src/code/target-thread.lisp

   1 ;;;; support for threads in the target machine common to uni- and
   2 ;;;; multithread systems
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   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.
  12
  13 (in-package "SB!THREAD")
  14
  15 (defstruct (thread (:constructor %make-thread))
  16   name
  17   %sap)
  18
  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
  25         ;; identity
  26         ))
  27   thread)
  28
  29 (defun thread-state (thread)
  30   (let ((state
  31          (sb!sys:sap-int
  32           (sb!sys:sap-ref-sap (thread-%sap thread)
  33                               (* sb!vm::thread-state-slot
  34                                  sb!vm::n-word-bytes)))))
  35     (ecase state
  36       (#.(sb!vm:fixnumize 0) :starting)
  37       (#.(sb!vm:fixnumize 1) :running)
  38       (#.(sb!vm:fixnumize 2) :suspended)
  39       (#.(sb!vm:fixnumize 3) :dead))))
  40
  41 (defun %set-thread-state (thread state)
  42   (setf (sb!sys:sap-ref-sap (thread-%sap thread)
  43                             (* sb!vm::thread-state-slot
  44                                sb!vm::n-word-bytes))
  45         (sb!sys:int-sap
  46           (ecase state
  47             (:starting #.(sb!vm:fixnumize 0))
  48             (:running #.(sb!vm:fixnumize 1))
  49             (:suspended #.(sb!vm:fixnumize 2))
  50             (:dead #.(sb!vm:fixnumize 3))))))
  51
  52 (defun thread-alive-p (thread)
  53   (not (eq :dead (thread-state thread))))
  54
  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"))
  60
  61 (defun list-all-threads ()
  62   (with-mutex (*all-threads-lock*)
  63     (copy-list *all-threads*)))
  64
  65 (declaim (inline current-thread-sap))
  66 (defun current-thread-sap ()
  67   (sb!vm::current-thread-offset-sap sb!vm::thread-this-slot))
  68
  69 (declaim (inline current-thread-sap-id))
  70 (defun current-thread-sap-id ()
  71   (sb!sys:sap-int
  72    (sb!vm::current-thread-offset-sap sb!vm::thread-os-thread-slot)))
  73
  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))))