summaryrefslogtreecommitdiff
path: root/libguile/foreign.c
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2011-11-16 23:53:58 +0100
committerLudovic Courtès <ludo@gnu.org>2011-11-16 23:53:58 +0100
commit46d80cae0876b63b460b2997c7e3bfab94461166 (patch)
tree982ecbef9cd9208c21eb10ea3bda447cd8681d7b /libguile/foreign.c
parent449c4d44d0dd82749ca1eb8cfeb2ba025caf6eaa (diff)
downloadguile-46d80cae0876b63b460b2997c7e3bfab94461166.tar.gz
FFI: Hold a weak reference to the CIF made by `procedure->pointer'.
* libguile/foreign.c (scm_procedure_to_pointer): Keep a weak reference to CIF so that it is not reclaimed before POINTER. Before that it could be reclaimed and typically reused to store the CIF of another procedure with the same arity, leading to obscure wrong-type-arg errors.
Diffstat (limited to 'libguile/foreign.c')
-rw-r--r--libguile/foreign.c14
1 files changed, 11 insertions, 3 deletions
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 68e0efab5..021c183cf 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -1127,7 +1127,7 @@ 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 pointer;
+ SCM cif_pointer, pointer;
ffi_cif *cif;
ffi_status err;
void *closure, *executable;
@@ -1144,8 +1144,16 @@ SCM_DEFINE (scm_procedure_to_pointer, "procedure->pointer", 3, 0, 0,
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);
+ {
+ pointer = scm_from_pointer (executable, ffi_closure_free);
+ register_weak_reference (pointer, cif_pointer);
+ }
else
{
/* CLOSURE needs to be freed eventually. However, since
@@ -1158,7 +1166,7 @@ SCM_DEFINE (scm_procedure_to_pointer, "procedure->pointer", 3, 0, 0,
pointer = scm_from_pointer (executable, NULL);
friend = scm_from_pointer (closure, ffi_closure_free);
- register_weak_reference (pointer, friend);
+ register_weak_reference (pointer, scm_list_2 (cif_pointer, friend));
}
return pointer;