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:
- FDN001RG--ILE RPG program that
indents free-format RPG source
- FDN001CL--CL driver program for FDN001RG
- 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.
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 mikeffaust@yahoo.com.
| 
[size="1">Code[/size>