Changeset 11141


Ignore:
Timestamp:
Oct 18, 2008, 1:01:33 AM (11 years ago)
Author:
gb
Message:

Define BIGNUM-REF and BIGNUM-SET as macros. Don't do the LOGAND
in BIGNUM-SET: the caller should do so if necessary, or depend
on (OPTIMIZE (SPEED 3) (SAFETY 0)) to simply store the low 32 bits
of fixnum there. (Need to ensure that ppc64 backend does this.)

Avoid some calls (%ADD-WITH-CARRY) that don't do much, do excessive
LOGANDing, and introduce some multiple-value overhead. (More to be
done here.)

Special-case bignum+fixnum addition, so that we don't have to
(stack-)cons a pseudo-bignum and loop. (Again, there may be more
to be done here; I'd guess that a lot of fixnums added to bignums
are tiny, e.g., 1).

[I thought that I'd checked this in a few days ago. Seems to help,
a little.]

File:
1 edited

Legend:

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

    r11111 r11141  
    142142;;; a) it's not -that- bad
    143143;;; b) it does some bounds/sanity checking, which isn't a bad idea.
    144 (eval-when (:compile-toplevel :execute)
    145   (declaim (inline bignum-ref bignum-set)))
    146 
    147 (defun bignum-ref (b i)
    148   (%typed-miscref :bignum b i))
    149 
    150 (defun bignum-set (b i val)
    151   (declare (fixnum val))
    152   (%typed-miscset :bignum b i (logand val all-ones-digit)))
     144
     145(defmacro bignum-ref (b i)
     146  `(%typed-miscref :bignum ,b ,i))
     147
     148(defmacro bignum-set (b i val)
     149  `(%typed-miscset :bignum ,b ,i ,val))
    153150
    154151
     
    178175    0))
    179176
     177         
    180178(defun %add-with-carry (a-digit b-digit carry-in)
    181179  (declare (fixnum a-digit b-digit carry-in))
     
    184182  (let* ((sum (+ carry-in (the fixnum (+ a-digit b-digit)))))
    185183    (declare (fixnum sum))
    186     (values (logand all-ones-digit sum) (logand 1 (ash sum -32)))))
     184    (values (logand all-ones-digit sum) (logand 1 (the fixnum (ash sum -32))))))
    187185
    188186(defun %subtract-with-borrow (a-digit b-digit borrow-in)
     
    214212  (let* ((len-a (%bignum-length a))
    215213         (len-b (%bignum-length b)))
    216     (declare (bignum-index len-a len-b))
     214    (declare (bignum-index len-a len-b)
     215             (optimize (speed 3) (safety 0)))
    217216    (when (> len-b len-a)
    218217      (rotatef a b)
     
    223222           (sign-b (%bignum-sign b)))
    224223        (dotimes (i len-b)
    225           (multiple-value-bind (result-digit carry-out)
    226               (%add-with-carry (bignum-ref a i) (bignum-ref b i) carry)
    227             (setf (bignum-ref res i) result-digit
    228                   carry carry-out)))
     224          (let* ((sum (+
     225                       (the fixnum (+ (the digit-type (bignum-ref a i))
     226                                      (the digit-type (bignum-ref b i))))
     227                       carry)))
     228            (declare (fixnum sum))
     229            (setf (bignum-ref res i) sum)
     230            (setq carry (logand 1 (the fixnum (ash sum -32))))))
    229231        (if (/= len-a len-b)
    230232          (finish-bignum-add  res carry a sign-b len-b len-a)
    231233          (setf (bignum-ref res len-a)
    232                 (%add-with-carry (%bignum-sign a) sign-b carry)))
     234                (+ (the fixnum carry)
     235                   (the fixnum (+ (the digit-type (%bignum-sign a))
     236                                  sign-b)))))
    233237        (%normalize-bignum-macro res))))
     238
     239(defun add-bignum-and-fixnum (bignum fixnum)
     240  (declare (bignum-type bignum)
     241           (fixnum fixnum)
     242           (optimize (speed 3) (safety 0)))
     243  (let* ((len-bignum (%bignum-length bignum))
     244         (len-res (1+ len-bignum))
     245         (res (%allocate-bignum len-res))
     246         (low (logand all-ones-digit fixnum))
     247         (high (logand all-ones-digit (the fixnum (ash fixnum -32)))))
     248    (declare (bignum-index len-bignum)
     249             (bignum-type res)
     250             (digit-type low high))
     251    (let* ((sum0 (+ (the digit-type (bignum-ref bignum 0)) low))
     252           (sum1 (+ (the fixnum (+ (the digit-type (bignum-ref bignum 1))
     253                                   high))
     254                    (the fixnum (logand 1 (ash sum0 -32)))))
     255           (carry (logand 1 (ash sum1 -32))))
     256      (declare (fixnum sum0 sum1) (digit-type carry))
     257      (setf (bignum-ref res 0) sum0
     258            (bignum-ref res 1) sum1)
     259      (if (> len-bignum 2)
     260        (finish-bignum-add  res carry bignum (ash fixnum (- (- target::nbits-in-word target::fixnumshift))) 2 len-bignum)
     261        (setf (bignum-ref res 2)
     262              (+ (the fixnum carry)
     263                 (the fixnum (+ (the digit-type (%bignum-sign bignum))
     264                                (the fixnum (ash fixnum (- (- target::nbits-in-word target::fixnumshift)))))))))
     265      (%normalize-bignum-macro res))))
     266
     267
     268
    234269
    235270
     
    237272;;; digit of A, propagating the carry.
    238273(defun finish-bignum-add (result carry a sign-b start end)
    239   (declare (type bignum-index start end))
    240   (do* ((i start (1+ i)))
     274  (declare (type bignum-index start end)
     275           (digit-type sign-b carry)
     276           (optimize (speed 3) (safety 0)))
     277  (do* ((i start (1+ i))
     278        (sign-b (logand all-ones-digit sign-b)))
    241279       ((= i end)
    242280        (setf (bignum-ref result end)
    243               (%add-with-carry (%sign-digit a end) sign-b carry)))
    244     (multiple-value-bind (result-digit carry-out)
    245         (%add-with-carry (bignum-ref a i) sign-b carry)
    246       (setf (bignum-ref result i) result-digit
    247             carry carry-out))))
     281              (the fixnum (+
     282                           (the fixnum (+ (the fixnum
     283                                            (logand all-ones-digit
     284                                                    (the fixnum
     285                                                      (%sign-digit a end))))
     286                                          sign-b))
     287                           carry))))
     288    (declare (fixnum i) (digit-type sign-b))
     289    (let* ((sum (the fixnum (+ (the fixnum (+ (bignum-ref a i)
     290                                              sign-b))
     291                               carry))))
     292      (declare (fixnum sum))
     293      (setf (bignum-ref result i) sum)
     294      (setq carry (logand 1 (the fixnum (ash sum -32)))))))
     295
     296
    248297
    249298
     
    260309
    261310(defun bignum-subtract-loop (a len-a b len-b res)
    262   (declare (bignum-index len-a len-b ))
     311  (declare (bignum-index len-a len-b )
     312           (optimize (speed 3) (safety 0)))
    263313  (let* ((len-res (%bignum-length res)))
    264314    (declare (bignum-index len-res))
     
    266316           (sign-a (%bignum-sign a))
    267317           (sign-b (%bignum-sign b)))
     318      (declare (digit-type borrow sign-a sign-b))
    268319      (dotimes (i (the bignum-index len-res))
    269320        (multiple-value-bind (result-digit borrow-out)
     
    943994(defun bignum-ashift-right (bignum x)
    944995  (declare (type bignum-type bignum)
    945            (fixnum x))
     996           (fixnum x)
     997           (optimize (speed 3) (safety 0)))
    946998  (let ((bignum-len (%bignum-length bignum)))
    947999    (declare (type bignum-index bignum-len))
     
    10481100         (res-len-1 (1- res-len))
    10491101         (res (or res (%allocate-bignum res-len))))
    1050     (declare (type bignum-index res-len res-len-1))
     1102    (declare (type bignum-index res-len res-len-1)
     1103             (optimize (speed 3) (safety 0)))
    10511104    (do ((i 0 i+1)
    10521105         (i+1 1 (1+ i+1))
Note: See TracChangeset for help on using the changeset viewer.