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

/* Copyright (C) 2012, 2013, 2014 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 3 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

#ifdef HAVE_CONFIG_H
# include <config.h>
#endif

#include <unistd.h>
#include <fcntl.h>

#include <full-write.h>

#include "libguile/bdw-gc.h"
#include "libguile/_scm.h"
#include "libguile/finalizers.h"
#include "libguile/gc.h"
#include "libguile/threads.h"

\f

static int automatic_finalization_p = 1;

static size_t finalization_count;


\f

void
scm_i_set_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
{
  GC_finalization_proc prev;
  void *prev_data;
  GC_REGISTER_FINALIZER_NO_ORDER (obj, proc, data, &prev, &prev_data);
}

struct scm_t_chained_finalizer
{
  int resuscitating_p;
  scm_t_finalizer_proc proc;
  void *data;
  scm_t_finalizer_proc prev;
  void *prev_data;
};

static void
chained_finalizer (void *obj, void *data)
{
  struct scm_t_chained_finalizer *chained_data = data;
  if (chained_data->resuscitating_p)
    {
      if (chained_data->prev)
        scm_i_set_finalizer (obj, chained_data->prev, chained_data->prev_data);
      chained_data->proc (obj, chained_data->data);
    }
  else
    {
      chained_data->proc (obj, chained_data->data);
      if (chained_data->prev)
        chained_data->prev (obj, chained_data->prev_data);
    }
}

void
scm_i_add_resuscitator (void *obj, scm_t_finalizer_proc proc, void *data)
{
  struct scm_t_chained_finalizer *chained_data;
  chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
  chained_data->resuscitating_p = 1;
  chained_data->proc = proc;
  chained_data->data = data;
  GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
                                  &chained_data->prev,
                                  &chained_data->prev_data);
}

static void
shuffle_resuscitators_to_front (struct scm_t_chained_finalizer *cd)
{
  while (cd->prev == chained_finalizer)
    {
      struct scm_t_chained_finalizer *prev = cd->prev_data;
      scm_t_finalizer_proc proc = cd->proc;
      void *data = cd->data;

      if (!prev->resuscitating_p)
        break;

      cd->resuscitating_p = 1;
      cd->proc = prev->proc;
      cd->data = prev->data;

      prev->resuscitating_p = 0;
      prev->proc = proc;
      prev->data = data;

      cd = prev;
    }
}

void
scm_i_add_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
{
  struct scm_t_chained_finalizer *chained_data;
  chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
  chained_data->resuscitating_p = 0;
  chained_data->proc = proc;
  chained_data->data = data;
  GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
                                  &chained_data->prev,
                                  &chained_data->prev_data);
  shuffle_resuscitators_to_front (chained_data);
}


\f

static SCM finalizer_async_cell;

static SCM
run_finalizers_async_thunk (void)
{
  scm_run_finalizers ();
  return SCM_UNSPECIFIED;
}


/* The function queue_finalizer_async is run by the GC when there are
 * objects to finalize.  It will enqueue an asynchronous call to
 * GC_invoke_finalizers() at the next SCM_TICK in this thread.
 */
static void
queue_finalizer_async (void)
{
  scm_i_thread *t = SCM_I_CURRENT_THREAD;
  static scm_i_pthread_mutex_t lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;

  scm_i_pthread_mutex_lock (&lock);
  /* If t is NULL, that could be because we're allocating in
     threads.c:guilify_self_1.  In that case, rely on the
     GC_invoke_finalizers call there after the thread spins up.  */
  if (t && scm_is_false (SCM_CDR (finalizer_async_cell)))
    {
      SCM_SETCDR (finalizer_async_cell, t->active_asyncs);
      t->active_asyncs = finalizer_async_cell;
      t->pending_asyncs = 1;
    }
  scm_i_pthread_mutex_unlock (&lock);
}


\f

#if SCM_USE_PTHREAD_THREADS

static int finalization_pipe[2];
static scm_i_pthread_mutex_t finalization_thread_lock =
  SCM_I_PTHREAD_MUTEX_INITIALIZER;
static pthread_t finalization_thread;
static int finalization_thread_is_running = 0;

static void
notify_finalizers_to_run (void)
{
  char byte = 0;
  full_write (finalization_pipe[1], &byte, 1);
}

static void
notify_about_to_fork (void)
{
  char byte = 1;
  full_write (finalization_pipe[1], &byte, 1);
}

struct finalization_pipe_data
{
  char byte;
  ssize_t n;
  int err;
};

static void*
read_finalization_pipe_data (void *data)
{
  struct finalization_pipe_data *fdata = data;
  
  fdata->n = read (finalization_pipe[0], &fdata->byte, 1);
  fdata->err = errno;

  return NULL;
}
  
static void*
finalization_thread_proc (void *unused)
{
  while (1)
    {
      struct finalization_pipe_data data;

      scm_without_guile (read_finalization_pipe_data, &data);
      
      if (data.n <= 0 && data.err != EINTR) 
        {
          perror ("error in finalization thread");
          return NULL;
        }

      switch (data.byte)
        {
        case 0:
          scm_run_finalizers ();
          break;
        case 1:
          return NULL;
        default:
          abort ();
        }
    }
}

static void*
run_finalization_thread (void *arg)
{
  return scm_with_guile (finalization_thread_proc, arg);
}

static void
start_finalization_thread (void)
{
  scm_i_pthread_mutex_lock (&finalization_thread_lock);
  if (!finalization_thread_is_running)
    {
      /* Use the raw pthread API and scm_with_guile, because we don't want
	 to block on any lock that scm_spawn_thread might want to take,
	 and we don't want to inherit the dynamic state (fluids) of the
	 caller.  */
      if (pthread_create (&finalization_thread, NULL,
			  run_finalization_thread, NULL))
	perror ("error creating finalization thread");
      else
	finalization_thread_is_running = 1;
    }
  scm_i_pthread_mutex_unlock (&finalization_thread_lock);
}

static void
stop_finalization_thread (void)
{
  scm_i_pthread_mutex_lock (&finalization_thread_lock);
  if (finalization_thread_is_running)
    {
      notify_about_to_fork ();
      if (pthread_join (finalization_thread, NULL))
        perror ("joining finalization thread");
      finalization_thread_is_running = 0;
    }
  scm_i_pthread_mutex_unlock (&finalization_thread_lock);
}

static void
spawn_finalizer_thread (void)
{
  GC_set_finalizer_notifier (notify_finalizers_to_run);
  start_finalization_thread ();
}

#endif /* SCM_USE_PTHREAD_THREADS */


\f

void
scm_i_finalizer_pre_fork (void)
{
#if SCM_USE_PTHREAD_THREADS
  if (automatic_finalization_p)
    {
      stop_finalization_thread ();
      GC_set_finalizer_notifier (spawn_finalizer_thread);
    }
#endif
}


\f

static void*
weak_pointer_ref (void *weak_pointer) 
{
  return *(void **) weak_pointer;
}

static void
weak_gc_finalizer (void *ptr, void *data)
{
  void **weak = ptr;
  void *val;
  void (*callback) (SCM) = weak[1];

  val = GC_call_with_alloc_lock (weak_pointer_ref, &weak[0]);

  if (!val)
    return;

  callback (SCM_PACK_POINTER (val));

  scm_i_set_finalizer (ptr, weak_gc_finalizer, data);
}

/* CALLBACK will be called on OBJ, as long as OBJ is accessible.  It
   will be called from a finalizer, which may be from an async or from
   another thread.

   As an implementation detail, the way this works is that we allocate
   a fresh pointer-less object holding two words.  We know that this
   object should get collected the next time GC is run, so we attach a
   finalizer to it so that we get a callback after GC happens.

   The first word of the object holds a weak reference to OBJ, and the
   second holds the callback pointer.  When the callback is called, we
   check if the weak reference on OBJ still holds.  If it doesn't hold,
   then OBJ is no longer accessible, and we're done.  Otherwise we call
   the callback and re-register a finalizer for our two-word GC object,
   effectively resuscitating the object so that we will get a callback
   on the next GC.

   We could use the scm_after_gc_hook, but using a finalizer has the
   advantage of potentially running in another thread, decreasing pause
   time.  */
void
scm_i_register_weak_gc_callback (SCM obj, void (*callback) (SCM))
{
  void **weak = GC_MALLOC_ATOMIC (sizeof (void*) * 2);

  weak[0] = SCM_UNPACK_POINTER (obj);
  weak[1] = (void*)callback;
  GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak, SCM2PTR (obj));

  scm_i_set_finalizer (weak, weak_gc_finalizer, NULL);
}


int
scm_set_automatic_finalization_enabled (int enabled_p)
{
  int was_enabled_p = automatic_finalization_p;

  if (enabled_p == was_enabled_p)
    return was_enabled_p;

  if (!scm_initialized_p)
    {
      automatic_finalization_p = enabled_p;
      return was_enabled_p;
    }

  if (enabled_p)
    {
#if SCM_USE_PTHREAD_THREADS
      if (pipe2 (finalization_pipe, O_CLOEXEC) != 0)
        scm_syserror (NULL);
      GC_set_finalizer_notifier (spawn_finalizer_thread);
#else
      GC_set_finalizer_notifier (queue_finalizer_async);
#endif
    }
  else
    {
      GC_set_finalizer_notifier (0);

#if SCM_USE_PTHREAD_THREADS
      stop_finalization_thread ();
      close (finalization_pipe[0]);
      close (finalization_pipe[1]);
      finalization_pipe[0] = -1;
      finalization_pipe[1] = -1;
#endif
    }

  automatic_finalization_p = enabled_p;

  return was_enabled_p;
}

int
scm_run_finalizers (void)
{
  int finalized = GC_invoke_finalizers ();

  finalization_count += finalized;

  return finalized;
}


\f

void
scm_init_finalizers (void)
{
  /* When the async is to run, the cdr of the pair gets set to the
     asyncs queue of the current thread.  */
  finalizer_async_cell =
    scm_cons (scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
                                run_finalizers_async_thunk),
              SCM_BOOL_F);

  if (automatic_finalization_p)
    GC_set_finalizer_notifier (queue_finalizer_async);
}

void
scm_init_finalizer_thread (void)
{
#if SCM_USE_PTHREAD_THREADS
  if (automatic_finalization_p)
    {
      if (pipe2 (finalization_pipe, O_CLOEXEC) != 0)
        scm_syserror (NULL);
      GC_set_finalizer_notifier (spawn_finalizer_thread);
    }
#endif
}
Commit	Line	Data
d6651f69	1	/* Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
6e9ec86d AW	2	*
	3	* This library is free software; you can redistribute it and/or
	4	* modify it under the terms of the GNU Lesser General Public License
	5	* as published by the Free Software Foundation; either version 3 of
	6	* the License, or (at your option) any later version.
	7	*
	8	* This library is distributed in the hope that it will be useful, but
	9	* 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.
	12	*
	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., 51 Franklin Street, Fifth Floor, Boston, MA
	16	* 02110-1301 USA
	17	*/
	18
	19
	20	\f
	21
	22	#ifdef HAVE_CONFIG_H
	23	# include <config.h>
	24	#endif
	25
eaf99988	26	#include <unistd.h>
eaf99988 AW	27	#include <fcntl.h>
	28
	29	#include <full-write.h>
	30
6e9ec86d AW	31	#include "libguile/bdw-gc.h"
	32	#include "libguile/_scm.h"
	33	#include "libguile/finalizers.h"
	34	#include "libguile/gc.h"
	35	#include "libguile/threads.h"
	36
	37	\f
	38
d6651f69 AW	39	static int automatic_finalization_p = 1;
d6651f69 AW	40
eaf99988 AW	41	static size_t finalization_count;
	42
	43
	44	\f
	45
6e9ec86d AW	46	void
	47	scm_i_set_finalizer (void obj, scm_t_finalizer_proc proc, void data)
	48	{
	49	GC_finalization_proc prev;
6922d92f	50	void *prev_data;
6e9ec86d AW	51	GC_REGISTER_FINALIZER_NO_ORDER (obj, proc, data, &prev, &prev_data);
	52	}
	53
	54	struct scm_t_chained_finalizer
	55	{
	56	int resuscitating_p;
	57	scm_t_finalizer_proc proc;
	58	void *data;
	59	scm_t_finalizer_proc prev;
	60	void *prev_data;
	61	};
	62
	63	static void
	64	chained_finalizer (void obj, void data)
	65	{
	66	struct scm_t_chained_finalizer *chained_data = data;
	67	if (chained_data->resuscitating_p)
	68	{
	69	if (chained_data->prev)
	70	scm_i_set_finalizer (obj, chained_data->prev, chained_data->prev_data);
	71	chained_data->proc (obj, chained_data->data);
	72	}
	73	else
	74	{
	75	chained_data->proc (obj, chained_data->data);
	76	if (chained_data->prev)
	77	chained_data->prev (obj, chained_data->prev_data);
	78	}
	79	}
	80
	81	void
	82	scm_i_add_resuscitator (void obj, scm_t_finalizer_proc proc, void data)
	83	{
	84	struct scm_t_chained_finalizer *chained_data;
	85	chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
	86	chained_data->resuscitating_p = 1;
	87	chained_data->proc = proc;
	88	chained_data->data = data;
	89	GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
	90	&chained_data->prev,
	91	&chained_data->prev_data);
	92	}
	93
	94	static void
	95	shuffle_resuscitators_to_front (struct scm_t_chained_finalizer *cd)
	96	{
	97	while (cd->prev == chained_finalizer)
	98	{
	99	struct scm_t_chained_finalizer *prev = cd->prev_data;
	100	scm_t_finalizer_proc proc = cd->proc;
	101	void *data = cd->data;
	102
	103	if (!prev->resuscitating_p)
	104	break;
	105
	106	cd->resuscitating_p = 1;
	107	cd->proc = prev->proc;
	108	cd->data = prev->data;
	109
	110	prev->resuscitating_p = 0;
	111	prev->proc = proc;
	112	prev->data = data;
	113
	114	cd = prev;
115	}
116	}
117
118	void
119	scm_i_add_finalizer (void obj, scm_t_finalizer_proc proc, void data)
120	{
121	struct scm_t_chained_finalizer *chained_data;
122	chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
123	chained_data->resuscitating_p = 0;
124	chained_data->proc = proc;
125	chained_data->data = data;
126	GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
127	&chained_data->prev,
128	&chained_data->prev_data);
129	shuffle_resuscitators_to_front (chained_data);
130	}
131
eaf99988	132
6e9ec86d AW	133	\f
6e9ec86d AW	134
eaf99988 AW	135	static SCM finalizer_async_cell;
	136
	137	static SCM
	138	run_finalizers_async_thunk (void)
	139	{
d6651f69	140	scm_run_finalizers ();
eaf99988 AW	141	return SCM_UNSPECIFIED;
	142	}
	143
	144
f740445a AW	145	/* The function queue_finalizer_async is run by the GC when there are
	146	* objects to finalize. It will enqueue an asynchronous call to
	147	* GC_invoke_finalizers() at the next SCM_TICK in this thread.
eaf99988 AW	148	*/
	149	static void
	150	queue_finalizer_async (void)
	151	{
	152	scm_i_thread *t = SCM_I_CURRENT_THREAD;
	153	static scm_i_pthread_mutex_t lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
	154
	155	scm_i_pthread_mutex_lock (&lock);
f740445a AW	156	/* If t is NULL, that could be because we're allocating in
	157	threads.c:guilify_self_1. In that case, rely on the
	158	GC_invoke_finalizers call there after the thread spins up. */
	159	if (t && scm_is_false (SCM_CDR (finalizer_async_cell)))
eaf99988 AW	160	{
	161	SCM_SETCDR (finalizer_async_cell, t->active_asyncs);
	162	t->active_asyncs = finalizer_async_cell;
	163	t->pending_asyncs = 1;
	164	}
	165	scm_i_pthread_mutex_unlock (&lock);
	166	}
	167
	168
	169	\f
	170
	171	#if SCM_USE_PTHREAD_THREADS
	172
	173	static int finalization_pipe[2];
	174	static scm_i_pthread_mutex_t finalization_thread_lock =
	175	SCM_I_PTHREAD_MUTEX_INITIALIZER;
2dcf6b59	176	static pthread_t finalization_thread;
1701a689	177	static int finalization_thread_is_running = 0;
eaf99988 AW	178
	179	static void
	180	notify_finalizers_to_run (void)
	181	{
	182	char byte = 0;
	183	full_write (finalization_pipe[1], &byte, 1);
	184	}
	185
	186	static void
	187	notify_about_to_fork (void)
	188	{
	189	char byte = 1;
	190	full_write (finalization_pipe[1], &byte, 1);
	191	}
	192
	193	struct finalization_pipe_data
	194	{
	195	char byte;
	196	ssize_t n;
	197	int err;
	198	};
	199
	200	static void*
	201	read_finalization_pipe_data (void *data)
	202	{
	203	struct finalization_pipe_data *fdata = data;
	204
	205	fdata->n = read (finalization_pipe[0], &fdata->byte, 1);
	206	fdata->err = errno;
	207
	208	return NULL;
	209	}
	210
2dcf6b59	211	static void*
eaf99988 AW	212	finalization_thread_proc (void *unused)
	213	{
	214	while (1)
	215	{
	216	struct finalization_pipe_data data;
	217
	218	scm_without_guile (read_finalization_pipe_data, &data);
	219
	220	if (data.n <= 0 && data.err != EINTR)
	221	{
2dcf6b59 AW	222	perror ("error in finalization thread");
2dcf6b59 AW	223	return NULL;
eaf99988 AW	224	}
	225
	226	switch (data.byte)
	227	{
	228	case 0:
d6651f69	229	scm_run_finalizers ();
eaf99988 AW	230	break;
eaf99988 AW	231	case 1:
2dcf6b59	232	return NULL;
eaf99988 AW	233	default:
	234	abort ();
	235	}
	236	}
	237	}
	238
2dcf6b59 AW	239	static void*
	240	run_finalization_thread (void *arg)
	241	{
	242	return scm_with_guile (finalization_thread_proc, arg);
	243	}
	244
eaf99988 AW	245	static void
	246	start_finalization_thread (void)
	247	{
	248	scm_i_pthread_mutex_lock (&finalization_thread_lock);
1701a689 LC	249	if (!finalization_thread_is_running)
	250	{
	251	/* Use the raw pthread API and scm_with_guile, because we don't want
	252	to block on any lock that scm_spawn_thread might want to take,
	253	and we don't want to inherit the dynamic state (fluids) of the
	254	caller. */
	255	if (pthread_create (&finalization_thread, NULL,
	256	run_finalization_thread, NULL))
	257	perror ("error creating finalization thread");
	258	else
	259	finalization_thread_is_running = 1;
	260	}
eaf99988 AW	261	scm_i_pthread_mutex_unlock (&finalization_thread_lock);
	262	}
	263
	264	static void
	265	stop_finalization_thread (void)
	266	{
	267	scm_i_pthread_mutex_lock (&finalization_thread_lock);
1701a689	268	if (finalization_thread_is_running)
eaf99988 AW	269	{
eaf99988 AW	270	notify_about_to_fork ();
2dcf6b59 AW	271	if (pthread_join (finalization_thread, NULL))
2dcf6b59 AW	272	perror ("joining finalization thread");
1701a689	273	finalization_thread_is_running = 0;
eaf99988 AW	274	}
	275	scm_i_pthread_mutex_unlock (&finalization_thread_lock);
	276	}
	277
	278	static void
	279	spawn_finalizer_thread (void)
	280	{
	281	GC_set_finalizer_notifier (notify_finalizers_to_run);
	282	start_finalization_thread ();
	283	}
	284
	285	#endif /* SCM_USE_PTHREAD_THREADS */
	286
	287
	288	\f
	289
	290	void
	291	scm_i_finalizer_pre_fork (void)
	292	{
	293	#if SCM_USE_PTHREAD_THREADS
d6651f69 AW	294	if (automatic_finalization_p)
	295	{
	296	stop_finalization_thread ();
	297	GC_set_finalizer_notifier (spawn_finalizer_thread);
	298	}
eaf99988 AW	299	#endif
	300	}
	301
	302
	303	\f
6e9ec86d	304
a0551390 AW	305	static void*
	306	weak_pointer_ref (void *weak_pointer)
	307	{
	308	return (void *) weak_pointer;
	309	}
	310
	311	static void
	312	weak_gc_finalizer (void ptr, void data)
	313	{
	314	void **weak = ptr;
	315	void *val;
	316	void (*callback) (SCM) = weak[1];
	317
	318	val = GC_call_with_alloc_lock (weak_pointer_ref, &weak[0]);
	319
	320	if (!val)
	321	return;
	322
	323	callback (SCM_PACK_POINTER (val));
	324
	325	scm_i_set_finalizer (ptr, weak_gc_finalizer, data);
	326	}
	327
	328	/* CALLBACK will be called on OBJ, as long as OBJ is accessible. It
	329	will be called from a finalizer, which may be from an async or from
	330	another thread.
	331
	332	As an implementation detail, the way this works is that we allocate
	333	a fresh pointer-less object holding two words. We know that this
	334	object should get collected the next time GC is run, so we attach a
	335	finalizer to it so that we get a callback after GC happens.
	336
	337	The first word of the object holds a weak reference to OBJ, and the
	338	second holds the callback pointer. When the callback is called, we
	339	check if the weak reference on OBJ still holds. If it doesn't hold,
	340	then OBJ is no longer accessible, and we're done. Otherwise we call
	341	the callback and re-register a finalizer for our two-word GC object,
	342	effectively resuscitating the object so that we will get a callback
	343	on the next GC.
	344
	345	We could use the scm_after_gc_hook, but using a finalizer has the
	346	advantage of potentially running in another thread, decreasing pause
	347	time. */
	348	void
	349	scm_i_register_weak_gc_callback (SCM obj, void (*callback) (SCM))
	350	{
	351	void *weak = GC_MALLOC_ATOMIC (sizeof (void) * 2);
	352
	353	weak[0] = SCM_UNPACK_POINTER (obj);
	354	weak[1] = (void*)callback;
	355	GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak, SCM2PTR (obj));
	356
	357	scm_i_set_finalizer (weak, weak_gc_finalizer, NULL);
	358	}
	359
	360
d6651f69 AW	361	int
	362	scm_set_automatic_finalization_enabled (int enabled_p)
	363	{
	364	int was_enabled_p = automatic_finalization_p;
	365
	366	if (enabled_p == was_enabled_p)
	367	return was_enabled_p;
	368
	369	if (!scm_initialized_p)
	370	{
	371	automatic_finalization_p = enabled_p;
	372	return was_enabled_p;
	373	}
	374
	375	if (enabled_p)
	376	{
	377	#if SCM_USE_PTHREAD_THREADS
	378	if (pipe2 (finalization_pipe, O_CLOEXEC) != 0)
	379	scm_syserror (NULL);
	380	GC_set_finalizer_notifier (spawn_finalizer_thread);
	381	#else
	382	GC_set_finalizer_notifier (queue_finalizer_async);
	383	#endif
	384	}
	385	else
	386	{
	387	GC_set_finalizer_notifier (0);
	388
	389	#if SCM_USE_PTHREAD_THREADS
	390	stop_finalization_thread ();
	391	close (finalization_pipe[0]);
	392	close (finalization_pipe[1]);
	393	finalization_pipe[0] = -1;
	394	finalization_pipe[1] = -1;
	395	#endif
	396	}
	397
	398	automatic_finalization_p = enabled_p;
	399
	400	return was_enabled_p;
	401	}
	402
	403	int
	404	scm_run_finalizers (void)
	405	{
	406	int finalized = GC_invoke_finalizers ();
	407
	408	finalization_count += finalized;
	409
	410	return finalized;
	411	}
	412
	413
a0551390 AW	414	\f
a0551390 AW	415
6e9ec86d AW	416	void
	417	scm_init_finalizers (void)
	418	{
eaf99988 AW	419	/* When the async is to run, the cdr of the pair gets set to the
	420	asyncs queue of the current thread. */
	421	finalizer_async_cell =
	422	scm_cons (scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
	423	run_finalizers_async_thunk),
	424	SCM_BOOL_F);
d6651f69 AW	425
	426	if (automatic_finalization_p)
	427	GC_set_finalizer_notifier (queue_finalizer_async);
eaf99988 AW	428	}
	429
	430	void
	431	scm_init_finalizer_thread (void)
	432	{
	433	#if SCM_USE_PTHREAD_THREADS
d6651f69 AW	434	if (automatic_finalization_p)
	435	{
	436	if (pipe2 (finalization_pipe, O_CLOEXEC) != 0)
	437	scm_syserror (NULL);
	438	GC_set_finalizer_notifier (spawn_finalizer_thread);
	439	}
eaf99988	440	#endif
6e9ec86d	441	}