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

expander: atomic update of a module-path-index table

Browse Source 
A module path index used to expand a module must be interned, and the
intern table is an `equal?`-based weak hash table, which means there's
an internal lock on the table that can be damaged if the current
thread is terminated while using the table.

I don't see an easy way to fall back to `eq?`-based tables, so I'm
resorting to an atomic region (which I had managed to avoid until
now).
This commit is contained in:
Matthew Flatt 2018-04-27 12:59:58 -06:00
parent cb921cd1d9
commit 53ffd28e0f
2 changed files with 22 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,5 +1,6 @@
#lang racket/base #lang racket/base
(require "../compile/serialize-property.rkt" (require ffi/unsafe/atomic
"../compile/serialize-property.rkt"
"contract.rkt" "contract.rkt"
"parse-module-path.rkt" "parse-module-path.rkt"
"intern.rkt") "intern.rkt")
@ -291,11 +292,17 @@
(define (make-generic-self-module-path-index self) (define (make-generic-self-module-path-index self)
(define r (resolved-module-path-to-generic-resolved-module-path (define r (resolved-module-path-to-generic-resolved-module-path
(module-path-index-resolved self))) (module-path-index-resolved self)))
(or (let ([e (hash-ref generic-self-mpis r #f)]) ;; The use of `generic-self-mpis` must be atomic, so that the
(and e (ephemeron-value e))) ;; current thread cannot be killed, since that could leave
(let ([mpi (module-path-index #f #f r #f)]) ;; the table locked
(hash-set! generic-self-mpis r (make-ephemeron r mpi)) (start-atomic)
mpi))) (begin0
(or (let ([e (hash-ref generic-self-mpis r #f)])
(and e (ephemeron-value e)))
(let ([mpi (module-path-index #f #f r #f)])
(hash-set! generic-self-mpis r (make-ephemeron r mpi))
mpi))
(end-atomic)))
(define (resolved-module-path-to-generic-resolved-module-path r) (define (resolved-module-path-to-generic-resolved-module-path r)
(define name (resolved-module-path-name r)) (define name (resolved-module-path-name r))

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

@ -2841,6 +2841,8 @@ static const char *startup_source =
" for-loop_8)" " for-loop_8)"
" '#hasheq()" " '#hasheq()"
" lst_13))))))" " lst_13))))))"
"(define-values(start-atomic)(lambda()(begin(unsafe-start-atomic))))"
"(define-values(end-atomic)(lambda()(begin(unsafe-end-atomic))))"
"(define-values(prop:serialize serialize? serialize-ref)(make-struct-type-property 'serialize))" "(define-values(prop:serialize serialize? serialize-ref)(make-struct-type-property 'serialize))"
"(define-values" "(define-values"
"(prop:serialize-fill! serialize-fill!? serialize-fill!-ref)" "(prop:serialize-fill! serialize-fill!? serialize-fill!-ref)"
@ -4250,12 +4252,17 @@ static const char *startup_source =
"(lambda(self_0)" "(lambda(self_0)"
"(begin" "(begin"
"(let-values(((r_15)(resolved-module-path-to-generic-resolved-module-path(module-path-index-resolved self_0))))" "(let-values(((r_15)(resolved-module-path-to-generic-resolved-module-path(module-path-index-resolved self_0))))"
"(begin"
"(start-atomic)"
"(begin0"
"(let-values(((or-part_46)" "(let-values(((or-part_46)"
"(let-values(((e_9)(hash-ref generic-self-mpis r_15 #f)))(if e_9(ephemeron-value e_9) #f))))" "(let-values(((e_9)(hash-ref generic-self-mpis r_15 #f)))"
"(if e_9(ephemeron-value e_9) #f))))"
"(if or-part_46" "(if or-part_46"
" or-part_46" " or-part_46"
"(let-values(((mpi_6)(module-path-index2.1 #f #f r_15 #f)))" "(let-values(((mpi_6)(module-path-index2.1 #f #f r_15 #f)))"
"(begin(hash-set! generic-self-mpis r_15(make-ephemeron r_15 mpi_6)) mpi_6))))))))" "(begin(hash-set! generic-self-mpis r_15(make-ephemeron r_15 mpi_6)) mpi_6))))"
"(end-atomic)))))))"
"(define-values" "(define-values"
"(resolved-module-path-to-generic-resolved-module-path)" "(resolved-module-path-to-generic-resolved-module-path)"
"(lambda(r_16)" "(lambda(r_16)"