Changeset 13932
 Timestamp:
 Jul 7, 2010, 6:52:11 PM (9 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

branches/arm/level0/l0bignum32.lisp
r13889 r13932 1434 1434 1435 1435 1436 ;;; These are used by BIGNUMTRUNCATE and friends in the general case.1437 ;;;1438 (defvar *truncatex* nil)1439 (defvar *truncatey* nil)1440 1436 1441 1437 ;;; BIGNUMTRUNCATE  Public. … … 1477 1473 (let* ((lenx+1 (1+ lenx))) 1478 1474 (declare (fixnum lenx+1)) 1479 (withbignumbuffers (( *truncatex*lenx+1)1480 ( *truncatey*(the fixnum (1+ leny))))1475 (withbignumbuffers ((truncatex lenx+1) 1476 (truncatey (the fixnum (1+ leny)))) 1481 1477 (let ((yshift (shiftyfortruncate y))) 1482 (shiftandstoretruncatebuffers x lenx y leny yshift)1483 (values (dotruncate lenx+1 leny)1478 (shiftandstoretruncatebuffers truncatex truncatey x lenx y leny yshift) 1479 (values (dotruncate truncatex truncatey lenx+1 leny) 1484 1480 ;; DOTRUNCATE must execute first. 1485 1481 (when (not norem) … … 1487 1483 (let* ((reslen1 (1 leny))) 1488 1484 (declare (fixnum reslen1)) 1489 (bignumshiftrightloop1 yshift *truncatex* *truncatex*reslen1 0)))1490 (let ((theres (%normalizebignummacro *truncatex*)))1485 (bignumshiftrightloop1 yshift truncatex truncatey reslen1 0))) 1486 (let ((theres (%normalizebignummacro truncatex ))) 1491 1487 (if (not (fixnump theres)) 1492 1488 (if xplusp (copybignum theres) (negatebignum theres)) … … 1523 1519 (let* ((lenx+1 (1+ lenx))) 1524 1520 (declare (fixnum lenx+1)) 1525 (withbignumbuffers (( *truncatex*lenx+1)1526 ( *truncatey*(the fixnum (1+ leny))))1521 (withbignumbuffers ((truncatex lenx+1) 1522 (truncatey (the fixnum (1+ leny)))) 1527 1523 (let ((yshift (shiftyfortruncate y))) 1528 (shiftandstoretruncatebuffers x lenx y leny yshift)1529 (dotruncatenoquo lenx+1 leny)1524 (shiftandstoretruncatebuffers truncatex truncatey x lenx y leny yshift) 1525 (dotruncatenoquo truncatex truncatey lenx+1 leny) 1530 1526 (when (not (eql 0 yshift)) 1531 1527 (let* ((reslen1 (1 leny))) … … 1669 1665 1670 1666 1671 (defun dotruncate ( lenx leny)1667 (defun dotruncate (truncatex truncatey lenx leny) 1672 1668 (declare (type bignumindex lenx leny)) 1673 1669 (let* ((lenq ( lenx leny)) … … 1684 1680 (digitbind (h l) 1685 1681 (digitbind (guessh guessl) 1686 (bignumtruncateguess2 *truncatex* i *truncatey*(the fixnum (1 leny)))1687 (trybignumtruncateguess guessh guessl leny lowxdigit))1682 (bignumtruncateguess2 truncatex i truncatey (the fixnum (1 leny))) 1683 (trybignumtruncateguess truncatex truncatey guessh guessl leny lowxdigit)) 1688 1684 (%bignumset q k h l)) 1689 1685 (cond ((zerop k) (return)) … … 1697 1693 (%normalizebignummacro q)))) 1698 1694 1699 (defun dotruncatenoquo ( lenx leny)1695 (defun dotruncatenoquo (truncatex truncatey lenx leny) 1700 1696 (declare (type bignumindex lenx leny)) 1701 1697 (let* ((lenq ( lenx leny)) … … 1705 1701 (declare (type bignumindex lenq k i lowxdigit)) 1706 1702 (loop 1707 (digitbind (guessh guessl) (bignumtruncateguess2 *truncatex* i *truncatey*(the fixnum (1 leny)))1708 (trybignumtruncateguess guessh guessl leny lowxdigit)1703 (digitbind (guessh guessl) (bignumtruncateguess2 truncatex i truncatey (the fixnum (1 leny))) 1704 (trybignumtruncateguess truncatex truncatey guessh guessl leny lowxdigit) 1709 1705 (cond ((zerop k) (return)) 1710 1706 (t (decf k) … … 1726 1722 ;;; 1727 1723 1728 (defun trybignumtruncateguess ( guessh guessl leny lowxdigit)1724 (defun trybignumtruncateguess (truncatex truncatey guessh guessl leny lowxdigit) 1729 1725 (declare (type bignumindex lowxdigit leny)) 1730 1726 … … 1737 1733 ;; Multiply guess and divisor, subtracting from dividend simultaneously. 1738 1734 (dotimes (j leny) 1739 (multiplevaluebind (yh yl) (%bignumref *truncatey*j)1735 (multiplevaluebind (yh yl) (%bignumref truncatey j) 1740 1736 (multiplevaluebind (highh highl lowh lowl) 1741 1737 (%multiplyandadd1 guessh … … 1747 1743 (setq carrydigith highh 1748 1744 carrydigitl highl) 1749 (multiplevaluebind (txh txl) (%bignumref *truncatex*i)1745 (multiplevaluebind (txh txl) (%bignumref truncatex i) 1750 1746 (multiplevaluebind (xh xl tempborrow) 1751 1747 (%subtractwithborrow1 txh txl lowh lowl borrow) 1752 (%bignumset *truncatex*i xh xl)1748 (%bignumset truncatex i xh xl) 1753 1749 (setq borrow tempborrow))))) 1754 1750 (incf i)) 1755 (multiplevaluebind (txh txl) (%bignumref *truncatex*i)1751 (multiplevaluebind (txh txl) (%bignumref truncatex i) 1756 1752 (multiplevaluebind (xh xl) 1757 1753 (%subtractwithborrow1 txh txl carrydigith carrydigitl borrow) 1758 (%bignumset *truncatex*i xh xl)))1754 (%bignumset truncatex i xh xl))) 1759 1755 ;; See if guess is off by one, adding one Y back in if necessary. 1760 1756 1761 1757 1762 (cond ((%digit0orplusp *truncatex*i)1758 (cond ((%digit0orplusp truncatex i) 1763 1759 (values guessh guessl)) 1764 1760 (t … … 1766 1762 ;; in. The guess was one too large in magnitude. 1767 1763 ;; hmm  happens about 1.6% of the time 1768 (bignumaddloop+ lowxdigit *truncatex* *truncatey*leny)1764 (bignumaddloop+ lowxdigit truncatex truncatey leny) 1769 1765 (%subtractone guessh guessl) 1770 1766 ;(%subtractwithborrow guessh guessl 0 1 1) … … 1834 1830 ;;; it assumes *truncatex* and *truncatey* are one digit longer than x and y. 1835 1831 ;;; 1836 (defun shiftandstoretruncatebuffers ( x lenx y leny shift)1832 (defun shiftandstoretruncatebuffers (truncatex truncatey x lenx y leny shift) 1837 1833 (declare (type bignumindex lenx leny) 1838 1834 (type (integer 0 (#.digitsize)) shift)) 1839 1835 (cond ((eql 0 shift) 1840 (bignumreplace *truncatex*x :end1 lenx)1841 (bignumreplace *truncatey*y :end1 leny))1836 (bignumreplace truncatex x :end1 lenx) 1837 (bignumreplace truncatey y :end1 leny)) 1842 1838 (t 1843 (bignumashiftleftunaligned x 0 shift (the fixnum (1+ lenx)) *truncatex*)1844 (bignumashiftleftunaligned y 0 shift (the fixnum (1+ leny)) *truncatey*))))1839 (bignumashiftleftunaligned x 0 shift (the fixnum (1+ lenx)) truncatex) 1840 (bignumashiftleftunaligned y 0 shift (the fixnum (1+ leny)) truncatey)))) 1845 1841 1846 1842
Note: See TracChangeset
for help on using the changeset viewer.