delay-load non-system DLLs in MzScheme and MrEd executables

svn: r1746

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

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"
 

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;
+  p = scheme_get_current_thread();
-  scheme_current_thread->error_buf = &newbuf;
+  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;
+  p = scheme_get_current_thread();
-  scheme_current_thread->error_buf = &newbuf;
+  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_Thread * volatile p;
-   scheme_current_thread->error_buf = &newbuf;
+
+   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;
+  scheme_set_actual_main(actual_main);
-  mred_run_from_cmd_line = run_from_cmd_line;
+  mred_set_run_from_cmd_line(run_from_cmd_line);
-  mred_finish_cmd_line_run = finish_cmd_line_run;
+  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++) {

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 <Windows.h>
+# 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 */
+                       "<DLL Directory: Replace This ***************"
+                       "********************************************"
+                       "********************************************"
+                       "********************************************"
+                       "********************************************"
+                       "********************************************>";
+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_Thread * volatile p;
-	scheme_current_thread->error_buf = &newbuf;
+	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_Thread * volatile p;
-	scheme_current_thread->error_buf = &newbuf;
+	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_Thread * volatile p;
-    scheme_current_thread->error_buf = &newbuf;
+    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_Thread * volatile p;
-    scheme_current_thread->error_buf = &newbuf;
+    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_Thread * volatile p;
-    scheme_current_thread->error_buf = &newbuf;
+    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_Thread * volatile p;
-  scheme_current_thread->error_buf = &newbuf;
+  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_Thread * volatile p;
-  scheme_current_thread->error_buf = &newbuf;
+  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]);

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

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
  {

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

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

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 (dlldir) {
-  
+    int len1, len2;
-  if (!SCHEME_BYTE_STRINGP(o))
+    char *p;
-    scheme_wrong_type(name, "MacOS type/creator 4-character byte string", which, argc, argv);
+    len1 = strlen(dlldir);
-
+    len2 = strlen(s);
-  if (SCHEME_BYTE_STRTAG_VAL(o) != 4) {
+    p = (char *)scheme_malloc_atomic(len1 + len2 + 2);
-    scheme_raise_exn(MZEXN_FAIL_CONTRACT,
+    memcpy(p, dlldir, len1);
-		     "%s: string is not a 4-character type or creator signature: %V",
+    if (p[len1 - 1] != '\\') {
-		     name,
+      p[len1++] = '\\';
-		     o);
     }
-  
+    memcpy(p + len1, s, len2 + 1);
-  return *(long *)SCHEME_BYTE_STR_VAL(o);
+    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) {
+  dlldir = p;
-    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)&paramPB) == 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);
 }
 
 #endif

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;

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;
 

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

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[]);

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;

src/worksp-vc70/libmzgc/libmzgc.vcproj

@@ -164,9 +164,6 @@
                         <File
                                 RelativePath="..\..\Mzscheme\Gc\Stubborn.c">
                         </File>
-                        <File
-                                RelativePath="..\mzscheme\uniplt.c">
-                        </File>
                         <File
                                 RelativePath="..\..\Mzscheme\Gc\win32_threads.c">
                         </File>

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"

src/worksp-vc70/mred/mred.vcproj

@@ -38,8 +38,8 @@
 				Name="VCCustomBuildTool"/>
 			<Tool
 				Name="VCLinkerTool"
-				AdditionalOptions="/MACHINE:I386"
+				AdditionalOptions="/MACHINE:I386 /DELAYLOAD:libmzschxxxxxxx.dll /DELAYLOAD:libmzgcxxxxxxx.dll /DELAYLOAD:libmredxxxxxxx.dll"
-				AdditionalDependencies="Unicows.lib WSock32.lib User32.lib Advapi32.lib"
+				AdditionalDependencies="Unicows.lib WSock32.lib User32.lib Advapi32.lib delayimp.lib"
 				OutputFile="..\..\..\$(ProjectName).exe"
 				ProgramDatabaseFile="..\..\..\$(ProjectName).pdb"
 				LinkIncremental="1"
@@ -88,8 +88,8 @@
 				Name="VCCustomBuildTool"/>
 			<Tool
 				Name="VCLinkerTool"
-				AdditionalOptions="/MACHINE:I386"
+				AdditionalOptions="/MACHINE:I386 /DELAYLOAD:libmzschxxxxxxx.dll /DELAYLOAD:libmzgcxxxxxxx.dll /DELAYLOAD:libmredxxxxxxx.dll"
-				AdditionalDependencies="Unicows.lib WSock32.lib User32.lib Advapi32.lib"
+				AdditionalDependencies="Unicows.lib WSock32.lib User32.lib Advapi32.lib delayimp.lib"
 				OutputFile="..\..\..\$(ProjectName).exe"
 				ProgramDatabaseFile="..\..\..\$(ProjectName).pdb"
 				SuppressStartupBanner="TRUE"

src/worksp-vc70/mzscheme/mzscheme.vcproj

@@ -34,7 +34,8 @@
 				Name="VCCustomBuildTool"/>
 			<Tool
 				Name="VCLinkerTool"
-				AdditionalOptions="/MACHINE:I386"
+				AdditionalOptions="/MACHINE:I386 /DELAYLOAD:libmzschxxxxxxx.dll /DELAYLOAD:libmzgcxxxxxxx.dll"
+				AdditionalDependencies="delayimp.lib"
 				OutputFile="..\..\..\$(ProjectName).exe"
 				ProgramDatabaseFile="..\..\..\$(ProjectName).pdb"
 				SuppressStartupBanner="TRUE"
@@ -96,7 +97,8 @@ cd ..\..\worksp\mzscheme
 				Name="VCCustomBuildTool"/>
 			<Tool
 				Name="VCLinkerTool"
-				AdditionalOptions="/MACHINE:I386"
+				AdditionalOptions="/MACHINE:I386 /DELAYLOAD:libmzschxxxxxxx.dll /DELAYLOAD:libmzgcxxxxxxx.dll"
+				AdditionalDependencies="delayimp.lib"
 				OutputFile="..\..\..\$(ProjectName).exe"
 				ProgramDatabaseFile="..\..\..\$(ProjectName).pdb"
 				LinkIncremental="1"

src/worksp-vc70/mzscheme/uniplt.c

@@ -1,23 +1,3 @@
 
-#include <windows.h>
+/* Instead of copying the code: */
-#include <stdio.h>
+#include "../../worksp/mzscheme/uniplt.c"
-#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;

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

src/worksp/libmzgc/libmzgc.vcproj

@@ -178,9 +178,6 @@
 			<File
 				RelativePath="..\..\Mzscheme\Gc\Stubborn.c">
 			</File>
-			<File
-				RelativePath="..\mzscheme\uniplt.c">
-			</File>
 			<File
 				RelativePath="..\..\Mzscheme\Gc\win32_threads.c">
 			</File>

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"

src/worksp/mred/mred.vcproj

@@ -38,8 +38,8 @@
 				Name="VCCustomBuildTool"/>
 			<Tool
 				Name="VCLinkerTool"
-				AdditionalOptions="/MACHINE:I386"
+				AdditionalOptions="/MACHINE:I386 /DELAYLOAD:libmzschxxxxxxx.dll /DELAYLOAD:libmzgcxxxxxxx.dll"
-				AdditionalDependencies="Unicows.lib WSock32.lib User32.lib Advapi32.lib"
+				AdditionalDependencies="Unicows.lib WSock32.lib User32.lib Advapi32.lib delayimp.lib"
 				OutputFile="..\..\..\$(ProjectName).exe"
 				LinkIncremental="1"
 				SuppressStartupBanner="TRUE"
@@ -94,8 +94,8 @@
 				Name="VCCustomBuildTool"/>
 			<Tool
 				Name="VCLinkerTool"
-				AdditionalOptions="/MACHINE:I386"
+				AdditionalOptions="/MACHINE:I386 /DELAYLOAD:libmzschxxxxxxx.dll /DELAYLOAD:libmzgcxxxxxxx.dll"
-				AdditionalDependencies="Unicows.lib WSock32.lib User32.lib Advapi32.lib"
+				AdditionalDependencies="Unicows.lib WSock32.lib User32.lib Advapi32.lib delayimp.lib"
 				OutputFile="..\..\..\$(ProjectName).exe"
 				SuppressStartupBanner="TRUE"
 				IgnoreDefaultLibraryNames="libcd.lib"

src/worksp/mzscheme/mzscheme.vcproj

@@ -34,7 +34,8 @@
 				Name="VCCustomBuildTool"/>
 			<Tool
 				Name="VCLinkerTool"
-				AdditionalOptions="/MACHINE:I386"
+				AdditionalOptions="/MACHINE:I386 /DELAYLOAD:libmzschxxxxxxx.dll /DELAYLOAD:libmzgcxxxxxxx.dll"
+				AdditionalDependencies="delayimp.lib"
 				OutputFile="..\..\..\$(ProjectName).exe"
 				SuppressStartupBanner="TRUE"
 				GenerateDebugInformation="TRUE"
@@ -102,7 +103,8 @@ cd ..\..\worksp\mzscheme
 				Name="VCCustomBuildTool"/>
 			<Tool
 				Name="VCLinkerTool"
-				AdditionalOptions="/MACHINE:I386"
+				AdditionalOptions="/MACHINE:I386 /DELAYLOAD:libmzschxxxxxxx.dll /DELAYLOAD:libmzgcxxxxxxx.dll"
+				AdditionalDependencies="delayimp.lib"
 				OutputFile="..\..\..\$(ProjectName).exe"
 				LinkIncremental="1"
 				SuppressStartupBanner="TRUE"

src/worksp/mzscheme/uniplt.c

@@ -1,23 +1,23 @@
 
 #include <windows.h>
 #include <stdio.h>
-#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 */
+  char *s;
-  HMODULE m;
+
-  char s[40];
+  /* Versioning should replace the "xxxxxxx" */
-  sprintf(s, "uniplt_%d%d_000000", MZSCHEME_VERSION_MAJOR, MZSCHEME_VERSION_MINOR);
+  s = scheme_get_dll_path("uniplt_xxxxxxx.dll");
-  s[14] = '.';
+
-  s[15] = 'd';
+  return LoadLibrary(s);
-  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;

src/wxwindow/src/msw/wx_graph_glue.cxx

@@ -3,7 +3,7 @@
 #include "wx_graphics.h"
 #include <gdiplus.h>
 
-#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];
+    char *s;
-    sprintf(s, "pltgdi_%d%d_000000", MZSCHEME_VERSION_MAJOR, MZSCHEME_VERSION_MINOR);
+
-    s[14] = '.';
+    /* Versioning will replace the "xxxxxxx" */
-    s[15] = 'd';
+    s = scheme_get_dll_path("pltgdi_xxxxxxx.dll");
-    s[16] = 'l';
+
-    s[17] = 'l';
+    hm = LoadLibrary(s);
-    s[18] = 0;
-    hm = LoadLibraryA(s);
-    if (!hm)
-      hm = LoadLibraryA("pltgdi_xxxxxxx.dll");
     
     if (hm) {
       GetProcs(hm);

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] != '\\')) {