adjust futures impl to use mzrt; fix MrEd build to work with futures

svn: r17879

collects/compiler/private/xform.ss

@@ -586,22 +586,24 @@
         
         (define per-block-push? #t)
         (define gc-var-stack-mode
-          (ormap (lambda (e)
+          (let loop ([e-raw e-raw])
-                   (cond
+            (ormap (lambda (e)
-                    [(and (pragma? e)
+                     (cond
-                          (regexp-match #rx"GC_VARIABLE_STACK_THOUGH_TABLE" (pragma-s e)))
+                      [(and (pragma? e)
-                     'table]
+                            (regexp-match #rx"GC_VARIABLE_STACK_THOUGH_TABLE" (pragma-s e)))
-                    [(and (tok? e)
+                       'table]
-                          (eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL))
+                      [(and (tok? e)
-                     'thread-local]
+                            (eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL))
-                    [(and (tok? e)
+                       'thread-local]
-                          (eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_GETSPECIFIC))
+                      [(and (tok? e)
-                     'getspecific]
+                            (eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_GETSPECIFIC))
-                    [(and (tok? e)
+                       'getspecific]
-                          (eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_FUNCTION))
+                      [(and (tok? e)
-                     'function]
+                            (eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_FUNCTION))
-                    [else #f]))
+                       'function]
-                 e-raw))
+                      [(braces? e) (loop (seq->list (seq-in e)))]
+                      [else #f]))
+                   e-raw)))
         
         ;; The code produced by xform uses a number of macros. These macros
         ;; make the transformation about a little easier to debug, and they

src/configure

@@ -706,7 +706,7 @@ FRAMEWORK_REL_INSTALL
 FRAMEWORK_PREFIX
 INSTALL_ORIG_TREE
 EXE_SUFFIX
-PLACE_CGC_FLAGS
+MZRT_CGC_FLAGS
 LIBATOM
 MREDLINKER
 LIBSFX
@@ -2316,7 +2316,7 @@ ZLIB_INC='$(ZLIB_INC)'
 PNG_A='$(PNG_A)'
 
 PREFLAGS="$CPPFLAGS"
-PLACE_CGC_FLAGS=""
+MZRT_CGC_FLAGS=""
 LIBATOM="LIBATOM_NONE"
 
 ar_libtool_no_undefined=""
@@ -10712,16 +10712,24 @@ fi
 
 if test "${enable_places}" = "yes" ; then
   PREFLAGS="$PREFLAGS -DMZ_USE_PLACES"
-  PLACE_CGC_FLAGS="$GC_THREADS_FLAG -DTHREAD_LOCAL_ALLOC"
   LDFLAGS="$LDFLAGS -pthread"
-  LIBATOM="LIBATOM_USE"
+  enable_mzrt=yes
 fi
 
 ############### futures ###################
 
 if test "${enable_futures}" = "yes" ; then
-  PREFLAGS="$PREFLAGS -DFUTURES_ENABLED -DUSE_PTHREAD_INSTEAD_OF_ITIMER"
+  PREFLAGS="$PREFLAGS -DMZ_USE_FUTURES"
+  enable_mzrt=yes
+fi
+
+############### OS threads ###################
+
+if test "${enable_mzrt}" = "yes" ; then
+  PREFLAGS="$PREFLAGS -DUSE_PTHREAD_INSTEAD_OF_ITIMER"
   LDFLAGS="$LDFLAGS -pthread"
+  MZRT_CGC_FLAGS="$GC_THREADS_FLAG -DTHREAD_LOCAL_ALLOC"
+  LIBATOM="LIBATOM_USE"
 fi
 
 ################ Xrender ##################
@@ -12959,7 +12967,7 @@ FRAMEWORK_REL_INSTALL!$FRAMEWORK_REL_INSTALL$ac_delim
 FRAMEWORK_PREFIX!$FRAMEWORK_PREFIX$ac_delim
 INSTALL_ORIG_TREE!$INSTALL_ORIG_TREE$ac_delim
 EXE_SUFFIX!$EXE_SUFFIX$ac_delim
-PLACE_CGC_FLAGS!$PLACE_CGC_FLAGS$ac_delim
+MZRT_CGC_FLAGS!$MZRT_CGC_FLAGS$ac_delim
 LIBATOM!$LIBATOM$ac_delim
 MREDLINKER!$MREDLINKER$ac_delim
 LIBSFX!$LIBSFX$ac_delim

src/mred/mrmain.cxx

@@ -292,12 +292,14 @@ static int call_main_after_stack(void *data)
 }
 
 int main(int argc, char *argv[])
+  XFORM_SKIP_PROC
 {
   Main_Args ma;
   ma.argc = argc;
   ma.argv = argv;
   return scheme_main_stack_setup(1, call_main_after_stack, &ma);
 }
+
 #endif
 
 /* **************************************************************** */

src/mzscheme/configure.ac

@@ -354,7 +354,7 @@ ZLIB_INC='$(ZLIB_INC)'
 PNG_A='$(PNG_A)'
 
 PREFLAGS="$CPPFLAGS"
-PLACE_CGC_FLAGS=""
+MZRT_CGC_FLAGS=""
 LIBATOM="LIBATOM_NONE"
 
 ar_libtool_no_undefined=""
@@ -1142,16 +1142,24 @@ fi
 
 if test "${enable_places}" = "yes" ; then
   PREFLAGS="$PREFLAGS -DMZ_USE_PLACES"
-  PLACE_CGC_FLAGS="$GC_THREADS_FLAG -DTHREAD_LOCAL_ALLOC"
   LDFLAGS="$LDFLAGS -pthread"
-  LIBATOM="LIBATOM_USE"
+  enable_mzrt=yes
 fi
 
 ############### futures ###################
 
 if test "${enable_futures}" = "yes" ; then
-  PREFLAGS="$PREFLAGS -DFUTURES_ENABLED -DUSE_PTHREAD_INSTEAD_OF_ITIMER"
+  PREFLAGS="$PREFLAGS -DMZ_USE_FUTURES"
+  enable_mzrt=yes
+fi
+
+############### OS threads ###################
+
+if test "${enable_mzrt}" = "yes" ; then
+  PREFLAGS="$PREFLAGS -DUSE_PTHREAD_INSTEAD_OF_ITIMER"
   LDFLAGS="$LDFLAGS -pthread"
+  MZRT_CGC_FLAGS="$GC_THREADS_FLAG -DTHREAD_LOCAL_ALLOC"
+  LIBATOM="LIBATOM_USE"
 fi
 
 ################ Xrender ##################
@@ -1432,7 +1440,7 @@ AC_SUBST(FRAMEWORK_REL_INSTALL)
 AC_SUBST(FRAMEWORK_PREFIX)
 AC_SUBST(INSTALL_ORIG_TREE)
 AC_SUBST(EXE_SUFFIX)
-AC_SUBST(PLACE_CGC_FLAGS)
+AC_SUBST(MZRT_CGC_FLAGS)
 AC_SUBST(LIBATOM)
 
 AC_SUBST(MREDLINKER)

src/mzscheme/gc/Makefile.in

@@ -47,7 +47,7 @@ mainsrcdir = @srcdir@/../..
 # compiler options; mainly used to allow importing options
 OPTIONS=@OPTIONS@ @CGCOPTIONS@
 
-BASEFLAGS= -I$(srcdir)/include -I$(AO_INSTALL_DIR)/src @CFLAGS@ @COMPFLAGS@ @PREFLAGS@ @PLACE_CGC_FLAGS@
+BASEFLAGS= -I$(srcdir)/include -I$(AO_INSTALL_DIR)/src @CFLAGS@ @COMPFLAGS@ @PREFLAGS@ @MZRT_CGC_FLAGS@
 CFLAGS= $(BASEFLAGS) @PROFFLAGS@ $(OPTIONS) -DNO_EXECUTE_PERMISSION -DSILENT -DNO_GETENV -DLARGE_CONFIG -DATOMIC_UNCOLLECTABLE -DINITIAL_MARK_STACK_SIZE=8192
 
 # To build the parallel collector on Linux, add to the above:

src/mzscheme/gc2/newgc.c

@@ -3309,6 +3309,7 @@ static void clean_up_heap(NewGC *gc)
   cleanup_vacated_pages(gc);
 }
 
+#ifdef MZ_USE_PLACES
 static void unprotect_old_pages(NewGC *gc)
 {
   Page_Range *protect_range = gc->protect_range;
@@ -3337,6 +3338,8 @@ static void unprotect_old_pages(NewGC *gc)
 
   flush_protect_page_ranges(protect_range, 0);
 }
+#endif
+
 static void protect_old_pages(NewGC *gc)
 {
   Page_Range *protect_range = gc->protect_range;

src/mzscheme/include/scheme.h

@@ -147,25 +147,6 @@ typedef jmpbuf jmp_buf[1];
 typedef struct FSSpec mzFSSpec;
 #endif
 
-/* Set up MZ_EXTERN for DLL build */
-#if defined(WINDOWS_DYNAMIC_LOAD) \
-    && !defined(LINK_EXTENSIONS_BY_TABLE) \
-    && !defined(SCHEME_EMBEDDED_NO_DLL)
-# define MZ_DLLIMPORT __declspec(dllimport)
-# define MZ_DLLEXPORT __declspec(dllexport)
-# ifdef __mzscheme_private__
-#  define MZ_DLLSPEC __declspec(dllexport)
-# else
-#  define MZ_DLLSPEC __declspec(dllimport)
-# endif
-#else
-# define MZ_DLLSPEC
-# define MZ_DLLIMPORT
-# define MZ_DLLEXPORT
-#endif
-
-#define MZ_EXTERN extern MZ_DLLSPEC
-
 #ifndef MZ_DONT_USE_JIT
 # if defined(MZ_USE_JIT_PPC) || defined(MZ_USE_JIT_I386) || defined(MZ_USE_JIT_X86_64)
 #  define MZ_USE_JIT

src/mzscheme/include/schthread.h

@@ -19,8 +19,8 @@
 #ifndef SCHEME_THREADLOCAL_H
 #define SCHEME_THREADLOCAL_H
 
-#if defined(MZ_USE_PLACES) || defined(FUTURES_ENABLED)
+#if defined(MZ_USE_PLACES) || defined(MZ_USE_FUTURES)
-#  define USE_THREAD_LOCAL
+# define USE_THREAD_LOCAL
 # if _MSC_VER
 #  define THREAD_LOCAL __declspec(thread)
 # elif defined(OS_X) || (defined(linux) && defined(MZ_USES_SHARED_LIB))
@@ -35,7 +35,26 @@
 # define THREAD_LOCAL /* empty */
 #endif
 
-extern void scheme_init_os_thread();
+/* Set up MZ_EXTERN for DLL build */
+#if (defined(__WIN32__) || defined(WIN32) || defined(_WIN32)) \
+    && !defined(LINK_EXTENSIONS_BY_TABLE) \
+    && !defined(SCHEME_EMBEDDED_NO_DLL)
+# define MZ_DLLIMPORT __declspec(dllimport)
+# define MZ_DLLEXPORT __declspec(dllexport)
+# ifdef __mzscheme_private__
+#  define MZ_DLLSPEC __declspec(dllexport)
+# else
+#  define MZ_DLLSPEC __declspec(dllimport)
+# endif
+#else
+# define MZ_DLLSPEC
+# define MZ_DLLIMPORT
+# define MZ_DLLEXPORT
+#endif
+
+#define MZ_EXTERN extern MZ_DLLSPEC
+
+MZ_EXTERN void scheme_init_os_thread();
 
 /* **************************************************************** */
 /* Declarations that we wish were elsewhere, but are needed here to */
@@ -77,7 +96,7 @@ typedef long objhead;
 
 /* **************************************** */
 
-#if FUTURES_ENABLED
+#if MZ_USE_FUTURES
 # include <pthread.h>
 #endif
 
@@ -193,8 +212,8 @@ typedef struct Thread_Local_Variables {
   void *jit_future_storage_[2];
   struct Scheme_Object **scheme_current_runstack_start_;
   struct Scheme_Object **scheme_current_runstack_;
-  MZ_MARK_STACK_TYPE scheme_current_cont_mark_stack_;
+  long scheme_current_cont_mark_stack_;
-  MZ_MARK_POS_TYPE scheme_current_cont_mark_pos_;
+  long scheme_current_cont_mark_pos_;
   struct Scheme_Custodian *main_custodian_;
   struct Scheme_Custodian *last_custodian_;
   struct Scheme_Hash_Table *limited_custodians_;
@@ -215,7 +234,6 @@ typedef struct Thread_Local_Variables {
   struct Scheme_Object *recycle_cell_;
   struct Scheme_Object *maybe_recycle_cell_;
   int recycle_cc_count_;
-  mz_jmp_buf main_init_error_buf_;
   void *gmp_mem_pool_;
   unsigned long max_total_allocation_;
   unsigned long current_total_allocation_;
@@ -226,14 +244,14 @@ typedef struct Thread_Local_Variables {
   int builtin_ref_counter_;
   int env_uid_counter_;
   int scheme_overflow_count_;
-  Scheme_Object *original_pwd_;
+  struct Scheme_Object *original_pwd_;
   long scheme_hash_request_count_;
   long scheme_hash_iteration_count_;
-  Scheme_Env *initial_modules_env_;
+  struct Scheme_Env *initial_modules_env_;
   int num_initial_modules_;
-  Scheme_Object **initial_modules_;
+  struct Scheme_Object **initial_modules_;
-  Scheme_Object *initial_renames_;
+  struct Scheme_Object *initial_renames_;
-  Scheme_Bucket_Table *initial_toplevel_;
+  struct Scheme_Bucket_Table *initial_toplevel_;
   int generate_lifts_count_;
   int special_is_ok_;
   int scheme_force_port_closed_;
@@ -253,14 +271,14 @@ typedef struct Thread_Local_Variables {
   long start_this_gc_time_;
   long end_this_gc_time_;
   volatile short delayed_break_ready_;
-  Scheme_Thread *main_break_target_thread_;
+  struct Scheme_Thread *main_break_target_thread_;
   long scheme_code_page_total_;
   int locale_on_;
-  const mzchar *current_locale_name_;
+  void *current_locale_name_ptr_;
   int gensym_counter_;
-  Scheme_Object *dummy_input_port_;
+  struct Scheme_Object *dummy_input_port_;
-  Scheme_Object *dummy_output_port_;
+  struct Scheme_Object *dummy_output_port_;
-  Scheme_Bucket_Table *place_local_modpath_table_;
+  struct Scheme_Bucket_Table *place_local_modpath_table_;
 /*KPLAKE1*/
 } Thread_Local_Variables;
 
@@ -461,7 +479,6 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
 #define recycle_cell XOA (scheme_get_thread_local_variables()->recycle_cell_)
 #define maybe_recycle_cell XOA (scheme_get_thread_local_variables()->maybe_recycle_cell_)
 #define recycle_cc_count XOA (scheme_get_thread_local_variables()->recycle_cc_count_)
-#define main_init_error_buf XOA (scheme_get_thread_local_variables()->main_init_error_buf_)
 #define gmp_mem_pool XOA (scheme_get_thread_local_variables()->gmp_mem_pool_)
 #define max_total_allocation XOA (scheme_get_thread_local_variables()->max_total_allocation_)
 #define current_total_allocation XOA (scheme_get_thread_local_variables()->current_total_allocation_)
@@ -502,7 +519,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
 #define main_break_target_thread XOA (scheme_get_thread_local_variables()->main_break_target_thread_)
 #define scheme_code_page_total XOA (scheme_get_thread_local_variables()->scheme_code_page_total_)
 #define locale_on XOA (scheme_get_thread_local_variables()->locale_on_)
-#define current_locale_name XOA (scheme_get_thread_local_variables()->current_locale_name_)
+#define current_locale_name_ptr XOA (scheme_get_thread_local_variables()->current_locale_name_ptr_)
 #define gensym_counter XOA (scheme_get_thread_local_variables()->gensym_counter_)
 #define dummy_input_port XOA (scheme_get_thread_local_variables()->dummy_input_port_)
 #define dummy_output_port XOA (scheme_get_thread_local_variables()->dummy_output_port_)

src/mzscheme/src/Makefile.in

@@ -272,7 +272,7 @@ fun.@LTO@: $(COMMON_HEADERS) \
         $(srcdir)/../src/stypes.h $(srcdir)/mzmark.c $(srcdir)/schmap.inc \
 				$(srcdir)/future.h
 future.@LTO@: $(srcdir)/schpriv.h $(srcdir)/future.h $(SCONFIG) $(srcdir)/../include/scheme.h \
-        $(srcdir)/../src/stypes.h $(srcdir)/mzmark.c \
+        $(srcdir)/../src/stypes.h $(srcdir)/mzmark.c $(srcdir)/mzrt.c \
         $(srcdir)/jit_ts_future_glue.c $(srcdir)/jit_ts_runtime_glue.c $(srcdir)/jit_ts_protos.h
 hash.@LTO@: $(COMMON_HEADERS) \
         $(srcdir)/../src/stypes.h $(srcdir)/mzmark.c

src/mzscheme/src/env.c

@@ -32,7 +32,7 @@
 #include "schminc.h"
 #include "schmach.h"
 #include "schexpobs.h"
-#ifdef FUTURES_ENABLED
+#ifdef MZ_USE_FUTURES
 # include "future.h"
 #endif
 

src/mzscheme/src/eval.c

@@ -143,7 +143,7 @@
 #ifdef MACOS_STACK_LIMIT
 #include <Memory.h>
 #endif 
-#ifdef FUTURES_ENABLED
+#ifdef MZ_USE_FUTURES
 # include "future.h"
 #endif
 

src/mzscheme/src/future.c

@@ -35,7 +35,7 @@ static Scheme_Object *future_p(int argc, Scheme_Object *argv[])
 static void register_traversers(void);
 #endif
 
-#ifndef FUTURES_ENABLED
+#ifndef MZ_USE_FUTURES
 
 /* Futures not enabled, but make a stub module and implementation */
 
@@ -176,12 +176,12 @@ typedef struct Scheme_Future_State {
   future_t *future_waiting_atomic;
   int next_futureid;
 
-  pthread_mutex_t future_mutex;
+  mzrt_mutex *future_mutex;
-  pthread_cond_t future_pending_cv;
+  mzrt_sema *future_pending_sema;
-  pthread_cond_t gc_ok_c;
+  mzrt_sema *gc_ok_c;
-  pthread_cond_t gc_done_c;
+  mzrt_sema *gc_done_c;
 
-  int gc_not_ok, wait_for_gc;
+  int gc_not_ok, wait_for_gc, need_gc_ok_post, need_gc_done_post;
 
   int *gc_counter_ptr;
 
@@ -190,9 +190,8 @@ typedef struct Scheme_Future_State {
 
 typedef struct Scheme_Future_Thread_State {
   int id;
-  pthread_t threadid;
   int worker_gc_counter;
-  pthread_cond_t worker_can_continue_cv;
+  mzrt_sema *worker_can_continue_sema;
   future_t *current_ft;
   long runstack_size;
 
@@ -232,53 +231,12 @@ static void send_special_result(future_t *f, Scheme_Object *retval);
 # define scheme_future_longjmp(newbuf, v) scheme_longjmp(newbuf, v)
 #endif
 
-/**********************************************************************/
-/*   Semaphore helpers                                                */
-/**********************************************************************/
-
-typedef struct sema_t {
-  int ready;
-  pthread_mutex_t m;
-  pthread_cond_t c;
-} sema_t;
-
-static void sema_wait(sema_t *s)
-{
-  pthread_mutex_lock(&s->m);
-  while (!s->ready) {
-    pthread_cond_wait(&s->c, &s->m);
-  }
-  --s->ready;
-  pthread_mutex_unlock(&s->m);
-}
-
-static void sema_signal(sema_t *s)
-{
-  pthread_mutex_lock(&s->m);
-  s->ready++;
-  pthread_cond_signal(&s->c);
-  pthread_mutex_unlock(&s->m);
-}
-
-static void sema_init(sema_t *s)
-{
-  pthread_mutex_init(&s->m, NULL);
-  pthread_cond_init(&s->c, NULL);
-  s->ready = 0;
-}
-
-static void sema_destroy(sema_t *s)
-{
-  pthread_mutex_destroy(&s->m);
-  pthread_cond_destroy(&s->c);
-}
-
 /**********************************************************************/
 /* Arguments for a newly created future thread                        */
 /**********************************************************************/
 
 typedef struct future_thread_params_t {
-  struct sema_t ready_sema;
+  mzrt_sema *ready_sema;
   struct NewGC *shared_GC;
   Scheme_Future_State *fs;
   Scheme_Future_Thread_State *fts;
@@ -361,10 +319,10 @@ void futures_init(void)
   REGISTER_SO(fs->future_queue_end);
   REGISTER_SO(fs->future_waiting_atomic);
   
-  pthread_mutex_init(&fs->future_mutex, NULL);
+  mzrt_mutex_create(&fs->future_mutex);
-  pthread_cond_init(&fs->future_pending_cv, NULL);
+  mzrt_sema_create(&fs->future_pending_sema, 0);
-  pthread_cond_init(&fs->gc_ok_c, NULL);
+  mzrt_sema_create(&fs->gc_ok_c, 0);
-  pthread_cond_init(&fs->gc_done_c, NULL);
+  mzrt_sema_create(&fs->gc_done_c, 0);
 
   fs->gc_counter_ptr = &scheme_did_gc_count;
 
@@ -380,13 +338,11 @@ static void init_future_thread(Scheme_Future_State *fs, int i)
 {
   Scheme_Future_Thread_State *fts;
   GC_CAN_IGNORE future_thread_params_t params;
-  pthread_t threadid;
+  Scheme_Thread *skeleton;
-  GC_CAN_IGNORE pthread_attr_t attr;
+  Scheme_Object **runstack_start;
 
   //Create the worker thread pool.  These threads will
   //'queue up' and wait for futures to become available   
-  pthread_attr_init(&attr);
-  pthread_attr_setstacksize(&attr, INITIAL_C_STACK_SIZE);
 
   fts = (Scheme_Future_Thread_State *)malloc(sizeof(Scheme_Future_Thread_State));
   memset(fts, 0, sizeof(Scheme_Future_Thread_State));
@@ -397,24 +353,27 @@ static void init_future_thread(Scheme_Future_State *fs, int i)
   params.fs = fs;
 
   /* Make enough of a thread record to deal with multiple values. */
-  params.thread_skeleton = MALLOC_ONE_TAGGED(Scheme_Thread);
+  skeleton = MALLOC_ONE_TAGGED(Scheme_Thread);
-  params.thread_skeleton->so.type = scheme_thread_type;
+  skeleton->so.type = scheme_thread_type;
 
   {
     Scheme_Object **rs_start, **rs;
     long init_runstack_size = FUTURE_RUNSTACK_SIZE;
     rs_start = scheme_alloc_runstack(init_runstack_size);
     rs = rs_start XFORM_OK_PLUS init_runstack_size;
-    params.runstack_start = rs_start;
+    runstack_start = rs_start;
     fts->runstack_size = init_runstack_size;
   }
 
-  sema_init(&params.ready_sema);
+  /* Fill in GCable values just before creating the thread,
-  pthread_create(&threadid, &attr, worker_thread_future_loop, &params);
+     because the GC ignores `params': */
-  sema_wait(&params.ready_sema);
+  params.thread_skeleton = skeleton;
-  sema_destroy(&params.ready_sema);
+  params.runstack_start = runstack_start;
 
-  fts->threadid = threadid;
+  mzrt_sema_create(&params.ready_sema, 0);
+  mz_proc_thread_create_w_stacksize(worker_thread_future_loop, &params, INITIAL_C_STACK_SIZE);
+  mzrt_sema_wait(params.ready_sema);
+  mzrt_sema_destroy(params.ready_sema);
 
   fts->gen0_size = 1;
 	
@@ -428,9 +387,13 @@ static void init_future_thread(Scheme_Future_State *fs, int i)
 }
 
 static void start_gc_not_ok(Scheme_Future_State *fs)
+/* must have mutex_lock */
 {
   while (fs->wait_for_gc) {
-    pthread_cond_wait(&fs->gc_done_c, &fs->future_mutex);
+    fs->need_gc_done_post++;
+    mzrt_mutex_unlock(fs->future_mutex);
+    mzrt_sema_wait(fs->gc_done_c);
+    mzrt_mutex_lock(fs->future_mutex);
   }
 
   fs->gc_not_ok++;
@@ -452,6 +415,7 @@ static void start_gc_not_ok(Scheme_Future_State *fs)
 static void end_gc_not_ok(Scheme_Future_Thread_State *fts, 
                           Scheme_Future_State *fs, 
                           Scheme_Object **current_rs)
+/* must have mutex_lock */
 {
   scheme_set_runstack_limits(MZ_RUNSTACK_START, 
                              fts->runstack_size,
@@ -463,7 +427,10 @@ static void end_gc_not_ok(Scheme_Future_Thread_State *fts,
   /* FIXME: clear scheme_current_thread->ku.multiple.array ? */
 
   --fs->gc_not_ok;
-  pthread_cond_signal(&fs->gc_ok_c);
+  if (fs->need_gc_ok_post) {
+    fs->need_gc_ok_post = 0;
+    mzrt_sema_post(fs->gc_ok_c);
+  }
 }
 
 void scheme_future_block_until_gc()
@@ -473,9 +440,9 @@ void scheme_future_block_until_gc()
 
   if (!fs) return;
 
-  pthread_mutex_lock(&fs->future_mutex);
+  mzrt_mutex_lock(fs->future_mutex);
   fs->wait_for_gc = 1;
-  pthread_mutex_unlock(&fs->future_mutex);
+  mzrt_mutex_unlock(fs->future_mutex);
 
   for (i = 0; i < THREAD_POOL_SIZE; i++) { 
     if (fs->pool_threads[i]) {
@@ -486,11 +453,14 @@ void scheme_future_block_until_gc()
   }
   asm("mfence");
 
-  pthread_mutex_lock(&fs->future_mutex);
+  mzrt_mutex_lock(fs->future_mutex);
   while (fs->gc_not_ok) {
-    pthread_cond_wait(&fs->gc_ok_c, &fs->future_mutex);
+    fs->need_gc_ok_post = 1;
+    mzrt_mutex_unlock(fs->future_mutex);
+    mzrt_sema_wait(fs->gc_ok_c);
+    mzrt_mutex_lock(fs->future_mutex);
   }
-  pthread_mutex_unlock(&fs->future_mutex);
+  mzrt_mutex_unlock(fs->future_mutex);
 }
 
 void scheme_future_continue_after_gc()
@@ -508,10 +478,13 @@ void scheme_future_continue_after_gc()
     }
   }
 
-  pthread_mutex_lock(&fs->future_mutex);
+  mzrt_mutex_lock(fs->future_mutex);
   fs->wait_for_gc = 0;
-  pthread_cond_broadcast(&fs->gc_done_c);
+  while (fs->need_gc_done_post) {
-  pthread_mutex_unlock(&fs->future_mutex);
+    --fs->need_gc_done_post;
+    mzrt_sema_post(fs->gc_done_c);
+  }
+  mzrt_mutex_unlock(fs->future_mutex);
 }
 
 void scheme_future_gc_pause()
@@ -520,10 +493,10 @@ void scheme_future_gc_pause()
   Scheme_Future_Thread_State *fts = scheme_future_thread_state;
   Scheme_Future_State *fs = scheme_future_state;
 
-  pthread_mutex_lock(&fs->future_mutex); 
+  mzrt_mutex_lock(fs->future_mutex); 
   end_gc_not_ok(fts, fs, MZ_RUNSTACK);
   start_gc_not_ok(fs); /* waits until wait_for_gc is 0 */
-  pthread_mutex_unlock(&fs->future_mutex);
+  mzrt_mutex_unlock(fs->future_mutex);
 }
 
 /**********************************************************************/
@@ -544,9 +517,9 @@ Scheme_Object *future(int argc, Scheme_Object *argv[])
   scheme_check_proc_arity("future", 0, 0, argc, argv);
 
   if (fs->future_threads_created < THREAD_POOL_SIZE) {
-    pthread_mutex_lock(&fs->future_mutex);
+    mzrt_mutex_lock(fs->future_mutex);
     count = fs->future_queue_count;
-    pthread_mutex_unlock(&fs->future_mutex);
+    mzrt_mutex_unlock(fs->future_mutex);
     if (count >= fs->future_threads_created) {
       init_future_thread(fs, fs->future_threads_created);
       fs->future_threads_created++;
@@ -566,10 +539,6 @@ Scheme_Object *future(int argc, Scheme_Object *argv[])
   ft->status = PENDING;
    
   //JIT compile the code if not already jitted
-  //Temporarily repoint MZ_RUNSTACK
-  //to the worker thread's runstack -
-  //in case the JIT compiler uses the stack address
-  //when generating code
   if (ncd->code == scheme_on_demand_jit_code)
     {
       scheme_on_demand_generate_lambda(nc, 0, NULL);
@@ -582,11 +551,11 @@ Scheme_Object *future(int argc, Scheme_Object *argv[])
 
   ft->code = (void*)ncd->code;
 
-  pthread_mutex_lock(&fs->future_mutex);
+  mzrt_mutex_lock(fs->future_mutex);
   enqueue_future(fs, ft);
   //Signal that a future is pending
-  pthread_cond_signal(&fs->future_pending_cv);
+  mzrt_sema_post(fs->future_pending_sema);
-  pthread_mutex_unlock(&fs->future_mutex);
+  mzrt_mutex_unlock(fs->future_mutex);
 
   return (Scheme_Object*)ft;
 }
@@ -599,11 +568,11 @@ int future_ready(Scheme_Object *obj)
   int ret = 0;
   future_t *ft = (future_t*)obj;
 
-  pthread_mutex_lock(&fs->future_mutex);
+  mzrt_mutex_lock(fs->future_mutex);
   if (ft->work_completed || ft->rt_prim) {
     ret = 1;
   }
-  pthread_mutex_unlock(&fs->future_mutex);
+  mzrt_mutex_unlock(fs->future_mutex);
 
   return ret;
 }
@@ -645,62 +614,61 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[])
   dump_state();
 #endif
 
-  pthread_mutex_lock(&fs->future_mutex);
+  mzrt_mutex_lock(fs->future_mutex);
   if ((ft->status == PENDING) || (ft->status == PENDING_OVERSIZE)) {
     if (ft->status == PENDING_OVERSIZE) {
       scheme_log(scheme_main_logger, SCHEME_LOG_DEBUG, 0,
                  "future: oversize procedure deferred to runtime thread");
     }
     ft->status = RUNNING;
-    pthread_mutex_unlock(&fs->future_mutex);
+    mzrt_mutex_unlock(fs->future_mutex);
 
     retval = scheme_apply_multi(ft->orig_lambda, 0, NULL);
     send_special_result(ft, retval);
 
-    pthread_mutex_lock(&fs->future_mutex);
+    mzrt_mutex_lock(fs->future_mutex);
     ft->work_completed = 1;
     ft->retval = retval;
     ft->status = FINISHED;
     dequeue_future(fs, ft);
-    pthread_mutex_unlock(&fs->future_mutex);
+    mzrt_mutex_unlock(fs->future_mutex);
 
     receive_special_result(ft, retval, 0);
 
     return retval;
   }
-  pthread_mutex_unlock(&fs->future_mutex);
+  mzrt_mutex_unlock(fs->future_mutex);
 
   //Spin waiting for primitive calls or a return value from
   //the worker thread
- wait_for_rtcall_or_completion:
+  while (1) {
-  scheme_block_until(future_ready, NULL, (Scheme_Object*)ft, 0);
+    scheme_block_until(future_ready, NULL, (Scheme_Object*)ft, 0);
-  pthread_mutex_lock(&fs->future_mutex);
+    mzrt_mutex_lock(fs->future_mutex);
-  if (ft->work_completed)
+    if (ft->work_completed)
-    {
+      {
-      retval = ft->retval;
+        retval = ft->retval;
 
-      LOG("Successfully touched future %d\n", ft->id);
+        LOG("Successfully touched future %d\n", ft->id);
-      // fflush(stdout);
+        // fflush(stdout);
 
-      pthread_mutex_unlock(&fs->future_mutex);
+        mzrt_mutex_unlock(fs->future_mutex);
-    }
+        break;
-  else if (ft->rt_prim)
+      }
-    {
+    else if (ft->rt_prim)
-      //Invoke the primitive and stash the result
+      {
-      //Release the lock so other threads can manipulate the queue
+        //Invoke the primitive and stash the result
-      //while the runtime call executes
+        //Release the lock so other threads can manipulate the queue
-      pthread_mutex_unlock(&fs->future_mutex);
+        //while the runtime call executes
-      LOG("Invoking primitive %p on behalf of future %d...", ft->rt_prim, ft->id);
+        mzrt_mutex_unlock(fs->future_mutex);
-      invoke_rtcall(fs, ft);
+        LOG("Invoking primitive %p on behalf of future %d...", ft->rt_prim, ft->id);
-      LOG("done.\n");
+        invoke_rtcall(fs, ft);
-
+        LOG("done.\n");
-      goto wait_for_rtcall_or_completion;
+      }
-    }
+    else
-  else
+      {
-    {
+        mzrt_mutex_unlock(fs->future_mutex);
-      pthread_mutex_unlock(&fs->future_mutex);
+      }
-      goto wait_for_rtcall_or_completion;
+  }
-    }
 
   if (!retval) {
     scheme_signal_error("touch: future previously aborted");
@@ -762,8 +730,6 @@ void *worker_thread_future_loop(void *arg)
   future_t *ft;
   mz_jmp_buf newbuf;
 
-  scheme_init_os_thread();
-
   scheme_future_state = fs;
   scheme_future_thread_state = fts;
 
@@ -771,7 +737,7 @@ void *worker_thread_future_loop(void *arg)
   scheme_current_thread = params->thread_skeleton;
 
   //Set processor affinity
-  /*pthread_mutex_lock(&fs->future_mutex);
+  /*mzrt_mutex_lock(fs->future_mutex);
       static unsigned long cur_cpu_mask = 1;
     if (pthread_setaffinity_np(pthread_self(), sizeof(g_cur_cpu_mask), &g_cur_cpu_mask))
     {
@@ -781,10 +747,10 @@ void *worker_thread_future_loop(void *arg)
     pthread_self());
     }
 
-    pthread_mutex_unlock(&fs->future_mutex);
+    mzrt_mutex_unlock(fs->future_mutex);
   */
 
-  pthread_cond_init(&fts->worker_can_continue_cv, NULL);
+  mzrt_sema_create(&fts->worker_can_continue_sema, 0);
 
   scheme_use_rtcall = 1;
 
@@ -803,81 +769,77 @@ void *worker_thread_future_loop(void *arg)
   params->current_thread_ptr = &scheme_current_thread;
   params->jit_future_storage_ptr = &jit_future_storage[0];
 
-  sema_signal(&params->ready_sema);
+  mzrt_sema_post(params->ready_sema);
 
- wait_for_work:
+  while (1) {
-  pthread_mutex_lock(&fs->future_mutex);
+    mzrt_sema_wait(fs->future_pending_sema);
-  start_gc_not_ok(fs);
+    mzrt_mutex_lock(fs->future_mutex);
-  while (!(ft = get_pending_future(fs))) {
-    end_gc_not_ok(fts, fs, NULL);
-    pthread_cond_wait(&fs->future_pending_cv, &fs->future_mutex);
     start_gc_not_ok(fs);
-  }
+    ft = get_pending_future(fs);
 
-  LOG("Got a signal that a future is pending...");
+    if (ft) {
+      LOG("Got a signal that a future is pending...");
         
-  //Work is available for this thread
+      //Work is available for this thread
-  ft->status = RUNNING;
+      ft->status = RUNNING;
-  pthread_mutex_unlock(&fs->future_mutex);
+      mzrt_mutex_unlock(fs->future_mutex);
 
-  ft->threadid = fts->threadid;
+      ft->thread_short_id = fts->id;
-  ft->thread_short_id = fts->id;
 
-  //Set up the JIT compiler for this thread 
+      //Set up the JIT compiler for this thread 
-  scheme_jit_fill_threadlocal_table();
+      scheme_jit_fill_threadlocal_table();
         
-  jitcode = (Scheme_Object* (*)(Scheme_Object*, int, Scheme_Object**))(ft->code);
+      jitcode = (Scheme_Object* (*)(Scheme_Object*, int, Scheme_Object**))(ft->code);
 
-  fts->current_ft = ft;
+      fts->current_ft = ft;
 
-  //Run the code
+      //Run the code
-  //Passing no arguments for now.
+      //Passing no arguments for now.
-  //The lambda passed to a future will always be a parameterless
+      //The lambda passed to a future will always be a parameterless
-  //function.
+      //function.
-  //From this thread's perspective, this call will never return
+      //From this thread's perspective, this call will never return
-  //until all the work to be done in the future has been completed,
+      //until all the work to be done in the future has been completed,
-  //including runtime calls. 
+      //including runtime calls. 
-  //If jitcode asks the runrtime thread to do work, then
+      //If jitcode asks the runrtime thread to do work, then
-  //a GC can occur.
+      //a GC can occur.
-  LOG("Running JIT code at %p...\n", ft->code);
+      LOG("Running JIT code at %p...\n", ft->code);
 
-  MZ_RUNSTACK = MZ_RUNSTACK_START + fts->runstack_size;
+      MZ_RUNSTACK = MZ_RUNSTACK_START + fts->runstack_size;
 
-  scheme_current_thread->error_buf = &newbuf;
+      scheme_current_thread->error_buf = &newbuf;
-  if (scheme_future_setjmp(newbuf)) {
+      if (scheme_future_setjmp(newbuf)) {
-    /* failed */
+        /* failed */
-    v = NULL;
+        v = NULL;
-  } else {
+      } else {
-    v = jitcode(ft->orig_lambda, 0, NULL);
+        v = jitcode(ft->orig_lambda, 0, NULL);
-    if (SAME_OBJ(v, SCHEME_TAIL_CALL_WAITING)) {
+        if (SAME_OBJ(v, SCHEME_TAIL_CALL_WAITING)) {
-      v = scheme_ts_scheme_force_value_same_mark(v);
+          v = scheme_ts_scheme_force_value_same_mark(v);
-    }
+        }
-  }
+      }
 
-  LOG("Finished running JIT code at %p.\n", ft->code);
+      LOG("Finished running JIT code at %p.\n", ft->code);
 
-  // Get future again, since a GC may have occurred
+      // Get future again, since a GC may have occurred
-  ft = fts->current_ft;
+      ft = fts->current_ft;
   
-  //Set the return val in the descriptor
+      //Set the return val in the descriptor
-  pthread_mutex_lock(&fs->future_mutex);
+      mzrt_mutex_lock(fs->future_mutex);
-  ft->work_completed = 1;
+      ft->work_completed = 1;
-  ft->retval = v;
+      ft->retval = v;
 
-  /* In case of multiple values: */
+      /* In case of multiple values: */
-  send_special_result(ft, v);
+      send_special_result(ft, v);
 
-  //Update the status 
+      //Update the status 
-  ft->status = FINISHED;
+      ft->status = FINISHED;
-  dequeue_future(fs, ft);
+      dequeue_future(fs, ft);
 
-  scheme_signal_received_at(fs->signal_handle);
+      scheme_signal_received_at(fs->signal_handle);
 
-  end_gc_not_ok(fts, fs, NULL);
+    }
-
+    end_gc_not_ok(fts, fs, NULL);
-  pthread_mutex_unlock(&fs->future_mutex);
+    mzrt_mutex_unlock(fs->future_mutex);
-
+  }
-  goto wait_for_work;
 
   return NULL;
 }
@@ -895,14 +857,14 @@ void scheme_check_future_work()
 
   while (1) {
     /* Try to get a future waiting on a atomic operation */
-    pthread_mutex_lock(&fs->future_mutex);
+    mzrt_mutex_lock(fs->future_mutex);
     ft = fs->future_waiting_atomic;
     if (ft) {
       fs->future_waiting_atomic = ft->next_waiting_atomic;
       ft->next_waiting_atomic = NULL;
       ft->waiting_atomic = 0;
     }
-    pthread_mutex_unlock(&fs->future_mutex);
+    mzrt_mutex_unlock(fs->future_mutex);
 
     if (ft) {
       if (ft->rt_prim && ft->rt_prim_is_atomic) {
@@ -931,7 +893,7 @@ static void future_do_runtimecall(Scheme_Future_Thread_State *fts,
 
   //set up the arguments for the runtime call
   //to be picked up by the main rt thread
-  pthread_mutex_lock(&fs->future_mutex);
+  mzrt_mutex_lock(fs->future_mutex);
 
   future->prim_func = func;
   future->rt_prim = 1;
@@ -951,17 +913,19 @@ static void future_do_runtimecall(Scheme_Future_Thread_State *fts,
   scheme_signal_received_at(fs->signal_handle);
 
   //Wait for the signal that the RT call is finished
-  future->can_continue_cv = &fts->worker_can_continue_cv;
+  future->can_continue_sema = fts->worker_can_continue_sema;
-  while (future->can_continue_cv) {
+  end_gc_not_ok(fts, fs, MZ_RUNSTACK);
-    end_gc_not_ok(fts, fs, MZ_RUNSTACK);
+  mzrt_mutex_unlock(fs->future_mutex);
-    pthread_cond_wait(&fts->worker_can_continue_cv, &fs->future_mutex);
-    start_gc_not_ok(fs);
-    //Fetch the future instance again, in case the GC has moved the pointer
-    future = fts->current_ft;
-  }
 
-  pthread_mutex_unlock(&fs->future_mutex);
+  mzrt_sema_wait(fts->worker_can_continue_sema);
 
+  mzrt_mutex_lock(fs->future_mutex);
+  start_gc_not_ok(fs);
+  mzrt_mutex_unlock(fs->future_mutex);
+
+  //Fetch the future instance again, in case the GC has moved the pointer
+  future = fts->current_ft;
+  
   if (future->no_retval) {
     future->no_retval = 0;
     scheme_future_longjmp(*scheme_current_thread->error_buf, 1);
@@ -1158,14 +1122,14 @@ static void do_invoke_rtcall(Scheme_Future_State *fs, future_t *future)
       break;
     }
 
-  pthread_mutex_lock(&fs->future_mutex);
+  mzrt_mutex_lock(fs->future_mutex);
   //Signal the waiting worker thread that it
   //can continue running machine code
-  if (future->can_continue_cv) {
+  if (future->can_continue_sema) {
-    pthread_cond_signal(future->can_continue_cv);
+    mzrt_sema_post(future->can_continue_sema);
-    future->can_continue_cv= NULL;
+    future->can_continue_sema= NULL;
   }
-  pthread_mutex_unlock(&fs->future_mutex);
+  mzrt_mutex_unlock(fs->future_mutex);
 }
 
 static void *do_invoke_rtcall_k(void)
@@ -1190,14 +1154,14 @@ static void invoke_rtcall(Scheme_Future_State * volatile fs, future_t * volatile
   savebuf = p->error_buf;
   p->error_buf = &newbuf;
   if (scheme_setjmp(newbuf)) {
-    pthread_mutex_lock(&fs->future_mutex);
+    mzrt_mutex_lock(fs->future_mutex);
     future->no_retval = 1;
     future->work_completed = 1;
     //Signal the waiting worker thread that it
     //can continue running machine code
-    pthread_cond_signal(future->can_continue_cv);
+    mzrt_sema_post(future->can_continue_sema);
-    future->can_continue_cv = NULL;
+    future->can_continue_sema = NULL;
-    pthread_mutex_unlock(&fs->future_mutex);
+    mzrt_mutex_unlock(fs->future_mutex);
     scheme_longjmp(*savebuf, 1);
   } else {
     if (future->rt_prim_is_atomic) {
@@ -1262,7 +1226,7 @@ START_XFORM_SKIP;
 
 static void register_traversers(void)
 {
-#ifdef FUTURES_ENABLED
+#ifdef MZ_USE_FUTURES
   GC_REG_TRAV(scheme_future_type, future);
 #else
   GC_REG_TRAV(scheme_future_type, sequential_future);

src/mzscheme/src/future.h

@@ -20,7 +20,6 @@ void scheme_add_global(char *name, int arity, Scheme_Env *env);
 int scheme_make_prim_w_arity(prim_t func, char *name, int arg1, int arg2);
 #endif
 
-#include "pthread.h"
 #include <stdio.h>
 
 typedef void (*prim_void_void_3args_t)(Scheme_Object **);
@@ -43,11 +42,10 @@ typedef struct future_t {
   Scheme_Object so;
 
   int id;
-  pthread_t threadid;
   int thread_short_id;
   int status;
   int work_completed;
-  pthread_cond_t *can_continue_cv;
+  mzrt_sema *can_continue_sema;
 
   Scheme_Object *orig_lambda;
   void *code;
@@ -111,7 +109,7 @@ typedef struct future_t {
 extern Scheme_Object *scheme_ts_scheme_force_value_same_mark(Scheme_Object *v);
 
 //Helper macros for argument marshaling
-#ifdef FUTURES_ENABLED
+#ifdef MZ_USE_FUTURES
 
 #define IS_WORKER_THREAD (g_rt_threadid != 0 && pthread_self() != g_rt_threadid)
 #define ASSERT_CORRECT_THREAD if (g_rt_threadid != 0 && pthread_self() != g_rt_threadid) \

src/mzscheme/src/gmp/gmp.c

@@ -5788,6 +5788,7 @@ void scheme_init_gmp_places() {
   gmp_tmp_xxx.alloc_point = &gmp_tmp_xxx;
   gmp_tmp_xxx.prev = 0;
   gmp_tmp_current = &gmp_tmp_xxx;
+  REGISTER_SO(gmp_mem_pool);
 }
 
 void scheme_gmp_tls_init(long *s) 

src/mzscheme/src/jit.c

@@ -42,7 +42,7 @@
 
 #include "schpriv.h"
 #include "schmach.h"
-#ifdef FUTURES_ENABLED
+#ifdef MZ_USE_FUTURES
 # include "future.h"
 #endif
 #ifdef MZ_USE_DWARF_LIBUNWIND
@@ -2570,7 +2570,7 @@ extern int g_print_prims;
 #include "jit_ts.c"
 
 /* Support for intercepting direct calls to primitives: */
-#ifdef FUTURES_ENABLED
+#ifdef MZ_USE_FUTURES
 # define mz_prepare_direct_prim(n) mz_prepare(n)
 # define mz_finishr_direct_prim(reg, proc) (jit_pusharg_p(reg), (void)mz_finish(proc))
 # define mz_direct_only(p) /* skip this arg, so that total count <= 3 args */
@@ -2689,7 +2689,7 @@ static int generate_pause_for_gc_and_retry(mz_jit_state *jitter,
                                            int gc_reg, /* must not be JIT_R1 */
                                            GC_CAN_IGNORE jit_insn *refagain)
 {
-#ifdef FUTURES_ENABLED
+#ifdef MZ_USE_FUTURES
   GC_CAN_IGNORE jit_insn *refslow = 0, *refpause;
   int i;
 

src/mzscheme/src/jit_ts.c

@@ -1,4 +1,4 @@
-#ifdef FUTURES_ENABLED
+#ifdef MZ_USE_FUTURES
 
 # include "jit_ts_def.c"
 

src/mzscheme/src/mzmark.c

@@ -5503,7 +5503,7 @@ static int native_unclosed_proc_plus_case_FIXUP(void *p) {
 
 #ifdef MARKS_FOR_FUTURE_C
 
-#ifdef FUTURES_ENABLED
+#ifdef MZ_USE_FUTURES
 
 static int future_SIZE(void *p) {
   return

src/mzscheme/src/mzmarksrc.c

@@ -2253,7 +2253,7 @@ END jit;
 
 START future;
 
-#ifdef FUTURES_ENABLED
+#ifdef MZ_USE_FUTURES
 
 future {
  mark:

src/mzscheme/src/mzrt.c

@@ -1,6 +1,6 @@
 #include "schpriv.h"
 
-#ifdef MZ_USE_PLACES
+#ifdef MZ_USE_MZRT
 
 /************************************************************************/
 /************************************************************************/
@@ -194,18 +194,19 @@ mz_proc_thread* mzrt_proc_first_thread_init() {
   return thread;
 }
 
-mz_proc_thread* mz_proc_thread_create(mz_proc_thread_start start_proc, void* data) {
+mz_proc_thread* mz_proc_thread_create_w_stacksize(mz_proc_thread_start start_proc, void* data, long stacksize) {
   mz_proc_thread *thread = (mz_proc_thread*)malloc(sizeof(mz_proc_thread));
+#   ifndef WIN32
   pthread_attr_t *attr;
-
-#ifdef OS_X
   pthread_attr_t attr_storage;
-  attr = &attr_storage;
+
-  pthread_attr_init(attr);
+  if (stacksize) {
-  pthread_attr_setstacksize(attr, 8*1024*1024); /*8MB*/
+    attr = &attr_storage;
-#else
+    pthread_attr_init(attr);
-  attr = NULL;
+    pthread_attr_setstacksize(attr, stacksize); /*8MB*/
-#endif
+  } else
+    attr = NULL;
+#   endif
 
   mzrt_thread_stub_data *stub_data = (mzrt_thread_stub_data*)malloc(sizeof(mzrt_thread_stub_data));
   thread->mbox = pt_mbox_create();
@@ -213,7 +214,7 @@ mz_proc_thread* mz_proc_thread_create(mz_proc_thread_start start_proc, void* dat
   stub_data->data       = data;
   stub_data->thread     = thread;
 #   ifdef WIN32
-  thread->threadid = CreateThread(NULL, 0, mzrt_thread_stub, stub_data, 0, NULL);
+  thread->threadid = CreateThread(NULL, stacksize, mzrt_thread_stub, stub_data, 0, NULL);
 #   else
   pthread_create(&thread->threadid, attr, mzrt_thread_stub, stub_data);
 #   endif
@@ -221,6 +222,18 @@ mz_proc_thread* mz_proc_thread_create(mz_proc_thread_start start_proc, void* dat
   return thread;
 }
 
+mz_proc_thread* mz_proc_thread_create(mz_proc_thread_start start_proc, void* data) {
+  long stacksize;
+
+#ifdef OS_X
+  stacksize = 8*1024*1024;
+#else
+  stacksize = 0;
+#endif
+
+  return mz_proc_thread_create_w_stacksize(start_proc, data, stacksize);
+}
+
 void * mz_proc_thread_wait(mz_proc_thread *thread) {
 #ifdef WIN32
   DWORD rc;

src/mzscheme/src/mzrt.h

@@ -1,7 +1,7 @@
 #ifndef MZRT_H
 #define MZRT_H
 
-#ifdef MZ_USE_PLACES
+#ifdef MZ_USE_MZRT
 
 /****************** ATOMIC OPERATIONS ************************************/
 /* mzrt_atomic_ops.c */
@@ -44,6 +44,7 @@ typedef void *(mz_proc_thread_start)(void*);
 
 mz_proc_thread* mzrt_proc_first_thread_init();
 mz_proc_thread* mz_proc_thread_create(mz_proc_thread_start*, void* data);
+mz_proc_thread* mz_proc_thread_create_w_stacksize(mz_proc_thread_start*, void* data, long stacksize);
 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);

src/mzscheme/src/schpriv.h

@@ -403,6 +403,14 @@ THREAD_LOCAL_DECL(extern volatile int scheme_fuel_counter);
 
 THREAD_LOCAL_DECL(extern Scheme_Thread *scheme_main_thread);
 
+#if defined(MZ_USE_PLACES) || defined(MZ_USE_FUTURES)
+# define MZ_USE_MZRT
+#endif
+
+#ifdef MZ_USE_MZRT
+#include "mzrt.h"
+#endif
+
 #ifdef MZ_USE_PLACES
 THREAD_LOCAL_DECL(extern Scheme_Thread *scheme_current_thread);
 THREAD_LOCAL_DECL(extern Scheme_Thread *scheme_first_thread);
@@ -415,7 +423,6 @@ THREAD_LOCAL_DECL(extern Scheme_Thread *scheme_first_thread);
 #define scheme_jumping_to_continuation (scheme_current_thread->cjs.jumping_to_continuation)
 #define scheme_multiple_count (scheme_current_thread->ku.multiple.count)
 #define scheme_multiple_array (scheme_current_thread->ku.multiple.array)
-#include "mzrt.h"
 extern mz_proc_thread *scheme_master_proc_thread;
 THREAD_LOCAL_DECL(extern mz_proc_thread *proc_thread_self);
 #endif

src/mzscheme/src/string.c

@@ -163,9 +163,11 @@ typedef struct Scheme_Converter {
    may have changed. Similarly, setlocale() is only up-to-date
    when reset_locale() has been called. */
 THREAD_LOCAL_DECL(static int locale_on);
-THREAD_LOCAL_DECL(static const mzchar *current_locale_name);
+THREAD_LOCAL_DECL(static void *current_locale_name_ptr);
 static void reset_locale(void);
 
+#define current_locale_name ((const mzchar *)current_locale_name_ptr)
+
 #ifdef USE_ICONV_DLL
 static char *nl_langinfo(int which)
 {
@@ -173,7 +175,7 @@ static char *nl_langinfo(int which)
 
   reset_locale();
   if (!current_locale_name)
-    current_locale_name = (mzchar *)"\0\0\0\0";
+    current_locale_name_ptr ="\0\0\0\0";
 
   if ((current_locale_name[0] == 'C')
       && !current_locale_name[1])
@@ -853,8 +855,8 @@ scheme_init_string (Scheme_Env *env)
 }
 
 void scheme_init_string_places(void) {
-  REGISTER_SO(current_locale_name);
+  REGISTER_SO(current_locale_name_ptr);
-  current_locale_name = (mzchar *)"xxxx\0\0\0\0";
+  current_locale_name_ptr = "xxxx\0\0\0\0";
 }
 
 /**********************************************************************/
@@ -3418,7 +3420,7 @@ static void reset_locale(void)
 	setlocale(LC_COLLATE, "C");
     }
 #endif
-    current_locale_name = name;
+    current_locale_name_ptr = (void *)name;
   }
 }
 

src/mzscheme/src/thread.c

@@ -41,7 +41,7 @@
 #include "schpriv.h"
 #include "schmach.h"
 #include "schgc.h"
-#ifdef FUTURES_ENABLED
+#ifdef MZ_USE_FUTURES
 # include "future.h"
 #endif
 #ifndef PALMOS_STUFF
@@ -232,7 +232,6 @@ THREAD_LOCAL_DECL(static Scheme_Object *thread_swap_out_callbacks);
 THREAD_LOCAL_DECL(static Scheme_Object *recycle_cell);
 THREAD_LOCAL_DECL(static Scheme_Object *maybe_recycle_cell);
 THREAD_LOCAL_DECL(static int recycle_cc_count);
-THREAD_LOCAL_DECL(static mz_jmp_buf main_init_error_buf);
 
 #ifdef MZ_PRECISE_GC
 extern long GC_get_memory_use(void *c);
@@ -2199,7 +2198,7 @@ static Scheme_Thread *make_thread(Scheme_Config *config,
 
     process->suspend_break = 1; /* until start-up finished */
 
-    process->error_buf = &main_init_error_buf;
+    process->error_buf = NULL;
 
     thread_swap_callbacks = scheme_null;
     thread_swap_out_callbacks = scheme_null;
@@ -4130,7 +4129,7 @@ void scheme_thread_block(float sleep_time)
   /* Check scheduled_kills early and often. */
   check_scheduled_kills();
 
-#ifdef FUTURES_ENABLED
+#ifdef MZ_USE_FUTURES
   scheme_check_future_work();
 #endif
 
@@ -7349,7 +7348,7 @@ static void get_ready_for_GC()
 {
   start_this_gc_time = scheme_get_process_milliseconds();
 
-#ifdef FUTURES_ENABLED
+#ifdef MZ_USE_FUTURES
   scheme_future_block_until_gc();
 #endif
 
@@ -7421,7 +7420,7 @@ static void done_with_GC()
   end_this_gc_time = scheme_get_process_milliseconds();
   scheme_total_gc_time += (end_this_gc_time - start_this_gc_time);
 
-#ifdef FUTURES_ENABLED
+#ifdef MZ_USE_FUTURES
   scheme_future_continue_after_gc();
 #endif
 }