places exit handler

svn: r17817

src/mzscheme/src/mzrt.c

@@ -253,6 +253,18 @@ int mz_proc_thread_detach(mz_proc_thread *thread) {
 #endif
 }
 
+void mz_proc_thread_exit(void *rc) {
+#ifdef WIN32
+  ExitThread((DWORD)rc);
+#else
+#   ifndef MZ_PRECISE_GC
+  pthread_exit(rc);
+#   else
+  pthread_exit(rc);
+#   endif
+#endif
+}
+
 /***********************************************************************/
 /*                RW Lock                                              */
 /***********************************************************************/

src/mzscheme/src/mzrt.h

@@ -46,6 +46,7 @@ mz_proc_thread* mzrt_proc_first_thread_init();
 mz_proc_thread* mz_proc_thread_create(mz_proc_thread_start*, void* data);
 void *mz_proc_thread_wait(mz_proc_thread *thread);
 int mz_proc_thread_detach(mz_proc_thread *thread);
+void mz_proc_thread_exit(void *rc);
 
 void mzrt_sleep(int seconds);
 

src/mzscheme/src/places.c

@@ -7,6 +7,7 @@
 
 #include "mzrt.h"
 
+READ_ONLY static Scheme_Object *scheme_def_place_exit_proc;
 
 SHARED_OK mz_proc_thread *scheme_master_proc_thread;
 THREAD_LOCAL_DECL(mz_proc_thread *proc_thread_self);
@@ -17,6 +18,7 @@ static Scheme_Object *scheme_place_p(int argc, Scheme_Object *args[]);
 static Scheme_Object *scheme_places_deep_copy_in_master(Scheme_Object *so);
 static Scheme_Object *scheme_place_send(int argc, Scheme_Object *args[]);
 static Scheme_Object *scheme_place_recv(int argc, Scheme_Object *args[]);
+static Scheme_Object *def_place_exit_handler_proc(int argc, Scheme_Object *args[]);
 
 Scheme_Object *scheme_place_async_channel_create();
 void scheme_place_async_send(Scheme_Place_Async_Channel *ch, Scheme_Object *o);
@@ -42,7 +44,6 @@ static Scheme_Object *not_implemented(int argc, Scheme_Object **argv)
 
 # ifdef MZ_PRECISE_GC
 static void register_traversers(void) { }
-
 # endif
 
 #endif
@@ -67,7 +68,12 @@ void scheme_init_place(Scheme_Env *env)
   PLACE_PRIM_W_ARITY("place-ch-send",  scheme_place_send,  1, 2, plenv);
   PLACE_PRIM_W_ARITY("place-ch-recv",  scheme_place_recv,  1, 1, plenv);
 
+#ifdef MZ_USE_PLACES
+  REGISTER_SO(scheme_def_place_exit_proc);
+  scheme_def_place_exit_proc = scheme_make_prim_w_arity(def_place_exit_handler_proc, "default-place-exit-handler", 1, 1);
+#endif
   scheme_finish_primitive_module(plenv);
+
 }
 
 #ifdef MZ_USE_PLACES
@@ -86,6 +92,21 @@ typedef struct Place_Start_Data {
   mzrt_sema *ready;
 } Place_Start_Data;
 
+static Scheme_Object *def_place_exit_handler_proc(int argc, Scheme_Object *argv[])
+{
+  long status;
+
+  if (SCHEME_INTP(argv[0])) {
+    status = SCHEME_INT_VAL(argv[0]);
+    if (status < 1 || status > 255)
+      status = 0;
+  } else
+    status = 0;
+
+  mz_proc_thread_exit((void *) status);
+  return scheme_void; /* Never get here */
+}
+
 static void null_out_runtime_globals() {
   scheme_current_thread           = NULL;
   scheme_first_thread             = NULL;
@@ -447,6 +468,8 @@ static void *place_start_proc(void *data_arg) {
   /* at point point, don't refer to place_data or its content
      anymore, because it's allocated in the other place */
 
+  scheme_set_root_param(MZCONFIG_EXIT_HANDLER, scheme_def_place_exit_proc);
+
   {
     Scheme_Thread * volatile p;
     mz_jmp_buf * volatile saved_error_buf;
@@ -504,8 +527,6 @@ Scheme_Object *scheme_place_recv(int argc, Scheme_Object *args[]) {
 }
 
 # ifdef MZ_PRECISE_GC
-static void* scheme_master_place_handlemsg(int msg_type, void *msg_payload);
-
 static void* scheme_master_place_handlemsg(int msg_type, void *msg_payload)
 {
   switch(msg_type) {
@@ -562,7 +583,6 @@ void scheme_spawn_master_place() {
   scheme_master_proc_thread = (void*) ~0;
 
 }
-
 # endif
 
 /*========================================================================*/
@@ -657,7 +677,6 @@ Scheme_Object *scheme_place_async_recv(Scheme_Place_Async_Channel *ch) {
   return msg;
 }
 
-
 /*========================================================================*/
 /*                       precise GC traversers                            */
 /*========================================================================*/