X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdebug.lisp;h=5f2c6e1f4a1a05f708d07f632ae9cb8484189c04;hb=ee3bfc5a989b5c0a1ea5a094e9541169ea2eb4ad;hp=7f67f0ffb7294b5681b72853d3f4f59a4cb823e3;hpb=c7dc5b2a1f56ed0583a0b3ea61b6ceb540c6f89e;p=sbcl.git

diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp
index 7f67f0f..5f2c6e1 100644
--- a/src/compiler/debug.lisp
+++ b/src/compiler/debug.lisp
@@ -963,7 +963,8 @@
            (ref (print-leaf (ref-leaf node)))
            (basic-combination
             (let ((kind (basic-combination-kind node)))
-              (format t "~(~A ~A~) c~D"
+              (format t "~(~A~A ~A~) c~D"
+                      (if (node-tail-p node) "tail " "")
                       (if (fun-info-p kind) "known" kind)
                       (type-of node)
                       (cont-num (basic-combination-fun node)))
@@ -981,7 +982,9 @@
             (print-continuation (block-start (if-alternative node))))
            (bind
             (write-string "bind ")
-            (print-leaf (bind-lambda node)))
+            (print-leaf (bind-lambda node))
+            (when (functional-kind (bind-lambda node))
+              (format t " ~S ~S" :kind (functional-kind (bind-lambda node)))))
            (creturn
             (format t "return c~D " (cont-num (return-result node)))
             (print-leaf (return-lambda node)))
@@ -1134,8 +1137,8 @@
 
 (defvar *list-conflicts-table* (make-hash-table :test 'eq))
 
-;;; Add all ALWAYS-LIVE TNs in Block to the conflicts. TN is ignored when
-;;; it appears in the global conflicts.
+;;; Add all ALWAYS-LIVE TNs in BLOCK to the conflicts. TN is ignored
+;;; when it appears in the global conflicts.
 (defun add-always-live-tns (block tn)
   (declare (type ir2-block block) (type tn tn))
   (do ((conf (ir2-block-global-tns block)
@@ -1147,7 +1150,7 @@
 	  (setf (gethash btn *list-conflicts-table*) t)))))
   (values))
 
-;;; Add all local TNs in block to the conflicts.
+;;; Add all local TNs in BLOCK to the conflicts.
 (defun add-all-local-tns (block)
   (declare (type ir2-block block))
   (let ((ltns (ir2-block-local-tns block)))
@@ -1176,7 +1179,8 @@
 	   (do ((conf confs (global-conflicts-next-tnwise conf)))
 	       ((null conf))
              (format t "~&#<block ~D kind ~S>~%"
-                     (block-number (ir2-block-block (global-conflicts-block conf)))
+                     (block-number (ir2-block-block (global-conflicts-block
+						     conf)))
                      (global-conflicts-kind conf))
 	     (let ((block (global-conflicts-block conf)))
 	       (add-always-live-tns block tn)