>From 0a48f5180276a08f33338b831c4d63bff5dae1c8 Mon Sep 17 00:00:00 2001
From: Peter Bex
Date: Fri, 11 Oct 2013 22:22:40 +0200
Subject: [PATCH 2/3] Fix #1058: never add mutex objects to FD lists in the
scheduler (causes panics!)
---
scheduler.scm | 7 ++++---
srfi-18.scm | 3 ++-
2 files changed, 6 insertions(+), 4 deletions(-)
diff --git a/scheduler.scm b/scheduler.scm
index bdc7c52..f337dcf 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) | # | #
(##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 af4b9d5..3f8cf25 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
--
1.8.3.4