X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fbignum.lisp;h=054e6dfd17b56e6b77c5d4f31ea528c528358896;hb=f69e89d31d95c15469110ba75ae1da8ac7cf3f32;hp=5ee6b3ada06f4b32e60df4222f5c25c4f03d3f7f;hpb=2f10546bc6638ee44bd9ba317fab1dff81be1bb6;p=sbcl.git

diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp
index 5ee6b3a..054e6df 100644
--- a/src/code/bignum.lisp
+++ b/src/code/bignum.lisp
@@ -20,7 +20,7 @@
 ;;;       bignum-ashift-right bignum-ashift-left bignum-gcd
 ;;;       bignum-to-float bignum-integer-length
 ;;;       bignum-logical-and bignum-logical-ior bignum-logical-xor
-;;;       bignum-logical-not bignum-load-byte bignum-deposit-byte
+;;;       bignum-logical-not bignum-load-byte
 ;;;       bignum-truncate bignum-plus-p bignum-compare make-small-bignum
 ;;;       bignum-logbitp bignum-logcount
 ;;;   These symbols define the interface to the compiler:
@@ -28,7 +28,7 @@
 ;;;       %bignum-length %bignum-set-length %bignum-ref %bignum-set
 ;;;       %digit-0-or-plusp %add-with-carry %subtract-with-borrow
 ;;;       %multiply-and-add %multiply %lognot %logand %logior %logxor
-;;;       %fixnum-to-digit %floor %fixnum-digit-with-correct-sign %ashl
+;;;       %fixnum-to-digit %bigfloor %fixnum-digit-with-correct-sign %ashl
 ;;;       %ashr %digit-logical-shift-right))
 
 ;;; The following interfaces will either be assembler routines or code
@@ -67,7 +67,7 @@
 ;;;    LDB
 ;;;       %FIXNUM-TO-DIGIT
 ;;;    TRUNCATE
-;;;       %FLOOR
+;;;       %BIGFLOOR
 ;;;
 ;;; Note: The floating routines know about the float representation.
 ;;;
@@ -194,7 +194,7 @@
   (%lognot digit))
 
 ;;; Each of these does the digit-size unsigned op.
-#!-sb-fluid (declaim (inline %logand %logior %logxor))
+(declaim (inline %logand %logior %logxor))
 (defun %logand (a b)
   (declare (type bignum-element-type a b))
   (logand a b))
@@ -216,13 +216,13 @@
 ;;; dividing the first two as a 2*digit-size integer by the third.
 ;;;
 ;;; Do weird LET and SETQ stuff to bamboozle the compiler into allowing
-;;; the %FLOOR transform to expand into pseudo-assembler for which the
+;;; the %BIGFLOOR transform to expand into pseudo-assembler for which the
 ;;; compiler can later correctly allocate registers.
-(defun %floor (a b c)
+(defun %bigfloor (a b c)
   (let ((a a) (b b) (c c))
     (declare (type bignum-element-type a b c))
     (setq a a b b c c)
-    (%floor a b c)))
+    (%bigfloor a b c)))
 
 ;;; Convert the digit to a regular integer assuming that the digit is signed.
 (defun %fixnum-digit-with-correct-sign (digit)
@@ -270,7 +270,7 @@
 
 ;;; These take two digit-size quantities and compare or contrast them
 ;;; without wasting time with incorrect type checking.
-#!-sb-fluid (declaim (inline %digit-compare %digit-greater))
+(declaim (inline %digit-compare %digit-greater))
 (defun %digit-compare (x y)
   (= x y))
 (defun %digit-greater (x y)
@@ -339,14 +339,7 @@
 ;;; function to call that fixes up the result returning any useful values, such
 ;;; as the result. This macro may evaluate its arguments more than once.
 (sb!xc:defmacro subtract-bignum-loop (a len-a b len-b res len-res return-fun)
-  (let ((borrow (gensym))
-        (a-digit (gensym))
-        (a-sign (gensym))
-        (b-digit (gensym))
-        (b-sign (gensym))
-        (i (gensym))
-        (v (gensym))
-        (k (gensym)))
+  (with-unique-names (borrow a-digit a-sign b-digit b-sign i v k)
     `(let* ((,borrow 1)
             (,a-sign (%sign-digit ,a ,len-a))
             (,b-sign (%sign-digit ,b ,len-b)))
@@ -482,38 +475,30 @@
                                 from-end)
   (sb!int:once-only ((n-dest dest)
                      (n-src src))
-    (let ((n-start1 (gensym))
-          (n-end1 (gensym))
-          (n-start2 (gensym))
-          (n-end2 (gensym))
-          (i1 (gensym))
-          (i2 (gensym))
-          (end1 (or end1 `(%bignum-length ,n-dest)))
-          (end2 (or end2 `(%bignum-length ,n-src))))
-      (if from-end
-          `(let ((,n-start1 ,start1)
-                 (,n-start2 ,start2))
-             (do ((,i1 (1- ,end1) (1- ,i1))
-                  (,i2 (1- ,end2) (1- ,i2)))
-                 ((or (< ,i1 ,n-start1) (< ,i2 ,n-start2)))
-               (declare (fixnum ,i1 ,i2))
-               (%bignum-set ,n-dest ,i1
-                            (%bignum-ref ,n-src ,i2))))
-          (if (eql start1 start2)
-              `(let ((,n-end1 (min ,end1 ,end2)))
-                 (do ((,i1 ,start1 (1+ ,i1)))
-                     ((>= ,i1 ,n-end1))
-                   (declare (type bignum-index ,i1))
-                   (%bignum-set ,n-dest ,i1
-                                (%bignum-ref ,n-src ,i1))))
-              `(let ((,n-end1 ,end1)
-                     (,n-end2 ,end2))
-                 (do ((,i1 ,start1 (1+ ,i1))
-                      (,i2 ,start2 (1+ ,i2)))
-                     ((or (>= ,i1 ,n-end1) (>= ,i2 ,n-end2)))
-                   (declare (type bignum-index ,i1 ,i2))
-                   (%bignum-set ,n-dest ,i1
-                                (%bignum-ref ,n-src ,i2)))))))))
+    (with-unique-names (n-start1 n-end1 n-start2 n-end2 i1 i2)
+      (let ((end1 (or end1 `(%bignum-length ,n-dest)))
+            (end2 (or end2 `(%bignum-length ,n-src))))
+        (if from-end
+            `(let ((,n-start1 ,start1)
+                   (,n-start2 ,start2))
+              (do ((,i1 (1- ,end1) (1- ,i1))
+                   (,i2 (1- ,end2) (1- ,i2)))
+                  ((or (< ,i1 ,n-start1) (< ,i2 ,n-start2)))
+                (declare (fixnum ,i1 ,i2))
+                (%bignum-set ,n-dest ,i1 (%bignum-ref ,n-src ,i2))))
+            (if (eql start1 start2)
+                `(let ((,n-end1 (min ,end1 ,end2)))
+                  (do ((,i1 ,start1 (1+ ,i1)))
+                      ((>= ,i1 ,n-end1))
+                    (declare (type bignum-index ,i1))
+                    (%bignum-set ,n-dest ,i1 (%bignum-ref ,n-src ,i1))))
+                `(let ((,n-end1 ,end1)
+                       (,n-end2 ,end2))
+                  (do ((,i1 ,start1 (1+ ,i1))
+                       (,i2 ,start2 (1+ ,i2)))
+                      ((or (>= ,i1 ,n-end1) (>= ,i2 ,n-end2)))
+                    (declare (type bignum-index ,i1 ,i2))
+                    (%bignum-set ,n-dest ,i1 (%bignum-ref ,n-src ,i2))))))))))
 
 (sb!xc:defmacro with-bignum-buffers (specs &body body)
   #!+sb-doc
@@ -792,6 +777,7 @@
         (setf u-len (make-gcd-bignum-odd u u-len))
         (rotatef u v)
         (rotatef u-len v-len))
+      (bignum-abs-buffer u u-len)
       (setf u (copy-bignum u u-len))
       (let ((n (bignum-mod-gcd v1 u)))
         (ash (bignum-mod-gcd u1 (if (fixnump n)
@@ -908,13 +894,9 @@
 
 ;;; This negates bignum-len digits of bignum, storing the resulting digits into
 ;;; result (possibly EQ to bignum) and returning whatever end-carry there is.
-(sb!xc:defmacro bignum-negate-loop (bignum
-                                    bignum-len
-                                    &optional (result nil resultp))
-  (let ((carry (gensym))
-        (end (gensym))
-        (value (gensym))
-        (last (gensym)))
+(sb!xc:defmacro bignum-negate-loop
+    (bignum bignum-len &optional (result nil resultp))
+  (with-unique-names (carry end value last)
     `(let* (,@(if (not resultp) `(,last))
             (,carry
              (multiple-value-bind (,value ,carry)
@@ -1575,10 +1557,10 @@
         ;;; normalization.
         ;;;
         ;;; We don't have to worry about shifting Y to make its most
-        ;;; significant digit sufficiently large for %FLOOR to return
+        ;;; significant digit sufficiently large for %BIGFLOOR to return
         ;;; digit-size quantities for the q-digit and r-digit. If Y is
         ;;; a single digit bignum, it is already large enough for
-        ;;; %FLOOR. That is, it has some bits on pretty high in the
+        ;;; %BIGFLOOR. That is, it has some bits on pretty high in the
         ;;; digit.
         ((bignum-truncate-single-digit (x len-x y)
            (declare (type bignum-index len-x))
@@ -1616,7 +1598,7 @@
                         (values q rem)))
                    (declare (type bignum-element-type r))
                    (multiple-value-bind (q-digit r-digit)
-                       (%floor r (%bignum-ref x i) y)
+                       (%bigfloor r (%bignum-ref x i) y)
                      (declare (type bignum-element-type q-digit r-digit))
                      (setf (%bignum-ref q i) q-digit)
                      (setf r r-digit))))))
@@ -1644,7 +1626,7 @@
            (declare (type bignum-element-type y1 y2 x-i x-i-1 x-i-2))
            (let ((guess (if (%digit-compare x-i y1)
                             all-ones-digit
-                            (%floor x-i x-i-1 y1))))
+                            (%bigfloor x-i x-i-1 y1))))
              (declare (type bignum-element-type guess))
              (loop
                  (multiple-value-bind (high-guess*y1 low-guess*y1)
@@ -1791,7 +1773,7 @@
         ;;; digit-size.
         ;;;
         ;;; We shift y to make it sufficiently large that doing the
-        ;;; 2*digit-size by digit-size %FLOOR calls ensures the quotient and
+        ;;; 2*digit-size by digit-size %BIGFLOOR calls ensures the quotient and
         ;;; remainder fit in digit-size.
          (shift-y-for-truncate (y)
            (let* ((len (%bignum-length y))
@@ -1880,7 +1862,7 @@
 ;;;; There used to be a pile of code for implementing division for bignum digits
 ;;;; for machines that don't have a 2*digit-size by digit-size divide instruction.
 ;;;; This happens to be most machines, but all the SBCL ports seem to be content
-;;;; to implement SB-BIGNUM:%FLOOR as a VOP rather than using the code here.
+;;;; to implement SB-BIGNUM:%BIGFLOOR as a VOP rather than using the code here.
 ;;;; So it's been deleted.  --njf, 2007-02-04
 
 ;;;; general utilities