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
;
47 scm_i_set_finalizer (void *obj
, scm_t_finalizer_proc proc
, void *data
)
49 GC_finalization_proc prev
;
51 GC_REGISTER_FINALIZER_NO_ORDER (obj
, proc
, data
, &prev
, &prev_data
);
54 struct scm_t_chained_finalizer
57 scm_t_finalizer_proc proc
;
59 scm_t_finalizer_proc prev
;
64 chained_finalizer (void *obj
, void *data
)
66 struct scm_t_chained_finalizer
*chained_data
= data
;
67 if (chained_data
->resuscitating_p
)
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
);
75 chained_data
->proc (obj
, chained_data
->data
);
76 if (chained_data
->prev
)
77 chained_data
->prev (obj
, chained_data
->prev_data
);
82 scm_i_add_resuscitator (void *obj
, scm_t_finalizer_proc proc
, void *data
)
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
,
91 &chained_data
->prev_data
);
95 shuffle_resuscitators_to_front (struct scm_t_chained_finalizer
*cd
)
97 while (cd
->prev
== chained_finalizer
)
99 struct scm_t_chained_finalizer
*prev
= cd
->prev_data
;
100 scm_t_finalizer_proc proc
= cd
->proc
;
101 void *data
= cd
->data
;
103 if (!prev
->resuscitating_p
)
106 cd
->resuscitating_p
= 1;
107 cd
->proc
= prev
->proc
;
108 cd
->data
= prev
->data
;
110 prev
->resuscitating_p
= 0;
119 scm_i_add_finalizer (void *obj
, scm_t_finalizer_proc proc
, void *data
)
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
,
128 &chained_data
->prev_data
);
129 shuffle_resuscitators_to_front (chained_data
);
135 static SCM finalizer_async_cell
;
138 run_finalizers_async_thunk (void)
140 finalization_count
+= GC_invoke_finalizers ();
141 return SCM_UNSPECIFIED
;
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.
150 queue_finalizer_async (void)
152 scm_i_thread
*t
= SCM_I_CURRENT_THREAD
;
153 static scm_i_pthread_mutex_t lock
= SCM_I_PTHREAD_MUTEX_INITIALIZER
;
155 scm_i_pthread_mutex_lock (&lock
);
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
)))
161 SCM_SETCDR (finalizer_async_cell
, t
->active_asyncs
);
162 t
->active_asyncs
= finalizer_async_cell
;
163 t
->pending_asyncs
= 1;
165 scm_i_pthread_mutex_unlock (&lock
);
171 #if SCM_USE_PTHREAD_THREADS
173 static int finalization_pipe
[2];
174 static scm_i_pthread_mutex_t finalization_thread_lock
=
175 SCM_I_PTHREAD_MUTEX_INITIALIZER
;
176 static pthread_t finalization_thread
;
177 static int finalization_thread_is_running
= 0;
180 notify_finalizers_to_run (void)
183 full_write (finalization_pipe
[1], &byte
, 1);
187 notify_about_to_fork (void)
190 full_write (finalization_pipe
[1], &byte
, 1);
193 struct finalization_pipe_data
201 read_finalization_pipe_data (void *data
)
203 struct finalization_pipe_data
*fdata
= data
;
205 fdata
->n
= read (finalization_pipe
[0], &fdata
->byte
, 1);
212 finalization_thread_proc (void *unused
)
216 struct finalization_pipe_data data
;
218 scm_without_guile (read_finalization_pipe_data
, &data
);
220 if (data
.n
<= 0 && data
.err
!= EINTR
)
222 perror ("error in finalization thread");
229 finalization_count
+= GC_invoke_finalizers ();
240 run_finalization_thread (void *arg
)
242 return scm_with_guile (finalization_thread_proc
, arg
);
246 start_finalization_thread (void)
248 scm_i_pthread_mutex_lock (&finalization_thread_lock
);
249 if (!finalization_thread_is_running
)
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
255 if (pthread_create (&finalization_thread
, NULL
,
256 run_finalization_thread
, NULL
))
257 perror ("error creating finalization thread");
259 finalization_thread_is_running
= 1;
261 scm_i_pthread_mutex_unlock (&finalization_thread_lock
);
265 stop_finalization_thread (void)
267 scm_i_pthread_mutex_lock (&finalization_thread_lock
);
268 if (finalization_thread_is_running
)
270 notify_about_to_fork ();
271 if (pthread_join (finalization_thread
, NULL
))
272 perror ("joining finalization thread");
273 finalization_thread_is_running
= 0;
275 scm_i_pthread_mutex_unlock (&finalization_thread_lock
);
279 spawn_finalizer_thread (void)
281 GC_set_finalizer_notifier (notify_finalizers_to_run
);
282 start_finalization_thread ();
285 #endif /* SCM_USE_PTHREAD_THREADS */
291 scm_i_finalizer_pre_fork (void)
293 #if SCM_USE_PTHREAD_THREADS
294 stop_finalization_thread ();
295 GC_set_finalizer_notifier (spawn_finalizer_thread
);
303 weak_pointer_ref (void *weak_pointer
)
305 return *(void **) weak_pointer
;
309 weak_gc_finalizer (void *ptr
, void *data
)
313 void (*callback
) (SCM
) = weak
[1];
315 val
= GC_call_with_alloc_lock (weak_pointer_ref
, &weak
[0]);
320 callback (SCM_PACK_POINTER (val
));
322 scm_i_set_finalizer (ptr
, weak_gc_finalizer
, data
);
325 /* CALLBACK will be called on OBJ, as long as OBJ is accessible. It
326 will be called from a finalizer, which may be from an async or from
329 As an implementation detail, the way this works is that we allocate
330 a fresh pointer-less object holding two words. We know that this
331 object should get collected the next time GC is run, so we attach a
332 finalizer to it so that we get a callback after GC happens.
334 The first word of the object holds a weak reference to OBJ, and the
335 second holds the callback pointer. When the callback is called, we
336 check if the weak reference on OBJ still holds. If it doesn't hold,
337 then OBJ is no longer accessible, and we're done. Otherwise we call
338 the callback and re-register a finalizer for our two-word GC object,
339 effectively resuscitating the object so that we will get a callback
342 We could use the scm_after_gc_hook, but using a finalizer has the
343 advantage of potentially running in another thread, decreasing pause
346 scm_i_register_weak_gc_callback (SCM obj
, void (*callback
) (SCM
))
348 void **weak
= GC_MALLOC_ATOMIC (sizeof (void*) * 2);
350 weak
[0] = SCM_UNPACK_POINTER (obj
);
351 weak
[1] = (void*)callback
;
352 GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak
, SCM2PTR (obj
));
354 scm_i_set_finalizer (weak
, weak_gc_finalizer
, NULL
);
361 scm_init_finalizers (void)
363 /* When the async is to run, the cdr of the pair gets set to the
364 asyncs queue of the current thread. */
365 finalizer_async_cell
=
366 scm_cons (scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
367 run_finalizers_async_thunk
),
369 GC_set_finalizer_notifier (queue_finalizer_async
);
373 scm_init_finalizer_thread (void)
375 #if SCM_USE_PTHREAD_THREADS
376 if (pipe2 (finalization_pipe
, O_CLOEXEC
) != 0)
378 GC_set_finalizer_notifier (spawn_finalizer_thread
);