Make module autoloading thread-safe.

Fixes <https://bugs.gnu.org/31878>.

* module/ice-9/boot-9.scm (call-with-module-autoload-lock): New procedure.
(try-module-autoload): Wrap body in 'call-with-module-autoload-lock'.
* module/ice-9/threads.scm: Set (@ (guile) call-with-module-autoload-lock).

module/ice-9/boot-9.scm

@@ -2936,8 +2936,11 @@ module '(ice-9 q) '(make-q q-length))}."
 ;;; {Autoloading modules}
 ;;;
 
-;;; XXX FIXME autoloads-in-progress and autoloads-done
+(define (call-with-module-autoload-lock thunk)
-;;;           are not handled in a thread-safe way.
+  ;; 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 '())
 
@@ -2957,37 +2960,40 @@ but it fails to load."
                                                 file-name-separator-string))
                                dir-hint-module-name))))
     (resolve-module dir-hint-module-name #f)
-    (and (not (autoload-done-or-in-progress? dir-hint name))
+
-         (let ((didit #f))
+    (call-with-module-autoload-lock
-           (dynamic-wind
+     (lambda ()
-            (lambda () (autoload-in-progress! dir-hint name))
+       (and (not (autoload-done-or-in-progress? dir-hint name))
-            (lambda ()
+            (let ((didit #f))
-              (with-fluids ((current-reader #f))
+              (dynamic-wind
-                (save-module-excursion
+                (lambda () (autoload-in-progress! dir-hint name))
-                 (lambda () 
+                (lambda ()
-                   (define (call/ec proc)
+                  (with-fluids ((current-reader #f))
-                     (let ((tag (make-prompt-tag)))
+                    (save-module-excursion
-                       (call-with-prompt
+                     (lambda ()
-                        tag
+                       (define (call/ec proc)
-                        (lambda ()
+                         (let ((tag (make-prompt-tag)))
-                          (proc (lambda () (abort-to-prompt tag))))
+                           (call-with-prompt
-                        (lambda (k) (values)))))
+                               tag
-                   ;; The initial environment when loading a module is a fresh
+                             (lambda ()
-                   ;; user module.
+                               (proc (lambda () (abort-to-prompt tag))))
-                   (set-current-module (make-fresh-user-module))
+                             (lambda (k) (values)))))
-                   ;; Here we could allow some other search strategy (other than
+                       ;; The initial environment when loading a module is a fresh
-                   ;; primitive-load-path), for example using versions encoded
+                       ;; user module.
-                   ;; into the file system -- but then we would have to figure
+                       (set-current-module (make-fresh-user-module))
-                   ;; out how to locate the compiled file, do auto-compilation,
+                       ;; Here we could allow some other search strategy (other than
-                   ;; etc. Punt for now, and don't use versions when locating
+                       ;; primitive-load-path), for example using versions encoded
-                   ;; the file.
+                       ;; into the file system -- but then we would have to figure
-                   (call/ec
+                       ;; out how to locate the compiled file, do auto-compilation,
-                    (lambda (abort)
+                       ;; etc. Punt for now, and don't use versions when locating
-                      (primitive-load-path (in-vicinity dir-hint name)
+                       ;; the file.
-                                           abort)
+                       (call/ec
-                      (set! didit #t)))))))
+                        (lambda (abort)
-            (lambda () (set-autoloaded! dir-hint name didit)))
+                          (primitive-load-path (in-vicinity dir-hint name)
-           didit))))
+                                               abort)
+                          (set! didit #t)))))))
+                (lambda () (set-autoloaded! dir-hint name didit)))
+              didit))))))
 
 
 

module/ice-9/threads.scm

@@ -1,5 +1,5 @@
 ;;;; 	Copyright (C) 1996, 1998, 2001, 2002, 2003, 2006, 2010, 2011,
-;;;;      2012 Free Software Foundation, Inc.
+;;;;      2012, 2018 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -380,4 +380,13 @@ of applying P-PROC on ARGLISTS."
 			      (loop))))))
 		  threads)))))
 
+
+;; Now that thread support is loaded, make module autoloading
+;; thread-safe.
+(set! (@ (guile) call-with-module-autoload-lock)
+  (let ((mutex (make-mutex 'recursive)))
+    (lambda (thunk)
+      (with-mutex mutex
+        (thunk)))))
+
 ;;; threads.scm ends here