Commit b2ceb201 authored by separdau's avatar separdau

threads: removed common_destroy,

 added do_make_sys_threads where mutexes and signals are initialized, so that
 we can join with threads which have not yet been started
 added finalizers for threads, but this breaks for now....
 also fixed a error_bad_thread -> STk_error_bad_thread
tests/test-threads.stk: enabled the fib test, which works.
parent 7088021d
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -26,7 +26,7 @@
#ifndef _STK_MUTEX_PTHREADS_H
#define _STK_MUTEX_PTHREADS_H
#include <pthreads.h>
#include <pthread.h>
#include "stklos.h"
/* ====================================================================== *\
......
......@@ -32,9 +32,8 @@ SCM STk_primordial_thread = NULL;
SCM STk_cond_thread_terminated;
static SCM cond_thread_abandonned_mutex, cond_join_timeout;
static SCM all_threads = STk_nil;
void error_bad_thread(SCM obj)
void STk_error_bad_thread(SCM obj)
{
STk_error("bad thread ~S", obj);
}
......@@ -61,7 +60,8 @@ static SCM do_make_thread(SCM thunk, SCM name)
THREAD_STATE(z) = th_new;
THREAD_VM(z) = NULL;
all_threads = STk_cons(z, all_threads); /* For the GC */
STk_do_make_sys_thread(z);
return z;
}
......@@ -84,34 +84,34 @@ DEFINE_PRIMITIVE("thread?", threadp, subr1, (SCM obj))
DEFINE_PRIMITIVE("thread-name", thread_name, subr1, (SCM thr))
{
if (! THREADP(thr)) error_bad_thread(thr);
if (! THREADP(thr)) STk_error_bad_thread(thr);
return THREAD_NAME(thr);
}
DEFINE_PRIMITIVE("%thread-end-exception", thread_end_exception, subr1, (SCM thr))
{
if (!THREADP(thr)) error_bad_thread(thr);
if (!THREADP(thr)) STk_error_bad_thread(thr);
return THREAD_EXCEPTION(thr);
}
DEFINE_PRIMITIVE("%thread-end-exception-set!", thread_end_exception_set,
subr2, (SCM thr, SCM val))
{
if (!THREADP(thr)) error_bad_thread(thr);
if (!THREADP(thr)) STk_error_bad_thread(thr);
THREAD_EXCEPTION(thr) = val;
return STk_void;
}
DEFINE_PRIMITIVE("%thread-end-result", thread_end_result, subr1, (SCM thr))
{
if (!THREADP(thr)) error_bad_thread(thr);
if (!THREADP(thr)) STk_error_bad_thread(thr);
return THREAD_RESULT(thr);
}
DEFINE_PRIMITIVE("%thread-end-result-set!", thread_end_result_set,
subr2, (SCM thr, SCM val))
{
if (!THREADP(thr)) error_bad_thread(thr);
if (!THREADP(thr)) STk_error_bad_thread(thr);
THREAD_RESULT(thr) = val;
return STk_void;
}
......@@ -119,14 +119,14 @@ DEFINE_PRIMITIVE("%thread-end-result-set!", thread_end_result_set,
DEFINE_PRIMITIVE("thread-specific", thread_specific, subr1, (SCM thr))
{
if (! THREADP(thr)) error_bad_thread(thr);
if (! THREADP(thr)) STk_error_bad_thread(thr);
return THREAD_SPECIFIC(thr);
}
DEFINE_PRIMITIVE("thread-specific-set!", thread_specific_set, subr2,
(SCM thr, SCM value))
{
if (!THREADP(thr)) error_bad_thread(thr);
if (!THREADP(thr)) STk_error_bad_thread(thr);
THREAD_SPECIFIC(thr) = value;
return STk_void;
}
......@@ -135,7 +135,7 @@ DEFINE_PRIMITIVE("thread-start!", thread_start, subr1, (SCM thr))
{
vm_thread_t *vm, *new;
if (!THREADP(thr)) error_bad_thread(thr);
if (!THREADP(thr)) STk_error_bad_thread(thr);
if (THREAD_STATE(thr) != th_new)
STk_error("thread has already been started ~S", thr);
......@@ -157,12 +157,6 @@ DEFINE_PRIMITIVE("thread-start!", thread_start, subr1, (SCM thr))
return thr;
}
void STk_thread_terminate_common(SCM thr){
/* remove the thread from the GC list, it can now dissapear when
everyone has stopped referencing it */
all_threads = STk_dremq(thr, all_threads);
}
/* ======================================================================
* Initialization ...
* ======================================================================
......
......@@ -63,7 +63,6 @@ struct thread_obj {
#define THREAD_VM(p) (((struct thread_obj *) (p))->vm)
extern void STk_error_bad_thread(SCM obj);
extern void STk_thread_terminate_common(SCM thr);
extern SCM STk_cond_thread_terminated;
......
......@@ -62,6 +62,19 @@ vm_thread_t *STk_get_current_vm(void)
/* ====================================================================== */
static void thread_finalizer(SCM thr){
int err;
// deallocate the signals
if((THREAD_TERM_SIG(thr) != NULL
&& ((err = lurc_signal_destroy(&THREAD_TERM_SIG(thr))) != 0))
|| (THREAD_DEATH_SIG(thr) != NULL
&& ((err = lurc_signal_destroy(&THREAD_DEATH_SIG(thr))) != 0))){
// any error here is fatal since we cannot raise it properly
STk_panic("Lurc error: ~S", lurc_strerror(err));
}
}
static void thread_watch(void *arg){
SCM thr = (SCM) arg;
// run the thread thunk
......@@ -97,23 +110,18 @@ static void start_scheme_thread(void *arg)
}
// FIXME: abandon the mutexes ?
// now deallocate the signals
if(((err = lurc_signal_destroy(&THREAD_TERM_SIG(thr))) != 0)
|| ((err = lurc_signal_destroy(&THREAD_DEATH_SIG(thr))) != 0)){
// any error here is fatal since we cannot raise it properly
STk_panic("Lurc error: ~S", lurc_strerror(err));
}
STk_thread_terminate_common(thr);
}
/* ====================================================================== */
void STk_sys_thread_start(SCM thr)
void STk_do_make_sys_thread(SCM thr)
{
lurc_signal_attr_t attr;
int err;
THREAD_TERM_SIG(thr) = NULL;
THREAD_DEATH_SIG(thr) = NULL;
// give them semi-meaningful names
if((err = lurc_signal_attr_init(&attr)) != 0)
lurc_error(err);
......@@ -127,7 +135,7 @@ void STk_sys_thread_start(SCM thr)
if((err = lurc_signal_attr_setname(&attr, "thread-death-sig")) != 0
|| (err = lurc_signal_init(&(THREAD_DEATH_SIG(thr)), &attr)) != 0){
lurc_signal_attr_destroy(&attr);
// do not forget the first successfull signal
// do not forget the first signal
lurc_signal_destroy(&(THREAD_TERM_SIG(thr)));
lurc_error(err);
}
......@@ -139,6 +147,14 @@ void STk_sys_thread_start(SCM thr)
lurc_error(err);
}
// now the finalizer
STk_register_finalizer(thr, thread_finalizer);
}
void STk_sys_thread_start(SCM thr)
{
int err;
if((err = lurc_thread_create(&THREAD_LTHREAD(thr), NULL,
&start_scheme_thread, thr)) != 0){
// do not forget the signals
......
......@@ -41,6 +41,7 @@ struct sys_thread_obj {
extern struct timeval lthr_abs_time_to_rel_time(double abs_secs);
extern void STk_do_make_sys_thread(SCM thr);
extern void STk_sys_thread_start(SCM thr);
extern int STk_init_sys_threads(vm_thread_t *vm);
......@@ -50,5 +51,4 @@ EXTERN_PRIMITIVE("%thread-join!", thread_join, subr2, (SCM thr, SCM tm));
EXTERN_PRIMITIVE("%thread-sleep!", thread_sleep, subr1, (SCM tm));
EXTERN_PRIMITIVE("%thread-system", thread_system, subr0, (void));
#endif /* ! _STK_THREAD_LURC_H */
......@@ -30,15 +30,6 @@
#include "vm.h"
#include "thread-common.h"
static SCM all_threads = STk_nil;
static void error_bad_thread(SCM obj)
{
STk_error("bad thread ~S", obj);
}
/*
* Thread specific value (the VM)
*/
......@@ -68,6 +59,14 @@ vm_thread_t *STk_get_current_vm(void)
/* ====================================================================== */
static void thread_finalizer(SCM thr)
{
printf("DESTROY!!\n");
fflush(stdout);
pthread_mutex_destroy(&THREAD_MYMUTEX(thr));
pthread_cond_destroy(&THREAD_MYCONDV(thr));
}
static void terminate_scheme_thread(void *arg)
{
SCM thr = (SCM) arg;
......@@ -75,11 +74,9 @@ static void terminate_scheme_thread(void *arg)
pthread_mutex_lock(&THREAD_MYMUTEX(thr));
THREAD_STATE(thr) = th_terminated;
/* signal the death of this thread to the ones waiting it */
/* signal the death of this thread to the ones awaiting it */
pthread_cond_broadcast(&THREAD_MYCONDV(thr));
pthread_mutex_unlock(&THREAD_MYMUTEX(thr));
STk_thread_terminate_common(thr);
}
......@@ -90,7 +87,7 @@ static void *start_scheme_thread(void *arg)
pthread_setspecific(vm_key, THREAD_VM(thr));
pthread_cleanup_push(terminate_scheme_thread, thr);
res = STk_C_apply(THREAD_THUNK(thr), 0);
if (THREAD_EXCEPTION(thr) == STk_false) {
THREAD_RESULT(thr) = res;
......@@ -103,14 +100,22 @@ static void *start_scheme_thread(void *arg)
/* ====================================================================== */
void STk_do_make_sys_thread(SCM thr)
{
pthread_mutex_init(&THREAD_MYMUTEX(thr), NULL);
pthread_cond_init(&THREAD_MYCONDV(thr), NULL);
// now the finalizer
STk_register_finalizer(thr, thread_finalizer);
// printf("bla\n");
}
void STk_sys_thread_start(SCM thr)
{
pthread_attr_t attr;
pthread_attr_init(&attr);
pthread_attr_setdetachstate(&attr, TRUE);
pthread_mutex_init(&THREAD_MYMUTEX(thr), NULL);
pthread_cond_init(&THREAD_MYCONDV(thr), NULL);
// pthread_mutex_lock(&THREAD_MYMUTEX(thr));
......@@ -132,7 +137,7 @@ DEFINE_PRIMITIVE("thread-yield!", thread_yield, subr0, (void))
DEFINE_PRIMITIVE("thread-terminate!", thread_terminate, subr1, (SCM thr))
{
if (!THREADP(thr)) error_bad_thread(thr);
if (!THREADP(thr)) STk_error_bad_thread(thr);
if (THREAD_STATE(thr) != th_terminated) {
terminate_scheme_thread(thr);
......@@ -140,7 +145,8 @@ DEFINE_PRIMITIVE("thread-terminate!", thread_terminate, subr1, (SCM thr))
pthread_mutex_lock(&THREAD_MYMUTEX(thr));
if (THREAD_EXCEPTION(thr) == STk_void) {
/* Be sure to register the first canceller only! */
THREAD_EXCEPTION(thr) = STk_make_C_cond(cond_thread_terminated, 1, thr);
THREAD_EXCEPTION(thr) =
STk_make_C_cond(STk_cond_thread_terminated, 1, thr);
}
pthread_mutex_lock(&THREAD_MYMUTEX(thr));
......@@ -162,7 +168,8 @@ DEFINE_PRIMITIVE("%thread-join!", thread_join, subr2, (SCM thr, SCM tm))
SCM res = STk_false;
double tmd;
if (!THREADP(thr)) error_bad_thread(thr);
if (!THREADP(thr)) STk_error_bad_thread(thr);
if (REALP(tm)) {
tmd = REAL_VAL(tm);
......
......@@ -40,6 +40,13 @@ struct sys_thread_obj {
#define THREAD_MYCONDV(p) (((struct thread_obj *) (p))->sys_thread.mycondv)
extern void STk_sys_thread_start(SCM thr);
extern void STk_do_make_sys_thread(SCM thr);
extern int STk_init_sys_threads(vm_thread_t *vm);
EXTERN_PRIMITIVE("thread-yield!", thread_yield, subr0, (void));
EXTERN_PRIMITIVE("thread-terminate!", thread_terminate, subr1, (SCM thr));
EXTERN_PRIMITIVE("%thread-join!", thread_join, subr2, (SCM thr, SCM tm));
EXTERN_PRIMITIVE("%thread-sleep!", thread_sleep, subr1, (SCM tm));
EXTERN_PRIMITIVE("%thread-system", thread_system, subr0, (void));
#endif /* ! _STK_THREAD_PTHREADS_H */
......@@ -56,23 +56,23 @@
t))))
;; calculate fibonacchi in awful way
;;// (define (mt-fib n)
;;// (let ((threads (make-vector n)))
;;// (dotimes (i n)
;;// (vector-set! threads
;;// i
;;// (make-thread
;;// (case i
;;// ((0) (lambda () 1))
;;// ((1) (lambda () 2))
;;// (else (lambda ()
;;// (+ (thread-join! (vector-ref threads (- i 1)))
;;// (thread-join! (vector-ref threads (- i 2))))))))))
;;// (dotimes (i n)
;;// (thread-start! (vector-ref threads (- n i 1))))
;;// (thread-join! (vector-ref threads (- n 1)))))
;;//
;;// (test "thread-join!" 14930352 (mt-fib 35))
(define (mt-fib n)
(let ((threads (make-vector n)))
(dotimes (i n)
(vector-set! threads
i
(make-thread
(case i
((0) (lambda () 1))
((1) (lambda () 2))
(else (lambda ()
(+ (thread-join! (vector-ref threads (- i 1)))
(thread-join! (vector-ref threads (- i 2))))))))))
(dotimes (i n)
(thread-start! (vector-ref threads (- n i 1))))
(thread-join! (vector-ref threads (- n 1)))))
(test "thread-join!" 14930352 (mt-fib 35))
;;---------------------------------------------------------------------
(test-subsection "Thread and error")
......
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