How to Walk the Procedure Call Tree
/* tree.p This program will show you programs (.p) and include files
** that your program is running. You should specify how many nested
** levels you want to go.
** 11/04/96 DMITRI LEVIN (c)
*/
def var PROGR as char format "x(40)" no-undo.
def var MAX-LVL as int init 2 no-undo.
def var PROG-PATH as char no-undo.
def var PROG-CNT as int no-undo.
def var LVL-CNT as int no-undo.
def var STR as char format "x(200)" no-undo.
def var TO-FILE as char init "/users/pedsdal1/tree.out"
format "x(40)" no-undo.
def var OFFSET as int no-undo.
def temp-table PROG-LIST no-undo
field PROG-NAME as char
field FULL-PATH as char format "x(40)"
field LEVEL as int
field PROG-NUM as int
field PARNT-NUM as int
field PROCESSED as log
index PRI as primary PROG-NUM
index SEC PARNT-NUM
index FPATH FULL-PATH.
def var SAV-NUM like PROG-LIST.PROG-NUM no-undo.
def stream DMI.
def buffer P-LIST for PROG-LIST.
update
PROGR label "Please, Enter the Program Name "
validate(search(PROGR) <> ?,"Could not find it, try again") skip
MAX-LVL label "Maximum level of nested programs"
help "Usualy more than 3 makes no sence, you can try more later" skip
TO-FILE label "Send Output to File "
help "File name where output 'tree' will be sent"
with side-labels.
assign
PROG-CNT = PROG-CNT + 1
OFFSET = min(int(40 / MAX-LVL),4).
create PROG-LIST.
assign PROG-NAME = PROGR
FULL-PATH = search(PROGR)
LEVEL = LVL-CNT
PROG-NUM = PROG-CNT
PARNT-NUM = 0.
MAIN-LOOP:
do while true on error undo, leave
on end-key undo, leave:
find first PROG-LIST where PROG-LIST.PROCESSED = no no-error.
if not avail PROG-LIST then leave MAIN-LOOP.
if PROG-LIST.LEVEL >= MAX-LVL
or PROG-LIST.PROG-NAME matches "applhelp.p"
or PROG-LIST.PROG-NAME = "RUN VALUE ?"
then do:
PROG-LIST.PROCESSED = yes.
next MAIN-LOOP.
end.
input stream DMI from value(PROG-LIST.FULL-PATH).
LVL-CNT = PROG-LIST.LEVEL + 1.
repeat:
import stream DMI unformatted str.
if index(str,"run ") > 0 and
( index(str," value(") > 0 or
index(str," value ") > 0 )
then do:
PROG-CNT = PROG-CNT + 1.
create P-LIST.
assign P-LIST.PROG-NAME = "RUN VALUE ?"
P-LIST.FULL-PATH = "RUN " + str
P-LIST.LEVEL = LVL-CNT
P-LIST.PROG-NUM = PROG-CNT
P-LIST.PARNT-NUM = PROG-LIST.PROG-NUM
.
next.
end.
if index(str,"run") > 0 and ( index(str,".p") > 0 or index(str,".w") > 0 ) then do:
str = substr(str,index(str,"run") + 4).
if index(str,".p") > 0 then
str = substr(str,1,index(str,".p") + 1).
else
str = substr(str,1,index(str,".w") + 1).
if search(str) ne ? and not can-find(P-LIST where
P-LIST.FULL-PATH = search(str)
and P-LIST.PARNT-NUM = PROG-LIST.PROG-NUM)
then do:
PROG-CNT = PROG-CNT + 1.
create P-LIST.
assign P-LIST.PROG-NAME = str
P-LIST.FULL-PATH = search(str)
P-LIST.LEVEL = LVL-CNT
P-LIST.PROG-NUM = PROG-CNT
P-LIST.PARNT-NUM = PROG-LIST.PROG-NUM
.
end.
end. /* if index(str,"run") */
if index(str,chr(123)) > 0 then do:
str = trim(substr(str,index(str,chr(123)) + 1)).
if index(str," ") > 0 then str = trim(substr(str,1,index(str," "))).
if index(str,chr(125)) > 0
then str = trim(substr(str,1,index(str,chr(125)) - 1)).
if search(str) ne ? and not can-find(P-LIST where
P-LIST.FULL-PATH = search(str)
and P-LIST.PARNT-NUM = PROG-LIST.PROG-NUM)
then do:
PROG-CNT = PROG-CNT + 1.
create P-LIST.
assign P-LIST.PROG-NAME = str
P-LIST.FULL-PATH = search(str)
P-LIST.LEVEL = LVL-CNT
P-LIST.PROG-NUM = PROG-CNT
P-LIST.PARNT-NUM = PROG-LIST.PROG-NUM
.
end.
end.
end.
input stream DMI close.
PROG-LIST.PROCESSED = yes.
end. /* MAIN-LOOP */
/*
for each PROG-LIST:
display FULL-PATH prog-num parnt-num level.
end.
*/
output stream DMI to value(TO-FILE).
find PROG-LIST where PROG-LIST.PROG-NUM = 1.
put stream DMI PROG-LIST.FULL-PATH skip.
PROG-LIST.PROCESSED = no.
PRINT-BLOCK:
do while LVL-CNT >= 0:
LVL-CNT = 0.
find first P-LIST where P-LIST.PARNT-NUM = PROG-LIST.PROG-NUM
and P-LIST.PROCESSED = yes
no-error.
if avail P-LIST then do:
assign
P-LIST.PROCESSED = no
LVL-CNT = P-LIST.LEVEL.
put stream DMI space(LVL-CNT * OFFSET) P-LIST.FULL-PATH skip.
find PROG-LIST where recid(PROG-LIST) = recid(P-LIST).
end.
else do:
find first P-LIST where P-LIST.LEVEL = LVL-CNT
and P-LIST.PARNT-NUM = PROG-LIST.PARNT-NUM
and P-LIST.PROCESSED = yes
no-error.
if avail P-LIST then do:
assign P-LIST.PROCESSED = no.
put stream DMI space(LVL-CNT * OFFSET) P-LIST.FULL-PATH skip.
find PROG-LIST where recid(PROG-LIST) = recid(P-LIST).
end.
else do:
assign SAV-NUM = PROG-LIST.PARNT-NUM.
if SAV-NUM = 0 then leave PRINT-BLOCK.
find PROG-LIST where PROG-LIST.PROG-NUM = SAV-NUM.
LVL-CNT = PROG-LIST.LEVEL.
end.
end. /* not avail P-LIST*/
end. /* PRINT-BLOCK */
output stream DMI close.