wingo pushed a commit to branch wip-whippet
in repository guile.
commit 3a6be6457d3636c02d9c914b5210e52636a0417a
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Fri May 2 16:57:30 2025 +0200
Rework pointer implementation to avoid weak tables
Instead of storing keep-alive edges in weak tables, just add extra
fields on pointer objects.
* libguile/foreign.c (make_pointer, pointer_extra_word_count)
(set_pointer_extra_word, make_pointer_0, make_pointer_1, make_pointer_3)
(attach_finalizer): New helpers.
(scm_make_pointer): Never attach finalizers on the null pointer object.
(scm_from_pointer): Likewise.
(scm_bytevector_to_pointer, scm_procedure_to_pointer): Store keep-alive
links in extra words.
(scm_init_foreign, scm_register_foreign): Rework init for null, free,
and ffi_closure_free pointers.
---
libguile/foreign.c | 185 +++++++++++++++++++++++++++++------------------------
1 file changed, 102 insertions(+), 83 deletions(-)
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 280a21749..1760ac53d 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -52,7 +52,6 @@
#include "stacks.h"
#include "symbols.h"
#include "threads.h"
-#include "weak-table.h"
#include "version.h"
#include "foreign.h"
@@ -97,6 +96,8 @@ SCM_SYMBOL (sym_null_pointer_error, "null-pointer-error");
/* The cell representing the null pointer. */
static SCM null_pointer;
+static SCM free_pointer;
+static SCM ffi_closure_free_pointer;
/* Raise a null pointer dereference error. */
@@ -111,13 +112,71 @@ null_pointer_error (const char *func_name)
static SCM cif_to_procedure (SCM cif, SCM func_ptr, int with_errno);
-static SCM pointer_weak_refs = SCM_BOOL_F;
+/* Pointers can be allocated with a number of extra tail words. These
+ are useful when you have a pointer derived from an object; you need
+ the object to stay alive as long as the derived pointer is alive.
+ Storing the object in a slot of the derived pointer will allow for
+ this. */
+static SCM
+make_pointer (uintptr_t addr, size_t extra_word_count)
+{
+ SCM ret = scm_words (scm_tc7_pointer | (extra_word_count << 16),
+ extra_word_count + 2);
+ SCM_SET_CELL_WORD_1 (ret, addr);
+ return ret;
+}
+
+static size_t
+pointer_extra_word_count (SCM ptr)
+{
+ if (!SCM_POINTER_P (ptr))
+ abort ();
+
+ return SCM_CELL_WORD_0 (ptr) >> 16;
+}
+
+static void
+set_pointer_extra_word (SCM ptr, size_t idx, SCM val)
+{
+ if (!(idx < pointer_extra_word_count (ptr)))
+ abort ();
+
+ SCM_SET_CELL_OBJECT (ptr, idx + 2, val);
+}
+
+static SCM
+make_pointer_0 (uintptr_t addr)
+{
+ if (!addr) abort ();
+ return make_pointer (addr, 0);
+}
+static SCM
+make_pointer_1 (uintptr_t addr, SCM obj)
+{
+ if (!addr) abort ();
+ SCM ret = make_pointer (addr, 1);
+ set_pointer_extra_word (ret, 0, obj);
+ return ret;
+}
+
+static SCM
+make_pointer_3 (uintptr_t addr, SCM obj0, SCM obj1, SCM obj2)
+{
+ if (!addr) abort ();
+ SCM ret = make_pointer (addr, 3);
+ set_pointer_extra_word (ret, 0, obj0);
+ set_pointer_extra_word (ret, 1, obj1);
+ set_pointer_extra_word (ret, 2, obj2);
+ return ret;
+}
static void
-register_weak_reference (SCM from, SCM to)
+attach_finalizer (SCM ptr, SCM finalizer)
{
- scm_weak_table_putq_x (pointer_weak_refs, from, to);
+ if (!SCM_POINTER_P (finalizer))
+ abort ();
+ scm_i_add_pointer_finalizer (SCM_I_CURRENT_THREAD, ptr, finalizer);
}
void
@@ -127,6 +186,9 @@ scm_i_finalize_pointer (struct scm_thread *thread, SCM ptr,
SCM data)
finalizer (SCM_POINTER_VALUE (ptr));
}
+
+
+
SCM_DEFINE (scm_pointer_p, "pointer?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is a pointer object, "
@@ -142,22 +204,22 @@ SCM_DEFINE (scm_make_pointer, "make-pointer", 1, 1, 0,
"Return a foreign pointer object pointing to @var{address}. "
"If @var{finalizer} is passed, it should be a pointer to a "
"one-argument C function that will be called when the pointer "
- "object becomes unreachable.")
+ "object becomes unreachable. Finalizers will not be attached "
+ "to null pointers (foreign pointers whose value is 0).")
#define FUNC_NAME s_scm_make_pointer
{
- void *c_finalizer;
- uintptr_t c_address;
+ if (scm_is_eq (address, SCM_INUM0))
+ return null_pointer;
- c_address = scm_to_uintptr_t (address);
- if (SCM_UNBNDP (finalizer))
- c_finalizer = NULL;
- else
+ SCM ret = make_pointer_0 (scm_to_uintptr_t (address));
+
+ if (!SCM_UNBNDP (finalizer))
{
SCM_VALIDATE_POINTER (2, finalizer);
- c_finalizer = SCM_POINTER_VALUE (finalizer);
+ attach_finalizer (ret, finalizer);
}
- return scm_from_pointer ((void *) c_address, c_finalizer);
+ return ret;
}
#undef FUNC_NAME
@@ -173,19 +235,13 @@ scm_to_pointer (SCM pointer)
SCM
scm_from_pointer (void *ptr, scm_t_pointer_finalizer finalizer)
{
- SCM ret;
+ if (ptr == NULL)
+ return null_pointer;
- if (ptr == NULL && finalizer == NULL)
- ret = null_pointer;
- else
- {
- ret = scm_cell (scm_tc7_pointer, (scm_t_bits) ptr);
+ SCM ret = make_pointer_0 ((uintptr_t) ptr);
- if (finalizer)
- scm_i_add_pointer_finalizer (SCM_I_CURRENT_THREAD, ret,
- scm_cell (scm_tc7_pointer,
- (scm_t_bits) finalizer));
- }
+ if (finalizer)
+ attach_finalizer (ret, make_pointer_0 ((uintptr_t) finalizer));
return ret;
}
@@ -219,13 +275,7 @@ SCM_DEFINE (scm_scm_to_pointer, "scm->pointer", 1, 0, 0,
"of @var{scm}.")
#define FUNC_NAME s_scm_scm_to_pointer
{
- SCM ret;
-
- ret = scm_from_pointer ((void*) SCM_UNPACK (scm), NULL);
- if (SCM_HEAP_OBJECT_P (ret))
- register_weak_reference (ret, scm);
-
- return ret;
+ return make_pointer_1 (SCM_UNPACK (scm), scm);
}
#undef FUNC_NAME
@@ -307,22 +357,15 @@ SCM_DEFINE (scm_bytevector_to_pointer,
"bytevector->pointer", 1, 1, 0,
"is passed.")
#define FUNC_NAME s_scm_bytevector_to_pointer
{
- SCM ret;
- signed char *ptr;
- size_t boffset;
-
SCM_VALIDATE_BYTEVECTOR (1, bv);
- ptr = SCM_BYTEVECTOR_CONTENTS (bv);
+ signed char *ptr = SCM_BYTEVECTOR_CONTENTS (bv);
- if (SCM_UNBNDP (offset))
- boffset = 0;
- else
- boffset = scm_to_unsigned_integer (offset, 0,
- SCM_BYTEVECTOR_LENGTH (bv) - 1);
+ size_t boffset = SCM_UNBNDP (offset)
+ ? 0
+ : scm_to_unsigned_integer (offset, 0,
+ SCM_BYTEVECTOR_LENGTH (bv) - 1);
- ret = scm_from_pointer (ptr + boffset, NULL);
- register_weak_reference (ret, bv);
- return ret;
+ return make_pointer_1 ((uintptr_t)(ptr + boffset), bv);
}
#undef FUNC_NAME
@@ -1196,51 +1239,26 @@ SCM_DEFINE (scm_procedure_to_pointer,
"procedure->pointer", 3, 0, 0,
"type should match @var{return_type} and @var{arg_types}.\n")
#define FUNC_NAME s_scm_procedure_to_pointer
{
- SCM cif_pointer, pointer;
- ffi_cif *cif;
- ffi_status err;
- void *closure, *executable;
-
- cif = make_cif (return_type, arg_types, FUNC_NAME);
+ ffi_cif *cif = make_cif (return_type, arg_types, FUNC_NAME);
+ void *closure, *executable;
closure = ffi_closure_alloc (sizeof (ffi_closure), &executable);
- err = ffi_prep_closure_loc ((ffi_closure *) closure, cif,
- invoke_closure, SCM_UNPACK_POINTER (proc),
- executable);
+
+ ffi_status err = ffi_prep_closure_loc ((ffi_closure *) closure, cif,
+ invoke_closure,
+ SCM_UNPACK_POINTER (proc),
+ executable);
if (err != FFI_OK)
{
ffi_closure_free (closure);
SCM_MISC_ERROR ("`ffi_prep_closure_loc' failed", SCM_EOL);
}
- /* CIF points to GC-managed memory and it should remain as long as
- POINTER (see below) is live. Wrap it in a Scheme pointer to then
- hold a weak reference on it. */
- cif_pointer = scm_from_pointer (cif, NULL);
-
- if (closure == executable)
- {
- pointer = scm_from_pointer (executable, ffi_closure_free);
- register_weak_reference (pointer,
- scm_list_2 (proc, cif_pointer));
- }
- else
- {
- /* CLOSURE needs to be freed eventually. However, since
- `GC_all_interior_pointers' is disabled, we can't just register
- a finalizer for CLOSURE. Instead, we create a pointer object
- for CLOSURE, with a finalizer, and register it as a weak
- reference of POINTER. */
- SCM friend;
-
- pointer = scm_from_pointer (executable, NULL);
- friend = scm_from_pointer (closure, ffi_closure_free);
-
- register_weak_reference (pointer,
- scm_list_3 (proc, cif_pointer, friend));
- }
-
- return pointer;
+ SCM cif_pointer = make_pointer_0 ((uintptr_t) cif);
+ SCM closure_pointer = make_pointer_0 ((uintptr_t) closure);
+ attach_finalizer (closure_pointer, ffi_closure_free_pointer);
+ return make_pointer_3 ((uintptr_t) executable, proc, cif_pointer,
+ closure_pointer);
}
#undef FUNC_NAME
@@ -1382,7 +1400,6 @@ scm_init_foreign (void)
#endif
);
- null_pointer = scm_cell (scm_tc7_pointer, 0);
scm_define (sym_null, null_pointer);
}
@@ -1393,5 +1410,7 @@ scm_register_foreign (void)
"scm_init_foreign",
(scm_t_extension_init_func)scm_init_foreign,
NULL);
- pointer_weak_refs = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
+ null_pointer = make_pointer (0, 0);
+ free_pointer = make_pointer_0 ((uintptr_t) free);
+ ffi_closure_free_pointer = make_pointer_0 ((uintptr_t) ffi_closure_free);
}
