[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 03/07: Make module autoloading thread-safe.
From: |
Ludovic Courtès |
Subject: |
[Guile-commits] 03/07: Make module autoloading thread-safe. |
Date: |
Mon, 18 Jun 2018 08:15:23 -0400 (EDT) |
civodul pushed a commit to branch stable-2.2
in repository guile.
commit 761cf0fb8c364e885e4c6fced34563f8157c3b84
Author: Ludovic Courtès <address@hidden>
Date: Mon Jun 18 13:42:22 2018 +0200
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 | 74 ++++++++++++++++++++++++++----------------------
module/ice-9/threads.scm | 11 ++++++-
2 files changed, 50 insertions(+), 35 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 4e51e92..6cd9b47 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1,6 +1,6 @@
;;; -*- mode: scheme; coding: utf-8; -*-
-;;;; Copyright (C) 1995-2014, 2016-2017 Free Software Foundation, Inc.
+;;;; Copyright (C) 1995-2014, 2016-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
@@ -2952,8 +2952,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 '())
@@ -2973,37 +2976,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 65108d9..c42bd26 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
- [Guile-commits] branch stable-2.2 updated (ac9f083 -> 1c970da), Ludovic Courtès, 2018/06/18
- [Guile-commits] 02/07: tests: Add SRFI-71 test., Ludovic Courtès, 2018/06/18
- [Guile-commits] 05/07: get-bytevector-n and get-bytevector-n! can now read more than 4 GB, Ludovic Courtès, 2018/06/18
- [Guile-commits] 04/07: vm: Fix typo when checking for 'madvise' error code., Ludovic Courtès, 2018/06/18
- [Guile-commits] 07/07: doc: Document (ice-9 match) macros., Ludovic Courtès, 2018/06/18
- [Guile-commits] 03/07: Make module autoloading thread-safe.,
Ludovic Courtès <=
- [Guile-commits] 01/07: Add SRFI 71: Extended LET-syntax for multiple values., Ludovic Courtès, 2018/06/18
- [Guile-commits] 06/07: doc: Fix typo., Ludovic Courtès, 2018/06/18