Commit 2c423af9 authored by Erick Gallesio's avatar Erick Gallesio

.

parent 6e511cb2
2006-04-06 Erick Gallesio <eg@essi.fr>
* lib/bonus.stk (parameterize):
* src/lib.c
* src/parameter.c
* src/stklos.h
* src/thread.c
* src/vm.c
* src/vm.h: New implementetaion of parameters. Paramateres can now
be assocaited to a thread. PARAMETERIZE permits to have a thread
specific dynamic environment.
* src/env.c: CURRENT-MODULE is now thread sepcific
2006-04-05 Erick Gallesio <eg@essi.fr>
......
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 2-Feb-2006 21:58 (eg)
* Last file update: 5-Feb-2006 21:52 (eg)
* Last file update: 6-Apr-2006 19:16 (eg)
*/
#define _REENTRANT 1
......@@ -59,6 +59,18 @@ struct mutex_obj {
#define MUTEX_MYMUTEX(p) (((struct mutex_obj *) (p))->mymutex)
#define MUTEX_MYCONDV(p) (((struct mutex_obj *) (p))->mycondv)
struct condv_obj {
stk_header header;
SCM name;
SCM specific;
pthread_cond_t mycondv;
};
#define CONDVP(p) (BOXED_TYPE_EQ((p), tc_condv))
#define CONDV_NAME(p) (((struct condv_obj *) (p))->name)
#define CONDV_SPECIFIC(p) (((struct condv_obj *) (p))->specific)
#define CONDV_MYCONDV(p) (((struct condv_obj *) (p))->mycondv)
void error_bad_mutex(SCM obj)
{
......@@ -78,7 +90,6 @@ void error_bad_timeout(SCM tm)
void mutex_finalizer(SCM mtx)
{
STk_debug("Finalizer mutex ~S", mtx);
pthread_mutex_destroy(&MUTEX_MYMUTEX(mtx));
pthread_cond_destroy(&MUTEX_MYCONDV(mtx));
}
......@@ -185,7 +196,7 @@ DEFINE_PRIMITIVE("%mutex-lock!", mutex_lock, subr3, (SCM mtx, SCM tm, SCM thread
if (tm != STk_false) {
int n = pthread_cond_timedwait(&MUTEX_MYCONDV(mtx), &MUTEX_MYMUTEX(mtx), &ts);
if (n == ETIMEDOUT) { STk_debug("TIMEOUT"); res = STk_false; break; }
if (n == ETIMEDOUT) { res = STk_false; break; }
}
else
pthread_cond_wait(&MUTEX_MYCONDV(mtx), &MUTEX_MYMUTEX(mtx));
......@@ -234,11 +245,11 @@ DEFINE_PRIMITIVE("%mutex-unlock!", mutex_unlock, subr3, (SCM mtx, SCM cv, SCM tm
pthread_cond_signal(&MUTEX_MYCONDV(mtx));
if (cv != STk_false) {
if (tm != STk_false) {
int n = pthread_cond_timedwait(&MUTEX_MYCONDV(mtx), &MUTEX_MYMUTEX(mtx), &ts);
int n = pthread_cond_timedwait(&CONDV_MYCONDV(cv), &MUTEX_MYMUTEX(mtx), &ts);
if (n == ETIMEDOUT) res = STk_false;
} else {
pthread_cond_wait(&MUTEX_MYCONDV(mtx), &MUTEX_MYMUTEX(mtx));
pthread_cond_wait(&CONDV_MYCONDV(cv), &MUTEX_MYMUTEX(mtx));
}
}
pthread_mutex_unlock(&MUTEX_MYMUTEX(mtx));
......@@ -253,20 +264,6 @@ DEFINE_PRIMITIVE("%mutex-unlock!", mutex_unlock, subr3, (SCM mtx, SCM cv, SCM tm
*
\* ====================================================================== */
struct condv_obj {
stk_header header;
SCM name;
SCM specific;
pthread_cond_t mycondv;
};
#define CONDVP(p) (BOXED_TYPE_EQ((p), tc_mutex))
#define CONDV_NAME(p) (((struct mutex_obj *) (p))->name)
#define CONDV_SPECIFIC(p) (((struct mutex_obj *) (p))->specific)
#define CONDV_MYCONDV(p) (((struct mutex_obj *) (p))->mycondv)
void error_bad_condv(SCM obj)
{
STk_error("bad confdition variable ~S", obj);
......@@ -274,7 +271,6 @@ void error_bad_condv(SCM obj)
void condv_finalizer(SCM cv)
{
STk_debug("Finalizer condv ~S", cv);
pthread_cond_destroy(&CONDV_MYCONDV(cv));
}
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 1-Jul-2003 11:38 (eg)
* Last file update: 6-Apr-2006 17:49 (eg)
* Last file update: 6-Apr-2006 18:28 (eg)
*/
......@@ -59,7 +59,7 @@ static void error_bad_parameter(SCM obj)
static void add_to_dynamic_env(SCM z)
{
vm_thread_t *vm = STk_get_current_vm();
vm->dynenv = STk_cons(z, vm->dynenv);
vm->parameters = STk_cons(z, vm->parameters);
}
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 23-Jan-2006 12:14 (eg)
* Last file update: 6-Apr-2006 17:21 (eg)
* Last file update: 6-Apr-2006 19:05 (eg)
*/
......@@ -95,7 +95,7 @@ static void *start_scheme_thread(void *arg)
SCM res;
vm = THREAD_VM(thr) = STk_allocate_vm(5000); // FIX:
vm->scheme_thread = thr;
vm->scheme_thread = thr;
pthread_setspecific(vm_key, vm);
pthread_cleanup_push(terminate_scheme_thread, thr);
......@@ -124,7 +124,7 @@ static SCM do_make_thread(SCM thunk, char *name)
THREAD_RESULT(z) = STk_void;
THREAD_EXCEPTION(z) = STk_false;
THREAD_STATE(z) = th_new;
// FIX: lock
all_threads = STk_cons(z, all_threads); /* For the GC */
return z;
......@@ -308,6 +308,10 @@ DEFINE_PRIMITIVE("%thread-join!", thread_join, subr2, (SCM thr, SCM tm))
DEFINE_PRIMITIVE("%thread-system", thread_system, subr0, (void))
{
return STk_intern("pthread");
}
/* ======================================================================
* Initialization ...
......@@ -387,7 +391,12 @@ int STk_init_threads(int stack_size)
ADD_PRIMITIVE(thread_yield);
ADD_PRIMITIVE(thread_terminate);
ADD_PRIMITIVE(thread_join);
ADD_PRIMITIVE(thread_system);
return TRUE;
}
#ifdef THREAD_LURC
int STk_thread_main(STk_main_t themain, int argc, char **argv){
return themain(argc, argv);
}
#endif
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 1-Mar-2000 19:51 (eg)
* Last file update: 6-Apr-2006 12:42 (eg)
* Last file update: 6-Apr-2006 19:16 (eg)
*/
// INLINER values
......@@ -139,7 +139,7 @@ vm_thread_t *STk_allocate_vm(int stack_size)
vm->handlers = NULL;
vm->top_jmp_buf = NULL;
vm->scheme_thread = STk_false;
vm->dynenv = STk_nil;
vm->parameters = STk_nil;
return vm;
}
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 1-Mar-2000 19:51 (eg)
* Last file update: 6-Apr-2006 12:39 (eg)
* Last file update: 6-Apr-2006 18:28 (eg)
*/
......@@ -102,7 +102,7 @@ typedef struct {
int stack_len;
SCM current_module;
SCM scheme_thread; /* Scheme associated thread */
SCM dynenv; /* Scheme dynamic environement (parameter objects) */
SCM parameters; /* Scheme dynamic environement (parameter objects) */
} vm_thread_t;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment