From 776b69e39985550ff43fa60a6fadd4c974c078c3 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 7 Aug 2020 07:19:09 -0600
Subject: [PATCH] avoid race on places and initialization for `eval`

Force visits on internal Chez Scheme modules before starting a place,
so that there won't be a race among places to visit the modules.
---
 racket/src/cs/main.sps        | 19 +++++++++++++++++++
 racket/src/cs/rumble.sls      |  1 +
 racket/src/cs/rumble/place.ss |  5 +++++
 3 files changed, 25 insertions(+)

diff --git a/racket/src/cs/main.sps b/racket/src/cs/main.sps
index 5591e0a3d8..bb8045099f 100644
--- a/racket/src/cs/main.sps
+++ b/racket/src/cs/main.sps
@@ -808,6 +808,25 @@
        
    (set-make-place-ports+fds! make-place-ports+fds)
 
+   (set-prepare-for-place!
+    (lambda ()
+      ;; Force visit of modules to make sure that we don't end up
+      ;; with a race later by trying to visit the module in a place:
+      (call-with-system-wind
+       (lambda ()
+         (for-each (lambda (lib)
+                     (#%$visit-library lib '() #f))
+                   '((chezscheme)
+                     (rumble)
+                     (thread)
+                     (io)
+                     (regexp)
+                     (schemify)
+                     (linklet)
+                     (expander)))
+         ;; Only need to visit once (although multiple time is ok)
+         (set-prepare-for-place! void)))))
+
    (set-start-place!
     (lambda (pch mod sym in out err cust plumber)
       (io-place-init! in out err cust plumber)
diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls
index c5cc0c78e7..bbd1015c5d 100644
--- a/racket/src/cs/rumble.sls
+++ b/racket/src/cs/rumble.sls
@@ -602,6 +602,7 @@
           unsafe-extfl->fx unsafe-fx->extfl unsafe-extflsqrt
           unsafe-extflvector-length unsafe-extflvector-ref unsafe-extflvector-set!
 
+          set-prepare-for-place!     ; not exported to Racket
           set-start-place!           ; not exported to Racket
           set-destroy-place!         ; not exported to Racket
           fork-place                 ; not exported to Racket
diff --git a/racket/src/cs/rumble/place.ss b/racket/src/cs/rumble/place.ss
index f2ff07327e..c68ee51123 100644
--- a/racket/src/cs/rumble/place.ss
+++ b/racket/src/cs/rumble/place.ss
@@ -79,6 +79,7 @@
  [(threaded?)
   (define (place-enabled?) #t)
   (define (fork-place thunk finish-proc)
+    (do-prepare-for-place)
     (fork-thread (lambda ()
                    (init-virtual-registers)
                    (place-registers (vector-copy place-register-inits))
@@ -102,6 +103,10 @@
   (define (fork-place thunk finish-proc) #f)
   (define (current-place-roots) '())])
 
+(define do-prepare-for-place void)
+(define (set-prepare-for-place! proc)
+  (set! do-prepare-for-place proc))
+
 (define do-start-place void)
 (define (set-start-place! proc)
   (set! do-start-place proc))