diff options
-rw-r--r-- | libguile/ChangeLog | 33 | ||||
-rw-r--r-- | libguile/Makefile.am | 12 | ||||
-rw-r--r-- | libguile/eval.c | 78 | ||||
-rw-r--r-- | libguile/eval.h | 5 | ||||
-rw-r--r-- | libguile/init.c | 4 | ||||
-rw-r--r-- | libguile/stime.c | 34 | ||||
-rw-r--r-- | libguile/stime.h | 28 | ||||
-rw-r--r-- | libguile/threads.c | 64 | ||||
-rw-r--r-- | libguile/threads.h | 36 |
9 files changed, 166 insertions, 128 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 53db3c1cc..c1c982a8a 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,36 @@ +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 diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 49314a87d..c38872101 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -1,6 +1,6 @@ ## 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. ## @@ -63,7 +63,7 @@ guile_LDFLAGS = @DLPREOPEN@ 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 \ @@ -80,6 +80,7 @@ DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x \ 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 \ @@ -95,7 +96,8 @@ EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@ 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 \ @@ -147,8 +149,8 @@ modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.h boolean.h \ 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 \ diff --git a/libguile/eval.c b/libguile/eval.c index 521ef53fe..46c786579 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -1,4 +1,4 @@ -/* 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 @@ -80,6 +80,7 @@ char *alloca (); #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" @@ -3803,6 +3804,78 @@ ret: */ 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) { return SCM_SUBRF (proc) (arg1); @@ -3888,7 +3961,8 @@ scm_trampoline_1 (SCM proc) 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; diff --git a/libguile/eval.h b/libguile/eval.h index 8e2fbee84..f8e739abd 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -3,7 +3,7 @@ #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 @@ -145,6 +145,7 @@ SCM_API scm_t_bits scm_tc16_promise; #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); @@ -243,6 +244,8 @@ SCM_API SCM scm_apply_0 (SCM proc, SCM args); 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); diff --git a/libguile/init.c b/libguile/init.c index c9dec664b..cd98511e6 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -1,4 +1,4 @@ -/* 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 @@ -76,6 +76,7 @@ #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" @@ -482,6 +483,7 @@ scm_init_guile_1 (SCM_STACKITEM *base) scm_init_eq (); scm_init_error (); scm_init_fluids (); + scm_init_futures (); scm_init_backtrace (); /* Requires fluids */ scm_init_fports (); scm_init_strports (); diff --git a/libguile/stime.c b/libguile/stime.c index 0db4ab26d..12c5a1b46 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -1,4 +1,4 @@ -/* 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 @@ -66,19 +66,6 @@ #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 @@ -98,17 +85,6 @@ extern char *tzname[]; /* RS6000 and others reject char **tzname. */ 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 @@ -125,7 +101,7 @@ timet mytime() } #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 @@ -153,10 +129,10 @@ SCM_DEFINE (scm_get_internal_real_time, "get-internal-real-time", 0, 0, 0, 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 @@ -706,7 +682,7 @@ void 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); diff --git a/libguile/stime.h b/libguile/stime.h index db40e74c6..288c7ca50 100644 --- a/libguile/stime.h +++ b/libguile/stime.h @@ -3,7 +3,7 @@ #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 @@ -49,6 +49,32 @@ #include "libguile/__scm.h" + +# 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 + + 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); diff --git a/libguile/threads.c b/libguile/threads.c index ba4d2cbe9..6cb2ab2b5 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -495,63 +495,6 @@ SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0, } #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 @@ -1388,19 +1331,12 @@ scm_init_threads (SCM_STACKITEM *base) 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" } diff --git a/libguile/threads.h b/libguile/threads.h index 14c0bdefe..f6d34ea18 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -3,7 +3,7 @@ #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 @@ -83,20 +83,6 @@ SCM_API scm_t_bits scm_tc16_fair_condvar; 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); @@ -199,8 +185,6 @@ SCM_API unsigned long scm_thread_usleep (unsigned long); /* 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); @@ -235,12 +219,14 @@ do { \ 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); @@ -262,6 +248,12 @@ SCM_API SCM scm_thread_exited_p (SCM thread); 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; @@ -283,12 +275,6 @@ struct timespec }; #endif -#ifdef USE_PTHREAD_THREADS -#include "libguile/pthread-threads.h" -#else -#include "libguile/null-threads.h" -#endif - #endif /* SCM_THREADS_H */ /* |