Rexx code to modify cobtrace code to include display values



IBM's Command List programming language & Restructured Extended Executor

Rexx code to modify cobtrace code to include display values

Postby mainframe3270 » Thu Mar 28, 2019 12:50 am

I need to modify my cob trace REXX utility for it to display values of a particular program variables at every paragraph entry and exit .

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
mainframe3270
 
Posts: 1
Joined: Thu Mar 28, 2019 12:42 am
Has thanked: 0 time
Been thanked: 0 time

Re: Rexx code to modify cobtrace code to include display values

 

Re: Rexx code to modify cobtrace code to include display val

Postby NicC » Thu Mar 28, 2019 3:18 am

And your question is? This is not a 'write your code for you' forum. There are members who would do it for you - at the going rate.
The problem I have is that people can explain things quickly but I can only comprehend slowly.
Regards
Nic
NicC
Global moderator
 
Posts: 2989
Joined: Sun Jul 04, 2010 12:13 am
Location: Pushing up the daisies (almost)
Has thanked: 4 times
Been thanked: 135 times


Return to CLIST & REXX

 


  • Related topics
    Replies
    Views
    Last post