diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-06-18 13:42:22 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2018-08-07 12:09:12 +0200 |
commit | 251202fc90f4dc22350cd9b2d85546e650391ee5 (patch) | |
tree | b3cf1eeefb335696a2dd502b4528d2a446fc2f00 | |
parent | b79a6e647d02f63769561f0e510aa0a7a58cfbc1 (diff) | |
download | guile-251202fc90f4dc22350cd9b2d85546e650391ee5.tar.gz |
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).
-rw-r--r-- | module/ice-9/boot-9.scm | 72 | ||||
-rw-r--r-- | module/ice-9/threads.scm | 11 |
2 files changed, 49 insertions, 34 deletions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 09eb871a1..ad911b9d7 100644 --- a/module/ice-9/boot-9.scm +++ b/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 -;;; are not handled in a thread-safe way. +(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 '()) @@ -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)) - (dynamic-wind - (lambda () (autoload-in-progress! dir-hint name)) - (lambda () - (with-fluids ((current-reader #f)) - (save-module-excursion - (lambda () - (define (call/ec proc) - (let ((tag (make-prompt-tag))) - (call-with-prompt - tag - (lambda () - (proc (lambda () (abort-to-prompt tag)))) - (lambda (k) (values))))) - ;; The initial environment when loading a module is a fresh - ;; user module. - (set-current-module (make-fresh-user-module)) - ;; Here we could allow some other search strategy (other than - ;; primitive-load-path), for example using versions encoded - ;; into the file system -- but then we would have to figure - ;; out how to locate the compiled file, do auto-compilation, - ;; etc. Punt for now, and don't use versions when locating - ;; the file. - (call/ec - (lambda (abort) - (primitive-load-path (in-vicinity dir-hint name) - abort) - (set! didit #t))))))) - (lambda () (set-autoloaded! dir-hint name didit))) - didit)))) + + (call-with-module-autoload-lock + (lambda () + (and (not (autoload-done-or-in-progress? dir-hint name)) + (let ((didit #f)) + (dynamic-wind + (lambda () (autoload-in-progress! dir-hint name)) + (lambda () + (with-fluids ((current-reader #f)) + (save-module-excursion + (lambda () + (define (call/ec proc) + (let ((tag (make-prompt-tag))) + (call-with-prompt + tag + (lambda () + (proc (lambda () (abort-to-prompt tag)))) + (lambda (k) (values))))) + ;; The initial environment when loading a module is a fresh + ;; user module. + (set-current-module (make-fresh-user-module)) + ;; Here we could allow some other search strategy (other than + ;; primitive-load-path), for example using versions encoded + ;; into the file system -- but then we would have to figure + ;; out how to locate the compiled file, do auto-compilation, + ;; etc. Punt for now, and don't use versions when locating + ;; the file. + (call/ec + (lambda (abort) + (primitive-load-path (in-vicinity dir-hint name) + abort) + (set! didit #t))))))) + (lambda () (set-autoloaded! dir-hint name didit))) + didit)))))) diff --git a/module/ice-9/threads.scm b/module/ice-9/threads.scm index 65108d9f1..c42bd266f 100644 --- a/module/ice-9/threads.scm +++ b/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 |