Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv24946

Modified Files: integers.lisp Log Message: Factored out bignum-related operators from integers.lisp to bignums.lisp.

Date: Sat Jul 17 12:30:20 2004 Author: ffjeld

Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.72 movitz/losp/muerte/integers.lisp:1.73 --- movitz/losp/muerte/integers.lisp:1.72 Sat Jul 17 10:42:10 2004 +++ movitz/losp/muerte/integers.lisp Sat Jul 17 12:30:20 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.72 2004/07/17 17:42:10 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.73 2004/07/17 19:30:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -23,7 +23,6 @@ (defconstant most-positive-fixnum #.movitz::+movitz-most-positive-fixnum+) (defconstant most-negative-fixnum #.movitz::+movitz-most-negative-fixnum+)

- ;;; Comparison

(define-primitive-function fast-compare-two-reals (n1 n2) @@ -413,84 +412,6 @@ (:xorl #xff00 (:eax #.movitz:+other-type-offset+)))))))

;;; Addition - -(defun %bignum-addf-fixnum (bignum delta) - "Destructively add a fixnum delta (negative or positive) to an (unsigned) bignum." - (check-type delta fixnum) - (check-type bignum bignum) - (macrolet - ((do-it () - `(with-inline-assembly (:returns :eax :labels (add-bignum-loop add-bignum-done)) - (:load-lexical (:lexical-binding delta) :ecx) - (:load-lexical (:lexical-binding bignum) :eax) - (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ebx) ; length - (:xorl :edx :edx) ; counter - (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) - (:jns 'positive-delta) - ;; negative-delta - (:negl :ecx) - (:subl :ecx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) - (:jnc 'add-bignum-done) - sub-bignum-loop - (:addl 4 :edx) - (:cmpl :edx :ebx) - (:je '(:sub-program (overflow) (:int 4))) - (:subl 1 (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) - (:jc 'sub-bignum-loop) - (:jmp 'add-bignum-done) - - positive-delta - (:addl :ecx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) - (:jnc 'add-bignum-done) - add-bignum-loop - (:addl 4 :edx) - (:cmpl :edx :ebx) - (:je '(:sub-program (overflow) (:int 4))) - (:addl 1 (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) - (:jc 'add-bignum-loop) - add-bignum-done))) - (do-it))) - -(defun %bignum-addf (bignum delta) - "Destructively add (abs delta) to bignum." - (check-type bignum bignum) - (etypecase delta - (positive-fixnum - (%bignum-addf-fixnum bignum delta)) - (negative-fixnum - (%bignum-addf-fixnum bignum (- delta))) - (bignum - (macrolet - ((do-it () - `(with-inline-assembly (:returns :eax) - not-size1 - (:load-lexical (:lexical-binding bignum) :eax) ; EAX = bignum - (:load-lexical (:lexical-binding delta) :ebx) ; EBX = delta - (:xorl :edx :edx) ; Counter - (:xorl :ecx :ecx) ; Carry - add-bignum-loop - (:cmpw :dx (:eax (:offset movitz-bignum length))) - (:jbe '(:sub-program (overflow) (:int 4))) - (:addl (:ebx :edx (:offset movitz-bignum :bigit0)) - :ecx) - (:jz 'carry+digit-overflowed) ; If CF=1, then ECX=0. - (:addl :ecx (:eax :edx (:offset movitz-bignum bigit0))) - carry+digit-overflowed - (:sbbl :ecx :ecx) - (:negl :ecx) ; ECX = Add's Carry. - (:addl 4 :edx) - (:cmpw :dx (:ebx (:offset movitz-bignum length))) - (:ja 'add-bignum-loop) - ;; Now, if there's a carry we must propagate it. - (:jecxz 'add-bignum-done) - carry-propagate-loop - (:cmpw :dx (:eax (:offset movitz-bignum length))) - (:jbe '(:sub-program (overflow) (:int 4))) - (:addl 4 :edx) - (:addl 1 (:eax :edx (:offset movitz-bignum bigit0 -4))) - (:jc 'carry-propagate-loop) - add-bignum-done))) - (do-it)))))

(defun + (&rest terms) (declare (without-check-stack-limit))