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

[Frode Vatvedt Fjeld]

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

Modified Files:
	compiler.lisp 
Log Message:
Depreacated the :untagged-fixnum-eax more. It's incompatible with
stack discipline.

Date: Thu Oct 21 22:38:28 2004
Author: ffjeld

Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.101 movitz/compiler.lisp:1.102
--- movitz/compiler.lisp:1.101	Mon Oct 11 15:44:04 2004
+++ movitz/compiler.lisp	Thu Oct 21 22:38:28 2004
@@ -8,7 +8,7 @@
 ;;;; Created at:    Wed Oct 25 12:30:49 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: compiler.lisp,v 1.101 2004/10/11 13:44:04 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.102 2004/10/21 20:38:28 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -51,7 +51,7 @@
   "Use this segment prefix when reading a lispval at (potentially)
 non-local locations.")
 
-(defparameter *compiler-nonlocal-lispval-write-segment-prefix* '(:fs-override)
+(defparameter *compiler-nonlocal-lispval-write-segment-prefix* '(:es-override)
   "Use this segment prefix when writing a lispval at (potentially)
 non-local locations.")
 
@@ -2607,7 +2607,10 @@
 			     (cdr instruction)
 			   (assert (not (getf jumper-sets name)) ()
 			     "Duplicate jumper declaration for ~S." name)
-			   (setf (getf jumper-sets name) set))))
+			   (setf (getf jumper-sets name) set)))
+			(t (when (listp instruction)
+			     (dolist (binding (find-read-bindings instruction))
+			       (process-binding binding)))))
 		   do (let ((sub (instruction-sub-program instruction)))
 			(when sub (process sub))))))
       (process code)
@@ -4801,6 +4804,7 @@
 	    (values (append code
 			    `((:load-lexical ,returns-provided ,desired-result)))
 		    desired-result))))
+	#+ignore
 	(:untagged-fixnum-eax
 	 (case returns-provided
 	   (:untagged-fixnum-eax
@@ -4977,7 +4981,8 @@
 	    (values code returns-provided))
 	   (:multiple-values
 	    (values code :values))
-	   (t (values (make-result-and-returns-glue :eax returns-provided code)
+	   (t (values (make-result-and-returns-glue :eax returns-provided code
+						    :type type)
 		      '(:values 1)))))
 	((:multiple-values :function)
 	 (case (operator returns-provided)
@@ -4990,16 +4995,21 @@
 	      (1 (values (append code '((:clc)))
 			 :multiple-values))
 	      ((nil) (values code :multiple-values))
-	      (t (values (append code (make-immediate-move (first (operands returns-provided)) :ecx) '((:stc)))
+	      (t (values (append code
+				 (make-immediate-move (first (operands returns-provided)) :ecx)
+				 '((:stc)))
 			 :multiple-values))))
 	   (t (values (append (make-result-and-returns-glue :eax
 							    returns-provided
-							    code)
+							    code
+							    :type type
+							    :provider provider
+							    :really-desired desired-result)
 			      '((:clc)))
 		      :multiple-values)))))
     (unless new-returns-provided
       (multiple-value-setq (new-code new-returns-provided glue-side-effects-p)
-	(case (operator returns-provided)
+	(ecase (operator returns-provided)
 	  (#.+boolean-modes+
 	   (make-result-and-returns-glue desired-result :eax
 					 (make-result-and-returns-glue :eax returns-provided code
@@ -5009,16 +5019,28 @@
 					 :type type
 					 :provider provider))
 	  (:untagged-fixnum-ecx
-	   (case (result-mode-type desired-result)
-	     ((:eax :single-value)
-	      (values (append code
-			      `((:call (:edi ,(global-constant-offset 'box-u32-ecx)))))
-		      desired-result))
-	     (t (make-result-and-returns-glue desired-result :eax
-					      (make-result-and-returns-glue :eax :untagged-fixnum-ecx code
-									    :provider provider
-									    :really-desired desired-result)
-					      :provider provider))))
+	   (let ((fixnump (subtypep type `(integer 0 ,+movitz-most-positive-fixnum+))))
+	     (cond
+	      ((and fixnump
+		    (member (result-mode-type desired-result) '(:eax :ebx :ecx :edx)))
+	       (values (append code
+			       `((:leal ((:ecx ,+movitz-fixnum-factor+))
+					,(result-mode-type desired-result))))
+		       desired-result))
+	      ((and (not fixnump)
+		    (member (result-mode-type desired-result) '(:eax :single-value)))
+	       (values (append code
+			       `((:call (:edi ,(global-constant-offset 'box-u32-ecx)))))
+		       desired-result))
+	      (t (make-result-and-returns-glue
+		  desired-result :eax
+		  (make-result-and-returns-glue :eax :untagged-fixnum-ecx code
+						:provider provider
+						:really-desired desired-result
+						:type type)
+		  :provider provider
+		  :type type)))))
+	  #+ignore
 	  (:untagged-fixnum-eax
 	   (make-result-and-returns-glue desired-result :eax
 					 (make-result-and-returns-glue :eax :untagged-fixnum-eax code
@@ -5542,7 +5564,7 @@
 			  (:lexical-binding
 			   result-mode)
 			  ((:ebx :ecx :edx :esi :push
-			    :untagged-fixnum-eax
+			    ;; :untagged-fixnum-eax
 			    :untagged-fixnum-ecx
 			    :boolean-branch-on-true
 			    :boolean-branch-on-false)