mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-02 07:40:30 +02:00
Code Activity

Move foreign pointers off scm_words

Browse source 
* libguile/foreign.h: Give pointers a struct type.  Adapt to use it
internally.
* libguile/foreign.c: Allocate pointers with scm_allocate_tagged.
This commit is contained in:
Andy Wingo 2025-06-24 09:27:44 +02:00
parent 61af4d201a
commit 0a5d2ffb1a
2 changed files with 73 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

50
libguile/foreign.c
View file

@ -120,64 +120,58 @@ static SCM cif_to_procedure (SCM cif, SCM func_ptr, int with_errno);
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)
static struct scm_pointer *
make_pointer (uintptr_t addr, size_t gc_object_count)
{
SCM ret = scm_words (scm_tc7_pointer | (extra_word_count << 16),
extra_word_count + 2);
SCM_SET_CELL_WORD_1 (ret, addr);
struct scm_pointer *ret = scm_allocate_tagged
(SCM_I_CURRENT_THREAD, sizeof (*ret) + gc_object_count * sizeof (SCM));
ret->tag_and_size = scm_tc7_pointer | (gc_object_count << 16);
ret->address = 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)
pointer_init_gc_object (struct scm_pointer *ptr, size_t idx, SCM val)
{
if (!(idx < pointer_extra_word_count (ptr)))
if (!(idx < scm_pointer_gc_object_count (ptr)))
abort ();
SCM_SET_CELL_OBJECT (ptr, idx + 2, val);
ptr->gc_objects[idx] = val;
}
static SCM
make_pointer_0 (uintptr_t addr)
{
if (!addr) abort ();
return make_pointer (addr, 0);
return scm_i_from_pointer (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;
struct scm_pointer *ret = make_pointer (addr, 1);
pointer_init_gc_object (ret, 0, obj);
return scm_i_from_pointer (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;
struct scm_pointer *ret = make_pointer (addr, 3);
pointer_init_gc_object (ret, 0, obj0);
pointer_init_gc_object (ret, 1, obj1);
pointer_init_gc_object (ret, 2, obj2);
return scm_i_from_pointer (ret);
}
static void
attach_finalizer (SCM ptr, SCM finalizer)
{
if (!SCM_POINTER_P (finalizer))
if (!scm_is_pointer (finalizer))
abort ();
scm_i_add_pointer_finalizer (SCM_I_CURRENT_THREAD, ptr, finalizer);
}
@ -1416,7 +1410,7 @@ scm_register_foreign (void)
"scm_init_foreign",
(scm_t_extension_init_func)scm_init_foreign,
NULL);
null_pointer = make_pointer (0, 0);
null_pointer = scm_i_from_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);
}