From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: ludo@gnu.org (Ludovic =?UTF-8?Q?Court=C3=A8s?=) Newsgroups: gmane.lisp.guile.bugs Subject: bug#31878: Module autoloading is not thread safe Date: Mon, 18 Jun 2018 13:11:37 +0200 Message-ID: <878t7cwdqu.fsf@gnu.org> References: <87k1qwwhu2.fsf@gnu.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1529320278 29339 195.159.176.226 (18 Jun 2018 11:11:18 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Mon, 18 Jun 2018 11:11:18 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.1 (gnu/linux) To: 31878@debbugs.gnu.org, Andy Wingo Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Mon Jun 18 13:11:13 2018 Return-path: Envelope-to: guile-bugs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fUs41-0007Wy-IK for guile-bugs@m.gmane.org; Mon, 18 Jun 2018 13:11:13 +0200 Original-Received: from localhost ([::1]:34009 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fUs68-00066g-Ss for guile-bugs@m.gmane.org; Mon, 18 Jun 2018 07:13:24 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:58713) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fUs5p-0005zL-Vx for bug-guile@gnu.org; Mon, 18 Jun 2018 07:13:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fUs5m-0003vH-Qm for bug-guile@gnu.org; Mon, 18 Jun 2018 07:13:05 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:46531) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fUs5m-0003uw-ME for bug-guile@gnu.org; Mon, 18 Jun 2018 07:13:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1fUs5m-0002k9-8a; Mon, 18 Jun 2018 07:13:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: ludo@gnu.org (Ludovic =?UTF-8?Q?Court=C3=A8s?=) Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Mon, 18 Jun 2018 11:13:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 31878 X-GNU-PR-Package: guile X-GNU-PR-Keywords: Original-Received: via spool by 31878-submit@debbugs.gnu.org id=B31878.152932035210510 (code B ref 31878); Mon, 18 Jun 2018 11:13:02 +0000 Original-Received: (at 31878) by debbugs.gnu.org; 18 Jun 2018 11:12:32 +0000 Original-Received: from localhost ([127.0.0.1]:54428 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fUs5I-0002jR-DH for submit@debbugs.gnu.org; Mon, 18 Jun 2018 07:12:32 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:39215) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fUs5H-0002jG-0O for 31878@debbugs.gnu.org; Mon, 18 Jun 2018 07:12:31 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fUs58-0002bS-QJ for 31878@debbugs.gnu.org; Mon, 18 Jun 2018 07:12:25 -0400 Original-Received: from fencepost.gnu.org ([2001:4830:134:3::e]:36443) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fUs4R-0001e0-OL; Mon, 18 Jun 2018 07:11:39 -0400 Original-Received: from [193.50.110.191] (port=58746 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1fUs4R-00065o-7R; Mon, 18 Jun 2018 07:11:39 -0400 In-Reply-To: <87k1qwwhu2.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Mon, 18 Jun 2018 11:43:17 +0200") X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Original-Sender: "bug-guile" Xref: news.gmane.org gmane.lisp.guile.bugs:9067 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable ludo@gnu.org (Ludovic Court=C3=A8s) skribis: > I believe this comes from the fact that =E2=80=98autoloads-done=E2=80=99 = and related > alists in (ice-9 boot-9) are manipulated in a non-thread-safe fashion. Here=E2=80=99s a proposed fix for =E2=80=98stable-2.2=E2=80=99 as discussed= on #guile, Andy: --=-=-= Content-Type: text/x-patch Content-Disposition: inline diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 4e51e9281..960cb9fa3 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)))))) @@ -4061,6 +4067,19 @@ when none is available, reading FILE-NAME with READER." ;; Load (ice-9 threads), initializing some internal data structures. (resolve-interface '(ice-9 threads)) +(set! call-with-module-autoload-lock + (let* ((threads (resolve-module '(ice-9 threads))) + (mutex ((module-ref threads 'make-mutex) 'recursive)) + (lock (module-ref threads 'lock-mutex)) + (unlock (module-ref threads 'unlock-mutex))) + (lambda (thunk) + (dynamic-wind + (lambda () + (lock mutex)) + thunk + (lambda () + (unlock mutex)))))) + ;;; SRFI-4 in the default environment. FIXME: we should figure out how --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable How does that look? Thanks, Ludo=E2=80=99. --=-=-=--