[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-serv6574

Modified Files:
	integers.lisp 
Log Message:
Implemented  addition of negative fixnums and positive bignums.

Date: Sat Jul 10 07:39:28 2004
Author: ffjeld

Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.41 movitz/losp/muerte/integers.lisp:1.42
--- movitz/losp/muerte/integers.lisp:1.41	Sat Jul 10 06:29:23 2004
+++ movitz/losp/muerte/integers.lisp	Sat Jul 10 07:39:28 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.41 2004/07/10 13:29:23 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.42 2004/07/10 14:39:28 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -28,6 +28,9 @@
 (deftype positive-bignum ()
   `(integer ,(1+ movitz:+movitz-most-positive-fixnum+) *))
 
+(deftype negative-fixnum ()
+  `(integer ,movitz:+movitz-most-negative-fixnum+ -1))
+
 (defmacro number-double-dispatch ((x y) &rest clauses)
   `(let ((x ,x) (y ,y))
      (cond ,@(loop for ((x-type y-type) . then-body) in clauses
@@ -123,7 +126,13 @@
 		((positive-bignum positive-fixnum)
 		 (funcall '+ y x))
 		((positive-fixnum positive-bignum)
-		 (with-inline-assembly (:returns :eax)
+		 (with-inline-assembly (:returns :eax :labels (retry-not-size1
+							       not-size1
+							       copy-bignum-loop
+							       add-bignum-loop
+							       add-bignum-done
+							       no-expansion
+							       pfix-pbig-done))
 		   (:compile-two-forms (:eax :ebx) y x)
 		   (:testl :ebx :ebx)
 		   (:jz 'pfix-pbig-done)
@@ -131,7 +140,7 @@
 		   (:cmpl 1 :ecx)
 		   (:jne 'not-size1)
 		   (:compile-form (:result-mode :ecx) x)
-		   (:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
+		   (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
 		   (:addl (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :ecx)
 		   (:jc 'retry-not-size1)
 		   (:call-global-constant box-u32-ecx)
@@ -160,7 +169,7 @@
 		   (:jnz 'copy-bignum-loop)
 
 		   (:load-lexical (:lexical-binding x) :ecx)
-		   (:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
+		   (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
 		   (:xorl :ebx :ebx)
 		   (:addl :ecx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
 		   (:jnc 'add-bignum-done)
@@ -177,6 +186,70 @@
 		   (:je 'no-expansion)
 		   (:addl #x10000 (:eax ,movitz:+other-type-offset+))
 		   (:addl ,movitz:+movitz-fixnum-factor+ :ecx)
+		  no-expansion
+		   (:call-global-constant cons-commit)
+		   (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
+				    (:edi (:edi-offset atomically-status))))
+		   
+		  pfix-pbig-done))
+		((negative-fixnum positive-bignum)
+		 (with-inline-assembly (:returns :eax :labels (retry-not-size1
+							       not-size1
+							       copy-bignum-loop
+							       add-bignum-loop
+							       add-bignum-done
+							       no-expansion
+							       pfix-pbig-done))
+		   (:compile-two-forms (:eax :ebx) y x)
+		   (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx)
+		   (:cmpl 1 :ecx)
+		   (:jne 'not-size1)
+		   (:compile-form (:result-mode :ecx) x)
+		   (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
+		   (:addl (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :ecx)
+		   (:call-global-constant box-u32-ecx)
+		   (:jmp 'pfix-pbig-done)
+		  retry-not-size1
+		   (:compile-form (:result-mode :eax) y)
+		   (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx)
+		  not-size1
+		   (:declare-label-set retry-jumper (retry-not-size1))
+		   (:locally (:movl :esp (:edi (:edi-offset atomically-esp))))
+		   (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t :esp)
+				      'retry-jumper)
+				    (:edi (:edi-offset atomically-status))))
+		   (:leal ((:ecx ,movitz:+movitz-fixnum-factor+) ,(* 1 movitz:+movitz-fixnum-factor+))
+			  :eax)		; Number of words
+		   (:call-global-constant get-cons-pointer)
+		   (:load-lexical (:lexical-binding y) :ebx) ; bignum
+		   (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx)
+		   (:leal ((:ecx #.movitz:+movitz-fixnum-factor+) ,movitz:+movitz-fixnum-factor+)
+			  :edx)
+		  copy-bignum-loop
+		   (:subl ,movitz:+movitz-fixnum-factor+ :edx)
+		   (:movl (:ebx :edx ,movitz:+other-type-offset+) :ecx)
+		   (:movl :ecx (:eax :edx ,movitz:+other-type-offset+))
+		   (:jnz 'copy-bignum-loop)
+
+		   (:load-lexical (:lexical-binding x) :ecx)
+		   (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
+		   (:xorl :ebx :ebx)	; counter
+		   (:negl :ecx)
+		   (:subl :ecx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
+		   (:jnc 'add-bignum-done)
+		  add-bignum-loop
+		   (:addl 4 :ebx)
+		   (:subl 1 (:eax :ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
+		   (:jc 'add-bignum-loop)
+		  add-bignum-done
+		   (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))
+			    :ecx)
+		   (:leal ((:ecx ,movitz:+movitz-fixnum-factor+) ,movitz:+movitz-fixnum-factor+)
+			  :ecx)		; result bignum word-size
+		   (:cmpl 0 (:eax :ecx ,(+ -8 (bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))))
+		   (:jne 'no-expansion)
+		   (:subl #x10000 (:eax ,movitz:+other-type-offset+))
+		   (:subl ,movitz:+movitz-fixnum-factor+ :ecx)
 		  no-expansion
 		   (:call-global-constant cons-commit)
 		   (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)