#if defined(GBC_BOEHM)
ecl_def_string_array_elt("BOEHM-GC"),
#endif
+#ifdef ECL_LWP
+ ecl_def_string_array_elt("GREEN-THREADS"),
+#endif
#ifdef ECL_THREADS
ecl_def_string_array_elt("THREADS"),
#endif
{SYS_ "RESET-GC-COUNT", SI_ORDINARY, si_reset_gc_count, -1, OBJNULL},
#endif /* !GBC_BOEHM */
+#ifdef ECL_LWP
+{EXT_ "MAKE-THREAD", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "DEACTIVATE", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "REACTIVATE", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "KILL-THREAD", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "CURRENT-THREAD", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "THREAD-STATUS", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "THREAD-LIST", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "MAKE-CONTINUATION", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "THREAD-OF", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "CONTINUATION-OF", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "RESUME", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "%DISABLE-SCHEDULER", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "%ENABLE-SCHEDULER", EXT_ORDINARY, NULL, -1, OBJNULL},
+
+{EXT_ "LET/CC", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "PASS", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "SPAWN", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "WITHOUT-SCHEDULING", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "WAIT-IN", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "WAIT", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "WAIT-OR", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "*SCHEDULER-DISABLED-IN-ERROR*", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "*BREAK-LEVEL*", EXT_ORDINARY, NULL, -1, OBJNULL},
+#endif /* ECL_LWP */
+
/* #ifdef ECL_THREADS */
{MP_ "PROCESS", MP_ORDINARY, NULL, -1, OBJNULL},
{MP_ "LOCK", MP_ORDINARY, NULL, -1, OBJNULL},
{SYS_ "RESET-GC-COUNT","si_reset_gc_count"},
#endif /* !GBC_BOEHM */
+#ifdef ECL_LWP
+{EXT_ "MAKE-THREAD",NULL},
+{EXT_ "DEACTIVATE",NULL},
+{EXT_ "REACTIVATE",NULL},
+{EXT_ "KILL-THREAD",NULL},
+{EXT_ "CURRENT-THREAD",NULL},
+{EXT_ "THREAD-STATUS",NULL},
+{EXT_ "THREAD-LIST",NULL},
+{EXT_ "MAKE-CONTINUATION",NULL},
+{EXT_ "THREAD-OF",NULL},
+{EXT_ "CONTINUATION-OF",NULL},
+{EXT_ "RESUME",NULL},
+{EXT_ "%DISABLE-SCHEDULER",NULL},
+{EXT_ "%ENABLE-SCHEDULER",NULL},
+
+{EXT_ "LET/CC",NULL},
+{EXT_ "PASS",NULL},
+{EXT_ "SPAWN",NULL},
+{EXT_ "WITHOUT-SCHEDULING",NULL},
+{EXT_ "WAIT-IN",NULL},
+{EXT_ "WAIT",NULL},
+{EXT_ "WAIT-OR",NULL},
+{EXT_ "*SCHEDULER-DISABLED-IN-ERROR*",NULL},
+{EXT_ "*BREAK-LEVEL*",NULL},
+#endif /* ECL_LWP */
+
/* #ifdef ECL_THREADS */
{MP_ "PROCESS",NULL},
{MP_ "LOCK",NULL},
with_cross_config
enable_shared
enable_rpath
+enable_lwp
enable_threads
enable_boehm
enable_libatomic
--enable-shared enable loading compiled files (default=YES)
--enable-rpath hard-code the location of the ECL shared library.
(no|yes, default=NO)
+ --enable-lwp support for green threads (yes|no, default=no).
--enable-threads support for native threads (yes|no|auto,
default=auto).
--enable-boehm use the Boehm-Weiser garbage collector
fi
+# Check whether --enable-lwp was given.
+if test "${enable_lwp+set}" = set; then :
+ enableval=$enable_lwp;
+else
+ enable_lwp=no
+fi
+
+
# Check whether --enable-threads was given.
if test "${enable_threads+set}" = set; then :
enableval=$enable_threads;
fi
+if test "${enable_lwp}" = "yes"; then
+ EXTRA_OBJS="${EXTRA_OBJS} lwp.${OBJEXT}"
+
+$as_echo "#define ECL_LWP 1" >>confdefs.h
+
+fi
+
if test "${enable_threads}" = "auto"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for threads support" >&5
$as_echo_n "checking for threads support... " >&6; }
[(no|yes, default=NO)]),
[], [enable_rpath=yes] )
+AC_ARG_ENABLE(lwp,
+ AS_HELP_STRING( [--enable-lwp],
+ [support for green threads (yes|no, default=no).]),
+ [], [enable_lwp=no])
+
AC_ARG_ENABLE(threads,
AS_HELP_STRING( [--enable-threads],
[support for native threads (yes|no|auto, default=auto).]),
AC_SUBST(ECL_CMPDIR)
dnl ----------------------------------------------------------------------
+dnl Green thread support
+if test "${enable_lwp}" = "yes"; then
+ EXTRA_OBJS="${EXTRA_OBJS} lwp.${OBJEXT}"
+ AC_DEFINE([ECL_LWP], [1], [Green threads?])
+fi
+
+dnl ----------------------------------------------------------------------
dnl Native thread support
if test "${enable_threads}" = "auto"; then
AC_MSG_CHECKING([for threads support])
/* ECL_LOING_LONG_BITS */
#undef ECL_LONG_LONG_BITS
+/* Green threads? */
+#undef ECL_LWP
+
/* Define if your newline is CR */
#undef ECL_NEWLINE_IS_CR
#include "@ECL_GMP_HEADER@"
#endif
+/* Green threads? */
+#undef ECL_LWP
+
/* Userland threads? */
#undef ECL_THREADS
#ifdef ECL_THREADS
"src:lsp;format.lsp"
"src:lsp;defpackage.lsp"
"src:lsp;ffi.lsp"
+#+green-threads
+ "src:lsp;thread.lsp"
"src:lsp;mp.lsp"
#+tk
"src:lsp;tk-init.lsp"
--- /dev/null
+;;;; thread.lsp -- thread top level and utilities
+;;;;
+;;;; Copyright (c) 1990, Giuseppe Attardi.
+;;;; Copyright (c) 2015, Daniel Kochmański.
+;;;;
+;;;; This program is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Library General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2 of the License, or (at your option) any later version.
+;;;;
+;;;; See file '../Copyright' for full details.
+
+(in-package "EXT")
+
+;;; ----------------------------------------------------------------------
+;;; Utilities
+
+(defmacro spawn (function &rest args)
+ `(resume (make-continuation (make-thread ,function)) ,@ args))
+
+(defun pass (&rest args)
+ (%disable-scheduler)
+ (apply 'resume args)
+ (%suspend))
+
+(defmacro let/cc (cont body)
+ `(let ((,cont (make-continuation (current-thread))))
+ ,@body
+ (%suspend)))
+
+(defmacro without-scheduling (&rest body)
+ `(unwind-protect
+ (progn
+ (%disable-scheduler)
+ (progn ,@body))
+ (%enable-scheduler)))
+
+(defmacro wait-in (place)
+ `(progn
+ (setf ,place (make-continuation (current-thread)))
+ (%suspend)))
+
+(defun wait (&rest threads)
+ (labels ((wait-all-internal (threads)
+ (or (null threads)
+ (and (eq (thread-status (first threads)) 'DEAD)
+ (wait-all-internal (rest threads))))))
+ (funcall #'%thread-wait #'wait-all-internal threads)))
+
+(defun wait-some (&rest threads)
+ (labels ((wait-some-internal (threads)
+ (or (null threads)
+ (eq (thread-status (first threads)) 'DEAD)
+ (wait-some-internal (rest threads)))))
+ (funcall #'%thread-wait #'wait-some-internal threads)))
+
+;;; ----------------------------------------------------------------------
+;;; Examples
+#|
+(defvar *producer* (make-thread 'producer))
+(defvar *consumer* (make-thread 'consumer))
+
+(defun producer ()
+ (dotimes (i 20)
+ (print 'producer)
+ ;; produce
+ (resume (make-continuation *consumer*) i)
+ (%suspend)))
+
+(defun consumer ()
+ (let (i)
+ (loop
+ (print 'consumer)
+ (resume (make-continuation *producer*))
+ (setq i (%suspend))
+ ;; consume
+ (print i))))
+
+(resume (make-continuation *producer*))
+|#
Repositories / ecl.git / commitdiff