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

[Frode Vatvedt Fjeld]

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

Modified Files:
	compiler.lisp 
Log Message:
Improved propagation of :protect-registers somewhat.

Date: Wed Mar 24 13:38:18 2004
Author: ffjeld

Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.33 movitz/compiler.lisp:1.34
--- movitz/compiler.lisp:1.33	Thu Feb 26 08:48:42 2004
+++ movitz/compiler.lisp	Wed Mar 24 13:38:18 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.33 2004/02/26 13:48:42 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.34 2004/03/24 18:38:18 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -2436,9 +2436,12 @@
 	  (destructuring-bind (binding &key init-with-register init-with-type
 					    protect-registers protect-carry)
 	      (cdr i)
-	    (declare (ignore binding protect-registers protect-carry init-with-type))
+	    (declare (ignore binding protect-carry init-with-type))
 	    (when init-with-register
-	      (setf free-so-far (remove init-with-register free-so-far)))))
+	      (setf free-so-far (remove-if (lambda (x)
+					     (or (eq x init-with-register)
+						 (member x protect-registers)))
+					   free-so-far)))))
 	 (t (case (instruction-is i)
 	      ((nil :call)
 	       (return nil))
@@ -5575,12 +5578,13 @@
     (list source)))
 
 (define-extended-code-expander :store-lexical (instruction funobj frame-map)
-  (destructuring-bind (destination source &key shared-reference-p type)
+  (destructuring-bind (destination source &key shared-reference-p type protect-registers)
       (cdr instruction)
     (declare (ignore type))
     (make-store-lexical (ensure-local-binding destination funobj)
 			(ensure-local-binding source funobj)
-			shared-reference-p frame-map)))
+			shared-reference-p frame-map
+			:protect-registers protect-registers)))
 
 ;;;;;;;;;;;;;;;;;; Init-lexvar