From b3fab5cabeaa32832838984362e3fdbe26eb379d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 27 May 2010 12:48:09 -0600 Subject: [PATCH] fix MzCOM for Racket Merge to v5.0 --- src/mzcom/mzobj.cxx | 21 ++++++++++++++++----- src/mzcom/mzobj.h | 2 -- src/racket/include/scheme.h | 3 +++ src/racket/src/salloc.c | 10 +++++----- src/racket/src/thread.c | 14 ++++++++++++-- 5 files changed, 36 insertions(+), 14 deletions(-) diff --git a/src/mzcom/mzobj.cxx b/src/mzcom/mzobj.cxx index 0059be7dc6..87350bd7e9 100644 --- a/src/mzcom/mzobj.cxx +++ b/src/mzcom/mzobj.cxx @@ -53,6 +53,8 @@ static Scheme_Object *exn_catching_apply; static Scheme_Object *exn_p; static Scheme_Object *exn_message; +static Scheme_At_Exit_Callback_Proc at_exit_callback; + /* This indirection lets us delayload libmzsch.dll: */ #define scheme_false (scheme_make_false()) @@ -120,8 +122,9 @@ OLECHAR *wideStringFromSchemeObj(Scheme_Object *obj,char *fmt,int fmtlen) { } void exitHandler(int) { + if (at_exit_callback) at_exit_callback(); ReleaseSemaphore(exitSem,1,NULL); - ExitThread(0); + _endthreadex(0); } void setupSchemeEnv(Scheme_Env *in_env) @@ -143,7 +146,7 @@ void setupSchemeEnv(Scheme_Env *in_env) if (env == NULL) { ErrorBox("Can't create Scheme environment"); - ExitThread(0); + _endthreadex(0); } // set up collection paths, based on Racket startup @@ -294,7 +297,16 @@ static int do_evalLoop(Scheme_Env *env, int argc, char **_args) return 0; } -DWORD WINAPI evalLoop(LPVOID args) { +static void record_at_exit(Scheme_At_Exit_Callback_Proc p) XFORM_SKIP_PROC +{ + at_exit_callback = p; +} + +static __declspec(thread) void *tls_space; + +static unsigned WINAPI evalLoop(void *args) XFORM_SKIP_PROC { + scheme_register_tls_space(&tls_space, 0); + scheme_set_atexit(record_at_exit); return scheme_main_setup(1, do_evalLoop, 0, (char **)args); } @@ -312,14 +324,13 @@ void CMzObj::startMzThread(void) { tg.resetDoneSem = resetDoneSem; tg.pErrorState = &errorState; - threadHandle = CreateThread(NULL,0,evalLoop,(LPVOID)&tg,0,&threadId); + threadHandle = (HANDLE)_beginthreadex(NULL, 0, evalLoop, &tg, 0, NULL); } CMzObj::CMzObj(void) { inputMutex = NULL; readSem = NULL; - threadId = NULL; threadHandle = NULL; inputMutex = CreateSemaphore(NULL,1,1,NULL); diff --git a/src/mzcom/mzobj.h b/src/mzcom/mzobj.h index bd6f0e96e0..5d99f57ebd 100644 --- a/src/mzcom/mzobj.h +++ b/src/mzcom/mzobj.h @@ -19,7 +19,6 @@ typedef struct { } THREAD_GLOBALS; extern HINSTANCE globHinst; -extern DWORD WINAPI evalLoop(LPVOID); ///////////////////////////////////////////////////////////////////////////// // CMzObj @@ -47,7 +46,6 @@ class ATL_NO_VTABLE CMzObj : HANDLE evalDoneSems[2]; BSTR *globInput; BSTR globOutput; - DWORD threadId; HANDLE threadHandle; BOOL errorState; diff --git a/src/racket/include/scheme.h b/src/racket/include/scheme.h index 537ce30aa1..0757c94248 100644 --- a/src/racket/include/scheme.h +++ b/src/racket/include/scheme.h @@ -1719,6 +1719,9 @@ MZ_EXTERN void scheme_set_current_thread_ran_some(); typedef void (*Scheme_Exit_Proc)(int v); MZ_EXTERN Scheme_Exit_Proc scheme_exit; MZ_EXTERN void scheme_set_exit(Scheme_Exit_Proc p); +typedef void (*Scheme_At_Exit_Callback_Proc)(); +typedef void (*Scheme_At_Exit_Proc)(Scheme_At_Exit_Callback_Proc); +MZ_EXTERN void scheme_set_atexit(Scheme_At_Exit_Proc p); typedef void (*scheme_console_printf_t)(char *str, ...); MZ_EXTERN scheme_console_printf_t scheme_console_printf; MZ_EXTERN scheme_console_printf_t scheme_get_console_printf(); diff --git a/src/racket/src/salloc.c b/src/racket/src/salloc.c index 0229d0ea2b..6d95e44d6d 100644 --- a/src/racket/src/salloc.c +++ b/src/racket/src/salloc.c @@ -103,7 +103,7 @@ struct free_list_entry { THREAD_LOCAL_DECL(static struct free_list_entry *free_list;) THREAD_LOCAL_DECL(static int free_list_bucket_count;) -void scheme_set_stack_base(void *base, int no_auto_statics) +void scheme_set_stack_base(void *base, int no_auto_statics) XFORM_SKIP_PROC { #ifdef MZ_PRECISE_GC GC_init_type_tags(_scheme_last_type_, @@ -162,7 +162,7 @@ static int call_with_basic(void *data) return _main(scheme_basic_env(), ma->argc, ma->argv); } -int scheme_main_setup(int no_auto_statics, Scheme_Env_Main _main, int argc, char **argv) +int scheme_main_setup(int no_auto_statics, Scheme_Env_Main _main, int argc, char **argv) XFORM_SKIP_PROC { Scheme_Main_Data d; d._main = _main; @@ -171,7 +171,7 @@ int scheme_main_setup(int no_auto_statics, Scheme_Env_Main _main, int argc, char return scheme_main_stack_setup(no_auto_statics, call_with_basic, &d); } -static int do_main_stack_setup(int no_auto_statics, Scheme_Nested_Main _main, void *data) +static int do_main_stack_setup(int no_auto_statics, Scheme_Nested_Main _main, void *data) { void *stack_start; int volatile return_code; @@ -281,7 +281,7 @@ int scheme_main_stack_setup(int no_auto_statics, Scheme_Nested_Main _main, void return do_main_stack_setup(no_auto_statics, _main, data); } -void scheme_set_stack_bounds(void *base, void *deepest, int no_auto_statics) +void scheme_set_stack_bounds(void *base, void *deepest, int no_auto_statics) XFORM_SKIP_PROC { scheme_set_stack_base(base, no_auto_statics); @@ -292,7 +292,7 @@ void scheme_set_stack_bounds(void *base, void *deepest, int no_auto_statics) #endif } -extern unsigned long scheme_get_stack_base() +extern unsigned long scheme_get_stack_base() XFORM_SKIP_PROC { #if !defined(MZ_PRECISE_GC) && !defined(USE_SENORA_GC) if (GC_stackbottom) diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index 0010a56c38..eeaae7893f 100644 --- a/src/racket/src/thread.c +++ b/src/racket/src/thread.c @@ -184,6 +184,7 @@ extern int GC_is_marked(void *); # endif #endif +READ_ONLY Scheme_At_Exit_Proc replacement_at_exit; ROSYM Scheme_Object *scheme_parameterization_key; ROSYM Scheme_Object *scheme_exn_handler_key; @@ -1942,14 +1943,23 @@ static void run_atexit_closers(void) scheme_current_thread->error_buf = savebuf; } +void scheme_set_atexit(Scheme_At_Exit_Proc p) +{ + replacement_at_exit = p; +} + void scheme_add_atexit_closer(Scheme_Exit_Closer_Func f) { if (!cust_closers) { + if (replacement_at_exit) { + replacement_at_exit(run_atexit_closers); + } else { #ifdef USE_ON_EXIT_FOR_ATEXIT - on_exit(run_atexit_closers, NULL); + on_exit(run_atexit_closers, NULL); #else - atexit(run_atexit_closers); + atexit(run_atexit_closers); #endif + } REGISTER_SO(cust_closers); cust_closers = scheme_null;