From 6b468ba449cbd2db62f62e4b6f8bb584b4dff96e Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Thu, 23 Jan 2003 16:13:13 +0000 Subject: [PATCH] * 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. --- libguile/futures.c | 387 +++++++++++++++++++++++++++++++++++++++++++++ libguile/futures.h | 100 ++++++++++++ 2 files changed, 487 insertions(+) create mode 100644 libguile/futures.c create mode 100644 libguile/futures.h diff --git a/libguile/futures.c b/libguile/futures.c new file mode 100644 index 000000000..fefd93121 --- /dev/null +++ b/libguile/futures.c @@ -0,0 +1,387 @@ +/* Copyright (C) 1995,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 + * the Free Software Foundation; either version 2, 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 software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + + + + +#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_MUTEX (future_admin_mutex); + +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_NULLP (ls)) + { + ++n; + ls = SCM_FUTURE_NEXT (ls); + } + return SCM_MAKINUM (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_MAKINUM (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_mutex_destroy (&future->mutex); + scm_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_mutex_lock (&future->mutex); + do { + if (future->status == SCM_FUTURE_SIGNAL_ME) + scm_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_cond_wait (&future->cond, &future->mutex); + } while (!future->die_p); + future->status = SCM_FUTURE_DEAD; + scm_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_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_mutex_init (&f->mutex, &scm_i_plugin_mutex); + scm_cond_init (&f->cond, 0); + f->die_p = 0; + f->status = SCM_FUTURE_TASK_ASSIGNED; + scm_mutex_lock (&future_admin_mutex); + SCM_NEWSMOB2 (future, scm_tc16_future, futures, f); + SCM_SET_FUTURE_DATA (future, thunk); + futures = future; + scm_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_mutex_lock (&future_admin_mutex); + while (1) + { + if (!SCM_NULLP (old)) + UNLINK (old, future); + else if (!SCM_NULLP (young)) + UNLINK (young, future); + else + { + scm_mutex_unlock (&future_admin_mutex); + return alloc_future (thunk); + } + if (scm_mutex_trylock (SCM_FUTURE_MUTEX (future))) + kill_future (future); + else if (!SCM_FUTURE_ALIVE_P (future)) + { + scm_mutex_unlock (SCM_FUTURE_MUTEX (future)); + cleanup (SCM_FUTURE (future)); + } + else + break; + } + LINK (futures, future); + scm_mutex_unlock (&future_admin_mutex); + SCM_SET_FUTURE_DATA (future, thunk); + SCM_SET_FUTURE_STATUS (future, SCM_FUTURE_TASK_ASSIGNED); + scm_cond_signal (SCM_FUTURE_COND (future)); + scm_mutex_unlock (SCM_FUTURE_MUTEX (future)); + return future; +} + +static SCM +future_mark (SCM ptr) { + return SCM_FUTURE_DATA (ptr); +} + +static int +future_print (SCM exp, SCM port, scm_print_state *pstate) +{ + int writingp = SCM_WRITINGP (pstate); + scm_puts ("#', 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_mutex_lock (SCM_FUTURE_MUTEX (future)); + if (SCM_FUTURE_STATUS (future) != SCM_FUTURE_COMPUTING) + { + SCM_SET_FUTURE_STATUS (future, SCM_FUTURE_SIGNAL_ME); + scm_cond_wait (SCM_FUTURE_COND (future), SCM_FUTURE_MUTEX (future)); + } + if (!SCM_FUTURE_ALIVE_P (future)) + { + scm_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_mutex_unlock (SCM_FUTURE_MUTEX (future)); + return res; +} +#undef FUNC_NAME + +static void +kill_futures (SCM victims) +{ + while (!SCM_NULLP (victims)) + { + SCM future; + UNLINK (victims, future); + kill_future (future); + scm_cond_signal (SCM_FUTURE_COND (future)); + } +} + +static void +cleanup_undead () +{ + SCM next = undead, *nextloc = &undead; + while (!SCM_NULLP (next)) + { + if (scm_mutex_trylock (SCM_FUTURE_MUTEX (next))) + goto next; + else if (SCM_FUTURE_ALIVE_P (next)) + { + scm_cond_signal (SCM_FUTURE_COND (next)); + scm_mutex_unlock (SCM_FUTURE_MUTEX (next)); + next: + nextloc = SCM_FUTURE_NEXTLOC (next); + next = *nextloc; + } + else + { + SCM future; + UNLINK (next, future); + scm_mutex_unlock (SCM_FUTURE_MUTEX (future)); + cleanup (SCM_FUTURE (future)); + *nextloc = next; + } + } +} + +static void +mark_futures (SCM futures) +{ + while (!SCM_NULLP (futures)) + { + scm_gc_mark (SCM_FUTURE_DATA (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; + } + + next = futures; + nextloc = &futures; + while (!SCM_NULLP (next)) + { + if (!SCM_GC_MARK_P (next)) + goto free; + keep: + nextloc = SCM_FUTURE_NEXTLOC (next); + next = *nextloc; + } + goto exit; + while (!SCM_NULLP (next)) + { + if (SCM_GC_MARK_P (next)) + { + *nextloc = next; + goto keep; + } + free: + { + SCM future; + UNLINK (next, future); + LINK (young, future); + } + } + *nextloc = SCM_EOL; + exit: + cleanup_undead (); + mark_futures (young); + mark_futures (old); + mark_futures (undead); + return 0; +} + +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_mark (scm_tc16_future, future_mark); + 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" +} + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ diff --git a/libguile/futures.h b/libguile/futures.h new file mode 100644 index 000000000..b5109ddb1 --- /dev/null +++ b/libguile/futures.h @@ -0,0 +1,100 @@ +/* classes: h_files */ + +#ifndef SCM_FUTURES_H +#define SCM_FUTURES_H + +/* Copyright (C) 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 + * the Free Software Foundation; either version 2, 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 software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + + + +#include "libguile/__scm.h" +#include "libguile/threads.h" + + + +typedef struct scm_t_future { + SCM data; + scm_t_mutex mutex; + scm_t_cond 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_CELL_WORD_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_CELL_OBJECT_1 +#define SCM_FUTURE_NEXTLOC(x) ((SCM *) SCM_CELL_WORD_LOC ((x), 1)) +#define SCM_SET_FUTURE_NEXT SCM_SET_CELL_OBJECT_1 + +SCM_API scm_t_bits scm_tc16_future; + +extern SCM *scm_loc_sys_thread_handler; + +SCM_API 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 /* SCM_FUTURES_H */ + +/* + Local Variables: + c-file-style: "gnu" + End: +*/