Changeset 5431

Timestamp:

Oct 29, 2006, 11:24:28 PM (18 years ago)

Author:

Gary Byers

Message:

Enable the destructive version of %BIGNUM-BIGNUM-GCD; conditionalize it
for 64-bit targets and provide/fix supporting functions. Seems to work
on ppc64; needs testing on x8664.

File:

• trunk/ccl/level-0/l0-bignum64.lisp (modified) (7 diffs)

trunk/ccl/level-0/l0-bignum64.lisp

@@ -1808 +1808 @@
 
 
-#+(or safe-but-slow 64-bit-target)
+#+safe-but-slow
+;;; This is basically the same algorithm as the "destructive"
+;;; version below; while it may be more readable, it's often
+;;; slower and conses too much to be at all viable.
 (defun %bignum-bignum-gcd (u v)
   (setq u (abs u) v (abs v))
@@ -1823 +1826 @@
     (setq u (ash u -1) v (ash v -1))))
 
-#-(or safe-but-slow 64-bit-target)
+
+
+
+#-safe-but-slow
 (progn
 (defun %positive-bignum-bignum-gcd (u0 v0)
@@ -1867 +1873 @@
                            v-trailing-0-bits)))
           (loop
-              (let* ((fix-u (and (= u-len 1)
-                                 (let* ((hi-u (bignum-ref-hi u 0)))
-                                   (declare (fixnum hi-u))
-                                   (= hi-u (the fixnum
-                                             (logand hi-u (ash most-positive-fixnum -16)))))
-                                 (uvref u 0)))
-                     (fix-v (and (= v-len 1)
-                                 (let* ((hi-v (bignum-ref-hi v 0)))
-                                   (declare (fixnum hi-v))
-                                   (= hi-v (the fixnum
-                                             (logand hi-v (ash most-positive-fixnum -16)))))
-                                 (uvref v 0))))
+              (let* ((fix-u (and (<= u-len 2)
+                                 (%maybe-fixnum-from-one-or-two-digit-bignum u)))
+                     (fix-v (and (<= v-len 2)
+                                 (%maybe-fixnum-from-one-or-two-digit-bignum v))))
                 (if fix-v
                   (if fix-u
@@ -1885 +1883 @@
                   (if fix-u
                     (return (ash (bignum-fixnum-gcd v fix-u) shift)))))
-              
               (let* ((signum (if (> u-len v-len)
                                1
@@ -1942 +1939 @@
 
 
+;;; nbits can't be zero here.
+(defun bignum-shift-right-loop-1 (nbits result source len idx)
+  (declare (type bignum-type result source)
+           (type (mod 32) nbits)
+           (type bignum-index idx len))
+  (let* ((rbits (logand 31 (the (mod 32) (- 32 nbits)))))
+    (declare (type (mod 32) rbits))
+    (dotimes (j len)
+      (let* ((x (bignum-ref source idx)))
+        (declare (type bignum-element-type x))
+        (setq x (%ilsr nbits x))
+        (incf idx)
+        (let* ((y (bignum-ref source idx)))
+          (declare (type bignum-element-type y))
+          (setq y (%ilsl rbits y))
+          (setf (bignum-ref result j)
+                (%logior x y)))))
+    (setf (bignum-ref result len)
+          (%ilsr nbits (bignum-ref source idx)))
+    idx))
+    
+
 (defun %logcount (bignum idx)
   (%ilogcount (bignum-ref bignum idx)))
@@ -2004 +2023 @@
               carry carry-out)))))
 
-(defun %bignum-count-trailing-zerop-bits (bignum)
+(defun %bignum-count-trailing-zero-bits (bignum)
   (let* ((count 0))
     (dotimes (i (%bignum-length bignum))
@@ -2012 +2031 @@
           (incf count 32)
           (progn
-            (do* ((bit 31 (1- bit)))
-                 ((zerop bit))
+            (dotimes (bit 32)
               (declare (type (mod 32) bit))
               (if (logbitp bit digit)