1 (in-package "SB!THREAD")
3 ;;; used bu debug-int.lisp to access interrupt contexts
4 #!-sb-fluid
(declaim (inline sb
!vm
::current-thread-offset-sap
))
5 (defun sb!vm
::current-thread-offset-sap
(n)
6 (declare (type (unsigned-byte 27) n
))
7 (sb!sys
:sap-ref-sap
(alien-sap (extern-alien "all_threads" (* t
)))
10 (defun current-thread-id ()
11 (sb!sys
:sap-ref-32
(alien-sap (extern-alien "all_threads" (* t
)))
12 (* sb
!vm
::thread-pid-slot
4)))
16 ;; spinlocks use 0 as "free" value: higher-level locks use NIL
17 (defun get-spinlock (lock offset new-value
) )
19 (defmacro with-spinlock
((queue) &body body
)
22 ;;;; the higher-level locking operations are based on waitqueues
25 (name nil
:type
(or null simple-base-string
))
29 (defstruct (mutex (:include waitqueue
))
33 (defun wait-on-queue (queue &optional lock
)
34 (let ((pid (current-thread-id)))
35 ;; FIXME what should happen if we get interrupted when we've blocked
36 ;; the sigcont? For that matter, can we get interrupted?
38 (when lock
(release-mutex lock
))
39 (get-spinlock queue
2 pid
)
40 (pushnew pid
(waitqueue-data queue
))
41 (setf (waitqueue-lock queue
) 0)
42 (unblock-sigcont-and-sleep)))
45 (defun dequeue (queue)
46 (let ((pid (current-thread-id)))
47 (get-spinlock queue
2 pid
)
48 (setf (waitqueue-data queue
)
49 (delete pid
(waitqueue-data queue
)))
50 (setf (waitqueue-lock queue
) 0)))
53 (defun signal-queue-head (queue)
54 (let ((pid (current-thread-id)))
55 (get-spinlock queue
2 pid
)
56 (let ((h (car (waitqueue-data queue
))))
57 (setf (waitqueue-lock queue
) 0)
59 (sb!unix
:unix-kill h sb
!unix
:sigcont
)))))
64 (defun get-mutex (lock &optional new-value
(wait-p t
))
65 (declare (type mutex lock
))
66 (let ((pid (current-thread-id)))
67 (unless new-value
(setf new-value pid
))
68 (assert (not (eql new-value
(mutex-value lock
))))
71 ;; args are object slot-num old-value new-value
72 (sb!vm
::%instance-set-conditional lock
4 nil new-value
)
75 (unless wait-p
(return nil
))
76 (wait-on-queue lock nil
))))
79 (defun release-mutex (lock &optional
(new-value nil
))
80 (declare (type mutex lock
))
81 (let ((old-value (mutex-value lock
))
85 ;; args are object slot-num old-value new-value
88 (sb!vm
::%instance-set-conditional lock
4 old-value new-value
)))
89 (signal-queue-head lock
)
91 (setf old-value t1
))))
93 (defmacro with-mutex
((mutex &key value
(wait-p t
)) &body body
)
95 `(unless (mutex-value ,mutex
)
98 (setf (mutex-value ,mutex
) (or ,value t
))
100 (setf (mutex-value ,mutex
) nil
))))
104 ;;; what's the best thing to do with these on unithread?
106 (defun condition-wait (queue lock
)
107 "Atomically release LOCK and enqueue ourselves on QUEUE. Another
108 thread may subsequently notify us using CONDITION-NOTIFY, at which
109 time we reacquire LOCK and return to the caller."
111 (wait-on-queue queue lock
)
112 ;; If we are interrupted while waiting, we should do these things
113 ;; before returning. Ideally, in the case of an unhandled signal,
114 ;; we should do them before entering the debugger, but this is
115 ;; better than nothing.
120 (defun condition-notify (queue)
121 "Notify one of the processes waiting on QUEUE"
122 (signal-queue-head queue
))
124 (defun maybe-install-futex-functions () nil
)
128 (defun init-job-control () t
)
129 (defun debugger-wait-until-foreground-thread (stream) t
)
130 (defun get-foreground () t
)
131 (defun release-foreground (&optional next
) t
)