2 Copyright
2006, 2007 Greg Pfeil
4 Distributed under the MIT license
(see LICENSE file
)
7 (in-package #:bordeaux-threads
)
9 ;;; documentation on the SBCL Threads interface can be found at
10 ;;; http://www.sbcl.org/manual/Threading.html
14 (defun make-thread (function &key name
)
15 (sb-thread:make-thread function
:name name
))
17 (defun current-thread ()
18 sb-thread
:*current-thread
*)
20 (defun threadp (object)
21 (typep object
'sb-thread
:thread
))
23 (defun thread-name (thread)
24 (sb-thread:thread-name thread
))
26 ;;; Resource contention: locks and recursive locks
28 (defun make-lock (&optional name
)
29 (sb-thread:make-mutex
:name name
))
31 (defun acquire-lock (lock &optional
(wait-p t
))
32 (sb-thread:get-mutex lock nil wait-p
))
34 (defun release-lock (lock)
35 (sb-thread:release-mutex lock
))
37 (defmacro with-lock-held
((place) &body body
)
38 `(sb-thread:with-mutex
(,place
) ,@body
))
40 (defun make-recursive-lock (&optional name
)
41 (sb-thread:make-mutex
:name name
))
43 ;;; XXX acquire-recursive-lock and release-recursive-lock are actually
44 ;;; complicated because we can't use control stack tricks. We need to
45 ;;; actually count something to check that the acquire/releases are
48 (defmacro with-recursive-lock-held
((place) &body body
)
49 `(sb-thread:with-recursive-lock
(,place
)
52 ;;; Resource contention: condition variables
54 (defun make-condition-variable ()
55 (sb-thread:make-waitqueue
))
57 (defun condition-wait (condition-variable lock
)
58 (sb-thread:condition-wait condition-variable lock
))
60 (defun condition-notify (condition-variable)
61 (sb-thread:condition-notify condition-variable
))
63 (defun thread-yield ()
64 (sb-thread:release-foreground
))
66 ;;; Introspection/debugging
69 (sb-thread:list-all-threads
))
71 (defun interrupt-thread (thread function
)
72 (sb-thread:interrupt-thread thread function
))
74 (defun destroy-thread (thread)
75 (signal-error-if-current-thread thread
)
76 (sb-thread:terminate-thread thread
))
78 (defun thread-alive-p (thread)
79 (sb-thread:thread-alive-p thread
))