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

/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 */


\f

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

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