1 ;;;; support for threads needed at cross-compile time
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB!THREAD")
14 (sb!xc
:defmacro with-mutex
((mutex &key value
(wait-p t
)) &body body
)
15 #!-sb-thread
(declare (ignore mutex value wait-p
))
17 (with-unique-names (got)
18 `(let ((,got
(get-mutex ,mutex
,value
,wait-p
)))
22 (release-mutex ,mutex
)))))
23 ;; KLUDGE: this separate expansion for (NOT SB-THREAD) is not
24 ;; strictly necessary; GET-MUTEX and RELEASE-MUTEX are implemented.
25 ;; However, there would be a (possibly slight) performance hit in
30 (sb!xc
:defmacro with-recursive-lock
((mutex) &body body
)
31 #!-sb-thread
(declare (ignore mutex
))
33 (with-unique-names (cfp)
34 `(let ((,cfp
(sb!kernel
:current-fp
)))
35 (unless (and (mutex-value ,mutex
)
36 (sb!vm
:control-stack-pointer-valid-p
38 (sb!kernel
:get-lisp-obj-address
(mutex-value ,mutex
)))))
39 ;; this punning with MAKE-LISP-OBJ depends for its safety on
40 ;; the frame pointer being a lispobj-aligned integer. While
41 ;; it is, then MAKE-LISP-OBJ will always return a FIXNUM, so
42 ;; we're safe to do that. Should this ever change, this
43 ;; MAKE-LISP-OBJ could return something that looks like a
44 ;; pointer, but pointing into neverneverland, which will
45 ;; confuse GC completely. -- CSR, 2003-06-03
46 (get-mutex ,mutex
(sb!kernel
:make-lisp-obj
(sb!sys
:sap-int
,cfp
))))
49 (when (sb!sys
:sap
= (sb!sys
:int-sap
50 (sb!kernel
:get-lisp-obj-address
51 (mutex-value ,mutex
)))
53 (release-mutex ,mutex
)))))