cs: use call-consuming-continuation-attachment

Use `call-consuming-continuation-attachment` to implement
`with-continuation-marks`, because that avoids duplicating
a set of checks when in tail position.

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

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

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)

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]

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