-/* Copyright (C) 1995, 1996, 1997, 1998, 2000 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
* 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 */
\f
-#include "validate.h"
-#include "coop-threads.h"
-#include "root.h"
-#include "strings.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 */
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);
/* 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.
*/
/* 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,
/* 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.
*/
/* 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,
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
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,
(SCM_STACKITEM *) &thread);
SCM_SET_CELL_WORD_1 (thread, 0);
SCM_DEFER_INTS;
}
+
SCM
scm_call_with_new_thread (SCM argl)
+#define FUNC_NAME s_call_with_new_thread
{
SCM thread;
{
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. */
/* 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_SET_CELL_WORD_1 (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;
return thread;
}
+#undef FUNC_NAME
+
/* This is the second thread spawning mechanism: threads from C */
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;
/* 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,
(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;
/* 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;
t = coop_create (c_launch_thread, (void *) data);
t->data = SCM_ROOT_STATE (root);
- SCM_SET_CELL_WORD_1 (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;
}
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
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;
}
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;
}
HCoop / bpt / guile.git / blobdiff