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

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

Added core inlines include files.
Stopped 'buildsvnrevision' target from always forcing a build. Hope I didn't introduce a different bug.

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