here is the code of extrace:
Parse Source . . MyName . /* Get Program Name */
Exit_RC = 0 /* Initialize Return Code */
Signal On Failure
Signal On Halt
Signal On Syntax
Address ISPEXEC
"ISREDIT MACRO (PARM1) NOPROCESS"
If RC <> 0 Then Do
zedsmsg = 'Must be Edit/View Mode'
zedlmsg = '"'MyName'" is an Edit Macro'
Exit_RC = RC
Address ISPEXEC "SETMSG MSG(ISRZ001)"
Signal Get_Out_Of_Dodge
End /* Then Do */
"ISPEXEC CONTROL ERRORS RETURN"
Parm1 = translate(Parm1) /* Ensure Upper Case */
/*--------------------------------------------------------------------*/
/* SET UP TEST TRACE IF REQUESTED */
/*--------------------------------------------------------------------*/
If wordpos('TRACE',translate(Parm1)) <> 0 Then Do /*Trace Requested?*/
TCmd = TraceSet('CMD',Parm1) /* Y-Get Trace Command */
Parm1 = TraceSet('PARMS',Parm1) /* Strip Trace Parms */
Say '-*-*-*-*-*- Entering 'MyName' -*-*-*-*-*-'
Interpret TCmd /* Activate Trace */
End /* Then Do */
Else TCmd = '' /* N-Init Trace Command */
/*--------------------------------------------------------------------*/
/* PARSE ANY STACKED PARMS INTO INPARMS STEM */
/*--------------------------------------------------------------------*/
Inparms. = '' /* Initialize INPARMS Stem */
Nbr_Parms = words(Parm1)
If Nbr_Parms > 0 Then
Do i = 1 to Nbr_Parms
Inparms.i = word(Parm1,i)
End /* Then Do i = ... */
OnOffsw = Inparms.1
Top_Ind = 0
If Inparms.2 = 'T' Then
Nbr_Parms = words(Parm1)
If Nbr_Parms > 0 Then
Do i = 1 to Nbr_Parms
Inparms.i = word(Parm1,i)
End /* Then Do i = ... */
OnOffsw = Inparms.1
Top_Ind = 0
If Inparms.2 = 'T' Then
Top_Ind = 1
If OnOffsw='' | wordpos(translate(OnOffsw),'? H HELP') <> 0 Then
Call Help
If ((OnOffsw <> 'ON') & (OnOffsw <> 'OFF')) Then Do
zedsmsg = 'Enter(ON) or (OFF)'
zedlmsg = 'Valid Parms are "ON" and "OFF"'
Exit_RC = 12
Address ISPEXEC "SETMSG MSG(ISRZ000)"
Signal Macro_End
End /* Then Do */
Else Do
"ISREDIT BOUNDS"
If Top_Ind Then /* Top of Data Requested? */
nop /* Y-Don't need Temp Label */
Else Do /* N-Set Temporary Label */
"ISREDIT (CURLIN) = CURSOR" /* Get current cursor line */
"ISREDIT LABEL .ZCSR = .START" /* Set Temporary Label */
End /* Else Do */
End /* Else Do */
Address ISREDIT
If (OnOffsw = 'ON') Then Do
"CURSOR = 1 1"
Find_RC = 0
"FIND WORKING-STORAGE 8"
Find_RC = RC
If Find_RC > 0 Then Do
"FIND LOCAL-STORAGE 8"
Find_RC = RC
End
If Find_RC > 0 Then
Find_RC = 0
Else Do
"FIND '01 PX '"
Find_RC = RC
If Find_RC > 0 Then Do
Find_RC = 0
"RESET"
"LABEL .ZCSR = .CURR"
WrkLine = "*TRACE 88 DX-OFF VALUE '0'. "
"LINE_AFTER .CURR = DATALINE (WrkLine)"
WrkLine = "*TRACE 88 DX VALUE '1'. "
"LINE_AFTER .CURR = DATALINE (WrkLine)"
WrkLine = "*TRACE 01 FILLER VALUE '1' PIC X(01)."
"LINE_AFTER .CURR = DATALINE (WrkLine)"
"(MemName) = MEMBER"
WrkMem = "'" || MemName || "'"
WrkLine = "*TRACE 01 PX"copies(' ',5)'VALUE 'WrkMem||,
copies(' ',10)'PIC X(08).'
"LINE_AFTER .CURR = DATALINE (WrkLine)"
End /* Then Do */
End /* Else Do */
Find_RC = 0
"FIND 'PROCEDURE DIVISION' 8 25 FIRST"
Find_RC = RC
If (Find_RC = 0) Then Do
"(ZCsr) = LINENUM .ZCSR"
Proc = (ZCsr + 1)
"LABEL" Proc "= .PROC"
End /* Then Do */
Else Do
zedsmsg = 'No PROCEDURE DIVISION'
zedlmsg = 'Must have COBOL Program in EDIT/VIEW Mode'
Exit_RC = 12
Address ISPEXEC "SETMSG MSG(ISRZ000)"
Signal Macro_End
End /* Else Do */
End /* Then Do */
Do Until (Find_RC > 0)
If OnOffsw = 'ON' Then Do
"EXCLUDE ALL '*' 7"
"EXCLUDE ALL 'SKIP' 8 11"
"EXCLUDE ALL 'EJECT' 8 12"
"FIND P' ¬' 7 NX FIRST .PROC .ZLAST"
Find_RC = RC
Do While (Find_RC = 0)
"(Here) = LINENUM .ZCSR"
"(WrkLine) = LINE .ZCSR"
Parse Var WrkLine 8 CobLine .
ExitPos = pos(' EXIT.',WrkLine)
If ExitPos > 0 Then Do
ParaLine = substr(WrkLine,1,6)'*'||,
substr(WrkLine,8,length(WrkLine)-7)
"LINE .ZCSR = (ParaLine)"
ExitLine = "*TRCEX EXIT."
WrkLine = '*TRCEP'substr(WrkLine,7,ExitPos-7)||,
copies(' ',6)||,
substr(WrkLine,ExitPos+6,length(WrkLine)-ExitPos-13)
"LINE_AFTER .ZCSR = DATALINE (WrkLine)"
"(Here) = LINENUM .ZCSR"
Here = Here + 1
End /* Then Do */
Else
ExitLine = ''
If (substr(CobLine,length(CobLine)) = '.'),
| pos(' .',WrkLine) > 0 Then Do
CobLine = strip(substr(WrkLine,8,37))
CobLine = strip(CobLine,T,'.')
CobLine = strip(CobLine,T,' ')
CobLine = "' - "CobLine"'"
Wrkline = "*TRACE IF DX DISPLAY PX" CobLine "END-IF"
"LINE_AFTER "Here" = DATALINE (WrkLine)"
If ExitLine <> '' Then Do
Here = Here + 1
"LINE_AFTER "Here" = DATALINE (ExitLine)"
ExitLine = ''
End /* Then Do */
End /* Then Do */
"(Here) = LINENUM .ZCSR"
Here = (Here + 1)
"LABEL" Here "= .HERE"
"FIND P' ¬' 7 NX"
If (RC = 0) Then Do
"(There) = LINENUM .ZCSR"
There = (There - 1)
If There < Here Then There = Here + 1
"LABEL" There "= .THERE"
End /* Then Do */
Else Do
"LABEL .ZLAST = .THERE"
"(There) = LINENUM .THERE"
End /* Else Do */
"CURSOR =" There "1"
"FIND P' ¬' 7 NX"
Find_RC = RC
End /* Do While Find_RC = 0 */
'RESET'
End /* Then Do */
Else Do
"FIND *TRCEP 1 ALL"
Find_RC = RC
Do While (Find_RC = 0)
"(ParaPtr) = LINENUM .ZCSR"
ComPtr = ParaPtr - 1
"LABEL" ComPtr "= .COMM"
"(WrkLine) = LINE .COMM"
ComLine = substr(WrkLine,1,6)' '||,
substr(WrkLine,8,length(WrkLine)-7)
"LINE .COMM = (ComLine)"
"CURSOR =" ParaPtr "1"
"EXCLUDE all P'¬' .ZCSR .ZCSR"
"FIND *TRCEP 1 NX .ZCSR .ZL"
Find_RC = RC
End /* Do While Find_RC = 0 */
"EXCLUDE ALL"
"FIND ALL *TRACE 1"
"FIND ALL *TRCEX 1"
"FIND ALL *TRCEP 1"
"DELETE ALL NX"
"RESET"
Find_RC = 4
End /* Else Do */
End /* Do Until Find_RC > 0 */
If Top_Ind | CurLin = 1 Then /* Top of data requested? */
"ISREDIT UP MAX" /* Y-Then go back there */
Else
"ISREDIT LOCATE .START" /* N-Return to orig display ln*/
Signal Macro_End
MACRO_END: nop
If (Exit_RC > 4) Then Do
Say ''
Say MyName 'Terminated. RC = ' || Exit_RC
End /* If Exit_RC > 4 */
GET_OUT_OF_DODGE: nop
Exit Exit_RC
FAILURE: nop
zedsmsg = '"'MyName'" failed on line ' SIGL
zedlmsg = 'Command was "' sourceline(SIGL)'"',
'on line ' SIGL,
'Abend Code: ' c2x(abs(RC))
If RC = -3 Then
zedsmsg = '"'MyName'" has Bad Command'
Exit_RC = RC
Address ISPEXEC "SETMSG MSG(ISRZ001)"
Signal Macro_End
HALT: nop
zedsmsg = '"'MyName'" was interrupted'
zedlmsg = 'The Attention Key was pressed;',
'"'MyName'" was halted at line' Sigl'.'
Exit_RC = 12
Address ISPEXEC "SETMSG MSG(ISRZ001)"
Signal Macro_End
SYNTAX: nop
zedsmsg = 'Syntax Error' RC 'at' Sigl
zedlmsg = errortext(RC) '(' || RC || ') at line' Sigl'.'
Exit_RC = 12
Address ISPEXEC "SETMSG MSG(ISRZ001)"
Signal Macro_End
HELP: nop /* Procedure */
/*--------------------------------------------------------------------*/
/* Display HELP information from Comment Lines at the top of this */
/* program. HELP information lines are identified by the presence */
/* of "|" in position 3. */
/*--------------------------------------------------------------------*/
LTerm = sysvar(syslterm) /* Get Terminal No. Display Lines */
If LTerm > 24 Then Say
Say
Do LL1 = 1 to sourceline() Until Wk_Dlm_Line = "/*|"
Wk_Dlm_Line = substr(sourceline(LL1),1,3)
End /* Do Until Wk_Dlm_Line ... */
Do LL2 = LL1 to sourceline() Until Wk_Dlm_Line <> "/*|"
Wk_Line = strip(sourceline(LL2),'T')
Wk_Dlm_Line = substr(Wk_Line,1,3)
If Wk_Dlm_Line = "/*|" Then Do
Wk_Line = strip(strip(Wk_Line,'B','/'),'B','*') /*Remove comment*/
Say strip(Wk_Line,'L','|') /* Remove HELP ind & broadcast*/
End /* Then Do */
End /* Do Until Wk_Dlm_Line ... */
Signal Macro_End
Return
Coded - do it yourself next time
