* Makefile.am (libguile_la_SOURCES): Added futures.c.
(DOT_X_FILES): Added futures.x.
(DOT_DOC_FILES): Added futures.doc.
(modinclude_HEADERS): Added futures.h.
* threads.c, threads.h (scm_i_create_thread): Renamed from
create_thread and made global.
* eval.c: #include "libguile/futures.h".
* init.c: #include "futures.h"
(scm_init_guile_1): Call scm_init_futures.
* stime.c (SCM_TIME_UNITS_PER_SECOND): Renamed from CLKTCK.
* stime.h (SCM_TIME_UNITS_PER_SECOND): Definition moved here.
* eval.c, eval.h (scm_trampoline_0, scm_i_call_closure_0): New
functions.
* eval.c (scm_trampoline_1): Fixed arguments test for closures.
+2003-01-23 Mikael Djurfeldt <djurfeldt@nada.kth.se>
+
+ * futures.h, futures.c: New files; Introduced recycling of
+ futures. For fine-grained threading this lifts performance to
+ another level. We can now use parallelization in inner loops of
+ Guile programs without impossible overhead.
+
+ * threads.h, threads.c: Moved futures to their own file.
+
+ * Makefile.am (libguile_la_SOURCES): Added futures.c.
+ (DOT_X_FILES): Added futures.x.
+ (DOT_DOC_FILES): Added futures.doc.
+ (modinclude_HEADERS): Added futures.h.
+
+ * threads.c, threads.h (scm_i_create_thread): Renamed from
+ create_thread and made global.
+
+ * futures.c (scm_make_future): New procedure.
+
+ * eval.c: #include "libguile/futures.h".
+
+ * init.c: #include "futures.h"
+ (scm_init_guile_1): Call scm_init_futures.
+
+ * stime.c (SCM_TIME_UNITS_PER_SECOND): Renamed from CLKTCK.
+
+ * stime.h (SCM_TIME_UNITS_PER_SECOND): Definition moved here.
+
+ * eval.c, eval.h (scm_trampoline_0, scm_i_call_closure_0): New
+ functions.
+
+ * eval.c (scm_trampoline_1): Fixed arguments test for closures.
+
2003-01-22 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* threads.c (create_thread): Don't unwind dynwind chain of parent
## Process this file with Automake to create Makefile.in
##
-## Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \
chars.c continuations.c convert.c debug.c deprecation.c \
dynwind.c environments.c eq.c error.c eval.c evalext.c extensions.c \
- feature.c fluids.c fports.c \
+ feature.c fluids.c fports.c futures.c \
gc.c gc-mark.c gc-segment.c gc-malloc.c gc-card.c gc-freelist.c \
gc_os_dep.c gdbint.c gh_data.c gh_eval.c gh_funcs.c gh_init.c \
gh_io.c gh_list.c gh_predicates.c goops.c gsubr.c guardians.c hash.c \
continuations.x debug.x deprecation.x dynl.x dynwind.x \
environments.x eq.x \
error.x eval.x evalext.x extensions.x feature.x fluids.x fports.x \
+ futures.x \
gc.x gc-mark.x gc-segment.x gc-malloc.x gc-card.x goops.x \
gsubr.x guardians.x hash.x hashtab.x hooks.x init.x ioext.x iselect.x \
keywords.x lang.x list.x load.x macros.x mallocs.x modules.x \
DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc \
boolean.doc chars.doc continuations.doc debug.doc dynl.doc \
dynwind.doc environments.doc eq.doc error.doc eval.doc evalext.doc \
- extensions.doc feature.doc fluids.doc fports.doc gc.doc goops.doc \
+ extensions.doc feature.doc fluids.doc fports.doc futures.doc \
+ gc.doc goops.doc \
gsubr.doc gc-mark.doc gc-segment.doc gc-malloc.doc gc-card.doc \
guardians.doc hash.doc hashtab.doc hooks.doc init.doc ioext.doc \
iselect.doc keywords.doc lang.doc list.doc load.doc macros.doc \
chars.h continuations.h convert.h debug.h \
debug-malloc.h threads-plugin.h null-threads.h pthread-threads.h \
deprecation.h dynl.h dynwind.h environments.h eq.h error.h eval.h \
- evalext.h extensions.h feature.h filesys.h fluids.h fports.h gc.h \
- gdb_interface.h gdbint.h \
+ evalext.h extensions.h feature.h filesys.h fluids.h fports.h futures.h \
+ gc.h gdb_interface.h gdbint.h \
goops.h gsubr.h guardians.h hash.h hashtab.h hooks.h init.h \
inline.h ioext.h \
iselect.h keywords.h lang.h list.h load.h macros.h mallocs.h modules.h \
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002, 2003 Free Software Foundation, Inc.
*
* 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
#include "libguile/alist.h"
#include "libguile/eq.h"
#include "libguile/continuations.h"
+#include "libguile/futures.h"
#include "libguile/throw.h"
#include "libguile/smob.h"
#include "libguile/macros.h"
* before.
*/
+static SCM
+call_subr0_0 (SCM proc)
+{
+ return SCM_SUBRF (proc) ();
+}
+
+static SCM
+call_subr1o_0 (SCM proc)
+{
+ return SCM_SUBRF (proc) (SCM_UNDEFINED);
+}
+
+static SCM
+call_lsubr_0 (SCM proc)
+{
+ return SCM_SUBRF (proc) (SCM_EOL);
+}
+
+SCM
+scm_i_call_closure_0 (SCM proc)
+{
+ return scm_eval_body (SCM_CLOSURE_BODY (proc),
+ SCM_EXTEND_ENV (SCM_CLOSURE_FORMALS (proc),
+ SCM_EOL,
+ SCM_ENV (proc)));
+}
+
+scm_t_trampoline_0
+scm_trampoline_0 (SCM proc)
+{
+ if (SCM_IMP (proc))
+ return 0;
+ if (SCM_DEBUGGINGP)
+ return scm_call_0;
+ switch (SCM_TYP7 (proc))
+ {
+ case scm_tc7_subr_0:
+ return call_subr0_0;
+ case scm_tc7_subr_1o:
+ return call_subr1o_0;
+ case scm_tc7_lsubr:
+ return call_lsubr_0;
+ case scm_tcs_closures:
+ {
+ SCM formals = SCM_CLOSURE_FORMALS (proc);
+ if (SCM_NULLP (formals) || SCM_SYMBOLP (formals))
+ return scm_i_call_closure_0;
+ else
+ return 0;
+ }
+ case scm_tcs_struct:
+ if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
+ return scm_call_generic_0;
+ else if (!SCM_I_OPERATORP (proc))
+ return 0;
+ return scm_call_0;
+ case scm_tc7_smob:
+ if (SCM_SMOB_APPLICABLE_P (proc))
+ return SCM_SMOB_DESCRIPTOR (proc).apply_0;
+ else
+ return 0;
+ /* fall through */
+ case scm_tc7_asubr:
+ case scm_tc7_rpsubr:
+ case scm_tc7_cclo:
+ case scm_tc7_pws:
+ return scm_call_0;
+ default:
+ return 0; /* not applicable on one arg */
+ }
+}
+
static SCM
call_subr1_1 (SCM proc, SCM arg1)
{
case scm_tcs_closures:
{
SCM formals = SCM_CLOSURE_FORMALS (proc);
- if (!SCM_CONSP (formals) || SCM_NULLP (SCM_CDR (formals)))
+ if ((SCM_CONSP (formals) && SCM_NULLP (SCM_CDR (formals)))
+ || SCM_SYMBOLP (formals))
return call_closure_1;
else
return 0;
#ifndef SCM_EVAL_H
#define SCM_EVAL_H
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003 Free Software Foundation, Inc.
*
* 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
#define SCM_XEVALCAR(x, env) EVALCAR (x, env)
#endif /* DEBUG_EXTENSIONS */
+typedef SCM (*scm_t_trampoline_0) (SCM proc);
typedef SCM (*scm_t_trampoline_1) (SCM proc, SCM arg1);
typedef SCM (*scm_t_trampoline_2) (SCM proc, SCM arg1, SCM arg2);
SCM_API SCM scm_apply_1 (SCM proc, SCM arg1, SCM args);
SCM_API SCM scm_apply_2 (SCM proc, SCM arg1, SCM arg2, SCM args);
SCM_API SCM scm_apply_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM args);
+SCM_API SCM scm_i_call_closure_0 (SCM proc);
+SCM_API scm_t_trampoline_0 scm_trampoline_0 (SCM proc);
SCM_API scm_t_trampoline_1 scm_trampoline_1 (SCM proc);
SCM_API scm_t_trampoline_2 scm_trampoline_2 (SCM proc);
SCM_API SCM scm_nconc2last (SCM lst);
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003 Free Software Foundation, Inc.
*
* 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
#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/goops.h"
scm_init_eq ();
scm_init_error ();
scm_init_fluids ();
+ scm_init_futures ();
scm_init_backtrace (); /* Requires fluids */
scm_init_fports ();
scm_init_strports ();
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003 Free Software Foundation, Inc.
*
* 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
#include <string.h>
#endif
-# ifdef TIME_WITH_SYS_TIME
-# include <sys/time.h>
-# include <time.h>
-# else
-# ifdef HAVE_SYS_TIME_H
-# include <sys/time.h>
-# else
-# ifdef HAVE_TIME_H
-# include <time.h>
-# endif
-# endif
-# endif
-
#ifdef HAVE_SYS_TIMES_H
# include <sys/times.h>
#endif
extern char *strptime ();
#endif
-/* This should be figured out by autoconf. */
-#if ! defined(CLKTCK) && defined(CLK_TCK)
-# define CLKTCK ((int) CLK_TCK)
-#endif
-#if ! defined(CLKTCK) && defined(CLOCKS_PER_SEC)
-# define CLKTCK ((int) CLOCKS_PER_SEC)
-#endif
-#if ! defined(CLKTCK)
-# define CLKTCK 60
-#endif
-
#ifdef __STDC__
# define timet time_t
#else
}
#else
# ifdef LACK_CLOCK
-# define mytime() ((time((timet*)0) - scm_your_base) * CLKTCK)
+# define mytime() ((time((timet*)0) - scm_your_base) * SCM_TIME_UNITS_PER_SECOND)
# else
# define mytime clock
# endif
tmp = scm_sum (tmp,
scm_product (SCM_MAKINUM (1000),
SCM_MAKINUM (time_buffer.time)));
- return scm_quotient (scm_product (tmp, SCM_MAKINUM (CLKTCK)),
+ return scm_quotient (scm_product (tmp, SCM_MAKINUM (SCM_TIME_UNITS_PER_SECOND)),
SCM_MAKINUM (1000));
#else
- return scm_long2num((time((timet*)0) - scm_your_base) * (int)CLKTCK);
+ return scm_long2num((time((timet*)0) - scm_your_base) * (int)SCM_TIME_UNITS_PER_SECOND);
#endif /* HAVE_FTIME */
}
#undef FUNC_NAME
scm_init_stime()
{
scm_c_define ("internal-time-units-per-second",
- scm_long2num((long)CLKTCK));
+ scm_long2num((long) SCM_TIME_UNITS_PER_SECOND));
#ifdef HAVE_FTIME
if (!scm_your_base.time) ftime(&scm_your_base);
#ifndef SCM_STIME_H
#define SCM_STIME_H
-/* Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000, 2003 Free Software Foundation, Inc.
*
* 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
#include "libguile/__scm.h"
\f
+
+# ifdef TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+# else
+# ifdef HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# ifdef HAVE_TIME_H
+# include <time.h>
+# endif
+# endif
+# endif
+
+/* This should be figured out by autoconf. */
+#if ! defined(SCM_TIME_UNITS_PER_SECOND) && defined(CLK_TCK)
+# define SCM_TIME_UNITS_PER_SECOND ((int) CLK_TCK)
+#endif
+#if ! defined(SCM_TIME_UNITS_PER_SECOND) && defined(CLOCKS_PER_SEC)
+# define SCM_TIME_UNITS_PER_SECOND ((int) CLOCKS_PER_SEC)
+#endif
+#if ! defined(SCM_TIME_UNITS_PER_SECOND)
+# define SCM_TIME_UNITS_PER_SECOND 60
+#endif
+
+\f
SCM_API long scm_c_get_internal_run_time (void);
SCM_API SCM scm_get_internal_real_time (void);
SCM_API SCM scm_get_internal_run_time (void);
}
#undef FUNC_NAME
-SCM *scm_loc_sys_thread_handler;
-
-SCM
-scm_i_make_future (SCM thunk)
-{
- SCM_RETURN_NEWSMOB2 (scm_tc16_future,
- create_thread ((scm_t_catch_body) scm_call_0,
- thunk,
- (scm_t_catch_handler) scm_apply_1,
- *scm_loc_sys_thread_handler,
- scm_cons (thunk,
- *scm_loc_sys_thread_handler)),
- scm_make_rec_mutex ());
-}
-
-static size_t
-future_free (SCM future)
-{
- scm_rec_mutex_free (SCM_FUTURE_MUTEX (future));
- return 0;
-}
-
-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_VALIDATE_FUTURE (1, future);
- scm_rec_mutex_lock (SCM_FUTURE_MUTEX (future));
- if (!SCM_FUTURE_COMPUTED_P (future))
- {
- SCM value = scm_join_thread (SCM_FUTURE_DATA (future));
- if (!SCM_FUTURE_COMPUTED_P (future))
- {
- SCM_SET_FUTURE_DATA (future, value);
- SCM_SET_FUTURE_COMPUTED (future);
- }
- }
- scm_rec_mutex_unlock (SCM_FUTURE_MUTEX (future));
- return SCM_FUTURE_DATA (future);
-}
-#undef FUNC_NAME
-
/*** Fair mutexes */
/* We implement our own mutex type since we want them to be 'fair', we
scm_set_smob_mark (scm_tc16_fair_condvar, fair_cond_mark);
- scm_tc16_future = scm_make_smob_type ("future", 0);
- scm_set_smob_mark (scm_tc16_future, scm_markcdr);
- scm_set_smob_free (scm_tc16_future, future_free);
- scm_set_smob_print (scm_tc16_future, future_print);
-
threads_initialized_p = 1;
}
void
scm_init_thread_procs ()
{
- scm_loc_sys_thread_handler
- = SCM_VARIABLE_LOC (scm_c_define ("%thread-handler", SCM_BOOL_F));
#include "libguile/threads.x"
}
#ifndef SCM_THREADS_H
#define SCM_THREADS_H
-/* Copyright (C) 1996,1997,1998,2000,2001, 2002 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003 Free Software Foundation, Inc.
*
* 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
SCM_ASSERT_TYPE (SCM_CONDVARP (a) || SCM_FAIR_CONDVAR_P (a), \
a, pos, FUNC_NAME, "condition variable");
-#define SCM_VALIDATE_FUTURE(pos, obj) \
- SCM_ASSERT_TYPE (SCM_TYP16_PREDICATE (scm_tc16_future, obj), \
- obj, pos, FUNC_NAME, "future");
-#define SCM_F_FUTURE_COMPUTED (1L << 16)
-#define SCM_FUTURE_COMPUTED_P(future) \
- (SCM_F_FUTURE_COMPUTED & SCM_CELL_WORD_0 (future))
-#define SCM_SET_FUTURE_COMPUTED(future) \
- SCM_SET_CELL_WORD_0 (future, scm_tc16_future | SCM_F_FUTURE_COMPUTED)
-#define SCM_FUTURE_MUTEX(future) \
- ((scm_t_rec_mutex *) SCM_CELL_WORD_2 (future))
-#define SCM_FUTURE_DATA SCM_CELL_OBJECT_1
-#define SCM_SET_FUTURE_DATA SCM_SET_CELL_OBJECT_1
-SCM_API scm_t_bits scm_tc16_future;
-
SCM_API void scm_threads_mark_stacks (void);
SCM_API void scm_init_threads (SCM_STACKITEM *);
SCM_API void scm_init_thread_procs (void);
/* End of low-level C API */
/*----------------------------------------------------------------------*/
-extern SCM *scm_loc_sys_thread_handler;
-
typedef struct scm_thread scm_thread;
SCM_API void scm_i_enter_guile (scm_thread *t);
scm_i_thread_sleep_for_gc (); \
} while (0)
+SCM scm_i_create_thread (scm_t_catch_body body, void *body_data,
+ scm_t_catch_handler handler, void *handler_data,
+ SCM protects);
+
/* The C versions of the Scheme-visible thread functions. */
SCM_API SCM scm_call_with_new_thread (SCM thunk, SCM handler);
SCM_API SCM scm_yield (void);
SCM_API SCM scm_join_thread (SCM t);
-SCM_API SCM scm_i_make_future (SCM thunk);
-SCM_API SCM scm_future_ref (SCM future);
SCM_API SCM scm_make_mutex (void);
SCM_API SCM scm_make_fair_mutex (void);
SCM_API SCM scm_lock_mutex (SCM m);
SCM_API scm_root_state *scm_i_thread_root (SCM thread);
+#ifdef USE_PTHREAD_THREADS
+#include "libguile/pthread-threads.h"
+#else
+#include "libguile/null-threads.h"
+#endif
+
#define SCM_CURRENT_THREAD \
((scm_thread *) scm_i_plugin_getspecific (scm_i_thread_key))
extern scm_t_key scm_i_thread_key;
};
#endif
-#ifdef USE_PTHREAD_THREADS
-#include "libguile/pthread-threads.h"
-#else
-#include "libguile/null-threads.h"
-#endif
-
#endif /* SCM_THREADS_H */
/*
HCoop / bpt / guile.git / commitdiff