1 /* Copyright (C) 2012 Free Software Foundation, Inc.
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.
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.
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
26 #include "libguile/bdw-gc.h"
27 #include "libguile/_scm.h"
28 #include "libguile/finalizers.h"
29 #include "libguile/gc.h"
30 #include "libguile/threads.h"
34 static size_t finalization_count
;
40 scm_i_set_finalizer (void *obj
, scm_t_finalizer_proc proc
, void *data
)
42 GC_finalization_proc prev
;
44 GC_REGISTER_FINALIZER_NO_ORDER (obj
, proc
, data
, &prev
, &prev_data
);
47 struct scm_t_chained_finalizer
50 scm_t_finalizer_proc proc
;
52 scm_t_finalizer_proc prev
;
57 chained_finalizer (void *obj
, void *data
)
59 struct scm_t_chained_finalizer
*chained_data
= data
;
60 if (chained_data
->resuscitating_p
)
62 if (chained_data
->prev
)
63 scm_i_set_finalizer (obj
, chained_data
->prev
, chained_data
->prev_data
);
64 chained_data
->proc (obj
, chained_data
->data
);
68 chained_data
->proc (obj
, chained_data
->data
);
69 if (chained_data
->prev
)
70 chained_data
->prev (obj
, chained_data
->prev_data
);
75 scm_i_add_resuscitator (void *obj
, scm_t_finalizer_proc proc
, void *data
)
77 struct scm_t_chained_finalizer
*chained_data
;
78 chained_data
= scm_gc_malloc (sizeof (*chained_data
), "chained finalizer");
79 chained_data
->resuscitating_p
= 1;
80 chained_data
->proc
= proc
;
81 chained_data
->data
= data
;
82 GC_REGISTER_FINALIZER_NO_ORDER (obj
, chained_finalizer
, chained_data
,
84 &chained_data
->prev_data
);
88 shuffle_resuscitators_to_front (struct scm_t_chained_finalizer
*cd
)
90 while (cd
->prev
== chained_finalizer
)
92 struct scm_t_chained_finalizer
*prev
= cd
->prev_data
;
93 scm_t_finalizer_proc proc
= cd
->proc
;
94 void *data
= cd
->data
;
96 if (!prev
->resuscitating_p
)
99 cd
->resuscitating_p
= 1;
100 cd
->proc
= prev
->proc
;
101 cd
->data
= prev
->data
;
103 prev
->resuscitating_p
= 0;
112 scm_i_add_finalizer (void *obj
, scm_t_finalizer_proc proc
, void *data
)
114 struct scm_t_chained_finalizer
*chained_data
;
115 chained_data
= scm_gc_malloc (sizeof (*chained_data
), "chained finalizer");
116 chained_data
->resuscitating_p
= 0;
117 chained_data
->proc
= proc
;
118 chained_data
->data
= data
;
119 GC_REGISTER_FINALIZER_NO_ORDER (obj
, chained_finalizer
, chained_data
,
121 &chained_data
->prev_data
);
122 shuffle_resuscitators_to_front (chained_data
);
128 static SCM finalizer_async_cell
;
131 run_finalizers_async_thunk (void)
133 finalization_count
+= GC_invoke_finalizers ();
134 return SCM_UNSPECIFIED
;
138 /* The function queue_finalizer_async is run by the GC when there are
139 * objects to finalize. It will enqueue an asynchronous call to
140 * GC_invoke_finalizers() at the next SCM_TICK in this thread.
143 queue_finalizer_async (void)
145 scm_i_thread
*t
= SCM_I_CURRENT_THREAD
;
146 static scm_i_pthread_mutex_t lock
= SCM_I_PTHREAD_MUTEX_INITIALIZER
;
148 scm_i_pthread_mutex_lock (&lock
);
149 /* If t is NULL, that could be because we're allocating in
150 threads.c:guilify_self_1. In that case, rely on the
151 GC_invoke_finalizers call there after the thread spins up. */
152 if (t
&& scm_is_false (SCM_CDR (finalizer_async_cell
)))
154 SCM_SETCDR (finalizer_async_cell
, t
->active_asyncs
);
155 t
->active_asyncs
= finalizer_async_cell
;
156 t
->pending_asyncs
= 1;
158 scm_i_pthread_mutex_unlock (&lock
);
164 #ifndef HAVE_GC_SET_FINALIZER_NOTIFIER
166 GC_set_finalizer_notifier (void (*notifier
) (void))
168 GC_finalizer_notifier
= notifier
;
173 scm_init_finalizers (void)
175 /* When the async is to run, the cdr of the pair gets set to the
176 asyncs queue of the current thread. */
177 finalizer_async_cell
=
178 scm_cons (scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
179 run_finalizers_async_thunk
),
181 GC_set_finalizer_notifier (queue_finalizer_async
);