/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- thread_error_handler
- Scm_MakeThread
- thread_cleanup
- thread_entry
- Scm_ThreadStart
- Scm_ThreadJoin
- Scm_ThreadYield
- Scm_ThreadSleep
- Scm_ThreadTerminate
- Scm_Init_threads
1 /*
2 * thread.c - Scheme thread API
3 *
4 * Copyright (c) 2000-2004 Shiro Kawai, All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * 3. Neither the name of the authors nor the names of its contributors
18 * may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 *
33 * $Id: threads.c,v 1.9 2005/07/22 09:26:55 shirok Exp $
34 */
35
36 #include <gauche.h>
37 #include <gauche/vm.h>
38 #include <gauche/extend.h>
39 #include <gauche/exception.h>
40 #include "threads.h"
41
42 #include <unistd.h>
43 #ifdef HAVE_SCHED_H
44 #include <sched.h>
45 #endif
46
47 /*==============================================================
48 * Thread interface
49 */
50
51 static ScmObj thread_error_handler(ScmObj *args, int nargs, void *data)
52 {
53 /* For now, uncaptured error causes thread termination with
54 setting <uncaught-exception> to the resultException field.
55 It is handled in thread_entry(), so we don't need to do anything
56 here. */
57 return SCM_UNDEFINED;
58 }
59
60 static SCM_DEFINE_STRING_CONST(thread_error_handler_NAME, "thread-error-handler", 20, 20);
61 static SCM_DEFINE_SUBR(thread_error_handler_STUB, 1, 0, SCM_OBJ(&thread_error_handler_NAME), thread_error_handler, NULL, NULL);
62
63 /* Creation. In the "NEW" state, a VM is allocated but actual thread
64 is not created. */
65 ScmObj Scm_MakeThread(ScmProcedure *thunk, ScmObj name)
66 {
67 ScmVM *current = Scm_VM(), *vm;
68
69 if (SCM_PROCEDURE_REQUIRED(thunk) != 0) {
70 Scm_Error("thunk required, but got %S", thunk);
71 }
72 vm = Scm_NewVM(current, name);
73 vm->thunk = thunk;
74 vm->defaultEscapeHandler = SCM_OBJ(&thread_error_handler_STUB);
75 return SCM_OBJ(vm);
76 }
77
78 /* Start a thread. If the VM is in "NEW" state, create a new thread and
79 make it run.
80
81 With pthread, the real thread is started as "detached" mode; i.e. once
82 the thread exits, the resources allocated for the thread by the system
83 is collected, including the result of the thread. During this
84 deconstruction phase, the handler vm_cleanup() runs and saves the
85 thread result to the ScmVM structure. If nobody cares about the
86 result of the thread, ScmVM structure will eventually be GCed.
87 This is to prevent exitted thread's system resources from being
88 uncollected.
89 */
90
91 #ifdef GAUCHE_USE_PTHREADS
92 static void thread_cleanup(void *data)
93 {
94 ScmVM *vm = SCM_VM(data);
95 ScmObj exc;
96
97 /* Change this VM state to TERMINATED, and signals the change
98 to the waiting threads. */
99 if (pthread_mutex_lock(&vm->vmlock) == EDEADLK) {
100 Scm_Panic("dead lock in vm_cleanup.");
101 }
102 vm->state = SCM_VM_TERMINATED;
103 if (vm->canceller) {
104 /* This thread is cancelled. */
105 exc = Scm_MakeThreadException(SCM_CLASS_TERMINATED_THREAD_EXCEPTION, vm);
106 SCM_THREAD_EXCEPTION(exc)->data = SCM_OBJ(vm->canceller);
107 vm->resultException = exc;
108 }
109 pthread_cond_broadcast(&vm->cond);
110 pthread_mutex_unlock(&vm->vmlock);
111 }
112
113 static void *thread_entry(void *data)
114 {
115 ScmVM *vm = SCM_VM(data);
116 pthread_cleanup_push(thread_cleanup, vm);
117 if (pthread_setspecific(Scm_VMKey(), vm) != 0) {
118 /* NB: at this point, theVM is not set and we can't use Scm_Error. */
119 vm->resultException =
120 Scm_MakeError(SCM_MAKE_STR("pthread_setspecific failed"));
121 } else {
122 SCM_UNWIND_PROTECT {
123 vm->result = Scm_Apply(SCM_OBJ(vm->thunk), SCM_NIL);
124 } SCM_WHEN_ERROR {
125 ScmObj exc;
126 switch (vm->escapeReason) {
127 case SCM_VM_ESCAPE_CONT:
128 /*TODO: better message*/
129 vm->resultException =
130 Scm_MakeError(SCM_MAKE_STR("stale continuation thrown"));
131 break;
132 default:
133 Scm_Panic("unknown escape");
134 case SCM_VM_ESCAPE_ERROR:
135 exc = Scm_MakeThreadException(SCM_CLASS_UNCAUGHT_EXCEPTION, vm);
136 SCM_THREAD_EXCEPTION(exc)->data = SCM_OBJ(vm->escapeData[1]);
137 vm->resultException = exc;
138 Scm_ReportError(SCM_OBJ(vm->escapeData[1]));
139 break;
140 }
141 } SCM_END_PROTECT;
142 }
143 pthread_cleanup_pop(TRUE);
144 return NULL;
145 }
146
147 /* The default signal mask on the thread creation */
148 static struct threadRec {
149 int dummy; /* required to place this in data area */
150 sigset_t defaultSigmask;
151 } threadrec = { 0 };
152 #endif /* GAUCHE_USE_PTHREADS */
153
154 ScmObj Scm_ThreadStart(ScmVM *vm)
155 {
156 #ifdef GAUCHE_USE_PTHREADS
157 int err_state = FALSE, err_create = FALSE;
158 pthread_attr_t thattr;
159 sigset_t omask, dummy;
160
161 (void)SCM_INTERNAL_MUTEX_LOCK(vm->vmlock);
162 if (vm->state != SCM_VM_NEW) {
163 err_state = TRUE;
164 } else {
165 SCM_ASSERT(vm->thunk);
166 vm->state = SCM_VM_RUNNABLE;
167 pthread_attr_init(&thattr);
168 pthread_attr_setdetachstate(&thattr, TRUE);
169 pthread_sigmask(SIG_SETMASK, &threadrec.defaultSigmask, &omask);
170 if (pthread_create(&vm->thread, &thattr, thread_entry, vm) != 0) {
171 vm->state = SCM_VM_NEW;
172 err_create = TRUE;
173 }
174 pthread_sigmask(SIG_SETMASK, &omask, &dummy);
175 pthread_attr_destroy(&thattr);
176 }
177 (void)SCM_INTERNAL_MUTEX_UNLOCK(vm->vmlock);
178 if (err_state) Scm_Error("attempt to start an already-started thread: %S", vm);
179 if (err_create) Scm_Error("couldn't start a new thread: %S", vm);
180 #else /*!GAUCHE_USE_PTHREADS*/
181 Scm_Error("not implemented!\n");
182 #endif /*GAUCHE_USE_PTHREADS*/
183 return SCM_OBJ(vm);
184 }
185
186 /* Thread join */
187 ScmObj Scm_ThreadJoin(ScmVM *target, ScmObj timeout, ScmObj timeoutval)
188 {
189 #ifdef GAUCHE_USE_PTHREADS
190 struct timespec ts, *pts;
191 ScmObj result = SCM_FALSE, resultx = SCM_FALSE;
192 int intr = FALSE, tout = FALSE;
193
194 pts = Scm_GetTimeSpec(timeout, &ts);
195 (void)SCM_INTERNAL_MUTEX_LOCK(target->vmlock);
196 while (target->state != SCM_VM_TERMINATED) {
197 if (pts) {
198 int tr = pthread_cond_timedwait(&(target->cond), &(target->vmlock), pts);
199 if (tr == ETIMEDOUT) { tout = TRUE; break; }
200 else if (tr == EINTR) { intr = TRUE; break; }
201 } else {
202 pthread_cond_wait(&(target->cond), &(target->vmlock));
203 }
204 }
205 if (!tout) { result = target->result; resultx = target->resultException; }
206 (void)SCM_INTERNAL_MUTEX_UNLOCK(target->vmlock);
207 if (intr) Scm_SigCheck(Scm_VM());
208 if (tout) {
209 if (SCM_UNBOUNDP(timeoutval)) {
210 ScmObj e = Scm_MakeThreadException(SCM_CLASS_JOIN_TIMEOUT_EXCEPTION, target);
211 result = Scm_Raise(e);
212 } else {
213 result = timeoutval;
214 }
215 } else if (SCM_CONDITIONP(resultx)) {
216 result = Scm_Raise(resultx);
217 }
218 return result;
219 #else /*!GAUCHE_USE_PTHREADS*/
220 Scm_Error("not implemented!\n");
221 return SCM_UNDEFINED;
222 #endif /*!GAUCHE_USE_PTHREADS*/
223 }
224
225 /* Thread yield */
226 ScmObj Scm_ThreadYield(void)
227 {
228 #ifdef GAUCHE_USE_PTHREADS
229 #if defined(HAVE_SCHED_H) && defined(_POSIX_PRIORITY_SCHEDULING) && defined(HAVE_SCHED_YIELD)
230 sched_yield();
231 #else /*!HAVE_SCHED_H*/
232 /* what can I do? */
233 #endif /*!HAVE_SCHED_H*/
234 #else /*!GAUCHE_USE_PTHREADS*/
235 Scm_Error("not implemented!\n");
236 #endif /*!GAUCHE_USE_PTHREADS*/
237 return SCM_UNDEFINED;
238 }
239
240 /* Thread sleep */
241 ScmObj Scm_ThreadSleep(ScmObj timeout)
242 {
243 #ifdef GAUCHE_USE_PTHREADS
244 struct timespec ts, *pts;
245 ScmInternalCond dummyc = PTHREAD_COND_INITIALIZER;
246 ScmInternalMutex dummym = PTHREAD_MUTEX_INITIALIZER;
247 int intr = FALSE;
248 pts = Scm_GetTimeSpec(timeout, &ts);
249 if (pts == NULL) Scm_Error("thread-sleep! can't take #f as a timeout value");
250 pthread_mutex_lock(&dummym);
251 if (pthread_cond_timedwait(&dummyc, &dummym, pts) == EINTR) {
252 intr = TRUE;
253 }
254 pthread_mutex_unlock(&dummym);
255 if (intr) Scm_SigCheck(Scm_VM());
256 #else /*!GAUCHE_USE_PTHREADS*/
257 Scm_Error("not implemented!\n");
258 #endif /*!GAUCHE_USE_PTHREADS*/
259 return SCM_UNDEFINED;
260 }
261
262 /* Thread terminate */
263 ScmObj Scm_ThreadTerminate(ScmVM *target)
264 {
265 #ifdef GAUCHE_USE_PTHREADS
266 ScmVM *vm = Scm_VM();
267 if (target == vm) {
268 /* self termination */
269 (void)SCM_INTERNAL_MUTEX_LOCK(target->vmlock);
270 if (target->canceller == NULL) {
271 target->canceller = vm;
272 }
273 (void)SCM_INTERNAL_MUTEX_UNLOCK(target->vmlock);
274 /* Need to unlock before calling pthread_exit(), or the cleanup
275 routine can't obtain the lock */
276 pthread_exit(NULL);
277 } else {
278 (void)SCM_INTERNAL_MUTEX_LOCK(target->vmlock);
279 /* This ensures only the first call of thread-terminate! on a thread
280 is in effect. */
281 if (target->canceller == NULL) {
282 target->canceller = vm;
283 pthread_cancel(target->thread);
284 }
285 (void)SCM_INTERNAL_MUTEX_UNLOCK(target->vmlock);
286 }
287 #else /*!GAUCHE_USE_PTHREADS*/
288 Scm_Error("not implemented!\n");
289 #endif /*!GAUCHE_USE_PTHREADS*/
290 return SCM_UNDEFINED;
291 }
292
293 /*
294 * Initialization.
295 */
296 extern void Scm_Init_mutex(ScmModule*);
297 extern void Scm_Init_thrlib(ScmModule*);
298
299 void Scm_Init_threads(void)
300 {
301 ScmModule *mod = SCM_FIND_MODULE("gauche.threads", SCM_FIND_MODULE_CREATE);
302 SCM_INIT_EXTENSION(threads);
303 #ifdef GAUCHE_USE_PTHREADS
304 sigfillset(&threadrec.defaultSigmask);
305 #endif /*GAUCHE_USE_PTHREADS*/
306 Scm_Init_mutex(mod);
307 Scm_Init_thrlib(mod);
308 }
309