[Guile-commits] 43/58: Serialize accesses to submodule hash tables.

[Andy Wingo]

wingo pushed a commit to branch lightning
in repository guile.

commit 12f2bb5262f9a4f4f800888e5a0b0dfb50eea537
Author: Ludovic Courtès <address@hidden>
Date:   Sun Jul 1 18:37:59 2018 +0200

    Serialize accesses to submodule hash tables.
    
    Fixes <https://bugs.gnu.org/30602>.
    
    Previously, when compiling files in parallel like Guix does, threads
    would be concurrently inserting, rehashing, and reading the submodule
    hash table of module ().  Thus, some threads would sometimes see an
    inconsistent state, leading to errors such as:
    
      Module named (system repl debug) does not exist
    
    * module/ice-9/boot-9.scm (call-with-module-autoload-lock): Move higher
    in the file.
    (module-name): Use it around call to 'nested-define-module!'.
    (resolve-module): Wrap the whole thing in 'call-with-module-autoload-lock'.
---
 module/ice-9/boot-9.scm | 58 +++++++++++++++++++++++++++----------------------
 1 file changed, 32 insertions(+), 26 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index ad911b9..6e44ce7 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2591,6 +2591,14 @@ interfaces are added to the inports list."
 
 
 
+(define (call-with-module-autoload-lock thunk)
+  ;; This binding is overridden when (ice-9 threads) is available to
+  ;; implement a critical section around the call to THUNK.  It must be
+  ;; used anytime 'autoloads-done' and related variables are accessed
+  ;; and whenever submodules are accessed (via the 'nested-'
+  ;; procedures.)
+  (thunk))
+
 ;; Now that modules are booted, give module-name its final definition.
 ;;
 (define module-name
@@ -2602,7 +2610,9 @@ interfaces are added to the inports list."
             ;; `resolve-module'. This is important as `psyntax' stores module
             ;; names and relies on being able to `resolve-module' them.
             (set-module-name! mod name)
-            (nested-define-module! (resolve-module '() #f) name mod)
+            (call-with-module-autoload-lock
+             (lambda ()
+               (nested-define-module! (resolve-module '() #f) name mod)))
             (accessor mod))))))
 
 (define* (module-gensym #:optional (id " mg") (m (current-module)))
@@ -2684,25 +2694,27 @@ deterministic."
     (module-define-submodule! root 'guile the-root-module)
 
     (lambda* (name #:optional (autoload #t) (version #f) #:key (ensure #t))
-      (let ((already (nested-ref-module root name)))
-        (cond
-         ((and already
-               (or (not autoload) (module-public-interface already)))
-          ;; A hit, a palpable hit.
-          (if (and version
-                   (not (version-matches? version (module-version already))))
-              (error "incompatible module version already loaded" name))
-          already)
-         (autoload
-          ;; Try to autoload the module, and recurse.
-          (try-load-module name version)
-          (resolve-module name #f #:ensure ensure))
-         (else
-          ;; No module found (or if one was, it had no public interface), and
-          ;; we're not autoloading. Make an empty module if #:ensure is true.
-          (or already
-              (and ensure
-                   (make-modules-in root name)))))))))
+      (call-with-module-autoload-lock
+       (lambda ()
+         (let ((already (nested-ref-module root name)))
+           (cond
+            ((and already
+                  (or (not autoload) (module-public-interface already)))
+             ;; A hit, a palpable hit.
+             (if (and version
+                      (not (version-matches? version (module-version 
already))))
+                 (error "incompatible module version already loaded" name))
+             already)
+            (autoload
+             ;; Try to autoload the module, and recurse.
+             (try-load-module name version)
+             (resolve-module name #f #:ensure ensure))
+            (else
+             ;; No module found (or if one was, it had no public interface), 
and
+             ;; we're not autoloading. Make an empty module if #:ensure is 
true.
+             (or already
+                 (and ensure
+                      (make-modules-in root name)))))))))))
 
 
 (define (try-load-module name version)
@@ -2936,12 +2948,6 @@ module '(ice-9 q) '(make-q q-length))}."
 ;;; {Autoloading modules}
 ;;;
 
-(define (call-with-module-autoload-lock thunk)
-  ;; This binding is overridden when (ice-9 threads) is available to
-  ;; implement a critical section around the call to THUNK.  It must be
-  ;; used anytime the autoload variables below are used.
-  (thunk))
-
 (define autoloads-in-progress '())
 
 ;; This function is called from scm_load_scheme_module in