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 OpenMCL Threads interface can be found at
12 ;;; http://openmcl.clozure.com/Doc/Programming-with-Threads.html
16 (defun %make-thread
(function name
)
17 (ccl:process-run-function name function
))
19 (defun current-thread ()
20 ccl
:*current-process
*)
22 (defun threadp (object)
23 (typep object
'ccl
:process
))
25 (defun thread-name (thread)
26 (ccl:process-name thread
))
28 ;;; Resource contention: locks and recursive locks
30 (defun make-lock (&optional name
)
31 (ccl:make-lock
(or name
"Anonymous lock")))
33 (defun acquire-lock (lock &optional
(wait-p t
))
38 (defun release-lock (lock)
39 (ccl:release-lock lock
))
41 (defmacro with-lock-held
((place) &body body
)
42 `(ccl:with-lock-grabbed
(,place
)
45 (defun make-recursive-lock (&optional name
)
46 (ccl:make-lock
(or name
"Anonymous recursive lock")))
48 (defun acquire-recursive-lock (lock)
51 (defun release-recursive-lock (lock)
52 (ccl:release-lock lock
))
54 (defmacro with-recursive-lock-held
((place) &body body
)
55 `(ccl:with-lock-grabbed
(,place
)
58 ;;; Resource contention: condition variables
60 (defun make-condition-variable (&key name
)
61 (declare (ignore name
))
64 (defun condition-wait (condition-variable lock
)
68 (ccl:wait-on-semaphore condition-variable
))
69 (acquire-lock lock t
)))
71 (defun condition-notify (condition-variable)
72 (ccl:signal-semaphore condition-variable
))
74 (defun thread-yield ()
75 (ccl:process-allow-schedule
))
77 ;;; Introspection/debugging
82 (defun interrupt-thread (thread function
)
83 (ccl:process-interrupt thread function
))
85 (defun destroy-thread (thread)
86 (signal-error-if-current-thread thread
)
87 (ccl:process-kill thread
))
89 (defun thread-alive-p (thread)
90 (ccl::process-active-p thread
))
92 (defun join-thread (thread)
93 (ccl:join-process thread
))