X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fcontrol.lisp;h=2e1db870749b936af3eb91ba15f7d9e9244f9430;hb=eb5265ab22a2b1cae18bbdf43c871dba9b5927ea;hp=3a1d235c9033c56b8b0a9a0dc905dc75c5abfd23;hpb=416152f084604094445a758ff399871132dff2bd;p=sbcl.git

diff --git a/src/compiler/control.lisp b/src/compiler/control.lisp
index 3a1d235..2e1db87 100644
--- a/src/compiler/control.lisp
+++ b/src/compiler/control.lisp
@@ -50,17 +50,16 @@
 (defun find-rotated-loop-head (block)
   (declare (type cblock block))
   (let* ((num (block-number block))
-	 (env (block-environment block))
+	 (env (block-physenv block))
 	 (pred (dolist (pred (block-pred block) nil)
 		 (when (and (not (block-flag pred))
-			    (eq (block-environment pred) env)
+			    (eq (block-physenv pred) env)
 			    (< (block-number pred) num))
 		   (return pred)))))
     (cond
      ((and pred
-	   (not (environment-nlx-info env))
-	   (not (eq (node-block (lambda-bind (block-home-lambda block)))
-		    block)))
+	   (not (physenv-nlx-info env))
+	   (not (eq (lambda-block (block-home-lambda block)) block)))
       (let ((current pred)
 	    (current-num (block-number pred)))
 	(block DONE
@@ -69,7 +68,7 @@
 	      (when (eq pred block)
 		(return-from DONE))
 	      (when (and (not (block-flag pred))
-			 (eq (block-environment pred) env)
+			 (eq (block-physenv pred) env)
 			 (> (block-number pred) current-num))
 		(setq current pred   current-num (block-number pred))
 		(return)))))
@@ -97,7 +96,9 @@
 ;;; (end in an error, NLX or tail full call.) This is to discourage
 ;;; making error code the drop-through.
 (defun control-analyze-block (block tail block-info-constructor)
-  (declare (type cblock block) (type block-annotation tail))
+  (declare (type cblock block)
+           (type block-annotation tail)
+           (type function block-info-constructor))
   (unless (block-flag block)
     (let ((block (find-rotated-loop-head block)))
       (setf (block-flag block) t)
@@ -110,8 +111,8 @@
       (let ((last (block-last block)))
 	(cond ((and (combination-p last) (node-tail-p last)
 		    (eq (basic-combination-kind last) :local)
-		    (not (eq (node-environment last)
-			     (lambda-environment (combination-lambda last)))))
+		    (not (eq (node-physenv last)
+			     (lambda-physenv (combination-lambda last)))))
 	       (combination-lambda last))
 	      (t
 	       (let ((component-tail (component-tail (block-component block)))
@@ -128,22 +129,24 @@
 
 ;;; Analyze all of the NLX EPs first to ensure that code reachable
 ;;; only from a NLX is emitted contiguously with the code reachable
-;;; from the Bind. Code reachable from the Bind is inserted *before*
-;;; the NLX code so that the Bind marks the beginning of the code for
-;;; the function. If the walks from NLX EPs reach the bind block, then
+;;; from the BIND. Code reachable from the BIND is inserted *before*
+;;; the NLX code so that the BIND marks the beginning of the code for
+;;; the function. If the walks from NLX EPs reach the BIND block, then
 ;;; we just move it to the beginning.
 ;;;
-;;; If the walk from the bind node encountered a tail local call, then
+;;; If the walk from the BIND node encountered a tail local call, then
 ;;; we start over again there to help the call drop through. Of
 ;;; course, it will never get a drop-through if either function has
 ;;; NLX code.
 (defun control-analyze-1-fun (fun component block-info-constructor)
-  (declare (type clambda fun) (type component component))
+  (declare (type clambda fun)
+           (type component component)
+           (type function block-info-constructor))
   (let* ((tail-block (block-info (component-tail component)))
 	 (prev-block (block-annotation-prev tail-block))
 	 (bind-block (node-block (lambda-bind fun))))
     (unless (block-flag bind-block)
-      (dolist (nlx (environment-nlx-info (lambda-environment fun)))
+      (dolist (nlx (physenv-nlx-info (lambda-physenv fun)))
 	(control-analyze-block (nlx-info-target nlx) tail-block
 			       block-info-constructor))
       (cond
@@ -164,7 +167,7 @@
 				   block-info-constructor)))))))
   (values))
 
-;;; Do control analysis on Component, finding the emit order. Our only
+;;; Do control analysis on COMPONENT, finding the emit order. Our only
 ;;; cleverness here is that we walk XEP's first to increase the
 ;;; probability that the tail call will be a drop-through.
 ;;;
@@ -189,7 +192,7 @@
     (clear-flags component)
 
     (dolist (fun (component-lambdas component))
-      (when (external-entry-point-p fun)
+      (when (xep-p fun)
 	(control-analyze-1-fun fun component block-info-constructor)))
 
     (dolist (fun (component-lambdas component))
@@ -197,7 +200,7 @@
 
     (do-blocks (block component)
       (unless (block-flag block)
-	(event control-deleted-block (continuation-next (block-start block)))
+	(event control-deleted-block (block-start-node block))
 	(delete-block block))))
 
   (let ((2comp (component-info component)))