suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
svn: r17879
This commit is contained in:
Matthew Flatt 2010-01-29 00:15:43 +00:00
parent 5270fcbc6c
commit ea87c95d95
23 changed files with 314 additions and 308 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
collects/compiler/private/xform.ss
View File

@ -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

20
src/configure vendored
View File

@ -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

2
src/mred/mrmain.cxx
View File

@ -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
/* **************************************************************** */

18
src/mzscheme/configure.ac
View File

@ -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)

2
src/mzscheme/gc/Makefile.in
View File

@ -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:

3
src/mzscheme/gc2/newgc.c
View File

@ -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;

19
src/mzscheme/include/scheme.h
View File

@ -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

55
src/mzscheme/include/schthread.h
View File

@ -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 <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_;
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_)

2
src/mzscheme/src/Makefile.in
View File

@ -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

2
src/mzscheme/src/env.c
View File

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

2
src/mzscheme/src/eval.c
View File

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

374
src/mzscheme/src/future.c
View File

@ -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(&params.ready_sema);
pthread_create(&threadid, &attr, worker_thread_future_loop, &params);
sema_wait(&params.ready_sema);
sema_destroy(&params.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(&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);
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(&params->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);

6
src/mzscheme/src/future.h
View File

@ -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) \

1
src/mzscheme/src/gmp/gmp.c
View File

@ -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)

6
src/mzscheme/src/jit.c
View File

@ -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;

2
src/mzscheme/src/jit_ts.c
View File

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

2
src/mzscheme/src/mzmark.c
View File

@ -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

2
src/mzscheme/src/mzmarksrc.c
View File

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

35
src/mzscheme/src/mzrt.c
View File

@ -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;

3
src/mzscheme/src/mzrt.h
View File

@ -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);

9
src/mzscheme/src/schpriv.h
View File

@ -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

12
src/mzscheme/src/string.c
View File

@ -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;
}
}

11
src/mzscheme/src/thread.c
View File

@ -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
}