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 ()
23 (sb!sys:sap-ref-32 (alien-sap (extern-alien "all_threads" (* t)))
24 (* sb!vm::thread-os-thread-slot sb!vm:n-word-bytes)))
26 (defun reap-dead-threads ())
30 ;; spinlocks use 0 as "free" value: higher-level locks use NIL
31 (defun get-spinlock (lock offset new-value)
32 (declare (ignore lock offset new-value)))
34 (defmacro with-spinlock ((queue) &body body)
35 (declare (ignore queue))
38 ;;;; the higher-level locking operations are based on waitqueues
41 (name nil :type (or null simple-string))
45 (defstruct (mutex (:include waitqueue))
50 (defun get-mutex (lock &optional new-value (wait-p t))
51 (declare (type mutex lock))
52 (let ((old-value (mutex-value lock)))
53 (when (and old-value wait-p)
54 (error "In unithread mode, mutex ~S was requested with WAIT-P ~S and ~
55 new-value ~S, but has already been acquired (with value ~S)."
56 lock wait-p new-value old-value))
57 (setf (mutex-value lock) new-value)
60 (defun release-mutex (lock)
61 (declare (type mutex lock))
62 (setf (mutex-value lock) nil))
65 ;; FIXME need suitable stub or ERROR-signaling definitions for
66 ;; condition-wait (queue lock)
67 ;; condition-notify (queue)
71 (defun init-job-control () t)
72 (defun debugger-wait-until-foreground-thread (stream)
73 (declare (ignore stream))
75 (defun get-foreground () t)
76 (defun release-foreground (&optional next)
77 (declare (ignore next))
79 (defun terminate-session ())