[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-serv6231

Modified Files:
	special-operators-cl.lisp 
Log Message:
Many fixes to the compiler. Basic change is that LET init-forms are
compiled with compile-form-unprotected, and that
compile-lexical-variable and compile-self-evaluating return binding
only as "returns", not in the form of "code".

Date: Sun Aug 28 23:03:27 2005
Author: ffjeld

Index: movitz/special-operators-cl.lisp
diff -u movitz/special-operators-cl.lisp:1.47 movitz/special-operators-cl.lisp:1.48
--- movitz/special-operators-cl.lisp:1.47	Sat Aug 20 22:31:15 2005
+++ movitz/special-operators-cl.lisp	Sun Aug 28 23:03:27 2005
@@ -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.47 2005/08/20 20:31:15 ffjeld Exp $
+;;;; $Id: special-operators-cl.lisp,v 1.48 2005/08/28 21:03:27 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -85,11 +85,11 @@
 				      :modify-accumulate let-modifies
 				      :result-mode :push)
 				    `((:pushl :edi)) ; scratch
-				    (compiler-call #'compile-self-evaluating ; binding name
+				    (compiler-call #'compile-form ; binding name
 				      :with-stack-used (incf stack-used 2)
 				      :env init-env
 				      :defaults all
-				      :form var
+				      :form `(muerte.cl:quote ,var)
 				      :result-mode :push)
 				    (prog1 nil (incf stack-used)))
 			    nil t)
@@ -103,20 +103,26 @@
 			   (compiler-values-bind (&code init-code &functional-p functional-p
 						  &type type &returns init-register
 						  &final-form final-form)
-			       (compiler-call #'compile-form-to-register
+			       
+			       (compiler-call #'compile-form-unprotected
+				 :result-mode binding
+				 :env init-env
+				 :extent local-env
+				 :defaults all
+				 :form init-form)
+			     #+ignore
+			     (compiler-call #'compile-form-to-register
 				 :env init-env
 				 :extent local-env
 				 :defaults all
 				 :form init-form
 				 :modify-accumulate let-modifies)
+			     (when (eq binding init-register)
+			       (setf init-register nil))
 ;;;			     (warn "var ~S, type: ~S" var type)
 ;;;			     (warn "var ~S init: ~S.." var init-form)
-;;;			     (print-code 'init
-;;;					 (compiler-call #'compile-form
-;;;					   :env init-env
-;;;					   :defaults all
-;;;					   :form init-form
-;;;					   :result-mode binding))
+;;;			     (warn "bind: ~S reg: ~S" binding init-register)
+;;;			     (print-code 'init init-code)
 			     (list var
 				   init-form
 				   init-code
@@ -127,6 +133,7 @@
 				     init-type)
 				   (case init-register
 				     (:non-local-exit :edi)
+				     (:multiple-values :eax)
 				     (t init-register))
 				   final-form))))))
 	  (setf (stack-used local-env)
@@ -221,6 +228,9 @@
 						    ;; This is the best we can do now to determine
 						    ;; if target-binding is ever used again.
 						    (and (eq result-mode :function)
+							 (not (and (bindingp body-returns)
+								   (binding-eql target-binding
+										body-returns)))
 							 (not (code-uses-binding-p body-code
 										   target-binding
 										   :load t
@@ -261,10 +271,11 @@
 								   :load nil :store t)))
 				    ;; replace read-only lexical binding with
 				    ;; side-effect-free form
-				    #+ignore (warn "Constant binding: ~S => ~S => ~S"
-						   (binding-name binding)
-						   init-form
-						   (car (type-specifier-singleton type)))
+				    #+ignore
+				    (warn "Constant binding: ~S => ~S => ~S"
+					  (binding-name binding)
+					  init-form
+					  (car (type-specifier-singleton type)))
 				    (change-class binding 'constant-object-binding
 						  :object (car (type-specifier-singleton type)))
 				    (if functional-p
@@ -1404,7 +1415,9 @@
 		:returns :eax))))
 	 (t (compiler-call #'compile-form-unprotected
 	      :forward all
-	      :form `(muerte::compiled-cond (,test-form ,then-form) (t ,else-form)))))))))
+	      :form `(muerte::compiled-cond
+		      (,test-form ,then-form)
+		      (muerte.cl::t ,else-form)))))))))
 
 (define-special-operator the (&all all &form form)
   (destructuring-bind (value-type sub-form)