1 (in-package "SB!THREAD")
3 #-sb-fluid (declaim (inline sb!vm::current-thread-offset-sap))
4 (defun sb!vm::current-thread-offset-sap (n)
5 (declare (type (unsigned-byte 27) n))
6 (sb!sys:sap-ref-sap (alien-sap (extern-alien "all_threads" (* t)))
9 (defun current-thread-id ()
11 (sb!vm::current-thread-offset-sap sb!vm::thread-pid-slot)))
15 ;; spinlocks use 0 as "free" value: higher-level locks use NIL
16 (defun get-spinlock (lock offset new-value) )
18 (defmacro with-spinlock ((queue) &body body)
21 ;;;; the higher-level locking operations are based on waitqueues
24 (name nil :type (or null simple-base-string))
28 (defstruct (mutex (:include waitqueue))
32 (defun wait-on-queue (queue &optional lock)
33 (let ((pid (current-thread-id)))
34 ;; FIXME what should happen if we get interrupted when we've blocked
35 ;; the sigcont? For that matter, can we get interrupted?
37 (when lock (release-mutex lock))
38 (get-spinlock queue 2 pid)
39 (pushnew pid (waitqueue-data queue))
40 (setf (waitqueue-lock queue) 0)
41 (unblock-sigcont-and-sleep)))
44 (defun dequeue (queue)
45 (let ((pid (current-thread-id)))
46 (get-spinlock queue 2 pid)
47 (setf (waitqueue-data queue)
48 (delete pid (waitqueue-data queue)))
49 (setf (waitqueue-lock queue) 0)))
52 (defun signal-queue-head (queue)
53 (let ((pid (current-thread-id)))
54 (get-spinlock queue 2 pid)
55 (let ((h (car (waitqueue-data queue))))
56 (setf (waitqueue-lock queue) 0)
58 (sb!unix:unix-kill h :sigcont)))))
63 (defun get-mutex (lock &optional new-value (wait-p t))
64 (declare (type mutex lock))
65 (let ((pid (current-thread-id)))
66 (unless new-value (setf new-value pid))
67 (assert (not (eql new-value (mutex-value lock))))
70 ;; args are object slot-num old-value new-value
71 (sb!vm::%instance-set-conditional lock 4 nil new-value)
74 (unless wait-p (return nil))
75 (wait-on-queue lock nil))))
78 (defun release-mutex (lock &optional (new-value nil))
79 (declare (type mutex lock))
80 (let ((old-value (mutex-value lock))
84 ;; args are object slot-num old-value new-value
87 (sb!vm::%instance-set-conditional lock 4 old-value new-value)))
88 (signal-queue-head lock)
90 (setf old-value t1))))
92 (defmacro with-mutex ((mutex &key value (wait-p t)) &body body)
93 (declare (ignore mutex value wait-p))
96 ;;; what's the best thing to do with these on unithread?
98 (defun condition-wait (queue lock)
99 "Atomically release LOCK and enqueue ourselves on QUEUE. Another
100 thread may subsequently notify us using CONDITION-NOTIFY, at which
101 time we reacquire LOCK and return to the caller."
103 (wait-on-queue queue lock)
104 ;; If we are interrupted while waiting, we should do these things
105 ;; before returning. Ideally, in the case of an unhandled signal,
106 ;; we should do them before entering the debugger, but this is
107 ;; better than nothing.
112 (defun condition-notify (queue)
113 "Notify one of the processes waiting on QUEUE"
114 (signal-queue-head queue))
117 ;;;; multiple independent listeners
119 (defvar *session-lock* nil)
123 (defun debugger-wait-until-foreground-thread (stream) t)