1.0.24.26: fix release spinlock

[sbcl.git] / src / code / target-thread.lisp

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index c534ca0..fac5220 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -218,8 +218,15 @@ in future versions."
 
 (defun release-spinlock (spinlock)
   (declare (optimize (speed 3) (safety 0)))
-  (setf (spinlock-value spinlock) nil)
-  nil)
+  ;; Simply setting SPINLOCK-VALUE to NIL is not enough as it does not
+  ;; propagate to other processors, plus without a memory barrier the
+  ;; CPU might reorder instructions allowing code from the critical
+  ;; section to leak out. Use COMPARE-AND-SWAP for the memory barrier
+  ;; effect and do some sanity checking while we are at it.
+  (unless (eq *current-thread*
+              (sb!ext:compare-and-swap (spinlock-value spinlock)
+                                       *current-thread* nil))
+    (error "Only the owner can release the spinlock ~S." spinlock)))
 
 ;;;; mutexes
 
@@ -266,8 +273,13 @@ directly."
            #!-sb-thread (ignore waitp))
   (unless new-owner
     (setq new-owner *current-thread*))
-  (when (eql new-owner (mutex-%owner mutex))
-    (error "Recursive lock attempt ~S." mutex))
+  (let ((old (mutex-%owner mutex)))
+    (when (eq new-owner old)
+      (error "Recursive lock attempt ~S." mutex))
+    #!-sb-thread
+    (if old
+        (error "Strange deadlock on ~S in an unithreaded build?" mutex)
+        (setf (mutex-%owner mutex) new-owner)))
   #!+sb-thread
   (progn
     ;; FIXME: Lutexes do not currently support deadlines, as at least