SDC-NE
IBM Global Network
Leslie L. Koehler
12 Apr 2004
Abstract
This presentation shows how extending the high level tracability of Rexx can enhance understanding the flow of Rexx code at execution time.
These techniques have been extended over time to meet ever-changing needs as responsibility for the maintenance of code written by others has increased.
Some actual problems encountered, how they were solved and even problems encountered in the solution are presented.
A program that reconciles recorded data against vendor supplied data.
6k lines of code
Might run for hours
No restart capability
No logging
Limited error detecting/reporting
Complicated logic
Fix the run time problem by changing a doubly nested DO loop to use a context-addressable stemmed variable.
ix='Les Koehler'
country.ix='USA'
city.ix='Tampa'
state.ix='Florida'
Add a simple TRACK routine
Insert a line after each label to Call TRACK:
ACCOUNTING_VALIDATE:
If trace? Then Do;
Call track sigl 'ACCOUNTING_VALIDATE';
Trace Value result;
End
At execution time, this yields (in the console spool file):
<06:53:58 @287 -> ACCOUNTING_VALIDATE: 474 >
and each line is right aligned to the width of the console to make it different from normal stuff.
Notice that this provides information that would not normally be available, for instance if just a TRACE S had been inserted somewhere:
As informative as this was, I soon discovered it had some shortcomings:
which resulted in a very large spool file.
Luckily, this was discovered during hands-on testing so I avoided upsetting the Operator and VM Support!
To fix the previously mentioned problems, two things had to be done:
Call Track_Dump 'PUSH 3' /* Keep 3 nesting levels */
Do expression
Call rtn1
End
Call Track_Dump 'POP'
<12:16:33 @22 -> RTN2: 40 >
RTN2 running
RTN2 running
RTN2 running
<12:16:33 @22 -> RTN2: 40 (3 times) >
<12:16:33 @28 -> LAST: 44 >
LAST running
<12:32:23 @22 -> RTN1: 35 >
RTN1 running
<12:32:23 @37 -> RTN2: 40 >
RTN2 running
RTN1 running
RTN2 running
<12:32:23 @22 -> RTN1: 35 (2 times) >
<12:32:23 @37 -> RTN2: 40 (2 times) >
RTN1: Procedure Expose (!!trackvars)
If !!trace? Then Do;
Call track sigl '-1';
Trace Value result;End
Say 'RTN1 running'
Return
!sq='/'||'*'
!eq='*'||'/'
!lbrk='{'
!rbrk='}'
!level=0
!callvars='!sq !eq !lbrk !rbrk !level !ind. !mark.' Return
r='RTN1'
Call value r 'stuff','more'
{0} call RTN1 "stuff" ,"more"
arg()=2 arg(1,"E")=1 arg(2,"E")=1
arg(1)=stuff arg(2)=more
{1} Return
/* A weird */ call name/* a comment */,
/* example */ 'RTN5',
/* comment */ 'first arg', ,
/* stuff x */ ,'third arg'
{0} call RTN5 "first arg", ,"third arg"
3 args were passed.
arg(1,E)=1 arg(2,E)=0 arg(3,E)=1
arg(1)=first arg arg(2)= arg(3)=third arg
{1} Return
{0} Result= RTN5 result
<@59 -> RTNB: 407 >
<{0} @60 -> RTN1: 417 >
<{1} @438 -> RTN2: 446 >
<{2} @454 -> RTN3: 462 >
<{3} @470 -> RTN4: 478 >
<{4} @492 -> RTN5: 500 >
<{0} @61 -> RTNB: 407 >
<59 -> RTNB: 407 (2 times) >
<{0} @60 -> RTN1: 417 (2 times) >
<{1} @438 -> RTN2: 446 (2 times) >
<{2} @454 -> RTN3: 462 (2 times) >
<{3} @470 -> RTN4: 478 (2 times) >
<{4} @492 -> RTN5: 500 (2 times) >
<{0} @61 -> RTNB: 407 (2 times) >
<@59 -> RTNB: 407 >
<{0} @60 -> RTN1: 417 >
<{1} @438 -> RTN2: 446 >
<{2} @454 -> RTN3: 462 >
<{3} @470 -> RTN4: 478 >
<{4} @492 -> RTN5: 500 >
<{0} @61 -> RTNB: 407 >
<59 -> RTNB: 407 (2 times) >
<{0} @60 -> RTN1: 417 (2 times) >
<{1} @438 -> RTN2: 446 (2 times) >
<{2} @454 -> RTN3: 462 (2 times) >
<{3} @470 -> RTN4: 478 (2 times) >
<{4} @492 -> RTN5: 500 (2 times) >
<{0} @61 -> RTNB: 407 (2 times) >
<@59 -> RTNB: 407 >
<{0} @60 -> RTN1: 417 >
<{1} @438 -> RTN2: 446 >
<{2} @454 -> RTN3: 462 >
<{3} @470 -> RTN4: 478 >
<{4} @492 -> RTN5: 500 >
<{0} @61 -> RTNB: 407 >
<59 -> RTNB: 407 (2 times) >
<{0} @60 -> RTN1: 417 (2 times) >
<{1} @438 -> RTN2: 446 (2 times) >
<{2} @454 -> RTN3: 462 (2 times) >
<{3} @470 -> RTN4: 478 (2 times) >
<{4} @492 -> RTN5: 500 (2 times) >
<{0} @61 -> RTNB: 407 (2 times) >
/* Sample internal tracking subroutines
{1} !UPDATE! !UPTIME!
*/
Address COMMAND
Parse Source . . exec_name exec_type .
opts='TRACE O *'
Call init_track
/*
call rtn2
Call track ' This is text'
exit
*/
/*
call rtn2
Call track ' This is text'
exit
*/
Call rtn2
Call track_dump 'PUSH 3'
Do 5
Call rtn2
Call track 'Text'
/*
call rtn2
*/
End
Call track_dump
Exit
RTN1: Procedure Expose (!!trackvars)
If !!trace? Then Do;Call track sigl '-1';Trace Value result;End
Say 'RTN1 running'
Call rtn2
Return
RTN2: Procedure Expose (!!trackvars)
If !!trace? Then Do;Call track sigl 'RTN2';Trace Value result;End
Say 'RTN2 running'
Return
LAST: Procedure Expose (!!trackvars)
If !!trace? Then Do;Call track sigl '-1';Trace Value result;End
Say 'LAST running'
Return
/*.----------------.
| INIT_TRACK |
'----------------'*/
INIT_TRACK:
Trace o
Parse Value 0 0 With !!trace? !!debug !!subs file_opts
!!trackvars='sigl !!trace? !!debug !!subs !!track. !!saypad' ,
'!!right? !!right'
/*Call get_vars
*/If opts='' & file_opts='' Then Do
opts='TRACE O *'
End
!!saypad=Copies(' ',39) /* Padding for SAY output */
!!right?=0
!!right=79
!!track.=0 /* Initialize all slots to zero */
!!track.0=1 /* Default number of slots */
!!track.!='' /* PUSH save area */
j = Find(file_opts,'TRACE') /* Get the debug options */
If j>0 & j<Words(file_opts)-1 Then Do /* Handle default settings */
!!debug = Word(file_opts,j+1)
!!subs = !!subs Subword(file_opts,j+2)
!!trace?=1
End
j = Find(opts,'TRACE') /* Any debug options on cmd line? */
If j>0 & j<Words(opts)-1 Then Do /* Handle them also */
!!debug = Word(opts,j+1)
!!subs = !!subs Subword(opts,j+2)
!!trace?=1
End
Return
/*.--------------. Get the initialization variables
| GET_VARS |
'--------------'*/
GET_VARS:
'EXEC CNSVARS' /* Set the vars via GLOBALV */
'GLOBALV SELECT CNSVARS GET V.0' /* Get the number of vars */
Do z=1 To v.0
'GLOBALV SELECT CNSVARS GET V.'z /* Get the varname */
'GLOBALV SELECT CNSVARS GET' v.z /* Set the variable */
Say v.z'='Value(v.z)
End
Drop v.
Return
/*.----------------. PUSH n-Tracks across N 'slots' for nested calls
| TRACK_DUMP | POP -Sets everything back to where it was
'----------------'*/
TRACK_DUMP: Procedure Expose !!track. !!saypad !!right !!right?
Trace o
Arg pushpop newslots .
Do ptr=1 To !!track.@
iy=!!track.ptr /* Get save caller & callee info */
If !!track.iy.ptr>1 Then Do /* Dump if > 1 */
Parse Var iy r l f rest
If Datatype(r,'Whole') , /* Normal entry */
& Datatype(f,'Whole') Then Do /* Normal entry */
Call track_say ,
'@'r '->' l':' f '('!!track.iy.ptr 'times)'
End
Else Do /* Text entry */
Parse Var iy . rest
Call track_say ,
'@'r rest '('!!track.iy.ptr 'times)'
End
End
End
slots=!!track.0 /* Save the number of slots allowed */
save=!!track.! /* Save any PUSHed slot number info */
If save=0 Then save='' /* Null, instead of zero */
!!track.=0 /* Set all entries to zero */
!!track.0=slots /* Restore the number of slots allowed */
!!track.!=save /* Restore any saved data */
Select
When pushpop='' Then Nop
When pushpop='PUSH' Then Do
!!track.!=!!track.0 !!track.! /* Save the current number of slots */
!!track.0=newslots /* Set the new */
End
When pushpop='POP' Then Do
If !!track.!\='' Then Do /* Restore the saved number of slots */
Parse Var !!track.! !!track.0 !!track.!
End
Else Say 'Nothing left in !!TRACK.! to Pop.'
End
Otherwise Nop
End
Return
/*
!!track.0 = Number of slots to use
!!track.ix = Pointer to counter of number of times called
!!track.ptr = Caller & callee information in the form:
Calling line number (Passed as 'sigl')
Called routine name (Hard-coded per routine)
to allow compiling. If compiling is not
required, then pass the offset to the lable, i.e. -1
Called routine line number (gotten from 'sigl')
!!track.@ = Number of slots used
!!track.! = Push save area
*/
/*.-----------.
| TRACK |
'-----------'*/
TRACK: Procedure Expose (!!trackvars)
Trace Value 'o'
line=Arg(1)
Parse Arg caller_from label
called_from=sigl
l=Word(label,1)
If Datatype(l,'N') Then Do
ll=Word(Sourceline(called_from+l),1)
label=Strip(Translate(ll,' ',':'))
End
Trace o
caller_from?=Datatype(caller_from,'Whole')
If caller_from? Then ix=caller_from label called_from /* Normal */
Else ix=called_from line /* Text */
If !!track.ix=0 Then Do /* Not already tracking this */
If !!track.@<!!track.0 Then Do /* We have a free slot */
ptr=!!track.@+1 /* Establish pointer to it */
End
Else Do /* No free slot. Dump ctrs */
Call track_dump
ptr=1
End
!!track.ix=ptr /* Save it for later */
!!track.ix.ptr=1 /* Set count to one */
!!track.ptr=ix /* Save caller & callee info */
!!track.@=ptr /* Save slot number */
End
Else Do /* We're already tracking this caller & callee */
ptr=!!track.ix /* Get the ptr to the counter */
!!track.ix.ptr=!!track.ix.ptr+1 /* Bump the counter */
End
flag='O'
If Find(!!subs,label)>0 Then flag=!!debug
If flag\='O' | Find(!!subs,'*')>0 Then Do
If !!track.ix.ptr=1 Then Do /* Show if first one */
If caller_from? Then Do
Call track_say ,
'@'caller_from '->' label':' called_from
End
Else Do
Call track_say ,
'@'called_from line
End
End
End
Return flag
/*.---------------. Format and type a SAY for TRACK
| TRACK_SAY |
'---------------'*/
TRACK_SAY: Procedure Expose !!right? !!right !!saypad
line='<'Time() Arg(1) '>'
If !!right? Then Say Right(line,!!right)
Else Say !!saypad line
Return
/**/
Trace o
Address COMMAND
Call init_call
rtn1='lesk'
r='RTN1'
Call value r 'stuff','more'
/*
If symbol('RESULT')='VAR' Then say !ind.!level 'Result=' result
else say !ind.!level 'No Result'
drop result
*/
/*
/* another*/ call name/* a comment */,
/* weird */ 'RTN1',
'stuff','more'
*/
trace o
If Symbol('RESULT')='VAR' Then Say !pad.!level !mark.!level 'Result=' result
Else Say !pad.!level !mark.!level'No Result'
Exit
/*.---------------.
| INIT_CALL |
'---------------'*/
INIT_CALL:
!sq='/'||'*'
!eq='*'||'/'
!lbrk='{'
!rbrk='}'
!level=0
!callvars='!sq !eq !lbrk !rbrk !level !ind. !mark.'
return
/*.---------------.
| UNCOMMENT |
'---------------'*/
UNCOMMENT: PROCEDURE EXPOSE !SQ !eq
Arg !line
!hit=Pos(!sq,!line)
If !hit>0 Then Do
Do Until !hit=0
!nxt=Pos(!eq,!line,!hit+2)
If !nxt>0 Then Do
!line=Overlay(' ',!line,!hit,2+!nxt-!hit)
!hit=Pos(!sq,!line,!nxt+2)
End
End
End
Return !line
/*.----------.
| NAME |
'----------'*/
NAME:
Trace o
!from=sigl
!line=uncomment(Translate(Sourceline(!from)))
!hit=wordpos('NAME',!line)
!comma?=0
If !hit>0 Then Do
!!hit=Pos('NAME',!line)+4
!nxt=Substr(!line,!!hit)
!comma?=(Left(Space(!nxt,0),1)=',')
End
If !hit=0 Then Do
!hit=wordpos('NAME,',!line)
!comma?=1
End
If Words(!line>!hit) & \!comma? Then !name=Subword(!line,!hit+1,1)
Else Do
!!hit=Pos('NAME',!line)+4
!nxt=Substr(!line,!!hit)
If Left(Space(!nxt,0),1)=',' Then Do
!line=uncomment(Translate(Sourceline(!from+1)))
!name=Word(uncomment(!line),1)
End
End
!name=Translate(!name,' ',',''"')
/*.-----------.
| VALUE |
'-----------'*/
VALUE:
!args=Arg()
Do !a=1 To !args
!anum.!a=Arg(!a)
End
Parse Var !anum.1 !target !anum.1
If Symbol('!name')='VAR' Then !target=!name
Else !from=sigl
Drop !name
!str=!target
If !anum.1\=='' Then !str=!str '"'!anum.1'"'
Do !a=2 To !args
If !anum.!a\=='' Then !str=!str ',"'!anum.!a'"'
Else !str=!str','
End
If !level>0 Then Do
If Symbol('!PAD'.!level)\='VAR' Then Do
!pad.!level=Copies(' ',!level )
!ind.!level=!pad.!level' '
!mark.!level=!lbrk||!level||!rbrk
End
End
Else Do
If Symbol('!PAD'.!level)\='VAR' Then Do
!pad.!level=''
!ind.!level=!pad.!level
!mark.!level=!lbrk||!level||!rbrk
End
End
Say !pad.!level !mark.!level 'call' !str
!level=!level+1
If Symbol('!PAD'.!level)\='VAR' Then Do
!pad.!level=Copies(' ',!level )
!ind.!level=!pad.!level' '
!mark.!level=!lbrk||!level||!rbrk
End
Interpret 'call' !str
Say !pad.!level !mark.!level 'Return'
!level=!level-1
If Symbol('RESULT')='VAR' Then Return result
Return
/*.----------.
| RTN1 |
'----------'*/
RTN1: PROCEDURE EXPOSE (!CALLVArs)
aa=Arg()
Parse Value '' With l1 l2
l1='arg()='aa' '
Do a=1 To aa
l1=l1|| 'arg('a',"E")='Arg(a,'E')' '
If Arg(a,'E') Then Do
l2=l2|| 'arg('a')='Arg(a)' '
End
End
Say !ind.!level l1
Say !ind.!level l2
/*
return
say !ind.!level 'arg(1,'E')='arg(1,'E'),
'arg(2,'E')='arg(2,'E') 'arg(3,'E')='arg(3,'E')
say !ind.!level 'arg(1)='arg(1),
'arg(2)='arg(2) 'arg(3)='arg(3)
*/
Call name rtn2 'first arg'
If Symbol('RESULT')='VAR' Then Say !pad.!level !mark.!level 'Result=' result
Else Say !pad.!level !mark.level'No Result'
If Symbol('RESULT')='VAR' Then Return result
Return
/*.----------.
| RTN2 |
'----------'*/
RTN2:
Say !ind.!level Arg() 'args were passed.'
Say !ind.!level 'arg(1,'e')='Arg(1,'E'),
'arg(2,'e')='Arg(2,'E') 'arg(3,'e')='Arg(3,'E')
Say !ind.!level 'arg(1)='Arg(1),
'arg(2)='Arg(2) 'arg(3)='Arg(3)
Call name rtn3 'first arg','second arg'
If Symbol('RESULT')='VAR' Then Say !pad.!level !mark.!level 'Result=' result
Else Say !pad.!level !mark.level'No Result'
If Symbol('RESULT')='VAR' Then Return result
Return
/*.----------.
| RTN3 |
'----------'*/
RTN3:
Say !ind.!level Arg() 'args were passed.'
Say !ind.!level 'arg(1,'e')='Arg(1,'E'),
'arg(2,'e')='Arg(2,'E') 'arg(3,'e')='Arg(3,'E')
Say !ind.!level 'arg(1)='Arg(1),
'arg(2)='Arg(2) 'arg(3)='Arg(3)
Call name rtn4 'first arg','second arg','third arg'
If Symbol('RESULT')='VAR' Then Say !pad.!level !mark.!level 'Result=' result
Else Say !pad.!level !mark.level'No Result'
If Symbol('RESULT')='VAR' Then Return result
Return
/*.----------.
| RTN4 |
'----------'*/
RTN4:
Say !ind.!level Arg() 'args were passed.'
Say !ind.!level 'arg(1,'e')='Arg(1,'E'),
'arg(2,'e')='Arg(2,'E') 'arg(3,'e')='Arg(3,'E')
Say !ind.!level 'arg(1)='Arg(1),
'arg(2)='Arg(2) 'arg(3)='Arg(3)
Call name rtn5 'first arg',,'third arg'
If Symbol('RESULT')='VAR' Then Say !pad.!level !mark.!level 'Result=' result
Else Say !pad.!level !mark.level'No Result'
If Symbol('RESULT')='VAR' Then Return result
Return
/*.----------.
| RTN5 |
'----------'*/
RTN5:
Say !ind.!level Arg() 'args were passed.'
Say !ind.!level 'arg(1,'e')='Arg(1,'E'),
'arg(2,'e')='Arg(2,'E') 'arg(3,'e')='Arg(3,'E')
Say !ind.!level 'arg(1)='Arg(1),
'arg(2)='Arg(2) 'arg(3)='Arg(3)
Return 'RTN5 result'
/* Sample internal tracking subroutines with CALL extensions integrated
{1} !UPDATE! !UPTIME!
*/
Address COMMAND
Parse Source . . exec_name exec_type .
opts='TRACE O *'
Call init_track
Call init_call
/*
rtn1='lesk'
r='RTNB'
Call value r 'stuff','more'
If symbol('RESULT')='VAR' Then say !ind.!level 'Result=' result
else say !ind.!level 'No Result'
drop result
exit
*/
/*
/* another*/ call name/* a comment */,
/* weird */ 'RTN1',
'stuff','more'
If Symbol('RESULT')='VAR' Then Say !ind.!level 'Result=' result
Else Say !ind.!level 'No Result'
Exit
*/
/*
call NAME rtnb
exit
*/
/*
call track ' Text w/leading blank'
call rtnb
Exit
*/
Call track_dump 'PUSH 7'
/*
do 2
call rtnb
call name rtn4
/*
call name rtnb
*/
end
*/
/*
do 2
call rtnb
call name rtn4
call name rtnb
end
*/
r='RTNB'
Do 2
Call rtnb
Call name rtn1
Call value rtnb
End
/*
'EXEC VARSHOW'
do 2 /* */
call rtnb
call name rtn1
/*call name rtnb */
end
*/
/*
do 2 /* But this works! */
call name rtnb
call name rtn1
call name rtnb
end
*/
Call track_dump 'POP'
Exit
/*.----------------.
| INIT_TRACK |
'----------------'*/
INIT_TRACK:
Trace o
Parse Value 0 0 With !!trace? !!debug !!subs file_opts
!!trackvars='sigl !!trace? !!debug !!subs !!track. !!saypad' ,
'!!right? !!right'
/*Call get_vars
*/If opts='' & file_opts='' Then Do
opts='TRACE O *'
End
!!saypad=Copies(' ',39) /* Padding for SAY output */
!!right?=0
!!right=79
!!track.=0 /* Initialize all slots to zero */
!!track.0=1 /* Default number of slots */
!!track.!='' /* PUSH save area */
j = Find(file_opts,'TRACE') /* Get the debug options */
If j>0 & j<Words(file_opts)-1 Then Do /* Handle default settings */
!!debug = Word(file_opts,j+1)
!!subs = !!subs Subword(file_opts,j+2)
!!trace?=1
End
j = Find(opts,'TRACE') /* Any debug options on cmd line? */
If j>0 & j<Words(opts)-1 Then Do /* Handle them also */
!!debug = Word(opts,j+1)
!!subs = !!subs Subword(opts,j+2)
!!trace?=1
End
Return
/*.--------------. Get the initialization variables
| GET_VARS |
'--------------'*/
GET_VARS:
'EXEC CNSVARS' /* Set the vars via GLOBALV */
'GLOBALV SELECT CNSVARS GET V.0' /* Get the number of vars */
Do z=1 To v.0
'GLOBALV SELECT CNSVARS GET V.'z /* Get the varname */
'GLOBALV SELECT CNSVARS GET' v.z /* Set the variable */
Say v.z'='Value(v.z)
End
Drop v.
Return
/*.----------------. PUSH n-Tracks across N 'slots' for nested calls
| TRACK_DUMP | POP -Sets everything back to where it was
'----------------'*/
TRACK_DUMP: Procedure Expose !!track. (!callvars) !!saypad !!right?,
!!right
Trace o
Arg pushpop newslots .
/*
'EXEC VARSHOW'
*/
Do ptr=1 To !!track.@
iy=!!track.ptr /* Get saved caller & callee info */
If !!track.iy.ptr>1 Then Do /* Dump if > 1 */
If Left(iy,1)='!' Then Do /* Level track entry */
iz=iy
Parse Var iy prev iy
Parse Var iy r l f rest
If Datatype(r,'Whole') Then Do /* Normal entry */
Call track_say prev ,
'@'r '->' l':' f '('!!track.iz.ptr 'times)'
End
Else Do /* Text entry */
Parse Var iy . rest
Call track_say ,
'@'r rest '('!!track.iz.ptr 'times)'
End
End
Else Do /* Regular track w/o level */
Parse Var iy r l f rest
If Datatype(r,'Whole') Then Do /* Normal entry */
Call track_say ,
'@'r '->' l':' f '('!!track.iy.ptr 'times)'
End
Else Do /* Text entry */
Call track_say ,
'@'r rest '('!!track.iy.ptr 'times)'
End
End
End
End
slots=!!track.0 /* Save the number of slots allowed */
save=!!track.! /* Save any PUSHed slot number info */
If save=0 Then save='' /* Null, instead of zero */
!!track.=0 /* Set all entries to zero */
!!track.0=slots /* Restore the number of slots allowed */
!!track.!=save /* Restore any saved data */
Select
When pushpop='' Then Nop
When pushpop='PUSH' Then Do
!!track.!=!!track.0 !!track.! /* Save the current number of slots */
!!track.0=newslots /* Set the new */
End
When pushpop='POP' Then Do
If !!track.!\='' Then Do /* Restore the saved number of slots */
Parse Var !!track.! !!track.0 !!track.!
End
Else Say 'Nothing left in !!TRACK.! to Pop.'
End
Otherwise Nop
End
Return
/*
!!track.0 = Number of slots to use
!!track.ix = Pointer to counter of number of times called
!!track.ptr = Caller & callee information in the form:
Calling line number (Passed as 'sigl')
Called routine name (Hard-coded per routine)
to allow compiling. If compiling is not
required, then pass the offset to the lable, i.e. -1
Called routine line number (gotten from 'sigl')
!!track.@ = Number of slots used
!!track.! = Push save area
*/
/*
'EXEC VARSHOW'
Exit
*/
/*.-----------.
| TRACK |
'-----------'*/
TRACK: Procedure Expose (!!trackvars) (!callvars)
Trace Value 'O'
line=Arg(1)
Parse Arg caller_from label
/*
'EXEC VARSHOW'
*/
called_from=sigl
l=Word(label,1)
If Datatype(l,'N') Then Do
ll=Word(Sourceline(called_from+l),1)
label=Strip(Translate(ll,' ',':'))
End
prefix=''
caller_from?=Datatype(caller_from,'Whole')
If caller_from? Then Do
If Translate(Word(Sourceline(caller_from),1))='INTERPRET' Then Do
prefix='!'
caller_from=!from
ix=!level-1
If ix<0 Then ix=0
ix=prefix||ix
ix=ix caller_from label called_from
End
Else ix=caller_from label called_from
End
Else ix=line
If !!track.ix=0 Then Do /* Not already tracking this */
If !!track.@<!!track.0 Then Do /* We have a free slot */
Trace o
ptr=!!track.@+1 /* Establish pointer to it */
End
Else Do /* No free slot. Dump ctrs */
Call track_dump
ptr=1
End
!!track.ix=ptr /* Save it for later */
!!track.ix.ptr=1 /* Set count to one */
!!track.ptr=ix /* Save caller & callee info */
!!track.@=ptr /* Save slot number */
End
Else Do /* We're already tracking this caller & callee */
ptr=!!track.ix /* Get the ptr to the counter */
!!track.ix.ptr=!!track.ix.ptr+1 /* Bump the counter */
End
Trace o
flag='O'
If Find(!!subs,label)>0 Then flag=!!debug
If flag\='O' | Find(!!subs,'*')>0 Then Do
If !!track.ix.ptr=1 Then Do /* Show if first one */
If caller_from? Then Do
Call track_say ,
prefix '@'caller_from '->' label':' called_from
End
Else Do
Call track_say ,
prefix '@'called_from line
End
End
End
Return flag
/*.---------------. Format and type a SAY for TRACK
| TRACK_SAY |
'---------------'*/
TRACK_SAY: Procedure Expose !!right? !!right !!saypad (!callvars)
Trace o
arg1=Arg(1)
If !!right? Then Do
line='<'Time() arg1 '>'
Say Right(line,!!right)
End
Else Do
new?=(Left(arg1,1)='!')
If new? Then Do
Parse Var arg1 prev rest
Parse Var prev 2 prev .
If Datatype(prev,'Whole') Then Do
If prev<0 Then prev=0
End
Else Do
prev=!level-1
If prev<0 Then prev=0
End
arg1=rest
line=!!saypad||!pad.prev '<'||!lbrk||prev||!rbrk arg1 '>'
End
Else Do
line=!!saypad '<'Substr(arg1,2) '>'
End
Say line
End
Return
Trace o
Address COMMAND
INIT_CALL:
!sq='/'||'*'
!eq='*'||'/'
!lbrk='{'
!rbrk='}'
!level=0
!callsay?=0
!callvars='!sq !eq !lbrk !rbrk !level !ind. !pad. !mark. !callsay?' ,
'!from'
Return
UNCOMMENT: Procedure Expose !sq !eq
Arg !line
!hit=Pos(!sq,!line)
If !hit>0 Then Do
Do Until !hit=0
!nxt=Pos(!eq,!line,!hit+2)
If !nxt>0 Then Do
!line=Overlay(' ',!line,!hit,2+!nxt-!hit)
!hit=Pos(!sq,!line,!nxt+2)
End
End
End
Return !line
NAME:
Trace o
!from=sigl
!line=uncomment(Translate(Sourceline(!from)))
!hit=wordpos('NAME',!line)
!comma?=0
If !hit>0 Then Do
!!hit=Pos('NAME',!line)+4
!nxt=Substr(!line,!!hit)
!comma?=(Left(Space(!nxt,0),1)=',')
End
If !hit=0 Then Do
!hit=wordpos('NAME,',!line)
!comma?=1
End
If Words(!line>!hit) & \!comma? Then !name=Subword(!line,!hit+1,1)
Else Do
!!hit=Pos('NAME',!line)+4
!nxt=Substr(!line,!!hit)
If Left(Space(!nxt,0),1)=',' Then Do
!line=uncomment(Translate(Sourceline(!from+1)))
!name=Word(uncomment(!line),1)
End
End
!name=Translate(!name,' ',',''"')
VALUE:
!args=Arg()
Do !a=1 To !args
!anum.!a=Arg(!a)
End
Parse Var !anum.1 !target !anum.1
If Symbol('!name')='VAR' Then !target=!name
Else !from=sigl
Drop !name
!str=!target
If !anum.1\=='' Then !str=!str '"'!anum.1'"'
Do !a=2 To !args
If !anum.!a\=='' Then !str=!str ',"'!anum.!a'"'
Else !str=!str','
End
If !level>0 Then Do
If Symbol('!PAD'.!level)\='VAR' Then Do
!pad.!level=Copies(' ',!level )
!ind.!level=!pad.!level' '
!mark.!level=!lbrk||!level||!rbrk
End
End
Else Do
If Symbol('!PAD'.!level)\='VAR' Then Do
!pad.!level=''
!ind.!level=!pad.!level
!mark.!level=!lbrk||!level||!rbrk
End
End
If !callsay? Then Say !pad.!level !mark.!level 'call' !str
!level=!level+1
If Symbol('!PAD'.!level)\='VAR' Then Do
!pad.!level=Copies(' ',!level )
!ind.!level=!pad.!level' '
!mark.!level=!lbrk||!level||!rbrk
End
Interpret 'call' !str
If !callsay? Then Say !pad.!level !mark.!level 'Return'
!level=!level-1
If Symbol('RESULT')='VAR' Then Return result
Return
RTNA: Procedure Expose (!!trackvars) (!callvars)
If !!trace? Then Do;Call track sigl '-1';Trace Value result;End
/*
SAY 'RTN1 running'
*/
Call name rtnb
If !callsay? Then Do
If Symbol('RESULT')='VAR' Then Say !pad.!level !mark.!level 'Result=' result
Else Say !pad.!level !mark.!level'No Result'
End
Return
RTNB: Procedure Expose (!!trackvars) (!callvars)
If !!trace? Then Do;Call track sigl '-1';Trace Value result;End
/*
SAY 'RTN2 running'
*/
Return
LAST: Procedure Expose (!!trackvars) (!callvars)
If !!trace? Then Do;Call track sigl '-1';Trace Value result;End
Say 'LAST running'
Return
RTN1: Procedure Expose (!callvars) (!!trackvars)
If !!trace? Then Do;Call track sigl '-1';Trace Value result;End
If !callsay? Then Do
aa=Arg()
Parse Value '' With l1 l2
l1='arg()='aa' '
Do a=1 To aa
l1=l1|| 'arg('a',"E")='Arg(a,'E')' '
If Arg(a,'E') Then Do
l2=l2|| 'arg('a')='Arg(a)' '
End
End
Say !ind.!level l1
Say !ind.!level l2
End
/*
return
say !ind.!level 'arg(1,'E')='arg(1,'E'),
'arg(2,'E')='arg(2,'E') 'arg(3,'E')='arg(3,'E')
say !ind.!level 'arg(1)='arg(1),
'arg(2)='arg(2) 'arg(3)='arg(3)
*/
Call name rtn2 'first arg'
If !callsay? Then Do
If Symbol('RESULT')='VAR' Then Say !pad.!level !mark.!level 'Result=' result
Else Say !pad.!level !mark.!level'No Result'
End
If Symbol('RESULT')='VAR' Then Return result
Return
RTN2:
If !!trace? Then Do;Call track sigl '-1';Trace Value result;End
If !callsay? Then Do
Say !ind.!level Arg() 'args were passed.'
Say !ind.!level 'arg(1,'e')='Arg(1,'E'),
'arg(2,'e')='Arg(2,'E') 'arg(3,'e')='Arg(3,'E')
Say !ind.!level 'arg(1)='Arg(1),
'arg(2)='Arg(2) 'arg(3)='Arg(3)
End
Call name rtn3 'first arg','second arg'
If !callsay? Then Do
If Symbol('RESULT')='VAR' Then Say !pad.!level !mark.!level 'Result=' result
Else Say !pad.!level !mark.!level'No Result'
End
If Symbol('RESULT')='VAR' Then Return result
Return
RTN3:
If !!trace? Then Do;Call track sigl '-1';Trace Value result;End
If !callsay? Then Do
Say !ind.!level Arg() 'args were passed.'
Say !ind.!level 'arg(1,'e')='Arg(1,'E'),
'arg(2,'e')='Arg(2,'E') 'arg(3,'e')='Arg(3,'E')
Say !ind.!level 'arg(1)='Arg(1),
'arg(2)='Arg(2) 'arg(3)='Arg(3)
End
Call name rtn4 'first arg','second arg','third arg'
If !callsay? Then Do
If Symbol('RESULT')='VAR' Then Say !pad.!level !mark.!level 'Result=' result
Else Say !pad.!level !mark.!level'No Result'
End
If Symbol('RESULT')='VAR' Then Return result
Return
RTN4:
If !!trace? Then Do;Call track sigl '-1';Trace Value result;End
/*
Call TRACK_DUMP 'PUSH 2'
*/
If !callsay? Then Do
Say !ind.!level Arg() 'args were passed.'
Say !ind.!level 'arg(1,'e')='Arg(1,'E'),
'arg(2,'e')='Arg(2,'E') 'arg(3,'e')='Arg(3,'E')
Say !ind.!level 'arg(1)='Arg(1),
'arg(2)='Arg(2) 'arg(3)='Arg(3)
End
/*
Call TRACK_DUMP 'POP'
*/
Call name rtn5 'first arg',,'third arg'
If !callsay? Then Do
If Symbol('RESULT')='VAR' Then Say !pad.!level !mark.!level 'Result=' result
Else Say !pad.!level !mark.!level'No Result'
End
If Symbol('RESULT')='VAR' Then Return result
Return
RTN5:
If !!trace? Then Do;Call track sigl '-1';Trace Value result;End
If !callsay? Then Do
Say !ind.!level Arg() 'args were passed.'
Say !ind.!level 'arg(1,'e')='Arg(1,'E'),
'arg(2,'e')='Arg(2,'E') 'arg(3,'e')='Arg(3,'E')
Say !ind.!level 'arg(1)='Arg(1),
'arg(2)='Arg(2) 'arg(3)='Arg(3)
End
Return 'RTN5 result'
RTN6:
If !!trace? Then Do;Call track sigl '-1';Trace Value result;End
If !callsay? Then Do
Say !ind.!level Arg() 'args were passed.'
Say !ind.!level 'arg(1,'e')='Arg(1,'E'),
'arg(2,'e')='Arg(2,'E') 'arg(3,'e')='Arg(3,'E')
Say !ind.!level 'arg(1)='Arg(1),
'arg(2)='Arg(2) 'arg(3)='Arg(3)
End
Call rtnb
Return