[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#32121] [PATCH 2/5] utils: Reset the Fiber dynamic environment in %N
From: |
Clément Lassieur |
Subject: |
[bug#32121] [PATCH 2/5] utils: Reset the Fiber dynamic environment in %NON-BLOCKING. |
Date: |
Wed, 11 Jul 2018 01:02:44 +0200 |
* src/cuirass/utils.scm (%non-blocking): Wrap body in PARAMETERIZE form that
clears CURRENT-FIBER.
So that PUT-MESSAGE doesn't try to suspend itself within CALL-WITH-NEW-THREAD.
See https://lists.gnu.org/archive/html/guile-devel/2018-07/msg00009.html.
---
src/cuirass/utils.scm | 34 ++++++++++++++++++----------------
1 file changed, 18 insertions(+), 16 deletions(-)
diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm
index bbecfb6..d219a3e 100644
--- a/src/cuirass/utils.scm
+++ b/src/cuirass/utils.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2012, 2013, 2016, 2018 Ludovic Courtès <address@hidden>
;;; Copyright © 2015 David Thompson <address@hidden>
;;; Copyright © 2016 Mathieu Lirzin <address@hidden>
+;;; Copyright © 2018 Clément Lassieur <address@hidden>
;;;
;;; This file is part of Cuirass.
;;;
@@ -122,22 +123,23 @@ VARS... are bound to the arguments of the critical
section."
(lambda (vars ...) exp ...)))
(define (%non-blocking thunk)
- (let ((channel (make-channel)))
- (call-with-new-thread
- (lambda ()
- (catch #t
- (lambda ()
- (call-with-values thunk
- (lambda values
- (put-message channel `(values ,@values)))))
- (lambda args
- (put-message channel `(exception ,@args))))))
-
- (match (get-message channel)
- (('values . results)
- (apply values results))
- (('exception . args)
- (apply throw args)))))
+ (parameterize (((@@ (fibers internal) current-fiber) #f))
+ (let ((channel (make-channel)))
+ (call-with-new-thread
+ (lambda ()
+ (catch #t
+ (lambda ()
+ (call-with-values thunk
+ (lambda values
+ (put-message channel `(values ,@values)))))
+ (lambda args
+ (put-message channel `(exception ,@args))))))
+
+ (match (get-message channel)
+ (('values . results)
+ (apply values results))
+ (('exception . args)
+ (apply throw args))))))
(define-syntax-rule (non-blocking exp ...)
"Evalaute EXP... in a separate thread so that it doesn't block the execution
--
2.18.0
[bug#32121] [PATCH 4/5] database: Call a specification 'jobset' instead of 'project'., Clément Lassieur, 2018/07/10