Code Generation circa 1988 using RPG II 1/2

While cleaning out my shelves I came across this old code sample disk. The company is long gone and the language is well…small. RPG II’s roots went back to punch-card days:

• Column position on each line was important
• Column 6 contains a one letter “record type”, e.g. H = header, C = calculation
• The OPCODE in the middle of the calc spec was max 6 chars long, e.g. EXSR = execute subroutine.

If I remember, the “1/2” was a commercial 3rd party tool/enhancement that added stuff like “IF” and “DO” instead of having to use the left-hand indicators (e.g. N90) to condition execution of the line.
0001 H       024                B        1                  SAL010
0002 H*===================================================================
0003 H*@ PROPERTY OF XXXXXXXXXXXX, KEENE, NEW HAMPSHIRE 1988
0004 H*T Generate #GSORT OCL to retrieve customer/item sales history
0005 H*M  144 07Dec88 Written *** Uses RPG II 1/2 ***
0005 H*D Accepts up to 18 selection criterion and generates the necessary
0005 H*D OCL code to run #GSORT to extract/sort the customer/item sales
0005 H*D history file. The calling report proc is stored in LDA to
0005 H*D determine various report-specific sort specs such as the header
0005 H*D and field specs.  To add another procedure the following must
0005 H*D be done:  Add proc name to PROC array, add the new sort header
0005 H*D spec to HDR, add the record type spec(s) to REC if necessary,
0006 H*S EDIT$    Edits the selection criteria
0006 H*S INIT$    Program Initialization
0009 H*I 40-57    Screen error indicators.
0014 H*===============================================================
0015 FWORKSTN CD  E               WORKSTN
0019 FPROC    O     120 120           DISK
0021 E* workstation arrays
0022 E              $FN         18  2 0         field number
0022 E              $OP         18  2         operation code
0022 E              $CR         18 15         selection criteria
0021 E* program work arrays
0022 E              OPNS      6   6  2         operation codes
0022 E              PROC      8   8  6         procedure names
0022 E              TABPRC  8   8  6   TABNUM  2 0 proc names & # of #GSORT field specs
0021 E* sort specs (OCL code)
0022 E              BEG      1   5 80         common 'beginning' OCL statements
0022 E              HDR      1   8 80         header specs
0022 E              REC      1  11 80         record selection specs
0037 I         UDS
0038 I                          1   8 @USER
0039 I                          9  10 @WS
     I                        505 512 @PROC       ?WS? + ?TIME?
0040 C*==============================================HILOEQ===========
0042 C     #@INIT    IFNE 1
0043 C               EXSR INIT$
0044 C               END
     C*
     C     T$1000    TAG
     C               EXFMTSCRN100
     C  KG           SETON             U7
     C  KG           GOTO T$9999
     C* call edit routine to check for errors
     C               EXSR EDIT$
     C* if any error occured, redisplay screen
     C     #@ERR     IFEQ 1
     C               GOTO T$1000
     C               END
     C* if Cmd/1 wasn't pressed loop back and redisplay
     C NKA           GOTO T$1000
     C* set array element pointer for procedure name
     C               SETOF             90
     C               Z-ADD1      Z      20
     C         @PROC       LOKUPPROC,Z             90
     C N90           DO
     C               SETON             U7    *proc not found - cancel job
     C               GOTO T$9999
     C               END
     C* display 'prompt' screen
     C               EXCPTWK110
     C* output // COPY statement with proc name
     C               EXCPTOCL1
     C* output common begining sort specs
     C               DO    5      X
     C               EXCPTOCL2
     C               END
     C* output sort header spec
     C               EXCPTOCL3
     C* output user-selected record type specs
     C               MOVE *BLANKS   #AND           *clear 'AND' code
     C               DO    18      X
     C         $FN,X       IFGE 1               *assume if valid $FN
     C         $FN,X       IFLE 18               *   then valid $OP and $CR
     C               SETOF             90
     C               Z-ADD1      Y      20
     C         $OP,X       LOKUPOPNS,Y             90*assume valid OPN since passed EDIT$
     C               EXCPTOCL4
     C               END
     C               MOVE 'A'      #AND           *set 'AND' code for remainder of loop
     C               END
     C* output field records for this proc
     C               DO    28      X
     C               SETOF             90
     C         @PROC       IFEQ PNAM,X
     C               EXCPTOCL5
     C               END
     C               END
     C*==============================================HILOEQ===========
     CSR     EDIT$       BEGSR
     C*
     C               Z-ADD0      #@ERR   10       *clear error flag
     C               DO    18      X      20       .DO once for each screen line
     C         X     ADD    39      Y      20        point to screen indicator
     C               Z-ADD0      *IN,Y         clear screen indicator
     C* if field num is blank, blank out operation and criterion
     C         $FN,X IFEQ *BLANKS
     C         $FN,X OREQ *ZEROS
     C               MOVE *BLANKS   $OP,X
     C               MOVE *BLANKS   $CR,X
     C               GOTO EDITX
     C               END
     C* if operation is blank, blank out field num and criterion
     C         $OP,X IFEQ *BLANKS
     C         $OP,X OREQ *ZEROS
     C               MOVE *ZEROS      $FN,X
     C               MOVE *BLANKS   $CR,X
     C               GOTO EDITX
     C               END
     C* check for valid field number range
     C         $FN,X IFLT 1
     C         $FN,X ORGT 11
     C               Z-ADD1      *IN,Y         turn on corresponding indicator
     C               Z-ADD1      #@ERR         set error flag
     C               END
     C* check for valid operation code
     C               SETOF             90
     C         $OP,X LOKUPOPNS             90
     C N90           Z-ADD1      *IN,Y          turn on corresponding indicator
     C N90           Z-ADD1      #@ERR          set error flag
     C               END                   .END
     C*
     C         EDITX       TAG
     C*
     CSR           ENDSR
     C*==============================================HILOEQ==========
     OPROC    E            OCL1
     O                     23 '// COPY LIBRARY-P,NAME-'
     O                   @PROC     31
     O          E            OCL2
     O                   COM,X     80
     O          E            OCL3
     O                   HDR,Z     80
     O          E            OCL4
     O                   REC,X     80
     O                   #AND      7
     O                   OPN,Y     18
     O                   $CR,X     34
     O          E            OCL5
     O                   FLD,X     80
**   operation codes
EQGEGTLELTNE
**   procedure names
SAL299SAL297SAL296SAL295SAL294SAL293SAL292SAL291
**   table of procedure names & number of sort field specs
SAL29905SAL29703SAL29603SAL29503SAL29403SAL29303SAL29205SAL29103
**   common 'beginning' sort specs
// REGION SIZE-64
// LOAD #GSORT
// FILE NAME-INPUT,LABEL-PRO.SCD,DISP-SHR
// FILE NAME-OUTPUT,LABEL-SAL010?WS?
// RUN
**   header specs for each program
//   HSORTA    17A      3       N           *SAL299
//   HSORTA    18A      3       N           *SAL297
//   HSORTA    18A      3       N           *SAL296
//   HSORTA    5A      3       N           *SAL295
//   HSORTA    18A      3       N           *SAL294
//   HSORTA    18A      3       N           *SAL293
//   HSORTA    8A      3       N           *SAL292
//   HSORTA    18A      3       N           *SAL291
**   common record selection and field specs (insert AND code & test condition)
//   I C   3   8  D                   *customer number
//   I C   9  23  C                   *item number
//   I C  36  36  C                   *sbu
//   I C  37  38  C                   *product group
//   I C 548 548  C                   *product line
//   I C 549 550  C                   *product class
//   I C  39  40  C                   *item class
//   I C  41  42  C                   *customer type
//   I C  43  44  C                   *company code
//   I C  33  34  C                   *sales region
//   I C  35  35  C                   *sales territory
**   proc names and their respective #GSORT field specs
SAL299//   FNC    33  34                     *sales region