Re: Bit Testing in CL Program?

"MIDRANGE-L" <midrange-l-bounces@xxxxxxxxxxxx> wrote on 12/20/2016
12:15:34 PM:

OK, I got the CALLPRC syntax to be accepted by the editor but it

won't create a program object because the TSTBTS symbol is not found. Is

there a binding directory or service program that I need to add to the
compile? Thanks.

Well, I never found an example but I did finally get the following
to work as desired. Not sure whether this was worth it. hehehe

CHGVAR VAR(&QFNM) VALUE(&SRCF *CAT '*LIBL')
CHGVAR VAR(&API_BPROV) VALUE(3016)
CALL PGM(QDBRTVFD) PARM(&RCVR &RCVL &QOUT +
'FILD0100' &QFNM '*FIRST' '1' '*LCL' +
'*INT' &APIERRC)
IF COND(&API_BAVAIL *GT 0) THEN(DO)
SNDPGMMSG MSGID(&API_MSGID) MSGF(QCPFMSG) +
MSGDTA(&API_MDATA) MSGTYPE(*ESCAPE)
ENDDO

CHGVAR VAR(&CHAR) VALUE(%SST(&RCVR 9 1))

CHGVAR VAR(&BIT_POS) VALUE(2)
CALLPRC PRC('_TSTBTS') PARM((&CHAR) (&BIT_POS *BYVAL)) +
RTNVAL(&BIT_POS)
CHGVAR VAR(&BIT_2_ON) VALUE(&BIT_POS *EQ 1)

CHGVAR VAR(&BIT_POS) VALUE(4)
CALLPRC PRC('_TSTBTS') PARM((&CHAR) (&BIT_POS *BYVAL)) +
RTNVAL(&BIT_POS)
CHGVAR VAR(&BIT_4_ON) VALUE(&BIT_POS *EQ 1)

IF COND(&BIT_2_ON) THEN(CHGVAR &FILEATRB *LF)
ELSE CMD(CHGVAR &FILEATRB *PF)
IF COND(&BIT_4_ON) THEN(CHGVAR &FILETYPE *SRC)
ELSE CMD(CHGVAR &FILEATRB *DATA)

IF COND(&FILEATRB *NE '*PF' +
*OR &FILETYPE *NE '*SRC') THEN(DO)
SNDPGMMSG MSGID(WSE9897) MSGF(&MSGF) MSGDTA('File is +
not a physical source file.') +
MSGTYPE(*ESCAPE)
ENDDO


Sincerely,

Dave Clark