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

Modified Files:
	integers.lisp 
Log Message:
Re-working the compilation of addition. Now use a proper extended-code
instruction (which is like a "vop", I think).

Date: Sat Jul 10 06:29:23 2004
Author: ffjeld

Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.40 movitz/losp/muerte/integers.lisp:1.41
--- movitz/losp/muerte/integers.lisp:1.40	Thu Jul  8 14:51:08 2004
+++ movitz/losp/muerte/integers.lisp	Sat Jul 10 06:29:23 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.40 2004/07/08 21:51:08 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.41 2004/07/10 13:29:23 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -71,7 +71,10 @@
   (case (length operands)
     (0 0)
     (1 (first operands))
-    (2 `(+%2op ,(first operands) ,(second operands)))
+    #+ignore (2 `(+%2op ,(first operands) ,(second operands)))
+    (2 `(let ((x ,(first operands))
+	      (y ,(second operands)))
+	  (++%2op x y)))
     (t (let ((operands
 	      (loop for operand in operands
 		  if (movitz:movitz-constantp operand env)
@@ -1975,8 +1978,9 @@
 	 (movitz:movitz-eval integer env))) ; constant folding
    ((and (movitz:movitz-constantp size env)
 	 (movitz:movitz-constantp position env))
-    (let ((size (movitz:movitz-eval size env))
-	  (position (movitz:movitz-eval position env)))
+    (let* ((size (movitz:movitz-eval size env))
+	   (position (movitz:movitz-eval position env))
+	   (result-type `(unsigned-byte ,size)))
       (cond
        ((or (minusp size) (minusp position))
 	(error "Negative byte-spec for ldb."))
@@ -1984,7 +1988,7 @@
 	`(progn ,integer 0))
        ((<= (+ size position) (- 31 movitz:+movitz-fixnum-shift+))
 	`(with-inline-assembly (:returns :register
-					 :type (integer 0 ,(mask-field (byte size 0) -1)))
+					 :type ,result-type)
 	   (:compile-form (:result-mode :eax) ,integer)
 	   (:call-global-constant unbox-u32)
 	   (:andl ,(mask-field (byte size position) -1) :ecx)
@@ -1992,7 +1996,7 @@
 	       `((:shrl ,position :ecx)))
 	   (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) (:result-register))))
        ((<= (+ size position) 32)
-	`(with-inline-assembly-case ()
+	`(with-inline-assembly-case (:type ,result-type)
 	   (do-case (t :eax :labels (nix done))
 	     (:compile-form (:result-mode :eax) ,integer)
 	     ,@(cond