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

/* 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 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.
*/

#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:
*/
Commit	Line	Data
dbb605f5	1	/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2006, 2008 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
dbb605f5 LC	27	#ifdef HAVE_CONFIG_H
	28	# include <config.h>
	29	#endif
	30
6b468ba4 MD	31	#include "libguile/_scm.h"
	32	#include "libguile/eval.h"
	33	#include "libguile/ports.h"
	34	#include "libguile/validate.h"
	35	#include "libguile/stime.h"
	36	#include "libguile/threads.h"
	37
	38	#include "libguile/futures.h"
	39
	40	#define LINK(list, obj) \
	41	do { \
	42	SCM_SET_FUTURE_NEXT (obj, list); \
	43	list = obj; \
	44	} while (0)
	45
	46	#define UNLINK(list, obj) \
	47	do { \
	48	obj = list; \
	49	list = SCM_FUTURE_NEXT (list); \
	50	} while (0)
	51
9de87eea	52	scm_i_pthread_mutex_t future_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
6b468ba4 MD	53
	54	static SCM futures = SCM_EOL;
	55	static SCM young = SCM_EOL;
	56	static SCM old = SCM_EOL;
	57	static SCM undead = SCM_EOL;
	58
	59	static long last_switch;
	60
	61	#ifdef SCM_FUTURES_DEBUG
	62	static int n_dead = 0;
	63
	64	static SCM
	65	count (SCM ls)
	66	{
	67	int n = 0;
d2e53ed6	68	while (!scm_is_null (ls))
6b468ba4 MD	69	{
	70	++n;
	71	ls = SCM_FUTURE_NEXT (ls);
	72	}
e11e83f3	73	return scm_from_int (n);
6b468ba4 MD	74	}
	75
	76	extern SCM scm_future_cache_status (void);
	77
	78	SCM_DEFINE (scm_future_cache_status, "future-cache-status", 0, 0, 0,
	79	(),
	80	"Return a list containing number of futures, youngs, olds, undeads and deads.")
	81	#define FUNC_NAME s_scm_future_cache_status
	82	{
	83	int nd = n_dead;
	84	n_dead = 0;
	85	return scm_list_5 (count (futures),
	86	count (young),
	87	count (old),
	88	count (undead),
e11e83f3	89	scm_from_int (nd));
6b468ba4 MD	90	}
	91	#undef FUNC_NAME
	92
	93	#endif
	94
	95	SCM *scm_loc_sys_thread_handler;
	96
	97	SCM_DEFINE (scm_make_future, "make-future", 1, 0, 0,
	98	(SCM thunk),
	99	"Make a future evaluating THUNK.")
	100	#define FUNC_NAME s_scm_make_future
	101	{
	102	SCM_VALIDATE_THUNK (1, thunk);
	103	return scm_i_make_future (thunk);
	104	}
	105	#undef FUNC_NAME
	106
	107	static char *s_future = "future";
	108
	109	static void
	110	cleanup (scm_t_future *future)
	111	{
9de87eea MV	112	scm_i_pthread_mutex_destroy (&future->mutex);
9de87eea MV	113	scm_i_pthread_cond_destroy (&future->cond);
6b468ba4 MD	114	scm_gc_free (future, sizeof (*future), s_future);
	115	#ifdef SCM_FUTURES_DEBUG
	116	++n_dead;
	117	#endif
	118	}
	119
	120	static SCM
	121	future_loop (scm_t_future *future)
	122	{
9de87eea	123	scm_i_scm_pthread_mutex_lock (&future->mutex);
6b468ba4 MD	124	do {
6b468ba4 MD	125	if (future->status == SCM_FUTURE_SIGNAL_ME)
9de87eea	126	scm_i_pthread_cond_broadcast (&future->cond);
6b468ba4 MD	127	future->status = SCM_FUTURE_COMPUTING;
	128	future->data = (SCM_CLOSUREP (future->data)
	129	? scm_i_call_closure_0 (future->data)
	130	: scm_call_0 (future->data));
9de87eea	131	scm_i_scm_pthread_cond_wait (&future->cond, &future->mutex);
6b468ba4 MD	132	} while (!future->die_p);
6b468ba4 MD	133	future->status = SCM_FUTURE_DEAD;
9de87eea	134	scm_i_pthread_mutex_unlock (&future->mutex);
6b468ba4 MD	135	return SCM_UNSPECIFIED;
	136	}
	137
	138	static SCM
	139	future_handler (scm_t_future *future, SCM key, SCM args)
	140	{
	141	future->status = SCM_FUTURE_DEAD;
9de87eea	142	scm_i_pthread_mutex_unlock (&future->mutex);
6b468ba4 MD	143	return scm_apply_1 (*scm_loc_sys_thread_handler, key, args);
	144	}
	145
	146	static SCM
	147	alloc_future (SCM thunk)
	148	{
	149	scm_t_future f = scm_gc_malloc (sizeof (f), s_future);
	150	SCM future;
	151	f->data = SCM_BOOL_F;
9de87eea MV	152	scm_i_pthread_mutex_init (&f->mutex, NULL);
9de87eea MV	153	scm_i_pthread_cond_init (&f->cond, NULL);
6b468ba4 MD	154	f->die_p = 0;
6b468ba4 MD	155	f->status = SCM_FUTURE_TASK_ASSIGNED;
9de87eea	156	scm_i_scm_pthread_mutex_lock (&future_admin_mutex);
6b468ba4 MD	157	SCM_NEWSMOB2 (future, scm_tc16_future, futures, f);
	158	SCM_SET_FUTURE_DATA (future, thunk);
	159	futures = future;
9de87eea	160	scm_i_pthread_mutex_unlock (&future_admin_mutex);
6b468ba4 MD	161	scm_spawn_thread ((scm_t_catch_body) future_loop,
	162	SCM_FUTURE (future),
	163	(scm_t_catch_handler) future_handler,
	164	SCM_FUTURE (future));
	165	return future;
	166	}
	167
	168	static void
	169	kill_future (SCM future)
	170	{
	171	SCM_FUTURE (future)->die_p = 1;
	172	LINK (undead, future);
	173	}
	174
	175	SCM
	176	scm_i_make_future (SCM thunk)
	177	{
	178	SCM future;
9de87eea	179	scm_i_scm_pthread_mutex_lock (&future_admin_mutex);
6b468ba4 MD	180	while (1)
6b468ba4 MD	181	{
d2e53ed6	182	if (!scm_is_null (old))
6b468ba4	183	UNLINK (old, future);
d2e53ed6	184	else if (!scm_is_null (young))
6b468ba4 MD	185	UNLINK (young, future);
	186	else
	187	{
9de87eea	188	scm_i_pthread_mutex_unlock (&future_admin_mutex);
6b468ba4 MD	189	return alloc_future (thunk);
6b468ba4 MD	190	}
9de87eea	191	if (scm_i_pthread_mutex_trylock (SCM_FUTURE_MUTEX (future)))
6b468ba4 MD	192	kill_future (future);
	193	else if (!SCM_FUTURE_ALIVE_P (future))
	194	{
9de87eea	195	scm_i_pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
6b468ba4 MD	196	cleanup (SCM_FUTURE (future));
	197	}
	198	else
	199	break;
	200	}
	201	LINK (futures, future);
9de87eea	202	scm_i_pthread_mutex_unlock (&future_admin_mutex);
6b468ba4 MD	203	SCM_SET_FUTURE_DATA (future, thunk);
6b468ba4 MD	204	SCM_SET_FUTURE_STATUS (future, SCM_FUTURE_TASK_ASSIGNED);
9de87eea MV	205	scm_i_pthread_cond_signal (SCM_FUTURE_COND (future));
9de87eea MV	206	scm_i_pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
6b468ba4 MD	207	return future;
	208	}
	209
6b468ba4 MD	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);
6b468ba4 MD	362	scm_set_smob_print (scm_tc16_future, future_print);
	363
	364	scm_c_hook_add (&scm_before_sweep_c_hook, scan_futures, 0, 0);
	365	#include "libguile/futures.x"
	366	}
	367
2f263a6a MV	368	#endif
2f263a6a MV	369
6b468ba4 MD	370	/*
	371	Local Variables:
	372	c-file-style: "gnu"
	373	End:
	374	*/