source: project/chicken/trunk/chicken-thread-object-inlines.scm @ 13167

Last change on this file since 13167 was 13167, checked in by Kon Lovett, 11 years ago

posixunix.scm, osixwin.scm : added Unit ports use
lolevel.scm : comment fix
runtime.c : cl -> closure (like other procs), use of macros rather than open-coded block access
chicken-thread-object-inlines.scm : minor fix

File size: 6.8 KB
Line 
1;;;; chicken-thread-object-primitive-inlines.scm
2;;;; Kon Lovett, Jan '09
3
4; Usage
5;
6; (include "chicken-primitive-object-inlines")
7; (include "chicken-thread-object-inlines")
8
9;; Notes
10;
11; Provides inlines & macros for thread objects. Use of these procedures
12; by non-core & non-core-extensions is highly suspect. Many of these routines
13; are unsafe.
14;
15; In fact, any use is suspect ;-)
16
17
18;;; Mutex object helpers:
19
20;; Mutex layout:
21;
22; 0     Tag - 'mutex
23; 1     Name (object)
24; 2     Thread (thread or #f)
25; 3     Waiting threads (FIFO list)
26; 4     Abandoned? (boolean)
27; 5     Locked? (boolean)
28; 6     Specific (object)
29
30(define-inline (%mutex? x)
31  (%structure? x 'mutex) )
32
33(define-inline (%mutex-name mx)
34  (%structure-ref mx 1) )
35
36(define-inline (%mutex-thread mx)
37  (%structure-ref mx 2) )
38
39(define-inline (%mutex-thread-set! mx th)
40  (%structure-set! mx 2 th) )
41
42(define-inline (%mutex-thread-clear! mx)
43  (%structure-set!/immediate mx 2 #f) )
44
45(define-inline (%mutex-waiters mx)
46  (%structure-ref mx 3) )
47
48(define-inline (%mutex-waiters-set! mx wt)
49  (%structure-set! mx 3 wt) )
50
51(define-inline (%mutex-waiters-empty? mx)
52  (%null? (%mutex-waiters mx)) )
53
54(define-inline (%mutex-waiters-empty! mx)
55  (%structure-set!/immediate mx 3 '()) )
56
57(define-inline (%mutex-waiters-add! mx th)
58  (%mutex-waiters-set! mx (%append-item (%mutex-waiters mx) th)) )
59
60(define-inline (%mutex-waiters-delete! mx th)
61  (%mutex-waiters-set! mx (%delq! th (%mutex-waiters mx))) )
62
63(define-inline (%mutex-waiters-pop! mx)
64  (let* ([wt (%mutex-waiters mx)]
65         [top (%car wt)])
66    (%mutex-waiters-set! mx (%cdr wt))
67    top ) )
68
69(define-inline (%mutex-abandoned? mx)
70  (%structure-ref mx 4) )
71
72(define-inline (%mutex-abandoned-set! mx f)
73  (%structure-set!/immediate mx 4 f) )
74
75(define-inline (%mutex-locked? mx)
76  (%structure-ref mx 5) )
77
78(define-inline (%mutex-locked-set! mx f)
79  (%structure-set!/immediate mx 5 f) )
80
81(define-inline (%mutex-specific mx)
82  (%structure-ref mx 6) )
83
84(define-inline (%mutex-specific-set! mx x)
85  (%structure-set! mx 6 x) )
86
87
88;;; Thread object helpers:
89
90;; Thread layout:
91;
92; 0     Tag - 'thread
93; 1     Thunk (procedure)
94; 2     Results (list-of object)
95; 3     State (symbol)
96; 4     Block-timeout (fixnum or #f)
97; 5     State buffer (vector)
98;       0       Dynamic winds (list)
99;       1       Standard input (port)
100;       2       Standard output (port)
101;       3       Standard error (port)
102;       4       Exception handler (procedure)
103;       5       Parameters (vector)
104; 6     Name (object)
105; 7     Reason (condition of #f)
106; 8     Mutexes (list-of mutex)
107; 9     Quantum (fixnum)
108; 10    Specific (object)
109; 11    Block object (thread or (pair-of fd io-mode))
110; 12    Recipients (list-of thread)
111; 13    Unblocked by timeout? (boolean)
112
113(define-inline (%thread? x)
114  (%structure? x 'thread) )
115
116(define-inline (%thread-thunk th)
117  (%structure-ref th 1) )
118
119(define-inline (%thread-thunk-set! th tk)
120  (%structure-set! th 1 tk) )
121
122(define-inline (%thread-results th)
123  (%structure-ref th 2) )
124
125(define-inline (%thread-results-set! th rs)
126  (%structure-set! th 2 rs) )
127
128(define-inline (%thread-state th)
129  (%structure-ref th 3) )
130
131(define-inline (%thread-state-set! th st)
132  (%structure-set! th 3 st) )
133
134(define-inline (%thread-block-timeout th)
135  (%structure-ref th 4) )
136
137(define-inline (%thread-block-timeout-set! th to)
138  (%structure-set!/immediate th 4 to) )
139
140(define-inline (%thread-block-timeout-clear! th)
141  (%thread-block-timeout-set! th #f) )
142
143(define-inline (%thread-state-buffer th)
144  (%structure-ref th 5) )
145
146(define-inline (%thread-state-buffer-set! th v)
147  (%structure-set! th 5 v) )
148
149(define-inline (%thread-name th)
150  (%structure-ref th 6) )
151
152(define-inline (%thread-reason th)
153  (%structure-ref th 7) )
154
155(define-inline (%thread-reason-set! th cd)
156  (%structure-set! th 7 cd) )
157
158(define-inline (%thread-mutexes th)
159  (%structure-ref th 8) )
160
161(define-inline (%thread-mutexes-set! th wt)
162  (%structure-set! th 8 wx) )
163
164(define-inline (%thread-mutexes-empty? th)
165  (%null? (%thread-mutexes th)) )
166
167(define-inline (%thread-mutexes-empty! th)
168  (%structure-set!/immediate th 8 '()) )
169
170(define-inline (%thread-mutexes-add! th mx)
171  (%thread-mutexes-set! th (%cons mx (%thread-mutexes th))) )
172
173(define-inline (%thread-mutexes-delete! th mx)
174  (%thread-mutexes-set! th (%delq! mx (%thread-mutexes th))) )
175
176(define-inline (%thread-quantum th)
177  (%structure-ref th 9) )
178
179(define-inline (%thread-quantum-set! th qt)
180  (%structure-set!/immediate th 9 qt) )
181
182(define-inline (%thread-specific th)
183  (%structure-ref th 10) )
184
185(define-inline (%thread-specific-set! th x)
186  (%structure-set! th 10 x) )
187
188(define-inline (%thread-block-object th)
189  (%structure-ref th 11) )
190
191(define-inline (%thread-block-object-set! th x)
192  (%structure-set! th 11 x) )
193
194(define-inline (%thread-block-object-clear! th)
195  (%structure-set!/immediate th 11 #f) )
196
197(define-inline (%thread-recipients th)
198  (%structure-ref th 12) )
199
200(define-inline (%thread-recipients-set! th x)
201  (%structure-set! th 12 x) )
202
203(define-inline (%thread-recipients-empty? th)
204  (%null? (%condition-variable-waiters th)) )
205
206(define-inline (%thread-recipients-empty! th)
207  (%structure-set!/immediate th 12 '()) )
208
209(define-inline (%thread-recipients-add! th rth)
210  (%thread-recipients-set! t (%cons rth (%thread-recipients t))) )
211
212(define-inline (%thread-recipients-process! th tk)
213  (let ([rs (%thread-recipients t)])
214    (unless (%null? rs) (for-each tk rs) ) )
215  (thread-recipients-empty! t) )
216
217(define-inline (%thread-unblocked-by-timeout? th)
218  (%structure-ref th 13) )
219
220(define-inline (%thread-unblocked-by-timeout-set! th f)
221  (%structure-set!/immediate th 13 f) )
222
223
224;;; Condition-variable object:
225
226;; Condition-variable layout:
227;
228; 0     Tag - 'condition-variable
229; 1     Name (object)
230; 2     Waiting threads (FIFO list)
231; 3     Specific (object)
232
233(define-inline (%condition-variable? x)
234  (%structure? x 'condition-variable) )
235
236(define-inline (%condition-variable-name cv)
237  (%structure-ref cv 1) )
238
239(define-inline (%condition-variable-waiters cv)
240  (%structure-ref cv 2) )
241
242(define-inline (%condition-variable-waiters-set! cv x)
243  (%structure-set! cv 2 x) )
244
245(define-inline (%condition-variable-waiters-empty? cv)
246  (%null? (%condition-variable-waiters cv)) )
247
248(define-inline (%condition-variable-waiters-empty! cv)
249  (%structure-set!/immediate cv 2 '()) )
250
251(define-inline (%condition-variable-waiters-add! cv th)
252  (%condition-variable-waiters-set! cv (%append-item (%condition-variable-waiters cv) th)) )
253
254(define-inline (%condition-variable-waiters-delete! cv th)
255  (%condition-variable-waiters-set! cv (%delq! th (%condition-variable-waiters cv))) )
256
257(define-inline (%condition-variable-waiters-pop! mx)
258  (let* ([wt (%condition-variable-waiters mx)]
259         [top (%car wt)])
260    (%condition-variable-waiters-set! mx (%cdr wt))
261    top ) )
262
263(define-inline (%condition-variable-specific cv)
264  (%structure-ref cv 3) )
265
266(define-inline (%condition-variable-specific-set! cv x)
267  (%structure-set! cv 3 x) )
Note: See TracBrowser for help on using the repository browser.