Merge remote-tracking branch 'origin/stable-2.0'

[bpt/guile.git] / libguile / foreign.c

diff --git a/libguile/foreign.c b/libguile/foreign.c
index 973bfc3..bb88cf5 100644 (file)
--- 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;