Years ago I wrote just such a routine. I have included it here as it
isn't too large. Let me know what you think of it.
Please note, this is an example of code I wrote many years ago and was
written as a tool for me so minimal doco etc.
During the analysis phase you can optionally see the calls and the level
they are being called at. Finally it reports on all programs called and
adds what each program calls and is call by.
Also note, there may be some programs you already know about that can be
excluded. See code for details.
Also note, it doesn't get into an endless loop as if a called routine
has already been reported upon it doesn't process it again.
Also note, it uses a neat piece of recursive logic in conjunction with
dynamic arrays so you can explode down to virtually any level if
necessary.
Needless to say it doesn't deal with CALL @xxx statements.
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
PGM.ID = 'HUNT.DOWN.CALLS.XREF'
*
* This routine will read the program source referred to and explode
* down the tree until no more CALLS found and report on the programs
* called.
*
AM = CHAR(254) ; VM = CHAR(253) ; PROMPT ''
MAX.WID = 80
*
KEY.EXCLUDED = PGM.ID:'_EXCLUDED'
*
CRT CHAR(12):PGM.ID "L#40":TIMEDATE()
CRT
*
CRT 'Enter source file name: ': ; INPUT SFILE
OPEN '',SFILE TO SOURCE.FILE ELSE STOP
*
CRT 'Screen or Printer: ': ; INPUT SORP
IF SORP = 'P' OR SORP = 'p' THEN
PRINTER ON
END
*
CRT 'Display 1st stage analysis: ': ; INPUT YORN
ANAL = (YORN MATCH 'Y':@VM:'y')
*
READ EXCLUDED FROM SOURCE.FILE,KEY.EXCLUDED ELSE EXCLUDED = ''
*
DIM PROGS(50)
DIM PD$(4)
MAT PD$ = ''
EQU PD$NAMES TO 1
EQU PD$CALLS TO 2
EQU PD$ACALLS TO 3
EQU PD$CALLBY TO 4
*
PRINT PGM.ID "L#40":TIMEDATE()
PRINT
PRINT ' ':'Excluded' "L#30":'Already'
PRINT
MAX.CNT = DCOUNT(EXCLUDED,AM)
FOR WK = 1 TO MAX.CNT
PRINT ' ':EXCLUDED<WK>
NEXT WK
PRINT
CMD = 'SSELECT ':SFILE
EXECUTE CMD CAPTURING OUTPUT
LOOP
READNEXT PPROG ELSE EXIT
LVL = 0 ; PROG = PPROG ; GOSUB PROCESS.PROGRAM
REPEAT
PRINT
PRINT 'Sorted list of SUBROUTINES'
INPUT OCKO,1 ; IF OCKO EQ 'Q' THEN STOP
PRINT
FIL = SPACE(6)
MAX.CNT = DCOUNT(PD$(PD$NAMES),@VM)
FOR V = 1 TO MAX.CNT
PRINT
PRINT PD$(PD$NAMES)<1,V>
PRINT ' Calls:....'
DATAS = PD$(PD$CALLS)<1,V>
IF LEN(DATAS) THEN
DATAS.CNT = DCOUNT(DATAS,@SM)
DATAS.WID = MAXIMUM(LENS(DATAS)) + 2
GOSUB DISPLAY.DETAILS
END
PRINT ' Called by:....'
DATAS = PD$(PD$CALLBY)<1,V>
IF LEN(DATAS) THEN
DATAS.CNT = DCOUNT(DATAS,@SM)
DATAS.WID = MAXIMUM(LENS(DATAS)) + 2
GOSUB DISPLAY.DETAILS
END
NEXT V
PRINT
PRINT 'END OF REPORT'
STOP
*
PROCESS.PROGRAM:
LOCATE(PROG, EXCLUDED ; FOUND) THEN RETURN
*
FOUND = 0
IF LVL THEN
IF LVL EQ 1 THEN
LOCATE(PROG, PD$(PD$CALLS), 1, PPOS ; FOUND)
ELSE PD$(PD$CALLS)<1, PPOS, -1> = PROG
END
LOCATE(PROG, PD$(PD$ACALLS), 1, PPOS ; FOUND ; 'AL') ELSE
INS PROG BEFORE PD$(PD$ACALLS)<1, PPOS, FOUND>
FOUND = 0
END
LOCATE(PROG, PD$(PD$NAMES), 1 ; POS ; 'AL') ELSE
INS PROG BEFORE PD$(PD$NAMES)<1, POS>
INS '' BEFORE PD$(PD$CALLS)<1, POS>
INS '' BEFORE PD$(PD$ACALLS)<1, POS>
INS '' BEFORE PD$(PD$CALLBY)<1, POS>
IF POS LT PPOS
THEN PPOS += 1
END
LOCATE(PPROG, PD$(PD$CALLBY), 1, POS ; WK ; 'AL')
ELSE INS PPROG BEFORE PD$(PD$CALLBY)<1, POS, WK>
END ELSE
LOCATE(PPROG, PD$(PD$NAMES), 1 ; PPOS ; 'AL') ELSE
INS PPROG BEFORE PD$(PD$NAMES)<1, PPOS>
INS '' BEFORE PD$(PD$CALLS)<1, PPOS>
INS '' BEFORE PD$(PD$ACALLS)<1, PPOS>
INS '' BEFORE PD$(PD$CALLBY)<1, PPOS>
END
END
*
LVL = LVL + 1
IF ANAL THEN
JL = 'R#':(LVL*2)
PRINT (LVL JL) "L#24":PROG "L#30":
END
IF FOUND THEN
IF ANAL THEN
PRINT ' *** already reported!'
END
END ELSE
IF ANAL THEN
PRINT
END
READ REC FROM SOURCE.FILE, PROG ELSE REC = ''
PROGS(LVL) = REC
LOOP
POS = INDEX(PROGS(LVL),' CALL ',1)
WHILE POS DO
IF POS THEN
PROGS(LVL) = PROGS(LVL)[POS+6,LEN(PROGS(LVL))]
POS = 1
LOOP
WK = PROGS(LVL)[POS,1]
UNTIL WK = '' OR INDEX(AM:' ;:,(-',WK,1) DO
POS = POS + 1
REPEAT
PROG = TRIM(PROGS(LVL)[1,POS-1])
GOSUB PROCESS.PROGRAM
END
REPEAT
END
LVL = LVL - 1
RETURN
*
DISPLAY.DETAILS:
WRAP.WID = MAX.WID - LEN(FIL)
PER.LINE = INT(WRAP.WID / DATAS.WID)
LOOP.CNT = INT((DATAS.CNT + PER.LINE - 1) / PER.LINE)
PLINE = SPACE(6)
JL = 'L#':DATAS.WID
POS = 0
FOR L = 1 TO LOOP.CNT
FOR I = 1 TO PER.LINE
POS += 1
PLINE := FMT(DATAS<1,1,POS>,JL)
NEXT I
PRINT PLINE
PLINE = FIL
NEXT L
IF PLINE NE FIL
THEN PRINT PLINE
RETURN
END
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Trevor Ockenden
Open Systems Professionals
E: [EMAIL PROTECTED]
__________________________________________________________________
<< ella for Spam Control >> has removed Spam messages and set aside
Newsletters for me
You can use it too - and it's FREE! http://www.ellaforspam.com
--
No virus found in this outgoing message.
Checked by AVG Anti-Virus.
Version: 7.0.300 / Virus Database: 266.4.0 - Release Date: 22/02/2005
-------
u2-users mailing list
[email protected]
To unsubscribe please visit http://listserver.u2ug.org/
