diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index c820bf932b..6e6740c7e9 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "7.4.0.7") +(define version "7.4.0.8") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/racket/src/cs/compile-file.ss b/racket/src/cs/compile-file.ss index dde4c9fa7b..5b6b74cb35 100644 --- a/racket/src/cs/compile-file.ss +++ b/racket/src/cs/compile-file.ss @@ -58,6 +58,7 @@ (check-defined '#%$record-cas!) (check-defined 'eq-hashtable-try-atomic-cell) (check-defined 'hashtable-ref-cell) +(check-defined 'call-consuming-continuation-attachment) ;; ---------------------------------------- diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index 0ea79a3f04..654b859831 100644 --- a/racket/src/cs/linklet.sls +++ b/racket/src/cs/linklet.sls @@ -171,6 +171,7 @@ (define jit-demand-on? (getenv "PLT_LINKLET_SHOW_JIT_DEMAND")) (define known-on? (getenv "PLT_LINKLET_SHOW_KNOWN")) (define cp0-on? (getenv "PLT_LINKLET_SHOW_CP0")) + (define assembly-on? (getenv "PLT_LINKLET_SHOW_ASSEMBLY")) (define show-on? (or gensym-on? pre-jit-on? pre-lift-on? @@ -179,6 +180,7 @@ jit-demand-on? known-on? cp0-on? + assembly-on? (getenv "PLT_LINKLET_SHOW"))) (define show (case-lambda @@ -207,7 +209,12 @@ ;; that need to be managed correctly when swapping Racket ;; engines/threads. (define (compile* e) - (call-with-system-wind (lambda () (compile e)))) + (call-with-system-wind (lambda () + (if assembly-on? + (parameterize ([#%$assembly-output (#%current-output-port)]) + (printf ";; assembly ---------------------\n") + (compile e)) + (compile e))))) (define (interpret* e) (call-with-system-wind (lambda () (interpret e)))) (define (fasl-write* s o) diff --git a/racket/src/cs/rumble/control.ss b/racket/src/cs/rumble/control.ss index 3da14c224c..608dbe5575 100644 --- a/racket/src/cs/rumble/control.ss +++ b/racket/src/cs/rumble/control.ss @@ -259,7 +259,7 @@ ;; current metacontinuation frame is already empty, don't push more (assert-in-uninterrupted) (assert-not-in-system-wind) - (call-with-current-continuation-attachment + (call-getting-continuation-attachment 'none (lambda (at) (cond @@ -930,13 +930,15 @@ (define-syntax with-continuation-mark (syntax-rules () [(_ key val body) - (call-with-current-continuation-attachment - empty-mark-frame - (lambda (a) - (call-setting-continuation-attachment - (mark-frame-update a key val) - (lambda () - body))))])) + (let* ([k key] + [v val]) + (call-consuming-continuation-attachment + empty-mark-frame + (lambda (a) + (call-setting-continuation-attachment + (mark-frame-update a k v) + (lambda () + body)))))])) ;; Return a continuation that expects a thunk to resume. That way, we ;; can can an `(end-uninterrupted)` and check for breaks in the @@ -1030,14 +1032,14 @@ (define (elem+cache-strip t) (if (elem+cache? t) (elem+cache-elem t) t)) ;; Export this form renamed to `call-with-immediate-continuation-mark`. -;; It's a macro to ensure that the underlying `call-with-current-continuation-attachment` +;; It's a macro to ensure that the underlying `call-getting-continuation-attachment` ;; is exposed. (define-syntax (call-with-immediate-continuation-mark/inline stx) (syntax-case stx (lambda) [(_ key-expr proc-expr) #'(call-with-immediate-continuation-mark/inline key-expr proc-expr #f)] [(_ key-expr (lambda (arg) body ...) default-v-expr) - #'(call-with-current-continuation-attachment + #'(call-getting-continuation-attachment empty-mark-frame (lambda (a) (let* ([key key-expr] diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index a5c57705f7..0ca505036c 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 4 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 7 +#define MZSCHEME_VERSION_W 8 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x