diff --git a/racket/src/expander/compile/header.rkt b/racket/src/expander/compile/header.rkt index a929fefbfc..d82be9d85b 100644 --- a/racket/src/expander/compile/header.rkt +++ b/racket/src/expander/compile/header.rkt @@ -122,9 +122,16 @@ ,(add-module-path-index! mpis self) ,self-id ,inspector-id)]) - (begin - (vector-cas! ,syntax-literals-id pos #f stx) - (unsafe-vector*-ref ,syntax-literals-id pos)))))))))) + ;; loop in case of spurious CAS failure + (letrec-values ([(loop) + (lambda () + (begin + (vector-cas! ,syntax-literals-id pos #f stx) + (let-values ([(stx) (unsafe-vector*-ref ,syntax-literals-id pos)]) + (if stx + stx + (loop)))))]) + (loop)))))))))) ;; Generate on-demand deserialization (shared across instances); the ;; result defines `deserialize-syntax-id` diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc index 7a44d3424b..c1375b2239 100644 --- a/racket/src/racket/src/startup.inc +++ b/racket/src/racket/src/startup.inc @@ -30709,10 +30709,22 @@ static const char *startup_source = "(add-module-path-index! mpis_0 self_0)" " self-id" " inspector-id)))" +"(list*" +" 'letrec-values" +"(list" +"(list" +" '(loop)" +"(list" +" 'lambda" +" '()" "(list" " 'begin" "(list* 'vector-cas! syntax-literals-id '(pos #f stx))" -"(list* 'unsafe-vector*-ref syntax-literals-id '(pos))))))))))))))))))))" +"(list*" +" 'let-values" +"(list(list '(stx)(list* 'unsafe-vector*-ref syntax-literals-id '(pos))))" +" '((if stx stx(loop))))))))" +" '((loop))))))))))))))))))))" "(define-values" "(generate-lazy-syntax-literals-data!)" "(lambda(sl_0 mpis_0)" diff --git a/racket/src/schemify/path-and-fasl.rkt b/racket/src/schemify/path-and-fasl.rkt index 621b2bf204..a6a3c9403c 100644 --- a/racket/src/schemify/path-and-fasl.rkt +++ b/racket/src/schemify/path-and-fasl.rkt @@ -138,9 +138,20 @@ (fasl->s-exp v #:datum-intern? #t #:external-lifts (to-fasl-lifts tf)))) - (box-cas! vb v v2) - (set-to-fasl-wrt! tf #f) - (unbox vb)] + (let loop () + (cond + [(box-cas! vb v v2) + (set-to-fasl-wrt! tf #f) + v2] + [else + (let ([v (unbox vb)]) + (cond + [(bytes? v) + ;; must be a spurious CAS failure + (loop)] + [else + ;; other thread beat us to it + v]))]))] [else ;; already forced (or never fasled) v])])) diff --git a/racket/src/thread/future.rkt b/racket/src/thread/future.rkt index 35c2453885..8c108c3b3e 100644 --- a/racket/src/thread/future.rkt +++ b/racket/src/thread/future.rkt @@ -653,7 +653,10 @@ ;; lock-free synchronization to check whether the box content is #f (define (worker-pinged? w) - (box-cas! (worker-ping w) #t #t)) + (cond + [(box-cas! (worker-ping w) #t #t) #t] + [(box-cas! (worker-ping w) #f #f) #f] + [else (worker-pinged? w)])) ;; called with scheduler lock (define (check-in w) diff --git a/racket/src/thread/place.rkt b/racket/src/thread/place.rkt index ba0696a4c0..e478e5dc1a 100644 --- a/racket/src/thread/place.rkt +++ b/racket/src/thread/place.rkt @@ -155,7 +155,7 @@ (host:mutex-release (place-lock p)))) (define (place-has-activity! p) - (box-cas! (place-activity-canary p) #f #t) + (set-box! (place-activity-canary p) #t) (sandman-wakeup (place-wakeup-handle p))) (void @@ -163,8 +163,8 @@ ;; Called in atomic mode by scheduler (lambda (callbacks) (define p current-place) - (unless (box-cas! (place-activity-canary p) #f #f) - (box-cas! (place-activity-canary p) #t #f) + (when (unbox (place-activity-canary p)) + (set-box! (place-activity-canary p) #f) (host:mutex-acquire (place-lock p)) (define queued-result (place-queued-result p)) (define break (place-pending-break p))