[Guile-commits] 01/05: Serialize accesses to submodule hash tables.

[Ludovic Courtès]

civodul pushed a commit to branch stable-2.2
in repository guile.

commit 533e3ff1708fef5cd00d4c0e836d7eb9f1536e0c
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 6cd9b47..db17f4d 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2607,6 +2607,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
@@ -2618,7 +2626,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)))
@@ -2700,25 +2710,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)
@@ -2952,12 +2964,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