[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