From 5e97645b81e7a5be0089d9d112faf9a6fea6bc81 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 2 May 2025 15:06:41 +0200 Subject: Prepare SMOBs for new finalization API * libguile/atomics-internal.h (scm_atomic_set_bits): New routine. * libguile/smob.c (scm_i_finalize_smob): Use atomics to clear the first word instead of the GC alloc lock. (finalize_smob): Implement as shim. --- libguile/atomics-internal.h | 16 +++++++++++++++- libguile/smob.c | 45 +++++++++++++++++++-------------------------- libguile/smob.h | 4 +++- 3 files changed, 37 insertions(+), 28 deletions(-) diff --git a/libguile/atomics-internal.h b/libguile/atomics-internal.h index e15ea3564..048484576 100644 --- a/libguile/atomics-internal.h +++ b/libguile/atomics-internal.h @@ -1,7 +1,7 @@ #ifndef SCM_ATOMICS_INTERNAL_H #define SCM_ATOMICS_INTERNAL_H -/* Copyright 2016,2018-2019 +/* Copyright 2016,2018-2019,2025 Free Software Foundation, Inc. This file is part of Guile. @@ -58,6 +58,12 @@ scm_atomic_ref_pointer (void **loc) return (void *) atomic_load (a_loc); } static inline void +scm_atomic_set_bits (scm_t_bits *loc, scm_t_bits val) +{ + atomic_uintptr_t *a_loc = (atomic_uintptr_t *) loc; + atomic_store (a_loc, val); +} +static inline void scm_atomic_set_scm (SCM *loc, SCM val) { atomic_uintptr_t *a_loc = (atomic_uintptr_t *) loc; @@ -136,6 +142,14 @@ scm_atomic_ref_pointer (void **loc) return ret; } +static inline void +scm_atomic_set_bits (scm_t_bits *loc, scm_t_bits val) +{ + scm_i_pthread_mutex_lock (&atomics_lock); + *loc = val; + scm_i_pthread_mutex_unlock (&atomics_lock); +} + static inline void scm_atomic_set_scm (SCM *loc, SCM val) { diff --git a/libguile/smob.c b/libguile/smob.c index 8e4da9adb..4fba079d9 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -1,4 +1,4 @@ -/* Copyright 1995-1996,1998-2001,2003-2004,2006,2009-2013,2015,2018 +/* Copyright 1995-1996,1998-2001,2003-2004,2006,2009-2013,2015,2018,2025 Free Software Foundation, Inc. This file is part of Guile. @@ -29,6 +29,7 @@ #include #include "async.h" +#include "atomics-internal.h" #include "bdw-gc.h" #include "finalizers.h" #include "goops.h" @@ -375,47 +376,39 @@ scm_gc_mark (SCM o) } -static void* -clear_smobnum (void *ptr) +/* Finalize SMOB by calling its SMOB type's free function, if any. */ +void +scm_i_finalize_smob (struct scm_thread *thread, SCM smob) { - SCM smob; - scm_t_bits smobnum; + scm_t_bits *first_word_loc = SCM_UNPACK_POINTER (smob); + scm_t_bits first_word = *first_word_loc; + scm_t_bits smobnum = SCM_TC2SMOBNUM (first_word & SCM_SMOB_TYPE_MASK); - smob = SCM_PACK_POINTER (ptr); - - smobnum = SCM_SMOBNUM (smob); /* Frob the object's type in place, re-setting it to be the "finalized smob" type. This will prevent other routines from accessing its internals in a way that assumes that the smob data is valid. This is notably the case for SMOB's own "mark" procedure, if any; as the - finalizer runs without the alloc lock, it's possible for a GC to + finalizer is invoked by the mutator, it's possible for a GC to occur while it's running, in which case the object is alive and yet its data is invalid. */ - SCM_SET_SMOB_DATA_0 (smob, SCM_SMOB_DATA_0 (smob) & ~(scm_t_bits) 0xff00); - - return (void *) smobnum; -} - -/* Finalize SMOB by calling its SMOB type's free function, if any. */ -static void -finalize_smob (void *ptr, void *data) -{ - SCM smob; - scm_t_bits smobnum; - size_t (* free_smob) (SCM); - - smob = SCM_PACK_POINTER (ptr); - smobnum = (scm_t_bits) GC_call_with_alloc_lock (clear_smobnum, ptr); + scm_t_bits finalized_word = first_word & ~(scm_t_bits) 0xff00; + scm_atomic_set_bits (first_word_loc, finalized_word); #if 0 - printf ("finalizing SMOB %p (smobnum: %u)\n", ptr, smobnum); + printf ("finalizing SMOB %p (smobnum: %u)\n", first_word_loc, smobnum); #endif - free_smob = scm_smobs[smobnum].free; + size_t (* free_smob) (SCM) = scm_smobs[smobnum].free; if (free_smob) free_smob (smob); } +static void +finalize_smob (void *ptr, void *data) +{ + return scm_i_finalize_smob (SCM_I_CURRENT_THREAD, PTR2SCM (ptr)); +} + /* Return a SMOB with typecode TC. The SMOB type corresponding to TC may provide a custom mark procedure and it will be honored. */ SCM diff --git a/libguile/smob.h b/libguile/smob.h index d137b3278..990ac057b 100644 --- a/libguile/smob.h +++ b/libguile/smob.h @@ -1,7 +1,7 @@ #ifndef SCM_SMOB_H #define SCM_SMOB_H -/* Copyright 1995-1996,1998-2001,2004,2006,2009-2012,2015,2018 +/* Copyright 1995-1996,1998-2001,2004,2006,2009-2012,2015,2018,2025 Free Software Foundation, Inc. This file is part of Guile. @@ -256,6 +256,8 @@ SCM_API void scm_assert_smob_type (scm_t_bits tag, SCM val); SCM_API SCM scm_make_smob (scm_t_bits tc); +SCM_INTERNAL void scm_i_finalize_smob (struct scm_thread *thread, SCM obj); + SCM_API void scm_smob_prehistory (void); #endif /* SCM_SMOB_H */ -- cgit v1.2.3