Commit 1e79281a authored by Erick Gallesio's avatar Erick Gallesio

* Integration of Stef work

* Added a test for thread in test directory

parent 45bd53be
2006-04-15 Erick Gallesio <eg@essi.fr>
* configure.in: Added the _REENTRANT and GC_LINUX_THREADS in the
CFLAGS for Linux, when using threads for the GC.
* src/vm.c (call-with-values): Fixed bug when no values was
returned by the producer.
* configure.in:
- Added the _REENTRANT and GC_LINUX_THREADS in the
CFLAGS for Linux, when using threads for the GC.
- Use pthreads as a default if the pthreads librarie is
present
* src/fport.c, src/system.c
* lib/repl.stk (main-repl): Changed the way buffer are flushed.
Bonus: when programs exits normally in interactive mode, the
......@@ -46,7 +52,7 @@
* src/env.c: CURRENT-MODULE is now thread sepcific
2006-04-05 Erick Gallesio <eg@essi.fr>
n
* lib/computils.stk (symbol-bound?): Use SYMBOL-VALUE* instead of
SYMBOL-VALUE. This avoids some undefined symbols warnings.
......
......@@ -3785,12 +3785,83 @@ then
HAVE_DLOPEN="#define HAVE_DLOPEN 1"
fi
echo "$as_me:$LINENO: checking for pthread_create in -lpthread" >&5
echo $ECHO_N "checking for pthread_create in -lpthread... $ECHO_C" >&6
if test "${ac_cv_lib_pthread_pthread_create+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lpthread $LIBS"
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
/* Override any gcc2 internal prototype to avoid an error. */
#ifdef __cplusplus
extern "C"
#endif
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char pthread_create ();
int
main ()
{
pthread_create ();
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
(eval $ac_link) 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } &&
{ ac_try='test -z "$ac_c_werror_flag"
|| test ! -s conftest.err'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; } &&
{ ac_try='test -s conftest$ac_exeext'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
ac_cv_lib_pthread_pthread_create=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
ac_cv_lib_pthread_pthread_create=no
fi
rm -f conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
echo "$as_me:$LINENO: result: $ac_cv_lib_pthread_pthread_create" >&5
echo "${ECHO_T}$ac_cv_lib_pthread_pthread_create" >&6
if test $ac_cv_lib_pthread_pthread_create = yes; then
deflt_threads=pthreads
else
deflt_threads=none
fi
# Check whether --enable-threads or --disable-threads was given.
if test "${enable_threads+set}" = set; then
enableval="$enable_threads"
THREADS=$enableval
else
THREADS=none
THREADS=$deflt_threads
fi;
ac_ext=c
......
......@@ -2,7 +2,7 @@ dnl configure.in for STklos
dnl
dnl Author: Erick Gallesio [eg@unice.fr]
dnl Creation date: 28-Dec-1999 21:19 (eg)
dnl Last file update: 15-Apr-2006 12:44 (eg)
dnl Last file update: 15-Apr-2006 16:57 (eg)
AC_INIT(src/stklos.c)
......@@ -50,10 +50,12 @@ fi
dnl
dnl To thread or not to thread ?
dnl
AC_CHECK_LIB(pthread, pthread_create, deflt_threads=pthreads, deflt_threads=none)
AC_ARG_ENABLE(threads,
[AC_HELP_STRING([--enable-threads=TYPE], [choose threading package (none,pthread,lurc)])],
THREADS=$enableval,
THREADS=none)
THREADS=$deflt_threads)
AC_LANG(C)
dnl This checks for the presence of a given CPP define in a fiven header file
......
......@@ -2,7 +2,7 @@
#
# Author: Erick Gallesio [eg@unice.fr]
# Creation date: 11-Apr-2000 10:30 (eg)
# Last file update: 13-Apr-2006 13:20 (eg)
# Last file update: 16-Apr-2006 11:47 (eg)
SUBDIRS = Match.d SILex.d Lalr.d @LURCDIR@
......@@ -27,7 +27,8 @@ scheme_BOOT = assembler.stk \
repl.stk \
runtime.stk \
srfi-0.stk \
struct.stk
struct.stk \
thread.stk
scheme_SRCS = STklos.init \
......
......@@ -18,7 +18,7 @@
#
# Author: Erick Gallesio [eg@unice.fr]
# Creation date: 11-Apr-2000 10:30 (eg)
# Last file update: 13-Apr-2006 13:20 (eg)
# Last file update: 16-Apr-2006 11:47 (eg)
SHELL = @SHELL@
srcdir = @srcdir@
......@@ -145,7 +145,8 @@ scheme_BOOT = assembler.stk \
repl.stk \
runtime.stk \
srfi-0.stk \
struct.stk
struct.stk \
thread.stk
scheme_SRCS = STklos.init \
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 01-Jan-2000 15:04 (eg)
;;;; Last file update: 14-Apr-2006 23:34 (eg)
;;;; Last file update: 16-Apr-2006 10:20 (eg)
;;;;
(include "runtime.stk") ; Definition necessary for the bootstrap
......@@ -38,6 +38,7 @@
(include "compiler.stk") ; VM Compiler
(include "object.stk") ; CLOS like object system
(include "date.stk") ; Dates
(include "threads.stk") ; Thread support
(include "pragma.stk") ; Pragma system for STklos compiler
(include "obsolete.stk") ; Obsolete functions. Candidates to disappear
......@@ -48,7 +49,6 @@
(autoload "compfile" compile-file)
(syntax-autoload "match" match-case match-lambda)
(autoload "getopt" %print-usage)
(autoload "threads" make-thread)
(syntax-autoload "getopt" parse-arguments)
(syntax-autoload "trace" trace untrace)
(autoload "pp" pp pretty-print)
......
;;;;
;;;; 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))
......@@ -2,7 +2,7 @@
#
# Author: Erick Gallesio [eg@unice.fr]
# Creation date: 11-Apr-2000 10:30 (eg)
# Last file update: 14-Apr-2006 17:28 (eg)
# Last file update: 16-Apr-2006 10:58 (eg)
CC = @CC@
CFLAGS = @CFLAGS@
......@@ -21,13 +21,13 @@ THREADS = @THREADS@
# what thread support do we put in?
if LURC
THREAD_FILES = lurc_thread.c lurc_mutex.c
THREAD_FILES = thread-lurc.c mutex-lurc.c
endif
if PTHREADS
THREAD_FILES = thread.c mutex.c
THREAD_FILES = thread-pthreads.c mutex-pthreads.c
endif
if NO_THREAD
THREAD_FILES = nothread.c
THREAD_FILES = thread-none.c mutex-none.c
endif
stklos_SOURCES = boolean.c boot.c char.c cond.c dynload.c env.c error.c \
......
......@@ -18,7 +18,7 @@
#
# Author: Erick Gallesio [eg@unice.fr]
# Creation date: 11-Apr-2000 10:30 (eg)
# Last file update: 14-Apr-2006 17:28 (eg)
# Last file update: 16-Apr-2006 10:58 (eg)
SHELL = @SHELL@
srcdir = @srcdir@
......@@ -135,9 +135,9 @@ extrainc_DATA = stklos.h extraconf.h stklosconf.h socket.h fport.h
DOCDB = DOCDB
# what thread support do we put in?
@LURC_TRUE@THREAD_FILES = lurc_thread.c lurc_mutex.c
@NO_THREAD_TRUE@THREAD_FILES = nothread.c
@PTHREADS_TRUE@THREAD_FILES = thread.c mutex.c
@LURC_TRUE@THREAD_FILES = thread-lurc.c mutex-lurc.c
@NO_THREAD_TRUE@THREAD_FILES = thread-none.c mutex-none.c
@PTHREADS_TRUE@THREAD_FILES = thread-pthreads.c mutex-pthreads.c
stklos_SOURCES = boolean.c boot.c char.c cond.c dynload.c env.c error.c \
extend.c fport.c gnu-getopt.c gnu-glob.c hash.c keyword.c lib.c \
......@@ -188,9 +188,11 @@ CONFIG_CLEAN_FILES = extraconf.h
bin_PROGRAMS = stklos$(EXEEXT)
PROGRAMS = $(bin_PROGRAMS)
@LURC_TRUE@am__objects_1 = lurc_thread.$(OBJEXT) lurc_mutex.$(OBJEXT)
@NO_THREAD_TRUE@am__objects_1 = nothread.$(OBJEXT)
@PTHREADS_TRUE@am__objects_1 = thread.$(OBJEXT) mutex.$(OBJEXT)
@LURC_TRUE@am__objects_1 = thread-lurc.$(OBJEXT) mutex-lurc.$(OBJEXT)
@NO_THREAD_TRUE@am__objects_1 = thread-none.$(OBJEXT) \
@NO_THREAD_TRUE@ mutex-none.$(OBJEXT)
@PTHREADS_TRUE@am__objects_1 = thread-pthreads.$(OBJEXT) \
@PTHREADS_TRUE@ mutex-pthreads.$(OBJEXT)
am_stklos_OBJECTS = boolean.$(OBJEXT) boot.$(OBJEXT) char.$(OBJEXT) \
cond.$(OBJEXT) dynload.$(OBJEXT) env.$(OBJEXT) error.$(OBJEXT) \
extend.$(OBJEXT) fport.$(OBJEXT) gnu-getopt.$(OBJEXT) \
......@@ -220,22 +222,23 @@ am__depfiles_maybe = depfiles
@AMDEP_TRUE@ ./$(DEPDIR)/fport.Po ./$(DEPDIR)/gnu-getopt.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/gnu-glob.Po ./$(DEPDIR)/hash.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/keyword.Po ./$(DEPDIR)/lib.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/list.Po ./$(DEPDIR)/lurc_mutex.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/lurc_thread.Po ./$(DEPDIR)/misc.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/mutex.Po ./$(DEPDIR)/nothread.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/number.Po ./$(DEPDIR)/object.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/parameter.Po ./$(DEPDIR)/path.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/port.Po ./$(DEPDIR)/print.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/proc.Po ./$(DEPDIR)/process.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/promise.Po ./$(DEPDIR)/read.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/regexp.Po ./$(DEPDIR)/signal.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/sio.Po ./$(DEPDIR)/socket.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/sport.Po ./$(DEPDIR)/stklos.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/str.Po ./$(DEPDIR)/struct.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/symbol.Po ./$(DEPDIR)/system.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/thread.Po ./$(DEPDIR)/uvector.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/vector.Po ./$(DEPDIR)/vm.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/vport.Po
@AMDEP_TRUE@ ./$(DEPDIR)/list.Po ./$(DEPDIR)/misc.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/mutex-lurc.Po ./$(DEPDIR)/mutex-none.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/mutex-pthreads.Po ./$(DEPDIR)/number.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/object.Po ./$(DEPDIR)/parameter.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/path.Po ./$(DEPDIR)/port.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/print.Po ./$(DEPDIR)/proc.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/process.Po ./$(DEPDIR)/promise.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/read.Po ./$(DEPDIR)/regexp.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/signal.Po ./$(DEPDIR)/sio.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/socket.Po ./$(DEPDIR)/sport.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/stklos.Po ./$(DEPDIR)/str.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/struct.Po ./$(DEPDIR)/symbol.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/system.Po ./$(DEPDIR)/thread-lurc.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/thread-none.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/thread-pthreads.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/uvector.Po ./$(DEPDIR)/vector.Po \
@AMDEP_TRUE@ ./$(DEPDIR)/vm.Po ./$(DEPDIR)/vport.Po
COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
CCLD = $(CC)
......@@ -325,11 +328,10 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/keyword.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/lib.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/list.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/lurc_mutex.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/lurc_thread.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/misc.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mutex.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/nothread.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mutex-lurc.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mutex-none.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mutex-pthreads.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/number.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/object.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/parameter.Po@am__quote@
......@@ -350,7 +352,9 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/struct.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/symbol.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/system.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/thread.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/thread-lurc.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/thread-none.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/thread-pthreads.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/uvector.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/vector.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/vm.Po@am__quote@
......
This diff is collapsed.
This diff is collapsed.
......@@ -22,20 +22,20 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 23-Oct-1993 21:37
* Last file update: 4-Apr-2006 23:58 (eg)
* Last file update: 16-Apr-2006 10:51 (eg)
*/
#include "stklos.h"
#include "hash.h"
#include "vm.h"
#ifdef THREADS_PTHREADS
# include "thread.h"
# include "thread-pthreads.h"
#endif
#ifdef THREADS_LURC
# include "lurc_thread.h"
# include "thread-lurc.h"
#endif
#ifdef THREADS_NONE
# include "nothread.h"
# include "thread-none.h"
#endif
static void error_bad_module_name(SCM obj)
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 5-Jan-2000 12:17 (eg)
* Last file update: 14-Apr-2006 20:10 (eg)
* Last file update: 16-Apr-2006 11:00 (eg)
*/
......@@ -75,9 +75,7 @@ STk_init_library(int *argc, char ***argv, int stack_size)
STk_init_boolean() &&
STk_init_reader() &&
STk_init_system() &&
#ifndef THREADS_NONE
STk_init_mutexes() &&
#endif /* !THREADS_NONE */
STk_init_number() &&
STk_init_hash() &&
STk_init_misc() &&
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 2-Feb-2006 21:58 (eg)
* Last file update: 15-Apr-2006 13:05 (eg)
* Last file update: 16-Apr-2006 10:51 (eg)
*/
#include <lurc.h>
......@@ -33,7 +33,7 @@
#include <unistd.h>
#include "stklos.h"
#include "vm.h"
#include "lurc_thread.h"
#include "thread-lurc.h"
static SCM sym_not_owned, sym_abandoned, sym_not_abandoned;
......
/*
* mutex-none.c -- Pthread Mutexes in Scheme
*
* 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: 16-Apr-2006 11:13 (eg)
* Last file update: 16-Apr-2006 11:39 (eg)
*/
#include "stklos.h"
#include "thread-none.h"
int STk_init_mutexes(void)
{
/* Mutexes primitives */
FAKE_PRIMITIVE("make-mutex");
FAKE_PRIMITIVE("mutex?");
FAKE_PRIMITIVE("mutex-name");
FAKE_PRIMITIVE("mutex-specific");
FAKE_PRIMITIVE("mutex-specific-set!");
FAKE_PRIMITIVE("mutex-state");
FAKE_PRIMITIVE("%mutex-lock!");
FAKE_PRIMITIVE("%mutex-unlock!");
/* Condv primitives */
FAKE_PRIMITIVE("make-condition-variable");
FAKE_PRIMITIVE("condition-variable?");
FAKE_PRIMITIVE("condition-variable-name");
FAKE_PRIMITIVE("condition-variable-specific");
FAKE_PRIMITIVE("condition-variable-specific-set!");
FAKE_PRIMITIVE("condition-variable-signal!");
FAKE_PRIMITIVE("condition-variable-brodcast!");
return TRUE;
}
/*
* mutex.c -- Pthread Mutexes in Scheme
* mutex-pthreads.c -- Pthread Mutexes in Scheme
*
* Copyright 2006 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
*
......@@ -21,13 +21,13 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 2-Feb-2006 21:58 (eg)
* Last file update: 15-Apr-2006 13:06 (eg)
* Last file update: 17-Apr-2006 00:00 (eg)
*/
#include <unistd.h>
#include "stklos.h"
#include "vm.h"
#include "thread.h"
#include "thread-pthreads.h"
static SCM sym_not_owned, sym_abandoned, sym_not_abandoned;
......@@ -98,14 +98,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;
......@@ -341,11 +335,11 @@ 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));
SCM name = MUTEX_NAME(mutex);
STk_puts("#[mutex ", port);
if (*name)
STk_puts(name, port);
if (name != STk_false)
STk_print(name, port, DSP_MODE);
else
STk_fprintf(port, "%lx", (unsigned long) mutex);
STk_putc(']', port);
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 28-Dec-1999 22:58 (eg)
* Last file update: 15-Apr-2006 11:53 (eg)
* Last file update: 15-Apr-2006 17:30 (eg)
*/
#ifndef STKLOS_H
......@@ -1081,7 +1081,7 @@ int STk_init_symbol(void);
int STk_dirp(const char *path);
int STk_init_system();
EXTERN_PRIMITIVE("exit", quit, subr01, (SCM retcode));
EXTERN_PRIMITIVE("exit", exit, subr01, (SCM retcode));
/*
------------------------------------------------------------------------------
......
/*
* thread.c -- Threads support in STklos
* thread-lurc.c -- Threads support in STklos
*
* Copyright 2006 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
*
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 23-Jan-2006 12:14 (eg)
* Last file update: 8-Feb-2006 10:25 (eg)
* Last file update: 16-Apr-2006 13:16 (eg)
*/
......@@ -40,7 +40,7 @@
#include <time.h>
#include "stklos.h"
#include "vm.h"
#include "lurc_thread.h"
#include "thread-lurc.h"
SCM STk_primordial_thread = NULL;
static SCM primordial;
......@@ -145,13 +145,8 @@ DEFINE_PRIMITIVE("%make-thread", make_thread, subr12, (SCM thunk, SCM name))
if (STk_procedurep(thunk) == STk_false)
STk_error("bad thunk ~S", thunk);
if (name) {
if (!STRINGP(name))
STk_error("bad thread name ~S", name);
}
else name = STk_Cstring2string("");
z = do_make_thread(thunk, name);
z = do_make_thread(thunk, (name ? name : STk_false));
return z;
}
......@@ -353,11 +348,12 @@ DEFINE_PRIMITIVE("%thread-system", thread_system, subr0, (void))
static void print_thread(SCM thread, SCM port, int mode)
{
char *s, *name = STRING_CHARS(THREAD_NAME(thread));
char *s;
SCM name = THREAD_NAME(thread);
STk_puts("#[thread ", port);
if (*name)
STk_puts(name, port);
if (name != STk_false)
STk_print(name, port, DSP_MODE);
else
STk_fprintf(port, "%lx", (unsigned long) thread);
switch (THREAD_STATE(thread)) {
......
/*
* nothread.c -- Threads support in STklos
* thread-none.c -- Threads support in STklos
*
* Copyright © 2006 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
* Copyright 2006 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
*
*
* This program is free software; you can redistribute it and/or modify
......@@ -21,15 +21,16 @@
*
* Author: Stephane Epardaud [stephane.epardaud@inria.fr]
* Creation date: 23-Jan-2006 12:14 (se)
* Last file update: 13-Apr-2006 15:51 (se)
* Last file update: 16-Apr-2006 11:35 (eg)
*/
#include "nothread.h"
#include "thread-none.h"
#include "stklos.h"
#include "vm.h"
SCM STk_primordial_thread = NULL;
static vm_thread_t *current_vm = NULL;
static vm_thread_t *current_vm;
vm_thread_t *STk_get_current_vm(void){
return current_vm;
......@@ -46,6 +47,15 @@ DEFINE_PRIMITIVE("%thread-system", thread_system, subr0, (void))
return STk_intern("none");
}
DEFINE_PRIMITIVE("%thread-no-support", threadno, vsubr, (int argc, SCM *argv))
{
STk_error("your version of stklos does not provide thread support");
return STk_void;
}
int STk_init_threads(int stack_size)
{
current_vm = STk_allocate_vm(stack_size);
......@@ -53,8 +63,26 @@ int STk_init_threads(int stack_size)
STk_primordial_thread = STk_false;
/* Thread primitives */
ADD_PRIMITIVE(thread_system);
ADD_PRIMITIVE(current_thread);
ADD_PRIMITIVE(thread_system);
/* Fake primitives */
ADD_PRIMITIVE(threadno);
FAKE_PRIMITIVE("%make-thread");
FAKE_PRIMITIVE("thread?");
FAKE_PRIMITIVE("thread-name");
FAKE_PRIMITIVE("%thread-end-exception");
FAKE_PRIMITIVE("%thread-end-exception-set!");
FAKE_PRIMITIVE("%thread-end-result");
FAKE_PRIMITIVE("%thread-end-result-set!");
FAKE_PRIMITIVE("thread-specific");
FAKE_PRIMITIVE("thread-specific-set!");
FAKE_PRIMITIVE("thread-start!");
FAKE_PRIMITIVE("thread-yield!");
FAKE_PRIMITIVE("thread-terminate!");
FAKE_PRIMITIVE("%thread-join!");
FAKE_PRIMITIVE("%thread-sleep!");
return TRUE;
}
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 4-Feb-2006 11:03 (eg)
* Last file update: 4-Feb-2006 11:04 (eg)
* Last file update: 16-Apr-2006 11:42 (eg)
*/
#ifndef _STK_THREAD_H
#define _STK_THREAD_H
......@@ -30,4 +30,11 @@
extern SCM STk_primordial_thread;
extern struct primitive_obj STk_o_threadno; /* A pseudo primitive which */
/* always fails */
#define FAKE_PRIMITIVE(name) \
STk_define_variable(STk_intern(name), &STk_o_threadno, STk_STklos_module)
#endif /* ! _STK_THREAD_H */
/*
* thread.c -- Threads support in STklos
* thread-pthread.c -- Threads support in STklos
*
* Copyright 2006 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
*
......@@ -21,14 +21,14 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 23-Jan-2006 12:14 (eg)
* Last file update: 15-Apr-2006 13:06 (eg)
* Last file update: 16-Apr-2006 13:11 (eg)
*/
#include <unistd.h>
#include "stklos.h"
#include "vm.h"