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

compiler/cm: fix ".zo" file locking in -MCR mode

Browse Source
This commit is contained in:
Matthew Flatt 2019-03-23 14:47:36 -06:00
parent 3127b324c4
commit 70e0cac062
1 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
racket/collects/compiler/private/cm-minimal.rkt
View File

@ -158,7 +158,7 @@
(and (pair? p) (cdr p))) (and (pair? p) (cdr p)))
(define deps-imports cdddr) (define deps-imports cdddr)
(define (get-compilation-path path->mode roots path) (define (get-compilation-path path->mode roots path #:for-lock? [for-lock? #f])
(let-values ([(dir name) (get-compilation-dir+name path (let-values ([(dir name) (get-compilation-dir+name path
#:modes (list (path->mode path)) #:modes (list (path->mode path))
#:roots roots #:roots roots
@ -167,7 +167,8 @@
;; may pick the first root where there's no ".dep" ;; may pick the first root where there's no ".dep"
;; written yet when the second root on has a ".dep" ;; written yet when the second root on has a ".dep"
;; and the ".zo" is not yet in place ;; and the ".zo" is not yet in place
#:default-root (if (cross-multi-compile? roots) #:default-root (if (and (not for-lock?)
(cross-multi-compile? roots))
(cadr roots) (cadr roots)
(car roots)))]) (car roots)))])
(build-path dir name))) (build-path dir name)))
@ -702,6 +703,11 @@
(touch zo-name) (touch zo-name)
#f] #f]
[else [else
(define lock-zo-name (if (cross-multi-compile? roots)
;; Make sure we use a file path for the lock that is consistent
;; with being in a phase of compiling for the current machine:
(path-add-extension (get-compilation-path path->mode roots path) #".zo")
zo-name))
;; Called when `tryng-sha1?` is #f and this process (or some process) ;; Called when `tryng-sha1?` is #f and this process (or some process)
;; needs to compile, recompile, or touch: ;; needs to compile, recompile, or touch:
(define (build #:just-touch? [just-touch? #f] (define (build #:just-touch? [just-touch? #f]
@ -711,7 +717,7 @@
#:use-existing-deps [use-existing-deps #f]) #:use-existing-deps [use-existing-deps #f])
(define lc (parallel-lock-client)) (define lc (parallel-lock-client))
(when lc (log-compile-event path 'locking)) (when lc (log-compile-event path 'locking))
(define locked? (and lc (lc 'lock zo-name))) (define locked? (and lc (lc 'lock lock-zo-name)))
(define ok-to-compile? (or (not lc) locked?)) (define ok-to-compile? (or (not lc) locked?))
(dynamic-wind (dynamic-wind
(lambda () (void)) (lambda () (void))
@ -756,7 +762,7 @@
[else 'finish-compile]) [else 'finish-compile])
'already-done)) 'already-done))
(when locked? (when locked?
(lc 'unlock zo-name)))) (lc 'unlock lock-zo-name))))
#f) #f)
;; Called to recompile bytecode that is currently in ;; Called to recompile bytecode that is currently in
;; machine-independent form: ;; machine-independent form:
@ -776,8 +782,8 @@
(define (build/sync) (define (build/sync)
(define lc (parallel-lock-client)) (define lc (parallel-lock-client))
(when lc (when lc
(when (lc 'lock zo-name) (when (lc 'lock lock-zo-name)
(lc 'unlock zo-name))) (lc 'unlock lock-zo-name)))
#f) #f)
;; ---------------------------------------- ;; ----------------------------------------
;; Determine whether and how to rebuild the file: ;; Determine whether and how to rebuild the file: