diff options
author | Andy Wingo <wingo@pobox.com> | 2011-12-01 23:31:50 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-12-01 23:31:50 +0100 |
commit | b2208d2e987759270c712e35c8164394a47a52aa (patch) | |
tree | 1edd39e74a266fc53c075d328696e8fbf33eba5b /libguile/foreign.c | |
parent | 3dc9f41900a0e9f915da3aa1eea6e0fae829c40d (diff) | |
parent | 738c899e4c1ab9d25cfbcd1010f34e0cce400bca (diff) | |
download | guile-b2208d2e987759270c712e35c8164394a47a52aa.tar.gz |
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts:
configure.ac
libguile/fluids.c
libguile/gc.c
libguile/gc.h
libguile/objcodes.c
libguile/procprop.c
libguile/vm.c
module/ice-9/psyntax-pp.scm
module/ice-9/psyntax.scm
Diffstat (limited to 'libguile/foreign.c')
-rw-r--r-- | libguile/foreign.c | 16 |
1 files changed, 13 insertions, 3 deletions
diff --git a/libguile/foreign.c b/libguile/foreign.c index 973bfc3bd..bb88cf563 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -1124,7 +1124,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; @@ -1141,8 +1141,17 @@ 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, + scm_list_2 (proc, cif_pointer)); + } else { /* CLOSURE needs to be freed eventually. However, since @@ -1155,7 +1164,8 @@ 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_3 (proc, cif_pointer, friend)); } return pointer; |