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

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

Browse Source 
svn: r1746
This commit is contained in:
Matthew Flatt 2006-01-02 23:09:25 +00:00
parent 3c6a8d5046
commit 5cfb159cae
27 changed files with 317 additions and 243 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/mred/mred.cxx
View File

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

2
src/mred/mred.h
View File

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

48
src/mred/mrmain.cxx
View File

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

168
src/mzscheme/cmdline.inc
View File

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

11
src/mzscheme/include/scheme.h
View File

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

26
src/mzscheme/main.c
View File

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

3
src/mzscheme/src/env.c
View File

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

4
src/mzscheme/src/error.c
View File

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

138
src/mzscheme/src/file.c
View File

@ -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)&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);
dlldir = p;
}
#endif

5
src/mzscheme/src/image.c
View File

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

1
src/mzscheme/src/port.c
View File

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

2
src/mzscheme/src/schemef.h
View File

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

2
src/mzscheme/src/symbol.c
View File

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

2
src/mzscheme/src/thread.c
View File

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

3
src/worksp-vc70/libmzgc/libmzgc.vcproj
View File

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

4
src/worksp-vc70/libmzsch/libmzsch.vcproj
View File

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

8
src/worksp-vc70/mred/mred.vcproj
View File

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

6
src/worksp-vc70/mzscheme/mzscheme.vcproj
View File

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

24
src/worksp-vc70/mzscheme/uniplt.c
View File

@ -1,23 +1,3 @@
#include <windows.h>
#include <stdio.h>
#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"

32
src/worksp/gc2/make.ss
View File

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

3
src/worksp/libmzgc/libmzgc.vcproj
View File

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

4
src/worksp/libmzsch/libmzsch.vcproj
View File

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

8
src/worksp/mred/mred.vcproj
View File

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

6
src/worksp/mzscheme/mzscheme.vcproj
View File

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

28
src/worksp/mzscheme/uniplt.c
View File

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

18
src/wxwindow/src/msw/wx_graph_glue.cxx
View File

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

2
src/wxwindow/src/msw/wx_main.cxx
View File

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