1 /* Copyright (C) 2012, 2013, 2014 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
29 #include <full-write.h>
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"
39 static int automatic_finalization_p
= 1;
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 scm_run_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 scm_run_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 if (automatic_finalization_p
)
296 stop_finalization_thread ();
297 GC_set_finalizer_notifier (spawn_finalizer_thread
);
306 weak_pointer_ref (void *weak_pointer
)
308 return *(void **) weak_pointer
;
312 weak_gc_finalizer (void *ptr
, void *data
)
316 void (*callback
) (SCM
) = weak
[1];
318 val
= GC_call_with_alloc_lock (weak_pointer_ref
, &weak
[0]);
323 callback (SCM_PACK_POINTER (val
));
325 scm_i_set_finalizer (ptr
, weak_gc_finalizer
, data
);
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
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.
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
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
349 scm_i_register_weak_gc_callback (SCM obj
, void (*callback
) (SCM
))
351 void **weak
= GC_MALLOC_ATOMIC (sizeof (void*) * 2);
353 weak
[0] = SCM_UNPACK_POINTER (obj
);
354 weak
[1] = (void*)callback
;
355 GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak
, SCM2PTR (obj
));
357 scm_i_set_finalizer (weak
, weak_gc_finalizer
, NULL
);
362 scm_set_automatic_finalization_enabled (int enabled_p
)
364 int was_enabled_p
= automatic_finalization_p
;
366 if (enabled_p
== was_enabled_p
)
367 return was_enabled_p
;
369 if (!scm_initialized_p
)
371 automatic_finalization_p
= enabled_p
;
372 return was_enabled_p
;
377 #if SCM_USE_PTHREAD_THREADS
378 if (pipe2 (finalization_pipe
, O_CLOEXEC
) != 0)
380 GC_set_finalizer_notifier (spawn_finalizer_thread
);
382 GC_set_finalizer_notifier (queue_finalizer_async
);
387 GC_set_finalizer_notifier (0);
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;
398 automatic_finalization_p
= enabled_p
;
400 return was_enabled_p
;
404 scm_run_finalizers (void)
406 int finalized
= GC_invoke_finalizers ();
408 finalization_count
+= finalized
;
417 scm_init_finalizers (void)
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
),
426 if (automatic_finalization_p
)
427 GC_set_finalizer_notifier (queue_finalizer_async
);
431 scm_init_finalizer_thread (void)
433 #if SCM_USE_PTHREAD_THREADS
434 if (automatic_finalization_p
)
436 if (pipe2 (finalization_pipe
, O_CLOEXEC
) != 0)
438 GC_set_finalizer_notifier (spawn_finalizer_thread
);