//JOBNAME JOB (ACCT),NAME,CLASS=A,MSGCLASS=A,MSGLEVEL=(1,1) // EXPORT SYMLIST=* // SET VOLNM=volnam,VOLN2=volnm2 <== VOL NAME FOR TEST DATASET //********************************************************************* //ASMCG PROC AOPT=,APARM=,LOPT=, // MAC1='SYS1.MACLIB', // MAC2='SYS1.MACLIB', // MAC3='SYS1.MODGEN' //ASM EXEC PGM=ASMA90, // PARM=('OBJ,NODECK,LC(32767),XREF(SHORT),TERM,RLD,ASA,&AOPT', // 'US(MAP,WARN(11)),SYSPARM(&APARM)') //SYSPRINT DD SYSOUT=* //SYSTERM DD SYSOUT=* //SYSLIB DD DISP=SHR,DSN=&MAC1 // DD DISP=SHR,DSN=&MAC2 // DD DISP=SHR,DSN=&MAC3 //SYSUT1 DD UNIT=SYSALLDA,SPACE=(TRK,(80,20)) //SYSLIN DD DISP=(,PASS),UNIT=SYSALLDA,SPACE=(TRK,(30,15),RLSE), // DCB=(RECFM=FB,BLKSIZE=0,LRECL=80) //GO EXEC PGM=LOADER,COND=(5,LT,ASM), // PARM=('LIST,LET,MAP,XREF,&LOPT') //SYSLOUT DD DUMMY //SYSLIN DD DSN=*.ASM.SYSLIN,DISP=(OLD,DELETE) // PEND //********************************************************************* //IEBDG1 EXEC PGM=IEBDG //SYSPRINT DD SYSOUT=* //SYSUT2 DD DISP=(,PASS),UNIT=SYSDA,SPACE=(CYL,(1,1),RLSE), // DCB=(RECFM=FB,LRECL=80) //SYSIN DD * DSD OUTPUT=(SYSUT2) FD NAME=F1,LENGTH=03,STARTLOC=01,PICTURE=3,'KEY' FD NAME=F2,LENGTH=05,STARTLOC=04,FORMAT=ZD,INDEX=1 FD NAME=F3,LENGTH=72,STARTLOC=09,FORMAT=AL,ACTION=RP CREATE NAME=(F1,F2,F3),FILL=X'FF',QUANTITY=65535 END //* //GENDS EXEC PGM=IDCAMS //SYSPRINT DD SYSOUT=* //SYSUT1 DD DISP=(OLD,DELETE),DSN=*.IEBDG1.SYSUT2 //SYSIN DD *,SYMBOLS=JCLONLY DEL &SYSUID..SAMPKSD2 SET MAXCC=0 DEF CL(NAME(&SYSUID..SAMPKSD2) VOL(&VOLNM) - REC(50000 10000) RECSZ(80 80) KEYS(8 0) IXD) - INDEX(VOL(&VOLN2)) REPRO IFILE(SYSUT1) ODS(&SYSUID..SAMPKSD2) //* //IEBDG2 EXEC PGM=IEBDG //SYSPRINT DD SYSOUT=* //SYSUT2 DD DISP=(,PASS),UNIT=SYSDA,SPACE=(CYL,(1,1),RLSE), // DCB=(RECFM=FB,LRECL=80) //SYSIN DD * DSD OUTPUT=(SYSUT2) FD NAME=F1,LENGTH=03,STARTLOC=01,PICTURE=3,'KEY' FD NAME=F2,LENGTH=02,STARTLOC=04,FORMAT=RA CREATE NAME=(F1,F2),FILL=X'FF',QUANTITY=50000 END //* //SCRATCH EXEC PGM=IEFBR14 //SORTOUT DD DISP=(MOD,DELETE),DSN=&SYSUID..SAMPKEY2, // UNIT=SYSDA,SPACE=(TRK,1) //* //DFSORT EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SORTIN DD DISP=(OLD,DELETE),DSN=*.IEBDG2.SYSUT2 //SORTOUT DD DISP=(NEW,CATLG),DSN=&SYSUID..SAMPKEY2, // UNIT=SYSDA,VOL=SER=&VOLNM,SPACE=(TRK,(10,10),RLSE), // DCB=(RECFM=FB,LRECL=8) //SYSIN DD * SORT FIELDS=COPY OUTFIL OUTREC=(1,3,4,2,BI,EDIT=(TTTTT)) //********************************************************************* //STEP6 EXEC ASMCG //GO.OUTLIST DD DUMMY //GO.SYSUT1 DD DISP=SHR,DSN=&SYSUID..SAMPKSD2 //GO.KEYIN DD DISP=SHR,DSN=&SYSUID..SAMPKEY2 //ASM.SYSIN DD * *=====================================================================* * MVS STANDARD HOUSE KEEPING PROCEDURE * *=====================================================================* * *----------------------------------* * * ENTRY PROCESSING * * *----------------------------------* MYASMPGM CSECT , DEFINE CONTROL SECTION MYASMPGM AMODE 31 DEFINE DEFAULT AMODE=31 MYASMPGM RMODE 24 DEFINE DEFAULT RMODE=24 USING *,12 DEFINE BASE REGISTER SAVE (14,12),,* SAVE CALLER REGISTERS LA 12,0(,15) GR12 --> OUR 1ST BASE ADDRESS LR 15,13 SAVE CALLER SAVEAREA CNOP 0,4 INSURE FULL WORD BOUNDARY BAS 13,*+4+72 AROUND OUR SAVEAREA DC 18F'-1' OUR GPR SAVEAREA ST 15,4(,13) SAVE CALLER SAVEAREA POINTER ST 13,8(,15) SET BACK CHAIN FOR LINK TRACE B MAINPROC DO MAINLINE PROCESSING * *----------------------------------* * * EXIT PROCESSING * * *----------------------------------* EXITPROC DS 0H L 13,4(,13) RESTORE CALLER SAVEAREA ST 15,16(,13) PASS RETURN CODE TO CALLER RETURN (14,12),T RESTORE CALLER REGISTERS + AND RETURN TO CALLER EJECT , *********************************************************************** * MAIN LINE PROCESSING. * * ===================================================== * * GR1 -- EXEC PARAMETER PLIST * * GR12 - BASE REGISTER * * GR13 - OUR REGISTER SAVEAREA * *---------------------------------------------------------------------* * SAMPLE CODE OF 'MVS ADVANCED SKILL Vol-2' CHAPTER 5.4 * * ===================================================== * * SEARCH AND READ KSDS DATASET WITH VSAM/LSR. * *---------------------------------------------------------------------* * CHANGE ALLOCATE STEP(IDCAMS DEFINE CLUSTER, DFSORT) AND * * SYSUT1 DSNAME FOR YOUR ENVIRONMENT. * * //GENDS EXEC PGM=IDCAMS * * //SYSIN DD * * * DEL userid.SAMPKSD2 <=== * * DEF CL(NAME(userid.SAMPKSD2) VOL(volnam) - <=== * * INDEX(VOL(volna2)) <=== * * REPRO IFILE(SYSUT1) ODS(userid.SAMPKSD2) <=== * * //* * * //SCRATCH EXEC PGM=IEFBR14 * * //SORTOUT DD DISP=(MOD,DELETE),DSN=userid.SAMPKEY2, <=== * * // UNIT=SYSDA,VOL=SER=volnam <=== * * //* * * //DFSORT EXEC PGM=SORT * * //SORTOUT DD DISP=(NEW,CATLG),DSN=userid.SAMPKEY2, <=== * * // UNIT=SYSDA,VOL=SER=volnam, <=== * * //* * * //GO EXEC PGM=LOADER,COND=(5,LT,ASM), * * //SYSUT1 DD DISP=SHR,DSN=&SYSUID..SAMPKSD2 <=== * * //KEYIN DD DISP=SHR,DSN=&SYSUID..SAMPKEY2 <=== * *********************************************************************** MAINPROC DS 0H * *----------------------------------* * * SETUP PROCESSING * * *----------------------------------* OPEN (OUTLIST,OUTPUT, OPEN OUTLIST/SYSIN DATASET + KEYIN,INPUT) SPACE , BLDVRP BUFFERS=(512(10),18432(500)), BUILD SHARED RESOURCES + TYPE=LSR,KEYLEN=8,STRNO=10,RMODE31=ALL,SHRPOOL=0 SPACE , GENCB AM=VSAM, GENERATE VSAM ACB AREA + BLK=ACB, + DDNAME=SYSUT1, + MACRF=(IN,DIR,LSR), + RMODE31=ALL, + LOC=ANY ST R0,LNGACB SAVE ACB AREA LENGTH LR R2,R1 GR2 --> VSAM/ACB USING IFGACB,R2 ADDRESS IT GENCB BLK=RPL, + ACB=(S,IFGACB), + AREA=(S,ARECORD), + AREALEN=L'ARECORD, + OPTCD=(KEY,DIR,LOC), + LOC=ANY ST R0,LNGRPL SAVE RPL AREA LENGTH LR R3,R1 GR3 --> VSAM/RPL USING IFGRPL,R3 ADDRESS IT SPACE , * *----------------------------------* * * MAIN LINE PROCESSING * * *----------------------------------* OPEN ((2)),MODE=31 OPEN INPUT DATASET LTR RA,RF SUCCESSFUL ? BNZ OPENERR NO, DO ERROR PROCESSING SPACE , LOOP DS 0H GET KEYIN GET NEXT KEY DATA ST R1,RPLARG SET KEY ADDRESS AS RPL ARGUMENT GET RPL=IFGRPL SEARCH RECORD LTR RA,RF SUCCESSFUL ? BNZ IOERROR NO, CHECK ERROR REASON L RA,ARECORD LOAD RECORD AREA ADDRESS PUTREC DS 0H PUT OUTLIST,(10) WRITE RECORD TO OUTPUT LIST B LOOP LOOP FOR NEXT SEARCH KEY SPACE , EODPROC DS 0H CLOSE ((2)),MODE=31 CLOSE INPUT DATASET L R0,LNGACB LOAD ACB AREA LENGTH FREEMAIN RU,LV=(0),A=(2) FREEMAIN ACB STORAGE L R0,LNGRPL LOAD RPL AREA LENGTH FREEMAIN RU,LV=(0),A=(3) FREEMAIN RPL STORAGE DLVRP TYPE=LSR,SHRPOOL=0 DELETE SHARED RESOURCES POOL CLOSE (OUTLIST,,KEYIN) CLOSE OUTLIST/KEYIN DATASET B ENDPROGM GO TO EPILOGUE PROCEDURE SPACE , * *----------------------------------* * * ERROR PROCESSING * * *----------------------------------* OPENERR DS 0H MVC ERRMSG1+4+5(4),=CL4'OPEN' SLR R0,R0 IC R0,ACBERFLG B SHOWMSG IOERROR DS 0H MVC ERRMSG1+4+5(4),=CL4'I/O' SLR R0,R0 IC R0,RPLERRCD CH R0,=Y(16) RECORD NOT FOUND ? BNE SHOWMSG NO, INFORM ERROR MSG LA RA,=CL80'RECORD NOT FOUND...' B PUTREC SHOWMSG DS 0H CVD RF,DOUBLE CONVERT RETCD TO PACKED DECIMAL UNPK ERRMSG1+4+25(2),DOUBLE I OI ERRMSG1+4+26,C'0' V CVD R0,DOUBLE CONVERT ERRCD TO PACKED DECIMAL UNPK ERRMSG1+4+36(3),DOUBLE I OI ERRMSG1+4+38,C'0' V WTO MF=(E,ERRMSG1) INFORM VSAM OPEN ERROR LR RF,RA LOAD VSAM RETURN CODE B ENDPROGM GO TO EPILOGUE PROCEDURE SPACE , * *----------------------------------* * * END OF PROCESSING * * *----------------------------------* ENDPROGM DS 0H B EXITPROC DO EXIT PROCESSING EJECT , *********************************************************************** * DATA AREA * *********************************************************************** DS 0D *---------------------------------------------------------------------* * *----------------------------------* * * VSAM INTERFACE PARAMETERS * * *----------------------------------* ARECORD DC A(0) RECORD AREA POINTER LNGACB DC F'0' ACB STORAGE LENGTH LNGRPL DC F'0' RPL STORAGE LENGTH SPACE , ERRMSG1 WTO 'VSAM XXXX ERROR, RETCODE=99 ERRCODE=999',MF=L, + MCSFLAG=HRDCPY ZOSv23 SPACE , * *----------------------------------* * * WORKING DATA * * *----------------------------------* DOUBLE DC D'0' DOUBLE WORD WORKAREA SPACE , KEYIN DCB DDNAME=KEYIN,DSORG=PS,MACRF=GL,EODAD=EODPROC OUTLIST DCB DDNAME=OUTLIST,DSORG=PS,MACRF=PM,RECFM=FB,LRECL=80 *---------------------------------------------------------------------* LTORG , LITERAL POOL AT HERE DROP , FORGET ALL BASE REGISTERS EJECT , *********************************************************************** * DATA AREA (OUTSIDE OUR BASE) * *********************************************************************** *---------------------------------------------------------------------* * LOCAL WORKAREA * *---------------------------------------------------------------------* *---------------------------------------------------------------------* * DSECTS * *---------------------------------------------------------------------* IFGACB AM=VSAM VSAM ACB IFGRPL AM=VSAM VSAM RPL *---------------------------------------------------------------------* * S/370, ESA/390 REGISTER EQUATES * *---------------------------------------------------------------------* YREGS , OS: REGISTER EQUATES RA EQU 10 ADD EQUATION FOR GR10 RB EQU 11 ADD EQUATION FOR GR11 RC EQU 12 ADD EQUATION FOR GR12 RD EQU 13 ADD EQUATION FOR GR13 RE EQU 14 ADD EQUATION FOR GR14 RF EQU 15 ADD EQUATION FOR GR15 END // //