[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp

[Frode Vatvedt Fjeld]

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))