Skip to content
Snippets Groups Projects
Commit d8b4d704 authored by ram's avatar ram
Browse files

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.
parent 05e8dc14
No related branches found
No related tags found
No related merge requests found
...@@ -174,12 +174,17 @@ ...@@ -174,12 +174,17 @@
(collect ((elsewhere)) (collect ((elsewhere))
(let ((tail (component-tail (let ((tail (component-tail
(block-component (node-block (lambda-bind fun)))))) (block-component (node-block (lambda-bind fun)))))
(do-environment-ir2-blocks (2block (lambda-environment fun)) (env (lambda-environment fun)))
(do-environment-ir2-blocks (2block env)
(let ((block (ir2-block-block 2block))) (let ((block (ir2-block-block 2block)))
(when (eq (block-info block) 2block) (when (eq (block-info block) 2block)
(let ((succ (let ((s (block-succ block))) (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)))) s))))
(vector-push-extend (vector-push-extend
...@@ -225,6 +230,7 @@ ...@@ -225,6 +230,7 @@
(let ((name (file-info-name x)) (let ((name (file-info-name x))
(res (make-debug-source (res (make-debug-source
:from :file :from :file
:comment (file-info-comment x)
:created (file-info-write-date x) :created (file-info-write-date x)
:compiled (source-info-start-time info) :compiled (source-info-start-time info)
:source-root (file-info-source-root x) :source-root (file-info-source-root x)
...@@ -456,8 +462,8 @@ ...@@ -456,8 +462,8 @@
:kind (functional-kind fun) :kind (functional-kind fun)
:return-pc (tn-sc-offset :return-pc (tn-sc-offset
(ir2-environment-return-pc 2env)) (ir2-environment-return-pc 2env))
:old-cont (tn-sc-offset :old-fp (tn-sc-offset
(ir2-environment-old-cont 2env)) (ir2-environment-old-fp 2env))
:start-pc (label-location :start-pc (label-location
(ir2-environment-environment-start 2env)) (ir2-environment-environment-start 2env))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment