Re: [PATCH] Configure GMP to use GC allocation functions, remove bignum finalizers

[Mark H Weaver <mhw@netris.org>]

[-- Attachment #1: Type: text/plain, Size: 367 bytes --]

Here is a revised version of the patch, which fixes a typo in a comment
and a poorly chosen "what" tag for allocation.

Also, the definition of factorial in my email had a typo.  It should be:

  (define (factorial n)
    (define (fac n acc)
      (if (<= n 1)
        acc
        (fac (1- n) (* n acc))))
    (fac n 1))

Apologies for the sloppiness,

       Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Configure GMP to use GC allocation functions, remove bignum finalizers --]
[-- Type: text/x-diff, Size: 4104 bytes --]

From 2a8c5a5b464f2af723476585f620a108ac1cc37b Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Tue, 31 May 2011 15:26:41 -0400
Subject: [PATCH] Configure GMP to use GC allocation functions, remove bignum finalizers

* libguile/numbers.c (custom_gmp_malloc, custom_gmp_realloc,
  custom_gmp_free): New static functions used by GMP for allocation.
  These are just wrappers for scm_gc_malloc, scm_gc_realloc, and
  scm_gc_free.

  (scm_init_numbers): Use mp_set_memory_functions to configure GMP to
  use custom_gmp_{malloc,realloc,free} for memory allocation.

  (make_bignum): Allocate the mpz_t (and type tag) using scm_gc_malloc,
  so that the GC will see the pointer to the digits, which are now
  allocated using custom_gmp_malloc.  Previously,
  scm_gc_malloc_pointerless was used to allocate the mpz_t, and a
  finalizer was used to free the digits.

  (finalize_bignum): Remove this static function.

  (scm_bigprint): Use custom_gmp_free to deallocate the string returned
  by mpz_get_str.
---
 libguile/numbers.c |   53 ++++++++++++++++++++++++++++++++++++---------------
 1 files changed, 37 insertions(+), 16 deletions(-)

diff --git a/libguile/numbers.c b/libguile/numbers.c
index 5aeced6..d14e5ea 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -172,14 +172,32 @@ scm_from_complex_double (complex double z)
 static mpz_t z_negative_one;
 
 \f
-/* Clear the `mpz_t' embedded in bignum PTR.  */
-static void
-finalize_bignum (GC_PTR ptr, GC_PTR data)
+
+/* The next three functions (custom_gmp_*) are passed to
+   mp_set_memory_functions (in GMP) so that memory used by the digits
+   themselves are allocated by the garbage collector.  This is needed so
+   that GC will be run at appropriate times.  Otherwise, a program which
+   creates many large bignums would malloc a huge amount of memory
+   before the GC runs. */
+static void *
+custom_gmp_malloc (size_t alloc_size)
+{
+  /* Unfortunately we cannot safely use scm_gc_malloc_pointerless here,
+     because the GMP docs specifically warns that it may use allocated
+     blocks to hold pointers to other allocated blocks. */
+  return scm_gc_malloc (alloc_size, "gmp-internal");
+}
+
+static void *
+custom_gmp_realloc (void *old_ptr, size_t old_size, size_t new_size)
 {
-  SCM bignum;
+  return scm_gc_realloc (old_ptr, old_size, new_size, "gmp-internal");
+}
 
-  bignum = PTR2SCM (ptr);
-  mpz_clear (SCM_I_BIG_MPZ (bignum));
+static void
+custom_gmp_free (void *ptr, size_t size)
+{
+  scm_gc_free (ptr, size, "gmp-internal");
 }
 
 /* Return a new uninitialized bignum.  */
@@ -187,18 +205,12 @@ static inline SCM
 make_bignum (void)
 {
   scm_t_bits *p;
-  GC_finalization_proc prev_finalizer;
-  GC_PTR prev_finalizer_data;
 
   /* Allocate one word for the type tag and enough room for an `mpz_t'.  */
-  p = scm_gc_malloc_pointerless (sizeof (scm_t_bits) + sizeof (mpz_t),
-				 "bignum");
+  p = scm_gc_malloc (sizeof (scm_t_bits) + sizeof (mpz_t),
+		     "bignum");
   p[0] = scm_tc16_big;
 
-  GC_REGISTER_FINALIZER_NO_ORDER (p, finalize_bignum, NULL,
-				  &prev_finalizer,
-				  &prev_finalizer_data);
-
   return SCM_PACK (p);
 }
 
@@ -5360,9 +5372,10 @@ int
 scm_bigprint (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
   char *str = mpz_get_str (NULL, 10, SCM_I_BIG_MPZ (exp));
+  size_t len = (size_t) strlen (str);
   scm_remember_upto_here_1 (exp);
-  scm_lfwrite (str, (size_t) strlen (str), port);
-  free (str);
+  scm_lfwrite (str, len, port);
+  custom_gmp_free (str, len + 1);
   return !0;
 }
 /*** END nums->strs ***/
@@ -9668,6 +9681,14 @@ scm_init_numbers ()
 {
   int i;
 
+  /* IMPORTANT: mp_set_memory_functions _must_ be called before any GMP
+     functions are called, or else custom_gmp_realloc and/or
+     custom_gmp_free could be called on a memory block allocated with
+     plain malloc, which would be bad. */
+  mp_set_memory_functions (custom_gmp_malloc,
+			   custom_gmp_realloc,
+			   custom_gmp_free);
+
   mpz_init_set_si (z_negative_one, -1);
 
   /* It may be possible to tune the performance of some algorithms by using
-- 
1.7.1