suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

expander: avoid race condition on syntax-e

Browse Source 
Concurrent lazy scope propagation had a (very unlikely) race condition
updating a syntax object. Ryan pointed out this problem as part of the
discussion for #3162.

Switch to using a single field for a syntax object's content and
propagations, so a CAS can be used to update the field. As a pleasant
side effect, this change tends to make syntax objects more compact.
This commit is contained in:
Matthew Flatt 2020-05-11 13:43:48 -06:00
parent 761c577479
commit 03c978d2e8
10 changed files with 862 additions and 414 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi)
(define version "7.7.0.4")
(define version "7.7.0.5")
(define deps `("racket-lib"
["racket" #:version ,version]))

31
pkgs/racket-test/tests/racket/stress/stx-concurrent.rkt Normal file
View File

@ -0,0 +1,31 @@
#lang racket/base
;; Try to provoke a race for the internal side effect of propagating
;; scopes in a syntax object
(define stx (datum->syntax
#'here
(for/list ([i 10000]) i)))
(define i (make-syntax-introducer))
(define (burn n)
(if (zero? n)
'done
(burn (sub1 n))))
(for ([j (in-range 100)])
(define failed? #f)
(define stx2 (i stx))
(for-each
sync
(for/list ([i 10])
(thread (lambda ()
(burn (random 100000))
(unless (eq? (syntax-e stx2)
(begin
(sleep)
(syntax-e stx2)))
(set! failed? #t)
(printf "CHANGED\n"))))))
(when failed?
(error "failed")))

13
racket/src/expander/expand/main.rkt
View File

@ -73,19 +73,20 @@
;; For expanding an implicit implemented by a rename transformer:
#:fail-non-transformer [fail-non-transformer #f])
(log-expand ctx 'visit s)
(define content (syntax-content s))
(cond
[(syntax-identifier? s)
[(symbol? content)
(expand-identifier s ctx alternate-id)]
[(and (pair? (syntax-content s))
(syntax-identifier? (car (syntax-content s))))
[(and (pair? content)
(syntax-identifier? (car content)))
(expand-id-application-form s ctx alternate-id
#:fail-non-transformer fail-non-transformer)]
[(or (pair? (syntax-content s))
(null? (syntax-content s)))
[(or (pair? content)
(null? content))
;; An "application" form that doesn't start with an identifier, so
;; use implicit `#%app`
(expand-implicit '#%app s ctx #f)]
[(already-expanded? (syntax-content s))
[(already-expanded? content)
(expand-already-expanded s ctx)]
[else
;; Anything other than an identifier or parens triggers the

46
racket/src/expander/syntax/binding.rkt
View File

@ -158,18 +158,25 @@
(define shift (if non-source?
(non-source-shift from-mpi to-mpi)
(cons from-mpi to-mpi)))
(define content* (syntax-content* s))
(define content (if (modified-content? content*)
(modified-content-content content*)
content*))
(struct-copy syntax s
[mpi-shifts (shift-cons shift (syntax-mpi-shifts s))]
[inspector (or (syntax-inspector s)
inspector)]
[scope-propagations+tamper (if (datum-has-elements? (syntax-content s))
(propagation-mpi-shift (syntax-scope-propagations+tamper s)
(lambda (s) (shift-cons shift s))
inspector
(syntax-scopes s)
(syntax-shifted-multi-scopes s)
(syntax-mpi-shifts s))
(syntax-scope-propagations+tamper s))])]))
[content* (if (datum-has-elements? content)
(modified-content
content
(propagation-mpi-shift (and (modified-content? content*)
(modified-content-scope-propagations+tamper content*))
(lambda (s) (shift-cons shift s))
inspector
(syntax-scopes s)
(syntax-shifted-multi-scopes s)
(syntax-mpi-shifts s)))
content*)])]))
(define (shift-cons shift shifts)
(cond
@ -303,17 +310,24 @@
(define (syntax-set-inspector s insp)
;; This inspector merging is also implemented via propagations in "scope.rkt"
(define content* (syntax-content* s))
(define content (if (modified-content? content*)
(modified-content-content content*)
content*))
(struct-copy syntax s
[inspector (or (syntax-inspector s)
insp)]
[scope-propagations+tamper (if (datum-has-elements? (syntax-content s))
(propagation-mpi-shift (syntax-scope-propagations+tamper s)
#f
insp
(syntax-scopes s)
(syntax-shifted-multi-scopes s)
(syntax-mpi-shifts s))
(syntax-scope-propagations+tamper s))]))
[content* (if (datum-has-elements? content)
(modified-content
content
(propagation-mpi-shift (and (modified-content? content*)
(modified-content-scope-propagations+tamper content*))
#f
insp
(syntax-scopes s)
(syntax-shifted-multi-scopes s)
(syntax-mpi-shifts s)))
content*)]))
;; ----------------------------------------

2
racket/src/expander/syntax/read-syntax.rkt
View File

@ -94,7 +94,7 @@
(define (read-to-syntax s-exp srcloc rep)
(struct-copy syntax empty-syntax
[content (datum-intern-literal s-exp)]
[content* (datum-intern-literal s-exp)]
[srcloc srcloc]
[props (case rep
[(#\[) original-square-props]

175
racket/src/expander/syntax/scope.rkt
View File

@ -379,84 +379,133 @@
;; Adding, removing, or flipping a scope is propagated
;; lazily to subforms
(define-inline (apply-scope s sc op prop-op)
(define content* (syntax-content* s))
(define content (if (modified-content? content*)
(modified-content-content content*)
content*))
(if (shifted-multi-scope? sc)
(struct-copy syntax s
[shifted-multi-scopes (fallback-update-first (syntax-shifted-multi-scopes s)
(lambda (smss)
(op (fallback-first smss) sc)))]
[scope-propagations+tamper (if (datum-has-elements? (syntax-content s))
(prop-op (syntax-scope-propagations+tamper s)
sc
(syntax-scopes s)
(syntax-shifted-multi-scopes s)
(syntax-mpi-shifts s))
(syntax-scope-propagations+tamper s))])
[content* (if (datum-has-elements? content)
(let ([prop (prop-op (and (modified-content? content*)
(modified-content-scope-propagations+tamper content*))
sc
(syntax-scopes s)
(syntax-shifted-multi-scopes s)
(syntax-mpi-shifts s))])
(if prop
(modified-content content prop)
content))
content*)])
(struct-copy syntax s
[scopes (op (syntax-scopes s) sc)]
[scope-propagations+tamper (if (datum-has-elements? (syntax-content s))
(prop-op (syntax-scope-propagations+tamper s)
sc
(syntax-scopes s)
(syntax-shifted-multi-scopes s)
(syntax-mpi-shifts s))
(syntax-scope-propagations+tamper s))])))
[content* (if (datum-has-elements? content)
(let ([prop (prop-op (and (modified-content? content*)
(modified-content-scope-propagations+tamper content*))
sc
(syntax-scopes s)
(syntax-shifted-multi-scopes s)
(syntax-mpi-shifts s))])
(if prop
(modified-content content prop)
content))
content*)])))
(define (syntax-e/no-taint s)
(define prop (syntax-scope-propagations+tamper s))
(if (or (propagation? prop)
(tamper-needs-propagate? prop))
(let ([new-content
(non-syntax-map (syntax-content s)
(define (syntax-propagated-content* s)
(define content* (syntax-content* s))
(cond
[(not (modified-content? content*))
content*]
[else
(define prop (modified-content-scope-propagations+tamper content*))
(cond
[(or (propagation? prop)
(tamper-needs-propagate? prop))
(define content (modified-content-content content*))
(define new-content
(cond
[(propagation? prop)
(non-syntax-map content
(lambda (tail? x) x)
(lambda (sub-s)
(if (propagation? prop)
(struct-copy syntax sub-s
[scopes (propagation-apply
(define sub-content* (syntax-content* sub-s))
(define sub-content (if (modified-content? sub-content*)
(modified-content-content sub-content*)
sub-content*))
(define scope-propagations+tamper
(propagation-merge
sub-content
prop
(and (modified-content? sub-content*)
(modified-content-scope-propagations+tamper sub-content*))
(syntax-scopes sub-s)
(syntax-shifted-multi-scopes sub-s)
(syntax-mpi-shifts sub-s)))
(struct-copy syntax sub-s
[scopes (propagation-apply
prop
(syntax-scopes sub-s)
s)]
[shifted-multi-scopes (propagation-apply-shifted
prop
(syntax-shifted-multi-scopes sub-s)
s)]
[mpi-shifts (propagation-apply-mpi-shifts
prop
(syntax-scopes sub-s)
(syntax-mpi-shifts sub-s)
s)]
[shifted-multi-scopes (propagation-apply-shifted
prop
(syntax-shifted-multi-scopes sub-s)
s)]
[mpi-shifts (propagation-apply-mpi-shifts
prop
(syntax-mpi-shifts sub-s)
s)]
[inspector (propagation-apply-inspector
prop
(syntax-inspector sub-s))]
[scope-propagations+tamper (propagation-merge
(syntax-content sub-s)
prop
(syntax-scope-propagations+tamper sub-s)
(syntax-scopes sub-s)
(syntax-shifted-multi-scopes sub-s)
(syntax-mpi-shifts sub-s))])
(struct-copy/t syntax sub-s
[tamper (tamper-tainted-for-content
(syntax-content sub-s))]))))])
(set-syntax-content! s new-content)
(set-syntax-scope-propagations+tamper! s (tamper-propagated (if (propagation? prop)
(propagation-tamper prop)
prop)))
new-content)
(syntax-content s)))
[inspector (propagation-apply-inspector
prop
(syntax-inspector sub-s))]
[content* (if scope-propagations+tamper
(modified-content sub-content scope-propagations+tamper)
sub-content)])))]
[else
(non-syntax-map content
(lambda (tail? x) x)
(lambda (sub-s)
(struct-copy/t syntax sub-s
[tamper (tamper-tainted-for-content
(syntax-content sub-s))])))]))
(define new-tamper (tamper-propagated (if (propagation? prop)
(propagation-tamper prop)
prop)))
(define new-content* (if new-tamper
(modified-content new-content new-tamper)
new-content))
(if (syntax-content*-cas! s content* new-content*)
new-content*
;; some other thread beat us to it?
(syntax-propagated-content* s))]
[else content*])]))
(define (syntax-e/no-taint s)
(define content* (syntax-propagated-content* s))
(if (modified-content? content*)
(modified-content-content content*)
content*))
(define (syntax-e s)
(define e (syntax-content s))
(define e (syntax-content* s))
(cond
;; Shortcut for most common case:
[(symbol? e) e]
;; General case:
[else
(define content (syntax-e/no-taint s))
;; Since we just called `syntax-e/no-taint`, we know that
;; `(syntax-scope-propagations+tamper s)` is not a propagation
(define content* (syntax-propagated-content* s))
(cond
[(not (tamper-armed? (syntax-scope-propagations+tamper s))) content]
[(datum-has-elements? content) (taint-content content)]
[else content])]))
[(modified-content? content*)
(define content (modified-content-content content*))
(define prop (modified-content-scope-propagations+tamper content*))
;; Since we just called `syntax-propagate-content*`, we know that
;; `prop` is not a propagation
(cond
[(not (tamper-armed? prop)) content]
[(datum-has-elements? content) (taint-content content)]
[else content])]
[else content*])]))
;; When a representative-scope is manipulated, we want to
;; manipulate the multi scope, instead (at a particular
@ -507,7 +556,7 @@
(lambda (tail? x) x)
(lambda (s d)
(struct-copy syntax s
[content d]
[content* (re-modify-content s d)]
[shifted-multi-scopes
(push (syntax-shifted-multi-scopes s))]))
syntax-e/no-taint))
@ -558,8 +607,8 @@
(= 1 (hash-count ops))
(not (propagation-inspector prop))
(not (propagation-add-mpi-shifts prop)))
;; Nothing left to propagate
#f]
;; Nothing left to propagate, except maybe taint
(propagation-tamper prop)]
[else
(struct-copy propagation prop
[scope-ops
@ -754,7 +803,7 @@
(lambda (tail? d) d)
(lambda (s d)
(struct-copy syntax s
[content d]
[content* (re-modify-content s d)]
[shifted-multi-scopes
(shift-all (syntax-shifted-multi-scopes s))]))
syntax-e/no-taint))))
@ -797,7 +846,7 @@
(lambda (tail? d) d)
(lambda (s d)
(struct-copy syntax s
[content d]
[content* (re-modify-content s d)]
[scopes (swap-scs (syntax-scopes s))]
[shifted-multi-scopes
(swap-smss (syntax-shifted-multi-scopes s))]))

78
racket/src/expander/syntax/syntax.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/private/place-local
racket/fixnum
(only-in racket/unsafe/ops unsafe-struct*-cas!)
"../compile/serialize-property.rkt"
"../compile/serialize-state.rkt"
"../common/set.rkt"
@ -13,10 +14,15 @@
(provide
(struct-out syntax) ; includes `syntax?`
syntax-content
syntax-tamper
empty-syntax
identifier?
syntax-identifier?
(struct-out modified-content)
re-modify-content
syntax-content*-cas!
syntax->datum
datum->syntax
@ -36,10 +42,14 @@
syntax-place-init!)
(struct syntax ([content #:mutable] ; datum and nested syntax objects; mutated for lazy propagation
;; Used for content wrapped with scope propagations and/or a tamper,
;; so a `content*` is either a `modified-content` or plain content
(struct modified-content (content scope-propagations+tamper)
#:authentic)
(struct syntax ([content* #:mutable] ; datum and nested syntax objects; mutated for lazy propagation
scopes ; scopes that apply at all phases
shifted-multi-scopes ; scopes with a distinct identity at each phase; maybe a fallback search
[scope-propagations+tamper #:mutable] ; lazy propagation info and/or tamper state
mpi-shifts ; chain of module-path-index substitutions
srcloc ; source location
props ; properties
@ -58,11 +68,14 @@
(write-string ">" port))
#:property prop:serialize
(lambda (s ser-push! state)
(define prop (syntax-scope-propagations+tamper s))
(define content* (syntax-content* s))
(define content
(if (propagation? prop)
((propagation-ref prop) s)
(syntax-content s)))
(if (modified-content? content*)
(let ([prop (modified-content-scope-propagations+tamper content*)])
(if (propagation? prop)
((propagation-ref prop) s)
(modified-content-content content*)))
content*))
(define properties
(intern-properties
(syntax-props s)
@ -135,10 +148,14 @@
(set-syntax-state-all-sharing?! stx-state #f)))]))
#:property prop:reach-scopes
(lambda (s reach)
(define prop (syntax-scope-propagations+tamper s))
(reach (if (propagation? prop)
(define content* (syntax-content* s))
(reach
(if (modified-content? content*)
(let ([prop (modified-content-scope-propagations+tamper content*)])
(if (propagation? prop)
((propagation-ref prop) s)
(syntax-content s)))
(modified-content-content content*)))
content*))
(reach (syntax-scopes s))
(reach (syntax-shifted-multi-scopes s))
(for ([(k v) (in-immutable-hash (syntax-props s))]
@ -158,11 +175,30 @@
(define-values (prop:propagation-set-tamper propagation-set-tamper? propagation-set-tamper-ref)
(make-struct-type-property 'propagation-set-tamper))
(define (syntax-content s)
(define content* (syntax-content* s))
(if (modified-content? content*)
(modified-content-content content*)
content*))
(define (syntax-tamper s)
(define v (syntax-scope-propagations+tamper s))
(if (tamper? v)
v
((propagation-tamper-ref v) v)))
(define content* (syntax-content* s))
(cond
[(modified-content? content*)
(define v (modified-content-scope-propagations+tamper content*))
(if (tamper? v)
v
((propagation-tamper-ref v) v))]
[else #f]))
(define (syntax-content*-cas! stx old new)
(unsafe-struct*-cas! stx 0 old new))
(define (re-modify-content s d)
(define content* (syntax-content* s))
(if (modified-content? content*)
(modified-content d (modified-content-scope-propagations+tamper content*))
d))
;; ----------------------------------------
@ -175,7 +211,6 @@
(syntax #f
empty-scopes
empty-shifted-multi-scopes
#f ; scope-propogations+tamper (clean)
empty-mpi-shifts
#f ; srcloc
empty-props
@ -198,16 +233,17 @@
[else
(define insp (if (syntax? s) 'not-needed (current-module-code-inspector)))
(define (wrap content)
(syntax content
(syntax (if (and stx-c
(syntax-tamper stx-c))
(modified-content content
(tamper-tainted-for-content content))
content)
(if stx-c
(syntax-scopes stx-c)
empty-scopes)
(if stx-c
(syntax-shifted-multi-scopes stx-c)
empty-shifted-multi-scopes)
(and stx-c
(syntax-tamper stx-c)
(tamper-tainted-for-content content))
(if stx-c
(syntax-mpi-shifts stx-c)
empty-mpi-shifts)
@ -308,10 +344,12 @@
;; Called by the deserializer
(define (deserialize-syntax content context-triple srcloc props tamper inspector)
(syntax content
(syntax (let ([t (deserialize-tamper tamper)])
(if t
(modified-content content t)
content))
(vector*-ref context-triple 0)
(vector*-ref context-triple 1)
(deserialize-tamper tamper)
(vector*-ref context-triple 2)
srcloc
(if props

22
racket/src/expander/syntax/taint.rkt
View File

@ -17,14 +17,22 @@
(define-syntax struct-copy/t
(syntax-rules (syntax tamper)
[(struct-copy/t syntax s [tamper v])
(let ([stx s])
(let* ([stx s]
[t v]
[content* (syntax-content* stx)]
[content (if (modified-content? content*)
(modified-content-content content*)
content*)]
[p (and (modified-content? content*)
(modified-content-scope-propagations+tamper content*))])
(struct-copy syntax stx
[scope-propagations+tamper
(let ([t v]
[p (syntax-scope-propagations+tamper stx)])
(if (tamper? p)
t
((propagation-set-tamper-ref p) p t)))]))]))
[content*
(let ([new-p (if (tamper? p)
t
((propagation-set-tamper-ref p) p t))])
(if new-p
(modified-content content new-p)
content))]))]))
(define (taint-content d)
(non-syntax-map d

2
racket/src/racket/src/schvers.h
View File

@ -16,7 +16,7 @@
#define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 7
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 4
#define MZSCHEME_VERSION_W 5
/* A level of indirection makes `#` work as needed: */
#define AS_a_STR_HELPER(x) #x

905
racket/src/racket/src/startup.inc
View File

File diff suppressed because it is too large Load Diff