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