Changeset 5591


Ignore:
Timestamp:
Dec 4, 2006, 8:02:03 PM (14 years ago)
Author:
gb
Message:

BIGNUM-BIGNUM-GCD (whatever it's called): don't bother to shift by 0 bits.
Do shift the initial U if non-zero trailing 0 BITS (was testing for non-zero
trailing DIGITS.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/level-0/l0-bignum32.lisp

    r3140 r5591  
    19791979             (v-trailing-0-digits (ash v-trailing-0-bits -5)))
    19801980        (declare (fixnum u-trailing-0-bits v-trailing-0-bits))
    1981         (unless (zerop u-trailing-0-digits)
     1981        (unless (zerop u-trailing-0-bits)
    19821982          (bignum-shift-right-loop-1
    19831983           (logand u-trailing-0-bits 31)
     
    20022002                           v-trailing-0-bits)))
    20032003          (loop
    2004               (let* ((fix-u (and (= u-len 1)
    2005                                 (let* ((hi-u (%bignum-ref-hi u 0)))
    2006                                    (declare (fixnum hi-u))
    2007                                    (= hi-u (the fixnum
    2008                                              (logand hi-u (ash most-positive-fixnum -16)))))
    2009                                 (uvref u 0)))
    2010                      (fix-v (and (= v-len 1)
    2011                                 (let* ((hi-v (%bignum-ref-hi v 0)))
    2012                                    (declare (fixnum hi-v))
    2013                                    (= hi-v (the fixnum
    2014                                              (logand hi-v (ash most-positive-fixnum -16)))))
    2015                                 (uvref v 0))))
    2016                 (if fix-v
    2017                   (if fix-u
    2018                     (return (ash (%fixnum-gcd fix-u fix-v) shift))
    2019                     (return (ash (bignum-fixnum-gcd u fix-v) shift)))
    2020                   (if fix-u
    2021                     (return (ash (bignum-fixnum-gcd v fix-u) shift)))))
     2004            (let* ((fix-u (and (= u-len 1)
     2005                              (let* ((hi-u (%bignum-ref-hi u 0)))
     2006                                 (declare (fixnum hi-u))
     2007                                 (= hi-u (the fixnum
     2008                                           (logand hi-u (ash most-positive-fixnum -16)))))
     2009                              (uvref u 0)))
     2010                   (fix-v (and (= v-len 1)
     2011                              (let* ((hi-v (%bignum-ref-hi v 0)))
     2012                                 (declare (fixnum hi-v))
     2013                                 (= hi-v (the fixnum
     2014                                           (logand hi-v (ash most-positive-fixnum -16)))))
     2015                              (uvref v 0))))
     2016              (if fix-v
     2017                (if fix-u
     2018                  (return (ash (%fixnum-gcd fix-u fix-v) shift))
     2019                  (return (ash (bignum-fixnum-gcd u fix-v) shift)))
     2020                (if fix-u
     2021                  (return (ash (bignum-fixnum-gcd v fix-u) shift)))))
    20222022             
    2023               (let* ((signum (if (> u-len v-len)
    2024                                1
    2025                                (if (< u-len v-len)
    2026                                  -1
    2027                                  (bignum-compare u v)))))
    2028                 (declare (fixnum signum))
    2029                 (case signum
    2030                   (0                    ; (= u v)
    2031                    (if (zerop shift)
    2032                      (let* ((copy (%allocate-bignum u-len)))
    2033                        (bignum-replace copy u)
    2034                        (return copy))
    2035                      (return (ash u shift))))
    2036                   (1                    ; (> u v)
    2037                    (bignum-subtract-loop u u-len v v-len u)
    2038                    (%mostly-normalize-bignum-macro u)
    2039                    (setq u-len (%bignum-length u))
    2040                    (setq u-trailing-0-bits
    2041                          (%bignum-count-trailing-zero-bits u)
    2042                          u-trailing-0-digits
    2043                          (ash u-trailing-0-bits -5))
     2023            (let* ((signum (if (> u-len v-len)
     2024                             1
     2025                             (if (< u-len v-len)
     2026                               -1
     2027                               (bignum-compare u v)))))
     2028              (declare (fixnum signum))
     2029              (case signum
     2030                (0                      ; (= u v)
     2031                 (if (zerop shift)
     2032                   (let* ((copy (%allocate-bignum u-len)))
     2033                     (bignum-replace copy u)
     2034                     (return copy))
     2035                   (return (ash u shift))))
     2036                (1                      ; (> u v)
     2037                 (bignum-subtract-loop u u-len v v-len u)
     2038                 (%mostly-normalize-bignum-macro u)
     2039                 (setq u-len (%bignum-length u))
     2040                 (setq u-trailing-0-bits
     2041                       (%bignum-count-trailing-zero-bits u)
     2042                       u-trailing-0-digits
     2043                       (ash u-trailing-0-bits -5))
     2044                 (unless (zerop u-trailing-0-bits)
    20442045                   (%init-misc 0 u2)
    20452046                   (bignum-shift-right-loop-1
     
    20522053                   (rotatef u u2)
    20532054                   (%mostly-normalize-bignum-macro u)
    2054                    (setq u-len (%bignum-length u)))
    2055                   (t                    ; (> v u)
    2056                    (bignum-subtract-loop v v-len u u-len v)
    2057                    (%mostly-normalize-bignum-macro v)
    2058                    (setq v-len (%bignum-length v))
    2059                    (setq v-trailing-0-bits
    2060                          (%bignum-count-trailing-zero-bits v)
    2061                          v-trailing-0-digits
    2062                          (ash v-trailing-0-bits -5))
     2055                   (setq u-len (%bignum-length u))))
     2056                (t                      ; (> v u)
     2057                 (bignum-subtract-loop v v-len u u-len v)
     2058                 (%mostly-normalize-bignum-macro v)
     2059                 (setq v-len (%bignum-length v))
     2060                 (setq v-trailing-0-bits
     2061                       (%bignum-count-trailing-zero-bits v)
     2062                       v-trailing-0-digits
     2063                       (ash v-trailing-0-bits -5))
     2064                 (unless (zerop v-trailing-0-bits)
    20632065                   (%init-misc 0 v2)
    20642066                   (bignum-shift-right-loop-1
     
    20702072                   (rotatef v v2)
    20712073                   (%mostly-normalize-bignum-macro v)
    2072                    (setq v-len (%bignum-length v)))))))))))
     2074                   (setq v-len (%bignum-length v))))))))))))
    20732075
    20742076(defun %bignum-bignum-gcd (u v)
Note: See TracChangeset for help on using the changeset viewer.