impl-mcl.lisp - clic - Clic is an command line interactive client for gopher wr… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
impl-mcl.lisp (1508B) | |
--- | |
1 ;;;; -*- indent-tabs-mode: nil -*- | |
2 | |
3 #| | |
4 Copyright 2006, 2007 Greg Pfeil | |
5 | |
6 Distributed under the MIT license (see LICENSE file) | |
7 |# | |
8 | |
9 (in-package #:bordeaux-threads) | |
10 | |
11 (deftype thread () | |
12 'ccl::process) | |
13 | |
14 ;;; Thread Creation | |
15 | |
16 (defun %make-thread (function name) | |
17 (ccl:process-run-function name function)) | |
18 | |
19 (defun current-thread () | |
20 ccl:*current-process*) | |
21 | |
22 (defun threadp (object) | |
23 (ccl::processp object)) | |
24 | |
25 (defun thread-name (thread) | |
26 (ccl:process-name thread)) | |
27 | |
28 ;;; Resource contention: locks and recursive locks | |
29 | |
30 (deftype lock () 'ccl:lock) | |
31 | |
32 (defun lock-p (object) | |
33 (typep object 'ccl:lock)) | |
34 | |
35 (defun make-lock (&optional name) | |
36 (ccl:make-lock (or name "Anonymous lock"))) | |
37 | |
38 (defun acquire-lock (lock &optional (wait-p t)) | |
39 (if wait-p | |
40 (ccl:process-lock lock ccl:*current-process*) | |
41 ;; this is broken, but it's better than a no-op | |
42 (ccl:without-interrupts | |
43 (when (null (ccl::lock.value lock)) | |
44 (ccl:process-lock lock ccl:*current-process*))))) | |
45 | |
46 (defun release-lock (lock) | |
47 (ccl:process-unlock lock)) | |
48 | |
49 (defmacro with-lock-held ((place) &body body) | |
50 `(ccl:with-lock-grabbed (,place) ,@body)) | |
51 | |
52 (defun thread-yield () | |
53 (ccl:process-allow-schedule)) | |
54 | |
55 ;;; Introspection/debugging | |
56 | |
57 (defun all-threads () | |
58 ccl:*all-processes*) | |
59 | |
60 (defun interrupt-thread (thread function &rest args) | |
61 (declare (dynamic-extent args)) | |
62 (apply #'ccl:process-interrupt thread function args)) | |
63 | |
64 (defun destroy-thread (thread) | |
65 (signal-error-if-current-thread thread) | |
66 (ccl:process-kill thread)) | |
67 | |
68 (mark-supported) |