From 396dd54b060ce9e21bff412258bd4ee1cd597bc9 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 22 Dec 2007 12:41:48 +0000 Subject: [PATCH] call-with-exception-handler change, plus some configure/Makefile changes that didn't help fix the built-on-10.5-for-10.4 problem but are still healthier in the long run svn: r8102 --- collects/drscheme/private/module-language.ss | 6 +- collects/scheme/private/more-scheme.ss | 12 ++- collects/scheme/private/stxcase-scheme.ss | 2 + collects/scribblings/reference/exns.scrbl | 16 ++-- src/configure | 6 +- src/mzscheme/Makefile.in | 4 +- src/mzscheme/cmdline.inc | 83 ++++++++++++++++++++ src/mzscheme/configure.ac | 6 +- src/mzscheme/gc2/Makefile.in | 4 +- src/mzscheme/gc2/vm_osx.c | 64 +++++++++++++-- src/wxcommon/PSDC.cxx | 5 -- src/wxmac/src/base/wb_main.cc | 1 + 12 files changed, 170 insertions(+), 39 deletions(-) diff --git a/collects/drscheme/private/module-language.ss b/collects/drscheme/private/module-language.ss index 48a3199009..da95128f06 100644 --- a/collects/drscheme/private/module-language.ss +++ b/collects/drscheme/private/module-language.ss @@ -214,10 +214,10 @@ (list (list #f program-filename)) null null - (list (if gui? "-Zmvqe-" "-mvqe-") - (format "~s" `(require ,(string->symbol (path->string short-program-name))))))))) + (list "-nqe-" + (format "~s" `(#%require ',(string->symbol (path->string short-program-name))))))))) (let ([make-launcher (if gui? make-mred-launcher make-mzscheme-launcher)]) - (make-launcher (list "-mvqt-" (path->string program-filename)) + (make-launcher (list "-qt-" (path->string program-filename)) executable-filename)))))))) (super-new diff --git a/collects/scheme/private/more-scheme.ss b/collects/scheme/private/more-scheme.ss index 49f3350bcc..8736d3c2ac 100644 --- a/collects/scheme/private/more-scheme.ss +++ b/collects/scheme/private/more-scheme.ss @@ -258,10 +258,14 @@ (values (wh #t) (wh #f)))) (define (call-with-exception-handler exnh thunk) - (with-continuation-mark - exception-handler-key - exnh - (thunk))) + ;; The `begin0' ensures that we don't overwrite an enclosing + ;; exception handler. + (begin0 + (with-continuation-mark + exception-handler-key + exnh + (thunk)) + (void))) (define-syntax set!-values (lambda (stx) diff --git a/collects/scheme/private/stxcase-scheme.ss b/collects/scheme/private/stxcase-scheme.ss index 0b89f43ef9..53a1b545c9 100644 --- a/collects/scheme/private/stxcase-scheme.ss +++ b/collects/scheme/private/stxcase-scheme.ss @@ -9,6 +9,8 @@ "stxloc.ss")) (-define (check-duplicate-identifier names) + (unless (and (list? names) (andmap identifier? names)) + (raise-type-error 'check-duplicate-identifier "list of identifiers" names)) (let/ec escape (let ([ht (make-hash-table)]) (for-each diff --git a/collects/scribblings/reference/exns.scrbl b/collects/scribblings/reference/exns.scrbl index 685ef37543..64d08a561d 100644 --- a/collects/scribblings/reference/exns.scrbl +++ b/collects/scribblings/reference/exns.scrbl @@ -179,15 +179,13 @@ See also @scheme[error-print-source-location].} @defproc[(call-with-exception-handler [f (any/c . -> . any)][thunk (-> any)]) any]{ -Installs @scheme[f] as the @tech{exception handler} for the current -continuation---i.e., for the dynamic extent of a call to -@scheme[thunk]. The @scheme[thunk] is called in tail position with -respect to the call to @scheme[call-with-exception-handler]. If an -exception is raised during the evaluation of @scheme[thunk] (in an -extension of the current continuation that does not have its own -exception handler), then @scheme[f] is applied to the @scheme[raise]d -value in the continuation of the @scheme[raise] call (but extended -with a @tech{continuation barrier}; see @secref["prompt-model"]). +Installs @scheme[f] as the @tech{exception handler} for the +@tech{dynamic extent} of the call to @scheme[thunk]. If an exception +is raised during the evaluation of @scheme[thunk] (in an extension of +the current continuation that does not have its own exception +handler), then @scheme[f] is applied to the @scheme[raise]d value in +the continuation of the @scheme[raise] call (but extended with a +@tech{continuation barrier}; see @secref["prompt-model"]). Any procedure that takes one argument can be an exception handler. If the exception handler returns a value when invoked by @scheme[raise], diff --git a/src/configure b/src/configure index 465a72ba78..73d4f65474 100755 --- a/src/configure +++ b/src/configure @@ -11667,16 +11667,16 @@ if test "${enable_shared}" = "yes" ; then MZOPTIONS="$MZOPTIONS -DMZ_USES_SHARED_LIB" else LIBSFX=a - MREDLINKER="$CXX" + MREDLINKER='$(CXX)' WXLIBS=WXLIBSNORM ICP=cp MRLIBINSTALL="install-no-lib" LIBFINISH=echo LTO="o" LTA="a" - MZLINKER="$CC" + MZLINKER='$(CC)' STATIC_AR="$AR" - PLAIN_CC="$CC" + PLAIN_CC='$(CC)' FOREIGN_CONVENIENCE="" FOREIGN_OBJSLIB="\$(FOREIGN_OBJS)" fi diff --git a/src/mzscheme/Makefile.in b/src/mzscheme/Makefile.in index 002cdce8ab..bace3fe9e8 100644 --- a/src/mzscheme/Makefile.in +++ b/src/mzscheme/Makefile.in @@ -144,12 +144,12 @@ MZFW = PLT_MzScheme.framework/Versions/$(FWVERSION)/PLT_MzScheme $(MZFW): libmzscheme.@LIBSFX@ libmzgc.@LIBSFX@ $(SPECIALIZINGOBJECTS) mkdir -p PLT_MzScheme.framework/Versions/$(FWVERSION) - $(CC) -o $(MZFW) -framework CoreFoundation -dynamiclib -all_load $(SPECIALIZINGOBJECTS) libmzscheme.@LIBSFX@ libmzgc.@LIBSFX@ @LDFLAGS@ @LIBS@ + @MZLINKER@ -o $(MZFW) -framework CoreFoundation -dynamiclib -all_load $(SPECIALIZINGOBJECTS) libmzscheme.@LIBSFX@ libmzgc.@LIBSFX@ @LDFLAGS@ @LIBS@ rm -f PLT_MzScheme.framework/PLT_MzScheme ln -s Versions/$(FWVERSION)/PLT_MzScheme PLT_MzScheme.framework/PLT_MzScheme mzscheme@CGC@@OSX@: $(MZFW) main.@LTO@ - $(CC) -o mzscheme@CGC@ @PROFFLAGS@ main.@LTO@ -Wl,-headerpad_max_install_names -F. -framework PLT_MzScheme + @MZLINKER@ -o mzscheme@CGC@ @PROFFLAGS@ main.@LTO@ -Wl,-headerpad_max_install_names -F. -framework PLT_MzScheme /usr/bin/install_name_tool -change "PLT_MzScheme.framework/Versions/$(FWVERSION)/PLT_MzScheme" "@executable_path/PLT_MzScheme.framework/Versions/$(FWVERSION)/PLT_MzScheme" "mzscheme@CGC@" # OSKit ---------------------------------------- diff --git a/src/mzscheme/cmdline.inc b/src/mzscheme/cmdline.inc index c5ee7a07a1..64fa7a9f5c 100644 --- a/src/mzscheme/cmdline.inc +++ b/src/mzscheme/cmdline.inc @@ -1158,3 +1158,86 @@ static int run_from_cmd_line(int argc, char *_argv[], return 1; #endif } + +#if defined(OS_X) && defined(MZ_PRECISE_GC) + +/* These declarations avoid linker problems when using + -mmacosx-version-min. See gc2/vm_osx.c for details. */ + +START_XFORM_SKIP; + +#include +#include + +# ifdef __cplusplus +extern "C" { +# endif + +extern kern_return_t GC_catch_exception_raise_state(mach_port_t port, + exception_type_t exception_type, + exception_data_t exception_data, + mach_msg_type_number_t data_cnt, + thread_state_flavor_t *flavor, + thread_state_t in_state, + mach_msg_type_number_t is_cnt, + thread_state_t out_state, + mach_msg_type_number_t os_cnt); +extern kern_return_t GC_catch_exception_raise_state_identitity + (mach_port_t port, mach_port_t thread_port, mach_port_t task_port, + exception_type_t exception_type, exception_data_t exception_data, + mach_msg_type_number_t data_count, thread_state_flavor_t *state_flavor, + thread_state_t in_state, mach_msg_type_number_t in_state_count, + thread_state_t out_state, mach_msg_type_number_t out_state_count); +extern kern_return_t GC_catch_exception_raise(mach_port_t port, + mach_port_t thread_port, + mach_port_t task_port, + exception_type_t exception_type, + exception_data_t exception_data, + mach_msg_type_number_t data_count); + +kern_return_t catch_exception_raise_state(mach_port_t port, + exception_type_t exception_type, + exception_data_t exception_data, + mach_msg_type_number_t data_cnt, + thread_state_flavor_t *flavor, + thread_state_t in_state, + mach_msg_type_number_t is_cnt, + thread_state_t out_state, + mach_msg_type_number_t os_cnt) +{ + return GC_catch_exception_raise_state(port, exception_type, exception_data, + data_cnt, flavor, + in_state, is_cnt, + out_state, os_cnt); +} + +kern_return_t catch_exception_raise_state_identitity + (mach_port_t port, mach_port_t thread_port, mach_port_t task_port, + exception_type_t exception_type, exception_data_t exception_data, + mach_msg_type_number_t data_count, thread_state_flavor_t *state_flavor, + thread_state_t in_state, mach_msg_type_number_t in_state_count, + thread_state_t out_state, mach_msg_type_number_t out_state_count) +{ + return GC_catch_exception_raise_state_identitity(port, thread_port, task_port, + exception_type, exception_data, + data_count, state_flavor, + in_state, in_state_count, + out_state, out_state_count); +} + +kern_return_t catch_exception_raise(mach_port_t port, + mach_port_t thread_port, + mach_port_t task_port, + exception_type_t exception_type, + exception_data_t exception_data, + mach_msg_type_number_t data_count) +{ + return GC_catch_exception_raise(port, thread_port, task_port, + exception_type, exception_data, data_count); +} + +# ifdef __cplusplus +}; +# endif +END_XFORM_SKIP; +#endif diff --git a/src/mzscheme/configure.ac b/src/mzscheme/configure.ac index 911b6b3666..e4352024fc 100644 --- a/src/mzscheme/configure.ac +++ b/src/mzscheme/configure.ac @@ -1230,16 +1230,16 @@ if test "${enable_shared}" = "yes" ; then MZOPTIONS="$MZOPTIONS -DMZ_USES_SHARED_LIB" else LIBSFX=a - MREDLINKER="$CXX" + MREDLINKER='$(CXX)' WXLIBS=WXLIBSNORM ICP=cp MRLIBINSTALL="install-no-lib" LIBFINISH=echo LTO="o" LTA="a" - MZLINKER="$CC" + MZLINKER='$(CC)' STATIC_AR="$AR" - PLAIN_CC="$CC" + PLAIN_CC='$(CC)' FOREIGN_CONVENIENCE="" FOREIGN_OBJSLIB="\$(FOREIGN_OBJS)" fi diff --git a/src/mzscheme/gc2/Makefile.in b/src/mzscheme/gc2/Makefile.in index 88670f43e6..2ed8e66af4 100644 --- a/src/mzscheme/gc2/Makefile.in +++ b/src/mzscheme/gc2/Makefile.in @@ -324,12 +324,12 @@ MZFWMMM = PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme $(MZFWMMM): ../libmzscheme3m.@LIBSFX@ mkdir -p "PLT_MzScheme.framework/Versions/$(FWVERSION)_3m" - $(CC) -o $(MZFWMMM) -framework CoreFoundation -dynamiclib -all_load ../libmzscheme3m.@LIBSFX@ @LDFLAGS@ $(LIBS) + @MZLINKER@ -o $(MZFWMMM) -framework CoreFoundation -dynamiclib -all_load ../libmzscheme3m.@LIBSFX@ @LDFLAGS@ $(LIBS) rm -f PLT_MzScheme.framework/PLT_MzScheme ln -s Versions/$(FWVERSION)_3m/PLT_MzScheme PLT_MzScheme.framework/PLT_MzScheme ../mzscheme@MMM@@OSX@: $(MZFWMMM) main.@LTO@ - $(CC) -o ../mzscheme@MMM@ @PROFFLAGS@ main.@LTO@ -Wl,-headerpad_max_install_names -F. -framework PLT_MzScheme + @MZLINKER@ -o ../mzscheme@MMM@ @PROFFLAGS@ main.@LTO@ -Wl,-headerpad_max_install_names -F. -framework PLT_MzScheme mkdir -p "../PLT_MzScheme.framework/Versions/$(FWVERSION)_3m" cp "PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme" "../PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme" /usr/bin/install_name_tool -change "PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme" "@executable_path/PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme" "../mzscheme@MMM@" diff --git a/src/mzscheme/gc2/vm_osx.c b/src/mzscheme/gc2/vm_osx.c index 85f91a306e..ab9b8df8bf 100644 --- a/src/mzscheme/gc2/vm_osx.c +++ b/src/mzscheme/gc2/vm_osx.c @@ -211,7 +211,27 @@ static unsigned long determine_max_heap_size() } #endif -/* these are some less neat mach callbacks */ +/* The catch_exception_raise() functions are treated specially by the + linker, and Mach looks them up at run time. We provide + GC_... variants due to linker confusion when the implementaiton of + these are in a framework instead of the main binary, so that the + main binary needs to define them and jump to the implemenations + here. (This linker problem seems to occur when we use + -mmacosx-version-min.) */ + +kern_return_t GC_catch_exception_raise_state(mach_port_t port, + exception_type_t exception_type, + exception_data_t exception_data, + mach_msg_type_number_t data_cnt, + thread_state_flavor_t *flavor, + thread_state_t in_state, + mach_msg_type_number_t is_cnt, + thread_state_t out_state, + mach_msg_type_number_t os_cnt) +{ + return KERN_FAILURE; +} + kern_return_t catch_exception_raise_state(mach_port_t port, exception_type_t exception_type, exception_data_t exception_data, @@ -221,6 +241,19 @@ kern_return_t catch_exception_raise_state(mach_port_t port, mach_msg_type_number_t is_cnt, thread_state_t out_state, mach_msg_type_number_t os_cnt) +{ + return GC_catch_exception_raise_state(port, exception_type, exception_data, + data_cnt, flavor, + in_state, is_cnt, + out_state, os_cnt); +} + +kern_return_t GC_catch_exception_raise_state_identitity + (mach_port_t port, mach_port_t thread_port, mach_port_t task_port, + exception_type_t exception_type, exception_data_t exception_data, + mach_msg_type_number_t data_count, thread_state_flavor_t *state_flavor, + thread_state_t in_state, mach_msg_type_number_t in_state_count, + thread_state_t out_state, mach_msg_type_number_t out_state_count) { return KERN_FAILURE; } @@ -232,15 +265,19 @@ kern_return_t catch_exception_raise_state_identitity thread_state_t in_state, mach_msg_type_number_t in_state_count, thread_state_t out_state, mach_msg_type_number_t out_state_count) { - return KERN_FAILURE; + return GC_catch_exception_raise_state_identitity(port, thread_port, task_port, + exception_type, exception_data, + data_count, state_flavor, + in_state, in_state_count, + out_state, out_state_count); } -kern_return_t catch_exception_raise(mach_port_t port, - mach_port_t thread_port, - mach_port_t task_port, - exception_type_t exception_type, - exception_data_t exception_data, - mach_msg_type_number_t data_count) +kern_return_t GC_catch_exception_raise(mach_port_t port, + mach_port_t thread_port, + mach_port_t task_port, + exception_type_t exception_type, + exception_data_t exception_data, + mach_msg_type_number_t data_count) { #if GENERATIONS /* kernel return value is in exception_data[0], faulting address in @@ -255,6 +292,17 @@ kern_return_t catch_exception_raise(mach_port_t port, return KERN_FAILURE; } +kern_return_t catch_exception_raise(mach_port_t port, + mach_port_t thread_port, + mach_port_t task_port, + exception_type_t exception_type, + exception_data_t exception_data, + mach_msg_type_number_t data_count) +{ + return GC_catch_exception_raise(port, thread_port, task_port, + exception_type, exception_data, data_count); +} + /* this is the thread which forwards of exceptions read from the exception server off to our exception catchers and then back out to the other thread */ diff --git a/src/wxcommon/PSDC.cxx b/src/wxcommon/PSDC.cxx index bfe837230d..4cbe5e15aa 100644 --- a/src/wxcommon/PSDC.cxx +++ b/src/wxcommon/PSDC.cxx @@ -2380,11 +2380,6 @@ void wxInitializePrintSetupData(Bool /* init */) { wxPrintSetupData *wxThePrintSetupData; -#ifdef wx_mac - wxThePrintPaperDatabase = new WXGC_PTRS wxPrintPaperDatabase; - wxThePrintPaperDatabase->CreateDatabase(); -#endif - wxThePrintSetupData = new WXGC_PTRS wxPrintSetupData; wxThePrintSetupData->SetPrintPreviewCommand(PS_PREVIEW_COMMAND); diff --git a/src/wxmac/src/base/wb_main.cc b/src/wxmac/src/base/wb_main.cc index 0bd32531d3..0b458901c4 100644 --- a/src/wxmac/src/base/wb_main.cc +++ b/src/wxmac/src/base/wb_main.cc @@ -84,6 +84,7 @@ void wxCommonInit(void) wxInitStandardTypes(); wxREGGLOB(wxThePrintPaperDatabase); wxThePrintPaperDatabase = new WXGC_PTRS wxPrintPaperDatabase; + wxThePrintPaperDatabase->CreateDatabase(); wxREGGLOB(wxWindow::gMouseWindow); wxRegisterAbortWindow(); wxRegisterSplinePointList();