diff --git a/src/mred/mred.cxx b/src/mred/mred.cxx index 6254007ea4..59a014ad21 100644 --- a/src/mred/mred.cxx +++ b/src/mred/mred.cxx @@ -184,7 +184,9 @@ extern "C" { /* Set by mrmain.cxx: */ /* (The indirection is needed to avoid mutual .dll dependencies.) */ MrEd_Finish_Cmd_Line_Run_Proc mred_finish_cmd_line_run; +void mred_set_finish_cmd_line_run(MrEd_Finish_Cmd_Line_Run_Proc p) { mred_finish_cmd_line_run = p; } MrEd_Run_From_Cmd_Line_Proc mred_run_from_cmd_line; +void mred_set_run_from_cmd_line(MrEd_Run_From_Cmd_Line_Proc p) { mred_run_from_cmd_line = p; } #if 0 /* Force initialization of the garbage collector (currently needed diff --git a/src/mred/mred.h b/src/mred/mred.h index 89c1bf127f..c99294ddc2 100644 --- a/src/mred/mred.h +++ b/src/mred/mred.h @@ -173,7 +173,9 @@ typedef int (*MrEd_Finish_Cmd_Line_Run_Proc)(void); typedef void (*MrEd_Run_From_Cmd_Line_Proc)(int argc, char **argv, Scheme_Env *(*mk_basic_env)(void)); MRED_EXTERN MrEd_Finish_Cmd_Line_Run_Proc mred_finish_cmd_line_run; +MRED_EXTERN void mred_set_finish_cmd_line_run(MrEd_Finish_Cmd_Line_Run_Proc); MRED_EXTERN MrEd_Run_From_Cmd_Line_Proc mred_run_from_cmd_line; +MRED_EXTERN void mred_set_run_from_cmd_line(MrEd_Run_From_Cmd_Line_Proc); # include "../mzscheme/src/schvers.h" diff --git a/src/mred/mrmain.cxx b/src/mred/mrmain.cxx index f7c324cc26..68951c7209 100644 --- a/src/mred/mrmain.cxx +++ b/src/mred/mrmain.cxx @@ -78,15 +78,17 @@ static void yield_indefinitely() void *dummy; #endif mz_jmp_buf * volatile save, newbuf; + Scheme_Thread * volatile p; - save = scheme_current_thread->error_buf; - scheme_current_thread->error_buf = &newbuf; + p = scheme_get_current_thread(); + save = p->error_buf; + p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) { mred_wait_eventspace(); } - scheme_current_thread->error_buf = save; + p->error_buf = save; #ifdef MZ_PRECISE_GC dummy = NULL; /* makes xform think that dummy is live, so we get a __gc_var_stack__ */ @@ -126,12 +128,15 @@ extern "C" Scheme_Object *scheme_initialize(Scheme_Env *env); #endif #define GET_INIT_FILENAME get_init_filename #if REDIRECT_STDIO || WINDOW_STDIO || WCONSOLE_STDIO -# define PRINTF scheme_console_printf +# define PRINTF mred_console_printf +static void (*mred_console_printf)(char *str, ...); +# define NEED_MRED_CONSOLE_PRINTF #else # define PRINTF printf #endif #define PROGRAM "MrEd" #define PROGRAM_LC "mred" +#define INITIAL_BIN_TYPE "ri" #ifdef wx_mac # ifndef OS_X @@ -190,9 +195,11 @@ static FinishArgs *xfa; static void do_graph_repl(Scheme_Env *env) { mz_jmp_buf * volatile save, newbuf; + Scheme_Thread * volatile p; - save = scheme_current_thread->error_buf; - scheme_current_thread->error_buf = &newbuf; + p = scheme_get_current_thread(); + save = p->error_buf; + p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) { if (xfa->alternate_rep) @@ -201,7 +208,7 @@ static void do_graph_repl(Scheme_Env *env) scheme_eval_string("(graphical-read-eval-print-loop)", env); } - scheme_current_thread->error_buf = save; + p->error_buf = save; #ifdef MZ_PRECISE_GC env = NULL; /* makes xform think that env is live, so we get a __gc_var_stack__ */ @@ -228,11 +235,14 @@ static int do_main_loop(FinishArgs *fa) { mz_jmp_buf * volatile save, newbuf; - save = scheme_current_thread->error_buf; - scheme_current_thread->error_buf = &newbuf; + Scheme_Thread * volatile p; + + p = scheme_get_current_thread(); + save = p->error_buf; + p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) wxDoMainLoop(); - scheme_current_thread->error_buf = save; + p->error_buf = save; } return 0; @@ -240,6 +250,9 @@ static int do_main_loop(FinishArgs *fa) static void run_from_cmd_line(int argc, char **argv, Scheme_Env *(*mk_basic_env)(void)) { +#ifdef NEED_MRED_CONSOLE_PRINTF + mred_console_printf = scheme_get_console_printf(); +#endif run_from_cmd_line(argc, argv, mk_basic_env, do_main_loop); } @@ -390,9 +403,9 @@ int main(int argc, char *argv[]) # endif #endif - scheme_actual_main = CAST_ACTUAL_MAIN actual_main; - mred_run_from_cmd_line = run_from_cmd_line; - mred_finish_cmd_line_run = finish_cmd_line_run; + scheme_set_actual_main(actual_main); + mred_set_run_from_cmd_line(run_from_cmd_line); + mred_set_finish_cmd_line_run(finish_cmd_line_run); rval = scheme_image_main(argc, argv); @@ -609,6 +622,15 @@ int APIENTRY WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR ignored long argc, j, l; char *a, **argv, *b, *normalized_path = NULL; + /* Order matters: load dependencies first */ + load_delayed_dll("msvcr71.dll"); +# ifndef MZ_PRECISE_GC + load_delayed_dll("libmzgcxxxxxxx.dll"); +# endif + load_delayed_dll("libmzsch" DLL_3M_SUFFIX "xxxxxxx.dll"); + load_delayed_dll("libmred" DLL_3M_SUFFIX "xxxxxxx.dll"); + record_dll_path(); + /* Get command line: */ m_lpCmdLine = GetCommandLineW(); for (j = 0; m_lpCmdLine[j]; j++) { diff --git a/src/mzscheme/cmdline.inc b/src/mzscheme/cmdline.inc index 9860e25b04..b2e2d4847e 100644 --- a/src/mzscheme/cmdline.inc +++ b/src/mzscheme/cmdline.inc @@ -6,9 +6,103 @@ #define SDESC "Set! works on undefined identifiers.\n" char *cmdline_exe_hack = "[Replace me for EXE hack ]"; +char *binary_type_hack = "bINARy tYPe:" INITIAL_BIN_TYPE; #ifdef DOS_FILE_SYSTEM # include +# ifdef MZ_PRECISE_GC +# define DLL_3M_SUFFIX "3m" +# else +# define DLL_3M_SUFFIX "" +# endif +static char *_dlldir = "dLl dIRECTORy:" /* <- this tag stays, so we can find it again */ + ""; +static int _dlldir_offset = 14; /* Skip permanent tag */ + +# ifdef MZ_PRECISE_GC +START_XFORM_SKIP; +# endif + +static void load_delayed_dll(char *lib) +{ + /* Don't use the C library here! */ + char *dlldir = _dlldir + _dlldir_offset; + + if (dlldir[0] != '<') { + if ((dlldir[0] == '\\') + || ((((dlldir[0] >= 'a') && (dlldir[0] <= 'z')) + || ((dlldir[0] >= 'A') && (dlldir[0] <= 'Z'))) + && (dlldir[1] == ':'))) { + /* Absolute path */ + } else { + /* Make it absolute, relative to this module */ + char name[1024], *s; + int j, i; + GetModuleFileName(NULL, name, 1024); + name[1023] = 0; + s = (char *)GlobalAlloc(GMEM_FIXED, 2048); + for (i = 0; name[i]; i++) { } + --i; + while (i && (name[i] != '\\')) { + --i; + } + name[i+1] = 0; + for (i = 0; name[i]; i++) { + s[i] = name[i]; + } + for (j = 0; dlldir[j]; j++, i++) { + s[i] = dlldir[j]; + } + s[i] = 0; + dlldir = s; + _dlldir = s; + _dlldir_offset = 0; + } + + { + char *t; + int j, i; + + t = (char *)GlobalAlloc(GMEM_FIXED, 2048); + for (i = 0; dlldir[i]; i++) { + t[i] = dlldir[i]; + } + if (t[i-1] != '\\') + t[i++] = '\\'; + for (j = 0; lib[j]; j++, i++) { + t[i] = lib[j]; + } + t[i] = 0; + + if (!LoadLibrary(t)) { + MessageBox(NULL, t, "Failure: cannot load DLL", MB_OK); + ExitProcess(1); + } + } + } +} + +extern +# ifdef __cplusplus +"C" +# endif +__declspec(dllexport) void scheme_set_dll_path(char *s); + +static void record_dll_path(void) +{ + if (_dlldir[_dlldir_offset] != '<') { + scheme_set_dll_path(_dlldir + _dlldir_offset); + } +} + +# ifdef MZ_PRECISE_GC +END_XFORM_SKIP; +# endif #endif #ifndef DONT_PARSE_COMMAND_LINE @@ -246,19 +340,23 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) break; } } else if (fa->eval_kind[i] == mzcmd_EVAL) { - save = scheme_current_thread->error_buf; - scheme_current_thread->error_buf = &newbuf; + Scheme_Thread * volatile p; + p = scheme_get_current_thread(); + save = p->error_buf; + p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) scheme_eval_string_all(fa->evals_and_loads[i], fa->global_env, 0); else { exit_val = 1; - scheme_current_thread->error_buf = save; + p->error_buf = save; break; } - scheme_current_thread->error_buf = save; + p->error_buf = save; } else if (fa->eval_kind[i] == mzcmd_MAIN) { - save = scheme_current_thread->error_buf; - scheme_current_thread->error_buf = &newbuf; + Scheme_Thread * volatile p; + p = scheme_get_current_thread(); + save = p->error_buf; + p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) { Scheme_Object *a[1], *m, *fn; @@ -269,10 +367,10 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) (void)scheme_apply(m, 1, a); } else { exit_val = 1; - scheme_current_thread->error_buf = save; + p->error_buf = save; break; } - scheme_current_thread->error_buf = save; + p->error_buf = save; } } } @@ -282,11 +380,13 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) { Scheme_Object *f, *a[1]; mz_jmp_buf * volatile save, newbuf; - save = scheme_current_thread->error_buf; - scheme_current_thread->error_buf = &newbuf; + Scheme_Thread * volatile p; + p = scheme_get_current_thread(); + save = p->error_buf; + p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) { f = scheme_initialize(fa->global_env); - a[0] = scheme_true; + a[0] = scheme_make_true(); f = _scheme_apply_multi(f, 1, a); if (SAME_OBJ(f, SCHEME_MULTIPLE_VALUES) && (scheme_multiple_count == 2)) { @@ -296,7 +396,7 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) } else { exit_val = 1; } - scheme_current_thread->error_buf = save; + p->error_buf = save; } #endif @@ -304,8 +404,10 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) if (!fa->no_rep && !fa->script_mode) { /* enter read-eval-print loop */ mz_jmp_buf * volatile save, newbuf; - save = scheme_current_thread->error_buf; - scheme_current_thread->error_buf = &newbuf; + Scheme_Thread * volatile p; + p = scheme_get_current_thread(); + save = p->error_buf; + p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) { repl(fa->global_env); exit_val = 0; @@ -315,19 +417,21 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) fa->add_yield = 0; #endif } - scheme_current_thread->error_buf = save; + p->error_buf = save; } #endif /* DONT_RUN_REP */ #ifdef VERSION_YIELD_FLAG if (fa->add_yield) { mz_jmp_buf * volatile save, newbuf; - save = scheme_current_thread->error_buf; - scheme_current_thread->error_buf = &newbuf; + Scheme_Thread * volatile p; + p = scheme_get_current_thread(); + save = p->error_buf; + p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) { yield_indefinitely(); } - scheme_current_thread->error_buf = save; + p->error_buf = save; } #endif @@ -338,8 +442,10 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) static void init_collection_paths(Scheme_Env *global_env) { mz_jmp_buf * volatile save, newbuf; - save = scheme_current_thread->error_buf; - scheme_current_thread->error_buf = &newbuf; + Scheme_Thread * volatile p; + p = scheme_get_current_thread(); + save = p->error_buf; + p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) { Scheme_Object *clcp, *flcp, *a[1]; @@ -351,7 +457,7 @@ static void init_collection_paths(Scheme_Env *global_env) _scheme_apply(clcp, 1, a); } } - scheme_current_thread->error_buf = save; + p->error_buf = save; } #endif @@ -359,8 +465,10 @@ static void init_collection_paths(Scheme_Env *global_env) static void init_mred(Scheme_Env *global_env) { mz_jmp_buf * volatile save, newbuf; - save = scheme_current_thread->error_buf; - scheme_current_thread->error_buf = &newbuf; + Scheme_Thread * volatile p; + p = scheme_get_current_thread(); + save = p->error_buf; + p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) { scheme_eval_string("(require (lib \"class.ss\"))", global_env); @@ -369,7 +477,7 @@ static void init_mred(Scheme_Env *global_env) scheme_eval_string("(current-load text-editor-load-handler)", global_env); } - scheme_current_thread->error_buf = save; + p->error_buf = save; } #endif @@ -667,13 +775,13 @@ static int run_from_cmd_line(int argc, char *_argv[], goto show_help; break; case 'g': - scheme_case_sensitive = 1; + scheme_set_case_sensitive(1); break; case 'G': - scheme_case_sensitive = 0; + scheme_set_case_sensitive(0); break; case 's': - scheme_allow_set_undefined = 1; + scheme_set_allow_set_undefined(1); break; case 'e': if (argc < 2) { @@ -848,7 +956,7 @@ static int run_from_cmd_line(int argc, char *_argv[], no_more_switches = 1; break; case 'b': - scheme_binary_mode_stdio = 1; + scheme_set_binary_mode_stdio(1); break; #ifndef MZSCHEME_CMD_LINE case 'Z': @@ -897,7 +1005,7 @@ static int run_from_cmd_line(int argc, char *_argv[], #endif PRINTF(BANNER); #ifdef MZSCHEME_CMD_LINE - if (scheme_allow_set_undefined) + if (scheme_get_allow_set_undefined()) PRINTF(SDESC); # ifdef DOS_FILE_SYSTEM # if !defined(FILES_HAVE_FDS) @@ -916,7 +1024,7 @@ static int run_from_cmd_line(int argc, char *_argv[], global_env = mk_basic_env(); - sch_argv = scheme_make_vector(argc, scheme_null); + sch_argv = scheme_make_vector(argc, NULL); for (i = 0; i < argc; i++) { Scheme_Object *so; so = scheme_make_locale_string(argv[i]); diff --git a/src/mzscheme/include/scheme.h b/src/mzscheme/include/scheme.h index fb609a7f22..0a72a68dad 100644 --- a/src/mzscheme/include/scheme.h +++ b/src/mzscheme/include/scheme.h @@ -1490,12 +1490,20 @@ MZ_EXTERN int scheme_hash_percent_syntax_only; /* Defaults to 0 */ MZ_EXTERN int scheme_hash_percent_globals_only; /* Defaults to 0 */ MZ_EXTERN int scheme_binary_mode_stdio; /* Windows-MacOS-specific. Defaults to 0 */ +MZ_EXTERN void scheme_set_case_sensitive(int); +MZ_EXTERN void scheme_set_allow_set_undefined(int); +MZ_EXTERN void scheme_set_binary_mode_stdio(int); + +MZ_EXTERN int scheme_get_allow_set_undefined(); + MZ_EXTERN Scheme_Thread *scheme_current_thread; MZ_EXTERN Scheme_Thread *scheme_first_thread; /* Set these global hooks (optionally): */ MZ_EXTERN void (*scheme_exit)(int v); -MZ_EXTERN void (*scheme_console_printf)(char *str, ...); +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(); MZ_EXTERN void (*scheme_console_output)(char *str, long len); MZ_EXTERN void (*scheme_sleep)(float seconds, void *fds); MZ_EXTERN void (*scheme_notify_multithread)(int on); @@ -1536,6 +1544,7 @@ MZ_EXTERN int scheme_get_external_event_fd(void); /* image dump enabling startup: */ MZ_EXTERN int scheme_image_main(int argc, char **argv); MZ_EXTERN int (*scheme_actual_main)(int argc, char **argv); +MZ_EXTERN void scheme_set_actual_main(int (*m)(int argc, char **argv)); /* GC registration: */ #ifdef GC_MIGHT_USE_REGISTERED_STATICS diff --git a/src/mzscheme/main.c b/src/mzscheme/main.c index 0d1cc635ab..39f8ce163e 100644 --- a/src/mzscheme/main.c +++ b/src/mzscheme/main.c @@ -105,8 +105,14 @@ extern BOOL WINAPI DllMain(HINSTANCE inst, ULONG reason, LPVOID reserved); static char *get_init_filename(Scheme_Env *env) { Scheme_Object *f; + Scheme_Thread * volatile p; + mz_jmp_buf * volatile save, newbuf; - if (!scheme_setjmp(scheme_error_buf)) { + p = scheme_get_current_thread(); + save = p->error_buf; + p->error_buf = &newbuf; + + if (!scheme_setjmp(newbuf)) { f = scheme_builtin_value("find-system-path"); if (f) { Scheme_Object *a[1]; @@ -115,10 +121,13 @@ static char *get_init_filename(Scheme_Env *env) f = _scheme_apply(f, 1, a); - if (SCHEME_PATHP(f)) + if (SCHEME_PATHP(f)) { + p->error_buf = save; return SCHEME_PATH_VAL(f); + } } } + p->error_buf = save; return NULL; } @@ -141,6 +150,7 @@ extern Scheme_Object *scheme_initialize(Scheme_Env *env); #define PRINTF printf #define PROGRAM "MzScheme" #define PROGRAM_LC "mzscheme" +#define INITIAL_BIN_TYPE "zi" #define BANNER scheme_banner() #define MZSCHEME_CMD_LINE @@ -226,6 +236,16 @@ int MAIN(int argc, MAIN_char **MAIN_argv) char **argv; #endif +#ifdef DOS_FILE_SYSTEM + /* Order matters: load dependencies first */ + load_delayed_dll("msvcr71.dll"); +# ifndef MZ_PRECISE_GC + load_delayed_dll("libmzgcxxxxxxx.dll"); +# endif + load_delayed_dll("libmzsch" DLL_3M_SUFFIX "xxxxxxx.dll"); + record_dll_path(); +#endif + stack_start = (void *)&stack_start; #if defined(MZ_PRECISE_GC) @@ -239,7 +259,7 @@ int MAIN(int argc, MAIN_char **MAIN_argv) oskit_prepare(&argc, &argv); #endif - scheme_actual_main = actual_main; + scheme_set_actual_main(actual_main); #ifdef WINDOWS_UNICODE_MAIN { diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index b8f2aa9f9d..8c93a51f6f 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -46,6 +46,9 @@ /* globals */ int scheme_allow_set_undefined; +void scheme_set_allow_set_undefined(int v) { scheme_allow_set_undefined = v; } +int scheme_get_allow_set_undefined() { return scheme_allow_set_undefined; } + int scheme_starting_up; Scheme_Object *scheme_local[MAX_CONST_LOCAL_POS][2]; diff --git a/src/mzscheme/src/error.c b/src/mzscheme/src/error.c index 49a0724ee2..5366c2edfa 100644 --- a/src/mzscheme/src/error.c +++ b/src/mzscheme/src/error.c @@ -32,7 +32,9 @@ #define TMP_CMARK_VALUE scheme_parameterization_key /* globals */ -void (*scheme_console_printf)(char *str, ...); +scheme_console_printf_t scheme_console_printf; +scheme_console_printf_t scheme_get_console_printf() { return scheme_console_printf; } + void (*scheme_console_output)(char *str, long len); void (*scheme_exit)(int v); diff --git a/src/mzscheme/src/file.c b/src/mzscheme/src/file.c index dc17aa3234..6b60082dbf 100644 --- a/src/mzscheme/src/file.c +++ b/src/mzscheme/src/file.c @@ -4702,126 +4702,34 @@ char *scheme_get_exec_path(void) /********************************************************************************/ -#ifdef MAC_CLASSIC_PROCESS_CONTROL +#ifdef DOS_FILE_SYSTEM -static long check_four(char *name, int which, int argc, Scheme_Object **argv) +static char *dlldir; + +__declspec(dllexport) char *scheme_get_dll_path(char *s); +__declspec(dllexport) void scheme_set_dll_path(char *p); + +char *scheme_get_dll_path(char *s) { - Scheme_Object *o = argv[which]; - - if (!SCHEME_BYTE_STRINGP(o)) - scheme_wrong_type(name, "MacOS type/creator 4-character byte string", which, argc, argv); - - if (SCHEME_BYTE_STRTAG_VAL(o) != 4) { - scheme_raise_exn(MZEXN_FAIL_CONTRACT, - "%s: string is not a 4-character type or creator signature: %V", - name, - o); - } - - return *(long *)SCHEME_BYTE_STR_VAL(o); + if (dlldir) { + int len1, len2; + char *p; + len1 = strlen(dlldir); + len2 = strlen(s); + p = (char *)scheme_malloc_atomic(len1 + len2 + 2); + memcpy(p, dlldir, len1); + if (p[len1 - 1] != '\\') { + p[len1++] = '\\'; + } + memcpy(p + len1, s, len2 + 1); + return p; + } else + return s; } -static int appl_name_to_spec(char *name, int find_path, Scheme_Object *o, FSSpec *spec) +void scheme_set_dll_path(char *p) { - if (find_path) { - HVolumeParam volPB; - HIOParam paramPB; - GetVolParmsInfoBuffer volinfo; - DTPBRec rec; - Str255 nm; - short vrefnum; - long junk; - long creator = check_four(name, 0, 1, &o); - - /* try current volume: */ - scheme_os_setcwd(SCHEME_PATH_VAL(scheme_get_param(scheme_current_config(), - MZCONFIG_CURRENT_DIRECTORY)), - 0); - if (HGetVol(nm, &vrefnum, &junk) == noErr) { - rec.ioNamePtr = NULL; - rec.ioVRefNum = vrefnum; - - if (PBDTGetPath(&rec)) { - rec.ioIndex = 0; - rec.ioNamePtr = nm; - rec.ioFileCreator = creator; - - if (PBDTGetAPPL(&rec, 0)) { - memcpy(spec->name, nm, 32); - spec->vRefNum = vrefnum; - spec->parID = rec.ioAPPLParID; - - return 1; - } - } - } - - volPB.ioNamePtr = NULL; - paramPB.ioNamePtr = NULL; - paramPB.ioBuffer = (Ptr)&volinfo; - paramPB.ioReqCount = sizeof(volinfo); - - /* Loop over all volumes: */ - for (volPB.ioVolIndex = 1; PBHGetVInfoSync ((HParmBlkPtr)&volPB) == noErr; volPB.ioVolIndex++) { - /* Call PBHGetVolParms call to ensure the volume is a local volume. */ - paramPB.ioVRefNum = volPB.ioVRefNum; - - if (PBHGetVolParmsSync ((HParmBlkPtr)¶mPB) == noErr && volinfo.vMServerAdr == 0) { - rec.ioNamePtr = NULL; - rec.ioVRefNum = volPB.ioVRefNum; - - if (PBDTGetPath(&rec)) - break; - - rec.ioIndex = 0; - rec.ioNamePtr = nm; - rec.ioFileCreator = creator; - - if (PBDTGetAPPL(&rec, 0)) - break; - - memcpy(spec->name, nm, 32); - spec->vRefNum = vrefnum; - spec->parID = rec.ioAPPLParID; - - return 1; - } - } - return 0; - } else { - char *s; - - if (!SCHEME_PATH_STRINGP(o)) - scheme_wrong_type(name, SCHEME_PATH_STRING_STR, 0, 1, &o); - - s = scheme_expand_string_filename(o, - name, - NULL, - 0); - - if (!find_mac_file(s, 0, spec, 0, 1, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, 0)) - return 0; - } - - return 1; -} - -int scheme_mac_start_app(char *name, int find_path, Scheme_Object *o) -{ - FSSpec spec; - LaunchParamBlockRec rec; - - if (!appl_name_to_spec(name, find_path, o, &spec)) - return 0; - - rec.launchBlockID = extendedBlock; - rec.launchEPBLength = extendedBlockLen; - rec.launchFileFlags = 0; - rec.launchControlFlags = launchContinue | launchNoFileFlags; - rec.launchAppSpec = &spec; - rec.launchAppParameters = NULL; - - return !LaunchApplication(&rec); + dlldir = p; } #endif diff --git a/src/mzscheme/src/image.c b/src/mzscheme/src/image.c index 692db2cff9..5991538b06 100644 --- a/src/mzscheme/src/image.c +++ b/src/mzscheme/src/image.c @@ -49,6 +49,11 @@ extern void *GC_get_stack_base(); MZ_DLLSPEC int (*scheme_actual_main)(int argc, char **argv); +void scheme_set_actual_main(int (*m)(int argc, char **argv)) +{ + scheme_actual_main = m; +} + #ifdef UNIX_IMAGE_DUMPS static Scheme_Object *(*scheme_dump_heap)(char *filename) = NULL; static Scheme_Object *(*scheme_load_heap)(char *filename, Scheme_Object *argvec) = NULL; diff --git a/src/mzscheme/src/port.c b/src/mzscheme/src/port.c index fc0e51c417..2dd31097b6 100644 --- a/src/mzscheme/src/port.c +++ b/src/mzscheme/src/port.c @@ -255,6 +255,7 @@ Scheme_Object *(*scheme_make_stderr)(void) = NULL; int scheme_file_open_count; MZ_DLLSPEC int scheme_binary_mode_stdio; +void scheme_set_binary_mode_stdio(int v) { scheme_binary_mode_stdio = v; } static int special_is_ok; diff --git a/src/mzscheme/src/schemef.h b/src/mzscheme/src/schemef.h index 46c0da57a7..978a60e545 100644 --- a/src/mzscheme/src/schemef.h +++ b/src/mzscheme/src/schemef.h @@ -75,6 +75,8 @@ MZ_EXTERN Scheme_Thread **scheme_current_thread_ptr; MZ_EXTERN volatile int *scheme_fuel_counter_ptr; #endif +MZ_EXTERN Scheme_Thread *scheme_get_current_thread(); + MZ_EXTERN void scheme_start_atomic(void); MZ_EXTERN void scheme_end_atomic(void); MZ_EXTERN void scheme_end_atomic_no_swap(void); diff --git a/src/mzscheme/src/symbol.c b/src/mzscheme/src/symbol.c index 745e8a9b80..ea1ce91259 100644 --- a/src/mzscheme/src/symbol.c +++ b/src/mzscheme/src/symbol.c @@ -55,6 +55,8 @@ unsigned long scheme_max_found_symbol_name; /* globals */ int scheme_case_sensitive = 1; +void scheme_set_case_sensitive(int v) { scheme_case_sensitive = v; } + /* locals */ static Scheme_Object *symbol_p_prim (int argc, Scheme_Object *argv[]); static Scheme_Object *string_to_symbol_prim (int argc, Scheme_Object *argv[]); diff --git a/src/mzscheme/src/thread.c b/src/mzscheme/src/thread.c index f6ae0eddcb..68db71da4e 100644 --- a/src/mzscheme/src/thread.c +++ b/src/mzscheme/src/thread.c @@ -147,6 +147,8 @@ Scheme_Thread *scheme_current_thread = NULL; Scheme_Thread *scheme_main_thread = NULL; Scheme_Thread *scheme_first_thread = NULL; +Scheme_Thread *scheme_get_current_thread() { return scheme_current_thread; } + typedef struct Scheme_Thread_Set { Scheme_Object so; struct Scheme_Thread_Set *parent; diff --git a/src/worksp-vc70/libmzgc/libmzgc.vcproj b/src/worksp-vc70/libmzgc/libmzgc.vcproj index 7c443cf597..027ef1f760 100644 --- a/src/worksp-vc70/libmzgc/libmzgc.vcproj +++ b/src/worksp-vc70/libmzgc/libmzgc.vcproj @@ -164,9 +164,6 @@ - - diff --git a/src/worksp-vc70/libmzsch/libmzsch.vcproj b/src/worksp-vc70/libmzsch/libmzsch.vcproj index fdda3c31a5..939ddae06f 100644 --- a/src/worksp-vc70/libmzsch/libmzsch.vcproj +++ b/src/worksp-vc70/libmzsch/libmzsch.vcproj @@ -22,7 +22,7 @@ Name="VCCLCompilerTool" Optimization="0" AdditionalIncludeDirectories="..,..\..\mzscheme\include,..\..\mzscheme\src,..\..\foreign\libffi_msvc,$(NOINHERIT)" - PreprocessorDefinitions="WIN32;_DEBUG;_WINDOWS;_USRDLL;GC_DLL;__STDC__" + PreprocessorDefinitions="WIN32;_DEBUG;_WINDOWS;_USRDLL;GC_DLL;__STDC__;LIBMZ_EXPORTS" BasicRuntimeChecks="3" RuntimeLibrary="1" EnableFunctionLevelLinking="TRUE" @@ -74,7 +74,7 @@ EnableIntrinsicFunctions="TRUE" FavorSizeOrSpeed="1" AdditionalIncludeDirectories="..,..\..\mzscheme\include,..\..\mzscheme\src,..\..\foreign\libffi_msvc,$(NOINHERIT)" - PreprocessorDefinitions="WIN32;NDEBUG;_WINDOWS;_USRDLL;GC_DLL;__STDC__" + PreprocessorDefinitions="WIN32;NDEBUG;_WINDOWS;_USRDLL;GC_DLL;__STDC__;LIBMZ_EXPORTS" StringPooling="TRUE" RuntimeLibrary="0" EnableFunctionLevelLinking="TRUE" diff --git a/src/worksp-vc70/mred/mred.vcproj b/src/worksp-vc70/mred/mred.vcproj index 483f0e7b5b..3a69190150 100644 --- a/src/worksp-vc70/mred/mred.vcproj +++ b/src/worksp-vc70/mred/mred.vcproj @@ -38,8 +38,8 @@ Name="VCCustomBuildTool"/> -#include -#include "../../mzscheme/src/schvers.h" - -HMODULE LoadUnicowsProc(void) -{ - /* Try version-mangled name, and if that doesn't work, try xxxxxxx name */ - HMODULE m; - char s[40]; - sprintf(s, "uniplt_%d%d_000000", MZSCHEME_VERSION_MAJOR, MZSCHEME_VERSION_MINOR); - s[14] = '.'; - s[15] = 'd'; - s[16] = 'l'; - s[17] = 'l'; - s[18] = 0; - m = LoadLibraryA(s); - if (!m) - m = LoadLibraryA("uniplt_xxxxxxx.dll"); - return m; -} - -extern FARPROC _PfnLoadUnicows = (FARPROC) &LoadUnicowsProc; +/* Instead of copying the code: */ +#include "../../worksp/mzscheme/uniplt.c" diff --git a/src/worksp/gc2/make.ss b/src/worksp/gc2/make.ss index f0d629dbbc..9b762a8e15 100644 --- a/src/worksp/gc2/make.ss +++ b/src/worksp/gc2/make.ss @@ -137,7 +137,7 @@ mz-inc "xsrc/precomp.h" "" - "" + "/D LIBMZ_EXPORTS " "mz.pch")) srcs) @@ -187,7 +187,7 @@ (define libs "kernel32.lib user32.lib wsock32.lib shell32.lib advapi32.lib") -(define (link-dll objs sys-libs dll link-options exe?) +(define (link-dll objs delayloads sys-libs dll link-options exe?) (let ([ms (if (file-exists? dll) (file-or-directory-modify-seconds dll) 0)]) @@ -196,7 +196,7 @@ (> (file-or-directory-modify-seconds f) ms)) objs) - (unless (system- (format "cl.exe ~a /MT /Zi /Fe~a unicows.lib ~a ~a ~a" + (unless (system- (format "cl.exe ~a /MT /Zi /Fe~a unicows.lib ~a ~a ~a ~a" (if exe? "" "/LD /DLL") dll (let loop ([objs (append objs sys-libs)]) @@ -206,6 +206,14 @@ (car objs) " " (loop (cdr objs))))) + (let loop ([delayloads delayloads]) + (if (null? delayloads) + "" + (string-append + "/DELAYLOAD:" + (car delayloads) + " " + (loop (cdr delayloads))))) libs link-options)) (error 'winmake "~a link failed" (if exe? "EXE" "DLL")))))) @@ -224,13 +232,15 @@ (lambda (n) (format "xsrc/~a.obj" n)) srcs))]) - (link-dll objs null dll "" #f)) + (link-dll objs null null dll "" #f)) (let ([objs (list "xsrc/main.obj" - "../libmzsch/Release/uniplt.obj" + "../mzscheme/Release/uniplt.obj" "../../../libmzsch3mxxxxxxx.lib")]) - (link-dll objs null exe "" #t)) + (link-dll objs + '("msvcrt71.dll" "libmzsch3mxxxxxxx.lib") + null exe "" #t)) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -388,7 +398,7 @@ (string-append wx-inc " -DMZ_PRECISE_GC -DGC2_AS_IMPORT -Dwx_msw")) (let ([objs (append (list - "../libmzsch/Release/uniplt.obj" + "../libmred/Release/uniplt.obj" "xsrc/wxGC.obj" "xsrc/wxJPEG.obj" "xsrc/xcglue.obj") @@ -411,7 +421,7 @@ "gdi32.lib" "comdlg32.lib" "advapi32.lib" "shell32.lib" "ole32.lib" "oleaut32.lib" "winmm.lib")]) - (link-dll (append objs libs) win-libs "../../../libmred3mxxxxxxx.dll" "" #f)) + (link-dll (append objs libs) null win-libs "../../../libmred3mxxxxxxx.dll" "" #f)) (wx-try "mred" "mred" "mrmain" #f "cxx") @@ -423,10 +433,12 @@ (let ([objs (list "mred.res" "xsrc/mrmain.obj" - "../libmzsch/Release/uniplt.obj" + "../mred/Release/uniplt.obj" "../../../libmzsch3mxxxxxxx.lib" "../../../libmred3mxxxxxxx.lib")]) - (link-dll objs (list "advapi32.lib") "../../../MrEd3m.exe" "/link /subsystem:windows" #t)) + (link-dll objs + '("msvcrt71.dll" "libmzsch3mxxxxxxx.lib" "libmred3mxxxxxxx.lib") + (list "advapi32.lib") "../../../MrEd3m.exe" "/link /subsystem:windows" #t)) (system- "cl.exe /MT /O2 /DMZ_PRECISE_GC /I../../mzscheme/include /I.. /c ../../mzscheme/dynsrc/mzdyn.c /Fomzdyn3m.obj") (system- "lib.exe -def:../../mzscheme/dynsrc/mzdyn.def -out:mzdyn3m.lib") diff --git a/src/worksp/libmzgc/libmzgc.vcproj b/src/worksp/libmzgc/libmzgc.vcproj index 29ffd2d451..9d74aff689 100644 --- a/src/worksp/libmzgc/libmzgc.vcproj +++ b/src/worksp/libmzgc/libmzgc.vcproj @@ -178,9 +178,6 @@ - - diff --git a/src/worksp/libmzsch/libmzsch.vcproj b/src/worksp/libmzsch/libmzsch.vcproj index 6cc082c3da..3b6d1924a8 100644 --- a/src/worksp/libmzsch/libmzsch.vcproj +++ b/src/worksp/libmzsch/libmzsch.vcproj @@ -22,7 +22,7 @@ Name="VCCLCompilerTool" Optimization="0" AdditionalIncludeDirectories="..,..\..\mzscheme\include,..\..\mzscheme\src,..\..\foreign\libffi_msvc,$(NOINHERIT)" - PreprocessorDefinitions="WIN32;_DEBUG;_WINDOWS;_USRDLL;GC_DLL;__STDC__" + PreprocessorDefinitions="WIN32;_DEBUG;_WINDOWS;_USRDLL;GC_DLL;__STDC__;LIBMZ_EXPORTS" BasicRuntimeChecks="3" RuntimeLibrary="1" EnableFunctionLevelLinking="TRUE" @@ -80,7 +80,7 @@ EnableIntrinsicFunctions="TRUE" FavorSizeOrSpeed="1" AdditionalIncludeDirectories="..,..\..\mzscheme\include,..\..\mzscheme\src,..\..\foreign\libffi_msvc,$(NOINHERIT)" - PreprocessorDefinitions="WIN32;NDEBUG;_WINDOWS;_USRDLL;GC_DLL;__STDC__" + PreprocessorDefinitions="WIN32;NDEBUG;_WINDOWS;_USRDLL;GC_DLL;__STDC__;LIBMZ_EXPORTS" StringPooling="TRUE" RuntimeLibrary="0" EnableFunctionLevelLinking="TRUE" diff --git a/src/worksp/mred/mred.vcproj b/src/worksp/mred/mred.vcproj index 4bcff54d2e..30b47ae9e5 100644 --- a/src/worksp/mred/mred.vcproj +++ b/src/worksp/mred/mred.vcproj @@ -38,8 +38,8 @@ Name="VCCustomBuildTool"/> #include -#include "../../mzscheme/src/schvers.h" + +#ifdef LIBMZ_EXPORTS +# define MZ_EXTERN extern __declspec(dllexport) +#else +# define MZ_EXTERN extern __declspec(dllimport) +#endif + +MZ_EXTERN char *scheme_get_dll_path(char *); HMODULE LoadUnicowsProc(void) { - /* Try version-mangled name, and if that doesn't work, try xxxxxxx name */ - HMODULE m; - char s[40]; - sprintf(s, "uniplt_%d%d_000000", MZSCHEME_VERSION_MAJOR, MZSCHEME_VERSION_MINOR); - s[14] = '.'; - s[15] = 'd'; - s[16] = 'l'; - s[17] = 'l'; - s[18] = 0; - m = LoadLibraryA(s); - if (!m) - m = LoadLibraryA("uniplt_xxxxxxx.dll"); - return m; + char *s; + + /* Versioning should replace the "xxxxxxx" */ + s = scheme_get_dll_path("uniplt_xxxxxxx.dll"); + + return LoadLibrary(s); } extern FARPROC _PfnLoadUnicows = (FARPROC) &LoadUnicowsProc; diff --git a/src/wxwindow/src/msw/wx_graph_glue.cxx b/src/wxwindow/src/msw/wx_graph_glue.cxx index 95d826d87b..b95b6c0d23 100644 --- a/src/wxwindow/src/msw/wx_graph_glue.cxx +++ b/src/wxwindow/src/msw/wx_graph_glue.cxx @@ -3,7 +3,7 @@ #include "wx_graphics.h" #include -#include "../../../mzscheme/src/schvers.h" +extern "C" __declspec(dllimport) char *scheme_get_dll_path(char *); Bool wx_gdi_plus = FALSE; @@ -223,16 +223,12 @@ void wxInitGraphicsPlus() HMODULE hm; hm = LoadLibrary("gdiplus.dll"); if (hm) { - char s[40]; - sprintf(s, "pltgdi_%d%d_000000", MZSCHEME_VERSION_MAJOR, MZSCHEME_VERSION_MINOR); - s[14] = '.'; - s[15] = 'd'; - s[16] = 'l'; - s[17] = 'l'; - s[18] = 0; - hm = LoadLibraryA(s); - if (!hm) - hm = LoadLibraryA("pltgdi_xxxxxxx.dll"); + char *s; + + /* Versioning will replace the "xxxxxxx" */ + s = scheme_get_dll_path("pltgdi_xxxxxxx.dll"); + + hm = LoadLibrary(s); if (hm) { GetProcs(hm); diff --git a/src/wxwindow/src/msw/wx_main.cxx b/src/wxwindow/src/msw/wx_main.cxx index 6f0dda5523..da251d1d27 100644 --- a/src/wxwindow/src/msw/wx_main.cxx +++ b/src/wxwindow/src/msw/wx_main.cxx @@ -247,7 +247,7 @@ int wxWinMain(int wm_is_mred, } else { char name[1024], *s; int i; - ::GetModuleFileName(hInstance, name, 10923); + ::GetModuleFileName(hInstance, name, 1023); i = strlen(name) - 1; while (i && (name[i] != '\\')) {