From: Christophe Rhodes <c.rhodes@gold.ac.uk>
Date: Fri, 6 Sep 2013 11:43:40 +0000 (+0100)
Subject: Fix for sb-gmp bignum result allocation (lp#1206191)
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=cd1c0c889786b8d43bfc22f0892a17f23c73ab3b;p=sbcl.git

Fix for sb-gmp bignum result allocation (lp#1206191)

Patch based on 59e72c69c00abf9095d82e9a7b65f9c1b54d105c from
<https://github.com/sfrank/sb-gmp> (thanks to Stephan Frank)
---

diff --git a/NEWS b/NEWS
index d54777d..b7cc955 100644
--- a/NEWS
+++ b/NEWS
@@ -14,6 +14,10 @@ changes relative to sbcl-1.1.11:
   * bug fix: (setf . a) is pprinted correctly (reported by Douglas Katzman).
   * bug fix: handle compiler-error in LOAD when it's not run from inside EVAL.
     (lp#1219601)
+  * bug fix: SB-GMP:MPZ-POW no longer segfaults given a non-bignum base.
+    (thanks to Stephan Frank)
+  * bug fix: space allocation of result bignums in SB-GMP is more accurate.
+    (thanks to Stephan Frank, lp#1206191)
   
 changes in sbcl-1.1.11 relative to sbcl-1.1.10:
   * enhancement: support building the manual under texinfo version 5.
diff --git a/contrib/sb-gmp/gmp.lisp b/contrib/sb-gmp/gmp.lisp
index 283db5a..50c4562 100644
--- a/contrib/sb-gmp/gmp.lisp
+++ b/contrib/sb-gmp/gmp.lisp
@@ -131,7 +131,7 @@ pre-allocated bignum. The allocated bignum-length must be (1+ COUNT)."
            (type (alien (* unsigned-long)) z)
            (type bignum-type b)
            (type bignum-index count))
-  (dotimes (i count (%normalize-bignum b count))
+  (dotimes (i count (%normalize-bignum b (1+ count)))
     (%bignum-set b i (deref z i))))
 
 (defun gmp-z-to-bignum-neg (z b count)
@@ -145,7 +145,7 @@ be (1+ COUNT)."
   (let ((carry 0)
         (add 1))
     (declare (type (mod 2) carry add))
-    (dotimes (i count b)
+    (dotimes (i count (%normalize-bignum b (1+ count)))
       (multiple-value-bind (value carry-tmp)
           (%add-with-carry
            (%lognot (deref z i)) add carry)
@@ -364,9 +364,9 @@ be (1+ COUNT)."
         collect size into sizes
         collect `(,gres (struct gmpint)) into declares
         collect `(__gmpz_init (addr ,gres)) into inits
-        collect `(,size (1+ (abs (slot ,gres 'mp_size))))
+        collect `(,size (abs (slot ,gres 'mp_size)))
           into resinits
-        collect `(,res (%allocate-bignum ,size))
+        collect `(,res (%allocate-bignum (1+ ,size)))
           into resinits
         collect `(setf ,res (if (minusp (slot ,gres 'mp_size)) ; check for negative result
                                 (gmp-z-to-bignum-neg (slot ,gres 'mp_d) ,res ,size)
diff --git a/contrib/sb-gmp/tests.lisp b/contrib/sb-gmp/tests.lisp
index ee3b627..2d47f0e 100644
--- a/contrib/sb-gmp/tests.lisp
+++ b/contrib/sb-gmp/tests.lisp
@@ -198,4 +198,17 @@
 
 (define-gmp-test (pow)
   (test-one-case 'expt 'mpz-pow
-                 16 3)) 
+                 16 3))
+
+(defun fac (n)
+  (loop for i from 1 to n
+        for fac = 1 then (* fac i)
+        finally (return fac)))
+
+(define-gmp-test (fac1)
+  (test-one-case 'fac 'mpz-fac
+                 6))
+
+(define-gmp-test (fac2)
+  (test-one-case 'fac 'mpz-fac
+                 63))