|
 |
 |
 |
Welcome to Code400.com
|
Okay...We all like to get free stuff..Right?!?
Well thats what we are offering here....Free Stuff
- Free storage for your source code.
- Free access to code
samples. (site search)
- Free place to ask questions or just say what you want.
We are interested in what you have to say.
If you can’t find what your’e looking for on this site....
We will add it.
The small print says: We provide the source code on this site as only
a guide. We do not recommend that anyone run any of the code provided
on this site without first testing it.
If you choose to download source from this site directly onto
your production box without testing....Well, YOU are completely to
blame and we don’t want to hear about it.
Random QuoteWe shall find peace. We shall hear the angels, we shall see the sky sparkling with diamonds.
Anton Chekhov, 1897
| |
 |
 |
|
V5R3 CLLE Enhancments
Download Program in text
Just a simple program
/*---------------------------------------------------------------*/
/* To compile run these commands first */
/* */
/* DSPOBJD OBJ(QSYS/ADD*) OBJTYPE(*CMD) + */
/* OUTPUT(*OUTFILE) OUTFILE(QTEMP/QADSPOBJ) */
/* */
/* DSPOBJD OBJ(QSYS/CHG*) OBJTYPE(*CMD) + */
/* OUTPUT(*OUTFILE) OUTFILE(QTEMP/QADSPOBJ2) */
/* */
/*---------------------------------------------------------------*/
pgm
/*--------------------------------------------------------*/
/* New TYPE values on DCL statement */
/* *INT & *UINT */
/* Len of 2 & 4 supported */
/* OPM doesnt support 8-Byte intengers - use CLLE */
/* (use %INT instead of binary) */
/* */
/* Previous limit on max parameters */
/* PGM & TFRCTL = 40 */
/* CALL = 99 */
/* New limits */
/* PGM & TFRCTL = 255 */
/* CALL = 255 */
/* */
/* Number of PARM statems remains at 99 */
/*--------------------------------------------------------*/
DCL VAR(&INT2) TYPE(*INT) LEN(2)
DCL VAR(&INT4) TYPE(*INT) LEN(4)
DCL VAR(&LOOP) TYPE(*CHAR) LEN(1) VALUE('Y')
DCL VAR(&COUNT) TYPE(*DEC) LEN(4 0)
/*------------------------------------------------------*/
/* character lengths have increaded from 9999 to 32767 */
/* Limit for TYPE(*CHAR) and TYPE(*PNAME) on */
/* PARM , ELEM, and QUAL command stays at 5000 */
/*------------------------------------------------------*/
DCL VAR(&BIGOFIELD) TYPE(*CHAR) LEN(32767)
DCL VAR(&INT) TYPE(*INT) LEN(2)
DCL VAR(&NAME) TYPE(*CHAR) LEN(10)
DCL VAR(&LGL) TYPE(*LGL) VALUE('1') /* True */
/*--------------------------------------------------------*/
/* Multiple file support */
/* supports upto 5 file "instances" */
/* instances can be for the same file of different files */
/* */
/* New OPNID (open identifier) parm added to DCLF */
/* (only 1 DCLF allowed with OPNID(*NONE) */
/* OPNID accepts 10 *char values */
/* If OPNID name is used then declared CL values are */
/* prefixed with this name : */
/* &FILE01_Field1 */
/* &FILE01_Field2 */
/* OPNID added to */
/* RCVF */
/* ENDRCV */
/* SNDF */
/* SNDRCVF */
/* WAIT */
/* */
/* I havent tried this but I think by defining the */
/* the file QADSPOBJ twice with different OPNID I */
/* can read the file again once it hits eof */
/* **once a file is read in CL (at EOF) the POSDBF */
/* doesnt reposition the pointer. */
/*--------------------------------------------------------*/
DCLF FILE(QTEMP/QADSPOBJ) OPNID(FILE01)
DCLF FILE(QTEMP/QADSPOBJ2) OPNID(FILE02)
DCLF FILE(QTEMP/QADSPOBJ) OPNID(FILE03)
DSPOBJD OBJ(QSYS/ADD*) OBJTYPE(*CMD) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/QADSPOBJ)
DSPOBJD OBJ(QSYS/CHG*) OBJTYPE(*CMD) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/QADSPOBJ2)
CHGVAR VAR(&COUNT) VALUE(0)
DOWHILE COND(LOOP = 'Y')
CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
/*--------------------------------------------------------*/
/* Loops .. */
/* DOWHILE : DOUNTIL : DOFOR */
/* each support */
/* LEAVE : ITERATE */
/* -> CASE */
/* SELECT : WHEN : OTHERWISE : ENDSELECT */
/* 25 Level nesting supported */
/*--------------------------------------------------------*/
SELECT
WHEN COND(&COUNT *LE 5) THEN(DO)
ITERATE
ENDDO
OTHERWISE CMD(DO)
leave
ENDDO
endSelect
enddo
/*--------------------------------------------------------*/
/* DOFOR: */
/* BY left blank defaults to 1 */
/* VAR must be *INT or *UINT */
/* FROM and TO can be integer constants, expressions, */
/* or variables */
/* BY must be an integer contant (may be negative) */
/* */
/* FROM/TO expressions are checked at loop initiation */
/* TO evaluated after increment */
/* */
/* Checks for loop exit aat top of loop */
/*--------------------------------------------------------*/
DOFOR VAR(&INT2) FROM(1) TO(12) BY(2)
leave
ENDDO
/*--------------------------------------------------------*/
/* LEAVE/ITERATE */
/* Leave defaults to current loop may be changed to */
/* any label. see example below */
/*--------------------------------------------------------*/
LOOP1: DOFOR VAR(&INT) FROM(0) TO(10)
LOOP2: DOUNTIL COND(&LGL)
IF COND(&NAME *EQ *NONE) THEN(LEAVE CMDLBL(LOOP1))
ENDDO /* DOUNTIL */
ENDDO /* DOFOR */
/*--------------------------------------------------------*/
/* Did someone say subroutines? */
/* IBM is looking to add SUBR, ENDSUBR and GOSUBR */
/*--------------------------------------------------------*/
endpgm
|
| |
