From 6315ced2856e394271f8ee30f734e1704ee5847e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?=
 <address@hidden>
Date: Mon, 23 Nov 2015 20:34:43 +0100
Subject: [PATCH] Change (mutex-lock! #f #f) not make the mutex not owned by
 the locking thread.  Part two.

---
 srfi-18.scm          | 26 +++++++++++++++-----------
 tests/mutex-test.scm | 17 ++++++++++++++++-
 2 files changed, 31 insertions(+), 12 deletions(-)

diff --git a/srfi-18.scm b/srfi-18.scm
index 740cdba..e355e1f 100644
--- a/srfi-18.scm
+++ b/srfi-18.scm
@@ -333,6 +333,7 @@
 	   (##sys#setislot mutex 5 #f)	; blocked
 	   (let ((t (##sys#slot mutex 2)))
 	     (when t
+	       (##sys#setislot mutex 2 #f)
 	       (##sys#setslot t 8 (##sys#delq mutex (##sys#slot t 8))))) ; unown from owner
 	   (when cvar
 	     (##sys#setslot cvar 2 (##sys#append (##sys#slot cvar 2) (##sys#list ct)))
@@ -340,11 +341,12 @@
 	     (cond (limit
 		    (##sys#setslot 
 		     ct 1
-		     (lambda () 
-		       (##sys#setslot cvar 2 (##sys#delq ct (##sys#slot cvar 2)))
-		       (##sys#setslot ct 11 #f) ; block object
+		     (lambda ()
+		       (##sys#setislot ct 11 #f)
 		       (if (##sys#slot ct 13) ; unblocked by timeout
-			   (return #f)
+			   (begin
+			     (##sys#setslot cvar 2 (##sys#delq ct (##sys#slot cvar 2)))
+			     (return #f))
 			   (begin
 			     (##sys#remove-from-timeout-list ct)
 			     (return #t))) ) )
@@ -353,15 +355,17 @@
 		    (##sys#setslot ct 1 (lambda () (return #t)))
 		    (##sys#setslot ct 3 'sleeping)) ) )
 	   (unless (null? waiting)
-	     (let* ([wt (##sys#slot waiting 0)]
-		    [wts (##sys#slot wt 3)] )
+	     (let* ((wt (##sys#slot waiting 0))
+		    (wts (##sys#slot wt 3)) )
 	       (##sys#setslot mutex 3 (##sys#slot waiting 1))
 	       (##sys#setislot mutex 5 #t)
-	       (when (or (eq? wts 'blocked) (eq? wts 'sleeping))
-		 (##sys#setslot mutex 2 wt)
-		 (##sys#setslot wt 8 (cons mutex (##sys#slot wt 8)))
-		 (##sys#setslot wt 11 #f)
-		 (when (eq? wts 'sleeping) (##sys#add-to-ready-queue wt) ) ) ) )
+	       (case wts
+		 ((blocked sleeping)
+		  (##sys#setslot wt 11 #f)
+		  (##sys#add-to-ready-queue wt))
+		 (else
+		  (##sys#error 'mutex-unlock "Internal scheduler error: unknown thread state: "
+			       wt wts))) ) )
 	   (if (eq? (##sys#slot ct 3) 'running)
 	       (return #t)
 	       (##sys#schedule)) ) ) ) ) ))
diff --git a/tests/mutex-test.scm b/tests/mutex-test.scm
index 30292a7..ed2bfa6 100644
--- a/tests/mutex-test.scm
+++ b/tests/mutex-test.scm
@@ -27,9 +27,24 @@
 
 (thread-yield!)
 
+(or (eq? (mutex-state mux) 'not-owned)
+    (error "Expected 'not-owned got" (mutex-state mux)))
+
+(set! t1
+  (thread-start!
+   (lambda ()
+    (mutex-lock! mux)
+    (when (not (eq? (mutex-state mux) (current-thread)))
+      (print "Got " mux " state " (mutex-state mux) " expected " (current-thread) "\n")
+      (exit 1)))))
+
+(mutex-unlock! mux)
+
+(thread-yield!)
+
 ;; check that it is properly abandoned
 
-(when (not (handle-exceptions ex (abandoned-mutex-exception? ex) (and (mutex-lock! mux) #f)))
+(when (not (handle-exceptions ex (abandoned-mutex-exception? ex) (and (mutex-lock! mux #f) #f)))
   (print "Abandoned Mutex not abandoned " mux "\n")
   (exit 1))
 
-- 
2.6.2