(in-package "SB!C")
-(file-comment
- "$Header$")
-
(defvar *args* ()
#!+sb-doc
"This variable is bound to the format arguments when an error is signalled
|#
-;;; 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)
(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)
(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
(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*)