Find IF as first word

[don.leahy]

Originally Posted by dbzthedinosaur

I would bounce the code because it violated standards.
I work with a lot of doctorates (physics)
and they also have no sensitivity to readability.

THEN, ELSE also alone on a separate line

    IF VAR-X > VAR-Y
    THEN 
       IF VAR-Y = VAR-Z
       THEN 
           PERFORM PARA-A
       ELSE 
           IF VAR-Y > VAR-Z
           THEN 
               PERFORM PARA-B
           ELSE 
               PERFORM PARA-C
           END-IF
       END-IF
    ELSE 
       PERFORM PARA-D
    END-IF

If it was me, I'd drop the THENs too. It's a noise word that adds nothing to the code's readability. Of course, that is just a personal preference, so please let's not start any holy wars over it.

[Michael Simpson]

In his preamble he, himself, used the phrase "coding something like if else if else if else if else if else etc etc" - a phrase in which there are multiple IF's following the word ELSE on the same line.

If I understood you correctly, I think you missed what I was trying to "say" and couldn't be bothered to write in its entirety. I mean the following type of coding example

if a = 8
  do something
else
  if b = 10
    do something else
  else
    if c = 20
      do a third thing
    else 
       if d = 40
         do d's stuff
       else
         if e = 50
          e's stuff this time
         else
.... and now finish with a lod of end-if's

Ugh !!!! If only people took the time to realize that almost any IF statement can be made more readable by re-writing it as an EVALUATE statement instead (but that's me). For example, Don's example above (I know it's just an example) could be rewritten as

evaluate true
  when VAR-X <= VAR-Y
    PERFORM PARA-D
  when VAR-Y = VAR-Z
    PERFORM PARA-A
  when VAR-Y > VAR-Z
    PERFORM PARA-B
  when other
    PERFORM PARA-C
end-evaluate

[don.leahy]

I just re-read your original post. If you primary concern is deeply nested IF statements, you may be able to examine the compile listing rather than the code. Column 16 shows you the nesting level of each statement.

[Steve Coalbran]

Hej Michael,
Well I hacked this together quickly from something else I had from way.back-whenever.
It just does some primitive highlighting and it's for REXX (so probably as much use as a chocolate teapot but anyhow..!).
The thing that this does is ignore stuff like:

IF TESTFLD = 'IF' THEN MOVE 'IF' TO INVERB.

(Sorry, my COBOL is pretty rusty. However I guess the inline comments do not apply so remove the blue-highlighted code?)

/**REXX***************************************************************/
/* Highlight active IF verbs                                         */
/*********************************************************************/
TRACE "N" 
ADDRESS ISPEXEC "CONTROL ERRORS RETURN" 
ADDRESS ISREDIT 
"MACRO (PARMS) NOPROCESS" 
 
/*-------------------------------------------------------------------*/
/* initialize data                                                   */
/*-------------------------------------------------------------------*/
PARSE VALUE 0 WITH 1 quotes 1 quoted 1 coment . 
 
/* test multiple IFs ------------------------------------------------>>
IF(a=b)THEN DO;IF(c=d)THEN e=f;ELSE IF(g=h)THEN i=j; END;ELSE NOP    */
IF(a=b)THEN DO;IF(c=d)THEN e=f;ELSE IF(g=h)THEN i=j; END;ELSE NOP 
/*-------------------------------------------------------------------*/
 
/*-------------------------------------------------------------------*/
/* read source                                                       */
/*-------------------------------------------------------------------*/
"SEEK P'=' 1 FIRST" 
DO WHILE(RC=0) 
   "(SRC) = LINE .ZCSR" 
   map = QUOTEMAP(STRIP(src,"T")) 
   hln = "" 
   "FIND WORD 'IF' .ZCSR .ZCSR FIRST" 
   DO WHILE(RC=0) 
      "(R,C) = CURSOR" 
      IF( SUBSTR(map,c,2)="00" )THEN 
         hln = OVERLAY("^^",hln,c) 
      ELSE NOP 
      "FIND WORD 'IF' .ZCSR .ZCSR NEXT" 
   END 
   IF( hln<>"" )THEN 
      "LINE_AFTER .ZCSR = NOTELINE (HLN)" 
   ELSE NOP 
   "SEEK P'=' 1 NEXT" 
END 
"SEEK P'=' 1 FIRST" 
"UP" 
EXIT 1 
/*===================================================================*/
/* create mask to shield inappropriate quoted                        */
PARSE ARG parms 
   lps = LENGTH(parms) 
   parmmap = COPIES('0',lps) 
   DO a = 1 TO lps 
      tc = SUBSTR(parms,a,1) 
      t2 = SUBSTR(parms,a,2) 
      inquotes = quotes!quoted 
      SELECT 
      WHEN( ^inquotes , 
         & t2 = "/*" )THEN DO 
         coment = 1 
         parmmap = OVERLAY('CC',parmmap,a) 
         a = a + 1 
         END 
      WHEN( ^inquotes , 
         & t2 = "*/" )THEN DO 
         coment = 0 
         parmmap = OVERLAY('CC',parmmap,a) 
         a = a + 1 
         END 
      WHEN( coment )THEN NOP 
      WHEN( ^quotes , 
          & tc = '"' )THEN 
         quoted = 1 - quoted 
      WHEN( ^quoted , 
          & tc = "'" )THEN 
         quotes = 1 - quotes 
      OTHERWISE NOP 
      END 
      IF( coment )THEN 
         parmmap = OVERLAY('C',parmmap,a) 
      ELSE DO 
         IF( inquotes!quotes!quoted )THEN 
            parmmap = OVERLAY('1',parmmap,a) 
         ELSE NOP 
         END 
   END 
 
RETURN parmmap

It seems to work for the few tests I did on it - mostly coded in there (dummy lines 14-17) !
(this can also be fatal - as anyone who's ever deleted/scrambled their own macro will verify! In this case, being NOTELINEs, its pretty safe).
Steve

[Steve Coalbran]

Hi - using the compiler listing is a great idea. Does much of the work for you.
I used to have a tool called PLIRITE that could reformat PL/1 based on options.
It used the FRMAT option of the (then!) PL/1 Checkout Compiler. So you can tell how long ago that was - late 80s sometime?!
I frankly forget exactly when it went "unsupported" (whatever!)
Steve

[nadel]

Although not perfect either, you can use regular expressions if you want to go to enough trouble to pass the program over to Unix. See my FINDRX edit macro at http://sillysot.com/ftp/findrx.txt

Unfortunately it isn't commented line by line but it isn't very long.

I've been through exercises like this before and my approach was the same as yours, but eventually, I end up writing a source code reformatter and run tests against a standard format. Listings sometimes do the same thing (as someone mentioned before) and sometimes compilers have a format function to create new source files. I don't have anything for COBOL though. In my experience, it is beyond any hope of readability so I just do the next best thing; abandon all hope of ever understanding it (... and .. cue another plea not start a holy war).

[Michael Simpson]

Nja...... Where is the compiler listing, does it even exist ?

I mentioned (?) that I already have a macro - user simply enters NESTEDIF on the command line for any COBOL source code to check that the level of nesting isn't too deep. I've changed the macro to only "count" the word IF/EVALUATE if either one is the first word - I ws just wondering if there was a variation on find that would obviate coding the search in the rexx macro. (The replacement code was only 5-6 lines)

[Steve Coalbran]

Hej Michael,

As I have said before, my COBOL is pretty stale.
However I do play about a bit with REXX.
I played about some with calling the compiler and processing the listing.
Take a look at this code which seems to work but only reformats the PROCEDURE DIVISION...

/**REXX(CBLFORM)******************************************************/
/*                                                                   */
/* Name:        CBLFORM                                              */
/* Type:        z/OS exec / EditMacro                                */
/* Author:      Steve Coalbran                                       */
/* Requires:    -                                                    */
/* Description: Reformat a COBOL program from it's compiler listing  */
/* Syntax:                                                           */
/* TSO EXEC     >>- CBLFORM --- cobol-dsn ---+- indent -+--------->< */
/*                                           +- 3 ------+            */
/* EDIT MACRO   >>- CBLFORM -+- cobol-dsn -+-+- indent -+--------->< */
/*                           +- * ---------+ +- 3 ------+            */
/*                           +-   ---------+                         */
/*-------------------------------------------------------------------*/
/* History:   - Original Implementation JUL-2010                     */
/* Modifications:                                                    */
/* YYYY-MM-DD BY         Description                                 */
/* ---------- ---------- ------------------------------------------- */
/* 201x-xx-xx BY xxx                                                 */
/*                                                                   */
/*********************************************************************/
TRACE "N"
ADDRESS TSO
pgm = "PP 5655-S71"                     /* compiler level (tailor)   */
ADDRESS ISPEXEC "CONTROL ERRORS RETURN"

/*-------------------------------------------------------------------*/
/* process parameters                                                */
/*-------------------------------------------------------------------*/
ADDRESS ISREDIT "MACRO (PARMS) NOPROCESS"
em = (RC=0)
IF( em=0 )THEN ARG parms
PARSE UPPER VAR parms cbl ind .
IF( em=1 & (cbl="" | cbl="*") )THEN DO
   ADDRESS ISREDIT "(DS) = DATASET"
   ADDRESS ISREDIT "(MN) = MEMBER"
   cbl = ds
   IF( mn<>"" )THEN cbl = cbl"("mn")"
   cbl = "'"cbl"'"
   END
ELSE NOP
IF( DATATYPE(ind)<>"NUM" )THEN ind = 3  /* dft indentation (tailor)  */
SAY "USING:-"
SAY "SOURCE:" cbl
SAY "INDENT:" ind

/*-------------------------------------------------------------------*/
/* work datasets                                                     */
/*-------------------------------------------------------------------*/
ADDRESS ISPEXEC "VGET (ZSCREEN) SHARED"
prt = "IGYCRCTL.LIST"zscreen
obj = "IGYCRCTL.OBJ"zscreen
ref = "IGYCRCTL.COBOL"zscreen
atp = "SP(3,3)TR DSORG(PS) RECFM(F B A) LRECL(133) BLKSIZE(27930)"
ato = "SP(3,3)TR DSORG(PS) RECFM(F B) LRECL(80) BLKSIZE(3200)"
CALL MSG "OFF"
"DELETE ("prt obj ref")"
CALL MSG "ON"
"ALLOC DD(SYSIN)    DS("cbl") SHR REUSE"
"ALLOC DD(SYSPRINT) DS("prt") NEW REUSE" atp
"ALLOC DD(SYSLIN)   DS("obj") MOD REUSE" ato
"ALLOC DD(SYSUT1)   UNIT(VIO) SP(1,1)CYL REUSE"
"ALLOC DD(SYSUT2)   UNIT(VIO) SP(1,1)CYL REUSE"
"ALLOC DD(SYSUT3)   UNIT(VIO) SP(1,1)CYL REUSE"
"ALLOC DD(SYSUT4)   UNIT(VIO) SP(1,1)CYL REUSE"
"ALLOC DD(SYSUT5)   UNIT(VIO) SP(1,1)CYL REUSE"
"ALLOC DD(SYSUT6)   UNIT(VIO) SP(1,1)CYL REUSE"
"ALLOC DD(SYSUT7)   UNIT(VIO) SP(1,1)CYL REUSE"

/*-------------------------------------------------------------------*/
/* invoke cobol compiler                                             */
/*-------------------------------------------------------------------*/
"CALL *(IGYCRCTL)"
IF( RC<>0 )THEN
   ADDRESS ISPEXEC "BROWSE DATASET("prt")" /* errors or warnings ?   */
ELSE
   CALL CBLANAL                         /* analyze the compiler list */

/*-------------------------------------------------------------------*/
/* cleanup                                                           */
/*-------------------------------------------------------------------*/
"FREE DD(SYSPRINT SYSLIN SYSUT1 SYSUT2 SYSUT3 SYSUT4 SYSUT5 SYSUT6",
"SYSUT7)"

EXIT

/*===================================================================*/
/* analyze the compiler list, generate reformatted source            */
/*===================================================================*/
CBLANAL:
ADDRESS TSO "ALLOC DD(SYSPRINT) DS("prt") SHR REUSE"
PARSE VALUE 0 WITH 1 in 1 s 1 pd s. l. title
ADDRESS TSO "EXECIO * DISKR SYSPRINT (STEM L. FINIS"
DO i = 1 TO l.0
   PARSE VAR l.i 1 asa 2 ttl 65 . 3 chk 35 . 1 pgc 13 .
   IF( pgc = "1"pgm )THEN ITERATE
   IF( asa = "1" )THEN
      IF( title = "" )THEN title = STRIP(ttl)       /* rebuild title */
      ELSE ITERATE
   ELSE NOP

   /*----------------------------------------------------------------*/
   /* listing sections                                               */
   /*----------------------------------------------------------------*/
   IF( chk = " LineID  PL SL  ----+-*A-1-B--+-" )THEN in = 1
   IF( chk = "Count   Cross-reference of verbs" )THEN in = 2
   IF( chk = "Defined   Cross-reference of dat" )THEN in = 3
   IF( chk = "Defined   Cross-reference of pro" )THEN in = 4
   IF( in<>1&in<>3 )THEN ITERATE

   /*----------------------------------------------------------------*/
   /* program division - PROCEDURE                                   */
   /*----------------------------------------------------------------*/
   PARSE VAR l.i 1 . 11 nl 17 . 26 dv 50 .
   IF( SPACE(dv)="PROCEDURE DIVISION."  )THEN pd = 1
   IF( LEFT(SPACE(dv),11)="END PROGRAM" )THEN pd = 0

   /*----------------------------------------------------------------*/
   /* store source lines - reformat by indent-level (PD only)        */
   /*----------------------------------------------------------------*/
   IF( DATATYPE(SUBSTR(l.i,4,6))="NUM" )THEN DO
      IF( in = 1 )THEN DO
         PARSE VALUE s+1";"l.i WITH s";" . =1 s.0";" +19 s.s +72 .
         IF( pd=1 )THEN DO
            IF( DATATYPE(nl)<>"NUM" )THEN nl=0
            s.s = LEFT(s.s,7)LEFT("",4+(nl*ind))STRIP(SUBSTR(s.s,8))
            END
         ELSE NOP
         END
      ELSE NOP
      END
   ELSE NOP
END

/*-------------------------------------------------------------------*/
/* browse reformatted output                                         */
/*-------------------------------------------------------------------*/
"ALLOC DD(SYSFORM)  DS("ref") NEW REUSE" ato
IF( title<>"" )THEN DO                             /* rebuild title? */
   t1 = '000100 TITLE "'title'".'
   "EXECIO 1 DISKW SYSFORM (STEM T "
   END
ELSE NOP
"EXECIO" s.0 "DISKW SYSFORM (STEM S. FINIS "
PARSE VALUE "YES ISR1B000 Reformatted Source;",
      WITH  zerralrm zerrhm zerrsm";"zerrlm
ADDRESS ISPEXEC "SETMSG MSG(ISRZ002)"
ADDRESS ISPEXEC "BROWSE DATASET("ref")"

EXIT

Steve