From e2435d71878cf8ce7562afe18c7fd2d617bb4077 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 18 Jul 2018 13:31:43 -0600
Subject: [PATCH] expander: different repair for race

The repair in 49a90ba75e reorders two lines in a way that, in
retrospect, seems worrying. I can't construct an example that goes
wrong, so maybe it's fine, but it seems possible (now or with some
future change) that attempting to visit available modules could lead
to the same attempt in the same thread and therefore a loop.

This commit changes the repair to just always take the lock instead of
fixing up the attempted shortcut. There's a tiny extra cost to always
taking the lock, but that extra cost seems like a better choice
overall.
---
 racket/src/expander/namespace/module.rkt | 24 +++++++++++-------------
 racket/src/racket/src/startup.inc        | 13 +++++--------
 2 files changed, 16 insertions(+), 21 deletions(-)

diff --git a/racket/src/expander/namespace/module.rkt b/racket/src/expander/namespace/module.rkt
index f6e2f1f4b6..1044fd13b9 100644
--- a/racket/src/expander/namespace/module.rkt
+++ b/racket/src/expander/namespace/module.rkt
@@ -494,19 +494,17 @@
   (namespace-run-available-modules! ns (add1 run-phase)))
 
 (define (namespace-run-available-modules! ns [run-phase (namespace-phase ns)])
-  ;; For a quick check, we can rely on the atomicity of `eqv?`-based hash tables
-  (unless (null? (hash-ref (namespace-available-module-instances ns) run-phase null))
-    (registry-call-with-lock
-     (namespace-module-registry ns)
-     (lambda ()
-       (let loop ()
-         (define mis (hash-ref (namespace-available-module-instances ns) run-phase null))
-         (unless (null? mis)
-           (for ([mi (in-list (reverse mis))])
-             (run-module-instance! mi ns #:run-phase run-phase #:skip-run? #f #:otherwise-available? #f))
-           (hash-set! (namespace-available-module-instances ns) run-phase null)
-           ;; In case instantiation added more reflectively:
-           (loop)))))))
+  (registry-call-with-lock
+   (namespace-module-registry ns)
+   (lambda ()
+     (let loop ()
+       (define mis (hash-ref (namespace-available-module-instances ns) run-phase null))
+       (unless (null? mis)
+         (hash-set! (namespace-available-module-instances ns) run-phase null)
+         (for ([mi (in-list (reverse mis))])
+           (run-module-instance! mi ns #:run-phase run-phase #:skip-run? #f #:otherwise-available? #f))
+         ;; In case instantiation added more reflectively:
+         (loop))))))
 
 (define (namespace-primitive-module-visit! ns name)
   (define mi (hash-ref (namespace-module-instances ns) (make-resolved-module-path name)))
diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc
index 2a4742501a..edbb9ae579 100644
--- a/racket/src/racket/src/startup.inc
+++ b/racket/src/racket/src/startup.inc
@@ -14000,9 +14000,6 @@ static const char *startup_source =
 "(let-values(((run-phase_4)"
 "(if(eq? run-phase132_0 unsafe-undefined)(namespace-phase ns_37) run-phase132_0)))"
 "(let-values()"
-"(if(null?(hash-ref(namespace-available-module-instances ns_37) run-phase_4 null))"
-"(void)"
-"(let-values()"
 "(registry-call-with-lock"
 "(namespace-module-registry$1 ns_37)"
 "(lambda()"
@@ -14019,6 +14016,10 @@ static const char *startup_source =
 "(void)"
 "(let-values()"
 "(begin"
+"(hash-set!"
+"(namespace-available-module-instances ns_37)"
+" run-phase_4"
+" null)"
 "(let-values(((lst_67)(reverse$1 mis_0)))"
 "(begin"
 "(if(variable-reference-from-unsafe?"
@@ -14068,12 +14069,8 @@ static const char *startup_source =
 " for-loop_91)"
 " lst_67)))"
 "(void)"
-"(hash-set!"
-"(namespace-available-module-instances ns_37)"
-" run-phase_4"
-" null)"
 "(loop_77)))))))))"
-" loop_77)))))))))))))"
+" loop_77)))))))))))"
 "(case-lambda"
 "((ns_38)(begin(namespace-run-available-modules!134_0 ns_38 unsafe-undefined)))"
 "((ns_39 run-phase132_1)(namespace-run-available-modules!134_0 ns_39 run-phase132_1)))))"