diff --git a/code/bignum.lisp b/code/bignum.lisp index dd195f381ccd9a445fb6e6a53c4d6ef381bae9fd..d051ae573dd6165db3cbdace6358f7856927ae98 100644 --- a/code/bignum.lisp +++ b/code/bignum.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bignum.lisp,v 1.18 1991/06/10 13:24:20 chiles Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bignum.lisp,v 1.19 1991/06/12 17:24:18 chiles Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1961,17 +1961,12 @@ IS LESS EFFICIENT BUT EASIER TO MAINTAIN. BILL SAYS THIS CODE CERTAINLY WORKS! (setf (%bignum-ref res i) (%bignum-ref x i))) (values 0 res))) (t - ;; SHIFT-AND-STORE-TRUNCATE-BUFFERS relies on this routine - ;; starting these buffers at five or greater. I think that's - ;; what Rob meant. ??? - (with-bignum-buffers ((*truncate-x* 5) - (*truncate-y* 5)) - (let ((y-shift (shift-y-for-truncate y))) - (multiple-value-bind (len-x len-y) - (shift-and-store-truncate-buffers - x len-x y len-y y-shift) - (declare (type bignum-index len-x len-y)) - (values (do-truncate len-x len-y) + (let ((len-x+1 (1+ len-x))) + (with-bignum-buffers ((*truncate-x* len-x+1) + (*truncate-y* (1+ len-y))) + (let ((y-shift (shift-y-for-truncate y))) + (shift-and-store-truncate-buffers x len-x y len-y y-shift) + (values (do-truncate len-x+1 len-y) ;; DO-TRUNCATE must execute first. (cond ((zerop y-shift) @@ -2201,58 +2196,18 @@ IS LESS EFFICIENT BUT EASIER TO MAINTAIN. BILL SAYS THIS CODE CERTAINLY WORKS! ;;; SHIFT-AND-STORE-TRUNCATE-BUFFERS -- Internal. ;;; ;;; Stores two bignums into the truncation bignum buffers, shifting them on the -;;; way in. This first makes sure the buffers are big enough and that the last -;;; element possibly needed is zero, in case we never store there. This -;;; assumes x and y are positive and at least two in length. Return the number -;;; of pertinent digits in each buffer, but make sure *truncate-x* has at least -;;; three digits. We also check for x and y having the same length because -;;; similar lengths make TRY-BIGNUM-TRUNCATE-GUESS index below 0 in x when -;;; doing the subtraction; just make sure x is one greater. +;;; way in. This assumes x and y are positive and at least two in length, and +;;; it assumes *truncate-x* and *truncate-y* are one digit longer than x and y. ;;; (defun shift-and-store-truncate-buffers (x len-x y len-y shift) (declare (type bignum-index len-x len-y) (type (integer 0 (#.digit-size)) shift)) - (macrolet ((frob (var len) - `(progn - (when (< (%bignum-length ,var) ,len) - (setf ,var (%allocate-bignum ,len))) - (setf (%bignum-ref ,var (1- ,len)) 0)))) - (multiple-value-bind - (buf-len-x buf-len-y) - (cond ((zerop shift) - (frob *truncate-x* len-x) - (frob *truncate-y* len-y) - (bignum-replace *truncate-x* x :end1 len-x) - (bignum-replace *truncate-y* y :end1 len-y) - (values len-x len-y)) - (t - (let ((len-x+1 (1+ len-x)) - (len-y+1 (1+ len-y))) - (declare (type bignum-index len-x+1 len-y+1)) - (frob *truncate-x* len-x+1) - (frob *truncate-y* len-y+1) - (values (bignum-ashift-left-unaligned x 0 shift len-x+1 - *truncate-x*) - (bignum-ashift-left-unaligned y 0 shift len-y+1 - *truncate-y*))))) - (declare (type bignum-index buf-len-x buf-len-y)) - (when (< buf-len-x 3) - ;; These two lines work because BIGNUM-TRUNCATE ensures - ;; *truncate-x* starts with at least five elements. I think - ;; that's what Rob meant. ??? - (assert (= buf-len-x 2)) - (setf (%bignum-ref *truncate-x* 2) 0) - (setf buf-len-x 3)) - (if (= buf-len-x buf-len-y) - (let ((buf-len-x+1 (1+ buf-len-x))) - (declare (type bignum-index buf-len-x+1)) - (when (< (%bignum-length *truncate-x*) buf-len-x+1) - (let ((old-x *truncate-x*)) - (setf *truncate-x* (%allocate-bignum buf-len-x+1)) - (bignum-replace *truncate-x* old-x :end1 buf-len-x))) - (setf (%bignum-ref *truncate-x* buf-len-x) 0) - (values buf-len-x+1 buf-len-y)) - (values buf-len-x buf-len-y))))) + (cond ((zerop shift) + (bignum-replace *truncate-x* x :end1 len-x) + (bignum-replace *truncate-y* y :end1 len-y)) + (t + (bignum-ashift-left-unaligned x 0 shift (1+ len-x) *truncate-x*) + (bignum-ashift-left-unaligned y 0 shift (1+ len-y) *truncate-y*))))