1 /* mutex.c -*- mode:c; coding:utf-8; -*-
2 *
3 * multi thread extensions
4 *
5 * Copyright (c) 2010-2015 Takashi Kato <ktakashi@ymail.com>
6 *
7 * Redistribution and use in source and binary forms, with or without
8 * modification, are permitted provided that the following conditions
9 * are met:
10 *
11 * 1. Redistributions of source code must retain the above copyright
12 * notice, this list of conditions and the following disclaimer.
13 *
14 * 2. Redistributions in binary form must reproduce the above copyright
15 * notice, this list of conditions and the following disclaimer in the
16 * documentation and/or other materials provided with the distribution.
17 *
18 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
19 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
20 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
21 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
22 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
23 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
24 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
25 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
26 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29 *
30 * $Id: $
31 */
32 #include <sagittarius.h>
33 #define LIBSAGITTARIUS_EXT_BODY
34 #include <sagittarius/extend.h>
35 #include "threads.h"
36
mutex_printer(SgObject self,SgPort * port,SgWriteContext * ctx)37 static void mutex_printer(SgObject self, SgPort *port, SgWriteContext *ctx)
38 {
39 SgMutex *mutex = SG_MUTEX(self);
40 int locked;
41 SgVM *vm;
42 SgObject name;
43 Sg_LockMutex(&mutex->mutex);
44 locked = mutex->locked;
45 name = mutex->name;
46 vm = mutex->owner;
47 Sg_UnlockMutex(&mutex->mutex);
48
49 Sg_Printf(port, UC("#<mutex %S "), name);
50 if (locked) {
51 if (vm) {
52 if (vm->threadState == SG_VM_TERMINATED) {
53 Sg_Printf(port, UC("unlocked/abandoned>"));
54 } else {
55 Sg_Printf(port, UC("locked/owned by %S>"), vm);
56 }
57 } else {
58 Sg_Printf(port, UC("locked/not-owned>"));
59 }
60 } else {
61 Sg_Printf(port, UC("unlocked/not-abandoned>"));
62 }
63 }
64 static SgObject mutex_allocate(SgClass *klass, SgObject initargs);
65
66 SG_DEFINE_BASE_CLASS(Sg_MutexClass, SgMutex,
67 mutex_printer, NULL, NULL, mutex_allocate,
68 NULL);
69
mutex_allocate(SgClass * klass,SgObject initargs)70 static SgObject mutex_allocate(SgClass *klass, SgObject initargs)
71 {
72 return NULL; /* dummy for now */
73 }
74
mutex_finalize(SgObject obj,void * data)75 static void mutex_finalize(SgObject obj, void *data)
76 {
77 SgMutex *mutex = SG_MUTEX(obj);
78 Sg_DestroyMutex(&mutex->mutex);
79 Sg_DestroyCond(&mutex->cv);
80 }
81
make_mutex(SgObject name,int recursiveP)82 static SgMutex * make_mutex(SgObject name, int recursiveP)
83 {
84 SgMutex *m = SG_NEW(SgMutex);
85 SG_SET_CLASS(m, SG_CLASS_MUTEX);
86 m->name = name;
87 m->specific = SG_UNDEF;
88 m->locked = FALSE;
89 m->owner = NULL;
90 Sg_InitMutex(&m->mutex, recursiveP);
91 Sg_InitCond(&m->cv);
92 Sg_RegisterFinalizer(SG_OBJ(m), mutex_finalize, NULL);
93 return m;
94 }
95
Sg_MakeMutex(SgObject name)96 SgObject Sg_MakeMutex(SgObject name)
97 {
98 return SG_OBJ(make_mutex(name, FALSE));
99 }
100
101 static SgObject sym_not_owned;
102 static SgObject sym_abandoned;
103 static SgObject sym_not_abandoned;
104
Sg_MutexState(SgMutex * mutex)105 SgObject Sg_MutexState(SgMutex *mutex)
106 {
107 SgObject r;
108 Sg_LockMutex(&mutex->mutex);
109 if (mutex->locked) {
110 if (mutex->owner) {
111 if (mutex->owner->threadState == SG_VM_TERMINATED) r = sym_abandoned;
112 else r = SG_OBJ(mutex->owner);
113 } else {
114 r = sym_not_owned;
115 }
116 } else {
117 r = sym_not_abandoned;
118 }
119 Sg_UnlockMutex(&mutex->mutex);
120 return r;
121 }
122
Sg_MutexLock(SgMutex * mutex,SgObject timeout,SgVM * owner)123 SgObject Sg_MutexLock(SgMutex *mutex, SgObject timeout, SgVM *owner)
124 {
125 SgObject r = SG_TRUE;
126 SgVM *abandoned = NULL;
127 struct timespec ts, *pts;
128 int intr = FALSE;
129
130 pts = Sg_GetTimeSpec(timeout, &ts);
131
132 SG_INTERNAL_MUTEX_SAFE_LOCK_BEGIN(mutex->mutex);
133 while (mutex->locked) {
134 if (mutex->owner && mutex->owner->threadState == SG_VM_TERMINATED) {
135 abandoned = mutex->owner;
136 mutex->locked = FALSE;
137 break;
138 }
139 if (pts) {
140 int tr = Sg_WaitWithTimeout(&mutex->cv, &mutex->mutex, pts);
141 if (tr == SG_INTERNAL_COND_TIMEDOUT) {
142 r = SG_FALSE;
143 break;
144 } else if (tr == SG_INTERNAL_COND_INTR) {
145 intr = TRUE;
146 break;
147 }
148 } else {
149 Sg_Wait(&mutex->cv, &mutex->mutex);
150 }
151 }
152 if (SG_TRUEP(r)) {
153 mutex->locked = TRUE;
154 mutex->owner = owner;
155 }
156 SG_INTERNAL_MUTEX_SAFE_LOCK_END();
157
158 /* intr? */
159 if (intr) {
160 SgObject e = Sg_MakeThreadInterruptException(owner);
161 Sg_Raise(e, FALSE);
162 r = FALSE;
163 }
164 if (abandoned) {
165 SgObject exc = Sg_MakeAbandonedMutexException(abandoned, mutex);
166 r = Sg_Raise(exc, FALSE);
167 }
168 return r;
169 }
170
Sg_MutexUnlock(SgMutex * mutex,SgConditionVariable * cv,SgObject timeout)171 SgObject Sg_MutexUnlock(SgMutex *mutex, SgConditionVariable *cv,
172 SgObject timeout)
173 {
174 SgObject r = SG_TRUE;
175 struct timespec ts, *pts;
176 int intr = FALSE;
177 SgVM *vm = mutex->owner; /* original owner */
178
179 pts = Sg_GetTimeSpec(timeout, &ts);
180
181 SG_INTERNAL_MUTEX_SAFE_LOCK_BEGIN(mutex->mutex);
182 mutex->locked = FALSE;
183 mutex->owner = NULL;
184 Sg_Notify(&mutex->cv);
185 if (cv) {
186 if (pts) {
187 int tr = Sg_WaitWithTimeout(&cv->cv, &mutex->mutex, pts);
188 if (tr == SG_INTERNAL_COND_TIMEDOUT) {
189 r = SG_FALSE;
190 } else if (tr == SG_INTERNAL_COND_INTR) {
191 intr = TRUE;
192 }
193 } else {
194 Sg_Wait(&cv->cv, &mutex->mutex);
195 }
196 }
197 SG_INTERNAL_MUTEX_SAFE_LOCK_END();
198
199 /* intr? */
200 if (intr) {
201 SgObject e = Sg_MakeThreadInterruptException((vm) ? vm : SG_VM(SG_FALSE));
202 Sg_Raise(e, FALSE);
203 r = FALSE;
204 }
205 return r;
206 }
207
208 /* condition variable */
cv_printer(SgObject self,SgPort * port,SgWriteContext * ctx)209 static void cv_printer(SgObject self, SgPort *port, SgWriteContext *ctx)
210 {
211 SgConditionVariable *cv = SG_CONDITION_VARIABLE(self);
212 Sg_Printf(port, UC("#<condition variable %S>"), cv->name);
213 }
214 static SgObject cv_allocate(SgClass *klass, SgObject initargs);
215
216 SG_DEFINE_BASE_CLASS(Sg_ConditionVariableClass, SgConditionVariable,
217 cv_printer, NULL, NULL, cv_allocate,
218 NULL);
219
cv_allocate(SgClass * klass,SgObject initargs)220 static SgObject cv_allocate(SgClass *klass, SgObject initargs)
221 {
222 return NULL; /* dummy for now */
223 }
224
cv_finalize(SgObject obj,void * data)225 static void cv_finalize(SgObject obj, void *data)
226 {
227 SgConditionVariable *cv = SG_CONDITION_VARIABLE(obj);
228 Sg_DestroyCond(&cv->cv);
229 }
230
231
Sg_MakeConditionVariable(SgObject name)232 SgObject Sg_MakeConditionVariable(SgObject name)
233 {
234 SgConditionVariable *c = SG_NEW(SgConditionVariable);
235 SG_SET_CLASS(c, SG_CLASS_CONDITION_VARIABLE);
236 c->name = name;
237 c->specific = SG_UNDEF;
238 Sg_InitCond(&c->cv);
239 Sg_RegisterFinalizer(SG_OBJ(c), cv_finalize, NULL);
240 return SG_OBJ(c);
241 }
242
Sg_ConditionVariableSignal(SgConditionVariable * cond)243 SgObject Sg_ConditionVariableSignal(SgConditionVariable *cond)
244 {
245 Sg_Notify(&cond->cv);
246 return SG_UNDEF;
247 }
248
Sg_ConditionVariableBroadcast(SgConditionVariable * cond)249 SgObject Sg_ConditionVariableBroadcast(SgConditionVariable *cond)
250 {
251 Sg_NotifyAll(&cond->cv);
252 return SG_UNDEF;
253 }
254
255
256 /* semaphore */
sem_printer(SgObject self,SgPort * port,SgWriteContext * ctx)257 static void sem_printer(SgObject self, SgPort *port, SgWriteContext *ctx)
258 {
259
260 }
261 static SgObject sem_allocate(SgClass *klass, SgObject initargs);
262
263 SG_DEFINE_BASE_CLASS(Sg_SemaphoreClass, SgSemaphore,
264 sem_printer, NULL, NULL, sem_allocate,
265 NULL);
266
sem_allocate(SgClass * klass,SgObject initargs)267 static SgObject sem_allocate(SgClass *klass, SgObject initargs)
268 {
269 return NULL; /* dummy for now */
270 }
271
272
Sg_MakeSemaphore(SgObject name,int value)273 SgObject Sg_MakeSemaphore(SgObject name, int value)
274 {
275 SgInternalSemaphore *sem
276 = Sg_InitSemaphore((SG_FALSEP(name)) ? NULL : SG_STRING(name), value);
277 SgSemaphore *z = SG_NEW(SgSemaphore);
278 SG_SET_CLASS(z, SG_CLASS_SEMAPHORE);
279 z->semaphore = sem;
280 return SG_OBJ(z);
281 }
282
Sg_SemaphoreWait(SgSemaphore * sem,SgObject timeout)283 int Sg_SemaphoreWait(SgSemaphore *sem, SgObject timeout)
284 {
285 struct timespec ts, *pts;
286 int r;
287
288 pts = Sg_GetTimeSpec(timeout, &ts);
289 r = Sg_WaitSemaphore(sem->semaphore, pts);
290 /* TODO intr? */
291 if (r == SG_INTERNAL_COND_TIMEDOUT) return FALSE;
292 return TRUE;
293 }
Sg_SemaphorePost(SgSemaphore * sem)294 int Sg_SemaphorePost(SgSemaphore *sem)
295 {
296 int r = Sg_PostSemaphore(sem->semaphore);
297 if (r) {
298 Sg_Error(UC("semaphore-post!: %A"),
299 Sg_GetLastErrorMessageWithErrorCode(r));
300 }
301 return TRUE;
302 }
Sg_SemaphoreClose(SgSemaphore * sem)303 void Sg_SemaphoreClose(SgSemaphore *sem)
304 {
305 Sg_CloseSemaphore(sem->semaphore);
306 }
Sg_SemaphoreDestroy(SgSemaphore * sem)307 void Sg_SemaphoreDestroy(SgSemaphore *sem)
308 {
309 Sg_DestroySemaphore(sem->semaphore);
310 }
311
312
313 static SgClass *error_cpl[] = {
314 SG_ERROR_CONDITION_CPL,
315 NULL
316 };
317
exc_printer(SgObject o,SgPort * p,SgWriteContext * ctx)318 static void exc_printer(SgObject o, SgPort *p, SgWriteContext *ctx)
319 {
320 Sg_Printf(p, UC("#<%A>"), SG_CLASS(Sg_ClassOf(o))->name);
321 }
322
323 SG_DEFINE_CONDITION_ALLOCATOR(parent_allocate, SgThreadException)
324 SG_DEFINE_CONDITION_ACCESSOR(thread_thread, SgThreadException,
325 SG_THREAD_EXCEPTIONP, thread)
326 static SgSlotAccessor parent_slots[] = {
327 SG_CLASS_SLOT_SPEC("thread", 0, thread_thread, thread_thread_set),
328 { { NULL } }
329 };
330 /* conditions */
331 SG_DEFINE_BASE_CLASS(Sg_ThreadExceptionClass, SgThreadException,
332 exc_printer, NULL, NULL, parent_allocate,
333 error_cpl);
334
335 static SgClass *thread_exc_cpl[] = {
336 SG_CLASS_THREAD_EXCEPTION,
337 SG_ERROR_CONDITION_CPL,
338 NULL
339 };
340
341 SG_DEFINE_BASE_CLASS(Sg_JoinTimeoutExceptionClass, SgThreadException,
342 exc_printer, NULL, NULL, parent_allocate,
343 thread_exc_cpl);
344
345 SG_DEFINE_CONDITION_ALLOCATOR(abn_allocate, SgAbondanedMutexException)
346 SG_DEFINE_CONDITION_ACCESSOR(abondand_mutex, SgAbondanedMutexException,
347 SG_ABONDANED_MUTEX_EXCEPTIONP, mutex)
348 static SgSlotAccessor abn_slots[] = {
349 SG_CLASS_SLOT_SPEC("mutex", 0, abondand_mutex, abondand_mutex_set),
350 { { NULL } }
351 };
352 SG_DEFINE_BASE_CLASS(Sg_AbondanedMutexExceptionClass, SgAbondanedMutexException,
353 exc_printer, NULL, NULL, abn_allocate,
354 thread_exc_cpl);
355
356 SG_DEFINE_CONDITION_ALLOCATOR(term_allocate, SgTerminatedThreadException)
357 SG_DEFINE_CONDITION_ACCESSOR(term_terminator, SgTerminatedThreadException,
358 SG_TERMINATED_THREAD_EXCEPTIONP, terminator)
359 static SgSlotAccessor term_slots[] = {
360 SG_CLASS_SLOT_SPEC("terminator", 0, term_terminator, term_terminator_set),
361 { { NULL } }
362 };
363 SG_DEFINE_BASE_CLASS(Sg_TerminatedThreadExceptionClass,
364 SgTerminatedThreadException,
365 exc_printer, NULL, NULL, term_allocate,
366 thread_exc_cpl);
367
368 SG_DEFINE_CONDITION_ALLOCATOR(uncaught_allocate, SgUncaughtException)
369 SG_DEFINE_CONDITION_ACCESSOR(uncaught_reason, SgUncaughtException,
370 SG_UNCAUGHT_EXCEPTIONP, reason)
371 static SgSlotAccessor uncaught_slots[] = {
372 SG_CLASS_SLOT_SPEC("reason", 0, uncaught_reason, uncaught_reason_set),
373 { { NULL } }
374 };
375 SG_DEFINE_BASE_CLASS(Sg_UncaughtExceptionClass,
376 SgUncaughtException,
377 exc_printer, NULL, NULL, uncaught_allocate,
378 thread_exc_cpl);
379
380 SG_DEFINE_BASE_CLASS(Sg_ThreadInterruptExceptionClass, SgThreadException,
381 exc_printer, NULL, NULL, parent_allocate,
382 thread_exc_cpl);
383
384
Sg_MakeJoinTimeoutException(SgVM * vm)385 SgObject Sg_MakeJoinTimeoutException(SgVM *vm)
386 {
387 SgObject c = parent_allocate(SG_CLASS_JOIN_TIMEOUT_EXCEPTION, SG_NIL);
388 SG_THREAD_EXCEPTION(c)->thread = vm;
389 return c;
390 }
391
Sg_MakeAbandonedMutexException(SgVM * vm,SgMutex * mutex)392 SgObject Sg_MakeAbandonedMutexException(SgVM *vm, SgMutex *mutex)
393 {
394 SgObject c = abn_allocate(SG_CLASS_ABONDANED_MUTEX_EXCEPTION, SG_NIL);
395 SG_THREAD_EXCEPTION(c)->thread = vm;
396 SG_ABONDANED_MUTEX_EXCEPTION(c)->mutex = mutex;
397 return c;
398 }
399
Sg_MakeTerminatedThreadException(SgVM * vm,SgVM * terminator)400 SgObject Sg_MakeTerminatedThreadException(SgVM *vm, SgVM *terminator)
401 {
402 SgObject c = term_allocate(SG_CLASS_TERMINATED_THREAD_EXCEPTION, SG_NIL);
403 SG_THREAD_EXCEPTION(c)->thread = vm;
404 SG_TERMINATED_THREAD_EXCEPTION(c)->terminator = terminator;
405 return c;
406 }
407
Sg_MakeUncaughtException(SgVM * vm,SgObject reason)408 SgObject Sg_MakeUncaughtException(SgVM *vm, SgObject reason)
409 {
410 SgObject c = uncaught_allocate(SG_CLASS_UNCAUGHT_EXCEPTION, SG_NIL);
411 SG_THREAD_EXCEPTION(c)->thread = vm;
412 SG_UNCAUGHT_EXCEPTION(c)->reason = reason;
413 return c;
414 }
415
Sg_MakeThreadInterruptException(SgVM * vm)416 SgObject Sg_MakeThreadInterruptException(SgVM *vm)
417 {
418 SgObject c = parent_allocate(SG_CLASS_THREAD_INTERRUPT_EXCEPTION, SG_NIL);
419 SG_THREAD_EXCEPTION(c)->thread = vm;
420 return c;
421 }
422
423 SG_CDECL_BEGIN
Sg__InitMutex(SgLibrary * lib)424 void Sg__InitMutex(SgLibrary *lib)
425 {
426 SG_INIT_CONDITION(SG_CLASS_THREAD_EXCEPTION, lib,
427 "&thread-exception", parent_slots);
428 SG_INIT_CONDITION(SG_CLASS_JOIN_TIMEOUT_EXCEPTION, lib,
429 "&join-timeout-exception", NULL);
430 SG_INIT_CONDITION(SG_CLASS_ABONDANED_MUTEX_EXCEPTION, lib,
431 "&abandoned-mutex-exception", abn_slots);
432 SG_INIT_CONDITION(SG_CLASS_TERMINATED_THREAD_EXCEPTION, lib,
433 "&terminated-thread-exception", term_slots);
434 SG_INIT_CONDITION(SG_CLASS_UNCAUGHT_EXCEPTION, lib,
435 "&uncaught-exception", uncaught_slots);
436 SG_INIT_CONDITION(SG_CLASS_THREAD_INTERRUPT_EXCEPTION, lib,
437 "&thread-interrupt-exception", NULL);
438 /* super class thread-exception */
439 #define INIT_CTR_PRED(cl, name, n, pred) \
440 SG_INIT_CONDITION_PRED(cl, lib, pred); \
441 SG_INIT_CONDITION_CTR(cl, lib, name, n)
442 #define INIT_ACC(fn, name) SG_INIT_CONDITION_ACC(fn, lib, name)
443
444 /* &thread-exception */
445 INIT_CTR_PRED(SG_CLASS_THREAD_EXCEPTION, "make-thread-exception", 1,
446 "thread-exception?");
447 INIT_ACC(thread_thread, "&thread-exception-thread");
448 /* &join-timeout-exception */
449 INIT_CTR_PRED(SG_CLASS_JOIN_TIMEOUT_EXCEPTION,
450 "make-join-timeout-exception", 1, "join-timeout-exception?");
451
452 /* &abandoned-mutex-exception */
453 INIT_CTR_PRED(SG_CLASS_ABONDANED_MUTEX_EXCEPTION,
454 "make-abandoned-mutex-exception", 2,
455 "abandoned-mutex-exception?");
456 INIT_ACC(abondand_mutex, "&abandoned-mutex-exception-mutex");
457
458 /* &terminated-thread-exception */
459 INIT_CTR_PRED(SG_CLASS_TERMINATED_THREAD_EXCEPTION,
460 "make-terminated-thread-exception", 2,
461 "terminated-thread-exception?");
462 INIT_ACC(term_terminator, "&terminated-thread-exception-terminator");
463
464 /* &uncaught-exception */
465 INIT_CTR_PRED(SG_CLASS_UNCAUGHT_EXCEPTION,
466 "make-uncaught-exception", 2, "uncaught-exception?");
467 INIT_ACC(uncaught_reason, "&uncaught-exception-reason");
468
469 /* &thread-interrupt-exception */
470 INIT_CTR_PRED(SG_CLASS_JOIN_TIMEOUT_EXCEPTION,
471 "make-thread-interrupt-exception", 1,
472 "thread-interrupt-exception?");
473
474 sym_not_owned = SG_INTERN("not-owned");
475 sym_abandoned = SG_INTERN("abandoned");
476 sym_not_abandoned = SG_INTERN("not-abandoned");
477
478 Sg_InitStaticClassWithMeta(SG_CLASS_MUTEX, UC("<mutex>"), lib, NULL,
479 SG_FALSE, NULL, 0);
480 Sg_InitStaticClassWithMeta(SG_CLASS_CONDITION_VARIABLE,
481 UC("<condition-variable>"), lib, NULL,
482 SG_FALSE, NULL, 0);
483 Sg_InitStaticClassWithMeta(SG_CLASS_SEMAPHORE, UC("<semaphore>"), lib, NULL,
484 SG_FALSE, NULL, 0);
485 }
486 SG_CDECL_END
487 /*
488 end of file
489 Local Variables:
490 coding: utf-8-unix
491 End:
492 */
493
494