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

Modified Files: integers.lisp Log Message: Added operators %bignum-addf and %bignum-addf-fixnum.

Date: Sat Jul 17 10:42:11 2004 Author: ffjeld

Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.71 movitz/losp/muerte/integers.lisp:1.72 --- movitz/losp/muerte/integers.lisp:1.71 Sat Jul 17 05:16:12 2004 +++ movitz/losp/muerte/integers.lisp Sat Jul 17 10:42:10 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.71 2004/07/17 12:16:12 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.72 2004/07/17 17:42:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -413,6 +413,84 @@ (: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))