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")
17 (name nil :type (or null simple-string))
23 (name nil :type (or null simple-string))
26 (sb!xc:defmacro with-mutex ((mutex &key (value '*current-thread*) (wait-p t))
29 "Acquire MUTEX for the dynamic scope of BODY, setting it to
30 NEW-VALUE or some suitable default value if NIL. If WAIT-P is non-NIL
31 and the mutex is in use, sleep until it is available"
32 #!-sb-thread (declare (ignore mutex value wait-p))
34 (with-unique-names (got mutex1)
35 `(let ((,mutex1 ,mutex)
38 ;; FIXME: async unwind in SETQ form
39 (when (setq ,got (get-mutex ,mutex1 ,value ,wait-p))
43 (release-mutex ,mutex1)))))
44 ;; KLUDGE: this separate expansion for (NOT SB-THREAD) is not
45 ;; strictly necessary; GET-MUTEX and RELEASE-MUTEX are implemented.
46 ;; However, there would be a (possibly slight) performance hit in
51 (sb!xc:defmacro with-recursive-lock ((mutex) &body body)
53 "Acquires MUTEX for the dynamic scope of BODY. Within that scope
54 further recursive lock attempts for the same mutex succeed. It is
55 allowed to mix WITH-MUTEX and WITH-RECURSIVE-LOCK for the same mutex
56 provided the default value is used for the mutex."
58 (declare (ignore mutex))
60 (with-unique-names (mutex1 inner-lock-p)
61 `(let* ((,mutex1 ,mutex)
62 (,inner-lock-p (eq (mutex-value ,mutex1) *current-thread*)))
70 (release-mutex ,mutex1)))))