diff options
author | Andy Wingo <wingo@pobox.com> | 2025-05-02 16:57:30 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2025-05-02 17:02:11 +0200 |
commit | 3a6be6457d3636c02d9c914b5210e52636a0417a (patch) | |
tree | 438c74b86ad35ffe307480ae0a4d466fc29146f5 | |
parent | 67c572ba6c3a7887cfc11436062c6e8d9653e570 (diff) | |
download | guile-3a6be6457d3636c02d9c914b5210e52636a0417a.tar.gz |
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.
-rw-r--r-- | libguile/foreign.c | 185 |
1 files 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); } |