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
)
13 (defun %make-thread
(function name
)
14 (mt:make-thread function
:name name
))
16 (defun current-thread ()
19 (defun threadp (object)
22 (defun thread-name (thread)
23 (mt:thread-name thread
))
25 ;;; Resource contention: locks and recursive locks
27 (defun make-lock (&optional name
)
28 (mt:make-mutex
:name name
))
30 (defun acquire-lock (lock &optional
(wait-p t
))
31 (declare (ignore wait-p
))
34 (defun release-lock (lock)
35 (mt:mutex-unlock lock
))
37 (defmacro with-lock-held
((place) &body body
)
38 `(mt:with-lock
(,place
) ,@body
))
40 (defun make-recursive-lock (&optional name
)
41 (mt:make-mutex
:name name
:recursive-p t
))
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 `(mt:with-lock
(,place
) ,@body
))
51 ;;; Resource contention: condition variables
53 (defun make-condition-variable ()
56 (defun condition-wait (condition-variable lock
)
57 (mt:exemption-wait condition-variable lock
))
59 (defun condition-notify (condition-variable)
60 (mt:exemption-signal condition-variable
))
62 (defun thread-yield ()
67 (defmacro with-timeout
((timeout) &body body
)
68 `(mt:with-timeout
(,timeout
)
71 ;;; Introspection/debugging
76 (defun interrupt-thread (thread function
)
77 (mt:thread-interrupt thread function
))
79 (defun destroy-thread (thread)
80 (signal-error-if-current-thread thread
)
81 (mt:thread-kill thread
))
83 (defun thread-alive-p (thread)
84 (mt:thread-active-p thread
))