Inline COBOL Error Display Utility

Learn how to quickly debug compile time errors

Return to article

REXX source
------------------------------------------------------------------------
      Syntax :
                Usage :  <cmd> <jobname> <jobid>
                OR
                Usage :  <cmd> <joblog dataset name>
                OR
                Usage :  <cmd> setup
------------------------------------------------------------------------
 */

   ADDRESS ISPEXEC "ISREDIT MACRO (STRING)"
   ADDRESS ISREDIT "RESET"

   call GetProfVar      /* Get Profile variable                       */

   call checkInput      /* Does syntax checking for input             */

   call mainInit        /* Initializes variables                      */

   call getJobInfo      /* Reads job info from the queque             */

   call readSource      /* Reads entire input file into stem variable */

   call mainProcess     /* Main process                               */

   call exitModule      /* Clean up process                           */
return

/* Get error level environment value                                  */
GetProfVar :
   ADDRESS ISPEXEC "VGET (ERRLVL) PROFILE"
   if (ERRLVL = '1' | ERRLVL = '2' | ERRLVL = '3')
   then nop
   else ERRLVL = '2'
 return

/* Does syntax checking for input                                     */
checkInput :
                        /* number of parms has to be 2                */
   if (WORDS(string) ¬= 2 & WORDS(string) ¬= 1)
     then do
             say "Invalid Syntax:"
             call syntaxShow
             ZEDSMSG  = 'RC = 16 '
             ZEDLMSG  = 'INVALID SYNTAX'
             ADDRESS ISPEXEC "ISPEXEC SETMSG MSG(ISRZ001)"
             exit(1)
          end

                        /* setup error level                          */
   if (WORDS(string) = 1 & translate(string) = "SETUP")
     then do
            ADDRESS ISPEXEC
            "ADDPOP ROW(5) COLUMN(20)"
            "DISPLAY PANEL(SHWMSGPL)"
            saveRC = RC
            "REMPOP"
            if saveRC = 0
            then do
              "VPUT (ERRLVL) PROFILE"
               ZEDSMSG  = 'Error level 'ERRLVL
               ZEDLMSG  = 'Error level is set to 'ERRLVL
            end
            else do
               ZEDSMSG  = 'Error level not set'
               ZEDLMSG  = 'Error level setup is not completed'
            end
               ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
             exit(1)
          end

   if (WORDS(string) = 2 ) then do
      DSFlag = 0
      jobName = word(string,1)
      jobId   = word(string,2)
                                         /* Check if job is on queue  */
      ADDRESS TSO
      x = outtrap(out.)                  /* trap TSO command output   */
      "status" jobName"("jobId")"
      x = outtrap('OFF')
      if (pos('ON OUTPUT QUEUE',out.1) > 0) then nop
      else do
         say "Error : " out.1
         call syntaxShow
         ZEDSMSG  = 'RC = 16 '
         ZEDLMSG  = 'RC = 16 '
         ADDRESS ISPEXEC "ISPEXEC SETMSG MSG(ISRZ001)"
         exit(1)
      end
   end
   else do
      DSFlag = 1
      /*Eliminate the single quotes provided by the user*/
      string=STRIP(String,B,"'")
      jobLogName = word(string,1)
      "ALLOC DA('"jobLogName"') F(JOBXXX) SHR REUSE"
      if RC ¬= 0 then do
         "FREE F(JOBXXX)"
         say "Invalid input Dataset ("jobLogName")"
         call syntaxShow
         ZEDSMSG  = 'RC = 16 '
         ZEDLMSG  = 'RC = 16 '
         ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
         exit(1)
       end
      "FREE F(JOBXXX)"
   end
return

/* Syntax to be displayed in case of major errors                     */
syntaxShow :
             say "Usage :  <cmd> <jobname> <jobid> "
             say "OR"
             say "Usage :  <cmd> <joblog dataset name> "
             say "OR"
             say "Usage :  <cmd> setup"
return

/* Initialize certain variables                                       */
mainInit :
                                    /* Used for labels                */
   char1 = 'A B C D E F G H I J K L M N O P Q R S T U V W X Y Z'
   prev_linen = 0

                                    /* Initialize Severe  Error flags */
   do i = 1 to 4
      dec1.i = 1
      dec2.i = 1
      dec3.i = 1
      cntr.i = 0
      LabelList_cntr.i = 0
      LabelList.i. = ""
   end
return

getJobInfo :
                                    /*      write job info to a file  */
   if (DSFlag = 0 ) then do
      call createJoblogFile
   end
   else do
      FileName = jobLogName
   end

   drop X.
   if (DSFlag = 0 )
   then "ALLOC DA("FileName") F(JOBXXX) SHR REUSE"
   else "ALLOC DA('"FileName"') F(JOBXXX) SHR REUSE"
   "EXECIO * DISKR JOBXXX (STEM X. FINIS"
   "FREE F(JOBXXX)"

                                    /* If no job info then error      */
   maxlines = X.0
   if (maxlines = 0 | DATATYPE(maxlines, W) = 0)
   then do
      say " Job Info Read Error (maxlines = 0)"
      ZEDSMSG  = 'RC = 16 '
      ZEDLMSG  = 'RC = 16 '
      ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
      call exitModule
   end
return

/* In case of input from Joblog ; create a seq file name to be used
     retrieve joblog info                                             */
CreateJoblogFile :
   parse value time() with hh":"mm":"ss":"
   parse value date() with dd" "mon" "yyyy
   dd=right(dd,2,"0")
   mm=right(mm,2,"0")
   hh=right(hh,2,"0")
   mm=right(mm,2,"0")
   ss=right(ss,2,"0")
   user=userID()
   yyyy=right(yyyy,2)
   dsname = user||".D"||dd||mon||yyyy||".T"||hh||mm||ss

   ADDRESS TSO
   "OUTPUT "jobName"("jobId") PRINT("dsname") BEGIN HOLD KEEP"
   if (pos('REJECTED',out.1) > 0)
   then do
      say ' Problem while Accessing Joblog '
      say out.1
      call syntaxShow
      ZEDSMSG  = 'RC = 16 '
      ZEDLMSG  = 'RC = 16 '
      ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
      call exitModule
   end
   FileName = dsname".OUTLIST"
                                    /* FileName created               */
return

/* Delete temporarily created seq dataset                             */
deleteJoblogFileName :
   if (DSFlag = 0 ) then do
      outTemp = outtrap(out.)            /* trap TSO command output   */
      ADDRESS TSO "DELETE "FileName" PURGE"
      outTemp = outtrap('OFF')
   end
return

/* Delete temporarily created seq dataset                             */
readSource:
   ADDRESS ISPEXEC "ISREDIT (lend)   = LINENUM .ZLAST"
   ADDRESS ISPEXEC "ISREDIT (lstart) = LINENUM .ZFIRST"

   j=0
   drop in_line.
   do i = lstart to lend
     ADDRESS ISPEXEC "ISREDIT (var)  = LINE (i)"
     pres_line = var
     j = j+1
     in_line.j = translate(pres_line)
   end
   in_max = j
return

mainProcess :
   cntr_occur = 0
   LineIdN = 0
                               /* Compiler and Precompiler options flags
                                  and counters */
   drop FlagOption.
   FlagOptionCntr = 0
   drop SourceOption.
   SourceOptionCntr = 0
   drop SqlOption.
   SqlOptionCntr = 0
   PosPreComp = -1
   PosComp = -1
                               /* Precompile error flags and counters */
   PreLine = 0
   Precomp1 = 0
   PreErrorCnt = 0
   PreErrorStr.= ""
   PreErrorLn. = ""
                               /* Translate  error flags and counters */
   TransErrorCnt = 1
   TransErrorStr.= "Translator Errors Present :"
                               /* Search Job Info                     */
   do  i = 1 to maxlines
      dsnt = substr(X.i,1,4)
      t2 = substr(X.i,2)
      t1 = strip(translate(word(t2,1)))
                               /* Check for Precompiler errors        */
      if (Precomp1 < 2 & pos('DSN', dsnt) > 0 & ,
          (word(t2,2) = 'E' | word(t2,2) = 'S'))
      then do
         Precomp1 = 1
         PreErrorCnt = PreErrorCnt + 1
         PreErrorStr.PreErrorCnt = strip(X.i)
         temp = FIND(t2,'LINE')
         PreErrorLn.PreErrorCnt  = word(t2,temp+1)
      end
                               /* Check for translator                */
      if ( pos('DFH', dsnt) > 0 & word(t2,2) = 'E' & ,
           DATATYPE(word(t2,3),W) = 1)
      then do
         TransErrorCnt = TransErrorCnt + 1
         TransErrorStr.TransErrorCnt = strip(X.i)
      end
                               /* Check for Compiler Options          */
      tempStr1= word(t2,1)
      if(pos('FLAG(',tempStr1) > 0 )
      then do
              FlagOptionCntr = FlagOptionCntr + 1
              FlagOption.FlagOptionCntr = tempStr1
           end
      if(pos('SOURCE',tempStr1) > 0 )
      then do
              SourceOptionCntr = SourceOptionCntr + 1
              SourceOption.SourceOptionCntr = tempStr1
           end
      if(pos('SQL',tempStr1) > 0 )
      then do
              SqlOptionCntr = SqlOptionCntr + 1
              SqlOption.SqlOptionCntr = tempStr1
           end

      if (PreErrorCnt > 0)
      then do
         tempStr = substr(t2,1,20)
         if (pos('DB2 SQL PRECOMPILER',tempStr)>0) then do
            if Precomp1 = 2 then do
               PreLine = i
               leave i
            end
            Precomp1 = 2
         end
      end
      else do
         if (t1 = 'LINEID') then do
            LineIdN = i
            leave i
         end
      end
   end

                               /* Call required modules based on error*/
   if ( TransErrorCnt > 1) then call transCheck
   else if (PreErrorCnt > 0)
   then call preCompCheck      /* For precompile errors               */
   else call compCheck         /* For Normal Compile errors           */

return

/* For Normal Compile errors                                          */
compCheck :
                               /* Joblog missing error check          */
   if LineIdN = 0
   then do
        say "Job Listing not present in Compile output"
        ZEDSMSG  = 'RC = 16 '
        ZEDLMSG  = 'RC = 16 '
        ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
        call exitModule
   end

   JoblogN = LineIdN + 1
   SourceN = 1

   sourceEOF = 0

                               /* Loop thru' entire joblog            */
   do jobLogN = (LineIdN + 1) to  maxlines
                               /* Skip commented lines in source      */
      if (pos('*',in_line.SourceN) = 7)
      then do
        do while (pos('*',in_line.SourceN) = 7)
             SourceN = SourceN + 1
        end
      end
                               /* Skip commented lines in Joblog      */
      if (pos('*',X.JoblogN) = 25)
      then do
        do while (pos('*',X.JoblogN) = 25)
             JoblogN = JoblogN + 1
        end
      end

      jobLogIn = translate(X.JoblogN)
                               /* Skip certain lines in source        */
      if ( (pos('EJECT',in_line.SourceN)  > 0) ,
        | (pos('PROCEDURE DIVISION.',in_line.SourceN)  > 0) ,
        | (pos('DATE-COMPILED.',in_line.SourceN)  > 0) ,
        | (pos(' SKIP1 ',in_line.SourceN)  > 0) )
      then SourceN = SourceN + 1

                               /* If beyond source line then set flag */
      if (SourceN > in_max) then sourceEOF = 1

                               /* Skipped translated lines            */
      if (pos('INSERTED BY TRANSLATOR',jobLogIn)  > 0)
      then do
          JoblogN = JoblogN + 1
          SourceN = SourceN + 1
          iterate JoblogN
      end

                               /* Skip lines without line numbers
                                  in joblog                           */
      LineNum1 = substr(jobLogIn,4,6)
      if (DATATYPE(LineNum1,W) = 0) then iterate JoblogN

                               /* Extract required lines              */
      LineIn = strip(substr(in_line.SourceN,01,72))
      JobIn  = strip(substr(jobLogIn       ,19,72))
                               /* Continue if joblog and source match */
      if (LineIn = JobIn)
      then do
          SourceN = SourceN + 1
          iterate JoblogN
      end

                               /* Skip exec's - since they are
                                  translated                          */
      if ((pos(' EXEC',in_line.SourceN) > 0) )
      then do
          do until (pos('END-EXEC',in_line.SourceN) > 0)
             SourceN = SourceN + 1
          end
          SourceN = SourceN + 1
          iterate JoblogN
      end

                               /* Skip copy's - since they are
                                    expanded                          */
      if (pos('COPY',in_line.SourceN) > 0)
      then do
          SourceN = SourceN + 1
          iterate JoblogN
      end

                               /* Check for presence of compile error
                                  Eye Catcher                         */
      if (pos(' IGY',jobLogIn) > 0)
      then do
          wordA = WORD(jobLogIn,1)
          if (pos('==',wordA) > 0 )
          then do
              word1 = WORD(jobLogIn,2)
              call getSeverity          /* Get error severity        */
              call extractErr           /* Extract and display error */
              call updateEOJCounters    /* Update End of Job counters*/
              cntr_occur = cntr_occur + 1
          end
          iterate JoblogN
      end

                               /* In case of mismatch check joblog line
                                     with next lines of source. If match
                                     found update source counter      */
      SourceT = SourceN
      do iTemp = 1 to 10
         SourceT = SourceT + 1
         do while (pos('*',in_line.SourceT) = 7)
            SourceT = SourceT + 1
         end
         LineInNext = strip(substr(in_line.SourceT,01,72))
         if (LineInNext = JobIn) then do
            SourceN = SourceT + 1
            iterate JoblogN
         end
      end

   end
                               /* Incomplete Joblog Error             */
   if (sourceEOF = 0)
   then do
      linen = 0
      msg = "*---------*---------*---------*---------*---------*"
      call displayMsg
      msg = "              Incomplete Joblog"
      call displayMsg
      msg = "*---------*---------*---------*---------*---------*"
      call displayMsg
   end
return

/* Write EOJ Counters                                                 */
writeEOJCounters :
   linen = 0
   l_RC = 0
   do j = 2 to 1 by -1
     if ( j = 1 )      then msg1 = 'E'
     else if ( j = 2 ) then msg1 = 'W'
     else if ( j = 3 ) then msg1 = 'P'

     msg = msg1 ": total :" cntr.j
     if LabelList_cntr.j > 0
     then do
          t1 = LabelList_cntr.j
          Slabel = LabelList.j.1
          Elabel = LabelList.j.t1
          msg =msg "(."Slabel"-."Elabel")"
          end
     call displayMsg
     if (j = 1 & cntr.j > 0 ) then l_RC = 8
     if (j = 2 & cntr.j > 0 ) then l_RC = 4
     if (j = 3 & cntr.j > 0 ) then l_RC = 4
   end
   msg = "Number of messages : " cntr_occur
   call displayMsg

   ZEDSMSG  = 'RC ='  l_RC
   ZEDLMSG  = 'RC ='  l_RC
   ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
                               /* Compiler option mismatch error      */
   if (pos('NOSOURCE',SourceOption.SourceOptionCntr) > 0 )
   then do
     msg = "*---------------------------------------------------------*"
     call displayMsg
     msg = " Required Source Option : SOURCE"
     call displayMsg
     msg = " Current  Source Option :" SourceOption.SourceOptionCntr
     call displayMsg
     msg = " Source Compiler option not matching with expected options"
     call displayMsg
     msg = "*---------------------------------------------------------*"
     call displayMsg
   end
   if (pos('FLAG(I,I)',FlagOption.FlagOptionCntr) = 0 |,
       FlagOptionCntr = 0 )
   then do
      msg = "*-------------------------------------------------------*"
      call displayMsg
      msg = " Required Flag Option : FLAG(I,I)"
      call displayMsg
      msg = " Current  Flag Option :" FlagOption.FlagOptionCntr
      call displayMsg
      msg = " Flag Compiler option not matching with expected options"
      call displayMsg
      msg = "*-------------------------------------------------------*"
      call displayMsg
   end
return

/* Get severity of compiler error                                     */
getSeverity :
   if(pos('-S',word1) > 0 | pos('-E',word1) > 0 )
   then SevereInd = 'E'
   else SevereInd = 'W'
return

/* Extract complete error message                                     */
extractErr :
   i_local = JoblogN
                               /* Get complete msg                    */
   MsgDispVar = ""
   do j=i_local to (i_local + 6)
      t1 = translate(strip(X.j))
      t2 = translate(X.j)
      if ( (pos('IBM COBOL',t1) > 0) | (pos('LINEID',t1) > 0) )
      then iterate j
      if length(t1) < 2 then leave j
      MsgDispVar  = MsgDispVar" "substr(t2,2)
   end


                               /* Parse error msg in lengths of 70
                                    characters & display              */
    Strk = SPACE(MsgDispVar)
    linen = SourceN
    call displayBigLine
                               /* make sure not to overwrite labels   */
   if (SevereInd = 'E' ) then ptr = 1
   else ptr = 2
   if (prev_linen ¬= linen | prev_SeverePtr > ptr)
   then do
      if (prev_linen = linen)
      then do
         t1 = prev_SeverePtr
         LabelList_cntr.t1 = LabelList_cntr.t1 - 1
      end
                               /* make sure not to overwrite labels   */
      LabelList_cntr.ptr = LabelList_cntr.ptr + 1
      ptr1 = LabelList_cntr.ptr

      prev_SeverePtr = ptr
      prev_linen = linen
      linen = linen - 1
                               /* Generate label at error line        */
      call generateLabel
                               /* Set label at error line             */
      if linen =0 then lineT = 1
                  else lineT = linen
      ADDRESS ISPEXEC "ISREDIT LABEL" lineT " = ."label1" 0 "
      LABELLIST.ptr.ptr1 = label1
   end
                               /* Display Message at top based on error
                                    level indicator                   */
   if ( ERRLVL = '2' |,
       ( ERRLVL = '1' & SevereInd ='E'))
   then do
                               /* Parse error msg in lengths of 70
                                    characters & display              */
      MsgDispVar = "(."LABELLIST.ptr.ptr1")" MsgDispVar
      Strk = SPACE(MsgDispVar)
      linen = 1
      call displayBigLine
   end
  return

/* Update End of Job counters                                         */
updateEOJCounters :
       if SevereInd = 'P' then ptr = 3
  else if SevereInd = 'E' then ptr = 1
  else                         ptr = 2

  cntr.ptr = cntr.ptr + 1

return

/* Generate labels at places of error / warnings                      */
generateLabel :
        if SevereInd = 'P' then ptr = 3
   else if SevereInd = 'E' then ptr = 1
   else                         ptr = 2

   l1 = word(char1,dec1.ptr)
   l2 = word(char1,dec2.ptr)
   l3 = word(char1,dec3.ptr)
   label1 = SevereInd||l1||l2||l3
   dec3.ptr = dec3.ptr + 1
   if ( dec3.ptr = 25 )
   then do
      dec3.ptr = 1
      dec2.ptr = dec2.ptr + 1
      if ( dec2.ptr = 25 )
      then do
         dec2.ptr = 1
         dec1.ptr = dec1.ptr + 1
      end
   end
return

/* Display messages after given line number (linen - line number)     */
displayMsg :
   ADDRESS ISPEXEC "ISREDIT LINE_AFTER (linen) = MSGLINE (msg)"
return

/* Display messages before given line number (linen - linenumber)     */
displayMsgBefore :
       if linen = 0 then linenDm = 1
       else              linenDM = linen
       ADDRESS ISPEXEC "ISREDIT LINE_BEFORE (linenDM) = MSGLINE (msg)"
return

/* Check for precompile errors                                        */
preCompCheck :
   SevereInd = 'P'
   PreErrorCntI = 1
   SourceN = 1
   do JoblogN = PreLine to  maxlines
                               /* Skip certain lines in source        */
     if (pos('EJECT',in_line.SourceN)  > 0) then SourceN = SourceN + 1
     if (pos('PROCEDURE DIVISION.',in_line.SourceN)  > 0)
     then SourceN = SourceN + 1
     if (pos('DATE-COMPILED.',in_line.SourceN)  > 0)
     then SourceN = SourceN + 1

     if (pos('DB2 SQL PRECOMPILER',X.JoblogN)  > 0)
     then iterate JoblogN

                               /* If beyond source line then exit     */
     if (SourceN > in_max)         then leave JoblogN

     if (pos('INSERTED BY TRANSLATOR',X.JoblogN)  > 0)
     then do
          JoblogN = JoblogN + 1
          SourceN = SourceN + 1
          iterate JoblogN
          end
                               /* Skip lines without line numbers
                                     in joblog                        */
     LineNum1 = substr(X.JoblogN,4,7)
     if (DATATYPE(LineNum1,W) = 0) then iterate JoblogN

                               /* Display error at proper place       */
     if (LineNum1 > PreErrorLn.PreErrorCntI) then do
        linen = SourceN
        Strk = PreErrorStr.PreErrorCntI
        call displayBigLine
        call generateLabel
        linen = SourceN - 1
        /* Set label at error line  */
        if linen =0 then lineT = 1
                    else lineT = linen
        ADDRESS ISPEXEC "ISREDIT LABEL" lineT " = ."label1" 0 "
        LabelList_cntr.4 = LabelList_cntr.4 + 1
        t1 = LabelList_cntr.4
        LabelList.4.t1 = label1
        call updateEOJCounters
        PreErrorCntI = PreErrorCntI + 1
        if (PreErrorCntI > PreErrorCnt) then leave JoblogN
     end

     LineIn = translate(strip(substr(in_line.SourceN,01,72)))
     JobIn  = translate(strip(substr(X.JoblogN      ,16,72)))
     if (LineIn = JobIn)
     then do
          SourceN = SourceN + 1
          iterate JoblogN
          end

     if (pos('EXEC',in_line.SourceN) > 0)
     then do
          do until (pos('END-EXEC',in_line.SourceN) > 0)
             SourceN = SourceN + 1
          end
          SourceN = SourceN + 1
          iterate JoblogN
          end

     if (pos('COPY',in_line.SourceN) > 0)
     then do
          SourceN = SourceN + 1
          iterate JoblogN
          end
   end
   linen = 0
   msg = " total : " PreErrorCnt
   t1 = LabelList_cntr.4
   Slabel = LabelList.4.1
   Elabel = LabelList.4.t1
   msg =msg "(."Slabel"- ."Elabel")"
   call displayMsg
   msg = " Precompile Errors Found "
   call displayMsg

   ZEDSMSG  = 'RC = 12 '
   ZEDLMSG  = 'RC = 12 '
   ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"

return

/* Display big line by splitting into multiple lines
   maxk - maximum characters per page
   Strk - input lengthy string that needs to be displayed             */
displayBigLine :
        maxk = 70
        lenk = length(Strk)
        cntk = (lenk % maxk)
        cntj = 1
        endj = 0
        drop msgStr.
        msgStrCntr = 0
        do cntj = 1 to cntk
           startj = (cntj-1) * maxk + 1
           endj   = maxk
           msg = substr(Strk,startj,endj)
           msgStrCntr = msgStrCntr + 1
           msgStr.msgStrCntr = msg
        end
        startj = (cntk * maxk) + 1
        msg = substr(Strk,startj)
        msgStrCntr = msgStrCntr + 1
        msgStr.msgStrCntr = msg

        if linen > in_max
        then do
               linen = in_max
               do cntj = msgStrCntr to 1 by -1
                  msg = msgStr.cntj
                  call displayMsg
               end
             end
        else do
               do cntj = 1 to msgStrCntr
                  msg = msgStr.cntj
                  call displayMsgBefore
               end
             end
return

/* Write translator error o/p                                         */
transCheck :
   linen = 1
   do i_T = 1 to TransErrorCnt
      Strk = SPACE(TransErrorStr.i_T)
      call displayBigLine
   end

   ZEDSMSG  = 'RC = 12 '
   ZEDLMSG  = 'RC = 12 '
   ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"

return

/* Clean up Processes                                                 */
exitModule:
   call writeEOJCounters
   call deleteJoblogFileName
   exit(1)
return
/*--------------------------------------------------------------------*/
/*---------------End Of Program---------------------------------------*/
/*--------------------------------------------------------------------*/

Return to article