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:
parent
67c572ba6c
commit
3a6be6457d
1 changed files with 102 additions and 83 deletions
|
@ -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);
|
||||
}
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue