[bpt/guile.git] / libguile / futures.c

/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2006 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 2.1 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
 */


\f

#if 0

/* This whole file is not being compiled.  See futures.h for the
   reason.
*/

#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 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 ("#<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_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"
}

#endif

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/
Commit	Line	Data
2b829bbb	1	/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2006 Free Software Foundation, Inc.
6b468ba4	2	*
73be1d9e MV	3	* This library is free software; you can redistribute it and/or
	4	* modify it under the terms of the GNU Lesser General Public
	5	* License as published by the Free Software Foundation; either
	6	* version 2.1 of the License, or (at your option) any later version.
6b468ba4	7	*
73be1d9e MV	8	* This library is distributed in the hope that it will be useful,
	9	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	10	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	11	* Lesser General Public License for more details.
6b468ba4	12	*
73be1d9e MV	13	* You should have received a copy of the GNU Lesser General Public
73be1d9e MV	14	* License along with this library; if not, write to the Free Software
92205699	15	* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
73be1d9e	16	*/
6b468ba4 MD	17
	18
	19	\f
	20
2f263a6a MV	21	#if 0
	22
	23	/* This whole file is not being compiled. See futures.h for the
	24	reason.
	25	*/
	26
6b468ba4 MD	27	#include "libguile/_scm.h"
	28	#include "libguile/eval.h"
	29	#include "libguile/ports.h"
	30	#include "libguile/validate.h"
	31	#include "libguile/stime.h"
	32	#include "libguile/threads.h"
	33
	34	#include "libguile/futures.h"
	35
	36	#define LINK(list, obj) \
	37	do { \
	38	SCM_SET_FUTURE_NEXT (obj, list); \
	39	list = obj; \
	40	} while (0)
	41
	42	#define UNLINK(list, obj) \
	43	do { \
	44	obj = list; \
	45	list = SCM_FUTURE_NEXT (list); \
	46	} while (0)
	47
9de87eea	48	scm_i_pthread_mutex_t future_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
6b468ba4 MD	49
	50	static SCM futures = SCM_EOL;
	51	static SCM young = SCM_EOL;
	52	static SCM old = SCM_EOL;
	53	static SCM undead = SCM_EOL;
	54
	55	static long last_switch;
	56
	57	#ifdef SCM_FUTURES_DEBUG
	58	static int n_dead = 0;
	59
	60	static SCM
	61	count (SCM ls)
	62	{
	63	int n = 0;
d2e53ed6	64	while (!scm_is_null (ls))
6b468ba4 MD	65	{
	66	++n;
	67	ls = SCM_FUTURE_NEXT (ls);
	68	}
e11e83f3	69	return scm_from_int (n);
6b468ba4 MD	70	}
	71
	72	extern SCM scm_future_cache_status (void);
	73
	74	SCM_DEFINE (scm_future_cache_status, "future-cache-status", 0, 0, 0,
	75	(),
	76	"Return a list containing number of futures, youngs, olds, undeads and deads.")
	77	#define FUNC_NAME s_scm_future_cache_status
	78	{
	79	int nd = n_dead;
	80	n_dead = 0;
	81	return scm_list_5 (count (futures),
	82	count (young),
	83	count (old),
	84	count (undead),
e11e83f3	85	scm_from_int (nd));
6b468ba4 MD	86	}
	87	#undef FUNC_NAME
	88
	89	#endif
	90
	91	SCM *scm_loc_sys_thread_handler;
	92
	93	SCM_DEFINE (scm_make_future, "make-future", 1, 0, 0,
	94	(SCM thunk),
	95	"Make a future evaluating THUNK.")
	96	#define FUNC_NAME s_scm_make_future
	97	{
	98	SCM_VALIDATE_THUNK (1, thunk);
	99	return scm_i_make_future (thunk);
	100	}
	101	#undef FUNC_NAME
	102
	103	static char *s_future = "future";
	104
	105	static void
	106	cleanup (scm_t_future *future)
	107	{
9de87eea MV	108	scm_i_pthread_mutex_destroy (&future->mutex);
9de87eea MV	109	scm_i_pthread_cond_destroy (&future->cond);
6b468ba4 MD	110	scm_gc_free (future, sizeof (*future), s_future);
	111	#ifdef SCM_FUTURES_DEBUG
	112	++n_dead;
	113	#endif
	114	}
	115
	116	static SCM
	117	future_loop (scm_t_future *future)
	118	{
9de87eea	119	scm_i_scm_pthread_mutex_lock (&future->mutex);
6b468ba4 MD	120	do {
6b468ba4 MD	121	if (future->status == SCM_FUTURE_SIGNAL_ME)
9de87eea	122	scm_i_pthread_cond_broadcast (&future->cond);
6b468ba4 MD	123	future->status = SCM_FUTURE_COMPUTING;
	124	future->data = (SCM_CLOSUREP (future->data)
	125	? scm_i_call_closure_0 (future->data)
	126	: scm_call_0 (future->data));
9de87eea	127	scm_i_scm_pthread_cond_wait (&future->cond, &future->mutex);
6b468ba4 MD	128	} while (!future->die_p);
6b468ba4 MD	129	future->status = SCM_FUTURE_DEAD;
9de87eea	130	scm_i_pthread_mutex_unlock (&future->mutex);
6b468ba4 MD	131	return SCM_UNSPECIFIED;
	132	}
	133
	134	static SCM
	135	future_handler (scm_t_future *future, SCM key, SCM args)
	136	{
	137	future->status = SCM_FUTURE_DEAD;
9de87eea	138	scm_i_pthread_mutex_unlock (&future->mutex);
6b468ba4 MD	139	return scm_apply_1 (*scm_loc_sys_thread_handler, key, args);
	140	}
	141
	142	static SCM
	143	alloc_future (SCM thunk)
	144	{
	145	scm_t_future f = scm_gc_malloc (sizeof (f), s_future);
	146	SCM future;
	147	f->data = SCM_BOOL_F;
9de87eea MV	148	scm_i_pthread_mutex_init (&f->mutex, NULL);
9de87eea MV	149	scm_i_pthread_cond_init (&f->cond, NULL);
6b468ba4 MD	150	f->die_p = 0;
6b468ba4 MD	151	f->status = SCM_FUTURE_TASK_ASSIGNED;
9de87eea	152	scm_i_scm_pthread_mutex_lock (&future_admin_mutex);
6b468ba4 MD	153	SCM_NEWSMOB2 (future, scm_tc16_future, futures, f);
	154	SCM_SET_FUTURE_DATA (future, thunk);
	155	futures = future;
9de87eea	156	scm_i_pthread_mutex_unlock (&future_admin_mutex);
6b468ba4 MD	157	scm_spawn_thread ((scm_t_catch_body) future_loop,
	158	SCM_FUTURE (future),
	159	(scm_t_catch_handler) future_handler,
	160	SCM_FUTURE (future));
	161	return future;
	162	}
	163
	164	static void
	165	kill_future (SCM future)
	166	{
	167	SCM_FUTURE (future)->die_p = 1;
	168	LINK (undead, future);
	169	}
	170
	171	SCM
	172	scm_i_make_future (SCM thunk)
	173	{
	174	SCM future;
9de87eea	175	scm_i_scm_pthread_mutex_lock (&future_admin_mutex);
6b468ba4 MD	176	while (1)
6b468ba4 MD	177	{
d2e53ed6	178	if (!scm_is_null (old))
6b468ba4	179	UNLINK (old, future);
d2e53ed6	180	else if (!scm_is_null (young))
6b468ba4 MD	181	UNLINK (young, future);
	182	else
	183	{
9de87eea	184	scm_i_pthread_mutex_unlock (&future_admin_mutex);
6b468ba4 MD	185	return alloc_future (thunk);
6b468ba4 MD	186	}
9de87eea	187	if (scm_i_pthread_mutex_trylock (SCM_FUTURE_MUTEX (future)))
6b468ba4 MD	188	kill_future (future);
	189	else if (!SCM_FUTURE_ALIVE_P (future))
	190	{
9de87eea	191	scm_i_pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
6b468ba4 MD	192	cleanup (SCM_FUTURE (future));
	193	}
	194	else
	195	break;
	196	}
	197	LINK (futures, future);
9de87eea	198	scm_i_pthread_mutex_unlock (&future_admin_mutex);
6b468ba4 MD	199	SCM_SET_FUTURE_DATA (future, thunk);
6b468ba4 MD	200	SCM_SET_FUTURE_STATUS (future, SCM_FUTURE_TASK_ASSIGNED);
9de87eea MV	201	scm_i_pthread_cond_signal (SCM_FUTURE_COND (future));
9de87eea MV	202	scm_i_pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
6b468ba4 MD	203	return future;
	204	}
	205
	206	static SCM
	207	future_mark (SCM ptr) {
	208	return SCM_FUTURE_DATA (ptr);
	209	}
	210
	211	static int
	212	future_print (SCM exp, SCM port, scm_print_state *pstate)
	213	{
	214	int writingp = SCM_WRITINGP (pstate);
	215	scm_puts ("#<future ", port);
	216	SCM_SET_WRITINGP (pstate, 1);
	217	scm_iprin1 (SCM_FUTURE_DATA (exp), port, pstate);
	218	SCM_SET_WRITINGP (pstate, writingp);
	219	scm_putc ('>', port);
	220	return !0;
	221	}
	222
	223	SCM_DEFINE (scm_future_ref, "future-ref", 1, 0, 0,
	224	(SCM future),
	225	"If the future @var{x} has not been computed yet, compute and\n"
	226	"return @var{x}, otherwise just return the previously computed\n"
	227	"value.")
	228	#define FUNC_NAME s_scm_future_ref
	229	{
	230	SCM res;
	231	SCM_VALIDATE_FUTURE (1, future);
9de87eea	232	scm_i_scm_pthread_mutex_lock (SCM_FUTURE_MUTEX (future));
6b468ba4 MD	233	if (SCM_FUTURE_STATUS (future) != SCM_FUTURE_COMPUTING)
	234	{
	235	SCM_SET_FUTURE_STATUS (future, SCM_FUTURE_SIGNAL_ME);
9de87eea MV	236	scm_i_scm_pthread_cond_wait (SCM_FUTURE_COND (future),
9de87eea MV	237	SCM_FUTURE_MUTEX (future));
6b468ba4 MD	238	}
	239	if (!SCM_FUTURE_ALIVE_P (future))
	240	{
9de87eea	241	scm_i_pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
6b468ba4 MD	242	SCM_MISC_ERROR ("requesting result from failed future ~A",
	243	scm_list_1 (future));
	244	}
	245	res = SCM_FUTURE_DATA (future);
9de87eea	246	scm_i_pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
6b468ba4 MD	247	return res;
	248	}
	249	#undef FUNC_NAME
	250
	251	static void
	252	kill_futures (SCM victims)
	253	{
d2e53ed6	254	while (!scm_is_null (victims))
6b468ba4 MD	255	{
	256	SCM future;
	257	UNLINK (victims, future);
	258	kill_future (future);
9de87eea	259	scm_i_pthread_cond_signal (SCM_FUTURE_COND (future));
6b468ba4 MD	260	}
	261	}
	262
	263	static void
	264	cleanup_undead ()
	265	{
	266	SCM next = undead, *nextloc = &undead;
d2e53ed6	267	while (!scm_is_null (next))
6b468ba4	268	{
9de87eea	269	if (scm_i_pthread_mutex_trylock (SCM_FUTURE_MUTEX (next)))
6b468ba4 MD	270	goto next;
	271	else if (SCM_FUTURE_ALIVE_P (next))
	272	{
9de87eea MV	273	scm_i_pthread_cond_signal (SCM_FUTURE_COND (next));
9de87eea MV	274	scm_i_pthread_mutex_unlock (SCM_FUTURE_MUTEX (next));
6b468ba4	275	next:
361d631f	276	SCM_SET_GC_MARK (next);
6b468ba4 MD	277	nextloc = SCM_FUTURE_NEXTLOC (next);
	278	next = *nextloc;
	279	}
	280	else
	281	{
	282	SCM future;
	283	UNLINK (next, future);
9de87eea	284	scm_i_pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
6b468ba4 MD	285	cleanup (SCM_FUTURE (future));
	286	*nextloc = next;
	287	}
	288	}
	289	}
	290
	291	static void
	292	mark_futures (SCM futures)
	293	{
d2e53ed6	294	while (!scm_is_null (futures))
6b468ba4	295	{
6b468ba4 MD	296	SCM_SET_GC_MARK (futures);
	297	futures = SCM_FUTURE_NEXT (futures);
	298	}
	299	}
	300
	301	static void *
	302	scan_futures (void dummy1, void dummy2, void *dummy3)
	303	{
	304	SCM next, *nextloc;
	305
	306	long now = scm_c_get_internal_run_time ();
	307	if (now - last_switch > SCM_TIME_UNITS_PER_SECOND)
	308	{
	309	/* switch out old (> 1 sec), unused futures */
	310	kill_futures (old);
	311	old = young;
	312	young = SCM_EOL;
	313	last_switch = now;
	314	}
361d631f MD	315	else
361d631f MD	316	mark_futures (young);
6b468ba4 MD	317
	318	next = futures;
	319	nextloc = &futures;
d2e53ed6	320	while (!scm_is_null (next))
6b468ba4 MD	321	{
	322	if (!SCM_GC_MARK_P (next))
	323	goto free;
	324	keep:
	325	nextloc = SCM_FUTURE_NEXTLOC (next);
	326	next = *nextloc;
	327	}
	328	goto exit;
d2e53ed6	329	while (!scm_is_null (next))
6b468ba4 MD	330	{
	331	if (SCM_GC_MARK_P (next))
	332	{
	333	*nextloc = next;
	334	goto keep;
	335	}
	336	free:
	337	{
	338	SCM future;
	339	UNLINK (next, future);
361d631f	340	SCM_SET_GC_MARK (future);
6b468ba4 MD	341	LINK (young, future);
	342	}
	343	}
	344	*nextloc = SCM_EOL;
	345	exit:
	346	cleanup_undead ();
6b468ba4	347	mark_futures (old);
6b468ba4 MD	348	return 0;
	349	}
	350
9de87eea MV	351	scm_t_bits scm_tc16_future;
9de87eea MV	352
6b468ba4 MD	353	void
	354	scm_init_futures ()
	355	{
	356	last_switch = scm_c_get_internal_run_time ();
	357
	358	scm_loc_sys_thread_handler
	359	= SCM_VARIABLE_LOC (scm_c_define ("%thread-handler", SCM_BOOL_F));
	360
	361	scm_tc16_future = scm_make_smob_type ("future", 0);
	362	scm_set_smob_mark (scm_tc16_future, future_mark);
	363	scm_set_smob_print (scm_tc16_future, future_print);
	364
	365	scm_c_hook_add (&scm_before_sweep_c_hook, scan_futures, 0, 0);
	366	#include "libguile/futures.x"
	367	}
	368
2f263a6a MV	369	#endif
2f263a6a MV	370
6b468ba4 MD	371	/*
	372	Local Variables:
	373	c-file-style: "gnu"
	374	End:
	375	*/