Control Lanuage programs have been the operational interface between the operating system and application programs from the IBM System/38 to the AS/400, to the iSeries, and the current power systems architecture.

The code listed on this page represents a CL program (CLP) I wrote as a pre-compiler for RPG programs. Typically, an RPG programmer might perform some file override operations before compiling a program. I stuck formatted text in the RPG source file, and wrote this program to read the source code and perform any file override operations before compiling the RPG program.

It sends messages to the user if the compile was successful, or not. It does not remove the old program object unless the compile is successful.

Pre-Compiler

/*===================================================================*/
/* Program and Declarative Section:                                  */
/*===================================================================*/
             PGM        PARM(&PGM &OBJLIB &SRCFILE &SRCLIB &SRCMBR)

             DCL        VAR(&PGM) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCLIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCFILE) TYPE(*CHAR) LEN(10)
             DCL        VAR(&OBJLIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCMBR) TYPE(*CHAR) LEN(10)
             DCL        VAR(&FMFILE) TYPE(*CHAR) LEN(10)
             DCL        VAR(&TOFILE) TYPE(*CHAR) LEN(10)
             DCL        VAR(&CNT) TYPE(*DEC) LEN(3 0)
             DCL        VAR(&LEN) TYPE(*DEC) LEN(3 0)
             DCL        &ERRORSW *LGL
             DCL        &MSGID *CHAR LEN(7)
             DCL        &MSGDTA *CHAR LEN(100)
             DCLF       FILE(*LIBL/QRPGSRC)

/*===================================================================*/
/* Define Global Monitor Messages:                                   */
/*   Define monitor messages to prevent a process from sending CPF   */
/*   error messages to the user, or operator. Point to a error       */
/*   handling section of the program.                                */
/*===================================================================*/

             MONMSG     MSGID(CPF0000) EXEC(GOTO ERROR)

             IF         COND(&SRCMBR *EQ '*PGM') THEN(CHGVAR +
                          VAR(&SRCMBR) VALUE(&PGM))

             OVRDBF     FILE(QRPGSRC) TOFILE(&SRCLIB/&SRCFILE) +
                          MBR(&SRCMBR)

/*-------------------------------------------------------------------*/
/* Read the data base file, EOF go to END. This example shows a      */
/* simple read of a record, with a monitor for end-of-file.          */
/*-------------------------------------------------------------------*/

 READ:       RCVF
             MONMSG     MSGID(CPF0864) EXEC(GOTO CMDLBL(COMPILE))
             MONMSG     MSGID(CPF0859)
             MONMSG     MSGID(CPF0860)
             MONMSG     MSGID(CPF0861)
             CHGVAR     VAR(&CNT) VALUE(9)
             CHGVAR     VAR(&LEN) VALUE(0)

             IF         COND(%SST(&SRCDTA 6 1) *EQ 'F') THEN(GOTO +
                          CMDLBL(COMPILE))

/*-------------------------------------------------------------------*/
/* Test the source record to see if an override spec has been found  */
/*-------------------------------------------------------------------*/

             IF         COND(%SST(&SRCDTA 7 3) *EQ '*V:') THEN(DO)
 NEXT:       CHGVAR     VAR(&CNT) VALUE(&CNT + 1)
             CHGVAR     VAR(&LEN) VALUE(&LEN + 1)
             IF         COND(&LEN *GT 21) THEN(GOTO CMDLBL(READ))
             IF         COND(%SST(&SRCDTA &CNT 1) = '.') THEN(DO)
                  CHGVAR  VAR(&LEN) VALUE(&LEN - 1)
                  CHGVAR  VAR(&FMFILE) VALUE(%SST(&SRCDTA 10 &LEN))
                  CHGVAR  VAR(&CNT) VALUE(&CNT + 1)
                  CHGVAR  VAR(&TOFILE) VALUE(%SST(&SRCDTA &CNT 10))
OVRDBF     FILE(&FMFILE) TOFILE(*LIBL/&TOFILE)
             GOTO       CMDLBL(READ)
             ENDDO
             GOTO       NEXT
             ENDDO

             GOTO       CMDLBL(READ)

COMPILE:

/*------------------------------------------------------------------*/
/* Compile the program into QTEMP. If the compile fails send error  */
/* message and escape. If the compile was successful, remove the    */
/* superceded program and move the new program from QTEMP to the    */
/* object library.                                                  */
/*------------------------------------------------------------------*/

             CRTRPGPGM  PGM(QTEMP/&PGM) SRCFILE(&SRCLIB/&SRCFILE) +
                          SRCMBR(&SRCMBR) USRPRF(*USER)
             MONMSG     MSGID(QRG9001) EXEC(GOTO CMDLBL(PGMERR))

             DLTPGM     PGM(&OBJLIB/&PGM)
             MONMSG     MSGID(CPF2105)

             MOVOBJ     OBJ(QTEMP/&PGM) OBJTYPE(*PGM) TOLIB(&OBJLIB)
             SNDPGMMSG  MSG('Program compile completed normally ') +
                          MSGTYPE(*COMP)
             RETURN

/*==================================================================*/
/* Error Handling Section:                                          */
/*   Define a method of sending diagnostic and escape messages      */
/*   to prevent CPF messages from being passed to the user for      */
/*   reply, or action, (C G I R D S).                               */
/*==================================================================*/

ERROR:
             IF         COND(&ERRORSW) THEN(SNDPGMMSG MSGID(CPF9999) +
                          MSGF(*LIBL/QCPFMSG) MSGTYPE(*ESCAPE)) /* +
                          Func chk */
             CHGVAR     VAR(&ERRORSW) VALUE('1')

PGMERR:    SNDPGMMSG MSGID(CPD0006) +
             MSGF(*LIBL/QCPFMSG) MSGDTA('0000Program object ' *CAT +
             &PGM *TCAT ' not created in ' *CAT &OBJLIB) +
             MSGTYPE(*DIAG)
             SNDPGMMSG  MSGID(CPF0002) MSGF(*LIBL/QCPFMSG) +
                          MSGTYPE(*ESCAPE)

 ESCAPE:     RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID)
             SNDPGMMSG  MSGID(&MSGID) MSGF(*LIBL/QCPFMSG) +
                          MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)

ENDPGM
	  
	

Contents