-
Notifications
You must be signed in to change notification settings - Fork 1
/
threads.fn
48 lines (38 loc) · 1.34 KB
/
threads.fn
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
43
44
45
46
47
48
;; ---
;; TODO: Queues are limited to the initial queue size, this is bad.
(defstruct Queue (_array _begin _end)
(constructor new ()
(set! _array (make-array 10))
(set! _begin 0)
(set! _end 0))
(method size ()
(mod (- (+ (array-size _array) _end)
_begin)
(array-size _array)))
(method push! (item)
(array-set! _array _end item)
(set! _end (mod (+ 1 _end) (array-size _array))))
(method pop! ()
(assert (< 0 (! self size)))
(let ((old-begin _begin))
(set! _begin (mod (+ 1 _begin) (array-size _array)))
(array-ref _array old-begin))))
;; ---
(def *thread-queue* (! Queue new))
(defn next-thread! ()
(! *thread-queue* push! (frame-caller ($get-frame)))
;; Note: set-frame-caller! may not be tail-called here.
(set-frame-caller! ($get-frame) (! *thread-queue* pop!))
nil)
(defn thread-die! ()
;; Note: set-frame-caller! may not be tail-called here.
(set-frame-caller! ($get-frame) (! *thread-queue* pop!))
nil)
(defn thread-new! (thunk)
(! *thread-queue* push! (frame-caller ($get-frame)))
;; Note: set-frame-caller! may not be tail-called here.
(set-frame-caller! ($get-frame) '*should-never-be-used*)
;; thread-die! needs to happen under all circumstances.
(dynamic-wind ->true thunk thread-die!))
(defn go (fn &rest args)
(thread-new! (lambda () (apply fn args))))