Untabify bordeaux-threads-test.lisp
[bordeaux-threads.git] / src / impl-ecl.lisp
blob9e37d73e887ef8a789b34ec7c067e0cf24a05881
1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
3 #|
4 Copyright 2006, 2007 Greg Pfeil
6 Distributed under the MIT license (see LICENSE file)
7 |#
9 (in-package #:bordeaux-threads)
11 ;;; documentation on the ECL Multiprocessing interface can be found at
12 ;;; http://ecls.sourceforge.net/cgi-bin/view/Main/MultiProcessing
14 ;;; Thread Creation
16 (defun %make-thread (function name)
17 (mp:process-run-function name function))
19 (defun current-thread ()
20 mp::*current-process*)
22 (defun threadp (object)
23 (typep object 'mp:process))
25 (defun thread-name (thread)
26 (mp:process-name thread))
28 ;;; Resource contention: locks and recursive locks
30 (defun make-lock (&optional name)
31 (mp:make-lock :name (or name "Anonymous lock")))
33 (defun acquire-lock (lock &optional (wait-p t))
34 (mp:get-lock lock wait-p))
36 (defun release-lock (lock)
37 (mp:giveup-lock lock))
39 (defmacro with-lock-held ((place) &body body)
40 `(mp:with-lock (,place) ,@body))
42 ;; FIXME: Missing:
43 ;; * make-recursive-lock
44 ;; * acquire-recursive-lock
45 ;; * release-recursive-lock
47 ;;; Resource contention: condition variables
49 (defun thread-yield ()
50 ;; (mp:yield)
51 (sleep 0))
53 ;;; Introspection/debugging
55 (defun all-threads ()
56 (mp:all-processes))
58 (defun interrupt-thread (thread function)
59 (mp:interrupt-process thread function))
61 (defun destroy-thread (thread)
62 (signal-error-if-current-thread thread)
63 (mp:process-kill thread))
65 (defun thread-alive-p (thread)
66 (mp:process-active-p thread))
68 (mark-supported)