0.9.5.58:
[sbcl.git] / src / code / thread.lisp
1 ;;;; support for threads needed at cross-compile time
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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.
11
12 (in-package "SB!THREAD")
13
14 (sb!xc:defmacro with-mutex ((mutex &key (value '*current-thread*) (wait-p t))
15                             &body body)
16   #!+sb-doc
17   "Acquire MUTEX for the dynamic scope of BODY, setting it to
18 NEW-VALUE or some suitable default value if NIL.  If WAIT-P is non-NIL
19 and the mutex is in use, sleep until it is available"
20   #!-sb-thread (declare (ignore mutex value wait-p))
21   #!+sb-thread
22   (with-unique-names (got mutex1)
23     `(let ((,mutex1 ,mutex)
24            ,got)
25        (unwind-protect
26             ;; FIXME: async unwind in SETQ form
27             (when (setq ,got (get-mutex ,mutex1 ,value ,wait-p))
28               (locally
29                   ,@body))
30          (when ,got
31            (release-mutex ,mutex1)))))
32   ;; KLUDGE: this separate expansion for (NOT SB-THREAD) is not
33   ;; strictly necessary; GET-MUTEX and RELEASE-MUTEX are implemented.
34   ;; However, there would be a (possibly slight) performance hit in
35   ;; using them.
36   #!-sb-thread
37   `(locally ,@body))
38
39 (sb!xc:defmacro with-recursive-lock ((mutex) &body body)
40   #!+sb-doc
41   "Acquires MUTEX for the dynamic scope of BODY. Within that scope
42 further recursive lock attempts for the same mutex succeed. It is
43 allowed to mix WITH-MUTEX and WITH-RECURSIVE-LOCK for the same mutex
44 provided the default value is used for the mutex."
45   #!-sb-thread
46   (declare (ignore mutex)) #!+sb-thread
47   (with-unique-names (mutex1 inner-lock-p)
48     `(let* ((,mutex1 ,mutex)
49             (,inner-lock-p (eq (mutex-value ,mutex1) *current-thread*)))
50        (unwind-protect
51             (progn
52               (unless ,inner-lock-p
53                 (get-mutex ,mutex1))
54               (locally
55                   ,@body))
56          (unless ,inner-lock-p
57            (release-mutex ,mutex1)))))
58   #!-sb-thread
59   `(locally ,@body))