X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/cabe682ce632e7d657774859ced86d6c728fe440..9bc6fb0a7d91ae9a6c57cedb76022043db413ba5:/libguile/coop-threads.c diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c index adc2b82d5..a3f4018e0 100644 --- a/libguile/coop-threads.c +++ b/libguile/coop-threads.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995, 1996, 1997, 1998 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -39,20 +39,19 @@ * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ -/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, - gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ -#include "scm_validate.h" -#include "coop-threads.h" +#include "libguile/validate.h" +#include "libguile/coop-threads.h" +#include "libguile/root.h" /* A counter of the current number of threads */ size_t scm_thread_count = 0; /* This is included rather than compiled separately in order to simplify the configuration mechanism. */ -#include "coop.c" +#include "libguile/coop.c" /* A count-down counter used to determine when to switch contexts */ @@ -67,7 +66,9 @@ scm_threads_init (SCM_STACKITEM *i) scm_thread_count = 1; +#ifndef GUILE_PTHREAD_COMPAT coop_global_main.sto = i; +#endif coop_global_main.base = i; coop_global_curr = &coop_global_main; coop_all_qput (&coop_global_allq, coop_global_curr); @@ -97,8 +98,8 @@ scm_threads_mark_stacks (void) /* Protect from the C stack. This must be the first marking * done because it provides information about what objects * are "in-use" by the C code. "in-use" objects are those - * for which the values from SCM_LENGTH and SCM_CHARS must remain - * usable. This requirement is stricter than a liveness + * for which the information about length and base address must + * remain usable. This requirement is stricter than a liveness * requirement -- in particular, it constrains the implementation * of scm_resizuve. */ @@ -106,7 +107,7 @@ scm_threads_mark_stacks (void) /* This assumes that all registers are saved into the jmp_buf */ setjmp (scm_save_regs_gc_mark); scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark, - ((scm_sizet) sizeof scm_save_regs_gc_mark + ((size_t) sizeof scm_save_regs_gc_mark / sizeof (SCM_STACKITEM))); scm_mark_locations (((size_t) thread->base, @@ -118,8 +119,8 @@ scm_threads_mark_stacks (void) /* Protect from the C stack. This must be the first marking * done because it provides information about what objects * are "in-use" by the C code. "in-use" objects are those - * for which the values from SCM_LENGTH and SCM_CHARS must remain - * usable. This requirement is stricter than a liveness + * for which the information about length and base address must + * remain usable. This requirement is stricter than a liveness * requirement -- in particular, it constrains the implementation * of scm_resizuve. */ @@ -127,7 +128,7 @@ scm_threads_mark_stacks (void) /* This assumes that all registers are saved into the jmp_buf */ setjmp (scm_save_regs_gc_mark); scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark, - ((scm_sizet) sizeof scm_save_regs_gc_mark + ((size_t) sizeof scm_save_regs_gc_mark / sizeof (SCM_STACKITEM))); scm_mark_locations ((SCM_STACKITEM *) &thread, @@ -177,21 +178,19 @@ typedef struct scheme_launch_data { SCM handler; } scheme_launch_data; -extern SCM scm_apply (SCM, SCM, SCM); - static SCM scheme_body_bootstrip (scheme_launch_data* data) { /* First save the new root continuation */ data->rootcont = scm_root->rootcont; - return scm_apply (data->body, SCM_EOL, SCM_EOL); + return scm_call_0 (data->body); } static SCM scheme_handler_bootstrip (scheme_launch_data* data, SCM tag, SCM throw_args) { scm_root->rootcont = data->rootcont; - return scm_apply (data->handler, scm_cons (tag, throw_args), SCM_EOL); + return scm_apply_1 (data->handler, tag, throw_args); } static void @@ -206,17 +205,20 @@ scheme_launch_thread (void *p) data.rootcont = SCM_BOOL_F; data.body = SCM_CADR (argl); data.handler = SCM_CADDR (argl); - scm_internal_cwdr ((scm_catch_body_t) scheme_body_bootstrip, + scm_internal_cwdr ((scm_t_catch_body) scheme_body_bootstrip, &data, - (scm_catch_handler_t) scheme_handler_bootstrip, + (scm_t_catch_handler) scheme_handler_bootstrip, &data, - &thread); + (SCM_STACKITEM *) &thread); + SCM_SET_CELL_WORD_1 (thread, 0); scm_thread_count--; SCM_DEFER_INTS; } + SCM scm_call_with_new_thread (SCM argl) +#define FUNC_NAME s_call_with_new_thread { SCM thread; @@ -224,26 +226,23 @@ scm_call_with_new_thread (SCM argl) { register SCM args = argl; SCM thunk, handler; - SCM_ASSERT (SCM_NIMP (args), - scm_makfrom0str (s_call_with_new_thread), - SCM_WNA, NULL); + if (!SCM_CONSP (args)) + SCM_WRONG_NUM_ARGS (); thunk = SCM_CAR (args); SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)), thunk, SCM_ARG1, s_call_with_new_thread); args = SCM_CDR (args); - SCM_ASSERT (SCM_NIMP (args), - scm_makfrom0str (s_call_with_new_thread), - SCM_WNA, NULL); + if (!SCM_CONSP (args)) + SCM_WRONG_NUM_ARGS (); handler = SCM_CAR (args); SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)), handler, SCM_ARG2, s_call_with_new_thread); - SCM_ASSERT (SCM_NULLP (SCM_CDR (args)), - scm_makfrom0str (s_call_with_new_thread), - SCM_WNA, NULL); + if (!SCM_NULLP (SCM_CDR (args))) + SCM_WRONG_NUM_ARGS (); } /* Make new thread. */ @@ -258,15 +257,14 @@ scm_call_with_new_thread (SCM argl) /* Allocate thread locals. */ root = scm_make_root (scm_root->handle); /* Make thread. */ - SCM_NEWCELL (thread); + thread = scm_cell (scm_tc16_thread, 0); SCM_DEFER_INTS; - SCM_SETCAR (thread, scm_tc16_thread); argl = scm_cons (thread, argl); /* Note that we couldn't pass a pointer to argl as data since the argl variable may not exist in memory when the thread starts. */ t = coop_create (scheme_launch_thread, (void *) argl); t->data = SCM_ROOT_STATE (root); - SCM_SETCDR (thread, t); + SCM_SET_CELL_WORD_1 (thread, (scm_t_bits) t); scm_thread_count++; /* Note that the following statement also could cause coop_yield.*/ SCM_ALLOW_INTS; @@ -280,6 +278,8 @@ scm_call_with_new_thread (SCM argl) return thread; } +#undef FUNC_NAME + /* This is the second thread spawning mechanism: threads from C */ @@ -288,9 +288,9 @@ typedef struct c_launch_data { SCM thread; SCM rootcont; } u; - scm_catch_body_t body; + scm_t_catch_body body; void *body_data; - scm_catch_handler_t handler; + scm_t_catch_handler handler; void *handler_data; } c_launch_data; @@ -318,24 +318,23 @@ c_launch_thread (void *p) /* We must use the address of `thread', otherwise the compiler will optimize it away. This is OK since the longest SCM_STACKITEM also is a long. */ - scm_internal_cwdr ((scm_catch_body_t) c_body_bootstrip, + scm_internal_cwdr ((scm_t_catch_body) c_body_bootstrip, data, - (scm_catch_handler_t) c_handler_bootstrip, + (scm_t_catch_handler) c_handler_bootstrip, data, - &thread); + (SCM_STACKITEM *) &thread); scm_thread_count--; - scm_must_free ((char *) data); + free ((char *) data); } SCM -scm_spawn_thread (scm_catch_body_t body, void *body_data, - scm_catch_handler_t handler, void *handler_data) +scm_spawn_thread (scm_t_catch_body body, void *body_data, + scm_t_catch_handler handler, void *handler_data) { SCM thread; coop_t *t; SCM root, old_winds; - c_launch_data *data = (c_launch_data *) scm_must_malloc (sizeof (*data), - "scm_spawn_thread"); + c_launch_data *data = (c_launch_data *) scm_malloc (sizeof (*data)); /* Unwind wind chain. */ old_winds = scm_dynwinds; @@ -344,9 +343,8 @@ scm_spawn_thread (scm_catch_body_t body, void *body_data, /* Allocate thread locals. */ root = scm_make_root (scm_root->handle); /* Make thread. */ - SCM_NEWCELL (thread); + thread = scm_cell (scm_tc16_thread, 0); SCM_DEFER_INTS; - SCM_SETCAR (thread, scm_tc16_thread); data->u.thread = thread; data->body = body; @@ -357,7 +355,7 @@ scm_spawn_thread (scm_catch_body_t body, void *body_data, t = coop_create (c_launch_thread, (void *) data); t->data = SCM_ROOT_STATE (root); - SCM_SETCDR (thread, t); + SCM_SET_CELL_WORD_1 (thread, (scm_t_bits) t); scm_thread_count++; /* Note that the following statement also could cause coop_yield.*/ SCM_ALLOW_INTS; @@ -372,11 +370,24 @@ scm_spawn_thread (scm_catch_body_t body, void *body_data, } SCM -scm_join_thread (SCM t) +scm_join_thread (SCM thread) #define FUNC_NAME s_join_thread { - SCM_VALIDATE_THREAD(1,t); - coop_join (SCM_THREAD_DATA (t)); + coop_t *thread_data; + SCM_VALIDATE_THREAD (1, thread); + /* Dirk:FIXME:: SCM_THREAD_DATA is a handle for a thread. It may be that a + * certain thread implementation uses a value of 0 as a valid thread handle. + * With the following code, this thread would always be considered finished. + */ + /* Dirk:FIXME:: With preemptive threading, a thread may finish immediately + * after SCM_THREAD_DATA is read. Thus, it must be guaranteed that the + * handle remains valid until the thread-object is garbage collected, or + * a mutex has to be used for reading and modifying SCM_THREAD_DATA. + */ + thread_data = SCM_THREAD_DATA (thread); + if (thread_data) + /* The thread is still alive */ + coop_join (thread_data); return SCM_BOOL_T; } #undef FUNC_NAME @@ -402,11 +413,8 @@ scm_single_thread_p (void) SCM scm_make_mutex (void) { - SCM m; - coop_m *data = (coop_m *) scm_must_malloc (sizeof (coop_m), "mutex"); - - SCM_NEWSMOB (m, scm_tc16_mutex, data); - coop_mutex_init (data); + SCM m = scm_make_smob (scm_tc16_mutex); + coop_mutex_init (SCM_MUTEX_DATA (m)); return m; } @@ -434,9 +442,7 @@ scm_unlock_mutex (SCM m) SCM scm_make_condition_variable (void) { - SCM c; - coop_c *data = (coop_c *) scm_must_malloc (sizeof (coop_c), "condvar"); - SCM_NEWSMOB (c, scm_tc16_condvar, data); + SCM c = scm_make_smob (scm_tc16_condvar); coop_condition_variable_init (SCM_CONDVAR_DATA (c)); return c; } @@ -467,3 +473,9 @@ scm_signal_condition_variable (SCM c) coop_condition_variable_signal (SCM_CONDVAR_DATA (c)); return SCM_BOOL_T; } + +/* + Local Variables: + c-file-style: "gnu" + End: +*/