~ chicken-core (chicken-5) 4c14161ba09eb1f875c40dfa0d722382fad98f36
commit 4c14161ba09eb1f875c40dfa0d722382fad98f36
Author: Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Fri Oct 11 22:22:40 2013 +0200
Commit: Mario Domenech Goulart <mario.goulart@gmail.com>
CommitDate: Thu Oct 17 15:08:09 2013 -0300
Fix #1058: never add mutex objects to FD lists in the scheduler (causes panics!)
Signed-off-by: Mario Domenech Goulart <mario.goulart@gmail.com>
diff --git a/scheduler.scm b/scheduler.scm
index bdc7c52d..f337dcf6 100644
--- a/scheduler.scm
+++ b/scheduler.scm
@@ -361,7 +361,7 @@ EOF
(define (##sys#thread-basic-unblock! t)
(dbg "unblocking: " t)
- (##sys#setislot t 11 #f) ; (FD . RWFLAGS)
+ (##sys#setislot t 11 #f) ; (FD . RWFLAGS) | #<MUTEX> | #<THREAD>
(##sys#setislot t 4 #f)
(##sys#add-to-ready-queue t) )
@@ -397,7 +397,8 @@ EOF
(for-each
(lambda (t)
(let ((p (##sys#slot t 11)))
- (fdset-set fd (cdr p))))
+ (when (pair? p) ; (FD . RWFLAGS)? (can also be mutex or thread)
+ (fdset-set fd (cdr p)))))
(cdar lst))
(loop (cdr lst))))))
@@ -580,7 +581,7 @@ EOF
(define (suspend t)
(unless (eq? t primordial)
(##sys#setslot t 3 'suspended))
- (##sys#setslot t 11 #f) ; block-object (may be thread)
+ (##sys#setslot t 11 #f) ; block-object (thread/mutex/fd & flags)
(##sys#setslot t 12 '())) ; recipients (waiting for join)
(set! ##sys#primordial-thread primordial)
(set! ready-queue-head (list primordial))
diff --git a/srfi-18.scm b/srfi-18.scm
index af4b9d54..3f8cf252 100644
--- a/srfi-18.scm
+++ b/srfi-18.scm
@@ -265,6 +265,7 @@
(lambda (return)
(let ([ct ##sys#current-thread])
(define (switch)
+ (dbg ct " sleeping on mutex " (mutex-name mutex))
(##sys#setslot mutex 3 (##sys#append (##sys#slot mutex 3) (list ct)))
(##sys#schedule) )
(define (check)
@@ -272,7 +273,7 @@
(return
(##sys#signal
(##sys#make-structure 'condition '(abandoned-mutex-exception) '()))) ) )
- (dbg ct ": locking " mutex)
+ (dbg ct ": locking " (mutex-name mutex))
(cond [(not (##sys#slot mutex 5))
(if (and threadsup (not thread))
(begin
Trap