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

[Frode Vatvedt Fjeld]

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

Modified Files:
	compiler.lisp 
Log Message:
Make the compiler work when *compiler-do-type-inference* is NIL. Fixed
a bug in the :add extended-code expander; it didn't work well for
lended bindings.

Date: Mon Aug 16 01:24:56 2004
Author: ffjeld

Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.94 movitz/compiler.lisp:1.95
--- movitz/compiler.lisp:1.94	Sat Aug 14 10:47:04 2004
+++ movitz/compiler.lisp	Mon Aug 16 01:24:56 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.94 2004/08/14 17:47:04 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.95 2004/08/16 08:24:56 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -72,7 +72,7 @@
   "Spend time and effort performing type inference and optimization.")
 
 (defvar *compiler-produce-defensive-code* t
-  "Try make code be extra cautious.")
+  "Try to make code be extra cautious.")
 
 (defvar *compiler-trust-user-type-declarations-p* t)
 
@@ -381,7 +381,24 @@
 (defun analyze-bindings (toplevel-funobj)
   "Figure out usage of bindings in a toplevel funobj.
 Side-effects each binding's binding-store-type."
-  (when *compiler-do-type-inference*
+  (if (not *compiler-do-type-inference*)
+      (labels
+	  ((analyze-code (code)
+	     (dolist (instruction code)
+	       (when (listp instruction)
+		 (let ((binding
+			(find-written-binding-and-type instruction)))
+		   (when binding
+		     (setf (binding-store-type binding)
+		       (multiple-value-list (type-specifier-encode t)))))
+		 (analyze-code (instruction-sub-program instruction)))))
+	   (analyze-funobj (funobj)
+	     (loop for (nil . function-env) in (function-envs funobj)
+		 do (analyze-code (extended-code function-env)))
+	     (loop for function-binding in (sub-function-binding-usage funobj) by #'cddr
+		 do (analyze-funobj (function-binding-funobj function-binding)))
+	     funobj))
+	(analyze-funobj toplevel-funobj))
     (let ((binding-usage (make-hash-table :test 'eq)))
       (labels ((binding-resolved-p (binding)
 		 (let ((analysis (gethash binding binding-usage)))
@@ -6283,9 +6300,9 @@
 	   ((and (type-specifier-singleton type0)
 		 (symbolp loc1)
 		 (integerp destination-location))
-	    `((:addl ,(movitz-immediate-value (car (type-specifier-singleton type0)))
-		     ,loc1)
-	      (:movl ,loc1 (:ebp ,(stack-frame-offset destination-location)))))
+	    (append `((:addl ,(movitz-immediate-value (car (type-specifier-singleton type0)))
+			     ,loc1))
+		    (make-store-lexical destination loc1 nil frame-map)))
 	   (t
 ;;;	    (warn "ADD: ~A/~S = ~A/~S + ~A/~S,~%~A ~A"
 ;;;		  destination-location