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

[Frode Vatvedt Fjeld]

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

Modified Files:
	compiler.lisp 
Log Message:
More stuff about using ECX only as a scratch register (i.e. it can't
be used to hold pointer values that might be moved by GC).

Date: Thu Apr  1 12:27:03 2004
Author: ffjeld

Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.40 movitz/compiler.lisp:1.41
--- movitz/compiler.lisp:1.40	Wed Mar 31 21:09:26 2004
+++ movitz/compiler.lisp	Thu Apr  1 12:27:03 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.40 2004/04/01 02:09:26 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.41 2004/04/01 17:27:03 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -2433,7 +2433,7 @@
 	    pos)))))
 
 (defun compute-free-registers (pc distance funobj frame-map
-			       &key (free-registers '(:eax :ebx :ecx :edx)))
+			       &key (free-registers '(:ecx :eax :ebx :edx)))
   "Return set of free register, and whether there may be more registers
    free later, with a more specified frame-map."
   (loop with free-so-far = free-registers
@@ -2518,22 +2518,35 @@
 	       (distance (position load-instruction (cdr init-pc))))
 	  (multiple-value-bind (free-registers more-later-p)
 	      (and distance (compute-free-registers (cdr init-pc) distance funobj frame-map))
-	    (if (and (member :ecx free-registers)
+	    (let ((free-registers-no-ecx (remove :ecx free-registers)))
+	      (cond
+	       ((member binding-destination free-registers-no-ecx)
+		binding-destination)
+	       ((and (not (typep binding '(or fixed-required-function-argument
+					   register-required-function-argument)))
+		     (member binding-destination free-registers))
+		binding-destination)
+	       ((member init-with-register free-registers)
+		init-with-register)
+	       ((and (member :ecx free-registers)
 		     (not (typep binding 'function-argument))
 		     (or (eq :untagged-fixnum-ecx binding-destination)
 			 (eq :untagged-fixnum-ecx init-with-register)))
-		:untagged-fixnum-ecx
-	      (let ((free-registers (remove :ecx free-registers)))
-		(cond
-		 ((member binding-destination free-registers)
-		  binding-destination)
-		 ((member init-with-register free-registers)
-		  init-with-register)
-		 ((not (null free-registers))
-		  (first free-registers))
-		 (more-later-p
-		  (values nil :not-now))
-		 (t (values nil :never)))))))))
+		:untagged-fixnum-ecx)
+	       ((and (binding-store-type binding)
+		     (member :ecx free-registers)
+		     (not (typep binding '(or fixed-required-function-argument
+					   register-required-function-argument)))
+		     (multiple-value-call #'encoded-subtypep
+		       (values-list (binding-store-type binding))
+		       (type-specifier-encode '(or integer character))))
+		(warn "for ecX: ~S" binding)
+		:ecx)
+	       ((not (null free-registers-no-ecx))
+		(first free-registers-no-ecx))
+	       (more-later-p
+		(values nil :not-now))
+	       (t (values nil :never))))))))
      (t (values nil :never)))))
 
 (defun discover-variables (code function-env)
@@ -3050,7 +3063,7 @@
 		      ((:eax :single-value) nil)
 		      (:untagged-fixnum-ecx
 		       `((:movl :eax :ecx)
-			 (:sarl ,movitz:+movitz-fixnum-factor+ :ecx)))))
+			 (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)))))
 		   ((:ebx :ecx :edx)
 		    (assert (not indirect-p))
 		    (unless (eq result-mode lexb-location)
@@ -3059,7 +3072,7 @@
 			((:ebx :ecx :edx :esi) `((:movl ,lexb-location ,result-mode)))
 			(:untagged-fixnum-ecx
 			 `((:movl ,lexb-location :ecx)
-			   (:sarl ,movitz:+movitz-fixnum-factor+ :ecx))))))
+			   (:sarl ,movitz:+movitz-fixnum-shift+ :ecx))))))
 		   (:argument-stack
 		    (assert (<= 2 (function-argument-argnum lexb)) ()
 		      "lexical :argument-stack argnum can't be ~A." (function-argument-argnum lexb))
@@ -3132,8 +3145,6 @@
 		    `((:movl (:ebp ,(stack-frame-offset binding-location)) :eax)
 		      (:pushl (:eax -1)))
 		  (ecase binding-location
-;;;		  (:eax '((:pushl :eax)))
-;;;		  (:ebx '((:pushl :ebx)))
 		    (:argument-stack
 		     (assert (<= 2 (function-argument-argnum binding)) ()
 		       ":load-lexical argnum can't be ~A." (function-argument-argnum binding))
@@ -3150,8 +3161,8 @@
 		  (if (integerp binding-location)
 		      `((:pushl (:ebp ,(stack-frame-offset binding-location))))
 		    (ecase binding-location
-		      (:eax '((:pushl :eax)))
-		      (:ebx '((:pushl :ebx)))
+		      ((:eax :ebx :ecx :edx)
+		       `((:pushl ,binding-location)))
 		      (:argument-stack
 		       (assert (<= 2 (function-argument-argnum binding)) ()
 			 ":load-lexical argnum can't be ~A." (function-argument-argnum binding))
@@ -3254,7 +3265,7 @@
 	  (if (integerp location)
 	      `((:movl ,source (:ebp ,(stack-frame-offset location))))
 	    (ecase location
-	      ((:eax :ebx :edx)
+	      ((:eax :ebx :ecx :edx)
 	       (unless (eq source location)
 		 `((:movl ,source ,location))))
 	      (:argument-stack