X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdebug.lisp;h=2458152e41e0d270aa2c833f6f39c155d81fcccc;hb=dfa55a883f94470267b626dae77ce7e7dfac3df6;hp=6e20896bb1c997f092dd48e9b6ed2d4fa792791e;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp
index 6e20896..2458152 100644
--- a/src/compiler/debug.lisp
+++ b/src/compiler/debug.lisp
@@ -12,9 +12,6 @@
 
 (in-package "SB!C")
 
-(file-comment
-  "$Header$")
-
 (defvar *args* ()
   #!+sb-doc
   "This variable is bound to the format arguments when an error is signalled
@@ -319,9 +316,9 @@
 
 |#
 
-;;; Check a block for consistency at the general flow-graph level, and call
-;;; Check-Node-Consistency on each node to locally check for semantic
-;;; consistency.
+;;; Check a block for consistency at the general flow-graph level, and
+;;; call CHECK-NODE-CONSISTENCY on each node to locally check for
+;;; semantic consistency.
 (declaim (ftype (function (cblock) (values)) check-block-consistency))
 (defun check-block-consistency (block)
 
@@ -502,13 +499,20 @@
 		   (combination-p node)))
 	 (barf "flushed arg not in local call: ~S" node))
 	(t
-	 (let ((fun (ref-leaf (continuation-use
-			       (basic-combination-fun node))))
-	       (pos (position arg (basic-combination-args node))))
-	   (check-type pos fixnum) ; to suppress warning -- WHN 19990311
-	   (when (leaf-refs (elt (lambda-vars fun) pos))
-	     (barf "flushed arg for referenced var in ~S" node))))))
-
+	 (locally
+	   ;; KLUDGE: In sbcl-0.6.11.37, the compiler doesn't like
+	   ;; (DECLARE (TYPE INDEX POS)) after the inline expansion of
+	   ;; POSITION. It compiles it correctly, but it issues a type
+	   ;; mismatch warning because it can't eliminate the
+	   ;; possibility that control will flow through the
+	   ;; NIL-returning branch. So we punt here. -- WHN 2001-04-15
+	   (declare (notinline position))
+	   (let ((fun (ref-leaf (continuation-use
+				 (basic-combination-fun node))))
+		 (pos (position arg (basic-combination-args node))))
+	     (declare (type index pos))
+	     (when (leaf-refs (elt (lambda-vars fun) pos))
+	       (barf "flushed arg for referenced var in ~S" node)))))))
      (let ((dest (continuation-dest (node-cont node))))
        (when (and (return-p dest)
 		  (eq (basic-combination-kind node) :local)
@@ -913,7 +917,7 @@
     (optional-dispatch
      (format stream "optional-dispatch ~S" (leaf-name leaf)))
     (functional
-     (assert (eq (functional-kind leaf) :top-level-xep))
+     (aver (eq (functional-kind leaf) :top-level-xep))
      (format stream "TL-XEP ~S"
 	     (let ((info (leaf-info leaf)))
 	       (etypecase info
@@ -1144,11 +1148,10 @@
     (clrhash *list-conflicts-table*)
     (res)))
 
+;;; Return a list of a the TNs that conflict with TN. Sort of, kind
+;;; of. For debugging use only. Probably doesn't work on :COMPONENT TNs.
 (defun list-conflicts (tn)
-  #!+sb-doc
-  "Return a list of a the TNs that conflict with TN. Sort of, kind of. For
-  debugging use only. Probably doesn't work on :COMPONENT TNs."
-  (assert (member (tn-kind tn) '(:normal :environment :debug-environment)))
+  (aver (member (tn-kind tn) '(:normal :environment :debug-environment)))
   (let ((confs (tn-global-conflicts tn)))
     (cond (confs
 	   (clrhash *list-conflicts-table*)