X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fdebug.lisp;h=7e6244a9142df1c76b45d5899e963a0d5f289e50;hb=e0697854ef9f4999c8585b64be1b282ce4725176;hp=9be0b0787042dba5d63bcaaab8b2d11612031df8;hpb=61c18727668ff0c3263a3d363e609d4522d545cc;p=sbcl.git

diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp
index 9be0b07..7e6244a 100644
--- a/src/compiler/debug.lisp
+++ b/src/compiler/debug.lisp
@@ -466,6 +466,18 @@
 	     (check-fun-reached leaf node)))))
     (basic-combination
      (check-dest (basic-combination-fun node) node)
+     (when (and (mv-combination-p node)
+                (eq (basic-combination-kind node) :local))
+       (let ((fun-lvar (basic-combination-fun node)))
+         (unless (ref-p (lvar-uses fun-lvar))
+           (barf "function in a local mv-combination is not a LEAF: ~S" node))
+         (let ((fun (ref-leaf (lvar-use fun-lvar))))
+           (unless (lambda-p fun)
+             (barf "function ~S in a local mv-combination ~S is not local"
+                   fun node))
+           (unless (eq (functional-kind fun) :mv-let)
+             (barf "function ~S in a local mv-combination ~S is not of kind :MV-LET"
+                   fun node)))))
      (dolist (arg (basic-combination-args node))
        (cond
          (arg (check-dest arg node))
@@ -940,6 +952,10 @@
       (format t " <deleted>"))
 
     (pprint-newline :mandatory)
+    (awhen (block-info block)
+      (format t "start stack:~{ v~D~}"
+              (mapcar #'cont-num (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)))
@@ -953,7 +969,7 @@
            (let ((kind (basic-combination-kind node)))
              (format t "~(~A~A ~A~) "
                      (if (node-tail-p node) "tail " "")
-                     (if (fun-info-p kind) "known" kind)
+                     kind
                      (type-of node))
              (print-lvar (basic-combination-fun node))
              (dolist (arg (basic-combination-args node))
@@ -998,6 +1014,10 @@
                      (cast-asserted-type node)))))
         (pprint-newline :mandatory)))
 
+    (awhen (block-info block)
+      (format t "end stack:~{ v~D~}"
+              (mapcar #'cont-num (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))))