X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-thread.lisp;h=19f27472de6112166f58a4ee7404e1f662c9d7e7;hb=c1aa8b6b5b870f21bc8c81da85708e9d71d4eb93;hp=8185b81d93e0d0a162e1d9d76f147f5ea147b435;hpb=9788b728b947d70f486188e36e4e817733b06a78;p=sbcl.git diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index 8185b81..19f2747 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -60,12 +60,7 @@ in future versions." (defvar *all-threads-lock* (make-mutex :name "all threads lock")) (defmacro with-all-threads-lock (&body body) - #!-sb-thread - `(locally ,@body) - #!+sb-thread - `(without-interrupts - (with-mutex (*all-threads-lock*) - ,@body))) + `(call-with-system-mutex (lambda () ,@body) *all-threads-lock*)) (defun list-all-threads () #!+sb-doc @@ -115,25 +110,25 @@ in future versions." (declaim (inline %lutex-init %lutex-wait %lutex-wake %lutex-lock %lutex-unlock)) - (sb!alien:define-alien-routine ("lutex_init" %lutex-init) + (define-alien-routine ("lutex_init" %lutex-init) int (lutex unsigned-long)) - (sb!alien:define-alien-routine ("lutex_wait" %lutex-wait) + (define-alien-routine ("lutex_wait" %lutex-wait) int (queue-lutex unsigned-long) (mutex-lutex unsigned-long)) - (sb!alien:define-alien-routine ("lutex_wake" %lutex-wake) + (define-alien-routine ("lutex_wake" %lutex-wake) int (lutex unsigned-long) (n int)) - (sb!alien:define-alien-routine ("lutex_lock" %lutex-lock) + (define-alien-routine ("lutex_lock" %lutex-lock) int (lutex unsigned-long)) - (sb!alien:define-alien-routine ("lutex_trylock" %lutex-trylock) + (define-alien-routine ("lutex_trylock" %lutex-trylock) int (lutex unsigned-long)) - (sb!alien:define-alien-routine ("lutex_unlock" %lutex-unlock) + (define-alien-routine ("lutex_unlock" %lutex-unlock) int (lutex unsigned-long)) - (sb!alien:define-alien-routine ("lutex_destroy" %lutex-destroy) + (define-alien-routine ("lutex_destroy" %lutex-destroy) int (lutex unsigned-long)) ;; FIXME: Defining a whole bunch of alien-type machinery just for @@ -160,13 +155,17 @@ in future versions." #!-sb-lutex (progn - (declaim (inline futex-wait futex-wake)) + (declaim (inline futex-wait %futex-wait futex-wake)) - (sb!alien:define-alien-routine "futex_wait" + (define-alien-routine ("futex_wait" %futex-wait) int (word unsigned-long) (old-value unsigned-long) (to-sec long) (to-usec unsigned-long)) - (sb!alien:define-alien-routine "futex_wake" + (defun futex-wait (word old to-sec to-usec) + (with-interrupts + (%futex-wait word old to-sec to-usec))) + + (define-alien-routine "futex_wake" int (word unsigned-long) (n unsigned-long)))) ;;; used by debug-int.lisp to access interrupt contexts @@ -182,34 +181,32 @@ in future versions." (declare (type (unsigned-byte 27) n)) (sb!vm::current-thread-offset-sap n)) -;;;; spinlocks -#!+sb-thread -(define-structure-slot-compare-and-swap - compare-and-swap-spinlock-value - :structure spinlock - :slot value) - (declaim (inline get-spinlock release-spinlock)) +;; Should always be called with interrupts disabled. (defun get-spinlock (spinlock) - (declare (optimize (speed 3) (safety 0)) - #!-sb-thread - (ignore spinlock)) - ;; %instance-set-conditional can test for 0 (which is a fixnum) and - ;; store any value - #!+sb-thread - (loop until - (eql 0 (compare-and-swap-spinlock-value spinlock 0 1))) - t) + (declare (optimize (speed 3) (safety 0))) + (let* ((new *current-thread*) + (old (sb!ext:compare-and-swap (spinlock-value spinlock) nil new))) + (when old + (when (eq old new) + (error "Recursive lock attempt on ~S." spinlock)) + #!+sb-thread + (flet ((cas () + (unless (sb!ext:compare-and-swap (spinlock-value spinlock) nil new) + (return-from get-spinlock t)))) + (if (and (not *interrupts-enabled*) *allow-with-interrupts*) + ;; If interrupts are enabled, but we are allowed to enabled them, + ;; check for pending interrupts every once in a while. + (loop + (loop repeat 128 do (cas)) ; 128 is arbitrary here + (sb!unix::%check-interrupts)) + (loop (cas))))) + t)) (defun release-spinlock (spinlock) - (declare (optimize (speed 3) (safety 0)) - #!-sb-thread (ignore spinlock)) - ;; %instance-set-conditional cannot compare arbitrary objects - ;; meaningfully, so (compare-and-swap-spinlock-value our-value 0) - ;; does not work for bignum thread ids. - #!+sb-thread - (setf (spinlock-value spinlock) 0) + (declare (optimize (speed 3) (safety 0))) + (setf (spinlock-value spinlock) nil) nil) ;;;; mutexes @@ -223,20 +220,14 @@ in future versions." "The value of the mutex. NIL if the mutex is free. Setfable.") #!+(and sb-thread (not sb-lutex)) -(progn - (define-structure-slot-addressor mutex-value-address +(define-structure-slot-addressor mutex-value-address :structure mutex :slot value) - (define-structure-slot-compare-and-swap - compare-and-swap-mutex-value - :structure mutex - :slot value)) (defun get-mutex (mutex &optional (new-value *current-thread*) (waitp t)) #!+sb-doc - "Acquire MUTEX, setting it to NEW-VALUE or some suitable default -value if NIL. If WAITP is non-NIL and the mutex is in use, sleep -until it is available." + "Acquire MUTEX, setting it to NEW-VALUE or some suitable default value if +NIL. If WAITP is non-NIL and the mutex is in use, sleep until it is available." (declare (type mutex mutex) (optimize (speed 3))) (/show0 "Entering GET-MUTEX") (unless new-value @@ -260,15 +251,20 @@ until it is available." ;; on Darwin pthread_foo_timedbar functions are not supported: ;; this means that we probably need to use the Carbon multiprocessing ;; functions on Darwin. + ;; + ;; FIXME: This is definitely not interrupt safe: what happens if + ;; we get hit (1) during the lutex calls (ok, they may be safe, + ;; but has that been checked?) (2) after the lutex call, but + ;; before setting the mutex value. #!+sb-lutex (when (zerop (with-lutex-address (lutex (mutex-lutex mutex)) (if waitp - (%lutex-lock lutex) + (with-interrupts (%lutex-lock lutex)) (%lutex-trylock lutex)))) (setf (mutex-value mutex) new-value)) #!-sb-lutex (let (old) - (when (and (setf old (compare-and-swap-mutex-value mutex nil new-value)) + (when (and (setf old (sb!ext:compare-and-swap (mutex-value mutex) nil new-value)) waitp) (loop while old do (multiple-value-bind (to-sec to-usec) (decode-timeout nil) @@ -278,7 +274,7 @@ until it is available." (or to-sec -1) (or to-usec 0)))) (signal-deadline))) - (setf old (compare-and-swap-mutex-value mutex nil new-value)))) + (setf old (sb!ext:compare-and-swap (mutex-value mutex) nil new-value)))) (not old)))) (defun release-mutex (mutex) @@ -334,6 +330,7 @@ time we reacquire MUTEX and return to the caller." (/show0 "CONDITION-WAITing") #!+sb-lutex (progn + ;; FIXME: This doesn't look interrupt safe! (setf (mutex-value mutex) nil) (with-lutex-address (queue-lutex-address (waitqueue-lutex queue)) (with-lutex-address (mutex-lutex-address (mutex-lutex mutex)) @@ -342,8 +339,8 @@ time we reacquire MUTEX and return to the caller." #!-sb-lutex (unwind-protect (let ((me *current-thread*)) - ;; XXX we should do something to ensure that the result of this setf - ;; is visible to all CPUs + ;; FIXME: should we do something to ensure that the result + ;; of this setf is visible to all CPUs? (setf (waitqueue-data queue) me) (release-mutex mutex) ;; Now we go to sleep using futex-wait. If anyone else @@ -451,13 +448,7 @@ this semaphore, then N of them is woken up." ;;; funny situations (like getting a sigint while holding the session ;;; lock) occur (defmacro with-session-lock ((session) &body body) - #!-sb-thread (declare (ignore session)) - #!-sb-thread - `(locally ,@body) - #!+sb-thread - `(without-interrupts - (with-mutex ((session-lock ,session)) - ,@body))) + `(call-with-system-mutex (lambda () ,@body) (session-lock ,session))) (defun new-session () (make-session :threads (list *current-thread*) @@ -729,11 +720,9 @@ return DEFAULT if given or else signal JOIN-THREAD-ERROR." "The thread that was not interrupted.") (defmacro with-interruptions-lock ((thread) &body body) - `(without-interrupts - (with-mutex ((thread-interruptions-lock ,thread)) - ,@body))) + `(call-with-system-mutex (lambda () ,@body) (thread-interruptions-lock ,thread))) -;; Called from the signal handler. +;; Called from the signal handler in C. (defun run-interruption () (in-interruption () (loop @@ -759,13 +748,13 @@ nature: if you interrupt a thread that was holding important locks then do something that turns out to need those locks, you probably won't like the effect." #!-sb-thread (declare (ignore thread)) - ;; not quite perfect, because it does not take WITHOUT-INTERRUPTS - ;; into account #!-sb-thread - (funcall function) + (with-interrupt-bindings + (with-interrupts (funcall function))) #!+sb-thread (if (eq thread *current-thread*) - (funcall function) + (with-interrupt-bindings + (with-interrupts (funcall function))) (let ((os-thread (thread-os-thread thread))) (cond ((not os-thread) (error 'interrupt-thread-error :thread thread))