X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdebug.lisp;h=ae59919ed9941b9ba7b583f753a93211d5234124;hb=5ecef987f3847ed5de8c03f66ef9d8ab468af993;hp=92b70a5b5272b48604a3bf79df33c9651978c050;hpb=5ef7f500a505f5711b1c76ff8c15f443d4815367;p=sbcl.git

diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp
index 92b70a5..ae59919 100644
--- a/src/compiler/debug.lisp
+++ b/src/compiler/debug.lisp
@@ -662,7 +662,7 @@
 
 ;;; Dump some info about how many TNs there, and what the conflicts data
 ;;; structures are like.
-(defun pre-pack-tn-stats (component &optional (stream *error-output*))
+(defun pre-pack-tn-stats (component &optional (stream *standard-output*))
   (declare (type component component))
   (let ((wired 0)
 	(global 0)
@@ -941,6 +941,11 @@
   (format t "v~D " (cont-num cont))
   (values))
 
+(defun print-lvar-stack (stack &optional (stream *standard-output*))
+  (loop for (lvar . rest) on stack
+        do (format stream "~:[u~;d~]v~D~@[ ~]"
+                   (lvar-dynamic-extent lvar) (cont-num lvar) rest)))
+
 ;;; Print out the nodes in BLOCK in a format oriented toward
 ;;; representing what the code does.
 (defun print-nodes (block)
@@ -952,6 +957,10 @@
       (format t " <deleted>"))
 
     (pprint-newline :mandatory)
+    (awhen (block-info block)
+      (format t "start stack: ")
+      (print-lvar-stack (ir2-block-start-stack it))
+      (pprint-newline :mandatory))
     (do ((ctran (block-start block) (node-next (ctran-next ctran))))
         ((not ctran))
       (let ((node (ctran-next ctran)))
@@ -992,7 +1001,13 @@
            (print-lvar (return-result node))
            (print-leaf (return-lambda node)))
           (entry
-           (format t "entry ~S" (entry-exits node)))
+           (let ((cleanup (entry-cleanup node)))
+             (case (cleanup-kind cleanup)
+               ((:dynamic-extent)
+                (format t "entry DX~{ v~D~}"
+                        (mapcar #'cont-num (cleanup-info cleanup))))
+               (t
+                (format t "entry ~S" (entry-exits node))))))
           (exit
            (let ((value (exit-value node)))
              (cond (value
@@ -1010,6 +1025,10 @@
                      (cast-asserted-type node)))))
         (pprint-newline :mandatory)))
 
+    (awhen (block-info block)
+      (format t "end stack: ")
+      (print-lvar-stack (ir2-block-end-stack it))
+      (pprint-newline :mandatory))
     (let ((succ (block-succ block)))
       (format t "successors~{ c~D~}~%"
               (mapcar (lambda (x) (cont-num (block-start x))) succ))))