Create from the source

CRTFMSRC allows you to encode these compiler/create options in with the source code.

How many times have you recompiled an object only to find out later that you forgot to specify a particular keyword value to the compiler? CRTFMSRC allows you to encode these compiler/create options in with the source code. Formatted comment entries in the source code are used to specify such things as RTVCLSRC(*NO) and SIZE(*NOMAX).

In the source for CMD, CLP and CLLE, code the comment lines, beginning in col 1 /* CRTOPT: xxxxxxxxxxxxxxxxxxxxxxxxxx */

In the source for DSPF, LF, PF, RPG, RPGLE and PRTF, code the comment lines, beginning in column 1 /* CRT*OPT xxxxxxxxxxxxxxxxxxxxxxxxxx */

The first 10 characters of &SRCDTA will be chopped out, as will the trailing '*/'; the xxx's (compiler directives) will be appended to the base create command which contains the name of the source file and the created object, the source member type (used to identify which compiler to use) and an optional prompt.

You can code as many compiler directives in a single line as will fit, and as many of the special comment lines as required.

The CL is relatively straightforward and could be easily modified to include other compiler-source relationships.


   
*********************
The CRTFMSRC command:
*********************

             CMD        PROMPT('Create object from source')
             PARM       KWD(SRCFILE) TYPE(QUAL1) RSTD(*NO) MIN(1) +
                          ALWVAR(*YES) PROMPT('Source file')
             PARM       KWD(SRCMBR) TYPE(*NAME) LEN(10) MIN(1) +
                          CHOICE('name') PROMPT('Source member')
             PARM       KWD(SRCTYPE) TYPE(*CHAR) LEN(10) RSTD(*YES) +
                          VALUES('CLLE' 'CLP' 'CMD' 'DSPF' 'LF' +
                          'PF' 'PRTF' 'RPG' 'RPGLE') MIN(1) +
                          PROMPT('Source member type')
             PARM       KWD(OBJECT) TYPE(QUAL2) RSTD(*NO) +
                          ALWVAR(*YES) PROMPT('Created object')
             PARM       KWD(PROMPT) TYPE(*CHAR) LEN(4) RSTD(*YES) +
                          DFT(*NO) VALUES(*NO *YES) PROMPT('Prompt +
                          to confirm values?')
 QUAL1:      QUAL       TYPE(*NAME) LEN(10) CHOICE('name')
             QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) SPCVAL((*LIBL +
                          *LIBL) (*CURLIB *CURLIB)) PROMPT('Library')
 QUAL2:      QUAL       TYPE(*NAME) LEN(10) DFT(*MBRNAME) +
                          SPCVAL((*MBRNAME *MBRNAME)) CHOICE('name')
             QUAL       TYPE(*NAME) LEN(10) DFT(*CURLIB) +
                          SPCVAL((*CURLIB *CURLIB)) PROMPT('Library')

****************
... and the CPP:
****************

             PGM        PARM(&SOURCE &SRCMBR &SRCTYP &OBJECT &PMTRQS)

/* Workfile & Input Parms */
             DCLF       FILE(*LIBL/QCLSRC)

             DCL        VAR(&SOURCE) TYPE(*CHAR) LEN(20)
             DCL        VAR(&SRCMBR) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCTYP) TYPE(*CHAR) LEN(10)
             DCL        VAR(&OBJECT) TYPE(*CHAR) LEN(20)
             DCL        VAR(&PMTRQS) TYPE(*CHAR) LEN(4)

/* Work variables */
             DCL        VAR(&CMD)    TYPE(*CHAR) LEN(10)
             DCL        VAR(&CMDSTR) TYPE(*CHAR) LEN(2000)
             DCL        VAR(&JOBTYP) TYPE(*CHAR) LEN(1)
             DCL        VAR(&OBJ)    TYPE(*CHAR) LEN(10)
             DCL        VAR(&OBJNAM) TYPE(*CHAR) LEN(10)

             DCL        VAR(&OBJLIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&OBJTYP) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCFIL) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCLIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&STRIDX) TYPE(*DEC)  LEN(2)

/* Input parameter processing */
             CHGVAR     VAR(&OBJNAM) VALUE(%SST(&OBJECT 01 10))
             CHGVAR     VAR(&OBJLIB) VALUE(%SST(&OBJECT 11 10))
             CHGVAR     VAR(&SRCFIL) VALUE(%SST(&SOURCE 01 10))
             CHGVAR     VAR(&SRCLIB) VALUE(%SST(&SOURCE 11 10))

/* Identify command & object type appropriate to source type */
             IF       (&SRCTYP = 'CLLE')  (CHGVAR &CMD 'CRTBNDCL')
             IF       (&SRCTYP = 'CLLE')  (CHGVAR &OBJ 'PGM')
             IF       (&SRCTYP = 'CLP')   (CHGVAR &CMD 'CRTCLPGM')
             IF       (&SRCTYP = 'CLP')   (CHGVAR &OBJ 'PGM')
             IF       (&SRCTYP = 'CMD')   (CHGVAR &CMD 'CRTCMD')
             IF       (&SRCTYP = 'CMD')   (CHGVAR &OBJ 'CMD')
             IF       (&SRCTYP = 'DSPF')  (CHGVAR &CMD 'CRTDSPF')
             IF       (&SRCTYP = 'DSPF')  (CHGVAR &OBJ 'FILE')
             IF       (&SRCTYP = 'LF')    (CHGVAR &CMD 'CRTLF')
             IF       (&SRCTYP = 'LF')    (CHGVAR &OBJ 'FILE')
             IF       (&SRCTYP = 'PF')    (CHGVAR &CMD 'CRTPF')
             IF       (&SRCTYP = 'PF')    (CHGVAR &OBJ 'FILE')
             IF       (&SRCTYP = 'PRTF')  (CHGVAR &CMD 'CRTPRTF')
             IF       (&SRCTYP = 'PRTF')  (CHGVAR &OBJ 'FILE')
             IF       (&SRCTYP = 'RPG')   (CHGVAR &CMD 'CRTRPGPGM')
             IF       (&SRCTYP = 'RPG')   (CHGVAR &OBJ 'PGM')
             IF       (&SRCTYP = 'RPGLE') (CHGVAR &CMD 'CRTBNDRPG')
             IF       (&SRCTYP = 'RPGLE') (CHGVAR &OBJ 'PGM')

/* Resolve logical values */
             IF         COND(&OBJNAM *EQ '*MBRNAME') +
             THEN(DO)
             CHGVAR     VAR(&OBJNAM) VALUE(&SRCMBR)
             ENDDO

             IF         COND(%SST(&SRCLIB 1 1) *EQ '*') +
             THEN(DO)
             RTVOBJD    OBJ(&SRCLIB/&SRCFIL) OBJTYPE(*FILE) +
                          RTNLIB(&SRCLIB)
             ENDDO

             IF         COND(%SST(&OBJLIB 1 1) *EQ '*') +
             THEN(DO)
             CHGVAR     VAR(&OBJTYP) VALUE('*' |< &OBJ)
             RTVOBJD    OBJ(&OBJLIB/&OBJNAM) OBJTYPE(&OBJTYP) +
                          RTNLIB(&OBJLIB)
             ENDDO

/* Ensure source file & member exist */
             CHKOBJ     OBJ(&SRCLIB/&SRCFIL) OBJTYPE(*FILE) +
                          MBR(&SRCMBR)
             MONMSG     MSGID(CPF9800) +
             EXEC(DO)
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Source' +
                          |> &SRCLIB |< '/' |< &SRCFIL |< '.' |< +
                          &SRCMBR |> 'not available. Check joblog +
                          for details') TOPGMQ(*PRV) MSGTYPE(*DIAG)
             GOTO       CMDLBL(LBL990)
             ENDDO

/* Initialisation */
             RTVJOBA    TYPE(&JOBTYP)
             DLTF       FILE(QTEMP/CRTFMSRC)
             MONMSG     MSGID(CPF2105)
             RCVMSG     MSGQ(*PGMQ) MSGTYPE(*ANY) RMV(*YES)
             CRTSRCPF   FILE(QTEMP/CRTFMSRC)
             RCVMSG     MSGQ(*PGMQ) MSGTYPE(*ANY) RMV(*YES)

/* Extract compilation-option records */
   /* Control language */
             IF         COND((&SRCTYP *EQ 'CLLE') +
                         *OR (&SRCTYP *EQ 'CLP') +
                         *OR (&SRCTYP *EQ 'CMD')) +
             THEN(DO)
             CPYF       FROMFILE(&SRCLIB/&SRCFIL) +
                          TOFILE(QTEMP/CRTFMSRC) FROMMBR(&SRCMBR) +
                          TOMBR(&SRCMBR) MBROPT(*REPLACE) FMTOPT(*MAP) +
                          INCREL((*IF SRCDTA *EQ '/* CRTOPT:'))
             RCVMSG     MSGQ(*PGMQ) MSGTYPE(*ANY) RMV(*YES)
             RCVMSG     MSGQ(*PGMQ) MSGTYPE(*ANY) RMV(*YES)
             RCVMSG     MSGQ(*PGMQ) MSGTYPE(*ANY) RMV(*YES)
             ENDDO
   /* DDS */
             IF         COND((&SRCTYP *EQ 'DSPF') +
                         *OR (&SRCTYP *EQ 'LF') +
                         *OR (&SRCTYP *EQ 'PF') +
                         *OR (&SRCTYP *EQ 'RPG') +
                         *OR (&SRCTYP *EQ 'RPGLE') +
                         *OR (&SRCTYP *EQ 'PRTF')) +
             THEN(DO)
             CPYF       FROMFILE(&SRCLIB/&SRCFIL) +
                          TOFILE(QTEMP/CRTFMSRC) FROMMBR(&SRCMBR) +
                          TOMBR(&SRCMBR) MBROPT(*REPLACE) FMTOPT(*MAP) +
                          INCREL((*IF SRCDTA *EQ '/* CRT*OPT'))
             RCVMSG     MSGQ(*PGMQ) MSGTYPE(*ANY) RMV(*YES)
             RCVMSG     MSGQ(*PGMQ) MSGTYPE(*ANY) RMV(*YES)
             RCVMSG     MSGQ(*PGMQ) MSGTYPE(*ANY) RMV(*YES)
             ENDDO

/* Access extracted records */
             OVRDBF     FILE(QCLSRC) TOFILE(QTEMP/CRTFMSRC) +
                          MBR(&SRCMBR)

/* Prepare base of command string */
             CHGVAR     VAR(&CMDSTR) VALUE(&CMD |> 'SRCFILE(' |< +
                          &SRCLIB |< '/' |< &SRCFIL |< ') SRCMBR(' +
                          |< &SRCMBR |< ')' |> &OBJ |< '(' |< +
                          &OBJLIB |< '/' |< &OBJNAM |< ')')

/* Command prompt ? */
             IF         COND((&JOBTYP *EQ '1') +
                        *AND (&PMTRQS *EQ '*YES')) +
                        THEN(CHGVAR &CMDSTR ('?' |> &CMDSTR))

/* Append create-command options from source-file */
 LBL010:     RCVF       DEV(*FILE)
             MONMSG     MSGID(CPF0864) EXEC(GOTO CMDLBL(LBL025))
   /* Remove format data from record */
             CHGVAR     VAR(&SRCDTA) VALUE(%SST(&SRCDTA 11 70))
             CHGVAR     VAR(&STRIDX) VALUE(80)
 LBL015:     CHGVAR     VAR(&STRIDX) VALUE(&STRIDX - 1)
             IF         COND(&STRIDX *LE 0) THEN(GOTO CMDLBL(LBL020))
             IF         COND(%SST(&SRCDTA &STRIDX 2) *NE '*/') +
                          THEN(GOTO CMDLBL(LBL015))
             CHGVAR     VAR(%SST(&SRCDTA &STRIDX 2)) VALUE('  ')

 LBL020:     CHGVAR     VAR(&CMDSTR) VALUE(&CMDSTR |> &SRCDTA)
             GOTO       CMDLBL(LBL010)

/* Execute complete command */
 LBL025:     RCVMSG     MSGQ(*PGMQ) MSGTYPE(*ANY) RMV(*YES)
             DLTOVR     FILE(QCLSRC)
             CALL       PGM(*LIBL/QCMDEXC) PARM(&CMDSTR 2000)
             MONMSG     MSGID(CPF6801)
             MONMSG     MSGID(CPF0000) EXEC(SNDPGMMSG MSGID(CPF9898) +
                          MSGF(QCPFMSG) MSGDTA(&CMDSTR) TOPGMQ(*SAME))

/* Program Exit */
 LBL990:     RETURN
             ENDPGM

  
  

==================================
MORE INFORMATION ON THIS TOPIC
==================================

The Best Web Links: tips, tutorials and more.

Ask your programming questions--or help out your peers by answering them--in our live discussion forums.

Ask the Experts yourself: Our application development gurus are waiting to answer your programming questions.

This was first published in January 2003

Dig deeper on iSeries CL programming

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchEnterpriseLinux

SearchDataCenter

Close