mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 14:50:19 +02:00
Code Activity

Serialize accesses to submodule hash tables.

Browse source 
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'.
This commit is contained in:
Ludovic Courtès 2018-07-01 18:37:59 +02:00 • committed by Andy Wingo
parent 8840ee5a3c
commit 12f2bb5262
1 changed files with 32 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

58
module/ice-9/boot-9.scm
View file

@ -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. ;; Now that modules are booted, give module-name its final definition.
;; ;;
(define module-name (define module-name
@ -2602,7 +2610,9 @@ interfaces are added to the inports list."
;; `resolve-module'. This is important as `psyntax' stores module ;; `resolve-module'. This is important as `psyntax' stores module
;; names and relies on being able to `resolve-module' them. ;; names and relies on being able to `resolve-module' them.
(set-module-name! mod name) (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)))))) (accessor mod))))))
(define* (module-gensym #:optional (id " mg") (m (current-module))) (define* (module-gensym #:optional (id " mg") (m (current-module)))
@ -2684,25 +2694,27 @@ deterministic."
(module-define-submodule! root 'guile the-root-module) (module-define-submodule! root 'guile the-root-module)
(lambda* (name #:optional (autoload #t) (version #f) #:key (ensure #t)) (lambda* (name #:optional (autoload #t) (version #f) #:key (ensure #t))
(let ((already (nested-ref-module root name))) (call-with-module-autoload-lock
(cond (lambda ()
((and already (let ((already (nested-ref-module root name)))
(or (not autoload) (module-public-interface already))) (cond
;; A hit, a palpable hit. ((and already
(if (and version (or (not autoload) (module-public-interface already)))
(not (version-matches? version (module-version already)))) ;; A hit, a palpable hit.
(error "incompatible module version already loaded" name)) (if (and version
already) (not (version-matches? version (module-version already))))
(autoload (error "incompatible module version already loaded" name))
;; Try to autoload the module, and recurse. already)
(try-load-module name version) (autoload
(resolve-module name #f #:ensure ensure)) ;; Try to autoload the module, and recurse.
(else (try-load-module name version)
;; No module found (or if one was, it had no public interface), and (resolve-module name #f #:ensure ensure))
;; we're not autoloading. Make an empty module if #:ensure is true. (else
(or already ;; No module found (or if one was, it had no public interface), and
(and ensure ;; we're not autoloading. Make an empty module if #:ensure is true.
(make-modules-in root name))))))))) (or already
(and ensure
(make-modules-in root name)))))))))))
(define (try-load-module name version) (define (try-load-module name version)
@ -2936,12 +2948,6 @@ module '(ice-9 q) '(make-q q-length))}."
;;; {Autoloading modules} ;;; {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 '()) (define autoloads-in-progress '())
;; This function is called from scm_load_scheme_module in ;; This function is called from scm_load_scheme_module in