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 LispWorks Multiprocessing interface can be found at
12 ;;; http://www.lispworks.com/documentation/lw445/LWUG/html/lwuser-156.htm
14 (mp:initialize-multiprocessing
)
18 (defun %make-thread
(function name
)
19 (mp:process-run-function name nil function
))
21 (defun current-thread ()
24 (defun threadp (object)
25 (typep object
'mp
:process
))
27 (defun thread-name (thread)
28 (mp:process-name thread
))
30 ;;; Resource contention: locks and recursive locks
32 (defun make-lock (&optional name
)
33 (mp:make-lock
:name
(or name
"Anonymous lock")))
35 (defun acquire-lock (lock &optional
(wait-p t
))
36 (mp:process-lock lock nil
37 (cond ((null wait-p
) 0)
38 ((numberp wait-p
) wait-p
)
41 (defun release-lock (lock)
42 (mp:process-unlock lock
))
44 (defmacro with-lock-held
((place) &body body
)
45 `(mp:with-lock
(,place
) ,@body
))
47 ;;; Resource contention: condition variables
49 (defun thread-yield ()
50 (mp:process-allow-scheduling
))
52 ;;; Introspection/debugging
55 (mp:list-all-processes
))
57 (defun interrupt-thread (thread function
)
58 (mp:process-interrupt thread function
))
60 (defun destroy-thread (thread)
61 (signal-error-if-current-thread thread
)
62 (mp:process-kill thread
))
64 (defun thread-alive-p (thread)
65 (mp:process-alive-p thread
))
67 (defun join-thread (thread)
68 (mp:process-wait
(format nil
"Waiting for thread ~A to complete" thread
)
69 (complement #'mp
:process-alive-p
) thread
))