diff --git a/collects/compiler/private/xform.ss b/collects/compiler/private/xform.ss index b602155fec..10a7b79eae 100644 --- a/collects/compiler/private/xform.ss +++ b/collects/compiler/private/xform.ss @@ -586,22 +586,24 @@ (define per-block-push? #t) (define gc-var-stack-mode - (ormap (lambda (e) - (cond - [(and (pragma? e) - (regexp-match #rx"GC_VARIABLE_STACK_THOUGH_TABLE" (pragma-s e))) - 'table] - [(and (tok? e) - (eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL)) - 'thread-local] - [(and (tok? e) - (eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_GETSPECIFIC)) - 'getspecific] - [(and (tok? e) - (eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_FUNCTION)) - 'function] - [else #f])) - e-raw)) + (let loop ([e-raw e-raw]) + (ormap (lambda (e) + (cond + [(and (pragma? e) + (regexp-match #rx"GC_VARIABLE_STACK_THOUGH_TABLE" (pragma-s e))) + 'table] + [(and (tok? e) + (eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL)) + 'thread-local] + [(and (tok? e) + (eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_GETSPECIFIC)) + 'getspecific] + [(and (tok? e) + (eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_FUNCTION)) + 'function] + [(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 diff --git a/src/configure b/src/configure index b0acdacae6..a1adb8948b 100755 --- a/src/configure +++ b/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 diff --git a/src/mred/mrmain.cxx b/src/mred/mrmain.cxx index 5ee4d8a030..0b4f437157 100644 --- a/src/mred/mrmain.cxx +++ b/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 /* **************************************************************** */ diff --git a/src/mzscheme/configure.ac b/src/mzscheme/configure.ac index 266010fb79..b2c75c1e32 100644 --- a/src/mzscheme/configure.ac +++ b/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) diff --git a/src/mzscheme/gc/Makefile.in b/src/mzscheme/gc/Makefile.in index 188c530451..f5db01a36b 100644 --- a/src/mzscheme/gc/Makefile.in +++ b/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: diff --git a/src/mzscheme/gc2/newgc.c b/src/mzscheme/gc2/newgc.c index 01566ce8a5..32640c0b10 100644 --- a/src/mzscheme/gc2/newgc.c +++ b/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; diff --git a/src/mzscheme/include/scheme.h b/src/mzscheme/include/scheme.h index f1b4e5469c..94b9f03ae3 100644 --- a/src/mzscheme/include/scheme.h +++ b/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 diff --git a/src/mzscheme/include/schthread.h b/src/mzscheme/include/schthread.h index 1426d83959..b21438887c 100644 --- a/src/mzscheme/include/schthread.h +++ b/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) -# define USE_THREAD_LOCAL +#if defined(MZ_USE_PLACES) || defined(MZ_USE_FUTURES) +# 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 #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_; - MZ_MARK_POS_TYPE scheme_current_cont_mark_pos_; + long scheme_current_cont_mark_stack_; + 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_; - Scheme_Object *initial_renames_; - Scheme_Bucket_Table *initial_toplevel_; + struct Scheme_Object **initial_modules_; + struct Scheme_Object *initial_renames_; + 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_; - Scheme_Object *dummy_output_port_; - Scheme_Bucket_Table *place_local_modpath_table_; + struct Scheme_Object *dummy_input_port_; + struct Scheme_Object *dummy_output_port_; + 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_) diff --git a/src/mzscheme/src/Makefile.in b/src/mzscheme/src/Makefile.in index 5b6dce72e8..f745e33c2c 100644 --- a/src/mzscheme/src/Makefile.in +++ b/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 diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index 8bfe025c08..1a7f5de1fe 100644 --- a/src/mzscheme/src/env.c +++ b/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 diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 3da262e03c..798c101ede 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -143,7 +143,7 @@ #ifdef MACOS_STACK_LIMIT #include #endif -#ifdef FUTURES_ENABLED +#ifdef MZ_USE_FUTURES # include "future.h" #endif diff --git a/src/mzscheme/src/future.c b/src/mzscheme/src/future.c index 31ff13b92b..0b5930b6df 100644 --- a/src/mzscheme/src/future.c +++ b/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; - pthread_cond_t future_pending_cv; - pthread_cond_t gc_ok_c; - pthread_cond_t gc_done_c; + mzrt_mutex *future_mutex; + mzrt_sema *future_pending_sema; + mzrt_sema *gc_ok_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); - pthread_cond_init(&fs->future_pending_cv, NULL); - pthread_cond_init(&fs->gc_ok_c, NULL); - pthread_cond_init(&fs->gc_done_c, NULL); + mzrt_mutex_create(&fs->future_mutex); + mzrt_sema_create(&fs->future_pending_sema, 0); + mzrt_sema_create(&fs->gc_ok_c, 0); + 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; - GC_CAN_IGNORE pthread_attr_t attr; + Scheme_Thread *skeleton; + 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); - params.thread_skeleton->so.type = scheme_thread_type; + skeleton = MALLOC_ONE_TAGGED(Scheme_Thread); + 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(¶ms.ready_sema); - pthread_create(&threadid, &attr, worker_thread_future_loop, ¶ms); - sema_wait(¶ms.ready_sema); - sema_destroy(¶ms.ready_sema); + /* Fill in GCable values just before creating the thread, + because the GC ignores `params': */ + params.thread_skeleton = skeleton; + params.runstack_start = runstack_start; - fts->threadid = threadid; + mzrt_sema_create(¶ms.ready_sema, 0); + mz_proc_thread_create_w_stacksize(worker_thread_future_loop, ¶ms, 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); - pthread_mutex_unlock(&fs->future_mutex); + while (fs->need_gc_done_post) { + --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); - pthread_mutex_unlock(&fs->future_mutex); + mzrt_sema_post(fs->future_pending_sema); + 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: - scheme_block_until(future_ready, NULL, (Scheme_Object*)ft, 0); - pthread_mutex_lock(&fs->future_mutex); - if (ft->work_completed) - { - retval = ft->retval; + while (1) { + scheme_block_until(future_ready, NULL, (Scheme_Object*)ft, 0); + mzrt_mutex_lock(fs->future_mutex); + if (ft->work_completed) + { + retval = ft->retval; - LOG("Successfully touched future %d\n", ft->id); - // fflush(stdout); + LOG("Successfully touched future %d\n", ft->id); + // fflush(stdout); - pthread_mutex_unlock(&fs->future_mutex); - } - else if (ft->rt_prim) - { - //Invoke the primitive and stash the result - //Release the lock so other threads can manipulate the queue - //while the runtime call executes - pthread_mutex_unlock(&fs->future_mutex); - LOG("Invoking primitive %p on behalf of future %d...", ft->rt_prim, ft->id); - invoke_rtcall(fs, ft); - LOG("done.\n"); - - goto wait_for_rtcall_or_completion; - } - else - { - pthread_mutex_unlock(&fs->future_mutex); - goto wait_for_rtcall_or_completion; - } + mzrt_mutex_unlock(fs->future_mutex); + break; + } + else if (ft->rt_prim) + { + //Invoke the primitive and stash the result + //Release the lock so other threads can manipulate the queue + //while the runtime call executes + mzrt_mutex_unlock(fs->future_mutex); + LOG("Invoking primitive %p on behalf of future %d...", ft->rt_prim, ft->id); + invoke_rtcall(fs, ft); + LOG("done.\n"); + } + else + { + mzrt_mutex_unlock(fs->future_mutex); + } + } 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(¶ms->ready_sema); + mzrt_sema_post(params->ready_sema); - wait_for_work: - pthread_mutex_lock(&fs->future_mutex); - start_gc_not_ok(fs); - while (!(ft = get_pending_future(fs))) { - end_gc_not_ok(fts, fs, NULL); - pthread_cond_wait(&fs->future_pending_cv, &fs->future_mutex); + while (1) { + mzrt_sema_wait(fs->future_pending_sema); + mzrt_mutex_lock(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 - ft->status = RUNNING; - pthread_mutex_unlock(&fs->future_mutex); + //Work is available for this thread + ft->status = RUNNING; + 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 - scheme_jit_fill_threadlocal_table(); + //Set up the JIT compiler for this thread + 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 - //Passing no arguments for now. - //The lambda passed to a future will always be a parameterless - //function. - //From this thread's perspective, this call will never return - //until all the work to be done in the future has been completed, - //including runtime calls. - //If jitcode asks the runrtime thread to do work, then - //a GC can occur. - LOG("Running JIT code at %p...\n", ft->code); + //Run the code + //Passing no arguments for now. + //The lambda passed to a future will always be a parameterless + //function. + //From this thread's perspective, this call will never return + //until all the work to be done in the future has been completed, + //including runtime calls. + //If jitcode asks the runrtime thread to do work, then + //a GC can occur. + 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; - if (scheme_future_setjmp(newbuf)) { - /* failed */ - v = NULL; - } else { - v = jitcode(ft->orig_lambda, 0, NULL); - if (SAME_OBJ(v, SCHEME_TAIL_CALL_WAITING)) { - v = scheme_ts_scheme_force_value_same_mark(v); - } - } + scheme_current_thread->error_buf = &newbuf; + if (scheme_future_setjmp(newbuf)) { + /* failed */ + v = NULL; + } else { + v = jitcode(ft->orig_lambda, 0, NULL); + if (SAME_OBJ(v, SCHEME_TAIL_CALL_WAITING)) { + 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 - ft = fts->current_ft; + // Get future again, since a GC may have occurred + ft = fts->current_ft; - //Set the return val in the descriptor - pthread_mutex_lock(&fs->future_mutex); - ft->work_completed = 1; - ft->retval = v; + //Set the return val in the descriptor + mzrt_mutex_lock(fs->future_mutex); + ft->work_completed = 1; + ft->retval = v; - /* In case of multiple values: */ - send_special_result(ft, v); + /* In case of multiple values: */ + send_special_result(ft, v); - //Update the status - ft->status = FINISHED; - dequeue_future(fs, ft); + //Update the status + ft->status = FINISHED; + 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); - - pthread_mutex_unlock(&fs->future_mutex); - - goto wait_for_work; + } + end_gc_not_ok(fts, fs, NULL); + mzrt_mutex_unlock(fs->future_mutex); + } 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; - while (future->can_continue_cv) { - end_gc_not_ok(fts, fs, MZ_RUNSTACK); - 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; - } + future->can_continue_sema = fts->worker_can_continue_sema; + end_gc_not_ok(fts, fs, MZ_RUNSTACK); + mzrt_mutex_unlock(fs->future_mutex); - 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) { - pthread_cond_signal(future->can_continue_cv); - future->can_continue_cv= NULL; + if (future->can_continue_sema) { + mzrt_sema_post(future->can_continue_sema); + 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); - future->can_continue_cv = NULL; - pthread_mutex_unlock(&fs->future_mutex); + mzrt_sema_post(future->can_continue_sema); + future->can_continue_sema = NULL; + 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); diff --git a/src/mzscheme/src/future.h b/src/mzscheme/src/future.h index 321177c60c..3652806522 100644 --- a/src/mzscheme/src/future.h +++ b/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 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) \ diff --git a/src/mzscheme/src/gmp/gmp.c b/src/mzscheme/src/gmp/gmp.c index 654f16c095..59d9ad25d3 100644 --- a/src/mzscheme/src/gmp/gmp.c +++ b/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) diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index 609c87d0d9..dcc2bb189e 100644 --- a/src/mzscheme/src/jit.c +++ b/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; diff --git a/src/mzscheme/src/jit_ts.c b/src/mzscheme/src/jit_ts.c index 640e456944..63539556ca 100644 --- a/src/mzscheme/src/jit_ts.c +++ b/src/mzscheme/src/jit_ts.c @@ -1,4 +1,4 @@ -#ifdef FUTURES_ENABLED +#ifdef MZ_USE_FUTURES # include "jit_ts_def.c" diff --git a/src/mzscheme/src/mzmark.c b/src/mzscheme/src/mzmark.c index afe07e3be9..9a124b8c81 100644 --- a/src/mzscheme/src/mzmark.c +++ b/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 diff --git a/src/mzscheme/src/mzmarksrc.c b/src/mzscheme/src/mzmarksrc.c index 8a0051a7ea..861a1367f2 100644 --- a/src/mzscheme/src/mzmarksrc.c +++ b/src/mzscheme/src/mzmarksrc.c @@ -2253,7 +2253,7 @@ END jit; START future; -#ifdef FUTURES_ENABLED +#ifdef MZ_USE_FUTURES future { mark: diff --git a/src/mzscheme/src/mzrt.c b/src/mzscheme/src/mzrt.c index f6232cd5b1..a7b9cef979 100644 --- a/src/mzscheme/src/mzrt.c +++ b/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); - pthread_attr_setstacksize(attr, 8*1024*1024); /*8MB*/ -#else - attr = NULL; -#endif + + if (stacksize) { + attr = &attr_storage; + pthread_attr_init(attr); + pthread_attr_setstacksize(attr, stacksize); /*8MB*/ + } 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; diff --git a/src/mzscheme/src/mzrt.h b/src/mzscheme/src/mzrt.h index 162323672b..954d77dc60 100644 --- a/src/mzscheme/src/mzrt.h +++ b/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); diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 7558bb6cba..6f1e2ab5a5 100644 --- a/src/mzscheme/src/schpriv.h +++ b/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 diff --git a/src/mzscheme/src/string.c b/src/mzscheme/src/string.c index d3db745161..6f314d8bba 100644 --- a/src/mzscheme/src/string.c +++ b/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); - current_locale_name = (mzchar *)"xxxx\0\0\0\0"; + REGISTER_SO(current_locale_name_ptr); + 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; } } diff --git a/src/mzscheme/src/thread.c b/src/mzscheme/src/thread.c index a25ff5b945..f02f499e7b 100644 --- a/src/mzscheme/src/thread.c +++ b/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 }