(in-package "SB!THREAD")
+;;; Of the WITH-PINNED-OBJECTS in this file, not every single one is
+;;; necessary because threads are only supported with the conservative
+;;; gencgc and numbers on the stack (returned by GET-LISP-OBJ-ADDRESS)
+;;; are treated as references.
+
;;; set the doc here because in early-thread FDOCUMENTATION is not
;;; available, yet
#!+sb-doc
;;;; spinlocks
-(defstruct spinlock
- #!+sb-doc
- "Spinlock type."
- (name nil :type (or null simple-string))
- (value 0))
-
(declaim (inline get-spinlock release-spinlock))
;;; The bare 2 here and below are offsets of the slots in the struct.
;;; There ought to be some better way to get these numbers
-(defun get-spinlock (spinlock new-value)
+(defun get-spinlock (spinlock)
(declare (optimize (speed 3) (safety 0))
#!-sb-thread
(ignore spinlock new-value))
;; store any value
#!+sb-thread
(loop until
- (eql (sb!vm::%instance-set-conditional spinlock 2 0 new-value) 0)))
+ (eql (sb!vm::%instance-set-conditional spinlock 2 0 1) 0)))
(defun release-spinlock (spinlock)
(declare (optimize (speed 3) (safety 0))
(defmacro with-spinlock ((spinlock) &body body)
(sb!int:with-unique-names (lock)
`(let ((,lock ,spinlock))
- (get-spinlock ,lock *current-thread*)
+ (get-spinlock ,lock)
(unwind-protect
(progn ,@body)
(release-spinlock ,lock)))))
;;;; mutexes
-(defstruct mutex
- #!+sb-doc
- "Mutex type."
- (name nil :type (or null simple-string))
- (value nil))
-
#!+sb-doc
(setf (sb!kernel:fdocumentation 'make-mutex 'function)
"Create a mutex."
(+ (sb!kernel:get-lisp-obj-address mutex)
(- (* 3 sb!vm:n-word-bytes) sb!vm:instance-pointer-lowtag))))
-(defun get-mutex (mutex &optional new-value (wait-p t))
+(defun get-mutex (mutex &optional (new-value *current-thread*) (wait-p t))
#!+sb-doc
"Acquire MUTEX, setting it to NEW-VALUE or some suitable default
value if NIL. If WAIT-P is non-NIL and the mutex is in use, sleep
until it is available"
(declare (type mutex mutex) (optimize (speed 3)))
- (unless new-value (setf new-value *current-thread*))
+ (unless new-value
+ (setq new-value *current-thread*))
#!-sb-thread
(let ((old-value (mutex-value mutex)))
(when (and old-value wait-p)
(setf old (sb!vm::%instance-set-conditional mutex 2 nil new-value))
(return t))
(unless wait-p (return nil))
- (futex-wait (mutex-value-address mutex)
- (sb!kernel:get-lisp-obj-address old)))))
+ (with-pinned-objects (mutex old)
+ (futex-wait (mutex-value-address mutex)
+ (sb!kernel:get-lisp-obj-address old))))))
(defun release-mutex (mutex)
#!+sb-doc
;; this comment, it will change queue->data, and so
;; futex-wait returns immediately instead of sleeping.
;; Ergo, no lost wakeup
- (futex-wait (waitqueue-data-address queue)
- (sb!kernel:get-lisp-obj-address me)))
+ (with-pinned-objects (queue me)
+ (futex-wait (waitqueue-data-address queue)
+ (sb!kernel:get-lisp-obj-address me))))
;; If we are interrupted while waiting, we should do these things
;; before returning. Ideally, in the case of an unhandled signal,
;; we should do them before entering the debugger, but this is
;; XXX we should do something to ensure that the result of this setf
;; is visible to all CPUs
(setf (waitqueue-data queue) me)
- (futex-wake (waitqueue-data-address queue) n)))
+ (with-pinned-objects (queue)
+ (futex-wake (waitqueue-data-address queue) n))))
(defun condition-broadcast (queue)
#!+sb-doc
;; reference to this thread
(handle-thread-exit thread)))))))
(values))))
+ ;; Keep INITIAL-FUNCTION pinned until the child thread is
+ ;; initialized properly.
(with-pinned-objects (initial-function)
(let ((os-thread
- ;; don't let the child inherit *CURRENT-THREAD* because that
- ;; can prevent gc'ing this thread while the child runs
- (let ((*current-thread* nil))
- (%create-thread
- (sb!kernel:get-lisp-obj-address initial-function)))))
+ (%create-thread
+ (sb!kernel:get-lisp-obj-address initial-function))))
(when (zerop os-thread)
(error "Can't create a new thread"))
(wait-on-semaphore setup-sem)
(let ((os-thread (sap-ref-word thread-sap
(* sb!vm:n-word-bytes
sb!vm::thread-os-thread-slot))))
- (print os-thread)
(when (= os-thread id) (return thread-sap))
(setf thread-sap
(sap-ref-sap thread-sap (* sb!vm:n-word-bytes