[movitz-cvs] CVS update: movitz/special-operators-cl.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	special-operators-cl.lisp 
Log Message:
Quite a bit of cruft regarding register allocation etc. Still more
work to do here, but I don't have time for it right now..

Date: Wed Jun  9 10:26:07 2004
Author: ffjeld

Index: movitz/special-operators-cl.lisp
diff -u movitz/special-operators-cl.lisp:1.17 movitz/special-operators-cl.lisp:1.18
--- movitz/special-operators-cl.lisp:1.17	Tue Apr 13 09:55:08 2004
+++ movitz/special-operators-cl.lisp	Wed Jun  9 10:26:07 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Fri Nov 24 16:31:11 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: special-operators-cl.lisp,v 1.17 2004/04/13 16:55:08 ffjeld Exp $
+;;;; $Id: special-operators-cl.lisp,v 1.18 2004/06/09 17:26:07 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -212,14 +212,20 @@
 											     :load t
 											     :store t))
 								      rest-codes))))))
-					 ;; replace read-only lexical binding with the outer lexical binding
-					 ;; (warn "replace ~S with outer ~S" var (second (first init-code)))
-					 (change-class binding 'forwarding-binding 
-						       :target-binding (second (first init-code)))
-					 nil)
+					 ;; replace read-only binding with the outer binding
+					 #+ignore (warn "replace ~S in ~S with outer ~S"
+							binding (binding-funobj binding)
+							(second (first init-code)))
+					 (let ((target (second (first init-code))))
+					   (change-class binding 'forwarding-binding 
+							 :target-binding target)
+					   `((:init-lexvar ,binding
+							   :init-with-register ,target
+							   :init-with-type ,target))))
 					((and (typep binding 'located-binding)
 					      (type-specifier-singleton type)
-					      (not (code-uses-binding-p body-code binding :load nil :store t)))
+					      (not (code-uses-binding-p body-code binding
+									:load nil :store t)))
 					 ;; replace read-only lexical binding with
 					 ;; side-effect-free form
 					 #+ignore (warn "Constant binding: ~S => ~S => ~S"