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
>From 2a8c5a5b464f2af723476585f620a108ac1cc37b Mon Sep 17 00:00:00 2001
From: Mark H Weaver <m...@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;
-/* 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
