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

fix MzCOM for Racket

Browse Source 
Merge to v5.0
This commit is contained in:
Matthew Flatt 2010-05-27 12:48:09 -06:00
parent 7e485b8d28
commit b3fab5cabe
5 changed files with 36 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/mzcom/mzobj.cxx
View File

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

2
src/mzcom/mzobj.h
View File

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

3
src/racket/include/scheme.h
View File

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

10
src/racket/src/salloc.c
View File

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

14
src/racket/src/thread.c
View File

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