1 ;;;; unithread stub support for threads in the target machine
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB!THREAD")
14 ;;; used bu debug-int.lisp to access interrupt contexts
15 #!-sb-fluid (declaim (inline sb!vm::current-thread-offset-sap))
16 (defun sb!vm::current-thread-offset-sap (n)
17 (declare (type (unsigned-byte 27) n))
18 (sb!sys:sap-ref-sap (alien-sap (extern-alien "all_threads" (* t)))
19 (* n sb!vm:n-word-bytes)))
21 (defun current-thread-id ()
22 (sb!sys:sap-ref-32 (alien-sap (extern-alien "all_threads" (* t)))
23 (* sb!vm::thread-pid-slot sb!vm:n-word-bytes)))
25 (defun reap-dead-threads ())
29 ;; spinlocks use 0 as "free" value: higher-level locks use NIL
30 (defun get-spinlock (lock offset new-value)
31 (declare (ignore lock offset new-value)))
33 (defmacro with-spinlock ((queue) &body body)
34 (declare (ignore queue))
37 ;;;; the higher-level locking operations are based on waitqueues
40 (name nil :type (or null simple-string))
44 (defstruct (mutex (:include waitqueue))
49 (defun get-mutex (lock &optional new-value (wait-p t))
50 (declare (type mutex lock))
51 (let ((old-value (mutex-value lock)))
52 (when (and old-value wait-p)
53 (error "In unithread mode, mutex ~S was requested with WAIT-P ~S and ~
54 new-value ~S, but has already been acquired (with value ~S)."
55 lock wait-p new-value old-value))
56 (setf (mutex-value lock) new-value)
59 (defun release-mutex (lock)
60 (declare (type mutex lock))
61 (setf (mutex-value lock) nil))
64 ;; FIXME need suitable stub or ERROR-signaling definitions for
65 ;; condition-wait (queue lock)
66 ;; condition-notify (queue)
70 (defun init-job-control () t)
71 (defun debugger-wait-until-foreground-thread (stream)
72 (declare (ignore stream))
74 (defun get-foreground () t)
75 (defun release-foreground (&optional next)
76 (declare (ignore next))
78 (defun terminate-session ())