From mboxrd@z Thu Jan 1 00:00:00 1970 From: =?UTF-8?Q?Cl=C3=A9ment?= Lassieur Subject: bug#32234: [PATCH 1/2] utils: Avoid deadlock when WITH-CRITICAL-SECTION calls are nested. Date: Mon, 6 Aug 2018 21:27:35 +0200 Message-ID: <20180806192736.1747-1-clement@lassieur.org> References: <87k1ponc62.fsf@lassieur.org> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:54672) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fmlBh-0005Lf-PV for bug-guix@gnu.org; Mon, 06 Aug 2018 15:29:07 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fmlBe-000257-Im for bug-guix@gnu.org; Mon, 06 Aug 2018 15:29:05 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:37887) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fmlBe-00024t-Ei for bug-guix@gnu.org; Mon, 06 Aug 2018 15:29:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1fmlBe-00064L-8u for bug-guix@gnu.org; Mon, 06 Aug 2018 15:29:02 -0400 In-Reply-To: <87k1ponc62.fsf@lassieur.org> Sender: "Debbugs-submit" Resent-Message-ID: List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: "bug-Guix" To: 32234@debbugs.gnu.org * src/cuirass/utils.scm (%critical-section-args): New parameter. (make-critical-section): Put ARGS into a parameter, so that CALL-WITH-CRITICAL-SECTION knows when it's called from the critical section. In that case it would just apply PROC to ARGS. (call-with-critical-section): If already in the critical section, apply PROC to %CRITICAL-SECTION-ARGS instead of sending the message through the critical section channel. --- src/cuirass/utils.scm | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm index 9e9ac36..6083890 100644 --- a/src/cuirass/utils.scm +++ b/src/cuirass/utils.scm @@ -94,6 +94,9 @@ delimited continuations and fibers." (conclusion) (apply throw args))))) +(define %critical-section-args + (make-parameter #f)) + (define (make-critical-section . args) "Return a channel used to implement a critical section. That channel can then be passed to 'join-critical-section', which will ensure sequential @@ -104,19 +107,23 @@ dedicated fiber." (let ((channel (make-channel))) (spawn-fiber (lambda () - (let loop () - (match (get-message channel) - (((? channel? reply) . (? procedure? proc)) - (put-message reply (apply proc args)))) - (loop)))) + (parameterize ((%critical-section-args args)) + (let loop () + (match (get-message channel) + (((? channel? reply) . (? procedure? proc)) + (put-message reply (apply proc args)))) + (loop))))) channel)) (define (call-with-critical-section channel proc) - "Call PROC in the critical section corresponding to CHANNEL. Return the -result of PROC." - (let ((reply (make-channel))) - (put-message channel (cons reply proc)) - (get-message reply))) + "Send PROC to the critical section through CHANNEL. Return the result of +PROC. If already in the critical section, call PROC immediately." + (let ((args (%critical-section-args))) + (if args + (apply proc args) + (let ((reply (make-channel))) + (put-message channel (cons reply proc)) + (get-message reply))))) (define-syntax-rule (with-critical-section channel (vars ...) exp ...) "Evaluate EXP... in the critical section corresponding to CHANNEL. -- 2.18.0