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
18 :use-standard-initial-bindings nil
))
20 (defun current-thread ()
21 ccl
:*current-process
*)
23 (defun threadp (object)
24 (typep object
'ccl
:process
))
26 (defun thread-name (thread)
27 (ccl:process-name thread
))
29 ;;; Resource contention: locks and recursive locks
31 (defun make-lock (&optional name
)
34 (defun acquire-lock (lock &optional
(wait-p t
))
39 (defun release-lock (lock)
40 (ccl:release-lock lock
))
42 (defmacro with-lock-held
((place) &body body
)
43 `(ccl:with-lock-grabbed
(,place
)
46 (defun make-recursive-lock (&optional name
)
49 (defun acquire-recursive-lock (lock)
52 (defun release-recursive-lock (lock)
53 (ccl:release-lock lock
))
55 (defmacro with-recursive-lock-held
((place) &body body
)
56 `(ccl:with-lock-grabbed
(,place
)
59 ;;; Resource contention: condition variables
61 (defun make-condition-variable ()
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
))