1 /* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
3 * This program is free software; you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation; either version 2, or (at your option)
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this software; see the file COPYING. If not, write to
15 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
16 * Boston, MA 02111-1307 USA
18 * As a special exception, the Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of GUILE.
21 * The exception is that, if you link the GUILE library with other files
22 * to produce an executable, this does not by itself cause the
23 * resulting executable to be covered by the GNU General Public License.
24 * Your use of that executable is in no way restricted on account of
25 * linking the GUILE library code into it.
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
30 * This exception applies only to the code released by the
31 * Free Software Foundation under the name GUILE. If you copy
32 * code from other Free Software Foundation releases into a copy of
33 * GUILE, as the General Public License permits, the exception does
34 * not apply to the code that you add in this way. To avoid misleading
35 * anyone as to the status of such modified files, you must delete
36 * this exception notice from them.
38 * If you write modifications of your own for GUILE, it is your choice
39 * whether to permit this exception to apply to your modifications.
40 * If you do not wish that, delete this exception notice. */
43 typedef struct scm_pthread_info
{
44 queue q
; /* the dequeue on which this structure exists */
45 /* reqired to be the first element */
46 pthread_t thread
; /* the corresponding thread structure */
47 void *stack_top
; /* the highest address in this thread's stack */
48 scm_root_state
*root
; /* root for this thread */
51 pthread_mutex_t scm_critical_section_mutex
;
52 pthread_t scm_critical_section_owner
;
54 static queue infos
= { &infos
, &infos
}; /* the dequeue of info structures */
56 /* Key to thread specific data */
57 pthread_key_t info_key
;
61 scm_threads_free_thread (SCM t
)
64 scm_threads_free_thread (t
)
68 scm_must_free (SCM_THREAD_DATA (t
));
69 return sizeof (pthread_t
);
74 scm_threads_free_mutex (SCM m
)
77 scm_threads_free_mutex (m
)
81 pthread_mutex_destroy (SCM_MUTEX_DATA (m
));
82 scm_must_free (SCM_MUTEX_DATA (m
));
83 return sizeof (pthread_mutex_t
);
88 scm_threads_free_condvar (SCM c
)
91 scm_threads_free_condvar (c
)
95 pthread_cond_destroy (SCM_CONDVAR_DATA (c
));
96 scm_must_free (SCM_CONDVAR_DATA (c
));
97 return sizeof (pthread_cond_t
);
100 /* cleanup for info structure
104 scm_pthread_delete_info (void *ptr
)
107 scm_pthread_delete_info (ptr
)
111 scm_pthread_info
*info
= (scm_pthread_info
*) ptr
;
112 info
->q
.blink
->flink
= info
->q
.flink
;
113 info
->q
.flink
->blink
= info
->q
.blink
;
114 scm_must_free ((char *) info
);
119 scm_threads_init (SCM_STACKITEM
*i
)
127 * each info structure is made thread-specific, so that the cleanup
128 * mechanism can be used to reclaim the space in a timely fashion.
130 pthread_key_create (&info_key
, scm_pthread_delete_info
);
132 /* initialize various mutex variables */
133 pthread_mutex_init (&scm_critical_section_mutex
, NULL
);
136 * create an info structure for the initial thread and push it onto
140 scm_pthread_info
*info
;
141 info
= (scm_pthread_info
*) scm_must_malloc (sizeof (scm_pthread_info
),
143 infos
.flink
= infos
.blink
= &info
->q
;
144 info
->q
.flink
= info
->q
.blink
= &infos
;
145 info
->thread
= pthread_initial
;
146 info
->stack_top
= (void *) i
;
147 pthread_setspecific(info_key
, info
);
149 /* The root state pointer gets initialized in init.c. */
152 /* given some thread, find the corresponding info
154 static scm_pthread_info
*pthreads_find_info (pthread_t target
)
156 queue
*ptr
= infos
.flink
;
158 while (ptr
!= &infos
)
160 scm_pthread_info
*info
= (scm_pthread_info
*) ptr
;
162 if (info
->thread
== target
)
172 scm_threads_mark_stacks ()
175 scm_threads_mark_stacks ()
178 scm_pthread_info
*info
;
182 for (info
= (scm_pthread_info
*) infos
.flink
;
183 info
!= (scm_pthread_info
*) &infos
;
184 info
= (scm_pthread_info
*) info
->q
.flink
)
186 thread
= info
->thread
;
187 if (thread
== pthread_run
)
190 /* stack_len is long rather than sizet in order to guarantee
191 that &stack_len is long aligned */
192 #ifdef STACK_GROWS_UP
193 long stack_len
= ((SCM_STACKITEM
*) (&thread
) -
194 (SCM_STACKITEM
*) info
->stack_top
);
196 /* Protect from the C stack. This must be the first marking
197 * done because it provides information about what objects
198 * are "in-use" by the C code. "in-use" objects are those
199 * for which the values from SCM_LENGTH and SCM_CHARS must remain
200 * usable. This requirement is stricter than a liveness
201 * requirement -- in particular, it constrains the implementation
204 SCM_FLUSH_REGISTER_WINDOWS
;
205 /* This assumes that all registers are saved into the jmp_buf */
206 setjmp (scm_save_regs_gc_mark
);
207 scm_mark_locations ((SCM_STACKITEM
*) scm_save_regs_gc_mark
,
208 ((scm_sizet
) sizeof scm_save_regs_gc_mark
209 / sizeof (SCM_STACKITEM
)));
211 scm_mark_locations (((size_t) info
->stack_top
,
214 long stack_len
= ((SCM_STACKITEM
*) info
->stack_top
-
215 (SCM_STACKITEM
*) (&thread
));
217 /* Protect from the C stack. This must be the first marking
218 * done because it provides information about what objects
219 * are "in-use" by the C code. "in-use" objects are those
220 * for which the values from SCM_LENGTH and SCM_CHARS must remain
221 * usable. This requirement is stricter than a liveness
222 * requirement -- in particular, it constrains the implementation
225 SCM_FLUSH_REGISTER_WINDOWS
;
226 /* This assumes that all registers are saved into the jmp_buf */
227 setjmp (scm_save_regs_gc_mark
);
228 scm_mark_locations ((SCM_STACKITEM
*) scm_save_regs_gc_mark
,
229 ((scm_sizet
) sizeof scm_save_regs_gc_mark
230 / sizeof (SCM_STACKITEM
)));
232 scm_mark_locations ((SCM_STACKITEM
*) &thread
,
238 /* Suspended thread */
239 #ifdef STACK_GROWS_UP
240 long stack_len
= ((SCM_STACKITEM
*) (thread
->THREAD_SP
) -
241 (SCM_STACKITEM
*) info
->stack_top
);
243 scm_mark_locations ((size_t)info
->stack_top
,
246 long stack_len
= ((SCM_STACKITEM
*) info
->stack_top
-
247 (SCM_STACKITEM
*) (thread
->THREAD_SP
));
249 scm_mark_locations ((SCM_STACKITEM
*) thread
->machdep_data
.machdep_state
,
250 ((scm_sizet
) sizeof (*thread
->machdep_data
.machdep_state
)
251 / sizeof (SCM_STACKITEM
)));
252 scm_mark_locations ((SCM_STACKITEM
*) (size_t) thread
->THREAD_SP
,
257 /* Mark this thread's root */
258 scm_gc_mark (((scm_root_state
*) info
->root
) -> handle
);
264 launch_thread (void *p
)
271 /* The thread object will be GC protected by being a member of the
272 list given as argument to launch_thread. It will be marked
273 during the conservative sweep of the stack. */
275 pthread_attr_setcleanup (&pthread_self () -> attr
,
277 SCM_ROOT_STATE (SCM_CAR (args
)));
278 scm_call_with_dynamic_root (SCM_CADDR (args
), SCM_CADDDR (args
));
284 scm_call_with_new_thread (SCM argl
)
287 scm_call_with_new_thread (argl
)
293 /* Check arguments. */
295 register SCM args
= argl
;
297 SCM_ASSERT (SCM_NIMP (args
),
298 scm_makfrom0str (s_call_with_new_thread
),
300 thunk
= SCM_CAR (args
);
301 SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk
)),
304 s_call_with_new_thread
);
305 args
= SCM_CDR (args
);
306 SCM_ASSERT (SCM_NIMP (args
),
307 scm_makfrom0str (s_call_with_new_thread
),
309 handler
= SCM_CAR (args
);
310 SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler
)),
313 s_call_with_new_thread
);
314 SCM_ASSERT (SCM_NULLP (SCM_CDR (args
)),
315 scm_makfrom0str (s_call_with_new_thread
),
319 /* Make new thread. */
323 scm_pthread_info
*info
=
324 (scm_pthread_info
*) scm_must_malloc (sizeof (scm_pthread_info
),
328 /* Unwind wind chain. */
329 old_winds
= scm_dynwinds
;
330 scm_dowinds (SCM_EOL
, scm_ilength (scm_root
->dynwinds
));
332 /* Allocate thread locals. */
333 root
= scm_make_root (scm_root
->handle
);
335 SCM_NEWCELL (thread
);
337 SCM_SETCAR (thread
, scm_tc16_thread
);
338 argl
= scm_cons2 (root
, thread
, argl
);
340 /* thread mustn't start until we've built the info struct */
341 pthread_kernel_lock
++;
343 /* initialize and create the thread. */
344 pthread_attr_init (&attr
);
345 pthread_attr_setschedpolicy (&attr
, SCHED_RR
);
347 pthread_create (&t
, &attr
, launch_thread
, (void *) argl
);
348 pthread_attr_destroy (&attr
);
350 /* push the info onto the dequeue */
351 info
->q
.flink
= infos
.flink
;
352 info
->q
.blink
= &infos
;
353 infos
.flink
->blink
= &info
->q
;
354 infos
.flink
= &info
->q
;
355 /* pthread_create filled in the initial SP -- profitons-en ! */
356 info
->stack_top
= (void *) (t
->THREAD_SP
);
358 info
->root
= SCM_ROOT_STATE (root
);
359 SCM_SETCDR (thread
, t
);
362 /* we're now ready for the thread to begin */
363 pthread_kernel_lock
--;
365 /* Return to old dynamic context. */
366 scm_dowinds (old_winds
, - scm_ilength (old_winds
));
374 scm_join_thread (SCM t
)
382 pthread_join (SCM_THREAD_DATA (t
), &value
);
407 pthread_mutex_t
*data
= (pthread_mutex_t
*) scm_must_malloc (sizeof (pthread_mutex_t
), "mutex");
410 SCM_SETCAR (m
, scm_tc16_mutex
);
411 SCM_SETCDR (m
, data
);
413 pthread_mutex_init (SCM_MUTEX_DATA (m
), NULL
);
419 scm_lock_mutex (SCM m
)
426 SCM_ASSERT (SCM_NIMP (m
) && SCM_MUTEXP (m
), m
, SCM_ARG1
, s_lock_mutex
);
427 pthread_mutex_lock (SCM_MUTEX_DATA (m
));
433 scm_unlock_mutex (SCM m
)
440 SCM_ASSERT (SCM_NIMP (m
) && SCM_MUTEXP (m
), m
, SCM_ARG1
, s_unlock_mutex
);
441 pthread_mutex_unlock (SCM_MUTEX_DATA (m
));
447 scm_make_condition_variable ()
450 scm_make_condition_variable ()
454 pthread_cond_t
*data
= (pthread_cond_t
*) scm_must_malloc (sizeof (pthread_cond_t
), "condvar");
457 SCM_SETCAR (c
, scm_tc16_condvar
);
458 SCM_SETCDR (c
, data
);
460 pthread_cond_init (SCM_CONDVAR_DATA (c
), NULL
);
466 scm_wait_condition_variable (SCM c
, SCM m
)
469 scm_wait_condition_variable (c
, m
)
474 SCM_ASSERT (SCM_NIMP (c
) && SCM_CONDVARP (c
),
477 s_wait_condition_variable
);
478 SCM_ASSERT (SCM_NIMP (m
) && SCM_MUTEXP (m
),
481 s_wait_condition_variable
);
482 pthread_cond_wait (SCM_CONDVAR_DATA (m
), SCM_MUTEX_DATA (c
));
488 scm_signal_condition_variable (SCM c
)
491 scm_signal_condition_variable (c
)
495 SCM_ASSERT (SCM_NIMP (c
) && SCM_CONDVARP (c
),
498 s_signal_condition_variable
);
499 pthread_cond_signal (SCM_CONDVAR_DATA (c
));