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

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


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