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

fix mzcom for v4

Browse Source 
svn: r9764
This commit is contained in:
Matthew Flatt 2008-05-09 11:55:29 +00:00
parent 1eacde0927
commit 70a3b20f8b
1 changed files with 29 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
src/mzcom/mzobj.cxx
View File

@ -124,11 +124,13 @@ void exitHandler(int) {
ExitThread(0); ExitThread(0);
} }
void setupSchemeEnv(void) { void setupSchemeEnv(Scheme_Env *in_env)
{
char *wrapper; char *wrapper;
char exeBuff[260]; char exeBuff[260];
HMODULE mod; HMODULE mod;
static BOOL registered; static BOOL registered;
Scheme_Object *nsreq, *a[1];
if (!registered) { if (!registered) {
scheme_register_static(&env,sizeof(env)); scheme_register_static(&env,sizeof(env));
@ -138,13 +140,29 @@ void setupSchemeEnv(void) {
registered = TRUE; registered = TRUE;
} }
env = scheme_basic_env(); env = in_env;
if (env == NULL) { if (env == NULL) {
ErrorBox("Can't create Scheme environment"); ErrorBox("Can't create Scheme environment");
ExitThread(0); ExitThread(0);
} }
// set up collection paths, based on MzScheme startup
mod = GetModuleHandle("mzcom.exe");
GetModuleFileName(mod,exeBuff,sizeof(exeBuff));
scheme_add_global("mzcom-exe",scheme_make_utf8_string(exeBuff),env);
scheme_set_exec_cmd(exeBuff);
scheme_set_collects_path(scheme_make_path("collects"));
scheme_init_collection_paths(env, scheme_make_null());
// initialize namespace
nsreq = scheme_builtin_value("namespace-require");
a[0] = scheme_intern_symbol("scheme");
scheme_apply(nsreq, 1, a);
// set up exception trapping // set up exception trapping
wrapper = wrapper =
@ -155,29 +173,11 @@ void setupSchemeEnv(void) {
exn_catching_apply = scheme_eval_string(wrapper,env); exn_catching_apply = scheme_eval_string(wrapper,env);
exn_p = scheme_builtin_value("exn?"); exn_p = scheme_builtin_value("exn?");
exn_message = scheme_builtin_value("exn-message"); exn_message = scheme_builtin_value("exn-message");
}
// set up collection paths, based on MzScheme startup static int do_evalLoop(Scheme_Env *env, int argc, char **_args)
mod = GetModuleHandle("mzcom.exe");
GetModuleFileName(mod,exeBuff,sizeof(exeBuff));
scheme_add_global("mzcom-exe",scheme_make_utf8_string(exeBuff),env);
scheme_set_exec_cmd(exeBuff);
{ {
Scheme_Object *clcp, *flcp, *a[1]; LPVOID args = (LPVOID)_args;
clcp = scheme_builtin_value("current-library-collection-paths");
flcp = scheme_builtin_value("find-library-collection-paths");
if (clcp && flcp) {
a[0] = _scheme_apply(flcp, 0, NULL);
_scheme_apply(clcp, 1, a);
}
}
}
DWORD WINAPI evalLoop(LPVOID args) {
HRESULT *pHr; HRESULT *pHr;
BOOL doEval; BOOL doEval;
UINT len; UINT len;
@ -197,14 +197,7 @@ DWORD WINAPI evalLoop(LPVOID args) {
// make sure all MzScheme calls are in this thread // make sure all MzScheme calls are in this thread
#ifdef MZ_PRECISE_GC setupSchemeEnv(env);
# define STACK_BASE_ADDR __gc_var_stack__
#else
# define STACK_BASE_ADDR NULL
#endif
scheme_set_stack_base(STACK_BASE_ADDR,1);
setupSchemeEnv();
scheme_set_exit(exitHandler); scheme_set_exit(exitHandler);
sleepFun = scheme_builtin_value("sleep"); sleepFun = scheme_builtin_value("sleep");
@ -239,7 +232,7 @@ DWORD WINAPI evalLoop(LPVOID args) {
// reset semaphore signalled // reset semaphore signalled
setupSchemeEnv(); setupSchemeEnv(scheme_basic_env());
ReleaseSemaphore(resetDoneSem,1,NULL); ReleaseSemaphore(resetDoneSem,1,NULL);
break; break;
@ -304,6 +297,10 @@ DWORD WINAPI evalLoop(LPVOID args) {
return 0; return 0;
} }
DWORD WINAPI evalLoop(LPVOID args) {
return scheme_main_setup(1, do_evalLoop, 0, (char **)args);
}
#ifdef MZ_PRECISE_GC #ifdef MZ_PRECISE_GC
START_XFORM_SKIP; START_XFORM_SKIP;
#endif #endif