[movitz-cvs] CVS movitz

[ffjeld]

Update of /project/movitz/cvsroot/movitz
In directory clnet:/tmp/cvs-serv27133

Modified Files:
	compiler.lisp 
Log Message:
Fix accounting of function-bindings, for (flet ((foo ...)) .. (lambda () (foo ..))).


--- /project/movitz/cvsroot/movitz/compiler.lisp	2008/03/16 22:27:54	1.196
+++ /project/movitz/cvsroot/movitz/compiler.lisp	2008/03/17 23:23:30	1.197
@@ -8,7 +8,7 @@
 ;;;; Created at:    Wed Oct 25 12:30:49 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: compiler.lisp,v 1.196 2008/03/16 22:27:54 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.197 2008/03/17 23:23:30 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -613,14 +613,19 @@
     (labels ((process-binding (funobj binding usages)
 	       (cond
                  ((typep binding 'constant-object-binding))
+		 ((and (typep binding 'function-binding)
+		       (equal usages '(:call)))
+		  (pushnew :call (getf (sub-function-binding-usage (function-binding-parent binding))
+				       binding))
+		  (pushnew :call (getf function-binding-usage binding)))
                  ((not (eq funobj (binding-funobj binding)))
                   (let ((borrowing-binding
                          (or (find binding (borrowed-bindings funobj)
-                              :key #'borrowed-binding-target)
+				   :key #'borrowed-binding-target)
                              (car (push (movitz-env-add-binding (funobj-env funobj)
                                                                 (make-instance 'borrowed-binding
-                                                                 :name (binding-name binding)
-                                                                 :target-binding binding))
+									       :name (binding-name binding)
+									       :target-binding binding))
                                         (borrowed-bindings funobj))))))
                     ;; We don't want to borrow a forwarding-binding..
                     (when (typep (borrowed-binding-target borrowing-binding)
@@ -2521,7 +2526,7 @@
 		    (incf (getf constants funobj 0))))
 		 (closure-binding)
 		 (function-binding
-		  (error "No function-binding now..: ~S" binding))))
+		  (warn "No function-binding now..: ~S" binding))))
 	     (process (sub-code)
 	       "This local function side-effects the variables jumper-sets and constants."
 	       (loop for instruction in sub-code
@@ -3785,8 +3790,9 @@
 		     (mapcar #'movitz-funobj-extent
 			     (mapcar #'binding-funobj 
 				     (getf (binding-lending lended-binding) :lended-to))))
-	       (append (make-load-lexical lended-binding :eax funobj t frame-map)
-		       (unless (or (typep lended-binding 'borrowed-binding)
+	       (when (typep lended-binding 'funobj-binding)
+		 (break "Lending ~S ?" lended-binding))
+	       (append (unless (or (typep lended-binding 'borrowed-binding)
 				   (getf (binding-lending lended-binding) :dynamic-extent-p)
 				   (every (lambda (borrower)
 					    (member (movitz-funobj-extent (binding-funobj borrower))