1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

Since support for "futures" in C has been completely disabled for some

time, and should be easily implementable in Scheme with the current
thread support, delete the C code.

* libguile/futures.c, libguile/futures.h: Delete.
* libguile/Makefile.am (libguile_la_SOURCES, DOT_X_FILES,
  DOT_DOC_FILES, modinclude_HEADERS): Delete references to futures.*
  files.

* libguile.h: Don't include futures.h.
* libguile/eval.c: Don't include futures.h.
  (isymnames): Delete "#@future" entry.
  (scm_m_future, s_future, scm_sym_future, unmemoize_future,
  unmemoize_builtin_macro): Delete disabled futures code.
* libguile/eval.i.c (CEVAL): Delete disabled futures code.
* libguile/init.c: Don't include futures.h.
  (scm_i_init_guile): Delete disabled futures initialization call.
* libguile/tags.h (SCM_IM_FUTURE): Delete.
  (SCM_IM_CALL_WITH_VALUES, SCM_IM_ELSE, SCM_IM_ARROW,
  SCM_IM_NIL_COND, SCM_IM_BIND): Renumber.

* doc/ref/api-scheduling.texi: Delete commented-out node on Futures.
* doc/maint/guile.texi: Delete make-future and future-ref mentions.
This commit is contained in:
Ken Raeburn 2009-10-29 17:22:17 -04:00
parent 7ed7e4bb2f
commit 9515ef7237
10 changed files with 6 additions and 582 deletions

View file

@ -1750,22 +1750,6 @@ current interfaces. If a file cannot be opened with the access
requested, @code{open-file} throws an exception.
@end deffn
make-future
@c snarfed from futures.c:89
@deffn {Scheme Procedure} make-future thunk
@deffnx {C Function} scm_make_future (thunk)
Make a future evaluating THUNK.
@end deffn
future-ref
@c snarfed from futures.c:221
@deffn {Scheme Procedure} future-ref future
@deffnx {C Function} scm_future_ref (future)
If the future @var{x} has not been computed yet, compute and
return @var{x}, otherwise just return the previously computed
value.
@end deffn
gc-live-object-stats
@c snarfed from gc.c:276
@deffn {Scheme Procedure} gc-live-object-stats

View file

@ -792,39 +792,6 @@ Like @code{scm_with_dynamic_state}, but call @var{func} with
@var{data}.
@end deftypefn
@c @node Futures
@c @subsection Futures
@c @cindex futures
@c -- Futures are disabled for the time being, see futures.h for an
@c -- explanation.
@c Futures are a convenient way to run a calculation in a new thread, and
@c only wait for the result when it's actually needed.
@c Futures are similar to promises (@pxref{Delayed Evaluation}), in that
@c they allow mainline code to continue immediately. But @code{delay}
@c doesn't evaluate at all until forced, whereas @code{future} starts
@c immediately in a new thread.
@c @deffn {syntax} future expr
@c Begin evaluating @var{expr} in a new thread, and return a ``future''
@c object representing the calculation.
@c @end deffn
@c @deffn {Scheme Procedure} make-future thunk
@c @deffnx {C Function} scm_make_future (thunk)
@c Begin evaluating the call @code{(@var{thunk})} in a new thread, and
@c return a ``future'' object representing the calculation.
@c @end deffn
@c @deffn {Scheme Procedure} future-ref f
@c @deffnx {C Function} scm_future_ref (f)
@c Return the value computed by the future @var{f}. If @var{f} has not
@c yet finished executing then wait for it to do so.
@c @end deffn
@node Parallel Forms
@subsection Parallel forms
@cindex parallel forms

View file

@ -51,7 +51,6 @@ extern "C" {
#include "libguile/filesys.h"
#include "libguile/fluids.h"
#include "libguile/fports.h"
#include "libguile/futures.h"
#include "libguile/gc.h"
#include "libguile/gdbint.h"
#include "libguile/generalized-arrays.h"

View file

@ -131,7 +131,6 @@ libguile_la_SOURCES = \
fluids.c \
fports.c \
frames.c \
futures.c \
gc-malloc.c \
gc.c \
gdbint.c \
@ -230,7 +229,6 @@ DOT_X_FILES = \
feature.x \
fluids.x \
fports.x \
futures.x \
gc-malloc.x \
gc.x \
gettext.x \
@ -327,7 +325,6 @@ DOT_DOC_FILES = \
feature.doc \
fluids.doc \
fports.doc \
futures.doc \
gc-malloc.doc \
gc.doc \
gettext.doc \
@ -483,7 +480,6 @@ modinclude_HEADERS = \
fluids.h \
fports.h \
frames.h \
futures.h \
gc.h \
gdb_interface.h \
gdbint.h \

View file

@ -41,7 +41,6 @@
#include "libguile/eq.h"
#include "libguile/feature.h"
#include "libguile/fluids.h"
#include "libguile/futures.h"
#include "libguile/goops.h"
#include "libguile/hash.h"
#include "libguile/hashtab.h"
@ -409,7 +408,6 @@ static const char *const isymnames[] =
"#@slot-ref",
"#@slot-set!",
"#@delay",
"#@future",
"#@call-with-values",
"#@else",
"#@arrow",
@ -784,9 +782,6 @@ static SCM scm_m_do (SCM xorig, SCM env);
static SCM scm_m_quasiquote (SCM xorig, SCM env);
static SCM scm_m_delay (SCM xorig, SCM env);
static SCM scm_m_generalized_set_x (SCM xorig, SCM env);
#if 0 /* Futures are disabled, see "futures.h". */
static SCM scm_m_future (SCM xorig, SCM env);
#endif
static SCM scm_m_define (SCM x, SCM env);
static SCM scm_m_letrec (SCM xorig, SCM env);
static SCM scm_m_let (SCM xorig, SCM env);
@ -2196,36 +2191,6 @@ scm_m_eval_when (SCM expr, SCM env SCM_UNUSED)
return scm_list_1 (SCM_IM_BEGIN);
}
#if 0
/* See futures.h for a comment why futures are not enabled.
*/
SCM_SYNTAX (s_future, "future", scm_i_makbimacro, scm_m_future);
SCM_GLOBAL_SYMBOL (scm_sym_future, s_future);
/* Like promises, futures are implemented as closures with an empty
* parameter list. Thus, (future <expression>) is transformed into
* (#@future '() <expression>), where the empty list represents the
* empty parameter list. This representation allows for easy creation
* of the closure during evaluation. */
static SCM
scm_m_future (SCM expr, SCM env)
{
const SCM new_expr = memoize_as_thunk_prototype (expr, env);
SCM_SETCAR (new_expr, SCM_IM_FUTURE);
return new_expr;
}
static SCM
unmemoize_future (const SCM expr, const SCM env)
{
const SCM thunk_expr = SCM_CADDR (expr);
return scm_list_2 (scm_sym_future, unmemoize_expression (thunk_expr, env));
}
#endif /* futures disabled. */
SCM_SYNTAX (s_gset_x, "set!", scm_i_makbimacro, scm_m_generalized_set_x);
SCM_SYMBOL (scm_sym_setter, "setter");
@ -2494,13 +2459,6 @@ unmemoize_builtin_macro (const SCM expr, const SCM env)
case (ISYMNUM (SCM_IM_CALL_WITH_VALUES)):
return unmemoize_at_call_with_values (expr, env);
#if 0
/* See futures.h for a comment why futures are not enabled.
*/
case (ISYMNUM (SCM_IM_FUTURE)):
return unmemoize_future (expr, env);
#endif
case (ISYMNUM (SCM_IM_SLOT_REF)):
return unmemoize_atslot_ref (expr, env);

View file

@ -734,13 +734,6 @@ dispatch:
case (ISYMNUM (SCM_IM_DELAY)):
RETURN (scm_make_promise (scm_closure (SCM_CDR (x), env)));
#if 0
/* See futures.h for a comment why futures are not enabled.
*/
case (ISYMNUM (SCM_IM_FUTURE)):
RETURN (scm_i_make_future (scm_closure (SCM_CDR (x), env)));
#endif
/* PLACEHOLDER for case (ISYMNUM (SCM_IM_DISPATCH)): The following
code (type_dispatch) is intended to be the tail of the case
clause for the internal macro SCM_IM_DISPATCH. Please don't

View file

@ -1,375 +0,0 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2006, 2008 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
* the License, or (at your option) any later version.
*
* This library 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
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
* 02110-1301 USA
*/
#if 0
/* This whole file is not being compiled. See futures.h for the
reason.
*/
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include "libguile/_scm.h"
#include "libguile/eval.h"
#include "libguile/ports.h"
#include "libguile/validate.h"
#include "libguile/stime.h"
#include "libguile/threads.h"
#include "libguile/futures.h"
#define LINK(list, obj) \
do { \
SCM_SET_FUTURE_NEXT (obj, list); \
list = obj; \
} while (0)
#define UNLINK(list, obj) \
do { \
obj = list; \
list = SCM_FUTURE_NEXT (list); \
} while (0)
scm_i_pthread_mutex_t future_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
static SCM futures = SCM_EOL;
static SCM young = SCM_EOL;
static SCM old = SCM_EOL;
static SCM undead = SCM_EOL;
static long last_switch;
#ifdef SCM_FUTURES_DEBUG
static int n_dead = 0;
static SCM
count (SCM ls)
{
int n = 0;
while (!scm_is_null (ls))
{
++n;
ls = SCM_FUTURE_NEXT (ls);
}
return scm_from_int (n);
}
extern SCM scm_future_cache_status (void);
SCM_DEFINE (scm_future_cache_status, "future-cache-status", 0, 0, 0,
(),
"Return a list containing number of futures, youngs, olds, undeads and deads.")
#define FUNC_NAME s_scm_future_cache_status
{
int nd = n_dead;
n_dead = 0;
return scm_list_5 (count (futures),
count (young),
count (old),
count (undead),
scm_from_int (nd));
}
#undef FUNC_NAME
#endif
SCM *scm_loc_sys_thread_handler;
SCM_DEFINE (scm_make_future, "make-future", 1, 0, 0,
(SCM thunk),
"Make a future evaluating THUNK.")
#define FUNC_NAME s_scm_make_future
{
SCM_VALIDATE_THUNK (1, thunk);
return scm_i_make_future (thunk);
}
#undef FUNC_NAME
static char *s_future = "future";
static void
cleanup (scm_t_future *future)
{
scm_i_pthread_mutex_destroy (&future->mutex);
scm_i_pthread_cond_destroy (&future->cond);
scm_gc_free (future, sizeof (*future), s_future);
#ifdef SCM_FUTURES_DEBUG
++n_dead;
#endif
}
static SCM
future_loop (scm_t_future *future)
{
scm_i_scm_pthread_mutex_lock (&future->mutex);
do {
if (future->status == SCM_FUTURE_SIGNAL_ME)
scm_i_pthread_cond_broadcast (&future->cond);
future->status = SCM_FUTURE_COMPUTING;
future->data = (SCM_CLOSUREP (future->data)
? scm_i_call_closure_0 (future->data)
: scm_call_0 (future->data));
scm_i_scm_pthread_cond_wait (&future->cond, &future->mutex);
} while (!future->die_p);
future->status = SCM_FUTURE_DEAD;
scm_i_pthread_mutex_unlock (&future->mutex);
return SCM_UNSPECIFIED;
}
static SCM
future_handler (scm_t_future *future, SCM key, SCM args)
{
future->status = SCM_FUTURE_DEAD;
scm_i_pthread_mutex_unlock (&future->mutex);
return scm_apply_1 (*scm_loc_sys_thread_handler, key, args);
}
static SCM
alloc_future (SCM thunk)
{
scm_t_future *f = scm_gc_malloc (sizeof (*f), s_future);
SCM future;
f->data = SCM_BOOL_F;
scm_i_pthread_mutex_init (&f->mutex, NULL);
scm_i_pthread_cond_init (&f->cond, NULL);
f->die_p = 0;
f->status = SCM_FUTURE_TASK_ASSIGNED;
scm_i_scm_pthread_mutex_lock (&future_admin_mutex);
SCM_NEWSMOB2 (future, scm_tc16_future, futures, f);
SCM_SET_FUTURE_DATA (future, thunk);
futures = future;
scm_i_pthread_mutex_unlock (&future_admin_mutex);
scm_spawn_thread ((scm_t_catch_body) future_loop,
SCM_FUTURE (future),
(scm_t_catch_handler) future_handler,
SCM_FUTURE (future));
return future;
}
static void
kill_future (SCM future)
{
SCM_FUTURE (future)->die_p = 1;
LINK (undead, future);
}
SCM
scm_i_make_future (SCM thunk)
{
SCM future;
scm_i_scm_pthread_mutex_lock (&future_admin_mutex);
while (1)
{
if (!scm_is_null (old))
UNLINK (old, future);
else if (!scm_is_null (young))
UNLINK (young, future);
else
{
scm_i_pthread_mutex_unlock (&future_admin_mutex);
return alloc_future (thunk);
}
if (scm_i_pthread_mutex_trylock (SCM_FUTURE_MUTEX (future)))
kill_future (future);
else if (!SCM_FUTURE_ALIVE_P (future))
{
scm_i_pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
cleanup (SCM_FUTURE (future));
}
else
break;
}
LINK (futures, future);
scm_i_pthread_mutex_unlock (&future_admin_mutex);
SCM_SET_FUTURE_DATA (future, thunk);
SCM_SET_FUTURE_STATUS (future, SCM_FUTURE_TASK_ASSIGNED);
scm_i_pthread_cond_signal (SCM_FUTURE_COND (future));
scm_i_pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
return future;
}
static int
future_print (SCM exp, SCM port, scm_print_state *pstate)
{
int writingp = SCM_WRITINGP (pstate);
scm_puts ("#<future ", port);
SCM_SET_WRITINGP (pstate, 1);
scm_iprin1 (SCM_FUTURE_DATA (exp), port, pstate);
SCM_SET_WRITINGP (pstate, writingp);
scm_putc ('>', port);
return !0;
}
SCM_DEFINE (scm_future_ref, "future-ref", 1, 0, 0,
(SCM future),
"If the future @var{x} has not been computed yet, compute and\n"
"return @var{x}, otherwise just return the previously computed\n"
"value.")
#define FUNC_NAME s_scm_future_ref
{
SCM res;
SCM_VALIDATE_FUTURE (1, future);
scm_i_scm_pthread_mutex_lock (SCM_FUTURE_MUTEX (future));
if (SCM_FUTURE_STATUS (future) != SCM_FUTURE_COMPUTING)
{
SCM_SET_FUTURE_STATUS (future, SCM_FUTURE_SIGNAL_ME);
scm_i_scm_pthread_cond_wait (SCM_FUTURE_COND (future),
SCM_FUTURE_MUTEX (future));
}
if (!SCM_FUTURE_ALIVE_P (future))
{
scm_i_pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
SCM_MISC_ERROR ("requesting result from failed future ~A",
scm_list_1 (future));
}
res = SCM_FUTURE_DATA (future);
scm_i_pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
return res;
}
#undef FUNC_NAME
static void
kill_futures (SCM victims)
{
while (!scm_is_null (victims))
{
SCM future;
UNLINK (victims, future);
kill_future (future);
scm_i_pthread_cond_signal (SCM_FUTURE_COND (future));
}
}
static void
cleanup_undead ()
{
SCM next = undead, *nextloc = &undead;
while (!scm_is_null (next))
{
if (scm_i_pthread_mutex_trylock (SCM_FUTURE_MUTEX (next)))
goto next;
else if (SCM_FUTURE_ALIVE_P (next))
{
scm_i_pthread_cond_signal (SCM_FUTURE_COND (next));
scm_i_pthread_mutex_unlock (SCM_FUTURE_MUTEX (next));
next:
SCM_SET_GC_MARK (next);
nextloc = SCM_FUTURE_NEXTLOC (next);
next = *nextloc;
}
else
{
SCM future;
UNLINK (next, future);
scm_i_pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
cleanup (SCM_FUTURE (future));
*nextloc = next;
}
}
}
static void
mark_futures (SCM futures)
{
while (!scm_is_null (futures))
{
SCM_SET_GC_MARK (futures);
futures = SCM_FUTURE_NEXT (futures);
}
}
static void *
scan_futures (void *dummy1, void *dummy2, void *dummy3)
{
SCM next, *nextloc;
long now = scm_c_get_internal_run_time ();
if (now - last_switch > SCM_TIME_UNITS_PER_SECOND)
{
/* switch out old (> 1 sec), unused futures */
kill_futures (old);
old = young;
young = SCM_EOL;
last_switch = now;
}
else
mark_futures (young);
next = futures;
nextloc = &futures;
while (!scm_is_null (next))
{
if (!SCM_GC_MARK_P (next))
goto free;
keep:
nextloc = SCM_FUTURE_NEXTLOC (next);
next = *nextloc;
}
goto exit;
while (!scm_is_null (next))
{
if (SCM_GC_MARK_P (next))
{
*nextloc = next;
goto keep;
}
free:
{
SCM future;
UNLINK (next, future);
SCM_SET_GC_MARK (future);
LINK (young, future);
}
}
*nextloc = SCM_EOL;
exit:
cleanup_undead ();
mark_futures (old);
return 0;
}
scm_t_bits scm_tc16_future;
void
scm_init_futures ()
{
last_switch = scm_c_get_internal_run_time ();
scm_loc_sys_thread_handler
= SCM_VARIABLE_LOC (scm_c_define ("%thread-handler", SCM_BOOL_F));
scm_tc16_future = scm_make_smob_type ("future", 0);
scm_set_smob_print (scm_tc16_future, future_print);
scm_c_hook_add (&scm_before_sweep_c_hook, scan_futures, 0, 0);
#include "libguile/futures.x"
}
#endif
/*
Local Variables:
c-file-style: "gnu"
End:
*/

View file

@ -1,91 +0,0 @@
/* classes: h_files */
#ifndef SCM_FUTURES_H
#define SCM_FUTURES_H
/* Copyright (C) 2002, 2003, 2006, 2008 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
* the License, or (at your option) any later version.
*
* This library 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
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
* 02110-1301 USA
*/
#if 0
/* Futures have the following known bugs, which should be fixed before
including them in Guile:
- The implementation of the thread cache needs to be better so that
it behaves reasonable under heavy use.
- The dynamic state of a thread needs to be properly initialized
when it is retrieved from the cache.
*/
#include "libguile/__scm.h"
#include "libguile/threads.h"
typedef struct scm_t_future {
SCM data;
scm_i_pthread_mutex_t mutex;
scm_i_pthread_cond_t cond;
int status;
int die_p;
} scm_t_future;
#define SCM_FUTURE_DEAD 0
#define SCM_FUTURE_SIGNAL_ME -1
#define SCM_FUTURE_COMPUTING 1
#define SCM_FUTURE_TASK_ASSIGNED 2
#define SCM_VALIDATE_FUTURE(pos, obj) \
SCM_ASSERT_TYPE (SCM_TYP16_PREDICATE (scm_tc16_future, obj), \
obj, pos, FUNC_NAME, "future");
#define SCM_FUTURE(future) ((scm_t_future *) SCM_SMOB_DATA_2 (future))
#define SCM_FUTURE_MUTEX(future) (&SCM_FUTURE (future)->mutex)
#define SCM_FUTURE_COND(future) (&SCM_FUTURE (future)->cond)
#define SCM_FUTURE_STATUS(future) (SCM_FUTURE (future)->status)
#define SCM_SET_FUTURE_STATUS(future, x) \
do { SCM_FUTURE (future)->status = (x); } while (0)
#define SCM_FUTURE_ALIVE_P(future) (SCM_FUTURE_STATUS (future))
#define SCM_FUTURE_DATA(future) (SCM_FUTURE (future)->data)
#define SCM_SET_FUTURE_DATA(future, x) \
do { SCM_FUTURE (future)->data = (x); } while (0)
#define SCM_FUTURE_NEXT SCM_SMOB_OBJECT
#define SCM_FUTURE_NEXTLOC SCM_SMOB_OBJECT_LOC
#define SCM_SET_FUTURE_NEXT SCM_SET_SMOB_OBJECT
SCM_API scm_t_bits scm_tc16_future;
extern SCM *scm_loc_sys_thread_handler;
SCM_INTERNAL SCM scm_i_make_future (SCM thunk);
SCM_API SCM scm_make_future (SCM thunk);
SCM_API SCM scm_future_ref (SCM future);
void scm_init_futures (void);
#endif /* Futures are disabled for now. */
#endif /* SCM_FUTURES_H */
/*
Local Variables:
c-file-style: "gnu"
End:
*/

View file

@ -60,7 +60,6 @@
#include "libguile/filesys.h"
#include "libguile/fluids.h"
#include "libguile/fports.h"
#include "libguile/futures.h"
#include "libguile/gc.h"
#include "libguile/gdbint.h"
#include "libguile/generalized-arrays.h"
@ -479,11 +478,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_dynwind ();
scm_init_eq ();
scm_init_error ();
#if 0
/* See futures.h for a comment why futures are not enabled.
*/
scm_init_futures ();
#endif
scm_init_fluids ();
scm_init_feature (); /* Requires fluids */
scm_init_backtrace (); /* Requires fluids */

View file

@ -613,7 +613,7 @@ enum scm_tc8_tags
/* Evaluator byte codes ('immediate symbols'). These constants are used only
* in eval but their values have to be allocated here. The indices of the
* SCM_IM_ symbols must agree with the declarations in print.c:
* SCM_IM_ symbols must agree with the declarations in eval.c:
* scm_isymnames. */
#define SCM_ISYMP(n) (SCM_ITAG8 (n) == scm_tc8_isym)
@ -639,12 +639,11 @@ enum scm_tc8_tags
#define SCM_IM_SLOT_REF SCM_MAKISYM (17)
#define SCM_IM_SLOT_SET_X SCM_MAKISYM (18)
#define SCM_IM_DELAY SCM_MAKISYM (19)
#define SCM_IM_FUTURE SCM_MAKISYM (20)
#define SCM_IM_CALL_WITH_VALUES SCM_MAKISYM (21)
#define SCM_IM_ELSE SCM_MAKISYM (22)
#define SCM_IM_ARROW SCM_MAKISYM (23)
#define SCM_IM_NIL_COND SCM_MAKISYM (24) /* Multi-language support */
#define SCM_IM_BIND SCM_MAKISYM (25) /* Multi-language support */
#define SCM_IM_CALL_WITH_VALUES SCM_MAKISYM (20)
#define SCM_IM_ELSE SCM_MAKISYM (21)
#define SCM_IM_ARROW SCM_MAKISYM (22)
#define SCM_IM_NIL_COND SCM_MAKISYM (23) /* Multi-language support */
#define SCM_IM_BIND SCM_MAKISYM (24) /* Multi-language support */