-
Notifications
You must be signed in to change notification settings - Fork 1
/
thread.lisp
43 lines (40 loc) · 1.96 KB
/
thread.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
;;;; thread.lisp
(in-package #:cl-multiagent-system)
(defmacro define-thread (thread-type lambda-list
(&key declarations initialization body)
&rest accessors)
(setf accessors (prepare-accessors thread-type accessors))
(alexandria:with-gensyms (thread-fn running-p thread)
(let ((lambda-list (append-aux-to-lambda-list
lambda-list running-p thread))
(declarations (append
declarations
`((type boolean ,running-p)
(type (or null bt:thread) ,thread))))
(accessors (append
accessors
`(((running-p () :reads (,running-p))
,running-p)
((start () :writes (,running-p))
(unless (and ,thread (bt:thread-alive-p ,thread))
(setf ,thread
(bt:make-thread
(lambda () (funcall ,thread-fn self)))
,running-p t)))
((stop () :writes (,running-p))
(when ,running-p
(setf ,running-p nil)
t))
((destroy () :writes (,running-p))
(when (and ,thread (bt:thread-alive-p ,thread))
(bt:destroy-thread ,thread)
(setf ,thread nil ,running-p nil)
t))))))
`(progn
,(type-definition thread-type)
,@(accessors-definitions thread-type accessors)
(let ((,thread-fn (lambda (self)
(declare (ignorable self))
,@body)))
,(constructor-definition thread-type lambda-list
declarations initialization accessors))))))