src/code/target-unithread.lisp

   1 (in-package "SB!THREAD")
   2
   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)))
   8                (* n 4)))
   9
  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)))
  13
  14 ;;;; queues, locks
  15
  16 ;; spinlocks use 0 as "free" value: higher-level locks use NIL
  17 (defun get-spinlock (lock offset new-value)
  18   (declare (ignore lock offset new-value)))
  19
  20 (defmacro with-spinlock ((queue) &body body)
  21   (declare (ignore queue))
  22   `(progn ,@body))
  23
  24 ;;;; the higher-level locking operations are based on waitqueues
  25
  26 (defstruct waitqueue
  27   (name nil :type (or null simple-base-string))
  28   (lock 0)
  29   (data nil))
  30
  31 (defstruct (mutex (:include waitqueue))
  32   (value nil))
  33
  34 #+nil
  35 (defun wait-on-queue (queue &optional lock)
  36   (let ((pid (current-thread-id)))
  37     ;; FIXME what should happen if we get interrupted when we've blocked
  38     ;; the sigcont?  For that matter, can we get interrupted?
  39     (block-sigcont)
  40     (when lock (release-mutex lock))
  41     (get-spinlock queue 2 pid)
  42     (pushnew pid (waitqueue-data queue))
  43     (setf (waitqueue-lock queue) 0)
  44     (unblock-sigcont-and-sleep)))
  45
  46 #+nil
  47 (defun dequeue (queue)
  48   (let ((pid (current-thread-id)))
  49     (get-spinlock queue 2 pid)
  50     (setf (waitqueue-data queue)
  51           (delete pid (waitqueue-data queue)))
  52     (setf (waitqueue-lock queue) 0)))
  53
  54 #+nil
  55 (defun signal-queue-head (queue)
  56   (let ((pid (current-thread-id)))
  57     (get-spinlock queue 2 pid)
  58     (let ((h (car (waitqueue-data queue))))
  59       (setf (waitqueue-lock queue) 0)
  60       (when h
  61         (sb!unix:unix-kill h sb!unix:sigcont)))))
  62
  63 ;;;; mutex
  64
  65 #+nil
  66 (defun get-mutex (lock &optional new-value (wait-p t))
  67   (declare (type mutex lock))
  68   (let ((pid (current-thread-id)))
  69     (unless new-value (setf new-value pid))
  70     (assert (not (eql new-value (mutex-value lock))))
  71     (loop
  72      (unless
  73          ;; args are object slot-num old-value new-value
  74          (sb!vm::%instance-set-conditional lock 4 nil new-value)
  75        (dequeue lock)
  76        (return t))
  77      (unless wait-p (return nil))
  78      (wait-on-queue lock nil))))
  79
  80 #+nil
  81 (defun release-mutex (lock &optional (new-value nil))
  82   (declare (type mutex lock))
  83   (let ((old-value (mutex-value lock))
  84         (t1 nil))
  85     (loop
  86      (unless
  87          ;; args are object slot-num old-value new-value
  88          (eql old-value
  89               (setf t1
  90                     (sb!vm::%instance-set-conditional lock 4 old-value new-value)))
  91        (signal-queue-head lock)
  92        (return t))
  93      (setf old-value t1))))
  94
  95 (defmacro with-mutex ((mutex &key value (wait-p t))  &body body)
  96   (cond ((not wait-p)
  97          `(unless (mutex-value ,mutex)
  98            (unwind-protect
  99                 (progn
 100                   (setf (mutex-value ,mutex) (or ,value t))
 101                   ,@body)
 102              (setf (mutex-value ,mutex) nil))))
 103         (t
 104          `(progn ,@body))))
 105
 106 ;;; what's the best thing to do with these on unithread?  commented
 107 ;;; functions are the thread versions, just to remind me what they do
 108 ;;; there
 109 #+nil
 110 (defun condition-wait (queue lock)
 111   "Atomically release LOCK and enqueue ourselves on QUEUE.  Another
 112 thread may subsequently notify us using CONDITION-NOTIFY, at which
 113 time we reacquire LOCK and return to the caller."
 114   (unwind-protect
 115        (wait-on-queue queue lock)
 116     ;; If we are interrupted while waiting, we should do these things
 117     ;; before returning.  Ideally, in the case of an unhandled signal,
 118     ;; we should do them before entering the debugger, but this is
 119     ;; better than nothing.
 120     (dequeue queue)
 121     (get-mutex lock)))
 122
 123 #+nil
 124 (defun condition-notify (queue)
 125   "Notify one of the processes waiting on QUEUE"
 126   (signal-queue-head queue))
 127
 128 (defun maybe-install-futex-functions () nil)
 129
 130 ;;;; job control
 131
 132 (defun init-job-control () t)
 133 (defun debugger-wait-until-foreground-thread (stream)
 134   (declare (ignore stream))
 135   t)
 136 (defun get-foreground () t)
 137 (defun release-foreground (&optional next)
 138   (declare (ignore next))
 139   t)
 140 (defun terminate-session ())