Commit 3f081ccb authored by separdau's avatar separdau

configure.in: removed REENTRANT and GC_LINUX_THREADS for Lurc, I'm still

 not sure this does the right thing, especially when giving it to the GC
 we're builing, which should not happen (I think).
lib/thread.stk: this one got removed (by accident?) and since the Makefile
 called it thread.stk (and not thread_S_.stk) I renamed it... fixme ?
thread*: remove threads from all_threads when they terminate, I think it's
 a good time then, but for the pthreads impl there are a few mutex and condv
 destroy missing...
lurc-*: made threads, mutexes and cond vars accept any SCM obj as name
lurc-thread.c: fixed a bug in thread_join for already dead threads
now make test passes !!!
parent 1e79281a
This diff is collapsed.
......@@ -113,6 +113,7 @@ esac
dnl Add the options _REENTRANT and GC_LINUX_THREADS if we are on Linux
case "$THREADS" in
none) true ;;
lurc) true ;;
*) case `uname -s` in
Linux*) CFLAGS="$CFLAGS -D_REENTRANT=1 -DGC_LINUX_THREADS=1";;
esac
......
......@@ -155,7 +155,7 @@ NROFF = nroff
MANS = $(man_MANS)
DATA = $(dochtml_DATA) $(docimg_DATA) $(docpdf_DATA) $(scheme_DATA)
DIST_COMMON = Makefile.am Makefile.in TODO stklos-compile.1.in \
DIST_COMMON = Makefile.am Makefile.in stklos-compile.1.in \
stklos-config.1.in stklos-genlex.1.in stklos-install.1.in \
stklos.1.in
all: all-am
......
(set! *load-path* (cons "lib/" (cons "lib/Lurc.d/" *load-path*)))
(load "threads")
(load "thread")
(print (%thread-system))
......@@ -41,9 +41,11 @@
(thread-join! thread2))
(print "done")
(if (eq? (%thread-system) 'lurc)
(load "lurc"))
(when (eq? (%thread-system) 'lurc)
(load "lurc")
(print "testing lurc")
(let ((sig (lurc:signal "test")))
(lurc:watch
sig
......
......@@ -153,7 +153,7 @@ LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
DIST_SOURCES =
DATA = $(scheme_DATA)
DIST_COMMON = README Makefile.am Makefile.in TODO extconf.h.in
DIST_COMMON = README Makefile.am Makefile.in extconf.h.in
all: all-am
.SUFFIXES:
......
......@@ -186,7 +186,7 @@ LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
DIST_SOURCES = $(libgtklos_a_SOURCES)
DATA = $(scheme_DATA)
DIST_COMMON = Makefile.am Makefile.in TODO gtklosconf.h.in
DIST_COMMON = Makefile.am Makefile.in gtklosconf.h.in
SOURCES = $(libgtklos_a_SOURCES)
all: all-am
......
......@@ -118,7 +118,6 @@ STACK_DIRECTION = @STACK_DIRECTION@
STRIP = @STRIP@
SVN_URL = @SVN_URL@
THREADS = @THREADS@
THREAD_FILES = @THREAD_FILES@
VERSION = @VERSION@
am__include = @am__include@
am__quote = @am__quote@
......
......@@ -22,4 +22,6 @@
(select-module STklos)
(import lurc)
(print "got lurc")
(provide "lurc")
\ No newline at end of file
;;;;
;;;; threads.stk -- Threads support
;;;;
;;;; Copyright © 2006 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; 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
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 26-Jan-2006 22:56 (eg)
;;;; Last file update: 14-Apr-2006 20:00 (eg)
;;;;
(define (%thread-timeout->seconds timeout)
(cond
((time? timeout) (time->seconds timeout))
((not timeout) timeout)
((real? timeout) (+ (time->seconds (current-time))
timeout))
(else (error "bad timeout ~S" timeout))))
(define (make-thread thunk :optional (name (symbol->string (gensym "thread"))))
(define (thread-handler c)
(%thread-end-exception-set! (current-thread) c)
c)
(%make-thread (lambda ()
(with-handler thread-handler
(thunk)))
name))
(define (thread-sleep! timeout)
(let ((n (%thread-timeout->seconds timeout)))
(unless n
(error 'thread-sleep! "cannot used #f as timeout"))
(%thread-sleep! n)))
(define (thread-join! thread :optional timeout (timeout-val #f timeout-val?))
(if (and (eq? thread (current-thread)) (not timeout))
(error 'thread-join! "cannot join on myself (deadlock will occur)")
(let ((join (%thread-join! thread
(%thread-timeout->seconds timeout))))
(cond
(join
;; We had a timeout
(if timeout-val?
timeout-val
(raise (make-condition &thead-join-timeout))))
((%thread-end-exception thread)
;; We had an exceptionin thread. Raise it
(raise (%thread-end-exception thread)))
(else
;; No exception. Return the thread-result
(%thread-end-result thread))))))
(define (mutex-lock! mtx :optional timeout (thread (current-thread)))
(let ((res (%mutex-lock! mtx (%thread-timeout->seconds timeout) thread)))
;; Different cases for res:
;; - The owning thread which is now terminated (a condition must be raised)
;; - #f: we had a timeout
;; - #t: otherwise
(if (thread? res)
(make-condition &thread-abandonned-mutex)
res)))
(define (mutex-unlock! mtx :optional condv timeout)
(%mutex-unlock! mtx condv timeout))
......@@ -246,8 +246,7 @@ LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
DIST_SOURCES = $(stklos_SOURCES)
DATA = $(extrainc_DATA)
DIST_COMMON = Makefile.am Makefile.in TODO extraconf.h.in \
stklosconf.h.in
DIST_COMMON = Makefile.am Makefile.in extraconf.h.in stklosconf.h.in
SOURCES = $(stklos_SOURCES)
all: stklosconf.h
......
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -110,14 +110,8 @@ DEFINE_PRIMITIVE("make-mutex", make_mutex, subr01, (SCM name))
{
SCM z;
if (name) {
if (!STRINGP(name))
STk_error("bad mutex name ~S", name);
}
else name = STk_Cstring2string("");
NEWCELL(z, mutex);
MUTEX_NAME(z) = name;
MUTEX_NAME(z) = (name ? name : STk_false);
MUTEX_SPECIFIC(z) = STk_void;
MUTEX_OWNER(z) = STk_false;
MUTEX_LOCKED(z) = FALSE;
......@@ -317,14 +311,8 @@ DEFINE_PRIMITIVE("make-condition-variable", make_condv, subr01, (SCM name))
{
SCM z;
if (name) {
if (!STRINGP(name))
STk_error("bad condition variable name ~S", name);
}
else name = STk_Cstring2string("");
NEWCELL(z, condv);
CONDV_NAME(z) = name;
CONDV_NAME(z) = (name ? name : STk_false);
CONDV_SPECIFIC(z) = STk_void;
CONDV_TARGET(z) = -1;
CONDV_EMITTED(z) = CV_NONE;
......@@ -398,25 +386,15 @@ DEFINE_PRIMITIVE("condition-variable-brodcast!", condv_broadcast, subr1, (SCM cv
static void print_mutex(SCM mutex, SCM port, int mode)
{
char *name = STRING_CHARS(MUTEX_NAME(mutex));
STk_puts("#[mutex ", port);
if (*name)
STk_puts(name, port);
else
STk_fprintf(port, "%lx", (unsigned long) mutex);
STk_print(MUTEX_NAME(mutex), port, DSP_MODE);
STk_putc(']', port);
}
static void print_condv(SCM condv, SCM port, int mode)
{
char *name = STRING_CHARS(CONDV_NAME(condv));
STk_puts("#[condition-variable ", port);
if (*name)
STk_puts(name, port);
else
STk_fprintf(port, "%lx", (unsigned long) condv);
STk_print(CONDV_NAME(condv), port, DSP_MODE);
STk_putc(']', port);
}
......
......@@ -97,16 +97,19 @@ static void start_scheme_thread(void *arg)
// now deallocate the signals
lurc_signal_destroy(&THREAD_TERM_SIG(thr));
lurc_signal_destroy(&THREAD_DEATH_SIG(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);
}
/* ====================================================================== */
static SCM do_make_thread(SCM thunk, char *name)
static SCM do_make_thread(SCM thunk, SCM name)
{
SCM z;
char buf[255];
NEWCELL(z, thread);
......@@ -117,18 +120,11 @@ static SCM do_make_thread(SCM thunk, char *name)
THREAD_EXCEPTION(z) = STk_false;
THREAD_STATE(z) = th_new;
// give them meaningful names
strncpy(buf, name, 244);
buf[244] = 0;
strcat(buf, "-term-sig");
THREAD_TERM_SIG(z) = lurc_signal(buf);
// give them semi-meaningful names
THREAD_TERM_SIG(z) = lurc_signal("thread-term-sig");
strncpy(buf, name, 244);
buf[244] = 0;
strcat(buf, "-death-sig");
THREAD_DEATH_SIG(z) = lurc_signal(buf);
THREAD_DEATH_SIG(z) = lurc_signal("thread-death-sig");
// FIX: lock
all_threads = STk_cons(z, all_threads); /* For the GC */
return z;
}
......@@ -309,7 +305,8 @@ DEFINE_PRIMITIVE("%thread-join!", thread_join, subr2, (SCM thr, SCM tm))
lurc_signal_await(&THREAD_DEATH_SIG(thr));
res = STk_false;
}
}
}else
res = STk_false;
return res;
}
......
......@@ -80,6 +80,10 @@ static void terminate_scheme_thread(void *arg)
/* signal the death of this thread to the ones waiting it */
pthread_cond_broadcast(&THREAD_MYCONDV(thr));
pthread_mutex_unlock(&THREAD_MYMUTEX(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);
}
......
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