From facb411a6383fd20a776e6ccf38383a68cf000a3 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 29 Feb 2012 20:20:05 -0700
Subject: [PATCH] fix problems with place termination

---
 collects/tests/racket/ffi-orig-place.rkt | 36 ++++++++++------
 src/racket/src/place.c                   | 52 ++++++++++++++----------
 2 files changed, 54 insertions(+), 34 deletions(-)

diff --git a/collects/tests/racket/ffi-orig-place.rkt b/collects/tests/racket/ffi-orig-place.rkt
index 2c76671a6d..20a098f88a 100644
--- a/collects/tests/racket/ffi-orig-place.rkt
+++ b/collects/tests/racket/ffi-orig-place.rkt
@@ -8,18 +8,30 @@
 (define scheme_malloc_atomic
   (get-ffi-obj 'GC_malloc_atomic #f (_fun #:in-original-place? #t _long -> _pointer)))
 
-(define (main)
+(define (x-main)
   (define ps
     (for/list ([j (in-range 4)])
-      (place pch
-             ;; Start a thread that keep having to wait on the original place:
-             (thread
-              (lambda ()
-                (let loop ()
-                  (scheme_malloc_atomic 10)
-                  (loop))))
-             ;; Create a lot of message channels to trigger master GC:
-             (for ([i (in-range 100000)])
-               (place-channel))
-             (printf "done\n"))))
+      (define p
+        (place pch
+               (define j (place-channel-get pch))
+               ;; Start a thread that keep having to wait on the original place:
+               (thread
+                (lambda ()
+                  (let loop ()
+                    (scheme_malloc_atomic 10)
+                    (loop))))
+               ;; Create a lot of message channels to trigger master GC:
+               (for ([i (in-range 10000)])
+                 (place-channel))
+               (printf "done\n")
+               ;; Helps check exit handling:
+               (when (even? j) (exit 1))))
+      (place-channel-put p j)
+      p))
+  
   (for-each place-wait ps))
+
+(define (main)
+  (for ([i 5])
+    (printf "iter ~a\n" i)
+    (x-main)))
diff --git a/src/racket/src/place.c b/src/racket/src/place.c
index 30fa56277e..20a00f92a3 100644
--- a/src/racket/src/place.c
+++ b/src/racket/src/place.c
@@ -2348,14 +2348,41 @@ static void place_set_result(Scheme_Object *result)
   mzrt_mutex_unlock(place_object->lock);
 }
 
+static void terminate_current_place()
+{
+  intptr_t place_obj_die;
+  intptr_t refcount;
+  Scheme_Place_Object *place_obj;
+  
+  place_obj = place_object;
+
+  mzrt_mutex_lock(place_obj->lock);
+  
+  place_obj_die = place_obj->die;
+  place_obj->refcount--;
+  refcount = place_obj->refcount;
+  
+  mzrt_mutex_unlock(place_obj->lock);
+  
+  if (!refcount)
+    destroy_place_object_locks(place_obj);
+  
+  place_object = NULL;
+  
+  /*printf("Leavin place: proc thread id%u\n", ptid);*/
+
+  /* Beware that the destroy operation might trigger a GC to cooperate
+     with the master GC: */
+  scheme_place_instance_destroy(place_obj_die);
+}
+
 static Scheme_Object *def_place_exit_handler_proc(int argc, Scheme_Object *argv[])
 {
   scheme_log(NULL, SCHEME_LOG_DEBUG, 0, "place %d: exiting via (exit)", scheme_current_place_id);
 
   place_set_result(argv[0]);
 
-  /*printf("Leavin place: proc thread id%u\n", ptid);*/
-  scheme_place_instance_destroy(0);
+  terminate_current_place();
 
   mz_proc_thread_exit(NULL);
 
@@ -2504,26 +2531,7 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
 
   scheme_log(NULL, SCHEME_LOG_DEBUG, 0, "place %d: exiting", scheme_current_place_id);
 
-  {
-    intptr_t place_obj_die;
-    intptr_t refcount;
-
-    mzrt_mutex_lock(place_obj->lock);
-
-    place_obj_die = place_obj->die;
-    place_obj->refcount--;
-    refcount = place_obj->refcount;
-
-    mzrt_mutex_unlock(place_obj->lock);
-
-    if(!refcount) {
-      destroy_place_object_locks(place_obj);
-      place_object = NULL;
-    }
-
-    /*printf("Leavin place: proc thread id%u\n", ptid);*/
-    scheme_place_instance_destroy(place_obj_die);
-  }
+  terminate_current_place();
 
   return NULL;
 }