From d8b4d704a3e88b1ec4aa6ac8e1da01b23fa142ed Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Mon, 16 Apr 1990 10:27:56 +0000
Subject: [PATCH] Merged non-descriptor changes: debug-dump.lisp  revision
 1.10.1.3  date: 90/04/13 12:11:22;  author: ram;  state: Exp;  lines
 added/del: 8/3  Changed block dumping to notice when the successor is in a
 different  environment (due to a TR call).  ---------------------------- 
 revision 1.10.1.2  date: 90/04/08 17:54:38;  author: ram;  state: Exp;  lines
 added/del: 2/2  old-cont => old-fp  ----------------------------  revision
 1.10.1.1  date: 90/03/27 12:12:06;  author: ram;  state: Exp;  lines
 added/del: 1/0  Added support for file comments.

---
 compiler/debug-dump.lisp | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

diff --git a/compiler/debug-dump.lisp b/compiler/debug-dump.lisp
index da2a180ec..bf5477121 100644
--- a/compiler/debug-dump.lisp
+++ b/compiler/debug-dump.lisp
@@ -174,12 +174,17 @@
 
     (collect ((elsewhere))
       (let ((tail (component-tail
-		   (block-component (node-block (lambda-bind fun))))))
-	(do-environment-ir2-blocks (2block (lambda-environment fun))
+		   (block-component (node-block (lambda-bind fun)))))
+	    (env (lambda-environment fun)))
+	(do-environment-ir2-blocks (2block env)
 	  (let ((block (ir2-block-block 2block)))
 	    (when (eq (block-info block) 2block)
 	      (let ((succ (let ((s (block-succ block)))
-			    (if (eq (car s) tail)
+			    (if (and s
+				     (or (eq (car s) tail)
+					 (not (eq (lambda-environment
+						   (block-lambda (car s)))
+						  env))))
 				()
 				s))))
 		(vector-push-extend
@@ -225,6 +230,7 @@
 	      (let ((name (file-info-name x))
 		    (res (make-debug-source
 			  :from :file
+			  :comment (file-info-comment x)
 			  :created (file-info-write-date x)
 			  :compiled (source-info-start-time info)
 			  :source-root (file-info-source-root x)
@@ -456,8 +462,8 @@
 			:kind (functional-kind fun)
 			:return-pc (tn-sc-offset
 				    (ir2-environment-return-pc 2env))
-			:old-cont (tn-sc-offset
-				   (ir2-environment-old-cont 2env))
+			:old-fp (tn-sc-offset
+				 (ir2-environment-old-fp 2env))
 			:start-pc (label-location
 				   (ir2-environment-environment-start 2env))
 
-- 
GitLab