1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-05 03:30:24 +02:00

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.
This commit is contained in:
Andy Wingo 2025-05-02 16:57:30 +02:00
parent 67c572ba6c
commit 3a6be6457d

View file

@ -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
register_weak_reference (SCM from, SCM to)
set_pointer_extra_word (SCM ptr, size_t idx, SCM val)
{
scm_weak_table_putq_x (pointer_weak_refs, from, to);
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
attach_finalizer (SCM ptr, SCM finalizer)
{
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;
ffi_cif *cif = make_cif (return_type, arg_types, FUNC_NAME);
void *closure, *executable;
cif = make_cif (return_type, arg_types, FUNC_NAME);
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);
}