1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
4 Copyright
2006, 2007 Greg Pfeil
6 Distributed under the MIT license
(see LICENSE file
)
9 (in-package #:bordeaux-threads
)
11 ;;; documentation on the SBCL Threads interface can be found at
12 ;;; http://www.sbcl.org/manual/Threading.html
16 (defun %make-thread
(function name
)
17 (sb-thread:make-thread function
:name name
))
19 (defun current-thread ()
20 sb-thread
:*current-thread
*)
22 (defun threadp (object)
23 (typep object
'sb-thread
:thread
))
25 (defun thread-name (thread)
26 (sb-thread:thread-name thread
))
28 ;;; Resource contention: locks and recursive locks
30 (defun make-lock (&optional name
)
31 (sb-thread:make-mutex
:name name
))
33 (defun acquire-lock (lock &optional
(wait-p t
))
34 (sb-thread:get-mutex lock nil wait-p
))
36 (defun release-lock (lock)
37 (sb-thread:release-mutex lock
))
39 (defmacro with-lock-held
((place) &body body
)
40 `(sb-thread:with-mutex
(,place
) ,@body
))
42 (defun make-recursive-lock (&optional name
)
43 (sb-thread:make-mutex
:name name
))
45 ;;; XXX acquire-recursive-lock and release-recursive-lock are actually
46 ;;; complicated because we can't use control stack tricks. We need to
47 ;;; actually count something to check that the acquire/releases are
50 (defmacro with-recursive-lock-held
((place) &body body
)
51 `(sb-thread:with-recursive-lock
(,place
)
54 ;;; Resource contention: condition variables
56 (defun make-condition-variable ()
57 (sb-thread:make-waitqueue
))
59 (defun condition-wait (condition-variable lock
)
60 (sb-thread:condition-wait condition-variable lock
))
62 (defun condition-notify (condition-variable)
63 (sb-thread:condition-notify condition-variable
))
65 (defun thread-yield ()
66 (sb-thread:release-foreground
))
70 (defmacro with-timeout
((timeout) &body body
)
71 `(sb-ext:with-timeout
,timeout
74 ;;; Introspection/debugging
77 (sb-thread:list-all-threads
))
79 (defun interrupt-thread (thread function
)
80 (sb-thread:interrupt-thread thread function
))
82 (defun destroy-thread (thread)
83 (signal-error-if-current-thread thread
)
84 (sb-thread:terminate-thread thread
))
86 (defun thread-alive-p (thread)
87 (sb-thread:thread-alive-p thread
))
89 (defun join-thread (thread)
90 (sb-thread:join-thread thread
))