/* Copyright 2012-2014,2018-2020,2022,2025 Free Software Foundation, Inc. This file is part of Guile. Guile 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. Guile 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 Guile. If not, see . */ #ifdef HAVE_CONFIG_H # include #endif #include #include #include #include #include #include #include "async.h" #include "atomics-internal.h" #include "bdw-gc.h" #include "eval.h" #include "extensions.h" #include "gc.h" #include "gsubr.h" #include "init.h" #include "numbers.h" #include "ports.h" #include "struct.h" #include "smob.h" #include "threads.h" #include "version.h" #include "finalizers.h" static int automatic_finalization_p = 1; static size_t finalization_count; static SCM run_finalizers_subr; enum finalizer_priority { FINALIZER_PRIORITY_GUARDIAN, FINALIZER_PRIORITY_DEFAULT }; 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); } static void struct_finalizer_trampoline (void *ptr, void *data) { scm_i_finalize_struct (SCM_I_CURRENT_THREAD, PTR2SCM (ptr)); } static void smob_finalizer_trampoline (void *ptr, void *data) { scm_i_finalize_smob (SCM_I_CURRENT_THREAD, PTR2SCM (ptr)); } SCM scm_i_add_struct_finalizer (struct scm_thread *thread, SCM obj) { if (!SCM_STRUCTP (obj)) abort (); scm_i_set_finalizer (SCM2PTR (obj), struct_finalizer_trampoline, NULL); return SCM_UNSPECIFIED; } SCM scm_i_add_smob_finalizer (struct scm_thread *thread, SCM obj) { if (!SCM_HAS_TYP7 (obj, scm_tc7_smob)) abort (); scm_i_set_finalizer (SCM2PTR (obj), smob_finalizer_trampoline, NULL); return SCM_UNSPECIFIED; } static void invoke_finalizer (void *obj, void *data) { scm_call_1 (PTR2SCM (data), PTR2SCM (obj)); } SCM_DEFINE_STATIC(scm_sys_add_finalizer, "%add-finalizer!", 3, 0, 0, (SCM obj, SCM proc, SCM priority), "Add a finalizer @var{proc} to object @var{obj}, with " "priority @var{priority}. Return the finalizer object.") #define FUNC_NAME s_scm_sys_add_finalizer { SCM_MAKE_VALIDATE (1, obj, HEAP_OBJECT_P); SCM_VALIDATE_PROC (2, proc); size_t c_priority = scm_to_unsigned_integer (priority, FINALIZER_PRIORITY_GUARDIAN, FINALIZER_PRIORITY_DEFAULT); (void) c_priority; scm_i_add_finalizer (SCM2PTR (obj), invoke_finalizer, SCM2PTR (proc)); return SCM_UNSPECIFIED; } #undef FUNC_NAME 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_thread *t = SCM_I_CURRENT_THREAD; /* Could be that the current thread is is NULL when 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) return; scm_system_async_mark_for_thread (run_finalizers_subr, scm_thread_handle (t)); } #if SCM_USE_PTHREAD_THREADS static int finalization_pipe[2] = { -1, -1 }; 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); } static void reset_finalization_pipe (void) { close (finalization_pipe[0]); close (finalization_pipe[1]); finalization_pipe[0] = -1; finalization_pipe[1] = -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 scm_i_pthread_t finalizer_thread; static void* finalization_thread_proc (void *unused) { scm_atomic_set_pointer ((void **) &finalizer_thread, (void *) pthread_self ()); while (1) { struct finalization_pipe_data data; scm_without_guile (read_finalization_pipe_data, &data); if (data.n == 0) /* The other end of the pipe was closed, so exit. */ return NULL; else if (data.n < 0) { if (data.err != EINTR) { errno = data.err; perror ("error in finalization thread"); return NULL; } } else { switch (data.byte) { case 0: scm_run_finalizers (); break; case 1: return NULL; default: abort (); } } } } int scm_i_is_finalizer_thread (struct scm_thread *t) { scm_i_pthread_t us = (scm_i_pthread_t) scm_atomic_ref_pointer ((void **) &finalizer_thread); return pthread_equal (t->pthread, us); } static void* run_finalization_thread (void *arg) { void *res = scm_with_guile (finalization_thread_proc, arg); scm_atomic_set_pointer ((void **) &finalizer_thread, NULL); return res; } static void start_finalization_thread (void) { scm_i_pthread_mutex_lock (&finalization_thread_lock); if (!finalization_thread_is_running) { assert (finalization_pipe[0] == -1); /* 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 (pipe2 (finalization_pipe, O_CLOEXEC) != 0) perror ("error creating finalization pipe"); else if (pthread_create (&finalization_thread, NULL, run_finalization_thread, NULL)) { reset_finalization_pipe (); perror ("error creating finalization thread"); } else { GC_set_finalizer_notifier (notify_finalizers_to_run); 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"); reset_finalization_pipe (); finalization_thread_is_running = 0; } scm_i_pthread_mutex_unlock (&finalization_thread_lock); } static void spawn_finalizer_thread (void) { start_finalization_thread (); } #else /* !SCM_USE_PTHREAD_THREADS */ int scm_i_is_finalizer_thread (struct scm_thread *t) { return 0; } #endif /* !SCM_USE_PTHREAD_THREADS */ 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 } 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 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 (); #endif } automatic_finalization_p = enabled_p; return was_enabled_p; } int scm_i_print_finalizer (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { scm_puts ("#", port); return 1; } int scm_run_finalizers (void) { int finalized = GC_invoke_finalizers (); finalization_count += finalized; return finalized; } static void scm_init_finalizers_module (void); void scm_register_finalizers (void) { scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, "scm_init_finalizers_module", (scm_t_extension_init_func)scm_init_finalizers_module, NULL); } 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. */ run_finalizers_subr = scm_c_make_gsubr ("%run-finalizers", 0, 0, 0, run_finalizers_async_thunk); if (automatic_finalization_p) GC_set_finalizer_notifier (queue_finalizer_async); } static void scm_init_finalizers_module (void) { #ifndef SCM_MAGIC_SNARFER #include "finalizers.x" #endif } void scm_init_finalizer_thread (void) { #if SCM_USE_PTHREAD_THREADS if (automatic_finalization_p) GC_set_finalizer_notifier (spawn_finalizer_thread); #endif }