From d5d02fe1e20c9ade17fcaf43d8ef39cdc05a0e16 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?=
 <address@hidden>
Date: Sat, 7 Nov 2015 21:48:56 +0100
Subject: [PATCH] Fix mutex-lock! so that (mutex-lock! <mutex> #f #f) results
 in mutex-state 'not-owned as required.  (Was incorrectly owned by the locking
 thread, but only if the thread had to wait.)

---
 srfi-18.scm | 56 +++++++++++++++++++++++++++++---------------------------
 1 file changed, 29 insertions(+), 27 deletions(-)

diff --git a/srfi-18.scm b/srfi-18.scm
index 2ae489d..4e23bd4 100644
--- a/srfi-18.scm
+++ b/srfi-18.scm
@@ -276,45 +276,47 @@
 	     (##sys#schedule) )
 	   (define (check)
 	     (when (##sys#slot mutex 4)	; abandoned
+	       (return (##sys#signal (##sys#make-structure 'condition '(abandoned-mutex-exception) (list (##sys#slot mutex 1))))) ) )
+	   (define (assign)
+	     (let ((abd (##sys#slot mutex 4)))
+	       (if (and threadsup (not thread))
+		   (begin
+		     (##sys#setislot mutex 2 #f)
+		     (##sys#setislot mutex 5 #t) )
+		   (let* ([t (or thread ct)]
+			  [ts (##sys#slot t 3)] )
+		     (if (or (eq? 'terminated ts) (eq? 'dead ts))
+			 (begin
+			   (##sys#setislot mutex 2 #f)
+			   (##sys#setislot mutex 5 #f)
+			   (##sys#setislot mutex 4 #t))
+			 (begin
+			   (##sys#setslot mutex 2 t)
+			   (##sys#setislot mutex 5 #t)
+			   (##sys#setslot t 8 (cons mutex (##sys#slot t 8))) ) ) ) )
 	       (return
-		(##sys#signal
-		 (##sys#make-structure 'condition '(abandoned-mutex-exception) '()))) ) )
-	   (dbg ct ": locking " (mutex-name mutex))
+		(if abd
+		    (##sys#signal (##sys#make-structure 'condition '(abandoned-mutex-exception) (list (##sys#slot mutex 1))))
+		    #t))))
+	   (dbg ct ": locking " mutex)
 	   (cond [(not (##sys#slot mutex 5))
-		  (if (and threadsup (not thread))
-		      (begin
-			(##sys#setislot mutex 2 #f)
-			(##sys#setislot mutex 5 #t) )
-		      (let* ([t (or thread ct)]
-			     [ts (##sys#slot t 3)] )
-			(if (or (eq? 'terminated ts) (eq? 'dead ts))
-			    (##sys#setislot mutex 4 #t)
-			    (begin
-			      (##sys#setislot mutex 5 #t)
-			      (##sys#setslot t 8 (cons mutex (##sys#slot t 8)))
-			      (##sys#setslot t 11 mutex)
-			      (##sys#setslot mutex 2 t) ) ) ) )
-		  (check)
-		  (return #t) ]
+		  (assign) ]
 		 [limit
 		  (check)
 		  (##sys#setslot
 		   ct 1 
 		   (lambda ()
-		     (##sys#setslot mutex 3 (##sys#delq ct (##sys#slot mutex 3)))
-		     (unless (##sys#slot ct 13)  ; not unblocked by timeout
-		       (##sys#remove-from-timeout-list ct))
-		     (check)
-		     (##sys#setslot ct 8 (cons mutex (##sys#slot ct 8)))
-		     (##sys#setslot ct 11 #f)
-		     (##sys#setslot mutex 2 thread)
-		     (return #f) ))
+		     (if (##sys#slot ct 13)  ; unblocked by timeout
+			 (return #f)
+			 (begin
+			   (##sys#remove-from-timeout-list ct)
+			   (assign))) ))
 		  (##sys#thread-block-for-timeout! ct limit)
 		  (switch) ]
 		 [else
 		  (##sys#setslot ct 3 'sleeping)
 		  (##sys#setslot ct 11 mutex)
-		  (##sys#setslot ct 1 (lambda () (check) (return #t)))
+		  (##sys#setslot ct 1 assign)
 		  (switch) ] ) ) ) ) ) ) )
 
 (define mutex-unlock!
-- 
2.6.1