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

Frode Vatvedt Fjeld ffjeld at common-lisp.net
Sat Jul 17 19:30:20 UTC 2004


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





More information about the Movitz-cvs mailing list