/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- thrlib_gauche_thread_type
- thrlib_threadP
- thrlib_thread_name
- thrlib_thread_specific
- thrlib_thread_specific_setX
- thrlib_make_thread
- thrlib_thread_startX
- thrlib_thread_yieldX
- thrlib_thread_sleepX
- thrlib_thread_joinX
- thrlib_thread_terminateX
- thrlib_make_mutex
- thrlib_mutexP
- thrlib_mutex_state
- thrlib_mutex_lockX
- thrlib_mutex_unlockX
- thrlib_mutex_specific
- thrlib_mutex_specific_setX
- thrlib_mutex_name
- thrlib_make_condition_variable
- thrlib_condition_variableP
- thrlib_condition_variable_name
- thrlib_condition_variable_specific
- thrlib_condition_variable_specific_setX
- thrlib_condition_variable_signalX
- thrlib_condition_variable_broadcastX
- thread_exception_allocate
- thread_exception_print
- uncaught_exception_print
- terminated_thread_print
- Scm_ThreadExceptionClass_thread_GET
- Scm_ThreadExceptionClass_thread_SET
- Scm_AbandonedMutexExceptionClass_mutex_GET
- Scm_AbandonedMutexExceptionClass_mutex_SET
- Scm_TerminatedThreadExceptionClass_terminator_GET
- Scm_TerminatedThreadExceptionClass_terminator_SET
- Scm_UncaughtExceptionClass_reason_GET
- Scm_UncaughtExceptionClass_reason_SET
- Scm_Init_thrlib
1 /* Generated by genstub. Do not edit. */
2 #include <gauche.h>
3 #if defined(__CYGWIN__) || defined(__MINGW32__)
4 #define SCM_CGEN_CONST /*empty*/
5 #else
6 #define SCM_CGEN_CONST const
7 #endif
8
9 #include <gauche.h>
10 #include <gauche/class.h>
11 #include <gauche/exception.h>
12 #include "threads.h"
13
14 static SCM_DEFINE_STRING_CONST(sym_pthread__NAME, "pthread", 7, 7);
15 static ScmObj sym_pthread = SCM_UNBOUND;
16 static SCM_DEFINE_STRING_CONST(sym_none__NAME, "none", 4, 4);
17 static ScmObj sym_none = SCM_UNBOUND;
18 static ScmObj thrlib_gauche_thread_type(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
19 {
20 SCM_ENTER_SUBR("gauche-thread-type");
21 {
22 #ifdef GAUCHE_USE_PTHREADS
23 SCM_RETURN(sym_pthread);
24 #else
25 SCM_RETURN(sym_none);
26 #endif
27 }
28 }
29
30 static SCM_DEFINE_STRING_CONST(thrlib_gauche_thread_type__NAME, "gauche-thread-type", 18, 18);
31 static SCM_DEFINE_SUBR(thrlib_gauche_thread_type__STUB, 0, 0, SCM_OBJ(&thrlib_gauche_thread_type__NAME), thrlib_gauche_thread_type, NULL, NULL);
32
33 static ScmObj thrlib_threadP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
34 {
35 ScmObj obj_scm;
36 ScmObj obj;
37 SCM_ENTER_SUBR("thread?");
38 obj_scm = SCM_ARGREF(0);
39 obj = (obj_scm);
40 {
41 {
42 int SCM_RESULT;
43 SCM_RESULT = SCM_VMP(obj);
44 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
45 }
46 }
47 }
48
49 static SCM_DEFINE_STRING_CONST(thrlib_threadP__NAME, "thread?", 7, 7);
50 static SCM_DEFINE_SUBR(thrlib_threadP__STUB, 1, 0, SCM_OBJ(&thrlib_threadP__NAME), thrlib_threadP, NULL, NULL);
51
52 static ScmObj thrlib_thread_name(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
53 {
54 ScmObj vm_scm;
55 ScmVM* vm;
56 SCM_ENTER_SUBR("thread-name");
57 vm_scm = SCM_ARGREF(0);
58 if (!SCM_VMP(vm_scm)) Scm_Error("thread required, but got %S", vm_scm);
59 vm = SCM_VM(vm_scm);
60 {
61 {
62 ScmObj SCM_RESULT;
63 SCM_RESULT = (vm->name);
64 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
65 }
66 }
67 }
68
69 static SCM_DEFINE_STRING_CONST(thrlib_thread_name__NAME, "thread-name", 11, 11);
70 static SCM_DEFINE_SUBR(thrlib_thread_name__STUB, 1, 0, SCM_OBJ(&thrlib_thread_name__NAME), thrlib_thread_name, NULL, NULL);
71
72 static ScmObj thrlib_thread_specific(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
73 {
74 ScmObj vm_scm;
75 ScmVM* vm;
76 SCM_ENTER_SUBR("thread-specific");
77 vm_scm = SCM_ARGREF(0);
78 if (!SCM_VMP(vm_scm)) Scm_Error("thread required, but got %S", vm_scm);
79 vm = SCM_VM(vm_scm);
80 {
81 {
82 ScmObj SCM_RESULT;
83 SCM_RESULT = (vm->specific);
84 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
85 }
86 }
87 }
88
89 static SCM_DEFINE_STRING_CONST(thrlib_thread_specific__NAME, "thread-specific", 15, 15);
90 static SCM_DEFINE_SUBR(thrlib_thread_specific__STUB, 1, 0, SCM_OBJ(&thrlib_thread_specific__NAME), thrlib_thread_specific, NULL, NULL);
91
92 static ScmObj thrlib_thread_specific_setX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
93 {
94 ScmObj vm_scm;
95 ScmVM* vm;
96 ScmObj obj_scm;
97 ScmObj obj;
98 SCM_ENTER_SUBR("thread-specific-set!");
99 vm_scm = SCM_ARGREF(0);
100 if (!SCM_VMP(vm_scm)) Scm_Error("thread required, but got %S", vm_scm);
101 vm = SCM_VM(vm_scm);
102 obj_scm = SCM_ARGREF(1);
103 obj = (obj_scm);
104 {
105 vm->specific = obj;
106 SCM_RETURN(SCM_UNDEFINED);
107 }
108 }
109
110 static SCM_DEFINE_STRING_CONST(thrlib_thread_specific_setX__NAME, "thread-specific-set!", 20, 20);
111 static SCM_DEFINE_SUBR(thrlib_thread_specific_setX__STUB, 2, 0, SCM_OBJ(&thrlib_thread_specific_setX__NAME), thrlib_thread_specific_setX, NULL, NULL);
112
113 static ScmObj thrlib_make_thread(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
114 {
115 ScmObj thunk_scm;
116 ScmProcedure* thunk;
117 ScmObj name_scm;
118 ScmObj name;
119 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
120 SCM_ENTER_SUBR("make-thread");
121 if (Scm_Length(SCM_OPTARGS) > 1)
122 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
123 thunk_scm = SCM_ARGREF(0);
124 if (!SCM_PROCEDUREP(thunk_scm)) Scm_Error("procedure required, but got %S", thunk_scm);
125 thunk = SCM_PROCEDURE(thunk_scm);
126 if (SCM_NULLP(SCM_OPTARGS)) name_scm = SCM_FALSE;
127 else {
128 name_scm = SCM_CAR(SCM_OPTARGS);
129 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
130 }
131 name = (name_scm);
132 {
133 {
134 ScmObj SCM_RESULT;
135 SCM_RESULT = Scm_MakeThread(thunk, name);
136 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
137 }
138 }
139 }
140
141 static SCM_DEFINE_STRING_CONST(thrlib_make_thread__NAME, "make-thread", 11, 11);
142 static SCM_DEFINE_SUBR(thrlib_make_thread__STUB, 1, 1, SCM_OBJ(&thrlib_make_thread__NAME), thrlib_make_thread, NULL, NULL);
143
144 static ScmObj thrlib_thread_startX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
145 {
146 ScmObj vm_scm;
147 ScmVM* vm;
148 SCM_ENTER_SUBR("thread-start!");
149 vm_scm = SCM_ARGREF(0);
150 if (!SCM_VMP(vm_scm)) Scm_Error("thread required, but got %S", vm_scm);
151 vm = SCM_VM(vm_scm);
152 {
153 {
154 ScmObj SCM_RESULT;
155 SCM_RESULT = Scm_ThreadStart(vm);
156 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
157 }
158 }
159 }
160
161 static SCM_DEFINE_STRING_CONST(thrlib_thread_startX__NAME, "thread-start!", 13, 13);
162 static SCM_DEFINE_SUBR(thrlib_thread_startX__STUB, 1, 0, SCM_OBJ(&thrlib_thread_startX__NAME), thrlib_thread_startX, NULL, NULL);
163
164 static ScmObj thrlib_thread_yieldX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
165 {
166 SCM_ENTER_SUBR("thread-yield!");
167 {
168 {
169 ScmObj SCM_RESULT;
170 SCM_RESULT = Scm_ThreadYield();
171 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
172 }
173 }
174 }
175
176 static SCM_DEFINE_STRING_CONST(thrlib_thread_yieldX__NAME, "thread-yield!", 13, 13);
177 static SCM_DEFINE_SUBR(thrlib_thread_yieldX__STUB, 0, 0, SCM_OBJ(&thrlib_thread_yieldX__NAME), thrlib_thread_yieldX, NULL, NULL);
178
179 static ScmObj thrlib_thread_sleepX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
180 {
181 ScmObj timeout_scm;
182 ScmObj timeout;
183 SCM_ENTER_SUBR("thread-sleep!");
184 timeout_scm = SCM_ARGREF(0);
185 timeout = (timeout_scm);
186 {
187 {
188 ScmObj SCM_RESULT;
189 SCM_RESULT = Scm_ThreadSleep(timeout);
190 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
191 }
192 }
193 }
194
195 static SCM_DEFINE_STRING_CONST(thrlib_thread_sleepX__NAME, "thread-sleep!", 13, 13);
196 static SCM_DEFINE_SUBR(thrlib_thread_sleepX__STUB, 1, 0, SCM_OBJ(&thrlib_thread_sleepX__NAME), thrlib_thread_sleepX, NULL, NULL);
197
198 static ScmObj thrlib_thread_joinX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
199 {
200 ScmObj vm_scm;
201 ScmVM* vm;
202 ScmObj timeout_scm;
203 ScmObj timeout;
204 ScmObj timeout_val_scm;
205 ScmObj timeout_val;
206 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
207 SCM_ENTER_SUBR("thread-join!");
208 if (Scm_Length(SCM_OPTARGS) > 2)
209 Scm_Error("too many arguments: up to 2 is expected, %d given.", Scm_Length(SCM_OPTARGS));
210 vm_scm = SCM_ARGREF(0);
211 if (!SCM_VMP(vm_scm)) Scm_Error("thread required, but got %S", vm_scm);
212 vm = SCM_VM(vm_scm);
213 if (SCM_NULLP(SCM_OPTARGS)) timeout_scm = SCM_FALSE;
214 else {
215 timeout_scm = SCM_CAR(SCM_OPTARGS);
216 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
217 }
218 timeout = (timeout_scm);
219 if (SCM_NULLP(SCM_OPTARGS)) timeout_val_scm = SCM_UNBOUND;
220 else {
221 timeout_val_scm = SCM_CAR(SCM_OPTARGS);
222 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
223 }
224 timeout_val = (timeout_val_scm);
225 {
226 {
227 ScmObj SCM_RESULT;
228 SCM_RESULT = Scm_ThreadJoin(vm, timeout, timeout_val);
229 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
230 }
231 }
232 }
233
234 static SCM_DEFINE_STRING_CONST(thrlib_thread_joinX__NAME, "thread-join!", 12, 12);
235 static SCM_DEFINE_SUBR(thrlib_thread_joinX__STUB, 1, 1, SCM_OBJ(&thrlib_thread_joinX__NAME), thrlib_thread_joinX, NULL, NULL);
236
237 static ScmObj thrlib_thread_terminateX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
238 {
239 ScmObj vm_scm;
240 ScmVM* vm;
241 SCM_ENTER_SUBR("thread-terminate!");
242 vm_scm = SCM_ARGREF(0);
243 if (!SCM_VMP(vm_scm)) Scm_Error("thread required, but got %S", vm_scm);
244 vm = SCM_VM(vm_scm);
245 {
246 {
247 ScmObj SCM_RESULT;
248 SCM_RESULT = Scm_ThreadTerminate(vm);
249 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
250 }
251 }
252 }
253
254 static SCM_DEFINE_STRING_CONST(thrlib_thread_terminateX__NAME, "thread-terminate!", 17, 17);
255 static SCM_DEFINE_SUBR(thrlib_thread_terminateX__STUB, 1, 0, SCM_OBJ(&thrlib_thread_terminateX__NAME), thrlib_thread_terminateX, NULL, NULL);
256
257 static ScmObj thrlib_make_mutex(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
258 {
259 ScmObj name_scm;
260 ScmObj name;
261 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
262 SCM_ENTER_SUBR("make-mutex");
263 if (Scm_Length(SCM_OPTARGS) > 1)
264 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
265 if (SCM_NULLP(SCM_OPTARGS)) name_scm = SCM_FALSE;
266 else {
267 name_scm = SCM_CAR(SCM_OPTARGS);
268 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
269 }
270 name = (name_scm);
271 {
272 {
273 ScmObj SCM_RESULT;
274 SCM_RESULT = Scm_MakeMutex(name);
275 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
276 }
277 }
278 }
279
280 static SCM_DEFINE_STRING_CONST(thrlib_make_mutex__NAME, "make-mutex", 10, 10);
281 static SCM_DEFINE_SUBR(thrlib_make_mutex__STUB, 0, 1, SCM_OBJ(&thrlib_make_mutex__NAME), thrlib_make_mutex, NULL, NULL);
282
283 static ScmObj thrlib_mutexP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
284 {
285 ScmObj obj_scm;
286 ScmObj obj;
287 SCM_ENTER_SUBR("mutex?");
288 obj_scm = SCM_ARGREF(0);
289 obj = (obj_scm);
290 {
291 {
292 int SCM_RESULT;
293 SCM_RESULT = SCM_MUTEXP(obj);
294 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
295 }
296 }
297 }
298
299 static SCM_DEFINE_STRING_CONST(thrlib_mutexP__NAME, "mutex?", 6, 6);
300 static SCM_DEFINE_SUBR(thrlib_mutexP__STUB, 1, 0, SCM_OBJ(&thrlib_mutexP__NAME), thrlib_mutexP, NULL, NULL);
301
302 static SCM_DEFINE_STRING_CONST(sym_not_owned__NAME, "not-owned", 9, 9);
303 static ScmObj sym_not_owned = SCM_UNBOUND;
304 static SCM_DEFINE_STRING_CONST(sym_abandoned__NAME, "abandoned", 9, 9);
305 static ScmObj sym_abandoned = SCM_UNBOUND;
306 static SCM_DEFINE_STRING_CONST(sym_not_abandoned__NAME, "not-abandoned", 13, 13);
307 static ScmObj sym_not_abandoned = SCM_UNBOUND;
308 static ScmObj thrlib_mutex_state(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
309 {
310 ScmObj mutex_scm;
311 ScmMutex* mutex;
312 SCM_ENTER_SUBR("mutex-state");
313 mutex_scm = SCM_ARGREF(0);
314 if (!SCM_MUTEXP(mutex_scm)) Scm_Error("mutex required, but got %S", mutex_scm);
315 mutex = SCM_MUTEX(mutex_scm);
316 {
317 ScmObj r;
318 (void)SCM_INTERNAL_MUTEX_LOCK(mutex->mutex);
319 if (mutex->locked) {
320 if (mutex->owner) {
321 if (mutex->owner->state == SCM_VM_TERMINATED) r = sym_abandoned;
322 else r = SCM_OBJ(mutex->owner);
323 } else {
324 r = sym_not_owned;
325 }
326 } else {
327 r = sym_not_abandoned;
328 }
329 (void)SCM_INTERNAL_MUTEX_UNLOCK(mutex->mutex);
330 SCM_RETURN(r);
331 }
332 }
333
334 static SCM_DEFINE_STRING_CONST(thrlib_mutex_state__NAME, "mutex-state", 11, 11);
335 static SCM_DEFINE_SUBR(thrlib_mutex_state__STUB, 1, 0, SCM_OBJ(&thrlib_mutex_state__NAME), thrlib_mutex_state, NULL, NULL);
336
337 static ScmObj thrlib_mutex_lockX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
338 {
339 ScmObj mutex_scm;
340 ScmMutex* mutex;
341 ScmObj timeout_scm;
342 ScmObj timeout;
343 ScmObj thread_scm;
344 ScmObj thread;
345 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
346 SCM_ENTER_SUBR("mutex-lock!");
347 if (Scm_Length(SCM_OPTARGS) > 2)
348 Scm_Error("too many arguments: up to 2 is expected, %d given.", Scm_Length(SCM_OPTARGS));
349 mutex_scm = SCM_ARGREF(0);
350 if (!SCM_MUTEXP(mutex_scm)) Scm_Error("mutex required, but got %S", mutex_scm);
351 mutex = SCM_MUTEX(mutex_scm);
352 if (SCM_NULLP(SCM_OPTARGS)) timeout_scm = SCM_FALSE;
353 else {
354 timeout_scm = SCM_CAR(SCM_OPTARGS);
355 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
356 }
357 timeout = (timeout_scm);
358 if (SCM_NULLP(SCM_OPTARGS)) thread_scm = SCM_UNBOUND;
359 else {
360 thread_scm = SCM_CAR(SCM_OPTARGS);
361 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
362 }
363 thread = (thread_scm);
364 {
365 ScmVM *owner = NULL;
366 if (SCM_VMP(thread)) owner = SCM_VM(thread);
367 else if (SCM_UNBOUNDP(thread)) owner = Scm_VM();
368 else if (!SCM_FALSEP(thread)) Scm_Error("thread or #f required, but got %S", thread);
369 SCM_RETURN(Scm_MutexLock(mutex, timeout, owner));
370 }
371 }
372
373 static SCM_DEFINE_STRING_CONST(thrlib_mutex_lockX__NAME, "mutex-lock!", 11, 11);
374 static SCM_DEFINE_SUBR(thrlib_mutex_lockX__STUB, 1, 1, SCM_OBJ(&thrlib_mutex_lockX__NAME), thrlib_mutex_lockX, NULL, NULL);
375
376 static ScmObj thrlib_mutex_unlockX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
377 {
378 ScmObj mutex_scm;
379 ScmMutex* mutex;
380 ScmObj cv_scm;
381 ScmObj cv;
382 ScmObj timeout_scm;
383 ScmObj timeout;
384 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
385 SCM_ENTER_SUBR("mutex-unlock!");
386 if (Scm_Length(SCM_OPTARGS) > 2)
387 Scm_Error("too many arguments: up to 2 is expected, %d given.", Scm_Length(SCM_OPTARGS));
388 mutex_scm = SCM_ARGREF(0);
389 if (!SCM_MUTEXP(mutex_scm)) Scm_Error("mutex required, but got %S", mutex_scm);
390 mutex = SCM_MUTEX(mutex_scm);
391 if (SCM_NULLP(SCM_OPTARGS)) cv_scm = SCM_FALSE;
392 else {
393 cv_scm = SCM_CAR(SCM_OPTARGS);
394 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
395 }
396 cv = (cv_scm);
397 if (SCM_NULLP(SCM_OPTARGS)) timeout_scm = SCM_FALSE;
398 else {
399 timeout_scm = SCM_CAR(SCM_OPTARGS);
400 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
401 }
402 timeout = (timeout_scm);
403 {
404 ScmConditionVariable *cond = NULL;
405 if (SCM_CONDITION_VARIABLE_P(cv)) cond = SCM_CONDITION_VARIABLE(cv);
406 else if (!SCM_FALSEP(cv)) Scm_Error("condition variable or #f required, but got %S", cv);
407 SCM_RETURN(Scm_MutexUnlock(mutex, cond, timeout));
408 }
409 }
410
411 static SCM_DEFINE_STRING_CONST(thrlib_mutex_unlockX__NAME, "mutex-unlock!", 13, 13);
412 static SCM_DEFINE_SUBR(thrlib_mutex_unlockX__STUB, 1, 1, SCM_OBJ(&thrlib_mutex_unlockX__NAME), thrlib_mutex_unlockX, NULL, NULL);
413
414 static ScmObj thrlib_mutex_specific(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
415 {
416 ScmObj mutex_scm;
417 ScmMutex* mutex;
418 SCM_ENTER_SUBR("mutex-specific");
419 mutex_scm = SCM_ARGREF(0);
420 if (!SCM_MUTEXP(mutex_scm)) Scm_Error("mutex required, but got %S", mutex_scm);
421 mutex = SCM_MUTEX(mutex_scm);
422 {
423 {
424 ScmObj SCM_RESULT;
425 SCM_RESULT = (mutex->specific);
426 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
427 }
428 }
429 }
430
431 static SCM_DEFINE_STRING_CONST(thrlib_mutex_specific__NAME, "mutex-specific", 14, 14);
432 static SCM_DEFINE_SUBR(thrlib_mutex_specific__STUB, 1, 0, SCM_OBJ(&thrlib_mutex_specific__NAME), thrlib_mutex_specific, NULL, NULL);
433
434 static ScmObj thrlib_mutex_specific_setX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
435 {
436 ScmObj mutex_scm;
437 ScmMutex* mutex;
438 ScmObj obj_scm;
439 ScmObj obj;
440 SCM_ENTER_SUBR("mutex-specific-set!");
441 mutex_scm = SCM_ARGREF(0);
442 if (!SCM_MUTEXP(mutex_scm)) Scm_Error("mutex required, but got %S", mutex_scm);
443 mutex = SCM_MUTEX(mutex_scm);
444 obj_scm = SCM_ARGREF(1);
445 obj = (obj_scm);
446 {
447 mutex->specific = obj;
448 SCM_RETURN(SCM_UNDEFINED);
449 }
450 }
451
452 static SCM_DEFINE_STRING_CONST(thrlib_mutex_specific_setX__NAME, "mutex-specific-set!", 19, 19);
453 static SCM_DEFINE_SUBR(thrlib_mutex_specific_setX__STUB, 2, 0, SCM_OBJ(&thrlib_mutex_specific_setX__NAME), thrlib_mutex_specific_setX, NULL, NULL);
454
455 static ScmObj thrlib_mutex_name(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
456 {
457 ScmObj mutex_scm;
458 ScmMutex* mutex;
459 SCM_ENTER_SUBR("mutex-name");
460 mutex_scm = SCM_ARGREF(0);
461 if (!SCM_MUTEXP(mutex_scm)) Scm_Error("mutex required, but got %S", mutex_scm);
462 mutex = SCM_MUTEX(mutex_scm);
463 {
464 {
465 ScmObj SCM_RESULT;
466 SCM_RESULT = (mutex->name);
467 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
468 }
469 }
470 }
471
472 static SCM_DEFINE_STRING_CONST(thrlib_mutex_name__NAME, "mutex-name", 10, 10);
473 static SCM_DEFINE_SUBR(thrlib_mutex_name__STUB, 1, 0, SCM_OBJ(&thrlib_mutex_name__NAME), thrlib_mutex_name, NULL, NULL);
474
475 static ScmObj thrlib_make_condition_variable(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
476 {
477 ScmObj name_scm;
478 ScmObj name;
479 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
480 SCM_ENTER_SUBR("make-condition-variable");
481 if (Scm_Length(SCM_OPTARGS) > 1)
482 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
483 if (SCM_NULLP(SCM_OPTARGS)) name_scm = SCM_FALSE;
484 else {
485 name_scm = SCM_CAR(SCM_OPTARGS);
486 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
487 }
488 name = (name_scm);
489 {
490 {
491 ScmObj SCM_RESULT;
492 SCM_RESULT = Scm_MakeConditionVariable(name);
493 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
494 }
495 }
496 }
497
498 static SCM_DEFINE_STRING_CONST(thrlib_make_condition_variable__NAME, "make-condition-variable", 23, 23);
499 static SCM_DEFINE_SUBR(thrlib_make_condition_variable__STUB, 0, 1, SCM_OBJ(&thrlib_make_condition_variable__NAME), thrlib_make_condition_variable, NULL, NULL);
500
501 static ScmObj thrlib_condition_variableP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
502 {
503 ScmObj obj_scm;
504 ScmObj obj;
505 SCM_ENTER_SUBR("condition-variable?");
506 obj_scm = SCM_ARGREF(0);
507 obj = (obj_scm);
508 {
509 {
510 int SCM_RESULT;
511 SCM_RESULT = SCM_CONDITION_VARIABLE_P(obj);
512 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
513 }
514 }
515 }
516
517 static SCM_DEFINE_STRING_CONST(thrlib_condition_variableP__NAME, "condition-variable?", 19, 19);
518 static SCM_DEFINE_SUBR(thrlib_condition_variableP__STUB, 1, 0, SCM_OBJ(&thrlib_condition_variableP__NAME), thrlib_condition_variableP, NULL, NULL);
519
520 static ScmObj thrlib_condition_variable_name(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
521 {
522 ScmObj cv_scm;
523 ScmConditionVariable* cv;
524 SCM_ENTER_SUBR("condition-variable-name");
525 cv_scm = SCM_ARGREF(0);
526 if (!SCM_CONDITION_VARIABLE_P(cv_scm)) Scm_Error("condition variable required, but got %S", cv_scm);
527 cv = SCM_CONDITION_VARIABLE(cv_scm);
528 {
529 {
530 ScmObj SCM_RESULT;
531 SCM_RESULT = (cv->name);
532 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
533 }
534 }
535 }
536
537 static SCM_DEFINE_STRING_CONST(thrlib_condition_variable_name__NAME, "condition-variable-name", 23, 23);
538 static SCM_DEFINE_SUBR(thrlib_condition_variable_name__STUB, 1, 0, SCM_OBJ(&thrlib_condition_variable_name__NAME), thrlib_condition_variable_name, NULL, NULL);
539
540 static ScmObj thrlib_condition_variable_specific(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
541 {
542 ScmObj cv_scm;
543 ScmConditionVariable* cv;
544 SCM_ENTER_SUBR("condition-variable-specific");
545 cv_scm = SCM_ARGREF(0);
546 if (!SCM_CONDITION_VARIABLE_P(cv_scm)) Scm_Error("condition variable required, but got %S", cv_scm);
547 cv = SCM_CONDITION_VARIABLE(cv_scm);
548 {
549 {
550 ScmObj SCM_RESULT;
551 SCM_RESULT = (cv->specific);
552 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
553 }
554 }
555 }
556
557 static SCM_DEFINE_STRING_CONST(thrlib_condition_variable_specific__NAME, "condition-variable-specific", 27, 27);
558 static SCM_DEFINE_SUBR(thrlib_condition_variable_specific__STUB, 1, 0, SCM_OBJ(&thrlib_condition_variable_specific__NAME), thrlib_condition_variable_specific, NULL, NULL);
559
560 static ScmObj thrlib_condition_variable_specific_setX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
561 {
562 ScmObj cv_scm;
563 ScmConditionVariable* cv;
564 ScmObj obj_scm;
565 ScmObj obj;
566 SCM_ENTER_SUBR("condition-variable-specific-set!");
567 cv_scm = SCM_ARGREF(0);
568 if (!SCM_CONDITION_VARIABLE_P(cv_scm)) Scm_Error("condition variable required, but got %S", cv_scm);
569 cv = SCM_CONDITION_VARIABLE(cv_scm);
570 obj_scm = SCM_ARGREF(1);
571 obj = (obj_scm);
572 {
573 cv->specific = obj;
574 SCM_RETURN(SCM_UNDEFINED);
575 }
576 }
577
578 static SCM_DEFINE_STRING_CONST(thrlib_condition_variable_specific_setX__NAME, "condition-variable-specific-set!", 32, 32);
579 static SCM_DEFINE_SUBR(thrlib_condition_variable_specific_setX__STUB, 2, 0, SCM_OBJ(&thrlib_condition_variable_specific_setX__NAME), thrlib_condition_variable_specific_setX, NULL, NULL);
580
581 static ScmObj thrlib_condition_variable_signalX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
582 {
583 ScmObj cv_scm;
584 ScmConditionVariable* cv;
585 SCM_ENTER_SUBR("condition-variable-signal!");
586 cv_scm = SCM_ARGREF(0);
587 if (!SCM_CONDITION_VARIABLE_P(cv_scm)) Scm_Error("condition variable required, but got %S", cv_scm);
588 cv = SCM_CONDITION_VARIABLE(cv_scm);
589 {
590 {
591 ScmObj SCM_RESULT;
592 SCM_RESULT = Scm_ConditionVariableSignal(cv);
593 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
594 }
595 }
596 }
597
598 static SCM_DEFINE_STRING_CONST(thrlib_condition_variable_signalX__NAME, "condition-variable-signal!", 26, 26);
599 static SCM_DEFINE_SUBR(thrlib_condition_variable_signalX__STUB, 1, 0, SCM_OBJ(&thrlib_condition_variable_signalX__NAME), thrlib_condition_variable_signalX, NULL, NULL);
600
601 static ScmObj thrlib_condition_variable_broadcastX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
602 {
603 ScmObj cv_scm;
604 ScmConditionVariable* cv;
605 SCM_ENTER_SUBR("condition-variable-broadcast!");
606 cv_scm = SCM_ARGREF(0);
607 if (!SCM_CONDITION_VARIABLE_P(cv_scm)) Scm_Error("condition variable required, but got %S", cv_scm);
608 cv = SCM_CONDITION_VARIABLE(cv_scm);
609 {
610 {
611 ScmObj SCM_RESULT;
612 SCM_RESULT = Scm_ConditionVariableBroadcast(cv);
613 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
614 }
615 }
616 }
617
618 static SCM_DEFINE_STRING_CONST(thrlib_condition_variable_broadcastX__NAME, "condition-variable-broadcast!", 29, 29);
619 static SCM_DEFINE_SUBR(thrlib_condition_variable_broadcastX__STUB, 1, 0, SCM_OBJ(&thrlib_condition_variable_broadcastX__NAME), thrlib_condition_variable_broadcastX, NULL, NULL);
620
621 static ScmObj thread_exception_allocate(ScmClass *klass, ScmObj initargs)
622 {
623 ScmThreadException *e = SCM_ALLOCATE(ScmThreadException, klass);
624 SCM_SET_CLASS(e, klass);
625 e->thread = NULL;
626 e->data = SCM_UNDEFINED;
627 return SCM_OBJ(e);
628 }
629 static void thread_exception_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
630 {
631 ScmClass *k = SCM_CLASS_OF(obj);
632 ScmThreadException *exc = SCM_THREAD_EXCEPTION(obj);
633 if (SCM_UNDEFINEDP(exc->data)) {
634 Scm_Printf(port, "#<%A %S>", Scm__InternalClassName(k), SCM_OBJ_SAFE(exc->thread));
635 } else {
636 Scm_Printf(port, "#<%A %S %S>", Scm__InternalClassName(k), SCM_OBJ_SAFE(exc->thread), exc->data);
637 }
638 }
639 static void uncaught_exception_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
640 {
641 ScmThreadException *exc = SCM_THREAD_EXCEPTION(obj);
642 Scm_Printf(port, "#<uncaught-exception in thread %S: %S>", SCM_OBJ_SAFE(exc->thread), exc->data);
643 }
644 static void terminated_thread_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
645 {
646 ScmThreadException *exc = SCM_THREAD_EXCEPTION(obj);
647 Scm_Printf(port, "#<terminated-thread-exception: %S terminated by %S>", SCM_OBJ_SAFE(exc->thread), exc->data);
648 }
649 static ScmClass *thread_exception_cpa[] = {
650 SCM_CLASS_STATIC_PTR(Scm_ThreadExceptionClass),
651 SCM_CLASS_STATIC_PTR(Scm_ConditionClass),
652 SCM_CLASS_STATIC_PTR(Scm_TopClass),
653 NULL
654 };
655 static ScmClass *Scm_ThreadExceptionClass_CPL[] = {
656 SCM_CLASS_STATIC_PTR(Scm_ConditionClass),
657 SCM_CLASS_STATIC_PTR(Scm_TopClass),
658 NULL
659 };
660 SCM_DEFINE_BUILTIN_CLASS(Scm_ThreadExceptionClass, thread_exception_print, NULL, NULL, thread_exception_allocate, Scm_ThreadExceptionClass_CPL);
661
662 static ScmObj Scm_ThreadExceptionClass_thread_GET(ScmObj OBJARG)
663 {
664 ScmThreadException* obj = SCM_THREAD_EXCEPTION(OBJARG);
665 return SCM_OBJ_SAFE(obj->thread);
666 }
667
668 static void Scm_ThreadExceptionClass_thread_SET(ScmObj OBJARG, ScmObj value)
669 {
670 ScmThreadException* obj = SCM_THREAD_EXCEPTION(OBJARG);
671 if (!SCM_VMP(value)) Scm_Error("ScmVM* required, but got %S", value);
672 obj->thread = SCM_VM(value);
673 }
674
675 static ScmClassStaticSlotSpec Scm_ThreadExceptionClass__SLOTS[] = {
676 SCM_CLASS_SLOT_SPEC("thread", Scm_ThreadExceptionClass_thread_GET, Scm_ThreadExceptionClass_thread_SET),
677 { NULL }
678 };
679
680 SCM_DEFINE_BUILTIN_CLASS(Scm_JoinTimeoutExceptionClass, thread_exception_print, NULL, NULL, thread_exception_allocate, thread_exception_cpa);
681
682 SCM_DEFINE_BUILTIN_CLASS(Scm_AbandonedMutexExceptionClass, thread_exception_print, NULL, NULL, thread_exception_allocate, thread_exception_cpa);
683
684 static ScmObj Scm_AbandonedMutexExceptionClass_mutex_GET(ScmObj OBJARG)
685 {
686 ScmThreadException* obj = SCM_THREAD_EXCEPTION(OBJARG);
687 return SCM_OBJ_SAFE(obj->data);
688 }
689
690 static void Scm_AbandonedMutexExceptionClass_mutex_SET(ScmObj OBJARG, ScmObj value)
691 {
692 ScmThreadException* obj = SCM_THREAD_EXCEPTION(OBJARG);
693 obj->data = (value);
694 }
695
696 static ScmClassStaticSlotSpec Scm_AbandonedMutexExceptionClass__SLOTS[] = {
697 SCM_CLASS_SLOT_SPEC("mutex", Scm_AbandonedMutexExceptionClass_mutex_GET, Scm_AbandonedMutexExceptionClass_mutex_SET),
698 { NULL }
699 };
700
701 SCM_DEFINE_BUILTIN_CLASS(Scm_TerminatedThreadExceptionClass, terminated_thread_print, NULL, NULL, thread_exception_allocate, thread_exception_cpa);
702
703 static ScmObj Scm_TerminatedThreadExceptionClass_terminator_GET(ScmObj OBJARG)
704 {
705 ScmThreadException* obj = SCM_THREAD_EXCEPTION(OBJARG);
706 return SCM_OBJ_SAFE(obj->data);
707 }
708
709 static void Scm_TerminatedThreadExceptionClass_terminator_SET(ScmObj OBJARG, ScmObj value)
710 {
711 ScmThreadException* obj = SCM_THREAD_EXCEPTION(OBJARG);
712 obj->data = (value);
713 }
714
715 static ScmClassStaticSlotSpec Scm_TerminatedThreadExceptionClass__SLOTS[] = {
716 SCM_CLASS_SLOT_SPEC("terminator", Scm_TerminatedThreadExceptionClass_terminator_GET, Scm_TerminatedThreadExceptionClass_terminator_SET),
717 { NULL }
718 };
719
720 SCM_DEFINE_BUILTIN_CLASS(Scm_UncaughtExceptionClass, uncaught_exception_print, NULL, NULL, thread_exception_allocate, thread_exception_cpa);
721
722 static ScmObj Scm_UncaughtExceptionClass_reason_GET(ScmObj OBJARG)
723 {
724 ScmThreadException* obj = SCM_THREAD_EXCEPTION(OBJARG);
725 return SCM_OBJ_SAFE(obj->data);
726 }
727
728 static void Scm_UncaughtExceptionClass_reason_SET(ScmObj OBJARG, ScmObj value)
729 {
730 ScmThreadException* obj = SCM_THREAD_EXCEPTION(OBJARG);
731 obj->data = (value);
732 }
733
734 static ScmClassStaticSlotSpec Scm_UncaughtExceptionClass__SLOTS[] = {
735 SCM_CLASS_SLOT_SPEC("reason", Scm_UncaughtExceptionClass_reason_GET, Scm_UncaughtExceptionClass_reason_SET),
736 { NULL }
737 };
738
739 void Scm_Init_thrlib(ScmModule *module)
740 {
741
742 Scm_InitBuiltinClass(&Scm_UncaughtExceptionClass, "<uncaught-exception>", Scm_UncaughtExceptionClass__SLOTS, TRUE, module);
743 Scm_InitBuiltinClass(&Scm_TerminatedThreadExceptionClass, "<terminated-thread-exception>", Scm_TerminatedThreadExceptionClass__SLOTS, TRUE, module);
744 Scm_InitBuiltinClass(&Scm_AbandonedMutexExceptionClass, "<abandoned-mutex-exception>", Scm_AbandonedMutexExceptionClass__SLOTS, TRUE, module);
745 Scm_InitBuiltinClass(&Scm_JoinTimeoutExceptionClass, "<join-timeout-exception>", NULL, TRUE, module);
746 Scm_InitBuiltinClass(&Scm_ThreadExceptionClass, "<thread-exception>", Scm_ThreadExceptionClass__SLOTS, TRUE, module);
747 SCM_DEFINE(module, "condition-variable-broadcast!", SCM_OBJ(&thrlib_condition_variable_broadcastX__STUB));
748 SCM_DEFINE(module, "condition-variable-signal!", SCM_OBJ(&thrlib_condition_variable_signalX__STUB));
749 SCM_DEFINE(module, "condition-variable-specific-set!", SCM_OBJ(&thrlib_condition_variable_specific_setX__STUB));
750 SCM_DEFINE(module, "condition-variable-specific", SCM_OBJ(&thrlib_condition_variable_specific__STUB));
751 SCM_DEFINE(module, "condition-variable-name", SCM_OBJ(&thrlib_condition_variable_name__STUB));
752 SCM_DEFINE(module, "condition-variable?", SCM_OBJ(&thrlib_condition_variableP__STUB));
753 SCM_DEFINE(module, "make-condition-variable", SCM_OBJ(&thrlib_make_condition_variable__STUB));
754 SCM_DEFINE(module, "mutex-name", SCM_OBJ(&thrlib_mutex_name__STUB));
755 SCM_DEFINE(module, "mutex-specific-set!", SCM_OBJ(&thrlib_mutex_specific_setX__STUB));
756 SCM_DEFINE(module, "mutex-specific", SCM_OBJ(&thrlib_mutex_specific__STUB));
757 SCM_DEFINE(module, "mutex-unlock!", SCM_OBJ(&thrlib_mutex_unlockX__STUB));
758 SCM_DEFINE(module, "mutex-lock!", SCM_OBJ(&thrlib_mutex_lockX__STUB));
759 SCM_DEFINE(module, "mutex-state", SCM_OBJ(&thrlib_mutex_state__STUB));
760 sym_not_abandoned = Scm_Intern(&sym_not_abandoned__NAME);
761 sym_abandoned = Scm_Intern(&sym_abandoned__NAME);
762 sym_not_owned = Scm_Intern(&sym_not_owned__NAME);
763 SCM_DEFINE(module, "mutex?", SCM_OBJ(&thrlib_mutexP__STUB));
764 SCM_DEFINE(module, "make-mutex", SCM_OBJ(&thrlib_make_mutex__STUB));
765 SCM_DEFINE(module, "thread-terminate!", SCM_OBJ(&thrlib_thread_terminateX__STUB));
766 SCM_DEFINE(module, "thread-join!", SCM_OBJ(&thrlib_thread_joinX__STUB));
767 SCM_DEFINE(module, "thread-sleep!", SCM_OBJ(&thrlib_thread_sleepX__STUB));
768 SCM_DEFINE(module, "thread-yield!", SCM_OBJ(&thrlib_thread_yieldX__STUB));
769 SCM_DEFINE(module, "thread-start!", SCM_OBJ(&thrlib_thread_startX__STUB));
770 SCM_DEFINE(module, "make-thread", SCM_OBJ(&thrlib_make_thread__STUB));
771 SCM_DEFINE(module, "thread-specific-set!", SCM_OBJ(&thrlib_thread_specific_setX__STUB));
772 SCM_DEFINE(module, "thread-specific", SCM_OBJ(&thrlib_thread_specific__STUB));
773 SCM_DEFINE(module, "thread-name", SCM_OBJ(&thrlib_thread_name__STUB));
774 SCM_DEFINE(module, "thread?", SCM_OBJ(&thrlib_threadP__STUB));
775 SCM_DEFINE(module, "gauche-thread-type", SCM_OBJ(&thrlib_gauche_thread_type__STUB));
776 sym_none = Scm_Intern(&sym_none__NAME);
777 sym_pthread = Scm_Intern(&sym_pthread__NAME);
778 }