1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
4 Copyright
2008 Scieneer Pty Ltd
6 Distributed under the MIT license
(see LICENSE file
)
9 (in-package #:bordeaux-threads
)
11 (defun %make-thread
(function name
)
12 (thread:thread-create function
:name name
))
14 (defun current-thread ()
17 (defun threadp (object)
18 (typep object
'thread
:thread
))
20 (defun thread-name (thread)
21 (thread:thread-name thread
))
23 ;;; Resource contention: locks and recursive locks
25 (defun make-lock (&optional name
)
26 (thread:make-lock
(or name
"Anonymous lock")))
28 (defun acquire-lock (lock &optional
(wait-p t
))
29 (thread::acquire-lock lock nil wait-p
))
31 (defun release-lock (lock)
32 (thread::release-lock lock
))
34 (defmacro with-lock-held
((place) &body body
)
35 `(thread:with-lock-held
(,place
) ,@body
))
37 (defun make-recursive-lock (&optional name
)
38 (thread:make-lock
(or name
"Anonymous recursive lock")
41 ;;; XXX acquire-recursive-lock and release-recursive-lock are actually
42 ;;; complicated because we can't use control stack tricks. We need to
43 ;;; actually count something to check that the acquire/releases are
46 (defmacro with-recursive-lock-held
((place) &body body
)
47 `(thread:with-lock-held
(,place
)
50 ;;; Resource contention: condition variables
52 (defun make-condition-variable (&key name
)
53 (thread:make-cond-var
(or name
"Anonymous condition variable")))
55 (defun condition-wait (condition-variable lock
)
56 (thread:cond-var-wait condition-variable lock
))
58 (defun condition-notify (condition-variable)
59 (thread:cond-var-broadcast condition-variable
))
61 (defun thread-yield ()
64 ;;; Introspection/debugging
69 (defun interrupt-thread (thread function
)
70 (thread:thread-interrupt thread function
))
72 (defun destroy-thread (thread)
73 (thread:destroy-thread thread
))
75 (defun thread-alive-p (thread)
76 (mp:process-alive-p thread
))
78 (defun join-thread (thread)
79 (mp:process-wait
(format nil
"Waiting for thread ~A to complete" thread
)
80 (lambda () (not (mp:process-alive-p thread
)))))