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
19 (defun %make-thread
(function name
)
20 (ccl:process-run-function name function
))
22 (defun current-thread ()
23 ccl
:*current-process
*)
25 (defun threadp (object)
26 (typep object
'ccl
:process
))
28 (defun thread-name (thread)
29 (ccl:process-name thread
))
31 ;;; Resource contention: locks and recursive locks
33 (defun make-lock (&optional name
)
34 (ccl:make-lock
(or name
"Anonymous lock")))
36 (defun acquire-lock (lock &optional
(wait-p t
))
41 (defun release-lock (lock)
42 (ccl:release-lock lock
))
44 (defmacro with-lock-held
((place) &body body
)
45 `(ccl:with-lock-grabbed
(,place
)
48 (defun make-recursive-lock (&optional name
)
49 (ccl:make-lock
(or name
"Anonymous recursive lock")))
51 (defun acquire-recursive-lock (lock)
54 (defun release-recursive-lock (lock)
55 (ccl:release-lock lock
))
57 (defmacro with-recursive-lock-held
((place) &body body
)
58 `(ccl:with-lock-grabbed
(,place
)
61 ;;; Resource contention: condition variables
63 (defun make-condition-variable (&key name
)
64 (declare (ignore name
))
67 (defun condition-wait (condition-variable lock
)
71 (ccl:wait-on-semaphore condition-variable
))
72 (acquire-lock lock t
)))
74 (defun condition-notify (condition-variable)
75 (ccl:signal-semaphore condition-variable
))
77 (defun thread-yield ()
78 (ccl:process-allow-schedule
))
80 ;;; Introspection/debugging
85 (defun interrupt-thread (thread function
&rest args
)
86 (declare (dynamic-extent args
))
87 (apply #'ccl
:process-interrupt thread function args
))
89 (defun destroy-thread (thread)
90 (signal-error-if-current-thread thread
)
91 (ccl:process-kill thread
))
93 (defun thread-alive-p (thread)
94 (ccl::process-active-p thread
))
96 (defun join-thread (thread)
97 (ccl:join-process thread
))