From 713bb89f472457ec6654732b6b248b17b971f0ff Mon Sep 17 00:00:00 2001 From: Alastair Bridgewater Date: Wed, 4 Aug 2010 18:03:35 +0000 Subject: [PATCH] 1.0.41.6: threads: Insert barriers as appear to be required. * This is mainly for mutexes, spinlocks, and sb-concurrency queues. * These are probably-necessary and appear to be sufficient. --- contrib/sb-concurrency/queue.lisp | 1 + src/code/target-thread.lisp | 13 +++++++++++-- version.lisp-expr | 2 +- 3 files changed, 13 insertions(+), 3 deletions(-) diff --git a/contrib/sb-concurrency/queue.lisp b/contrib/sb-concurrency/queue.lisp index fec6d0f..a902785 100644 --- a/contrib/sb-concurrency/queue.lisp +++ b/contrib/sb-concurrency/queue.lisp @@ -66,6 +66,7 @@ and secondary value." (tail (queue-tail queue)) (first-node-prev (node-prev head)) (val (node-value head))) + (barrier (:read)) (when (eq head (queue-head queue)) (cond ((not (eq val +dummy+)) (if (eq tail head) diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index 76fb998..0b129d1 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -325,7 +325,12 @@ created and old ones may exit at any time." ;; FIXME: this does not work on SMP Pentium Pro and OOSTORE systems, ;; neither on most non-x86 architectures (but we don't have threads ;; on those). - (setf (spinlock-value spinlock) nil)) + (setf (spinlock-value spinlock) nil) + + ;; FIXME: Is a :memory barrier too strong here? Can we use a :write + ;; barrier instead? + #!+(not (or x86 x86-64)) + (barrier (:memory))) ;;;; Mutexes @@ -364,6 +369,7 @@ HOLDING-MUTEX-P." #!-sb-thread (ignore waitp timeout)) (unless new-owner (setq new-owner *current-thread*)) + (barrier (:read)) (let ((old (mutex-%owner mutex))) (when (eq new-owner old) (error "Recursive lock attempt ~S." mutex)) @@ -392,6 +398,7 @@ HOLDING-MUTEX-P." (with-interrupts (%lutex-lock lutex)) (%lutex-trylock lutex)))) (setf (mutex-%owner mutex) new-owner) + (barrier (:write)) t)) #!-sb-lutex ;; This is a direct translation of the Mutex 2 algorithm from @@ -563,6 +570,7 @@ returning normally, it may do so without holding the mutex." #!-sb-thread (error "Not supported in unithread builds.") #!+sb-thread (let ((me *current-thread*)) + (barrier (:read)) (assert (eq me (mutex-%owner mutex))) (/show0 "CONDITION-WAITing") #!+sb-lutex @@ -577,7 +585,8 @@ returning normally, it may do so without holding the mutex." (with-lutex-address (mutex-lutex-address (mutex-lutex mutex)) (with-local-interrupts (%lutex-wait queue-lutex-address mutex-lutex-address))))) - (setf (mutex-%owner mutex) me))) + (barrier (:write) + (setf (mutex-%owner mutex) me)))) #!-sb-lutex ;; Need to disable interrupts so that we don't miss grabbing the ;; mutex on our way out. diff --git a/version.lisp-expr b/version.lisp-expr index 852a041..fda02a9 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.41.5" +"1.0.41.6" -- 1.7.10.4