Changeset 8529


Ignore:
Timestamp:
Feb 21, 2008, 9:23:02 AM (12 years ago)
Author:
gb
Message:

A couple of fixes in MULTIPLY-BIGNUM-AND-FIXNUM (including punting when
fixnum is most-negative-fixnum). Only broken on trunk,

File:
1 edited

Legend:

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

    r8405 r8529  
    779779(defun multiply-bignum-and-fixnum (bignum fixnum)
    780780  (declare (type bignum-type bignum) (fixnum fixnum))
    781   (let* ((big-len (%bignum-length bignum))
    782          (big-neg (bignum-minusp bignum))
    783          (signs-differ (not (eq big-neg (minusp fixnum)))))
    784     (flet ((multiply-unsigned-bignum-and-2-digit-fixnum (a len-a high low)
    785              (declare (bignum-type a)
    786                       (bignum-element-type high low)
    787                       (bignum-index len-a)
    788                       (optimize (speed 3) (safety 0)))
    789              (let* ((len-res (+ len-a 2))
    790                     (res (%allocate-bignum len-res)) )
    791                (declare (bignum-index len-a  len-res))
    792                (dotimes (i len-a)
    793                  (declare (type bignum-index i))
    794                  (let* ((carry-digit 0)
    795                         (x (bignum-ref a i))
    796                         (k i))
    797                    (declare (fixnum k))
    798                    (multiple-value-bind (big-carry res-digit)
    799                        (%multiply-and-add4 x
    800                                            low
    801                                            (bignum-ref res k)
    802                                            carry-digit)
    803                      (setf (bignum-ref res k) res-digit
    804                            carry-digit big-carry
    805                            k (1+ k)))
    806                    (multiple-value-bind (big-carry res-digit)
    807                        (%multiply-and-add4 x
    808                                            high
    809                                            (bignum-ref res k)
    810                                            carry-digit)
    811                      (setf (bignum-ref res k) res-digit
    812                            carry-digit big-carry
    813                            k (1+ k)))
    814                    (setf (bignum-ref res k) carry-digit)))
    815                res))
    816            (multiply-unsigned-bignum-and-1-digit-fixnum (a len-a fix)
    817              (declare (bignum-type a)
    818                       (bignum-element-type fix)
    819                       (bignum-index len-a)
    820                       (optimize (speed 3) (safety 0)))
    821              (let* ((len-res (+ len-a 1))
    822                     (res (%allocate-bignum len-res)) )
    823                (declare (bignum-index len-a  len-res))
    824                (dotimes (i len-a)
    825                  (declare (type bignum-index i))
    826                  (let* ((carry-digit 0)
    827                         (x (bignum-ref a i))
    828                         (k i))
    829                    (declare (fixnum k))
    830                    (multiple-value-bind (big-carry res-digit)
    831                        (%multiply-and-add4 x
    832                                            fix
    833                                            (bignum-ref res k)
    834                                            carry-digit)
    835                      (setf (bignum-ref res k) res-digit
    836                            carry-digit big-carry
    837                            k (1+ k)))
    838                    (setf (bignum-ref res k) carry-digit)))
    839                res)))
    840       (let* ((low (logand (1- (ash 1 32)) fixnum))
    841              (high (unless (<= (%fixnum-intlen fixnum) 32)
    842                      (ldb (byte 32 32) fixnum)))
    843              (res (if big-neg
    844                     (let* ((neg-len (1+ big-len)))
    845                       (declare (type bignum-index neg-len))
    846                       (with-bignum-buffers ((neg neg-len))
    847                         (negate-bignum bignum nil neg)
     781  (if (eql fixnum 1)
     782    bignum
     783    (if (eql fixnum target::target-most-negative-fixnum)
     784      (with-small-bignum-buffers ((big-fix fixnum))
     785        (multiply-bignums bignum big-fix))
     786      (let* ((big-len (%bignum-length bignum))
     787             (big-neg (bignum-minusp bignum))
     788             (signs-differ (not (eq big-neg (minusp fixnum)))))
     789        (flet ((multiply-unsigned-bignum-and-2-digit-fixnum (a len-a high low)
     790                 (declare (bignum-type a)
     791                          (bignum-element-type high low)
     792                          (bignum-index len-a)
     793                          (optimize (speed 3) (safety 0)))
     794                 (let* ((len-res (+ len-a 2))
     795                        (res (%allocate-bignum len-res)) )
     796                   (declare (bignum-index len-a  len-res))
     797                   (dotimes (i len-a)
     798                     (declare (type bignum-index i))
     799                     (let* ((carry-digit 0)
     800                            (x (bignum-ref a i))
     801                            (k i))
     802                       (declare (fixnum k))
     803                       (multiple-value-bind (big-carry res-digit)
     804                           (%multiply-and-add4 x
     805                                               low
     806                                               (bignum-ref res k)
     807                                               carry-digit)
     808                         (setf (bignum-ref res k) res-digit
     809                               carry-digit big-carry
     810                               k (1+ k)))
     811                       (multiple-value-bind (big-carry res-digit)
     812                           (%multiply-and-add4 x
     813                                               high
     814                                               (bignum-ref res k)
     815                                               carry-digit)
     816                         (setf (bignum-ref res k) res-digit
     817                               carry-digit big-carry
     818                               k (1+ k)))
     819                       (setf (bignum-ref res k) carry-digit)))
     820                   res))
     821               (multiply-unsigned-bignum-and-1-digit-fixnum (a len-a fix)
     822                 (declare (bignum-type a)
     823                          (bignum-element-type fix)
     824                          (bignum-index len-a)
     825                          (optimize (speed 3) (safety 0)))
     826                 (let* ((len-res (+ len-a 1))
     827                        (res (%allocate-bignum len-res)) )
     828                   (declare (bignum-index len-a  len-res))
     829                   (dotimes (i len-a)
     830                     (declare (type bignum-index i))
     831                     (let* ((carry-digit 0)
     832                            (x (bignum-ref a i))
     833                            (k i))
     834                       (declare (fixnum k))
     835                       (multiple-value-bind (big-carry res-digit)
     836                           (%multiply-and-add4 x
     837                                               fix
     838                                               (bignum-ref res k)
     839                                               carry-digit)
     840                         (setf (bignum-ref res k) res-digit
     841                               carry-digit big-carry
     842                               k (1+ k)))
     843                       (setf (bignum-ref res k) carry-digit)))
     844                   res)))
     845          (let* ((fixnum (if (< fixnum 0) (- fixnum) fixnum))
     846                 (low (logand (1- (ash 1 32)) fixnum))
     847                 (high (unless (<= (%fixnum-intlen fixnum) 32)
     848                         (ldb (byte 32 32) fixnum)))
     849                 (res (if big-neg
     850                        (let* ((neg-len (1+ big-len)))
     851                          (declare (type bignum-index neg-len))
     852                          (with-bignum-buffers ((neg neg-len))
     853                            (negate-bignum bignum nil neg)
     854                            (setq neg-len (%bignum-length bignum))
     855                            (if high
     856                              (multiply-unsigned-bignum-and-2-digit-fixnum
     857                               neg
     858                               neg-len
     859                               high
     860                               low)
     861                              (multiply-unsigned-bignum-and-1-digit-fixnum
     862                               neg
     863                               neg-len
     864                               low))))
    848865                        (if high
    849866                          (multiply-unsigned-bignum-and-2-digit-fixnum
    850                            neg
    851                            neg-len
     867                           bignum
     868                           big-len
    852869                           high
    853870                           low)
    854871                          (multiply-unsigned-bignum-and-1-digit-fixnum
    855                            neg
    856                            neg-len
    857                            low))))
    858                     (if high
    859                       (multiply-unsigned-bignum-and-2-digit-fixnum
    860                        bignum
    861                        big-len
    862                        high
    863                        low)
    864                       (multiply-unsigned-bignum-and-1-digit-fixnum
    865                        bignum
    866                        big-len
    867                        low)))))
    868         (if signs-differ (negate-bignum-in-place res))
    869         (%normalize-bignum-macro res)))))
     872                           bignum
     873                           big-len
     874                           low)))))
     875            (if signs-differ (negate-bignum-in-place res))
     876            (%normalize-bignum-macro res)))))))
    870877
    871878
Note: See TracChangeset for help on using the changeset viewer.