X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fstack.lisp;h=508b6ef6830b9430b2f48f7a135ed8c994b0907f;hb=31361af9eb64344f521abbb245ea784c76c746e5;hp=b8246a06603a3c213e0a62f9f3bd0069617c777e;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git

diff --git a/src/compiler/stack.lisp b/src/compiler/stack.lisp
index b8246a0..508b6ef 100644
--- a/src/compiler/stack.lisp
+++ b/src/compiler/stack.lisp
@@ -35,7 +35,7 @@
 		       (not (eq (node-block dest) block))
 		       2cont
 		       (eq (ir2-continuation-kind 2cont) :unknown))
-	      (assert (or saw-last (not last-pop)))
+	      (aver (or saw-last (not last-pop)))
 	      (pushed cont)))))
 
       (setf (ir2-block-pushed 2block) (pushed))))
@@ -89,7 +89,7 @@
       (dolist (push (reverse (ir2-block-pushed 2block)))
 	(if (eq (car new-stack) push)
 	    (pop new-stack)
-	    (assert (not (member push new-stack)))))
+	    (aver (not (member push new-stack)))))
 
       (dolist (pop (reverse (ir2-block-popped 2block)))
 	(push pop new-stack))
@@ -99,12 +99,12 @@
       (when new-stack
 	(dolist (pred (block-pred block))
 	  (if (eq pred (component-head (block-component block)))
-	      (assert (find block
-			    (environment-nlx-info (block-environment block))
-			    :key #'nlx-info-target))
+	      (aver (find block
+			  (environment-nlx-info (block-environment block))
+			  :key #'nlx-info-target))
 	      (let ((pred-stack (ir2-block-end-stack (block-info pred))))
 		(unless (tailp new-stack pred-stack)
-		  (assert (search pred-stack new-stack))
+		  (aver (search pred-stack new-stack))
 		  (stack-simulation-walk pred new-stack))))))))
 
   (values))
@@ -134,30 +134,30 @@
 	((null pushes))
       (let ((push (first pushes)))
 	(cond ((member push stack)
-	       (assert (not popping)))
+	       (aver (not popping)))
 	      ((eq push tailp-cont)
-	       (assert (null (rest pushes))))
+	       (aver (null (rest pushes))))
 	      (t
 	       (push push (ir2-block-end-stack 2block))
 	       (setq popping t))))))
 
   (values))
 
-;;; Called when we discover that the stack-top unknown-values continuation
-;;; at the end of Block1 is different from that at the start of Block2 (its
-;;; successor.)
+;;; This is called when we discover that the stack-top unknown-values
+;;; continuation at the end of BLOCK1 is different from that at the
+;;; start of BLOCK2 (its successor).
 ;;;
-;;; We insert a call to a funny function in a new cleanup block introduced
-;;; between Block1 and Block2. Since control analysis and LTN have already
-;;; run, we must do make an IR2 block, then do ADD-TO-EMIT-ORDER and
-;;; LTN-ANALYZE-BLOCK on the new block. The new block is inserted after Block1
-;;; in the emit order.
+;;; We insert a call to a funny function in a new cleanup block
+;;; introduced between BLOCK1 and BLOCK2. Since control analysis and
+;;; LTN have already run, we must do make an IR2 block, then do
+;;; ADD-TO-EMIT-ORDER and LTN-ANALYZE-BELATED-BLOCK on the new block.
+;;; The new block is inserted after BLOCK1 in the emit order.
 ;;;
-;;; If the control transfer between Block1 and Block2 represents a
-;;; tail-recursive return (:Deleted IR2-continuation) or a non-local exit, then
-;;; the cleanup code will never actually be executed. It doesn't seem to be
-;;; worth the risk of trying to optimize this, since this rarely happens and
-;;; wastes only space.
+;;; If the control transfer between BLOCK1 and BLOCK2 represents a
+;;; tail-recursive return (:DELETED IR2-continuation) or a non-local
+;;; exit, then the cleanup code will never actually be executed. It
+;;; doesn't seem to be worth the risk of trying to optimize this,
+;;; since this rarely happens and wastes only space.
 (defun discard-unused-values (block1 block2)
   (declare (type cblock block1 block2))
   (let* ((block1-stack (ir2-block-end-stack (block-info block1)))
@@ -166,7 +166,7 @@
 			   (- (length block1-stack)
 			      (length block2-stack)
 			      1))))
-    (assert (tailp block2-stack block1-stack))
+    (aver (tailp block2-stack block1-stack))
 
     (let* ((block (insert-cleanup-code block1 block2
 				       (continuation-next (block-start block2))
@@ -174,7 +174,7 @@
 	   (2block (make-ir2-block block)))
       (setf (block-info block) 2block)
       (add-to-emit-order 2block (block-info block1))
-      (ltn-analyze-block block)))
+      (ltn-analyze-belated-block block)))
 
   (values))