diff --git a/libguile/finalizers.c b/libguile/finalizers.c index 8b680d68c..d486ef842 100644 --- a/libguile/finalizers.c +++ b/libguile/finalizers.c @@ -165,6 +165,12 @@ smob_finalizer_trampoline (void *ptr, void *data) scm_i_finalize_smob (SCM_I_CURRENT_THREAD, PTR2SCM (ptr)); } +static void +port_finalizer_trampoline (void *ptr, void *data) +{ + scm_i_finalize_port (SCM_I_CURRENT_THREAD, PTR2SCM (ptr)); +} + SCM scm_i_add_struct_finalizer (struct scm_thread *thread, SCM obj) { @@ -185,6 +191,16 @@ scm_i_add_smob_finalizer (struct scm_thread *thread, SCM obj) return SCM_UNSPECIFIED; } +SCM +scm_i_add_port_finalizer (struct scm_thread *thread, SCM obj) +{ + if (!SCM_PORTP (obj)) + abort (); + + scm_i_set_finalizer (SCM2PTR (obj), port_finalizer_trampoline, NULL); + return SCM_UNSPECIFIED; +} + static void invoke_finalizer (void *obj, void *data) { diff --git a/libguile/finalizers.h b/libguile/finalizers.h index 6934a21d7..8c29fdb8a 100644 --- a/libguile/finalizers.h +++ b/libguile/finalizers.h @@ -39,6 +39,8 @@ SCM_INTERNAL SCM scm_i_add_struct_finalizer (struct scm_thread *thread, SCM obj); SCM_INTERNAL SCM scm_i_add_smob_finalizer (struct scm_thread *thread, SCM obj); +SCM_INTERNAL SCM scm_i_add_port_finalizer (struct scm_thread *thread, + SCM obj); SCM_INTERNAL void scm_i_finalizer_pre_fork (void); diff --git a/libguile/ports.c b/libguile/ports.c index 764fa9376..e979edada 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -1,4 +1,4 @@ -/* Copyright 1995-2001,2003-2004,2006-2019,2021,2024 +/* Copyright 1995-2001,2003-2004,2006-2019,2021,2024,2025 Free Software Foundation, Inc. This file is part of Guile. @@ -713,27 +713,16 @@ SCM scm_i_port_weak_set; /* Port finalization. */ static SCM close_port (SCM, int); - -static SCM -do_close (void *data) +void +scm_i_finalize_port (struct scm_thread *thread, SCM port) { - return close_port (SCM_PACK_POINTER (data), 0); -} - -/* Finalize the object (a port) pointed to by PTR. */ -static void -finalize_port (void *ptr, void *data) -{ - SCM port = SCM_PACK_POINTER (ptr); - if (!SCM_PORTP (port)) abort (); if (SCM_OPENP (port)) { SCM_SET_PORT_FINALIZING (port); - scm_internal_catch (SCM_BOOL_T, do_close, ptr, - scm_handle_by_message_noexit, NULL); + close_port (port, 0); scm_gc_ports_collected++; } } @@ -808,7 +797,7 @@ scm_c_make_port_with_encoding (scm_t_port_type *ptob, unsigned long mode_bits, if (SCM_PORT_TYPE (ret)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC) { - scm_i_set_finalizer (SCM2PTR (ret), finalize_port, NULL); + scm_i_add_port_finalizer (SCM_I_CURRENT_THREAD, ret); scm_weak_set_add_x (scm_i_port_weak_set, ret); } @@ -1161,7 +1150,7 @@ prepare_iconv_descriptors (SCM port, SCM precise_encoding) pt->output_cd = output_cd; /* Make sure this port has a finalizer. */ - scm_i_set_finalizer (SCM2PTR (port), finalize_port, NULL); + scm_i_add_port_finalizer (SCM_I_CURRENT_THREAD, port); return; diff --git a/libguile/ports.h b/libguile/ports.h index d481c2967..055e5b6b9 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -1,7 +1,7 @@ #ifndef SCM_PORTS_H #define SCM_PORTS_H -/* Copyright 1995-2001,2003-2004,2006,2008-2014,2018 +/* Copyright 1995-2001,2003-2004,2006,2008-2014,2018,2025 Free Software Foundation, Inc. This file is part of Guile. @@ -164,6 +164,7 @@ SCM_API SCM scm_c_make_port_with_encoding (scm_t_port_type *ptob, scm_t_bits stream); SCM_API SCM scm_c_make_port (scm_t_port_type *ptob, unsigned long mode_bits, scm_t_bits stream); +SCM_INTERNAL void scm_i_finalize_port (struct scm_thread *thread, SCM obj); /* Predicates. */ SCM_API SCM scm_port_p (SCM x);