wingo pushed a commit to branch wip-whippet
in repository guile.
commit 5e97645b81e7a5be0089d9d112faf9a6fea6bc81
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Fri May 2 15:06:41 2025 +0200
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 <stdlib.h>
#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 */
