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
)
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 (ccl::processp object
))
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
))
35 (ccl:process-lock lock ccl
:*current-process
*)
36 ;; this is broken, but it's better than a no-op
37 (ccl:without-interrupts
38 (when (null (ccl::lock.value lock
))
39 (ccl:process-lock lock ccl
:*current-process
*)))))
41 (defun release-lock (lock)
42 (ccl:process-unlock lock
))
44 (defmacro with-lock-held
((place) &body body
)
45 `(ccl:with-lock-grabbed
(,place
) ,@body
))
47 (defun thread-yield ()
48 (ccl:process-allow-schedule
))
50 ;;; Introspection/debugging
55 (defun interrupt-thread (thread function
&rest args
)
56 (declare (dynamic-extent args
))
57 (apply #'ccl
:process-interrupt thread function args
))
59 (defun destroy-thread (thread)
60 (signal-error-if-current-thread thread
)
61 (ccl:process-kill thread
))