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

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

View File

@ -1,5 +1,6 @@
#lang racket/base
(require "../compile/serialize-property.rkt"
(require ffi/unsafe/atomic
"../compile/serialize-property.rkt"
"contract.rkt"
"parse-module-path.rkt"
"intern.rkt")
@ -291,11 +292,17 @@
(define (make-generic-self-module-path-index self)
(define r (resolved-module-path-to-generic-resolved-module-path
(module-path-index-resolved self)))
;; The use of `generic-self-mpis` must be atomic, so that the
;; current thread cannot be killed, since that could leave
;; the table locked
(start-atomic)
(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)))
mpi))
(end-atomic)))
(define (resolved-module-path-to-generic-resolved-module-path r)
(define name (resolved-module-path-name r))

View File

@ -2841,6 +2841,8 @@ static const char *startup_source =
" for-loop_8)"
" '#hasheq()"
" 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-fill! serialize-fill!? serialize-fill!-ref)"
@ -4250,12 +4252,17 @@ static const char *startup_source =
"(lambda(self_0)"
"(begin"
"(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(((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"
" or-part_46"
"(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"
"(resolved-module-path-to-generic-resolved-module-path)"
"(lambda(r_16)"