diff --git a/src/mred/mrmain.cxx b/src/mred/mrmain.cxx index 883af50381..1dec62ac1a 100644 --- a/src/mred/mrmain.cxx +++ b/src/mred/mrmain.cxx @@ -50,13 +50,6 @@ int wx_in_terminal; /* dummy */ # endif #endif -#ifdef MPW_CPLUS -extern "C" { typedef int (*ACTUAL_MAIN_PTR)(int argc, char **argv); } -# define CAST_ACTUAL_MAIN (ACTUAL_MAIN_PTR) -#else -# define CAST_ACTUAL_MAIN /* empty */ -#endif - #ifdef wx_msw /* Hack: overwrite "y" with "n" in binary to disable checking for another instance of the same app. */ @@ -237,21 +230,6 @@ static void run_from_cmd_line(int argc, char **argv, Scheme_Env *(*mk_basic_env) run_from_cmd_line(argc, argv, mk_basic_env, do_main_loop); } -int actual_main(int argc, char **argv) -{ - int r; - - wxCreateApp(); - - r = wxEntry(argc, argv); - -#ifdef wx_msw - mred_clean_up_gdi_objects(); -#endif - - return r; -} - static int main_after_stack(int argc, char *argv[]) { int rval; @@ -280,15 +258,17 @@ static int main_after_stack(int argc, char *argv[]) wxDrop_GetArgs(&argc, &argv, &wx_in_terminal); #endif - 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); + wxCreateApp(); + + rval = wxEntry(argc, argv); - /* This line ensures that __gc_var_stack__ is the - val of GC_variable_stack in scheme_image_main. */ - argv = NULL; +#ifdef wx_msw + mred_clean_up_gdi_objects(); +#endif + return rval; } diff --git a/src/mzscheme/Makefile.in b/src/mzscheme/Makefile.in index 4cd06701f0..7790b4ece7 100644 --- a/src/mzscheme/Makefile.in +++ b/src/mzscheme/Makefile.in @@ -341,3 +341,8 @@ unix-cygwin-install-3m: unix-cygwin-install-3m-final: $(MAKE) unix-install-3m-final + +# Generate plt-gdbinit ---------------------------------------- + +mz-gdbinit: $(srcdir)/mk-gdbinit.ss $(srcdir)/src/stypes.h + mzscheme $(srcdir)/mk-gdbinit.ss diff --git a/src/mzscheme/gc2/Makefile.in b/src/mzscheme/gc2/Makefile.in index 9f3cd80bad..d71a9ab827 100644 --- a/src/mzscheme/gc2/Makefile.in +++ b/src/mzscheme/gc2/Makefile.in @@ -47,7 +47,6 @@ OBJS = salloc.@LTO@ \ file.@LTO@ \ fun.@LTO@ \ hash.@LTO@ \ - image.@LTO@ \ jit.@LTO@ \ list.@LTO@ \ module.@LTO@ \ @@ -91,7 +90,6 @@ XSRCS = $(XSRCDIR)/salloc.c \ $(XSRCDIR)/file.c \ $(XSRCDIR)/fun.c \ $(XSRCDIR)/hash.c \ - $(XSRCDIR)/image.c \ $(XSRCDIR)/jit.c \ $(XSRCDIR)/list.c \ $(XSRCDIR)/module.c \ @@ -164,8 +162,6 @@ $(XSRCDIR)/fun.c: ../src/fun.@LTO@ $(XFORMDEP) $(XFORM) $(XSRCDIR)/fun.c $(SRCDIR)/fun.c $(XSRCDIR)/hash.c: ../src/hash.@LTO@ $(XFORMDEP) $(XFORM) $(XSRCDIR)/hash.c $(SRCDIR)/hash.c -$(XSRCDIR)/image.c: ../src/image.@LTO@ $(XFORMDEP) - $(XFORM) $(XSRCDIR)/image.c $(SRCDIR)/image.c $(XSRCDIR)/jit.c: ../src/jit.@LTO@ $(XFORMDEP) $(XFORM) $(XSRCDIR)/jit.c $(SRCDIR)/jit.c $(XSRCDIR)/module.c: ../src/module.@LTO@ $(XFORMDEP) @@ -246,8 +242,6 @@ fun.@LTO@: $(XSRCDIR)/fun.c $(CC) $(CFLAGS) -c $(XSRCDIR)/fun.c -o fun.@LTO@ hash.@LTO@: $(XSRCDIR)/hash.c $(CC) $(CFLAGS) -c $(XSRCDIR)/hash.c -o hash.@LTO@ -image.@LTO@: $(XSRCDIR)/image.c - $(CC) $(CFLAGS) -c $(XSRCDIR)/image.c -o image.@LTO@ jit.@LTO@: $(XSRCDIR)/jit.c $(CC) $(CFLAGS) -c $(XSRCDIR)/jit.c -o jit.@LTO@ list.@LTO@: $(XSRCDIR)/list.c diff --git a/src/mzscheme/include/scheme.h b/src/mzscheme/include/scheme.h index f166883a63..086b77c924 100644 --- a/src/mzscheme/include/scheme.h +++ b/src/mzscheme/include/scheme.h @@ -1703,11 +1703,6 @@ MZ_EXTERN void scheme_check_threads(void); MZ_EXTERN void scheme_wake_up(void); 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: */ MZ_EXTERN void scheme_set_stack_base(void *base, int no_auto_statics); MZ_EXTERN void scheme_set_stack_bounds(void *base, void *deepest, int no_auto_statics); diff --git a/src/mzscheme/main.c b/src/mzscheme/main.c index ffd557edf1..06e593fbea 100644 --- a/src/mzscheme/main.c +++ b/src/mzscheme/main.c @@ -196,7 +196,6 @@ static void user_break_hit(int ignore) /* Forward declarations: */ static void do_scheme_rep(Scheme_Env *); static int cont_run(FinishArgs *f); -int actual_main(int argc, char *argv[]); #if defined(WINDOWS_UNICODE_SUPPORT) && !defined(__CYGWIN32__) # define MAIN wmain @@ -254,7 +253,7 @@ static int main_after_dlls(int argc, MAIN_char **argv) } /************************ main_after_stack *************************/ -/* Phase 1 setup, then call actual_main (indirectly) */ +/* Setup, parse command-line, and go to cont_run */ static int main_after_stack(void *data) { @@ -272,8 +271,6 @@ static int main_after_stack(void *data) oskit_prepare(&argc, &argv); #endif - scheme_set_actual_main(actual_main); - #ifdef WINDOWS_UNICODE_MAIN { char *a; @@ -295,34 +292,20 @@ static int main_after_stack(void *data) } #endif - rval = scheme_image_main(argc, argv); /* calls actual_main */ - - /* This line ensures that __gc_var_stack__ is the - val of GC_variable_stack in scheme_image_main. */ - argv = NULL; - return rval; -} - - -/************************* actual_main *****************************/ -/* Phase 2 setup, then parse command-line and go to cont_run */ - -int actual_main(int argc, char *argv[]) -{ - int exit_val; - #ifndef NO_USER_BREAK_HANDLER MZ_SIGSET(SIGINT, user_break_hit); #endif - exit_val = run_from_cmd_line(argc, argv, scheme_basic_env, cont_run); + rval = run_from_cmd_line(argc, argv, scheme_basic_env, cont_run); - scheme_immediate_exit(exit_val); - return exit_val; /* shouldn't happen! */ + scheme_immediate_exit(rval); + + /* shouldn't get here */ + return rval; } -/************************* cont_run *****************************/ -/* Phase 3 setup (none), then go to do_scheme_rep */ +/************************* cont_run ******************************/ +/* Go to do_scheme_rep */ static int cont_run(FinishArgs *f) { @@ -330,7 +313,7 @@ static int cont_run(FinishArgs *f) } /************************* do_scheme_rep *****************************/ -/* Finally, do a read-eval-print-loop */ +/* Finally, do a read-eval-print-loop */ static void do_scheme_rep(Scheme_Env *env) { diff --git a/src/mzscheme/mk-gdbinit.ss b/src/mzscheme/mk-gdbinit.ss new file mode 100644 index 0000000000..a8ae9099e7 --- /dev/null +++ b/src/mzscheme/mk-gdbinit.ss @@ -0,0 +1,258 @@ +#lang scheme/base + +;; This script generates "mz-gdbinit" to the current directory. +;; It's normally run via `make mz-gdbinit', in which case +;; putting +;; source mz-gdbinit +;; in your "~/.gdbinit" file causes it to be loaded. + +;; The "mz-gdbinit" file is generated so that it can use specific +;; type-tag constants from "stypes.h", in case the debugging info +;; can't see them. If "stypes.h" changes, then "mz-gdbinit" needs +;; to be re-built. + +(require scheme/runtime-path) + +(define-runtime-path stypes-path "src/stypes.h") + +(define template #< 0 + printf " " + set $i = $i - 1 + end +end + +define psox + set $O = ((Scheme_Object*) ($arg0)) + indent $arg1 + if (((int)$arg0) & 0x1) + set $OT = <> + else + set $OT = $O->type + end + printf "Scheme_Object %p type=%d\n", $O, $OT + indent $arg1 + psoq $O $arg1 +end + +define psoq +indent $arg1 +if (((int)$arg0) & 0x1) + printf "fixnum %d", (((int)$arg0) >> 1) +else + set $O = ((Scheme_Object*) ($arg0)) + set $OT = $O->type + if ( $OT == <> ) + set $TL = ((Scheme_Toplevel*) ($O)) + printf "scheme_toplevel_type depth=%d position=%d", $TL->depth, $TL->position + end + if ( $OT == <> ) + set $SSO = ((Scheme_Simple_Object*) ($O)) + set $index = $SSO->u.ptr_int_val.pint + set $object = (Scheme_Object *) $SSO->u.ptr_int_val.ptr + printf "scheme_syntax_type index=%d\n", $index + pso $object $arg1+1 + end + if ( $OT == <> ) + printf "scheme_application2_type\n" + set $AP = ((Scheme_App2_Rec*) ($O)) + set $RATOR = $AP->rator + set $RAND = $AP->rand + indent $arg1 + printf "rator=" + pso $RATOR $arg1+1 + indent $arg1 + printf "rand=" + pso $RAND $arg1+1 + end + if ( $OT == <> ) + printf "scheme_sequence\n" + set $seq = ((Scheme_Sequence *) $O) + p *$seq + set $size = $seq->count + set $cnt = 0 + while ( $cnt < $size ) + p $cnt + p $seq->array[$cnt] + pso $seq->array[$cnt] $arg1+1 + set $cnt++ + end + $OT = 0 + end + if ( $OT == <> ) + printf "scheme_prim_type\n" + set $pproc = ((Scheme_Primitive_Proc *) $O) + p *$pproc + end + if ( $OT == <> ) + printf "scheme_closure_type\n" + set $closure = ((Scheme_Closure *) $O) + p *$closure + set $code = $closure->code + printf "scheme_closure_type code1\n" + p *$code + set $name = $code->name + p *$name + #pso $name $arg+1 + printf "scheme_closure_type code2\n" + pso $code->code $arg+1 + $OT = <> + end + if ( $OT == <>) + printf "scheme_structure_type\n" + end + if ( $OT == <>) + printf "scheme_unix_path_type" + p (char *)((Scheme_Simple_Object *)$O)->u.byte_str_val.string_val + end + if ( $OT == <> ) + printf "scheme_symbol_type %s %p", (char *)((Scheme_Symbol*) $O)->s, $O + end + if ( $OT == <> ) + printf "scheme_null" + end + if ( $OT == <> ) + printf "scheme_pair\n" + set $SSO = ((Scheme_Simple_Object*) ($O)) + set $CAR = $SSO->u.pair_val.car + set $CDR = $SSO->u.pair_val.cdr + indent $arg1 + printf "car=\n" + pso $CAR $arg1+1 + indent $arg1 + printf "cdr=\n" + pso $CDR $arg1+1 + end + if ( $OT == <> ) + set $vector = ((struct Scheme_Vector *) $O) + set $size = $vector->size + printf "scheme_vector_type size=%d\n", $size + set $cnt = 0 + while ( $cnt < $size ) + p $cnt + pso $vector->els[$cnt] $arg1+1 + set $cnt++ + end + end + if ( $OT == <> ) + printf "scheme_true" + end + if ( $OT == <> ) + printf "scheme_false" + end + if ( $OT == <> ) + printf "scheme_void" + end + if ( $OT == <> ) + psht $O $arg1 + end + if ( $OT == <> ) + printf "scheme_module_index_type\n" + set $modidx = ((Scheme_Modidx *) $O) + indent $arg1 + printf "path=" + pso $modidx->path $arg1+1 + indent $arg1 + printf "base=" + pso $modidx->base $arg1+1 + indent $arg1 + printf "resolved=" + pso $modidx->resolved $arg1+1 + end + if ( $OT == <>) + printf "scheme_namespace_type\n" + set $env = ((Scheme_Env*)$O) + if ($env->module != 0) + pso $env->module $arg1+1 + else + indent $arg1 + printf "top-level\n" + end + end + if ( $OT == <> ) + printf "scheme_stx_type\n" + set $stx = ((Scheme_Stx*) $O) + p *$stx + indent $arg1 + printf "content=" + pso $stx->val $arg1+1 + set $srcloc = $stx->srcloc + set $name = ($stx->srcloc->src) + set $name = (char *)((Scheme_Simple_Object *)$name)->u.byte_str_val.string_val + indent $arg1 + printf "%s:%i:%i\n", $name, $srcloc->line, $srcloc->col + end + if ( $OT == <>) + printf "scheme_compilation_top_type\n" + set $top = ((Scheme_Compilation_Top*)$O) + p *$top + pso $top->code $arg1+1 + end + if ( $OT == <>) + printf "scheme_module_type\n" + set $module = ((Scheme_Module*)$O) + pso $module->modname $arg1+1 + end + if ( $OT == <>) + set $OO = (((Scheme_Small_Object *)$arg0)->u.ptr_val) + printf "scheme_resolved_module_path_type %s %p", (char *)((Scheme_Symbol*) $OO)->s, $OO + end +end +printf "\n" +end +document psoq +print scheme object quiet +end + +define psht + set $ht= ((struct Scheme_Hash_Table *) $arg0) + set $size = $ht->size + printf "scheme_hash_table_type size=%d count=%d\n", $size, $ht->count + set $cnt = 0 + while ( $cnt < $size ) + set $item = $ht->vals[$cnt] + if ($item != 0) + set $item = $ht->keys[$cnt] + indent $arg1 + printf "key=\n" + psoq $item $arg1+1 + set $item = $ht->vals[$cnt] + indent $arg1 + printf "val=\n" + psoq $item $arg1+1 + end + set $cnt++ + end +end +document psht +print scheme hash table +end +EOS +) + +(define styles (with-input-from-file stypes-path + (lambda () (read-string (* 2 (file-size stypes-path)))))) + +(call-with-output-file* "mz-gdbinit" + #:exists 'truncate + (lambda (out) + (let ([in (open-input-string template)]) + (let loop () + (let ([m (regexp-match #rx"<<([^>]*)>>" in 0 #f out)]) + (when m + (let ([m2 (regexp-match (format "~a, */[*] ([0-9]+) [*]/" (cadr m)) + styles)]) + (if m2 + (display (cadr m2) out) + (error 'mk-gdbinit "cannot find type in stypes.h: ~e" (cadr m)))) + (loop))))) + (newline out))) diff --git a/src/mzscheme/src/Makefile.in b/src/mzscheme/src/Makefile.in index 2c5db12190..9c4f350aa0 100644 --- a/src/mzscheme/src/Makefile.in +++ b/src/mzscheme/src/Makefile.in @@ -26,7 +26,6 @@ OBJS = salloc.@LTO@ \ fun.@LTO@ \ gmp.@LTO@ \ hash.@LTO@ \ - image.@LTO@ \ jit.@LTO@ \ list.@LTO@ \ module.@LTO@ \ @@ -66,7 +65,6 @@ SRCS = $(srcdir)/salloc.c \ $(srcdir)/fun.c \ $(srcdir)/gmp/gmp.c \ $(srcdir)/hash.c \ - $(srcdir)/image.c \ $(srcdir)/jit.c \ $(srcdir)/list.c \ $(srcdir)/module.c \ @@ -170,8 +168,6 @@ gmp.@LTO@: $(srcdir)/gmp/gmp.c $(srcdir)/gmp/gmplonglong.h $(CC) $(CFLAGS) -c $(srcdir)/gmp/gmp.c -o gmp.@LTO@ hash.@LTO@: $(srcdir)/hash.c $(CC) $(CFLAGS) -c $(srcdir)/hash.c -o hash.@LTO@ -image.@LTO@: $(srcdir)/image.c - $(CC) $(CFLAGS) -c $(srcdir)/image.c -o image.@LTO@ jit.@LTO@: $(srcdir)/jit.c $(CC) $(CFLAGS) -c $(srcdir)/jit.c -o jit.@LTO@ list.@LTO@: $(srcdir)/list.c diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 63e2747a26..84b65a41fd 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -168,7 +168,6 @@ static Scheme_Object *top_expander; static Scheme_Object *stop_expander; static Scheme_Object *quick_stx; -static int taking_shortcut; Scheme_Object *scheme_stack_dump_key; @@ -4634,6 +4633,7 @@ void scheme_init_compile_recs(Scheme_Compile_Info *src, int drec, dest[i].certs = src[drec].certs; /* should be always NULL */ dest[i].observer = src[drec].observer; + dest[i].pre_unwrapped = 0; } } @@ -4651,6 +4651,7 @@ void scheme_init_expand_recs(Scheme_Expand_Info *src, int drec, dest[i].value_name = scheme_false; dest[i].certs = src[drec].certs; dest[i].observer = src[drec].observer; + dest[i].pre_unwrapped = 0; } } @@ -4672,6 +4673,7 @@ void scheme_init_lambda_rec(Scheme_Compile_Info *src, int drec, lam[dlrec].value_name = scheme_false; lam[dlrec].certs = src[drec].certs; lam[dlrec].observer = src[drec].observer; + lam[dlrec].pre_unwrapped = 0; } void scheme_merge_lambda_rec(Scheme_Compile_Info *src, int drec, @@ -4918,6 +4920,7 @@ static void *compile_k(void) rec.value_name = scheme_false; rec.certs = NULL; rec.observer = NULL; + rec.pre_unwrapped = 0; cenv = scheme_new_comp_env(genv, insp, SCHEME_TOPLEVEL_FRAME); @@ -5556,7 +5559,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env, } else if (rec[drec].comp && SAME_OBJ(var, normal) && !rec[drec].observer) { /* Skip creation of intermediate form */ Scheme_Syntax *f; - taking_shortcut = 1; + rec[drec].pre_unwrapped = 1; f = (Scheme_Syntax *)SCHEME_SYNTAX(var); if (can_recycle_stx && !quick_stx) quick_stx = can_recycle_stx; @@ -5678,9 +5681,10 @@ compile_expand_app(Scheme_Object *forms, Scheme_Comp_Env *env, Scheme_Compile_Expand_Info *rec, int drec) { Scheme_Object *form, *naya; - int tsc = taking_shortcut; + int tsc; - taking_shortcut = 0; + tsc = rec[drec].pre_unwrapped; + rec[drec].pre_unwrapped = 0; scheme_rec_add_certs(rec, drec, forms); if (tsc) { @@ -5907,9 +5911,9 @@ datum_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec { Scheme_Object *c, *v; - if (taking_shortcut) { + if (rec[drec].pre_unwrapped) { c = form; - taking_shortcut = 0; + rec[drec].pre_unwrapped = 0; } else { c = SCHEME_STX_CDR(form); /* Need datum->syntax, in case c is a list: */ @@ -5947,13 +5951,13 @@ datum_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec 0, 2); } -static Scheme_Object *check_top(const char *when, Scheme_Object *form, Scheme_Comp_Env *env) +static Scheme_Object *check_top(const char *when, Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec) { Scheme_Object *c; - if (taking_shortcut) { + if (rec[drec].pre_unwrapped) { c = form; - taking_shortcut = 0; + rec[drec].pre_unwrapped = 0; } else c = SCHEME_STX_CDR(form); @@ -6009,7 +6013,7 @@ top_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, { Scheme_Object *c; - c = check_top(scheme_compile_stx_string, form, env); + c = check_top(scheme_compile_stx_string, form, env, rec, drec); c = scheme_tl_id_sym(env->genv, c, NULL, 0, NULL); @@ -6031,7 +6035,7 @@ static Scheme_Object * top_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec) { SCHEME_EXPAND_OBSERVE_PRIM_TOP(erec[drec].observer); - check_top(scheme_expand_stx_string, form, env); + check_top(scheme_expand_stx_string, form, env, erec, drec); return form; } @@ -8757,6 +8761,7 @@ static void *expand_k(void) erec1.value_name = scheme_false; erec1.certs = certs; erec1.observer = observer; + erec1.pre_unwrapped = 0; if (catch_lifts_key) scheme_frame_captures_lifts(env, scheme_make_lifted_defn, scheme_sys_wraps(env), scheme_false, catch_lifts_key); @@ -9576,13 +9581,13 @@ local_eval(int argc, Scheme_Object **argv) stx_env->in_modidx = scheme_current_thread->current_local_modidx; if (!SCHEME_FALSEP(expr)) { - Scheme_Compile_Expand_Info rec; rec.comp = 0; rec.depth = -1; rec.value_name = scheme_false; rec.certs = certs; rec.observer = observer; + rec.pre_unwrapped = 0; /* Evaluate and bind syntaxes */ expr = scheme_add_remove_mark(expr, scheme_current_thread->current_local_mark); diff --git a/src/mzscheme/src/image.c b/src/mzscheme/src/image.c deleted file mode 100644 index a39ec5d021..0000000000 --- a/src/mzscheme/src/image.c +++ /dev/null @@ -1,45 +0,0 @@ -/* - MzScheme - Copyright (c) 2004-2008 PLT Scheme Inc. - Copyright (c) 1995-2001 Matthew Flatt - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either - version 2 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - You should have received a copy of the GNU Library General Public - License along with this library; if not, write to the Free - Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - Boston, MA 02110-1301 USA. - - libscheme - Copyright (c) 1994 Brent Benson - All rights reserved. -*/ - -/* Images are long since unsupported, so all that's left is this - little trampoline. */ - -#include "schpriv.h" - -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; -} - -int scheme_image_main(int argc, char **argv) -{ - return scheme_actual_main(argc, argv); -} - -void scheme_no_dumps(char *why) -{ -} diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index 548a525fbf..11cfaa6afb 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -5782,6 +5782,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, erec1.value_name = scheme_false; erec1.certs = rec[drec].certs; erec1.observer = rec[drec].observer; + erec1.pre_unwrapped = 0; e = scheme_expand_expr(e, xenv, &erec1, 0); } @@ -5983,6 +5984,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, mrec.value_name = NULL; mrec.certs = rec[drec].certs; mrec.observer = NULL; + mrec.pre_unwrapped = 0; if (!rec[drec].comp) { Scheme_Expand_Info erec1; @@ -5991,6 +5993,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, erec1.value_name = boundname; erec1.certs = rec[drec].certs; erec1.observer = rec[drec].observer; + erec1.pre_unwrapped = 0; SCHEME_EXPAND_OBSERVE_PHASE_UP(observer); code = scheme_expand_expr_lift_to_let(code, eenv, &erec1, 0); } diff --git a/src/mzscheme/src/port.c b/src/mzscheme/src/port.c index d58f9c30fd..dc1d6d57fb 100644 --- a/src/mzscheme/src/port.c +++ b/src/mzscheme/src/port.c @@ -634,6 +634,10 @@ Scheme_Object * scheme_make_eof (void) return scheme_eof; } +void scheme_no_dumps(char *why) +{ +} + /*========================================================================*/ /* fd arrays */ /*========================================================================*/ diff --git a/src/mzscheme/src/portfun.c b/src/mzscheme/src/portfun.c index 979bb80e1b..da8171c61e 100644 --- a/src/mzscheme/src/portfun.c +++ b/src/mzscheme/src/portfun.c @@ -1364,6 +1364,7 @@ user_get_or_peek_bytes(Scheme_Input_Port *port, } else { char *vb; vb = scheme_malloc_atomic(size + 1); + memset(vb, size + 1, 0); /* must initialize for security */ bstr = scheme_make_sized_byte_string(vb, size, 0); } a[0] = bstr; diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index ff119363c9..10491eae9b 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -1775,6 +1775,7 @@ typedef struct Scheme_Compile_Expand_Info Scheme_Object *observer; char dont_mark_local_use; char resolve_module_ids; + char pre_unwrapped; int depth; } Scheme_Compile_Expand_Info; diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c index 06dd3067be..0f8b0fde21 100644 --- a/src/mzscheme/src/syntax.c +++ b/src/mzscheme/src/syntax.c @@ -5371,6 +5371,7 @@ do_define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, rec1.value_name = NULL; rec1.certs = rec[drec].certs; rec1.observer = NULL; + rec1.pre_unwrapped = 0; if (for_stx) { names = defn_targets_syntax(names, exp_env, &rec1, 0); @@ -5561,6 +5562,7 @@ void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object mrec.value_name = NULL; mrec.certs = certs; mrec.observer = NULL; + mrec.pre_unwrapped = 0; a = scheme_compile_expr_lift_to_let(a, eenv, &mrec, 0); diff --git a/src/worksp/gc2/make.ss b/src/worksp/gc2/make.ss index 975855a526..7345d6e609 100644 --- a/src/worksp/gc2/make.ss +++ b/src/worksp/gc2/make.ss @@ -36,7 +36,6 @@ "file" "fun" "hash" - "image" "jit" "list" "module" diff --git a/src/worksp/libmzsch/libmzsch.vcproj b/src/worksp/libmzsch/libmzsch.vcproj index 117e91b53d..3d926172d8 100644 --- a/src/worksp/libmzsch/libmzsch.vcproj +++ b/src/worksp/libmzsch/libmzsch.vcproj @@ -254,10 +254,6 @@ RelativePath="..\..\Mzscheme\Src\Hash.c" > - -