[movitz-cvs] CVS update: movitz/compiler.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv4621

Modified Files:
	compiler.lisp 
Log Message:
Working on add and type inference.

Date: Wed Aug 24 09:30:46 2005
Author: ffjeld

Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.156 movitz/compiler.lisp:1.157
--- movitz/compiler.lisp:1.156	Tue Aug 23 23:42:07 2005
+++ movitz/compiler.lisp	Wed Aug 24 09:30:45 2005
@@ -8,7 +8,7 @@
 ;;;; Created at:    Wed Oct 25 12:30:49 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: compiler.lisp,v 1.156 2005/08/23 21:42:07 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.157 2005/08/24 07:30:45 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -7023,26 +7023,75 @@
 				 (binding-lended-p (binding-target term1)))))
 	       (t (warn "Unknown fixnum add: ~S" instruction)
 		  (make-default-add))))
-	     #+ignore
 	     ((and (movitz-subtypep result-type '(unsigned-byte 32))
 		   (movitz-subtypep type0 'fixnum)
 		   (movitz-subtypep type1 'fixnum))
-	      (cond
-	       ((and (not (binding-lended-p (binding-target term0)))
-		     (not (binding-lended-p (binding-target term1)))
-		     (not (and (bindingp destination)
-			       (binding-lended-p (binding-target destination)))))
+	      (flet ((mkadd (src srcloc destreg)
+		       (if (integerp srcloc)
+			   `((:addl (:ebp ,(stack-frame-offset srcloc))
+				    ,destreg))
+			 (ecase (operator srcloc)
+			   ((:eax :ebx :ecx :edx)
+			    `((:addl ,srcloc ,destreg)))
+			   ((:argument-stack)
+			    `((:addl (:ebx ,(argument-stack-offset src))
+				     ,destreg)))
+			   ))))
 		(cond
 		 ((and (not constant0)
 		       (not constant1)
-		       (member destination-location '(:eax :ebx :edx)))
-		  (print-code instruction
-			      (append (make-load-lexical term0 :untagged-fixnum-ecx funobj nil frame-map)
-				      `((,*compiler-local-segment-prefix*
-					 :movl :ecx (:edi ,(global-constant-offset 'raw-scratch0))))
-				      )))
-		 (t (make-default-add))))
-	       (t (make-default-add))))
+		       (not (binding-lended-p (binding-target term0)))
+		       (not (binding-lended-p (binding-target term1)))
+		       (not (and (bindingp destination)
+				 (binding-lended-p (binding-target destination)))))
+		  (cond
+;;;		   ((and (not (eq loc0 :untagged-fixnum-ecx))
+;;;			 (not (eq loc1 :untagged-fixnum-ecx))
+;;;			 (not (eq destination-location :untagged-fixnum-ecx)))
+;;;		    (let ((tmpreg (cond
+;;;				   ((member destination-location '(:eax :ebx :ecx :edx))
+;;;				    destination-location)
+;;;				   ((some (lambda (x) (and (not (eq x loc0)) (not (eq x loc1))))
+;;;					  '(:ecx :edx :eax :ebx)))
+;;;				   (t :ecx)))
+;;;			  (no-overflow (gensym "no-overflow-")))
+;;;		      (append (make-load-lexical term0 :eax funobj nil frame-map)
+;;;			      (mkadd term1 loc1 :eax)
+;;;			      `((:jnc ',no-overflow)
+;;;				(:movl :eax :ecx)
+;;;				(:rcrl 1 :ecx)
+;;;				(:shrl 1 :ecx)
+;;;				(,*compiler-local-segment-prefix*
+;;;				 :call (:edi ,(global-constant-offset 'box-u32-ecx)))
+;;;				,no-overflow))
+		   (t (make-default-add)
+		      #+ignore
+		      (append (make-load-lexical term0 :untagged-fixnum-ecx funobj nil frame-map)
+			      `((,*compiler-local-segment-prefix*
+				 :movl :ecx (:edi ,(global-constant-offset 'raw-scratch0))))
+			      (make-load-lexical term1 :untagged-fixnum-ecx funobj nil frame-map)
+			      `((,*compiler-local-segment-prefix*
+				 :addl (:edi ,(global-constant-offset 'raw-scratch0)) :ecx))
+			      (if (integerp destination-location)
+				  `((,*compiler-local-segment-prefix*
+				     :call (:edi ,(global-constant-offset 'box-u32-ecx)))
+				    (:movl :eax (:ebp ,(stack-frame-offset destination-location))))
+				(ecase (operator destination-location)
+				  ((:untagged-fixnum-ecx)
+				   nil)
+				  ((:eax)
+				   `((,*compiler-local-segment-prefix*
+				      :call (:edi ,(global-constant-offset 'box-u32-ecx)))))
+				  ((:ebx :ecx :edx)
+				   `((,*compiler-local-segment-prefix*
+				      :call (:edi ,(global-constant-offset 'box-u32-ecx)))
+				     (:movl :eax ,destination-location)))
+				  ((:argument-stack)
+				   `((,*compiler-local-segment-prefix*
+				      :call (:edi ,(global-constant-offset 'box-u32-ecx)))
+				     (:movl :eax (:ebp ,(argument-stack-offset
+							 (binding-target destination))))))))))))
+		 (t (make-default-add)))))
 	     (t (make-default-add)))))))))
 
 ;;;;;;;