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

expander: fix intering of some module path indexes for ".zo"

Browse Source 
Two "self" module path indexes are treated the same on load when they
have the same resolved module name. Fix the serialization intern table
to take that into account and avoid some GC-based non-deterministism.

Related to #3165
This commit is contained in:
Matthew Flatt 2020-05-19 15:36:34 -06:00
parent 12bc1b3841
commit 91f8d8a72f
2 changed files with 33 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
racket/src/expander/common/module-path-intern.rkt
View File

@ -6,18 +6,25 @@
intern-module-path-index!) intern-module-path-index!)
(struct mpi-intern-table (normal ; name[not #f] -[`equal?`-based]-> base -[`eq?`-based]-> module path index (struct mpi-intern-table (normal ; name[not #f] -[`equal?`-based]-> base -[`eq?`-based]-> module path index
fast)) ; superset, but `eq?`-keyed for fast already-interned checks fast ; superset, but `eq?`-keyed for fast already-interned checks
self)) ; name -[`equal?`-based]-> module path index
(define (make-module-path-index-intern-table) (define (make-module-path-index-intern-table)
(mpi-intern-table (make-hash) (make-hasheq))) (mpi-intern-table (make-hash) (make-hasheq) (make-hash)))
(define (intern-module-path-index! t mpi) (define (intern-module-path-index! t mpi)
(or (hash-ref (mpi-intern-table-fast t) mpi #f) (or (hash-ref (mpi-intern-table-fast t) mpi #f)
(let-values ([(name base) (module-path-index-split mpi)]) (let-values ([(name base) (module-path-index-split mpi)])
(cond (cond
[(not name) [(not name)
(hash-set! (mpi-intern-table-fast t) mpi mpi) ;; "self" MPIs are equivalent when they have the same resolution
mpi] (define r (or (module-path-index-resolved mpi)
'self))
(or (hash-ref (mpi-intern-table-self t) r #f)
(begin
(hash-set! (mpi-intern-table-self t) r mpi)
(hash-set! (mpi-intern-table-fast t) mpi mpi)
mpi))]
[else [else
(define interned-base (and base (define interned-base (and base
(intern-module-path-index! t base))) (intern-module-path-index! t base)))

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

@ -20473,20 +20473,25 @@ static const char *startup_source =
"(read-fasl-bytes)" "(read-fasl-bytes)"
"(lambda(i_0)(begin(let-values(((len_0)(read-fasl-integer i_0)))(read-bytes/exactly len_0 i_0)))))" "(lambda(i_0)(begin(let-values(((len_0)(read-fasl-integer i_0)))(read-bytes/exactly len_0 i_0)))))"
"(define-values" "(define-values"
"(struct:mpi-intern-table mpi-intern-table1.1 mpi-intern-table? mpi-intern-table-normal mpi-intern-table-fast)" "(struct:mpi-intern-table"
" mpi-intern-table1.1"
" mpi-intern-table?"
" mpi-intern-table-normal"
" mpi-intern-table-fast"
" mpi-intern-table-self)"
"(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" "(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)"
"(let-values()" "(let-values()"
"(let-values()" "(let-values()"
"(make-struct-type" "(make-struct-type"
" 'mpi-intern-table" " 'mpi-intern-table"
" #f" " #f"
" 2" " 3"
" 0" " 0"
" #f" " #f"
" null" " null"
"(current-inspector)" "(current-inspector)"
" #f" " #f"
" '(0 1)" " '(0 1 2)"
" #f" " #f"
" 'mpi-intern-table)))))" " 'mpi-intern-table)))))"
"(values" "(values"
@ -20494,10 +20499,11 @@ static const char *startup_source =
" make-_0" " make-_0"
" ?_0" " ?_0"
"(make-struct-field-accessor -ref_0 0 'normal)" "(make-struct-field-accessor -ref_0 0 'normal)"
"(make-struct-field-accessor -ref_0 1 'fast))))" "(make-struct-field-accessor -ref_0 1 'fast)"
"(make-struct-field-accessor -ref_0 2 'self))))"
"(define-values" "(define-values"
"(make-module-path-index-intern-table)" "(make-module-path-index-intern-table)"
"(lambda()(begin(mpi-intern-table1.1(make-hash)(make-hasheq)))))" "(lambda()(begin(mpi-intern-table1.1(make-hash)(make-hasheq)(make-hash)))))"
"(define-values" "(define-values"
"(intern-module-path-index!)" "(intern-module-path-index!)"
"(lambda(t_0 mpi_0)" "(lambda(t_0 mpi_0)"
@ -20507,7 +20513,17 @@ static const char *startup_source =
" or-part_0" " or-part_0"
"(let-values(((name_0 base_0)(1/module-path-index-split mpi_0)))" "(let-values(((name_0 base_0)(1/module-path-index-split mpi_0)))"
"(if(not name_0)" "(if(not name_0)"
"(let-values()(begin(hash-set!(mpi-intern-table-fast t_0) mpi_0 mpi_0) mpi_0))" "(let-values()"
"(let-values(((r_0)"
"(let-values(((or-part_1)(module-path-index-resolved mpi_0)))"
"(if or-part_1 or-part_1 'self))))"
"(let-values(((or-part_1)(hash-ref(mpi-intern-table-self t_0) r_0 #f)))"
"(if or-part_1"
" or-part_1"
"(begin"
"(hash-set!(mpi-intern-table-self t_0) r_0 mpi_0)"
"(hash-set!(mpi-intern-table-fast t_0) mpi_0 mpi_0)"
" mpi_0)))))"
"(let-values()" "(let-values()"
"(let-values(((interned-base_0)(if base_0(intern-module-path-index! t_0 base_0) #f)))" "(let-values(((interned-base_0)(if base_0(intern-module-path-index! t_0 base_0) #f)))"
"(let-values(((at-name_0)" "(let-values(((at-name_0)"