From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 1 Sep 2009 21:53:58 +0000 (+0200)
Subject: Fix leaky behavior of `scm_take_TAGvector ()'.
X-Git-Url: https://git.hcoop.net/bpt/guile.git/commitdiff_plain/d7e7a02a6251c8ed4f76933d9d30baeee3f599c0

Fix leaky behavior of `scm_take_TAGvector ()'.

* libguile/srfi-4.c (free_user_data): New function.

* libguile/srfi-4.i.c (scm_take_TAGvector): Register `free_user_data ()'
  as a finalizer for DATA.

* libguile/objcodes.c (scm_objcode_to_bytecode): Allocate with
  `scm_malloc ()' since the memory taken by `scm_take_u8vector ()' will
  eventually be free(3)d.

* libguile/vm.c (really_make_boot_program): Likewise.
---

diff --git a/libguile/objcodes.c b/libguile/objcodes.c
index 33ba296ea..be3423271 100644
--- a/libguile/objcodes.c
+++ b/libguile/objcodes.c
@@ -229,8 +229,8 @@ SCM_DEFINE (scm_objcode_to_bytecode, "objcode->bytecode", 1, 0, 0,
   SCM_VALIDATE_OBJCODE (1, objcode);
 
   len = sizeof(struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode);
-  /* FIXME:  Is `gc_malloc' ok here? */
-  u8vector = scm_gc_malloc (len, "objcode-u8vector");
+
+  u8vector = scm_malloc (len);
   memcpy (u8vector, SCM_OBJCODE_DATA (objcode), len);
 
   return scm_take_u8vector (u8vector, len);
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index de1130fb3..302414364 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -28,6 +28,7 @@
 
 #include "libguile/_scm.h"
 #include "libguile/__scm.h"
+#include "libguile/boehm-gc.h"
 #include "libguile/srfi-4.h"
 #include "libguile/bitvectors.h"
 #include "libguile/bytevectors.h"
@@ -281,6 +282,14 @@ uvec_assert (int type, SCM obj)
     scm_wrong_type_arg_msg (NULL, 0, obj, uvec_names[type]);
 }
 
+/* Invoke free(3) on DATA, a user-provided buffer passed to one of the
+   `scm_take_' functions.  */
+static void
+free_user_data (GC_PTR data, GC_PTR unused)
+{
+  free (data);
+}
+
 static SCM
 take_uvec (int type, void *base, size_t len)
 {
diff --git a/libguile/srfi-4.i.c b/libguile/srfi-4.i.c
index cecd6c638..098752ef2 100644
--- a/libguile/srfi-4.i.c
+++ b/libguile/srfi-4.i.c
@@ -126,8 +126,16 @@ SCM_DEFINE (F(scm_list_to_,TAG,vector), "list->"S(TAG)"vector", 1, 0, 0,
 SCM
 F(scm_take_,TAG,vector) (CTYPE *data, size_t n)
 {
-  scm_gc_register_collectable_memory ((void *)data, n*uvec_sizes[TYPE],
-				      uvec_names[TYPE]);
+  /* The manual says "Return a new uniform numeric vector [...] that uses the
+     memory pointed to by DATA".  We *have* to use DATA as the underlying
+     storage; thus we must register a finalizer to eventually free(3) it.  */
+  GC_finalization_proc prev_finalizer;
+  GC_PTR prev_finalization_data;
+
+  GC_REGISTER_FINALIZER_NO_ORDER (data, free_user_data, 0,
+				  &prev_finalizer,
+				  &prev_finalization_data);
+
   return take_uvec (TYPE, data, n);
 }
 
diff --git a/libguile/vm.c b/libguile/vm.c
index d215f4d79..95aaa4fe4 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -190,8 +190,7 @@ really_make_boot_program (long nargs)
     abort ();
   text[1] = (scm_t_uint8)nargs;
 
-  bp = scm_gc_malloc (sizeof (struct scm_objcode) + sizeof (text),
-                      "make-u8vector");
+  bp = scm_malloc (sizeof (struct scm_objcode) + sizeof (text));
   memcpy (bp->base, text, sizeof (text));
   bp->nargs = 0;
   bp->nrest = 0;