src/code/thread.lisp

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