TechTip: Improving Free-Format Readability

RPG
Typography
  • Smaller Small Medium Big Bigger
  • Default Helvetica Segoe Georgia Times

One of the great things about coding RPG programs in free-format is the pure fact that the rigid spacing requirements of RPG are gone. This fact, however, can make reading a free-format RPG program difficult, especially when your program contains multiple levels of nested IF and/or DO conditions.

Wouldn't it be great to have a utility that would take "dirty" free-format RPG code and clean it up? This TechTip will add the Indent Free-Form ILE RPG (INDFREERPG) tool to your programming toolbox.

Before we look at the INDFREERPG utility, let's look at the problem it will help you resolve. Figure 1 is a code snippet from a free-format RPG program gone amuck.

/Free                                                 
 IF Parm1 = 'Y';                                      
 SELECT;                                              
 WHEN Parm2 = 1;                                      
 Exsr SubrA;                                          
 WHEN Parm2 = 2;                                      
 Exsr SubrA;                                          
 WHEN Parm2 = 3;                                      
 Exsr SubrB;                                          
     WHEN Parm2 = 9;                                  
 For X = 1 to 3;                                      
 Parm2 = X;                                           
       Exsr SubrB;                                    
   EndFor;                                            
 EndSl;
    EndIf;                                               
 Begsr SubrA;                                         
 Rtn = Parm2 * 3.1415927;                             
 EndSr;                                               
      Begsr SubrB;              
      Rtn = Parm2 / 3.1415927;  
 EndSr;                         
/END-FREE                                             

Figure 1: This code snippet illustrates a "dirty" free-format program.

A program coded like this, while completely acceptable to the compiler, will be difficult to follow when modification or analysis is required later. This program desperately needs a more structured layout. To accomplish this, the INDFREERPG utility takes free-format RPG statements and automatically indents the source statements.

This utility is made up of the following three objects:

  1. FDN001RG--ILE RPG program that indents free-format RPG source
  2. FDN001CL--CL driver program for FDN001RG
  3. INDFREERPG--OS/400 command source for the INDFREERPG command

FDN001RG (Figure 2) examines the specified source physical file member and looks for certain opcodes to determine whether any line should be indented further than the current source indentation.

      *--------------------------------------------------------------
      * Program :FDN001RG
      *
      * Description: Automatic indentation of Free-Format RPG source
      *
      * Create Command: CRTBNDRPG PGM(FDN001RG) SRCFILE(QRPGLESRC)
      * 
      *----------------------------------------------------
     H DFTACTGRP(*NO)
     FQRPGLESRC IF   E           K DISK    RENAME(QRPGLESRC:SOURCE)
     FQRPGLEOUT O  A F  112        DISK
     DFDN001RG         PR
     D Ind                           15  5
     DFDN001RG         PI
     D Indnt                         15  5
     D Ucase           C                   'ABCDEFGHIJKLMNOPQRSTUVWXYZÆØÅ'
     D Lcase           C                   'abcdefghijklmnopqrstuvwxyzÆØÅ'
     D Indent          S              5  0
     D FreeOn          S                   LIKE(*IN01)
     D Quot            S                   LIKE(*IN01)
     D X               S              3  0
     D Y               S              3  0
     D Z               S              3  0
     D Seqn            S              6  0
     D SRCDTAAR        S            110    DIM(32767)
     D SRCDATAR        S              6  0 DIM(32767)
     D Line            S            120
     D Line2           S            120
     D BlankSrch       S              5  0
     D SemiSrch        S              5  0
     D OpCode          S              8
     D TrimSrc         S            120
     D BlankLine       S            120    INZ(*Blanks)
     D CheckFree       S             50
     D End1            S              5  0
     D End2            S              5  0
     D RPGDS         E DS                  EXTNAME(QRPGLESRC) PREFIX('X':1)
      /FREE
       Indent = 8;
       Read QRPGLESRC;
       Dou %EOF;
         CheckFree = %XLATE(Lcase:Ucase:%Subst(SRCDTA:7:9));
         If FreeOn = *Off;
           Seqn = Seqn + 1;
           SRCDATAR(Seqn) = SRCDAT;
           SRCDTAAR(Seqn) = SRCDTA;
           If CheckFree = '/FREE';
             FreeOn = *On;
           EndIf;
           Read QRPGLESRC;
           Iter;
         Else;
           If CheckFree = '/END-FREE';
             FreeOn = *Off;
             Seqn = Seqn + 1;
             SRCDATAR(Seqn) = SRCDAT;
             SRCDTAAR(Seqn) = SRCDTA;
           Else;
             TrimSrc = %Trim(SRCDTA);
             BlankSrch = %Scan(' ':TrimSrc:1);
             SemiSrch = %Scan(';':TrimSrc:1);
             If SemiSrch < BlankSrch AND SemiSrch <> 0;
               BlankSrch = SemiSrch;
             EndIf;
             OpCode  = %XLATE(LCase:UCase:%Subst(TrimSrc:1:BlankSrch-1));
             If OpCode = 'ENDIF' OR OpCode = 'ENDFOR' OR OpCode = 'ENDDO' OR
                OpCode = 'ENDSL' OR OpCode = 'ENDMON' OR OpCode = 'ENDSR' OR
                %SUBST(OpCode:1:4) = 'ELSE' OR %SUBST(OpCode:1:4) = 'WHEN' OR
                %SUBST(OpCode:1:5) = 'OTHER' OR OpCode = 'ON-ERROR';
                Indent = Indent - Indnt;
             EndIf;
                Line = %SUBST(BlankLine: 1: Indent) + TrimSrc;
                IF %Scan('//': Line)=0 Or %Scan('//': Line)>80;
             DoW %Len(%Trim(Line))+Indent > 80;
               For X=1 To 79;
                 Y = 80-X;
                 If %SUBST(Line:Y:1) = ' ';
                   End2 = (%Len(%trim(LINE)) + Indent) - (Y+1);
                   Line2 =  %SUBST(Line:Y:%Len(Line)-Y);
                   For Z = 1 To Y;
                     If %Subst(Line:Z:1) = '''';
                       Quot = (Quot = *Off);
                     EndIf;
                   EndFor;
                   If Quot = *On;
                   Line = %SUBST(BlankLine:1:Indent) +
                           %SUBST(%Trim(Line):1:Y-Indent) + '+';
                   Else;
                   Line = %SUBST(BlankLine:1:Indent) +
                           %SUBST(%Trim(Line):1:Y-Indent);
                   EndIf;
                   Seqn = Seqn + 1;
                   SRCDATAR(Seqn) = SRCDAT;
                   SRCDTAAR(Seqn) = Line;
                   Line = %SUBST(BlankLine:1:Indent) + %Trim(Line2);
                   Leave;
                 EndIf;
               EndFor;
             EndDo;
             EndIf;
             Seqn = Seqn + 1;
             SRCDATAR(Seqn) = SRCDAT;
             SRCDTAAR(Seqn) = Line;
             If OpCode = 'IF' OR OpCode = 'DOU' OR OpCode = 'DOW' Or
                OpCode='FOR' OR OpCode = 'DO' OR OpCode = 'SELECT' OR
                %SUBST(OpCode:1:4) = 'WHEN' OR %SUBST(OpCode:1:4) = 'ELSE'
                OR OpCode = 'OTHER' OR OpCode = 'ON-ERROR' OR
                OpCode = 'MONITOR' OR OpCode = 'BEGSR';
                Indent = Indent + Indnt;
             EndIf;
           EndIf;
         EndIf;
         Read QRPGLESRC;
       EndDo;
       For X = 1 To Seqn;
         XRCSEQ = X;
         XRCDTA = SRCDTAAR(X);
         XRCDAT = SRCDATAR(X);
         Except WriteOut;
       EndFor;
       *INLR = *ON;
       Return;
      /END-FREE
     OQRPGLEOUT EADD         WriteOut
     O                       XRCSEQ
     O                       XRCDAT
     O                       XRCDTA

Figure 2: This program indents a free-format ILE RPG program.

This program reads through the specified source member until it hits a source record containing the /FREE compiler directive. A flag is used to identify that the source after the compile directive is free-format. At that point, the program continues reading through the source member, identifying grouped operations, and indenting the code inside of those operations.

The table below shows a list of these group operations.

Operations Used for Free-Format Indentation
Operation
Indentation Action
BEGSR, DO, DOU, DOW, FOR, IF, MONITOR, SELECT
Indent the code following this statement until an ENDxx is reached.
*ELSE
Return this statement to the location of the IF and continue indenting statements following this one.
ENDxx
Return this statement and any that follow it to the indentation of the beginning statement for the group.
ON-ERROR
Return this statement to the location of the MONITOR statements and continue indenting statements following this one.
OTHER
Return this statement to the location of the SELECT/WHEN statements and continue indenting statements following this one.
*WHEN
Return this statement to the location of the SELECT statements and continue indenting statements following this one.

If the line becomes too long (greater than 80 characters) as a result of a line of code being indented, the program automatically breaks the code into multiple lines of code that honor the new indentation. The resulting statements are initially loaded into an array and the "new" program is output at the end of the program. This array is currently limited to 32,767 statements. Create this program using the CRTBNDRPG command:

CRTBNDRPG PGM(FDN001RG) SRCFILE(QRPGLESRC)

To control the execution of this program, the CL program FDN001CL (Figure 3) is used.

/*----------------------------------------------------------------------------*/
/*                                                                            */
/* Program: FDN001CL                                                          */
/*                                                                            */
/* Description: Indentation of Free-Format ILE RPG Programs                   */
/*                                                                            */
/* Create Command: CRTCLPGM PGM(xxx/FDN001CL)                                 */
/*                          SRCFILE(xxx/QCLSRC)                               */
/*                                                                            */
/*----------------------------------------------------------------------------*/
             PGM        PARM(&INFILIB &SRCMBR &INDENT +
                          &OUTFILIB &OUTMBR &REPLACE)

             DCL        VAR(&INFILIB) TYPE(*CHAR) LEN(20)
             DCL        VAR(&OUTFILIB) TYPE(*CHAR) LEN(20)
             DCL        VAR(&SRCLIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCFILE) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCMBR) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCMBX) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCTYPE) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCTEXT) TYPE(*CHAR) LEN(50)
             DCL        VAR(&OUTLIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&OUTFILE) TYPE(*CHAR) LEN(10)
             DCL        VAR(&OUTMBR) TYPE(*CHAR) LEN(10)
             DCL        VAR(&INDENT) TYPE(*DEC) LEN(1 0)
             DCL        VAR(&IND) TYPE(*DEC) LEN(15 5)
             DCL        VAR(&REPLACE) TYPE(*CHAR) LEN(4)
             DCL        VAR(&EXISTS) TYPE(*CHAR) LEN(10)

             CHGVAR &IND VALUE(&INDENT)
             CHGVAR &SRCFILE VALUE(%SST(&INFILIB 1 10))
             CHGVAR &OUTFILE VALUE(%SST(&OUTFILIB 1 10))
             CHGVAR &SRCLIB VALUE(%SST(&INFILIB 11 10))
             CHGVAR &OUTLIB VALUE(%SST(&OUTFILIB 11 10))
             CHGVAR     VAR(&EXISTS) VALUE('N')

             CHKOBJ     OBJ(QTEMP/QRPGLEOUT) OBJTYPE(*FILE)
             MONMSG     MSGID(CPF9801) EXEC(DO)
             CRTSRCPF   FILE(QTEMP/QRPGLEOUT) RCDLEN(112)
             ENDDO
             IF         COND(&SRCFILE *EQ &OUTFILE *AND &SRCMBR *EQ +
                          &OUTMBR *AND &SRCLIB *EQ &OUTLIB) THEN(DO)
             IF         COND(&REPLACE *EQ 'N') THEN(DO)
             SNDPGMMSG  MSG('Output member is the same as input +
                          member and Replace option is "NO".')
             GOTO       CMDLBL(PGMEND)
             ENDDO
             ENDDO

             CHKOBJ     OBJ(&SRCLIB/&SRCFILE) OBJTYPE(*FILE) +
                          MBR(&SRCMBR)
             MONMSG     MSGID(CPF9815 CPF9801 CPF9810) EXEC(DO)
             SNDPGMMSG  MSG('Input Library/File or Member not found.')
             GOTO       CMDLBL(PGMEND)
             ENDDO

             IF         COND(&OUTFILE = '*INFILE') THEN(CHGVAR +
                          VAR(&OUTFILE) VALUE(&SRCFILE))
             IF         COND(&OUTLIB = '*INLIB') THEN(CHGVAR +
                          VAR(&OUTLIB) VALUE(&SRCLIB))
             IF         COND(&OUTMBR = '*INMBR') THEN(CHGVAR +
                          VAR(&OUTMBR) VALUE(&SRCMBR))

             CHKOBJ     OBJ(&OUTLIB/&OUTFILE) OBJTYPE(*FILE)
             MONMSG     MSGID(CPF9801 CPF9810) EXEC(DO)
             SNDPGMMSG  MSG('Output Library/File does not exist')
             GOTO       CMDLBL(PGMEND)
             ENDDO

             CHKOBJ     OBJ(&OUTLIB/&OUTFILE) OBJTYPE(*FILE) +
                          MBR(&OUTMBR)
             MONMSG     MSGID(CPF9815) EXEC(GOTO CMDLBL(OK))

             CHGVAR     VAR(&EXISTS) VALUE('Y')
             IF         COND(&REPLACE *NE 'Y') THEN(DO)
             SNDPGMMSG  MSG('Output Member Exists but Replace Option +
                          is "NO"')
             GOTO       CMDLBL(PGMEND)
             ENDDO

 OK:         RTVMBRD    FILE(&SRCLIB/&SRCFILE) MBR(&SRCMBR) +
                          SRCTYPE(&SRCTYPE) TEXT(&SRCTEXT)
             IF         COND(&SRCTYPE *NE 'RPGLE' *AND &SRCTYPE *NE +
                          'SQLRPGLE') THEN(DO)
             SNDPGMMSG  MSG('Member type for input source member +
                          must be RPGLE or SQLRPGLE.')
             GOTO       CMDLBL(PGMEND)
             ENDDO

             ADDPFM     FILE(QTEMP/QRPGLEOUT) MBR(&OUTMBR) +
                          TEXT(&SRCTEXT) SRCTYPE(&SRCTYPE)
             MONMSG     MSGID(CPF5812 CPF7306) EXEC(CLRPFM +
                          FILE(QTEMP/QRPGLEOUT) MBR(&OUTMBR))


             CHGVAR     VAR(&SRCMBX) VALUE('XXX' *TCAT %SST(&OUTMBR +
                          4 7))

             OVRDBF     FILE(QRPGLEOUT) TOFILE(QTEMP/QRPGLEOUT) +
                          MBR(&OUTMBR)
             OVRDBF     FILE(QRPGLESRC) TOFILE(&SRCLIB/&SRCFILE) +
                          MBR(&SRCMBR)
             CALL       PGM(FDN001RG) PARM(&IND)
             DLTOVR     FILE(*ALL)

             IF         COND(&EXISTS *EQ 'Y' *AND &REPLACE *EQ 'Y') +
                          THEN(DO)
             CPYF       FROMFILE(&OUTLIB/&OUTFILE) +
                          TOFILE(QTEMP/QRPGLEOUT) FROMMBR(&OUTMBR) +
                          TOMBR(&SRCMBX) MBROPT(*REPLACE)
             RMVM       FILE(&OUTLIB/&OUTFILE) MBR(&OUTMBR)
             ENDDO
             CPYF       FROMFILE(QTEMP/QRPGLEOUT) +
                          TOFILE(&OUTLIB/&OUTFILE) FROMMBR(&OUTMBR) +
                          TOMBR(&OUTMBR) MBROPT(*REPLACE)
             RMVM       FILE(QTEMP/QRPGLEOUT) MBR(&OUTMBR)
             SNDPGMMSG  MSG('Free Format Indentation Complete')

 PGMEND:     ENDPGM 

Figure 3: This CL controls the execution of FDN001RG.

Create this program using the CRTCLPGM command:

CRTCLPGM PGM(FDN001CL SRCFILE(QCLSRC)  

The primary function of this program is to perform error checking on the parameters supplied by the INDFREERPG command, to prepare the work files used by the application, and finally to create the new source member from these work files.

The source for the INDFREERPG command is shown in Figure 4.

/*----------------------------------------------------------------------------*/
/*                                                                            */
/* Command: INDFREERPG                                                        */
/*                                                                            */
/* Description: Indentation of Free-Format ILE RPG Programs                   */
/*                                                                            */
/* Create Command: CRTCMD CMD(INDFREERPG) PGM(FDN001CL)                       */
/*                        SRCFILE(QCMDSRC)                                    */
/*                                                                            */
/*                                                                            */
/*----------------------------------------------------------------------------*/
             CMD        PROMPT('Indent Free Format RPG Source')
             PARM       KWD(INFILE) TYPE(QUALFILE) PROMPT('Input RPG +
                          source file')
             PARM       KWD(INMBR) TYPE(*CHAR) LEN(10) DFT(*FIRST) +
                          SPCVAL((*FIRST *FIRST)) MIN(0) +
                          PROMPT('Input Free-Format RPG member')
             PARM       KWD(INDENT) TYPE(*DEC) LEN(1) RSTD(*YES) +
                          DFT(2) VALUES(1 2 3 4) MIN(0) +
                          PROMPT('Number of Characters to Indent')
             PARM       KWD(OUTFILE) TYPE(QUALFIL2) PROMPT('Output +
                          RPG source file')
             PARM       KWD(OUTMBR) TYPE(*CHAR) LEN(10) DFT(*INMBR) +
                          SPCVAL((*INMBR *INMBR)) MIN(0) +
                          PROMPT('Output Free-Format RPG member')
             PARM       KWD(REPLACE) TYPE(*CHAR) LEN(4) RSTD(*YES) +
                          DFT(*YES) SPCVAL((*YES Y) (*NO N)) MIN(0) +
                          PROMPT('Replace Existing Source Member')
 QUALFILE:   QUAL       TYPE(*NAME) LEN(10) DFT(QRPGLESRC)
             QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) SPCVAL((*LIBL +
                          *LIBL)) PROMPT('Input Library')
 QUALFIL2:   QUAL       TYPE(*NAME) LEN(10) DFT(*INFILE) +
                          SPCVAL((*INFILE *INFILE))
             QUAL       TYPE(*NAME) LEN(10) DFT(*INLIB) +
                          SPCVAL((*LIBL *LIBL) (*INLIB *INLIB)) +
                          PROMPT('Output Library')

Figure 4: This source is used to create the INDFREERPG command.

Use the CRTCMD command to build the INDFREERPG command:

CRTCMD CMD(INDFREERPG) PGM(FDN001CL) SRCFILE(QCMDSRC)

Once this statement has been executed, the INDFREERPG command is ready to go. This command accepts parameters that define the input source file and member, the output source file and member, the number of characters to indent at each group, and whether or not to replace an existing source member.

Figure 5 shows the prompt screen from this command.

http://www.mcpressonline.com/articles/images/2002/IndFreeRpg2V4--06240500.jpg

Figure 5: This is the prompt screen for INDFREERPG. (Click image to enlarge.)

This screen illustrates the parameters for the INDFREERPG command. The first set of parameters defines the input source member to be indented. The next parameter defines the number of characters to indent each grouping. A value between 1 and 4 is acceptable for this command. The next set of parameters defines the output file. Optionally, a value of *INFILE, *INLIB, or *INMBR can be used to identify that the output file/library and member are the same as the input file/library and member. The final parameter defines whether or not an existing member should be replaced when the command is executed. If *NO is specified and the output member exists, an error is returned.

Assuming that the free-format RPG shown in Figure 1 was contained in an RPG source member named FRE001RG, the following command would be used to indent the source:

INDFREERPG  INFILE(MYLIB/QRPGLESRC) INMBR(FRE001RG) INDENT(2) 
                           OUTFILE(*INLIB/*INFILE) OUTMBR(*INMBR) 

REPLACE(*YES)

When this statement is executed, the source member is read in and processed by the INDFREERPG command and saved into its original source file member.

Figure 6 shows the source from Figure 1 after is has been processed through INDFREERPG.

/Free                                                 
 IF Parm1 = 'Y';                                      
   SELECT;                                              
   WHEN Parm2 = 1;                                      
     Exsr SubrA;                                          
   WHEN Parm2 = 2;                                      
     Exsr SubrA;                                          
   WHEN Parm2 = 3;                                      
     Exsr SubrB;                                          
   WHEN Parm2 = 9;                                  
     For X = 1 to 3;                                      
       Parm2 = X;                                           
       Exsr SubrB;                                    
     EndFor;                                            
   EndSl;  
 EndIf;                                             
 Begsr SubrA;                                         
   Rtn = Parm2 * 3.1415927;                             
 EndSr;                                               
 Begsr SubrB;              
   Rtn = Parm2 / 3.1415927;  
 EndSr;                         
/END-FREE                                             

Figure 6: The free-format code has been "cleaned up."

As you can see, this version of the code is easier to read and follow. The flow of the program is easy to recognize at a glance. This command works best with applications written using all free-format code.

INDFREERPG can really help to keep your code "free" but under control.

Mike Faust is an Application Programmer for Fidelity Integrated Financial Solutions in Maitland, Florida. He is also the author or The iSeries and AS/400 Programmer's Guide to Cool Things, Active Server Pages Primer, and SQL Built-in Functions and Stored Procedures. You can contact Mike at This email address is being protected from spambots. You need JavaScript enabled to view it..


                       
Mike Faust

Mike Faust is a senior consultant/analyst for Retail Technologies Corporation in Orlando, Florida. Mike is also the author of the books Active Server Pages Primer, The iSeries and AS/400 Programmer's Guide to Cool Things, JavaScript for the Business Developer, and SQL Built-in Functions and Stored Procedures. You can contact Mike at This email address is being protected from spambots. You need JavaScript enabled to view it..


MC Press books written by Mike Faust available now on the MC Press Bookstore.

Active Server Pages Primer Active Server Pages Primer
Learn how to make the most of ASP while creating a fully functional ASP "shopping cart" application.
List Price $79.00

Now On Sale

JavaScript for the Business Developer JavaScript for the Business Developer
Learn how JavaScript can help you create dynamic business applications with Web browser interfaces.
List Price $44.95

Now On Sale

SQL Built-in Functions and Stored Procedures SQL Built-in Functions and Stored Procedures
Unleash the full power of SQL with these highly useful tools.
List Price $49.95

Now On Sale

BLOG COMMENTS POWERED BY DISQUS

LATEST COMMENTS

Support MC Press Online

$

Book Reviews

Resource Center

  •  

  • LANSA Business users want new applications now. Market and regulatory pressures require faster application updates and delivery into production. Your IBM i developers may be approaching retirement, and you see no sure way to fill their positions with experienced developers. In addition, you may be caught between maintaining your existing applications and the uncertainty of moving to something new.

  • The MC Resource Centers bring you the widest selection of white papers, trial software, and on-demand webcasts for you to choose from. >> Review the list of White Papers, Trial Software or On-Demand Webcast at the MC Press Resource Center. >> Add the items to yru Cart and complet he checkout process and submit

  • SB Profound WC 5536Join us for this hour-long webcast that will explore:

  • Fortra IT managers hoping to find new IBM i talent are discovering that the pool of experienced RPG programmers and operators or administrators with intimate knowledge of the operating system and the applications that run on it is small. This begs the question: How will you manage the platform that supports such a big part of your business? This guide offers strategies and software suggestions to help you plan IT staffing and resources and smooth the transition after your AS/400 talent retires. Read on to learn: