1 /* Copyright (C) 2012, 2013 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
31 #include <full-write.h>
33 #include "libguile/bdw-gc.h"
34 #include "libguile/_scm.h"
35 #include "libguile/finalizers.h"
36 #include "libguile/gc.h"
37 #include "libguile/threads.h"
41 static size_t finalization_count
;
46 #ifndef HAVE_GC_SET_FINALIZER_NOTIFIER
48 GC_set_finalizer_notifier (void (*notifier
) (void))
50 GC_finalizer_notifier
= notifier
;
58 scm_i_set_finalizer (void *obj
, scm_t_finalizer_proc proc
, void *data
)
60 GC_finalization_proc prev
;
62 GC_REGISTER_FINALIZER_NO_ORDER (obj
, proc
, data
, &prev
, &prev_data
);
65 struct scm_t_chained_finalizer
68 scm_t_finalizer_proc proc
;
70 scm_t_finalizer_proc prev
;
75 chained_finalizer (void *obj
, void *data
)
77 struct scm_t_chained_finalizer
*chained_data
= data
;
78 if (chained_data
->resuscitating_p
)
80 if (chained_data
->prev
)
81 scm_i_set_finalizer (obj
, chained_data
->prev
, chained_data
->prev_data
);
82 chained_data
->proc (obj
, chained_data
->data
);
86 chained_data
->proc (obj
, chained_data
->data
);
87 if (chained_data
->prev
)
88 chained_data
->prev (obj
, chained_data
->prev_data
);
93 scm_i_add_resuscitator (void *obj
, scm_t_finalizer_proc proc
, void *data
)
95 struct scm_t_chained_finalizer
*chained_data
;
96 chained_data
= scm_gc_malloc (sizeof (*chained_data
), "chained finalizer");
97 chained_data
->resuscitating_p
= 1;
98 chained_data
->proc
= proc
;
99 chained_data
->data
= data
;
100 GC_REGISTER_FINALIZER_NO_ORDER (obj
, chained_finalizer
, chained_data
,
102 &chained_data
->prev_data
);
106 shuffle_resuscitators_to_front (struct scm_t_chained_finalizer
*cd
)
108 while (cd
->prev
== chained_finalizer
)
110 struct scm_t_chained_finalizer
*prev
= cd
->prev_data
;
111 scm_t_finalizer_proc proc
= cd
->proc
;
112 void *data
= cd
->data
;
114 if (!prev
->resuscitating_p
)
117 cd
->resuscitating_p
= 1;
118 cd
->proc
= prev
->proc
;
119 cd
->data
= prev
->data
;
121 prev
->resuscitating_p
= 0;
130 scm_i_add_finalizer (void *obj
, scm_t_finalizer_proc proc
, void *data
)
132 struct scm_t_chained_finalizer
*chained_data
;
133 chained_data
= scm_gc_malloc (sizeof (*chained_data
), "chained finalizer");
134 chained_data
->resuscitating_p
= 0;
135 chained_data
->proc
= proc
;
136 chained_data
->data
= data
;
137 GC_REGISTER_FINALIZER_NO_ORDER (obj
, chained_finalizer
, chained_data
,
139 &chained_data
->prev_data
);
140 shuffle_resuscitators_to_front (chained_data
);
146 static SCM finalizer_async_cell
;
149 run_finalizers_async_thunk (void)
151 finalization_count
+= GC_invoke_finalizers ();
152 return SCM_UNSPECIFIED
;
156 /* The function queue_finalizer_async is run by the GC when there are
157 * objects to finalize. It will enqueue an asynchronous call to
158 * GC_invoke_finalizers() at the next SCM_TICK in this thread.
161 queue_finalizer_async (void)
163 scm_i_thread
*t
= SCM_I_CURRENT_THREAD
;
164 static scm_i_pthread_mutex_t lock
= SCM_I_PTHREAD_MUTEX_INITIALIZER
;
166 scm_i_pthread_mutex_lock (&lock
);
167 /* If t is NULL, that could be because we're allocating in
168 threads.c:guilify_self_1. In that case, rely on the
169 GC_invoke_finalizers call there after the thread spins up. */
170 if (t
&& scm_is_false (SCM_CDR (finalizer_async_cell
)))
172 SCM_SETCDR (finalizer_async_cell
, t
->active_asyncs
);
173 t
->active_asyncs
= finalizer_async_cell
;
174 t
->pending_asyncs
= 1;
176 scm_i_pthread_mutex_unlock (&lock
);
182 #if SCM_USE_PTHREAD_THREADS
184 static int finalization_pipe
[2];
185 static scm_i_pthread_mutex_t finalization_thread_lock
=
186 SCM_I_PTHREAD_MUTEX_INITIALIZER
;
187 static pthread_t finalization_thread
;
188 static int finalization_thread_is_running
= 0;
191 notify_finalizers_to_run (void)
194 full_write (finalization_pipe
[1], &byte
, 1);
198 notify_about_to_fork (void)
201 full_write (finalization_pipe
[1], &byte
, 1);
204 struct finalization_pipe_data
212 read_finalization_pipe_data (void *data
)
214 struct finalization_pipe_data
*fdata
= data
;
216 fdata
->n
= read (finalization_pipe
[0], &fdata
->byte
, 1);
223 finalization_thread_proc (void *unused
)
227 struct finalization_pipe_data data
;
229 scm_without_guile (read_finalization_pipe_data
, &data
);
231 if (data
.n
<= 0 && data
.err
!= EINTR
)
233 perror ("error in finalization thread");
240 finalization_count
+= GC_invoke_finalizers ();
251 run_finalization_thread (void *arg
)
253 return scm_with_guile (finalization_thread_proc
, arg
);
257 start_finalization_thread (void)
259 scm_i_pthread_mutex_lock (&finalization_thread_lock
);
260 if (!finalization_thread_is_running
)
262 /* Use the raw pthread API and scm_with_guile, because we don't want
263 to block on any lock that scm_spawn_thread might want to take,
264 and we don't want to inherit the dynamic state (fluids) of the
266 if (pthread_create (&finalization_thread
, NULL
,
267 run_finalization_thread
, NULL
))
268 perror ("error creating finalization thread");
270 finalization_thread_is_running
= 1;
272 scm_i_pthread_mutex_unlock (&finalization_thread_lock
);
276 stop_finalization_thread (void)
278 scm_i_pthread_mutex_lock (&finalization_thread_lock
);
279 if (finalization_thread_is_running
)
281 notify_about_to_fork ();
282 if (pthread_join (finalization_thread
, NULL
))
283 perror ("joining finalization thread");
284 finalization_thread_is_running
= 0;
286 scm_i_pthread_mutex_unlock (&finalization_thread_lock
);
290 spawn_finalizer_thread (void)
292 GC_set_finalizer_notifier (notify_finalizers_to_run
);
293 start_finalization_thread ();
296 #endif /* SCM_USE_PTHREAD_THREADS */
302 scm_i_finalizer_pre_fork (void)
304 #if SCM_USE_PTHREAD_THREADS
305 stop_finalization_thread ();
306 GC_set_finalizer_notifier (spawn_finalizer_thread
);
314 weak_pointer_ref (void *weak_pointer
)
316 return *(void **) weak_pointer
;
320 weak_gc_finalizer (void *ptr
, void *data
)
324 void (*callback
) (SCM
) = weak
[1];
326 val
= GC_call_with_alloc_lock (weak_pointer_ref
, &weak
[0]);
331 callback (SCM_PACK_POINTER (val
));
333 scm_i_set_finalizer (ptr
, weak_gc_finalizer
, data
);
336 /* CALLBACK will be called on OBJ, as long as OBJ is accessible. It
337 will be called from a finalizer, which may be from an async or from
340 As an implementation detail, the way this works is that we allocate
341 a fresh pointer-less object holding two words. We know that this
342 object should get collected the next time GC is run, so we attach a
343 finalizer to it so that we get a callback after GC happens.
345 The first word of the object holds a weak reference to OBJ, and the
346 second holds the callback pointer. When the callback is called, we
347 check if the weak reference on OBJ still holds. If it doesn't hold,
348 then OBJ is no longer accessible, and we're done. Otherwise we call
349 the callback and re-register a finalizer for our two-word GC object,
350 effectively resuscitating the object so that we will get a callback
353 We could use the scm_after_gc_hook, but using a finalizer has the
354 advantage of potentially running in another thread, decreasing pause
357 scm_i_register_weak_gc_callback (SCM obj
, void (*callback
) (SCM
))
359 void **weak
= GC_MALLOC_ATOMIC (sizeof (void*) * 2);
361 weak
[0] = SCM_UNPACK_POINTER (obj
);
362 weak
[1] = (void*)callback
;
363 GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak
, SCM2PTR (obj
));
365 scm_i_set_finalizer (weak
, weak_gc_finalizer
, NULL
);
372 scm_init_finalizers (void)
374 /* When the async is to run, the cdr of the pair gets set to the
375 asyncs queue of the current thread. */
376 finalizer_async_cell
=
377 scm_cons (scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
378 run_finalizers_async_thunk
),
380 GC_set_finalizer_notifier (queue_finalizer_async
);
384 scm_init_finalizer_thread (void)
386 #if SCM_USE_PTHREAD_THREADS
387 if (pipe2 (finalization_pipe
, O_CLOEXEC
) != 0)
389 GC_set_finalizer_notifier (spawn_finalizer_thread
);