1 (in-package :sb
!thread
)
4 (defun make-mutex (&key name value
) nil
)
7 (defmacro with-recursive-lock
((mutex) &body body
)
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
))
20 (when (eql (mutex-value ,mutex
) ,cfp
) (release-mutex ,mutex
))))))
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
)
28 (defun release-foreground ()
29 (sb!sys
:enable-interrupt
:sigint
:ignore
)
30 (release-mutex *session-lock
*)