fix MzCOM for Racket
Merge to v5.0
This commit is contained in:
parent
7e485b8d28
commit
b3fab5cabe
|
@ -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);
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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();
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue
Block a user