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

[Frode Vatvedt Fjeld]

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

Modified Files:
	compiler.lisp 
Log Message:
Fixed a nasty compiler bug that would let two function parameters be
assigned to the same register. By some weird accident this bug didn't
seem to do much actual harm, but the potential was certainly there.

Date: Fri Apr 16 15:20:46 2004
Author: ffjeld

Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.48 movitz/compiler.lisp:1.49
--- movitz/compiler.lisp:1.48	Thu Apr 15 15:58:20 2004
+++ movitz/compiler.lisp	Fri Apr 16 15:20:46 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.48 2004/04/15 19:58:20 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.49 2004/04/16 19:20:46 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -2451,11 +2451,13 @@
 	  (destructuring-bind (binding &key init-with-register init-with-type
 					    protect-registers protect-carry)
 	      (cdr i)
-	    (declare (ignore binding protect-carry init-with-type))
+	    (declare (ignore protect-carry init-with-type))
 	    (when init-with-register
 	      (setf free-so-far (remove-if (lambda (x)
-					     (or (eq x init-with-register)
-						 (member x protect-registers)))
+					     (if (new-binding-located-p binding frame-map)
+						 (eq x (new-binding-location binding frame-map))
+					       (or (eq x init-with-register)
+						   (member x protect-registers))))
 					   free-so-far)))))
 	 (t (case (instruction-is i)
 	      ((nil :call)
@@ -2476,8 +2478,7 @@
 		 (remove-if (lambda (r)
 			      (tree-search i r))
 			    free-so-far)))
-	      ((:load-constant :load-lexical :store-lexical :init-lexvar
-		:cons-get :endp :incf-lexvar)
+	      ((:load-constant :load-lexical :store-lexical :cons-get :endp :incf-lexvar :init-lexvar)
 	       (assert (gethash (instruction-is i) *extended-code-expanders*))
 	       (unless (can-expand-extended-p i frame-map)
 		 (return (values nil t)))
@@ -3764,6 +3765,9 @@
 		  (and (edx-var env)
 		       (new-binding-location (edx-var env) frame-map :default nil))))
 	    ;; (warn "l0: ~S, l1: ~S" location-0 location-1)
+	    (assert (not (and location-0
+			      (eql location-0 location-1))) ()
+	      "Compiler bug: two bindings in same location.")
 	    (cond
 	     ((and (eq :ebx location-0) (eq :eax location-1))
 	      `((:xchgl :eax :ebx)))