Changeset 13932 for branches


Ignore:
Timestamp:
Jul 7, 2010, 6:52:11 PM (9 years ago)
Author:
gb
Message:

arm-bignum.lisp: First stab at TRUNCATE-GUESS-LOOP; fix BIGNUM-SHIFT-LEFT-LOOP.
l0-bignum32.lisp: Don't use *TRUNCATE-X*/*TRUNCATE-Y*; pass extra arguments
around instead.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/arm/level-0/l0-bignum32.lisp

    r13889 r13932  
    14341434
    14351435
    1436 ;;; These are used by BIGNUM-TRUNCATE and friends in the general case.
    1437 ;;;
    1438 (defvar *truncate-x* nil)
    1439 (defvar *truncate-y* nil)
    14401436
    14411437;;; BIGNUM-TRUNCATE -- Public.
     
    14771473               (let* ((len-x+1 (1+ len-x)))
    14781474                 (declare (fixnum len-x+1))
    1479                  (with-bignum-buffers ((*truncate-x* len-x+1)
    1480                                        (*truncate-y* (the fixnum (1+ len-y))))
     1475                 (with-bignum-buffers ((truncate-x len-x+1)
     1476                                       (truncate-y (the fixnum (1+ len-y))))
    14811477                   (let ((y-shift (shift-y-for-truncate y)))
    1482                      (shift-and-store-truncate-buffers x len-x y len-y y-shift)
    1483                      (values (do-truncate len-x+1 len-y)
     1478                     (shift-and-store-truncate-buffers truncate-x truncate-y x len-x y len-y y-shift)
     1479                     (values (do-truncate truncate-x truncate-y len-x+1 len-y)
    14841480                             ;; DO-TRUNCATE must execute first.
    14851481                             (when (not no-rem)                               
     
    14871483                                 (let* ((res-len-1 (1- len-y)))
    14881484                                   (declare (fixnum res-len-1))
    1489                                    (bignum-shift-right-loop-1 y-shift *truncate-x* *truncate-x* res-len-1 0)))                               
    1490                                (let ((the-res (%normalize-bignum-macro *truncate-x* )))
     1485                                   (bignum-shift-right-loop-1 y-shift truncate-x truncate-y res-len-1 0)))                               
     1486                               (let ((the-res (%normalize-bignum-macro truncate-x )))
    14911487                                 (if (not (fixnump the-res))
    14921488                                   (if x-plusp (copy-bignum the-res) (negate-bignum the-res))
     
    15231519               (let* ((len-x+1 (1+ len-x)))
    15241520                 (declare (fixnum len-x+1))
    1525                  (with-bignum-buffers ((*truncate-x* len-x+1)
    1526                                        (*truncate-y* (the fixnum (1+ len-y))))
     1521                 (with-bignum-buffers ((truncate-x len-x+1)
     1522                                       (truncate-y (the fixnum (1+ len-y))))
    15271523                   (let ((y-shift (shift-y-for-truncate y)))
    1528                      (shift-and-store-truncate-buffers x len-x y len-y y-shift)
    1529                      (do-truncate-no-quo len-x+1 len-y)
     1524                     (shift-and-store-truncate-buffers truncate-x truncate-y x len-x y len-y y-shift)
     1525                     (do-truncate-no-quo truncate-x truncate-y len-x+1 len-y)
    15301526                     (when (not (eql 0 y-shift))                                 
    15311527                       (let* ((res-len-1 (1- len-y)))
     
    16691665
    16701666
    1671 (defun do-truncate (len-x len-y)
     1667(defun do-truncate (truncate-x truncate-y len-x len-y)
    16721668  (declare (type bignum-index len-x len-y))
    16731669  (let* ((len-q (- len-x len-y))
     
    16841680      (digit-bind (h l)
    16851681                  (digit-bind (guess-h guess-l)
    1686                               (bignum-truncate-guess-2 *truncate-x* i *truncate-y* (the fixnum (1- len-y)))                                 
    1687                     (try-bignum-truncate-guess guess-h guess-l len-y low-x-digit))
     1682                              (bignum-truncate-guess-2 truncate-x i truncate-y (the fixnum (1- len-y)))                                 
     1683                    (try-bignum-truncate-guess truncate-x truncate-y guess-h guess-l len-y low-x-digit))
    16881684        (%bignum-set q k h l))
    16891685      (cond ((zerop k) (return))
     
    16971693      (%normalize-bignum-macro q))))
    16981694
    1699 (defun do-truncate-no-quo (len-x len-y)
     1695(defun do-truncate-no-quo (truncate-x truncate-y len-x len-y)
    17001696  (declare (type bignum-index len-x len-y))
    17011697  (let* ((len-q (- len-x len-y))
     
    17051701    (declare (type bignum-index len-q k i  low-x-digit))
    17061702    (loop
    1707       (digit-bind (guess-h guess-l) (bignum-truncate-guess-2 *truncate-x* i *truncate-y* (the fixnum (1- len-y)))                                 
    1708         (try-bignum-truncate-guess guess-h guess-l len-y low-x-digit)
     1703      (digit-bind (guess-h guess-l) (bignum-truncate-guess-2 truncate-x i truncate-y (the fixnum (1- len-y)))                                 
     1704        (try-bignum-truncate-guess truncate-x truncate-y guess-h guess-l len-y low-x-digit)
    17091705        (cond ((zerop k) (return))
    17101706              (t (decf k)
     
    17261722;;;
    17271723
    1728 (defun try-bignum-truncate-guess (guess-h guess-l len-y low-x-digit)
     1724(defun try-bignum-truncate-guess (truncate-x truncate-y guess-h guess-l len-y low-x-digit)
    17291725  (declare (type bignum-index low-x-digit len-y))
    17301726
     
    17371733    ;; Multiply guess and divisor, subtracting from dividend simultaneously.
    17381734    (dotimes (j len-y)
    1739       (multiple-value-bind (y-h y-l) (%bignum-ref *truncate-y* j)
     1735      (multiple-value-bind (y-h y-l) (%bignum-ref truncate-y j)
    17401736        (multiple-value-bind (high-h high-l low-h low-l)
    17411737            (%multiply-and-add-1 guess-h
     
    17471743          (setq carry-digit-h high-h
    17481744                carry-digit-l high-l)
    1749           (multiple-value-bind (tx-h tx-l) (%bignum-ref *truncate-x* i)
     1745          (multiple-value-bind (tx-h tx-l) (%bignum-ref truncate-x i)
    17501746            (multiple-value-bind (x-h x-l temp-borrow)
    17511747                (%subtract-with-borrow-1 tx-h tx-l low-h low-l borrow)
    1752               (%bignum-set *truncate-x* i x-h x-l)
     1748              (%bignum-set truncate-x i x-h x-l)
    17531749              (setq borrow temp-borrow)))))
    17541750      (incf i))
    1755     (multiple-value-bind (tx-h tx-l) (%bignum-ref *truncate-x* i)
     1751    (multiple-value-bind (tx-h tx-l) (%bignum-ref truncate-x i)
    17561752      (multiple-value-bind (x-h x-l)
    17571753          (%subtract-with-borrow-1 tx-h tx-l carry-digit-h carry-digit-l borrow)
    1758         (%bignum-set *truncate-x* i x-h x-l)))
     1754        (%bignum-set truncate-x i x-h x-l)))
    17591755    ;; See if guess is off by one, adding one Y back in if necessary.
    17601756
    17611757
    1762     (cond ((%digit-0-or-plusp *truncate-x* i)
     1758    (cond ((%digit-0-or-plusp truncate-x i)
    17631759           (values guess-h guess-l))
    17641760          (t
     
    17661762           ;; in.  The guess was one too large in magnitude.
    17671763           ;; hmm - happens about 1.6% of the time
    1768            (bignum-add-loop-+ low-x-digit *truncate-x* *truncate-y* len-y)
     1764           (bignum-add-loop-+ low-x-digit truncate-x truncate-y len-y)
    17691765           (%subtract-one guess-h guess-l)
    17701766           ;(%subtract-with-borrow guess-h guess-l 0 1 1)
     
    18341830;;; it assumes *truncate-x* and *truncate-y* are one digit longer than x and y.
    18351831;;;
    1836 (defun shift-and-store-truncate-buffers (x len-x y len-y shift)
     1832(defun shift-and-store-truncate-buffers (truncate-x truncate-y x len-x y len-y shift)
    18371833  (declare (type bignum-index len-x len-y)
    18381834           (type (integer 0 (#.digit-size)) shift))
    18391835  (cond ((eql 0 shift)
    1840          (bignum-replace *truncate-x* x :end1 len-x)
    1841          (bignum-replace *truncate-y* y :end1 len-y))
     1836         (bignum-replace truncate-x x :end1 len-x)
     1837         (bignum-replace truncate-y y :end1 len-y))
    18421838        (t
    1843          (bignum-ashift-left-unaligned x 0 shift (the fixnum (1+ len-x)) *truncate-x*)
    1844          (bignum-ashift-left-unaligned y 0 shift (the fixnum (1+ len-y)) *truncate-y*))))
     1839         (bignum-ashift-left-unaligned x 0 shift (the fixnum (1+ len-x)) truncate-x)
     1840         (bignum-ashift-left-unaligned y 0 shift (the fixnum (1+ len-y)) truncate-y))))
    18451841
    18461842
Note: See TracChangeset for help on using the changeset viewer.