From c41e80a6ae71fe12eab86ae084205d3fa1765f81 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Mon, 21 Dec 2015 22:30:25 -0500
Subject: [PATCH] Prove GC is cooperating w/blocked thread

---
 runtime.c |  3 +++
 test.scm  | 36 ++++++++++++++++++++++++++++++------
 2 files changed, 33 insertions(+), 6 deletions(-)

diff --git a/runtime.c b/runtime.c
index 1086258c..5bfcb6f6 100644
--- a/runtime.c
+++ b/runtime.c
@@ -2795,6 +2795,9 @@ to look at the lock-free structures provided by ck?
  */
 void Cyc_end_thread(gc_thread_data *thd) 
 {
+  // TODO: should we consider passing the current continuation (and args)
+  // as an argument? if we don't, will objects be collected that are still
+  // being used by active threads??
   mclosure0(clo, Cyc_exit_thread);
   GC(thd, &clo, thd->gc_args, 0);
 }
diff --git a/test.scm b/test.scm
index 1dcb3314..27d05fc2 100644
--- a/test.scm
+++ b/test.scm
@@ -1,13 +1,37 @@
 (import (scheme base)
+        (scheme read)
         (scheme write))
 
 ;; Spawn off a thread
-(let ((t (thread-start! (make-thread (lambda () (write 'a))))))
-  ;; Busy wait
-  (letrec ((foo (lambda () (bar)))
-           (bar (lambda () (foo))))
-      (foo))
-)
+;(let ((t (thread-start! (make-thread (lambda () (write 'a))))))
+;  ;; Busy wait
+;  (letrec ((foo (lambda () (bar)))
+;           (bar (lambda () (foo))))
+;      (foo))
+;)
+
+;; A program to prove if cooperation is working, or if it
+;; is blocked by another thread. The (read) causes the main
+;; thread to block. The collector should be notified prior 
+;; to the blocking call being made, and the collector should
+;; be able to cooperate on the main thread's behalf:
+(define tmp '())
+(thread-start! 
+  (make-thread 
+    (lambda () 
+      ;(write 'a)
+      (letrec ((loop (lambda ()
+                      (set! tmp (cons "cons" tmp))
+                      ;(write tmp)
+                      (cond
+                       ((> (length tmp) 1000)
+                        (write "resetting tmp")
+                        (set! tmp '()))
+                       (else #f))
+                      (loop))))
+      (loop))
+    )))
+(read)
 
 ;;;; A temporary file to attempt to repro crashing / data corruption
 ;;(import (scheme base) (scheme write))