X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdebug.lisp;h=1bdad5baf07ed40875c28dbbefc9ab0a4d51b4a9;hb=1b650be8b800cf96e2c268ae317fb26d0bf36827;hp=cd549cc7c02e75556ba5ba564ca61e52c09eaeb8;hpb=942e5de3f3e27e1cc6ae4aae69c040fa1dc7db00;p=sbcl.git

diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp
index cd549cc..1bdad5b 100644
--- a/src/compiler/debug.lisp
+++ b/src/compiler/debug.lisp
@@ -475,7 +475,10 @@
        (unless (gethash (continuation-block cont) *seen-blocks*)
 	 (barf "~S receives ~S, which is in an unknown block." node cont))
        (unless (eq (continuation-dest cont) node)
-	 (barf "DEST for ~S should be ~S." cont node)))))
+	 (barf "DEST for ~S should be ~S." cont node))
+       (unless (find-uses cont)
+         (barf "Continuation ~S has a destinatin, but no uses."
+               cont)))))
   (values))
 
 ;;; This function deals with checking for consistency of the
@@ -496,25 +499,25 @@
      (check-dest (basic-combination-fun node) node)
      (dolist (arg (basic-combination-args node))
        (cond
-	(arg (check-dest arg node))
-	((not (and (eq (basic-combination-kind node) :local)
-		   (combination-p node)))
-	 (barf "flushed arg not in local call: ~S" node))
-	(t
-	 (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)))))))
+         (arg (check-dest arg node))
+         ((not (and (eq (basic-combination-kind node) :local)
+                    (combination-p node)))
+          (barf "flushed arg not in local call: ~S" node))
+         (t
+          (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)
@@ -894,11 +897,11 @@
 ;;;     keep garbage from being collected.
 (macrolet ((def (counter vto vfrom fto ffrom)
 	     `(progn
+		(declaim (type hash-table ,vto ,vfrom))
 		(defvar ,vto (make-hash-table :test 'eq))
 		(defvar ,vfrom (make-hash-table :test 'eql))
-		(proclaim '(hash-table ,vto ,vfrom))
+		(declaim (type fixnum ,counter))
 		(defvar ,counter 0)
-		(proclaim '(fixnum ,counter))
 
 		(defun ,fto (x)
 		  (or (gethash x ,vto)
@@ -954,6 +957,8 @@
   (pprint-logical-block (nil nil)
     (format t "~:@_IR1 block ~D start c~D"
            (block-number block) (cont-num (block-start block)))
+    (when (block-delete-p block)
+      (format t " <deleted>"))
 
     (let ((last (block-last block)))
      (pprint-newline :mandatory)