From e281030aba00ba3955a82418aef32e306f003d7d Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Mon, 15 Sep 2008 04:59:59 +0000 Subject: [PATCH 01/10] fix lcons example (PR9751) svn: r11752 --- collects/scribblings/drscheme/extending.scrbl | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/collects/scribblings/drscheme/extending.scrbl b/collects/scribblings/drscheme/extending.scrbl index 3e755d4d0e..20bf0299cc 100644 --- a/collects/scribblings/drscheme/extending.scrbl +++ b/collects/scribblings/drscheme/extending.scrbl @@ -8,13 +8,13 @@ DrScheme supports two forms of extension to the programming environment: @itemize[ - + @item{@index['("languages" "extending")]{@index['("DrScheme Teachpacks")]{A @deftech{teachpack}}} extends the set of procedures that are built into a language in DrScheme. For example, a teachpack might extend the Beginning Student language with a procedure for playing sounds. - + Teachpacks are particularly useful in a classroom setting, where an instructor can provide a teachpack that is designed for a specific exercise. To use the teachpack, each student must download the @@ -22,7 +22,7 @@ DrScheme supports two forms of extension to the programming Teachpack..."] menu item. See @secref["teachpacks"] for information in creating teachpacks.} - + @item{A @deftech{tool} extends the set of utilities within the DrScheme environment. For example, DrScheme's @onscreen{Check Syntax} button starts a syntax-checking tool. For information on @@ -41,11 +41,11 @@ example, to enable students to play hangman, we supply a teachpack that @itemize{ - @item{implements the random choosing of a word, } + @item{implements the random choosing of a word,} - @item{maintains the state variable of how many guesses have gone wrong, and} + @item{maintains the state variable of how many guesses have gone wrong, and} - @item{manages the GUI.} + @item{manages the GUI.} } @@ -70,7 +70,7 @@ implementation. To test it, be sure to save it in a file named @schememod[ scheme -(provide (rename-out :lcons lcons) lcar lcdr) +(provide (rename-out [:lcons lcons]) lcar lcdr) (define-struct lcons (hd tl)) From 1e40590ea49c8db711b635401f2abde15abc4f77 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Mon, 15 Sep 2008 07:19:41 +0000 Subject: [PATCH 02/10] Use a parameter for nested uses of test svn: r11753 --- collects/tests/lazy/testing.ss | 106 +++++++++++++++++---------------- 1 file changed, 56 insertions(+), 50 deletions(-) diff --git a/collects/tests/lazy/testing.ss b/collects/tests/lazy/testing.ss index 1be7f1696b..22d0643391 100644 --- a/collects/tests/lazy/testing.ss +++ b/collects/tests/lazy/testing.ss @@ -6,45 +6,32 @@ (define-syntax (safe stx) (syntax-case stx () [(_ expr) + ;; catch syntax errors while expanding, turn them into runtime errors (with-handlers ([exn? (lambda (e) #`(list 'error #,(exn-message e)))]) - (let-values ([(_ x) (syntax-local-expand-expression - #'(with-handlers ([exn? (lambda (e) - (list 'error - (exn-message e)))]) - (cons 'values - (call-with-values (lambda () expr) - list))))]) - x))])) + (define-values (_ opaque) + (syntax-local-expand-expression + #'(with-handlers ([exn? (lambda (e) (list 'error (exn-message e)))]) + (cons 'values (call-with-values (lambda () expr) list))))) + opaque)])) -(define (show value) - (match value - [(list 'error msg) (format "error: ~a" msg)] - [(list 'values x) (format "~e" x)] - [(list 'values xs ...) (format "~e" value)])) +(define show + (match-lambda [(list 'error msg) (format "error: ~a" msg)] + [(list 'values x) (format "~e" x)] + [(list 'values xs ...) (format "~e" (cons 'values xs))])) -(define test-context - (make-parameter - (lambda (num exns) - (if (null? exns) - (printf "~a tests passed\n" num) - (error 'test "~a/~a test failures:~a" (length exns) num - (string-append* - (append-map (lambda (e) (list "\n" (exn-message e))) - (reverse exns)))))))) +(define test-context (make-parameter #f)) -(define-for-syntax (loc stx) - (string->symbol - (format "~a:~a" (syntax-source stx) - (let ([l (syntax-line stx)] [c (syntax-column stx)]) - (cond [(and l c) (format "~a:~a" l c)] - [l l] - [(syntax-position stx) => (lambda (p) (format "#~a" p))] - [else "?"]))))) - -(provide test) -(define-syntax (test stx) +(define-syntax (test-thunk stx) (define (blame e fmt . args) - (with-syntax ([e e] [fmt fmt] [(arg ...) args] [loc (loc e)]) + (define loc + (string->symbol + (format "~a:~a" (or (syntax-source e) "(unknown)") + (let ([l (syntax-line e)] [c (syntax-column e)]) + (cond [(and l c) (format "~a:~a" l c)] + [l l] + [(syntax-position e) => (lambda (p) (format "#~a" p))] + [else "?"]))))) + (with-syntax ([e e] [fmt fmt] [(arg ...) args] [loc loc]) #'(error 'loc "test failure in ~e\n ~a" 'e (format fmt arg ...)))) (define (t1 x) #`(let ([x (safe #,x)]) @@ -62,14 +49,11 @@ #,(blame x "expected ~a; got: ~a" #'(show y) #'(show x))]))) (define (te x y) (t2 x #`(error #,y))) (define (try t . args) - #`(with-handlers ([exn? (lambda (e) (set! exns (cons e exns)))]) - (set! num (add1 num)) - #,(apply t args))) - (define (tb x) - #`(parameterize ([test-context (lambda (n es) - (set! num (+ n num)) - (set! exns (append es exns)))]) - #,x)) + #`(let ([c (test-context)]) + (with-handlers ([exn? (lambda (e) (set-mcdr! c (cons e (mcdr c))))]) + (set-mcar! c (add1 (mcar c))) + #,(apply t args)))) + (define (tb x) x) (let loop ([xs (map (lambda (x) (if (memq (syntax-e x) '(do => <= =error> y r) (cons (try te x y) r)] [(list* y ' "if: bad syntax" ;; test `test' errors - (test (/ 0)) =error> "expected non-#f single value" - (test 1 => 2) =error> "expected 2" - (test 1 =error> "") =error> "expected an error" - (test (/ 0) =error> "zzz") =error> "bad error message" + (test* (/ 0)) =error> "expected non-#f single value" + (test* 1 => 2) =error> "expected 2" + (test* 1 =error> "") =error> "expected an error" + (test* (/ 0) =error> "zzz") =error> "bad error message" ) ;; SchemeUnit stuff From d32f0a9692cf16aff6089105c00f438686b426f9 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Mon, 15 Sep 2008 08:01:06 +0000 Subject: [PATCH 03/10] * Made run-automated-tests invoke the original exception handler when need to * comment out stepper tests for now * lazy/main has a single batch of tests * added lazy/main to the tests svn: r11754 --- collects/tests/{lazy/testing.ss => eli-tester.ss} | 0 collects/tests/lazy/main.ss | 6 ++++-- collects/tests/run-automated-tests.ss | 9 ++++++--- 3 files changed, 10 insertions(+), 5 deletions(-) rename collects/tests/{lazy/testing.ss => eli-tester.ss} (100%) diff --git a/collects/tests/lazy/testing.ss b/collects/tests/eli-tester.ss similarity index 100% rename from collects/tests/lazy/testing.ss rename to collects/tests/eli-tester.ss diff --git a/collects/tests/lazy/main.ss b/collects/tests/lazy/main.ss index 43277e01f4..0399be1dee 100644 --- a/collects/tests/lazy/main.ss +++ b/collects/tests/lazy/main.ss @@ -1,6 +1,8 @@ #lang scheme/base -(require "testing.ss" lazy/force) +(require tests/eli-tester lazy/force) + +(test ;; lazy/force behavior (test @@ -46,4 +48,4 @@ => "#0=#s(foo 1 #0#)" )) -(printf "All tests passed.\n") +) diff --git a/collects/tests/run-automated-tests.ss b/collects/tests/run-automated-tests.ss index 232e124671..cb89a914c4 100755 --- a/collects/tests/run-automated-tests.ss +++ b/collects/tests/run-automated-tests.ss @@ -32,7 +32,9 @@ '([load "mzscheme/quiet.ss" (lib "scheme/init")] [require "typed-scheme/main.ss"] [require "match/plt-match-tests.ss"] - [require "stepper/automatic-tests.ss" (lib "scheme/base")])) + ;; [require "stepper/automatic-tests.ss" (lib "scheme/base")] + [require "lazy/main.ss"] + )) (require scheme/runtime-path) @@ -62,8 +64,9 @@ (lambda (n) (abort n "exit with error code ~a" n))] [uncaught-exception-handler (lambda (exn) - (when (eq? orig-exn-handler (uncaught-exception-handler)) - (abort 1 "error: ~a" (exn-message exn))))] + (if (eq? orig-exn-handler (uncaught-exception-handler)) + (abort 1 "error: ~a" (exn-message exn)) + (orig-exn-handler exn)))] [current-namespace (make-base-empty-namespace)]) (for-each namespace-require (cddr t)) ((case (car t) [(load) load] [(require) namespace-require]) From 99dc711ac0ef0123284656cef998802d884473cb Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Mon, 15 Sep 2008 09:57:16 +0000 Subject: [PATCH 04/10] Removed the redundant uncaught-exception-handler setting, use with-handlers except for the mzscheme tests svn: r11755 --- collects/tests/run-automated-tests.ss | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/collects/tests/run-automated-tests.ss b/collects/tests/run-automated-tests.ss index cb89a914c4..a1ee31b382 100755 --- a/collects/tests/run-automated-tests.ss +++ b/collects/tests/run-automated-tests.ss @@ -27,9 +27,11 @@ ;; Each should be a list with a mode symbol (`load' or `require'), ;; the path to the test file (relative to this script) and module ;; specifications for things to require into the initial namespace -;; for the test before the test is loaded. +;; for the test before the test is loaded. ('no-handler is a +;; special flag that means that errors raised by the test suite are +;; ignored, and should only be used by the mzscheme tests.) (define tests - '([load "mzscheme/quiet.ss" (lib "scheme/init")] + '([no-handler load "mzscheme/quiet.ss" (lib "scheme/init")] [require "typed-scheme/main.ss"] [require "match/plt-match-tests.ss"] ;; [require "stepper/automatic-tests.ss" (lib "scheme/base")] @@ -44,11 +46,11 @@ (define exit-code 0) (for ([t tests]) + (define no-handler? (and (eq? 'no-handler (car t)) (set! t (cdr t)))) (define name (cadr t)) (define stderr (current-error-port)) (define (echo fmt . args) (fprintf stderr "*** ~a: ~a\n" name (apply format fmt args))) - (define orig-exn-handler (uncaught-exception-handler)) (newline stderr) (echo "running...") (let/ec break @@ -62,15 +64,16 @@ (lambda () (sleep 900) (echo "Timeout!") (break-thread th)))) (parameterize* ([exit-handler (lambda (n) (abort n "exit with error code ~a" n))] - [uncaught-exception-handler - (lambda (exn) - (if (eq? orig-exn-handler (uncaught-exception-handler)) - (abort 1 "error: ~a" (exn-message exn)) - (orig-exn-handler exn)))] [current-namespace (make-base-empty-namespace)]) (for-each namespace-require (cddr t)) - ((case (car t) [(load) load] [(require) namespace-require]) - (build-path here name)) + (let ([thunk (lambda () + ((case (car t) [(load) load] [(require) namespace-require]) + (build-path here name)))]) + (if no-handler? + (thunk) + (with-handlers ([void (lambda (exn) + (abort 1 "error: ~a" (exn-message exn)))]) + (thunk)))) (echo "all tests passed.")))) (exit exit-code) From f25da8fd7d0549f3db25e569c00b7803ebdc9a20 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Mon, 15 Sep 2008 09:57:56 +0000 Subject: [PATCH 05/10] require at least one test expression svn: r11756 --- collects/tests/eli-tester.ss | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/collects/tests/eli-tester.ss b/collects/tests/eli-tester.ss index 22d0643391..c978e5a6c7 100644 --- a/collects/tests/eli-tester.ss +++ b/collects/tests/eli-tester.ss @@ -95,8 +95,8 @@ (reverse exns)))))))))))) (provide test test*) -(define-syntax-rule (test x ...) (run-tests (test-thunk x ...) #f)) -(define-syntax-rule (test* x ...) (run-tests (test-thunk x ...) #t)) +(define-syntax-rule (test x0 x ...) (run-tests (test-thunk x0 x ...) #f)) +(define-syntax-rule (test* x0 x ...) (run-tests (test-thunk x0 x ...) #t)) #; ;; test the `test' macro From 9c1f3eda0ceadda511b0deb00d999989ebc2271a Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 15 Sep 2008 12:52:55 +0000 Subject: [PATCH 06/10] removed a race condition in the way the colors were initialized svn: r11757 --- collects/lang/htdp-langs.ss | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/collects/lang/htdp-langs.ss b/collects/lang/htdp-langs.ss index 90a7a989c3..78ecc63e33 100644 --- a/collects/lang/htdp-langs.ss +++ b/collects/lang/htdp-langs.ss @@ -48,8 +48,6 @@ (define o (current-output-port)) (define (oprintf . args) (apply fprintf o args)) - (define init-eventspace (current-eventspace)) - (define user-installed-teachpacks-collection "installed-teachpacks") (define teachpack-installation-dir (build-path (find-user-collects-dir) user-installed-teachpacks-collection)) @@ -981,7 +979,7 @@ '()))] [else '()])]) - (parameterize ([current-eventspace init-eventspace]) + (parameterize ([current-eventspace drs-eventspace]) (queue-callback (lambda () ;; need to make sure that the user's eventspace is still the same @@ -1033,16 +1031,22 @@ (thread-cell-set! current-test-coverage-info ht) (let ([rep (drscheme:rep:current-rep)]) (when rep - (let ([on-sd (make-object style-delta%)] - [off-sd (make-object style-delta%)]) - (cond - [(preferences:get 'framework:white-on-black?) - (send on-sd set-delta-foreground "white") - (send off-sd set-delta-foreground "indianred")] - [else - (send on-sd set-delta-foreground "black") - (send off-sd set-delta-foreground "firebrick")]) - (send rep set-test-coverage-info ht on-sd off-sd #f)))))) + (let ([s (make-semaphore 0)]) + (parameterize ([current-eventspace drs-eventspace]) + (queue-callback + (λ () + (let ([on-sd (make-object style-delta%)] + [off-sd (make-object style-delta%)]) + (cond + [(preferences:get 'framework:white-on-black?) + (send on-sd set-delta-foreground "white") + (send off-sd set-delta-foreground "indianred")] + [else + (send on-sd set-delta-foreground "black") + (send off-sd set-delta-foreground "firebrick")]) + (send rep set-test-coverage-info ht on-sd off-sd #f)) + (semaphore-post s)))) + (semaphore-wait s)))))) (let ([ht (thread-cell-ref current-test-coverage-info)]) (when ht (hash-set! ht key (mcons #f expr))))) From 186bf676306ed59f9892d7bf58ab7d833b5c3f29 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 15 Sep 2008 19:08:50 +0000 Subject: [PATCH 07/10] msvs9-friendly patches; preliminary splicing let-syntax library; export and doc GC_resolve and GC_fixup_self svn: r11758 --- collects/compiler/private/xform.ss | 2 +- collects/mzlib/pretty.ss | 2 +- collects/scheme/splicing.ss | 93 ++++++++++++++++++++++++ collects/scribblings/inside/memory.scrbl | 29 +++++++- src/mzscheme/include/mzscheme3m.exp | 2 + src/mzscheme/include/mzwin3m.def | 2 + src/mzscheme/src/schemef.h | 2 + src/mzscheme/src/schemex.h | 2 + src/mzscheme/src/schemex.inc | 2 + src/mzscheme/src/schemexm.h | 2 + src/worksp/gc2/make.ss | 2 +- src/worksp/libmysterx/xform.ss | 2 +- src/worksp/mzcom/xform.ss | 2 +- src/wxwindow/contrib/fafa/fafabuf.h | 13 ++++ src/wxwindow/contrib/fafa/fafapriv.h | 14 +--- src/wxwindow/include/msw/wx_itemp.h | 2 +- src/wxwindow/src/msw/wx_dc.cxx | 4 +- 17 files changed, 155 insertions(+), 22 deletions(-) create mode 100644 collects/scheme/splicing.ss create mode 100644 src/wxwindow/contrib/fafa/fafabuf.h diff --git a/collects/compiler/private/xform.ss b/collects/compiler/private/xform.ss index 35e9cafcfe..c024cb9d13 100644 --- a/collects/compiler/private/xform.ss +++ b/collects/compiler/private/xform.ss @@ -2676,7 +2676,7 @@ (eq? semi (tok-n (cadr e)))) (tok-n (car e)) (loop (cdr e))))]) - (unless (eq? '|::| (tok-n (cadar body))) + (unless (or (eq? '|::| type) (eq? '|::| (tok-n (cadar body)))) ;; $patch vs2008 - goetter (log-error "[DECL] ~a in ~a: Variable declaration (~a ~a) not at the beginning of a block." (tok-line (caar body)) (tok-file (caar body)) type var)))) diff --git a/collects/mzlib/pretty.ss b/collects/mzlib/pretty.ss index 91e7aea70d..6849cb1cd3 100644 --- a/collects/mzlib/pretty.ss +++ b/collects/mzlib/pretty.ss @@ -1173,7 +1173,7 @@ (and (pretty-print-abbreviate-read-macros) (let ((head (car l)) (tail (cdr l))) (case head - ((quote quasiquote unquote unquote-splicing syntax) + ((quote quasiquote unquote unquote-splicing syntax unsyntax unsyntax-splicing) (length1? tail)) (else #f))))) diff --git a/collects/scheme/splicing.ss b/collects/scheme/splicing.ss new file mode 100644 index 0000000000..906587efd1 --- /dev/null +++ b/collects/scheme/splicing.ss @@ -0,0 +1,93 @@ +#lang scheme/base +(require (for-syntax scheme/base)) + +(provide splicing-let-syntax + splicing-let-syntaxes + splicing-letrec-syntax + splicing-letrec-syntaxes) + +(define-for-syntax (do-let-syntax stx rec? multi?) + (syntax-case stx () + [(_ ([ids expr] ...) body ...) + (let ([all-ids (map (lambda (ids-stx) + (let ([ids (if multi? + (syntax->list ids-stx) + (list ids-stx))]) + (unless ids + (raise-syntax-error + #f + "expected a parenthesized sequence of identifiers" + stx + ids-stx)) + (for-each (lambda (id) + (unless (identifier? id) + (raise-syntax-error + #f + "expected an identifier" + stx + id))) + ids) + ids)) + (syntax->list #'(ids ...)))]) + (let ([dup-id (check-duplicate-identifier + (apply append all-ids))]) + (when dup-id + (raise-syntax-error + #f + "duplicate binding" + stx + dup-id))) + (if (eq? 'expression (syntax-local-context)) + (with-syntax ([let-stx (if rec? + (if multi? + #'letrec-syntaxes + #'letrec-syntax) + (if multi? + #'let-syntaxes + #'let-syntax))]) + (syntax/loc stx + (let-stx ([ids expr] ...) + (#%expression body) + ...))) + (let ([sli (if (list? (syntax-local-context)) + syntax-local-introduce + values)]) + (let ([all-ids (map (lambda (ids) (map sli ids)) all-ids)] + [def-ctx (syntax-local-make-definition-context)] + [ctx (list (gensym 'intdef))]) + (syntax-local-bind-syntaxes (apply append all-ids) #f def-ctx) + (let* ([add-context + (lambda (expr) + (let ([q (local-expand #`(quote #,expr) + ctx + (list #'quote) + def-ctx)]) + (syntax-case q () + [(_ expr) #'expr])))]) + (with-syntax ([((id ...) ...) + (map (lambda (ids) + (map sli (map add-context ids))) + all-ids)] + [(expr ...) + (let ([exprs (syntax->list #'(expr ...))]) + (if rec? + (map add-context exprs) + exprs))] + [(body ...) + (map add-context (syntax->list #'(body ...)))]) + #'(begin + (define-syntaxes (id ...) expr) + ... + body ...)))))))])) + +(define-syntax (splicing-let-syntax stx) + (do-let-syntax stx #f #f)) + +(define-syntax (splicing-let-syntaxes stx) + (do-let-syntax stx #f #t)) + +(define-syntax (splicing-letrec-syntax stx) + (do-let-syntax stx #t #f)) + +(define-syntax (splicing-letrec-syntaxes stx) + (do-let-syntax stx #t #t)) \ No newline at end of file diff --git a/collects/scribblings/inside/memory.scrbl b/collects/scribblings/inside/memory.scrbl index 30387dc506..b9309f4264 100644 --- a/collects/scribblings/inside/memory.scrbl +++ b/collects/scribblings/inside/memory.scrbl @@ -939,6 +939,7 @@ See @cpp{scheme_dont_gc_ptr}.} Forces an immediate garbage-collection.} + @function[(void GC_register_traversers [short tag] [Size_Proc s] @@ -961,6 +962,30 @@ Each of the three procedures takes a pointer and returns an integer: If the result of the size procedure is a constant, then pass a non-zero value for @var{is_const_size}. If the mark and fixup procedures are no-ops, then pass a non-zero value - for @var{is_atomic}. + for @var{is_atomic}.} -} + +@function[(void* GC_resolve [void* p])]{ + +3m only. Can be called by a size, mark, or fixup procedure that is registered +with @cpp{GC_register_traversers}. It returns the current address of +an object @var{p} that might have been moved already, where @var{p} +corresponds to an object that is referenced directly by the object +being sized, marked, or fixed. This translation is necessary, for +example, if the size or structure of an object depends on the content +of an object it references. For example, the size of a class instance +usually depends on a field count that is stored in the class. A fixup +procedure should call this function on a reference @emph{before} +fixing it.} + + +@function[(void* GC_fixup_self [void* p])]{ + +3m only. Can be called by a fixup procedure that is registered with +@cpp{GC_register_traversers}. It returns the final address of @var{p}, +which must be the pointer passed to the fixup procedure. For some +implementations of the memory manager, the result is the same as +@var{p}, either because objects are not moved or because the object is +moved before it is fixed. With other implementations, an object might +be moved after the fixup process, and the result is the location that +the object will have after garbage collection finished.} diff --git a/src/mzscheme/include/mzscheme3m.exp b/src/mzscheme/include/mzscheme3m.exp index 84941c25c2..2d4e5561c6 100644 --- a/src/mzscheme/include/mzscheme3m.exp +++ b/src/mzscheme/include/mzscheme3m.exp @@ -201,6 +201,8 @@ GC_register_traversers GC_resolve GC_mark GC_fixup +GC_fixup_self +GC_resolve scheme_malloc_immobile_box scheme_free_immobile_box scheme_make_bucket_table diff --git a/src/mzscheme/include/mzwin3m.def b/src/mzscheme/include/mzwin3m.def index 19fe2ba515..3a7e88f9b7 100644 --- a/src/mzscheme/include/mzwin3m.def +++ b/src/mzscheme/include/mzwin3m.def @@ -193,6 +193,8 @@ EXPORTS GC_resolve GC_mark GC_fixup + GC_fixup_self + GC_resolve scheme_malloc_immobile_box scheme_free_immobile_box scheme_make_bucket_table diff --git a/src/mzscheme/src/schemef.h b/src/mzscheme/src/schemef.h index 6aee13eafd..f098acb8fb 100644 --- a/src/mzscheme/src/schemef.h +++ b/src/mzscheme/src/schemef.h @@ -396,6 +396,8 @@ MZ_EXTERN void GC_register_traversers(short tag, Size_Proc size, Mark_Proc mark, MZ_EXTERN void *GC_resolve(void *p); MZ_EXTERN void GC_mark(const void *p); MZ_EXTERN void GC_fixup(void *p); +MZ_EXTERN void *GC_fixup_self(void *p); +MZ_EXTERN void *GC_resolve(void *p); #endif MZ_EXTERN void **scheme_malloc_immobile_box(void *p); diff --git a/src/mzscheme/src/schemex.h b/src/mzscheme/src/schemex.h index 55239e85ef..f26c49d88e 100644 --- a/src/mzscheme/src/schemex.h +++ b/src/mzscheme/src/schemex.h @@ -322,6 +322,8 @@ void (*GC_register_traversers)(short tag, Size_Proc size, Mark_Proc mark, Fixup_ void *(*GC_resolve)(void *p); void (*GC_mark)(const void *p); void (*GC_fixup)(void *p); +void *(*GC_fixup_self)(void *p); +void *(*GC_resolve)(void *p); #endif void **(*scheme_malloc_immobile_box)(void *p); void (*scheme_free_immobile_box)(void **b); diff --git a/src/mzscheme/src/schemex.inc b/src/mzscheme/src/schemex.inc index d9cc68f466..656d9177c4 100644 --- a/src/mzscheme/src/schemex.inc +++ b/src/mzscheme/src/schemex.inc @@ -221,6 +221,8 @@ scheme_extension_table->GC_resolve = GC_resolve; scheme_extension_table->GC_mark = GC_mark; scheme_extension_table->GC_fixup = GC_fixup; + scheme_extension_table->GC_fixup_self = GC_fixup_self; + scheme_extension_table->GC_resolve = GC_resolve; #endif scheme_extension_table->scheme_malloc_immobile_box = scheme_malloc_immobile_box; scheme_extension_table->scheme_free_immobile_box = scheme_free_immobile_box; diff --git a/src/mzscheme/src/schemexm.h b/src/mzscheme/src/schemexm.h index 4ac0a90b91..7745185b5f 100644 --- a/src/mzscheme/src/schemexm.h +++ b/src/mzscheme/src/schemexm.h @@ -221,6 +221,8 @@ #define GC_resolve (scheme_extension_table->GC_resolve) #define GC_mark (scheme_extension_table->GC_mark) #define GC_fixup (scheme_extension_table->GC_fixup) +#define GC_fixup_self (scheme_extension_table->GC_fixup_self) +#define GC_resolve (scheme_extension_table->GC_resolve) #endif #define scheme_malloc_immobile_box (scheme_extension_table->scheme_malloc_immobile_box) #define scheme_free_immobile_box (scheme_extension_table->scheme_free_immobile_box) diff --git a/src/worksp/gc2/make.ss b/src/worksp/gc2/make.ss index a6a60f8e09..f7635ae83d 100644 --- a/src/worksp/gc2/make.ss +++ b/src/worksp/gc2/make.ss @@ -63,7 +63,7 @@ "type" "vector")) -(define common-cpp-defs " /D _CRT_SECURE_NO_DEPRECATE ") +(define common-cpp-defs " /D _CRT_SECURE_NO_DEPRECATE /D _USE_DECLSPECS_FOR_SAL=0 /D _USE_ATTRIBUTES_FOR_SAL=0 ") (define (check-timestamp t2 dep) (when (t2 . > . (current-seconds)) diff --git a/src/worksp/libmysterx/xform.ss b/src/worksp/libmysterx/xform.ss index c059c70f83..db6ff612ef 100644 --- a/src/worksp/libmysterx/xform.ss +++ b/src/worksp/libmysterx/xform.ss @@ -5,7 +5,7 @@ (require mzlib/restart) -(define cpp-flags "/D _CRT_SECURE_NO_DEPRECATE /D WIN32") +(define cpp-flags "/D _CRT_SECURE_NO_DEPRECATE /D WIN32 /D _USE_DECLSPECS_FOR_SAL=0 /D _USE_ATTRIBUTES_FOR_SAL=0") (define includes (string-append "/I ../../mzscheme/include /I . /I .. /I ../../mysterx" diff --git a/src/worksp/mzcom/xform.ss b/src/worksp/mzcom/xform.ss index d595984435..7e3d863994 100644 --- a/src/worksp/mzcom/xform.ss +++ b/src/worksp/mzcom/xform.ss @@ -4,7 +4,7 @@ (require mzlib/restart) -(define cpp-flags "/D _CRT_SECURE_NO_DEPRECATE /D WIN32") +(define cpp-flags "/D _CRT_SECURE_NO_DEPRECATE /D WIN32 /D _USE_DECLSPECS_FOR_SAL=0 /D _USE_ATTRIBUTES_FOR_SAL=0") (define includes "/I ../../mzscheme/include /I . /I .. /I ../../mzcom") (define (xform src dest) diff --git a/src/wxwindow/contrib/fafa/fafabuf.h b/src/wxwindow/contrib/fafa/fafabuf.h new file mode 100644 index 0000000000..a99c8a2998 --- /dev/null +++ b/src/wxwindow/contrib/fafa/fafabuf.h @@ -0,0 +1,13 @@ +#ifdef __cplusplus +extern "C" char FafaWind[] ; +extern "C" char FafaButt[] ; +extern "C" char FafaStat[] ; +extern "C" char FafaChck[] ; +extern "C" char MichButt[] ; +#else +extern char FafaWind[] ; +extern char FafaButt[] ; +extern char FafaStat[] ; +extern char FafaChck[] ; +extern char MichButt[] ; +#endif diff --git a/src/wxwindow/contrib/fafa/fafapriv.h b/src/wxwindow/contrib/fafa/fafapriv.h index 4b8c2d4069..bb7590aca6 100644 --- a/src/wxwindow/contrib/fafa/fafapriv.h +++ b/src/wxwindow/contrib/fafa/fafapriv.h @@ -120,19 +120,7 @@ enum { /* Extra BYTES, Offsets : */ extern HANDLE Inst ; /* instance librairie */ extern HBITMAP DisableBitmap ; /* bitmap controles disables */ -#ifdef __cplusplus -extern "C" char FafaWind[] ; -extern "C" char FafaButt[] ; -extern "C" char FafaStat[] ; -extern "C" char FafaChck[] ; -extern "C" char MichButt[] ; -#else -extern char FafaWind[] ; -extern char FafaButt[] ; -extern char FafaStat[] ; -extern char FafaChck[] ; -extern char MichButt[] ; -#endif +#include "fafabuf.h" /* |-----------------------------------------------------------------------| diff --git a/src/wxwindow/include/msw/wx_itemp.h b/src/wxwindow/include/msw/wx_itemp.h index 20a199fe3e..9cf1adf02a 100644 --- a/src/wxwindow/include/msw/wx_itemp.h +++ b/src/wxwindow/include/msw/wx_itemp.h @@ -18,7 +18,7 @@ #include "wx_utils.h" #include "fafa.h" -#include "fafapriv.h" //added by Chubraev +#include "fafabuf.h" #define STATIC_CLASS "STATIC" #define LSTATIC_CLASS L"STATIC" diff --git a/src/wxwindow/src/msw/wx_dc.cxx b/src/wxwindow/src/msw/wx_dc.cxx index 4bf98ae9d3..24af20cce8 100644 --- a/src/wxwindow/src/msw/wx_dc.cxx +++ b/src/wxwindow/src/msw/wx_dc.cxx @@ -3344,7 +3344,9 @@ wxGL *wxMemoryDC::GetGL() #include #include -#include +#if _MSC_VER < 1500 +# include +#endif #include "wx_wglext.h" #include "../../../wxcommon/wxGLConfig.cxx" From 1482d7d7c60967f0a70b7567ae6e58f8a4f464b6 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 15 Sep 2008 19:33:46 +0000 Subject: [PATCH 08/10] CPP macro tweak (hopefully makes MSVC a little happier) svn: r11759 --- src/mred/wxs/wxs.xci | 4 +++- src/mred/wxs/wxs_bmap.cxx | 2 ++ src/mred/wxs/wxs_butn.cxx | 8 +++++--- src/mred/wxs/wxs_chce.cxx | 8 +++++--- src/mred/wxs/wxs_ckbx.cxx | 8 +++++--- src/mred/wxs/wxs_cnvs.cxx | 16 +++++++++------- src/mred/wxs/wxs_dc.cxx | 2 ++ src/mred/wxs/wxs_evnt.cxx | 2 ++ src/mred/wxs/wxs_fram.cxx | 10 ++++++---- src/mred/wxs/wxs_gage.cxx | 8 +++++--- src/mred/wxs/wxs_gdi.cxx | 2 ++ src/mred/wxs/wxs_glob.cxx | 2 ++ src/mred/wxs/wxs_item.cxx | 8 +++++--- src/mred/wxs/wxs_lbox.cxx | 8 +++++--- src/mred/wxs/wxs_madm.cxx | 14 ++++++++------ src/mred/wxs/wxs_mede.cxx | 2 ++ src/mred/wxs/wxs_medi.cxx | 2 ++ src/mred/wxs/wxs_menu.cxx | 2 ++ src/mred/wxs/wxs_mio.cxx | 2 ++ src/mred/wxs/wxs_misc.cxx | 2 ++ src/mred/wxs/wxs_mpb.cxx | 2 ++ src/mred/wxs/wxs_obj.cxx | 2 ++ src/mred/wxs/wxs_panl.cxx | 16 +++++++++------- src/mred/wxs/wxs_rado.cxx | 8 +++++--- src/mred/wxs/wxs_slid.cxx | 8 +++++--- src/mred/wxs/wxs_snip.cxx | 2 ++ src/mred/wxs/wxs_styl.cxx | 2 ++ src/mred/wxs/wxs_tabc.cxx | 14 ++++++++------ src/mred/wxs/wxs_win.cxx | 8 +++++--- 29 files changed, 116 insertions(+), 58 deletions(-) diff --git a/src/mred/wxs/wxs.xci b/src/mred/wxs/wxs.xci index a2368edacc..479797b3c7 100644 --- a/src/mred/wxs/wxs.xci +++ b/src/mred/wxs/wxs.xci @@ -20,7 +20,9 @@ @MACRO CHECKOKFORDC[p.who] = if (x

) { if (!x

->Ok()) WITH_VAR_STACK(scheme_arg_mismatch(, "bad bitmap: ", p[POFFSET+

])); if (BM_SELECTED(x

)) WITH_VAR_STACK(scheme_arg_mismatch(, "bitmap is already installed into a bitmap-dc%: ", p[POFFSET+

])); if (BM_IN_USE(x

)) WITH_VAR_STACK(scheme_arg_mismatch(, "bitmap is currently installed as a control label or pen/brush stipple: ", p[POFFSET+

])); } +#define ESCAPE_NO_RET_VAL /*empty*/ + @MACRO JMPDECL = mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; -@MACRO SETJMP = ESCAPE_BLOCK(/*empty*/) +@MACRO SETJMP = ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) @MACRO SETJMPV[rv] = ESCAPE_BLOCK() @MACRO RESETJMP = { thread = scheme_get_current_thread(); thread->error_buf = savebuf; } diff --git a/src/mred/wxs/wxs_bmap.cxx b/src/mred/wxs/wxs_bmap.cxx index 62723f565a..2e809477dc 100644 --- a/src/mred/wxs/wxs_bmap.cxx +++ b/src/mred/wxs/wxs_bmap.cxx @@ -25,6 +25,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_bmap.h" diff --git a/src/mred/wxs/wxs_butn.cxx b/src/mred/wxs/wxs_butn.cxx index 5135e6b212..12af49764b 100644 --- a/src/mred/wxs/wxs_butn.cxx +++ b/src/mred/wxs/wxs_butn.cxx @@ -25,6 +25,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_butn.h" @@ -193,7 +195,7 @@ void os_wxButton::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -349,7 +351,7 @@ void os_wxButton::OnSetFocus() READY_TO_RETURN; ASSELF wxButton::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -383,7 +385,7 @@ void os_wxButton::OnKillFocus() READY_TO_RETURN; ASSELF wxButton::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); diff --git a/src/mred/wxs/wxs_chce.cxx b/src/mred/wxs/wxs_chce.cxx index c35bbee46a..227a37a41c 100644 --- a/src/mred/wxs/wxs_chce.cxx +++ b/src/mred/wxs/wxs_chce.cxx @@ -31,6 +31,8 @@ void wxSetComboBoxFont(wxFont *f) +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_chce.h" @@ -316,7 +318,7 @@ void os_wxChoice::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -472,7 +474,7 @@ void os_wxChoice::OnSetFocus() READY_TO_RETURN; ASSELF wxChoice::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -506,7 +508,7 @@ void os_wxChoice::OnKillFocus() READY_TO_RETURN; ASSELF wxChoice::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); diff --git a/src/mred/wxs/wxs_ckbx.cxx b/src/mred/wxs/wxs_ckbx.cxx index 163099543c..e0923fea68 100644 --- a/src/mred/wxs/wxs_ckbx.cxx +++ b/src/mred/wxs/wxs_ckbx.cxx @@ -25,6 +25,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_ckbx.h" @@ -197,7 +199,7 @@ void os_wxCheckBox::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -353,7 +355,7 @@ void os_wxCheckBox::OnSetFocus() READY_TO_RETURN; ASSELF wxCheckBox::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -387,7 +389,7 @@ void os_wxCheckBox::OnKillFocus() READY_TO_RETURN; ASSELF wxCheckBox::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); diff --git a/src/mred/wxs/wxs_cnvs.cxx b/src/mred/wxs/wxs_cnvs.cxx index 94dae84abe..ceb6de052a 100644 --- a/src/mred/wxs/wxs_cnvs.cxx +++ b/src/mred/wxs/wxs_cnvs.cxx @@ -27,6 +27,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_cnvs.h" @@ -267,7 +269,7 @@ void os_wxCanvas::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -423,7 +425,7 @@ void os_wxCanvas::OnSetFocus() READY_TO_RETURN; ASSELF wxCanvas::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -457,7 +459,7 @@ void os_wxCanvas::OnKillFocus() READY_TO_RETURN; ASSELF wxCanvas::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -493,7 +495,7 @@ void os_wxCanvas::OnScroll(class wxScrollEvent* x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_wxScrollEvent(x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -529,7 +531,7 @@ void os_wxCanvas::OnChar(class wxKeyEvent* x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_wxKeyEvent(x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -565,7 +567,7 @@ void os_wxCanvas::OnEvent(class wxMouseEvent* x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_wxMouseEvent(x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -599,7 +601,7 @@ void os_wxCanvas::OnPaint() READY_TO_RETURN; ASSELF wxCanvas::OnPaint(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); diff --git a/src/mred/wxs/wxs_dc.cxx b/src/mred/wxs/wxs_dc.cxx index 34ee5b5d0d..808f707f41 100644 --- a/src/mred/wxs/wxs_dc.cxx +++ b/src/mred/wxs/wxs_dc.cxx @@ -66,6 +66,8 @@ void wxGL::ThisContextCurrent(void) { } +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_dc.h" diff --git a/src/mred/wxs/wxs_evnt.cxx b/src/mred/wxs/wxs_evnt.cxx index 77df5d0fe7..4d6336c096 100644 --- a/src/mred/wxs/wxs_evnt.cxx +++ b/src/mred/wxs/wxs_evnt.cxx @@ -96,6 +96,8 @@ wxMouseEvent_ext::wxMouseEvent_ext(int et, int ld, int mdd, int rd, int xv, int +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_evnt.h" diff --git a/src/mred/wxs/wxs_fram.cxx b/src/mred/wxs/wxs_fram.cxx index bc66fef37e..749f4b4b6c 100644 --- a/src/mred/wxs/wxs_fram.cxx +++ b/src/mred/wxs/wxs_fram.cxx @@ -26,6 +26,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_fram.h" @@ -258,7 +260,7 @@ void os_wxFrame::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -414,7 +416,7 @@ void os_wxFrame::OnSetFocus() READY_TO_RETURN; ASSELF wxFrame::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -448,7 +450,7 @@ void os_wxFrame::OnKillFocus() READY_TO_RETURN; ASSELF wxFrame::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -660,7 +662,7 @@ void os_wxFrame::OnActivate(Bool x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = (x0 ? scheme_true : scheme_false); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); diff --git a/src/mred/wxs/wxs_gage.cxx b/src/mred/wxs/wxs_gage.cxx index c81a4da365..7cc9541ebf 100644 --- a/src/mred/wxs/wxs_gage.cxx +++ b/src/mred/wxs/wxs_gage.cxx @@ -25,6 +25,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_gage.h" @@ -203,7 +205,7 @@ void os_wxsGauge::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -359,7 +361,7 @@ void os_wxsGauge::OnSetFocus() READY_TO_RETURN; ASSELF wxsGauge::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -393,7 +395,7 @@ void os_wxsGauge::OnKillFocus() READY_TO_RETURN; ASSELF wxsGauge::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); diff --git a/src/mred/wxs/wxs_gdi.cxx b/src/mred/wxs/wxs_gdi.cxx index ee08e3efa9..b9acb128cd 100644 --- a/src/mred/wxs/wxs_gdi.cxx +++ b/src/mred/wxs/wxs_gdi.cxx @@ -31,6 +31,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_gdi.h" diff --git a/src/mred/wxs/wxs_glob.cxx b/src/mred/wxs/wxs_glob.cxx index 247cefdb77..59b34487db 100644 --- a/src/mred/wxs/wxs_glob.cxx +++ b/src/mred/wxs/wxs_glob.cxx @@ -34,6 +34,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_glob.h" diff --git a/src/mred/wxs/wxs_item.cxx b/src/mred/wxs/wxs_item.cxx index 93cd19cb85..be6c864219 100644 --- a/src/mred/wxs/wxs_item.cxx +++ b/src/mred/wxs/wxs_item.cxx @@ -26,6 +26,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_item.h" @@ -397,7 +399,7 @@ void os_wxMessage::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -553,7 +555,7 @@ void os_wxMessage::OnSetFocus() READY_TO_RETURN; ASSELF wxMessage::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -587,7 +589,7 @@ void os_wxMessage::OnKillFocus() READY_TO_RETURN; ASSELF wxMessage::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); diff --git a/src/mred/wxs/wxs_lbox.cxx b/src/mred/wxs/wxs_lbox.cxx index 822552f62f..9b407808c6 100644 --- a/src/mred/wxs/wxs_lbox.cxx +++ b/src/mred/wxs/wxs_lbox.cxx @@ -25,6 +25,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_lbox.h" @@ -354,7 +356,7 @@ void os_wxListBox::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -510,7 +512,7 @@ void os_wxListBox::OnSetFocus() READY_TO_RETURN; ASSELF wxListBox::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -544,7 +546,7 @@ void os_wxListBox::OnKillFocus() READY_TO_RETURN; ASSELF wxListBox::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); diff --git a/src/mred/wxs/wxs_madm.cxx b/src/mred/wxs/wxs_madm.cxx index eafa31f257..a3cdb4a7c7 100644 --- a/src/mred/wxs/wxs_madm.cxx +++ b/src/mred/wxs/wxs_madm.cxx @@ -27,6 +27,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_madm.h" @@ -309,7 +311,7 @@ void os_wxMediaCanvas::OnChar(class wxKeyEvent* x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_wxKeyEvent(x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -345,7 +347,7 @@ void os_wxMediaCanvas::OnEvent(class wxMouseEvent* x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_wxMouseEvent(x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -379,7 +381,7 @@ void os_wxMediaCanvas::OnPaint() READY_TO_RETURN; ASSELF wxMediaCanvas::OnPaint(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -415,7 +417,7 @@ void os_wxMediaCanvas::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -571,7 +573,7 @@ void os_wxMediaCanvas::OnSetFocus() READY_TO_RETURN; ASSELF wxMediaCanvas::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -605,7 +607,7 @@ void os_wxMediaCanvas::OnKillFocus() READY_TO_RETURN; ASSELF wxMediaCanvas::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); diff --git a/src/mred/wxs/wxs_mede.cxx b/src/mred/wxs/wxs_mede.cxx index 51f050ff84..18c4dff967 100644 --- a/src/mred/wxs/wxs_mede.cxx +++ b/src/mred/wxs/wxs_mede.cxx @@ -25,6 +25,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_mede.h" diff --git a/src/mred/wxs/wxs_medi.cxx b/src/mred/wxs/wxs_medi.cxx index 0567f211c6..04ed059ec0 100644 --- a/src/mred/wxs/wxs_medi.cxx +++ b/src/mred/wxs/wxs_medi.cxx @@ -25,6 +25,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_medi.h" diff --git a/src/mred/wxs/wxs_menu.cxx b/src/mred/wxs/wxs_menu.cxx index 0ff01f3ca1..cb0a50fbdb 100644 --- a/src/mred/wxs/wxs_menu.cxx +++ b/src/mred/wxs/wxs_menu.cxx @@ -32,6 +32,8 @@ START_XFORM_SKIP; +#define ESCAPE_NO_RET_VAL /*empty*/ + #ifdef wx_mac # define MAC_UNUSED(x) /**/ diff --git a/src/mred/wxs/wxs_mio.cxx b/src/mred/wxs/wxs_mio.cxx index 2655de7082..fc75ec6cbe 100644 --- a/src/mred/wxs/wxs_mio.cxx +++ b/src/mred/wxs/wxs_mio.cxx @@ -26,6 +26,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_mio.h" diff --git a/src/mred/wxs/wxs_misc.cxx b/src/mred/wxs/wxs_misc.cxx index 32f3537b95..8999f7cc4a 100644 --- a/src/mred/wxs/wxs_misc.cxx +++ b/src/mred/wxs/wxs_misc.cxx @@ -32,6 +32,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_misc.h" diff --git a/src/mred/wxs/wxs_mpb.cxx b/src/mred/wxs/wxs_mpb.cxx index 43dd70d390..fb729fa307 100644 --- a/src/mred/wxs/wxs_mpb.cxx +++ b/src/mred/wxs/wxs_mpb.cxx @@ -25,6 +25,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_mpb.h" diff --git a/src/mred/wxs/wxs_obj.cxx b/src/mred/wxs/wxs_obj.cxx index 944088c2ef..30c017bc63 100644 --- a/src/mred/wxs/wxs_obj.cxx +++ b/src/mred/wxs/wxs_obj.cxx @@ -25,6 +25,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_obj.h" diff --git a/src/mred/wxs/wxs_panl.cxx b/src/mred/wxs/wxs_panl.cxx index bf0302dcc4..77036e070c 100644 --- a/src/mred/wxs/wxs_panl.cxx +++ b/src/mred/wxs/wxs_panl.cxx @@ -27,6 +27,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_panl.h" @@ -225,7 +227,7 @@ void os_wxPanel::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -381,7 +383,7 @@ void os_wxPanel::OnSetFocus() READY_TO_RETURN; ASSELF wxPanel::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -415,7 +417,7 @@ void os_wxPanel::OnKillFocus() READY_TO_RETURN; ASSELF wxPanel::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -1159,7 +1161,7 @@ void os_wxDialogBox::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -1315,7 +1317,7 @@ void os_wxDialogBox::OnSetFocus() READY_TO_RETURN; ASSELF wxDialogBox::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -1349,7 +1351,7 @@ void os_wxDialogBox::OnKillFocus() READY_TO_RETURN; ASSELF wxDialogBox::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -1423,7 +1425,7 @@ void os_wxDialogBox::OnActivate(Bool x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = (x0 ? scheme_true : scheme_false); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); diff --git a/src/mred/wxs/wxs_rado.cxx b/src/mred/wxs/wxs_rado.cxx index 51b4ca672d..10816ea348 100644 --- a/src/mred/wxs/wxs_rado.cxx +++ b/src/mred/wxs/wxs_rado.cxx @@ -25,6 +25,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_rado.h" @@ -420,7 +422,7 @@ void os_wxRadioBox::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -576,7 +578,7 @@ void os_wxRadioBox::OnSetFocus() READY_TO_RETURN; ASSELF wxRadioBox::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -610,7 +612,7 @@ void os_wxRadioBox::OnKillFocus() READY_TO_RETURN; ASSELF wxRadioBox::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); diff --git a/src/mred/wxs/wxs_slid.cxx b/src/mred/wxs/wxs_slid.cxx index 6111a71fcb..2db54b1116 100644 --- a/src/mred/wxs/wxs_slid.cxx +++ b/src/mred/wxs/wxs_slid.cxx @@ -25,6 +25,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_slid.h" @@ -191,7 +193,7 @@ void os_wxSlider::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -347,7 +349,7 @@ void os_wxSlider::OnSetFocus() READY_TO_RETURN; ASSELF wxSlider::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -381,7 +383,7 @@ void os_wxSlider::OnKillFocus() READY_TO_RETURN; ASSELF wxSlider::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); diff --git a/src/mred/wxs/wxs_snip.cxx b/src/mred/wxs/wxs_snip.cxx index f3fd6e9f95..96a7b568fd 100644 --- a/src/mred/wxs/wxs_snip.cxx +++ b/src/mred/wxs/wxs_snip.cxx @@ -25,6 +25,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_snip.h" diff --git a/src/mred/wxs/wxs_styl.cxx b/src/mred/wxs/wxs_styl.cxx index 7e3ccca333..48a628d13b 100644 --- a/src/mred/wxs/wxs_styl.cxx +++ b/src/mred/wxs/wxs_styl.cxx @@ -26,6 +26,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_styl.h" diff --git a/src/mred/wxs/wxs_tabc.cxx b/src/mred/wxs/wxs_tabc.cxx index f7d1e78d36..497bf18388 100644 --- a/src/mred/wxs/wxs_tabc.cxx +++ b/src/mred/wxs/wxs_tabc.cxx @@ -28,6 +28,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #ifdef wx_xt /* This calls won't be instantiated, but it must compile. */ @@ -339,7 +341,7 @@ void os_wxTabChoice::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -495,7 +497,7 @@ void os_wxTabChoice::OnSetFocus() READY_TO_RETURN; ASSELF wxTabChoice::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -529,7 +531,7 @@ void os_wxTabChoice::OnKillFocus() READY_TO_RETURN; ASSELF wxTabChoice::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -1188,7 +1190,7 @@ void os_wxGroupBox::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -1344,7 +1346,7 @@ void os_wxGroupBox::OnSetFocus() READY_TO_RETURN; ASSELF wxGroupBox::OnSetFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -1378,7 +1380,7 @@ void os_wxGroupBox::OnKillFocus() READY_TO_RETURN; ASSELF wxGroupBox::OnKillFocus(); } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); diff --git a/src/mred/wxs/wxs_win.cxx b/src/mred/wxs/wxs_win.cxx index 19dabaad20..329ba7a0d0 100644 --- a/src/mred/wxs/wxs_win.cxx +++ b/src/mred/wxs/wxs_win.cxx @@ -27,6 +27,8 @@ +#define ESCAPE_NO_RET_VAL /*empty*/ + #include "wxscheme.h" #include "wxs_win.h" @@ -255,7 +257,7 @@ void os_wxWindow::OnDropFile(epathname x0) } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; p[POFFSET+0] = WITH_VAR_STACK(objscheme_bundle_pathname((char *)x0)); - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p)); @@ -411,7 +413,7 @@ void os_wxWindow::OnSetFocus() { READY_TO_RETURN; return; } } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); @@ -445,7 +447,7 @@ void os_wxWindow::OnKillFocus() { READY_TO_RETURN; return; } } else { mz_jmp_buf *savebuf, newbuf; Scheme_Thread *thread; - ESCAPE_BLOCK(/*empty*/) + ESCAPE_BLOCK(ESCAPE_NO_RET_VAL) p[0] = (Scheme_Object *) ASSELF __gc_external; v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p)); From ddb0efb40d02d3cf257be000fd448dd818870b99 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 15 Sep 2008 20:13:39 +0000 Subject: [PATCH 09/10] don't clear text% paste-continue status on mouse enter/leave svn: r11762 --- src/mred/wxme/wx_media.cxx | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/mred/wxme/wx_media.cxx b/src/mred/wxme/wx_media.cxx index fb03ed5e60..90abce7d02 100644 --- a/src/mred/wxme/wx_media.cxx +++ b/src/mred/wxme/wx_media.cxx @@ -429,7 +429,9 @@ void wxMediaEdit::OnEvent(wxMouseEvent *event) if (!admin) return; - if (!event->Moving()) + if (!event->Moving() + && !event->Entering() + && !event->Leaving()) EndStreaks(wxSTREAK_EXCEPT_KEY_SEQUENCE | wxSTREAK_EXCEPT_CURSOR | wxSTREAK_EXCEPT_DELAYED); if (event->ButtonDown() || caretSnip) { From d165c586af021f4d8f4b3bd5fa4c49ca78536195 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 15 Sep 2008 21:58:59 +0000 Subject: [PATCH 10/10] PR 9760 svn: r11766 --- collects/scheme/private/contract.ss | 5 +++++ collects/tests/mzscheme/contract-test.ss | 13 +++++++++++++ 2 files changed, 18 insertions(+) diff --git a/collects/scheme/private/contract.ss b/collects/scheme/private/contract.ss index 95af546c09..3ab590aaa6 100644 --- a/collects/scheme/private/contract.ss +++ b/collects/scheme/private/contract.ss @@ -129,6 +129,11 @@ improve method arity mismatch contract violation error messages? [name (identifier? (syntax name)) (syntax saved-id)] + [(set! id arg) + (raise-syntax-error 'provide/contract + "cannot set! a provide/contract variable" + stx + (syntax id))] [(name . more) (with-syntax ([app (datum->syntax stx '#%app)]) (syntax/loc stx (app saved-id . more)))])))) diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss index 1177d516b9..e0f698f057 100644 --- a/collects/tests/mzscheme/contract-test.ss +++ b/collects/tests/mzscheme/contract-test.ss @@ -5778,6 +5778,19 @@ so that propagation occurs. (and (exn? x) (regexp-match #rx"expected field name to be b, but found string?" (exn-message x))))) + (contract-error-test + #'(begin + (eval '(module pce7-bug scheme/base + (require scheme/contract) + (define x 1) + (provide/contract [x integer?]))) + (eval '(module pce7-bug2 scheme/base + (require 'pce7-bug) + (set! x 5)))) + (λ (x) + (and (exn? x) + (regexp-match #rx"cannot set!" (exn-message x))))) + (contract-eval `(,test 'pos guilty-party (with-handlers ((void values)) (contract not #t 'pos 'neg)))) (report-errs)