From 84827d04aadf441b8144a9ce2abaf4a569348747 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 8 Oct 2019 08:11:59 -0600 Subject: [PATCH] expander: avoid race on multi-scope -> scope table Although extremely unlikely, it was possible for multiple Racket threads operating on the same scopes to race on a multi-scope's table mapping phase levels to scopes. Also, for some some mutable hash tables that will be shared across places as read-only in Racket CS, make sure they are definitely set up for iteration. --- pkgs/base/info.rkt | 2 +- racket/src/cs/expander.sls | 1 + racket/src/cs/linklet.sls | 1 + racket/src/cs/rumble.sls | 1 + racket/src/cs/rumble/hash.ss | 5 ++ racket/src/cs/rumble/lock.ss | 12 ++--- racket/src/expander/syntax/scope.rkt | 35 +++++++------- racket/src/racket/src/schvers.h | 2 +- racket/src/racket/src/startup.inc | 72 +++++++++++++++++----------- 9 files changed, 76 insertions(+), 55 deletions(-) diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index b9d0f4e193..3b77a30890 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "7.4.0.13") +(define version "7.4.0.14") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/racket/src/cs/expander.sls b/racket/src/cs/expander.sls index 8c51e55d6c..fb065b559a 100644 --- a/racket/src/cs/expander.sls +++ b/racket/src/cs/expander.sls @@ -66,6 +66,7 @@ (let ([ht (make-hasheq)]) (hash-set! ht 'prim prim) ... + (unsafe-hash-seal! ht) ht))])) (include "primitive/kernel.ss") diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index 901f76d32a..7d541ae5d9 100644 --- a/racket/src/cs/linklet.sls +++ b/racket/src/cs/linklet.sls @@ -243,6 +243,7 @@ (lambda (table) (hash-for-each (cdr table) (lambda (k v) (hash-set! primitives k v)))) tables) + (unsafe-hash-seal! primitives) ;; prropagate table to the rumble layer (install-primitives-table! primitives)) diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls index 60163302dc..7c998e0ef0 100644 --- a/racket/src/cs/rumble.sls +++ b/racket/src/cs/rumble.sls @@ -270,6 +270,7 @@ unsafe-weak-hash-iterate-first unsafe-weak-hash-iterate-next unsafe-weak-hash-iterate-key unsafe-weak-hash-iterate-value unsafe-weak-hash-iterate-key+value unsafe-weak-hash-iterate-pair + unsafe-hash-seal! ; not exported to racket hash? hash-eq? hash-equal? hash-eqv? hash-weak? immutable-hash? hash-count diff --git a/racket/src/cs/rumble/hash.ss b/racket/src/cs/rumble/hash.ss index c40859c475..150233023f 100644 --- a/racket/src/cs/rumble/hash.ss +++ b/racket/src/cs/rumble/hash.ss @@ -238,6 +238,11 @@ ht))))] [else (raise-argument-error 'hash-clear! "(and/c hash? immutable?)" ht)])) +(define/who (unsafe-hash-seal! ht) + (check who eq-mutable-hash? ht) + (prepare-iterate! ht (hash-count ht)) + (set-locked-iterable-hash-lock! ht #f)) + (define (hash-eq? ht) (cond [(mutable-hash? ht) (eq-mutable-hash? ht)] diff --git a/racket/src/cs/rumble/lock.ss b/racket/src/cs/rumble/lock.ss index 8edbdb0dea..3e6678981e 100644 --- a/racket/src/cs/rumble/lock.ss +++ b/racket/src/cs/rumble/lock.ss @@ -57,13 +57,11 @@ (make-scheduler-lock)] [else #f])) -(define lock-acquire - (case-lambda - [(lock) - (cond - [(not lock) (disable-interrupts)] - [else - (scheduler-lock-acquire lock)])])) +(define (lock-acquire lock) + (cond + [(not lock) (disable-interrupts)] + [else + (scheduler-lock-acquire lock)])) (define (lock-release lock) (cond diff --git a/racket/src/expander/syntax/scope.rkt b/racket/src/expander/syntax/scope.rkt index 9573a8a0dc..ecaf6c3f39 100644 --- a/racket/src/expander/syntax/scope.rkt +++ b/racket/src/expander/syntax/scope.rkt @@ -163,7 +163,7 @@ ;; be small. (struct multi-scope (id ; identity name ; for debugging - scopes ; phase -> representative-scope + scopes ; box of table: phase -> representative-scope shifted ; box of table: interned shifted-multi-scopes for non-label phases label-shifted) ; box of table: interned shifted-multi-scopes for label phases #:authentic @@ -174,10 +174,9 @@ ;; Prune to reachable representative scopes (define multi-scope-tables (serialize-state-multi-scope-tables state)) (ser-push! (or (hash-ref multi-scope-tables (multi-scope-scopes ms) #f) - (let ([ht (make-hasheqv)]) - (for ([(phase sc) (in-hash (multi-scope-scopes ms))]) - (when (set-member? (serialize-state-reachable-scopes state) sc) - (hash-set! ht phase sc))) + (let ([ht (for/hasheqv ([(phase sc) (in-hash (unbox (multi-scope-scopes ms)))] + #:when (set-member? (serialize-state-reachable-scopes state) sc)) + (values phase sc))]) (hash-set! multi-scope-tables (multi-scope-scopes ms) ht) ht)))) #:property prop:reach-scopes @@ -199,12 +198,12 @@ ;; To make that work, `binding-table-register-reachable` ;; needs to recognize representative scopes and treat ;; them differently, hence `prop:implicitly-reachable`. - (for ([sc (in-hash-values (multi-scope-scopes ms))]) + (for ([sc (in-hash-values (unbox (multi-scope-scopes ms)))]) (unless (binding-table-empty? (scope-binding-table sc)) (reach sc))))) (define (deserialize-multi-scope name scopes) - (multi-scope (new-deserialize-scope-id!) name scopes (box (hasheqv)) (box (hash)))) + (multi-scope (new-deserialize-scope-id!) name (box scopes) (box (hasheqv)) (box (hash)))) (struct representative-scope scope (owner ; a multi-scope for which this one is a phase-specific identity phase) ; phase of this scope @@ -340,19 +339,21 @@ (ephemeron-value new)))))) (define (new-multi-scope [name #f]) - (intern-shifted-multi-scope 0 (multi-scope (new-scope-id!) name (make-hasheqv) (box (hasheqv)) (box (hash))))) + (intern-shifted-multi-scope 0 (multi-scope (new-scope-id!) name (box (hasheqv)) (box (hasheqv)) (box (hash))))) (define (multi-scope-to-scope-at-phase ms phase) ;; Get the identity of `ms` at phase` - (or (hash-ref (multi-scope-scopes ms) phase #f) - (let ([s (representative-scope (if (deserialized-scope-id? (multi-scope-id ms)) - (new-deserialize-scope-id!) - (new-scope-id!)) - 'module - empty-binding-table - ms phase)]) - (hash-set! (multi-scope-scopes ms) phase s) - s))) + (let ([scopes (unbox (multi-scope-scopes ms))]) + (or (hash-ref scopes phase #f) + (let ([s (representative-scope (if (deserialized-scope-id? (multi-scope-id ms)) + (new-deserialize-scope-id!) + (new-scope-id!)) + 'module + empty-binding-table + ms phase)]) + (if (box-cas! (multi-scope-scopes ms) scopes (hash-set scopes phase s)) + s + (multi-scope-to-scope-at-phase ms phase)))))) (define (scope>? sc1 sc2) ((scope-id sc1) . > . (scope-id sc2))) diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 98830be682..fe1ac1df18 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 13 +#define MZSCHEME_VERSION_W 14 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc index 934655f878..c202d0bfac 100644 --- a/racket/src/racket/src/startup.inc +++ b/racket/src/racket/src/startup.inc @@ -8684,7 +8684,7 @@ static const char *startup_source = " prop:scope-with-bindings" "(lambda(ms_0 get-reachable-scopes_0 reach_0 register-trigger_0)" "(begin" -"(let-values(((ht_0)(multi-scope-scopes ms_0)))" +"(let-values(((ht_0)(unbox(multi-scope-scopes ms_0))))" "(begin" "(if(variable-reference-from-unsafe?(#%variable-reference))" "(void)" @@ -8727,45 +8727,54 @@ static const char *startup_source = "(let-values(((or-part_0)(hash-ref multi-scope-tables_0(multi-scope-scopes ms_0) #f)))" "(if or-part_0" " or-part_0" -"(let-values(((ht_0)(make-hasheqv)))" -"(begin" -"(let-values(((ht_1)(multi-scope-scopes ms_0)))" +"(let-values(((ht_0)" +"(let-values(((ht_0)(unbox(multi-scope-scopes ms_0))))" "(begin" "(if(variable-reference-from-unsafe?(#%variable-reference))" "(void)" -"(let-values()(check-in-hash ht_1)))" +"(let-values()(check-in-hash ht_0)))" "((letrec-values(((for-loop_0)" -"(lambda(i_0)" +"(lambda(table_0 i_0)" "(begin" " 'for-loop" "(if i_0" "(let-values(((phase_0 sc_0)" -"(hash-iterate-key+value ht_1 i_0)))" -"(let-values((()" -"(let-values()" -"(let-values((()" -"(let-values()" -"(begin" -"(let-values()" +"(hash-iterate-key+value" +" ht_0" +" i_0)))" +"(let-values(((table_1)" +"(let-values(((table_1)" +" table_0))" "(if(set-member?" "(serialize-state-reachable-scopes" " state_0)" " sc_0)" +"(let-values(((table_2)" +" table_1))" +"(let-values(((table_3)" "(let-values()" -"(hash-set!" -" ht_0" +"(let-values(((key_0" +" val_0)" +"(let-values()" +"(values" " phase_0" -" sc_0))" -"(void)))" -"(values)))))" -"(values)))))" +" sc_0))))" +"(hash-set" +" table_2" +" key_0" +" val_0)))))" +"(values table_3)))" +" table_1))))" "(if(not #f)" -"(for-loop_0(hash-iterate-next ht_1 i_0))" -"(values))))" -"(values))))))" +"(for-loop_0" +" table_1" +"(hash-iterate-next ht_0 i_0))" +" table_1)))" +" table_0)))))" " for-loop_0)" -"(hash-iterate-first ht_1))))" -"(void)" +" '#hasheqv()" +"(hash-iterate-first ht_0))))))" +"(begin" "(hash-set! multi-scope-tables_0(multi-scope-scopes ms_0) ht_0)" " ht_0)))))))))))" "(current-inspector)" @@ -8785,7 +8794,7 @@ static const char *startup_source = "(define-values" "(deserialize-multi-scope)" "(lambda(name_0 scopes_0)" -"(begin(multi-scope3.1(new-deserialize-scope-id!) name_0 scopes_0(box(hasheqv))(box(hash))))))" +"(begin(multi-scope3.1(new-deserialize-scope-id!) name_0(box scopes_0)(box(hasheqv))(box(hash))))))" "(define-values" "(struct:representative-scope" " representative-scope4.1" @@ -9001,23 +9010,28 @@ static const char *startup_source = "(let-values()" "(intern-shifted-multi-scope" " 0" -"(multi-scope3.1(new-scope-id!) name_0(make-hasheqv)(box(hasheqv))(box(hash))))))))))" +"(multi-scope3.1(new-scope-id!) name_0(box(hasheqv))(box(hasheqv))(box(hash))))))))))" "(case-lambda(()(begin(new-multi-scope8_0 #f)))((name7_0)(new-multi-scope8_0 name7_0)))))" "(define-values" "(multi-scope-to-scope-at-phase)" "(lambda(ms_0 phase_0)" "(begin" -"(let-values(((or-part_0)(hash-ref(multi-scope-scopes ms_0) phase_0 #f)))" +"(let-values(((scopes_0)(unbox(multi-scope-scopes ms_0))))" +"(let-values(((or-part_0)(hash-ref scopes_0 phase_0 #f)))" "(if or-part_0" " or-part_0" "(let-values(((s_0)" "(representative-scope4.1" -"(if(deserialized-scope-id?(multi-scope-id ms_0))(new-deserialize-scope-id!)(new-scope-id!))" +"(if(deserialized-scope-id?(multi-scope-id ms_0))" +"(new-deserialize-scope-id!)" +"(new-scope-id!))" " 'module" " empty-binding-table" " ms_0" " phase_0)))" -"(begin(hash-set!(multi-scope-scopes ms_0) phase_0 s_0) s_0)))))))" +"(if(box-cas!(multi-scope-scopes ms_0) scopes_0(hash-set scopes_0 phase_0 s_0))" +" s_0" +"(multi-scope-to-scope-at-phase ms_0 phase_0)))))))))" "(define-values(scope>?)(lambda(sc1_0 sc2_0)(begin(>(scope-id sc1_0)(scope-id sc2_0)))))" "(define-values(scope