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.
Code
*********************
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.
