Changeset 15570


Ignore:
Timestamp:
Jan 8, 2013, 8:34:00 AM (6 years ago)
Author:
gb
Message:

Lose the (unused) local function MULTIPLY-UNSIGNED-BIGNUMS from
MULTIPLY-BIGNUMS.

Implement MULTIPLY-BIGNUM-AND-FIXNUM in terms of
%MULTIPLY-AND-ADD-FIXNUMS-LOOP; this seems to make the non-GC
time of (DOTIMES (I 1000) (FACT 1000)) about 3X faster.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/l0-bignum64.lisp

    r15377 r15570  
    801801(defun multiply-bignums (a b)
    802802  (let* ((signs-differ (not (eq (bignum-minusp a) (bignum-minusp b)))))
    803     (flet ((multiply-unsigned-bignums (a b)
    804              (let* ((len-a (%bignum-length a))
    805                     (len-b (%bignum-length b))
    806                     (len-res (+ len-a len-b))
    807                     (res (%allocate-bignum len-res)))
    808                (declare (bignum-index len-a len-b len-res))
    809                (dotimes (i len-a)
    810                  (declare (type bignum-index i))
    811                  (%multiply-and-add-loop a b res i len-b))
    812                res))
    813            (multiply-unsigned-bignums64 (a b)
     803    (flet ((multiply-unsigned-bignums64 (a b)
    814804             (let* ((len-a (ceiling (%bignum-length a) 2))
    815805                    (len-b (ceiling (%bignum-length b) 2))
     
    826816        (%normalize-bignum-macro res)))))
    827817
     818#+old
    828819(defun multiply-bignum-and-fixnum (bignum fixnum)
    829820  (declare (type bignum-type bignum) (fixnum fixnum))
     
    833824      (multiply-bignums bignum big-fix))))
    834825
    835 #+slower
    836826(defun multiply-bignum-and-fixnum (bignum fixnum)
    837827  (declare (type bignum-type bignum) (fixnum fixnum))
    838828  (if (eql fixnum 1)
    839829    bignum
    840     (if (eql fixnum target::target-most-negative-fixnum)
    841       (with-small-bignum-buffers ((big-fix fixnum))
    842         (multiply-bignums bignum big-fix))
    843       (let* ((big-len (%bignum-length bignum))
    844              (big-neg (bignum-minusp bignum))
    845              (signs-differ (not (eq big-neg (minusp fixnum)))))
    846         (flet ((multiply-unsigned-bignum-and-2-digit-fixnum (a len-a high low)
    847                  (declare (bignum-type a)
    848                           (bignum-element-type high low)
    849                           (bignum-index len-a)
    850                           (optimize (speed 3) (safety 0)))
    851                  (let* ((len-res (+ len-a 2))
    852                         (res (%allocate-bignum len-res)) )
    853                    (declare (bignum-index len-a  len-res))
    854                    (dotimes (i len-a)
    855                      (declare (type bignum-index i))
    856                      (let* ((carry-digit 0)
    857                             (x (bignum-ref a i))
    858                             (k i))
    859                        (declare (fixnum k))
    860                        (multiple-value-bind (big-carry res-digit)
    861                            (%multiply-and-add4 x
    862                                                low
    863                                                (bignum-ref res k)
    864                                                carry-digit)
    865                          (setf (bignum-ref res k) res-digit
    866                                carry-digit big-carry
    867                                k (1+ k)))
    868                        (multiple-value-bind (big-carry res-digit)
    869                            (%multiply-and-add4 x
    870                                                high
    871                                                (bignum-ref res k)
    872                                                carry-digit)
    873                          (setf (bignum-ref res k) res-digit
    874                                carry-digit big-carry
    875                                k (1+ k)))
    876                        (setf (bignum-ref res k) carry-digit)))
    877                    res))
    878                (multiply-unsigned-bignum-and-1-digit-fixnum (a len-a fix)
    879                  (declare (bignum-type a)
    880                           (bignum-element-type fix)
    881                           (bignum-index len-a)
    882                           (optimize (speed 3) (safety 0)))
    883                  (let* ((len-res (+ len-a 1))
    884                         (res (%allocate-bignum len-res)) )
    885                    (declare (bignum-index len-a  len-res))
    886                    (dotimes (i len-a)
    887                      (declare (type bignum-index i))
    888                      (let* ((carry-digit 0)
    889                             (x (bignum-ref a i))
    890                             (k i))
    891                        (declare (fixnum k))
    892                        (multiple-value-bind (big-carry res-digit)
    893                            (%multiply-and-add4 x
    894                                                fix
    895                                                (bignum-ref res k)
    896                                                carry-digit)
    897                          (setf (bignum-ref res k) res-digit
    898                                carry-digit big-carry
    899                                k (1+ k)))
    900                        (setf (bignum-ref res k) carry-digit)))
    901                    res)))
    902           (let* ((fixnum (if (< fixnum 0) (- fixnum) fixnum))
    903                  (low (logand (1- (ash 1 32)) fixnum))
    904                  (high (unless (<= (%fixnum-intlen fixnum) 32)
    905                          (ldb (byte 32 32) fixnum)))
    906                  (res (if big-neg
    907                         (let* ((neg-len (1+ big-len)))
    908                           (declare (type bignum-index neg-len))
    909                           (with-bignum-buffers ((neg neg-len))
    910                             (negate-bignum bignum nil neg)
    911                             (setq neg-len (%bignum-length bignum))
    912                             (if high
    913                               (multiply-unsigned-bignum-and-2-digit-fixnum
    914                                neg
    915                                neg-len
    916                                high
    917                                low)
    918                               (multiply-unsigned-bignum-and-1-digit-fixnum
    919                                neg
    920                                neg-len
    921                                low))))
    922                         (if high
    923                           (multiply-unsigned-bignum-and-2-digit-fixnum
    924                            bignum
    925                            big-len
    926                            high
    927                            low)
    928                           (multiply-unsigned-bignum-and-1-digit-fixnum
    929                            bignum
    930                            big-len
    931                            low)))))
    932             (if signs-differ (negate-bignum-in-place res))
    933             (%normalize-bignum-macro res)))))))
     830    (let* ((bignum-len (%bignum-length bignum))
     831           (bignum-plus-p (bignum-plusp bignum))
     832           (fixnum-plus-p (not (minusp fixnum)))
     833           (negate-res (neq bignum-plus-p fixnum-plus-p)))
     834      (declare (type bignum-type bignum)
     835               (type bignum-index bignum-len))
     836      (flet ((do-it (bignum fixnum  negate-res)
     837               (let* ((bignum-len (%bignum-length bignum))
     838                      (result (%allocate-bignum (the fixnum (+ bignum-len 2))))
     839                      (len64 (ash (1+ bignum-len) -1)))
     840                 (declare (type bignum-type bignum)
     841                          (type bignum-index bignum-len len64))
     842                 (%multiply-and-add-fixnum-loop len64 bignum fixnum result)
     843                 (when negate-res
     844                   (negate-bignum-in-place result))
     845                 (%normalize-bignum-macro result ))))
     846        (declare (dynamic-extent #'do-it))
     847        (if bignum-plus-p
     848          (do-it bignum (if fixnum-plus-p fixnum (- fixnum))  negate-res)
     849          (with-bignum-buffers ((b1 (the fixnum (1+ bignum-len))))
     850            (negate-bignum bignum nil b1)
     851            (do-it b1 (if fixnum-plus-p fixnum (- fixnum))  negate-res)))))))
    934852
    935853
Note: See TracChangeset for help on using the changeset viewer.