1 ;;;; support for threads in the target machine common to uni- and
2 ;;;; multithread systems
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
13 (in-package "SB!THREAD")
15 (defstruct (thread (:constructor %make-thread))
19 (def!method print-object ((thread thread) stream)
20 (if (thread-name thread)
21 (print-unreadable-object (thread stream :type t :identity t)
22 (prin1 (thread-name thread) stream))
23 (print-unreadable-object (thread stream :type t :identity t)
24 ;; body is empty => there is only one space between type and
29 (defun thread-state (thread)
32 (sb!sys:sap-ref-sap (thread-%sap thread)
33 (* sb!vm::thread-state-slot
34 sb!vm::n-word-bytes)))))
36 (#.(sb!vm:fixnumize 0) :starting)
37 (#.(sb!vm:fixnumize 1) :running)
38 (#.(sb!vm:fixnumize 2) :suspended)
39 (#.(sb!vm:fixnumize 3) :dead))))
41 (defun %set-thread-state (thread state)
42 (setf (sb!sys:sap-ref-sap (thread-%sap thread)
43 (* sb!vm::thread-state-slot
47 (:starting #.(sb!vm:fixnumize 0))
48 (:running #.(sb!vm:fixnumize 1))
49 (:suspended #.(sb!vm:fixnumize 2))
50 (:dead #.(sb!vm:fixnumize 3))))))
52 (defun thread-alive-p (thread)
53 (not (eq :dead (thread-state thread))))
55 ;; A thread is eligible for gc iff it has finished and there are no
56 ;; more references to it. This list is supposed to keep a reference to
57 ;; all running threads.
58 (defvar *all-threads* ())
59 (defvar *all-threads-lock* (make-mutex :name "all threads lock"))
61 (defun list-all-threads ()
62 (with-mutex (*all-threads-lock*)
63 (copy-list *all-threads*)))
65 (declaim (inline current-thread-sap))
66 (defun current-thread-sap ()
67 (sb!vm::current-thread-offset-sap sb!vm::thread-this-slot))
69 (declaim (inline current-thread-sap-id))
70 (defun current-thread-sap-id ()
72 (sb!vm::current-thread-offset-sap sb!vm::thread-os-thread-slot)))
74 (defun init-initial-thread ()
75 (let ((initial-thread (%make-thread :name "initial thread"
76 :%sap (current-thread-sap))))
77 (setq *current-thread* initial-thread)
78 ;; Either *all-threads* is empty or it contains exactly one thread
79 ;; in case we are in reinit since saving core with multiple
80 ;; threads doesn't work.
81 (setq *all-threads* (list initial-thread))))