src/code/thread.lisp

   1 (in-package :sb!thread)
   2
   3 #+sb-xc-host
   4 (defun make-mutex (&key name value) nil)
   5
   6 #+sb-xc-host
   7 (defmacro with-recursive-lock ((mutex) &body body)
   8   `(progn ,@body))
   9
  10 #-sb-xc-host
  11 (defmacro with-recursive-lock ((mutex) &body body)
  12   (let ((cfp (gensym "CFP")))
  13     `(let ((,cfp (ash (sb!sys:sap-int (sb!vm::current-fp) ) -2)))
  14       (unless (and (mutex-value ,mutex)
  15                    (SB!DI::control-stack-pointer-valid-p
  16                     (sb!sys:int-sap (ash (mutex-value ,mutex) 2))))
  17         (get-mutex ,mutex ,cfp))
  18       (unwind-protect
  19            (progn ,@body)
  20         (when (eql (mutex-value ,mutex) ,cfp) (release-mutex ,mutex))))))
  21
  22 (defun get-foreground ()
  23   (when (not (eql (mutex-value *session-lock*)  (CURRENT-THREAD-ID)))
  24     (get-mutex *session-lock*))
  25   (sb!sys:enable-interrupt :sigint #'sb!unix::sigint-handler)
  26   t)
  27
  28 (defun release-foreground ()
  29   (sb!sys:enable-interrupt :sigint :ignore)
  30   (release-mutex *session-lock*)
  31   t)