//MARKJ JOB (0),'STORE MEMBERS',CLASS=A,MSGCLASS=T //* //* ------------------------------------------------------------------- //* START - JCL DECK CUSTOMISATION NOTES //* ------------------------------------------------------------------- //* Globally change the below strings to something suitable //* for your site prior to running this JCL. That will save you //* from having to customise members individually later. //* //* Values for creating the install PDS dataset (the members //* in this JCL deck are installed into this newly created file) //* INSTALL.MID.VSAM.MACROS //* UNIT=3350,VOL=SER=SRCMD1 //* //* Existing Non APF-authourised load library (EXAMPASM assembles //* the example program into this library) //* MARK.LIB.LOAD //* //* VSAM dataset name and the unit and volume the VSAM catalog //* for the dataset prefix reside on (EXAMPJCL uses this to //* create (and at the end delete) a test keyed VSAM file when //* running the test program). The volume is expected to have //* enough free space in the VSAM dataspace area on the volume //* to create the file within. //* VSAM.MARK.VVDS.TEST //* UNIT=3330,VOL=SER=VSAM01 //* //* And all the jobnames are "MARKJ JOB (0)," so change to your //* "jobname job (acct)," standard. //* //* Then you can run this job to create the install dataset and //* members. //* Read the $DOC member. //* The job to assemble the test program (exampasm) uses the //* install PDS created by this JCL as it's macro library. You will //* want to copy the members VSAMCODE and VSSETERR to one of your //* macro libraries if you intend to use them a lot. //* ------------------------------------------------------------------- //* END - JCL DECK CUSTOMISATION NOTES //* ------------------------------------------------------------------- //* //STEPA EXEC PGM=IEFBR14 //DD1 DD DISP=(NEW,CATLG,DELETE), // DSN=INSTALL.MID.VSAM.MACROS, // UNIT=3350,VOL=SER=SRCMD1, // SPACE=(TRK,(1,1,5)), // DCB=SYS1.MACLIB //STEPB EXEC PGM=IEBUPDTE //SYSPRINT DD SYSOUT=* //SYSUT1 DD DISP=SHR,DSN=INSTALL.MID.VSAM.MACROS //SYSUT2 DD DISP=SHR,DSN=INSTALL.MID.VSAM.MACROS //SYSIN DD DATA,DLM=ZZ ./ ADD NAME=VSERRSET MACRO &NAME VSERRSET &RETURN= * ===================================================================== * USED TO TEMPORARILY CHANGE THE DEFAULT EXIT LOCATION SO A USER CALL * TO ONE OF THE FUNCTIONS JUMPS TO THE NEW LABEL ON AN ERROR INSTEAD * OF THE DEFAULT RETURN= USED ON THE VSAMCODE MACRO. * IT IS TEMPORARY, IT IS RESET TO THE DEFAULT AS SOON AS A VSAMCODE * ROUTINE IS CALLED. * ===================================================================== LA R4,&RETURN ST R4,$VSJUMPX MEND ./ ADD NAME=VSAMCODE MACRO &NAME VSAMCODE &RETURN=READCARD,&FATAL=EXIT04,&DDNAME=JCLDDNAM, X &DBKEYL=KEYLEN,&DBKEYOF=0,&DBRECL=RECLEN * ===================================================================== * * VSAMCODE: ASM/370 MACRO OS=MVS3.8J * PURPOSE: Generic macro to provide keyed I-O to manage a VSAM file * HISTORY: I have a lot of programs that were basically repeating * this code inline. Macro created as a generic replacement, * with changes made to work properly :-). * This macro allows access to one VSAM file from a program. * CREDITS: Much of the program code in this macro has been copied * from Jay Moseleys cobol/vsam interface code (v1), I see * "http://www.jaymoseley.com/hercules/vsam_io/vscobol.htm" * has now been updated to allow multiple VSAM files to be * used from a cobol program so you may want to look at that * also. * MODS: My changes (to v1) were limited to (apart from not needing * a structured interface for cobol) was remove direct access * methods (as I only needed updated by key), to add a few * CHECK and ENDREQ calls, plus change the VSEOF handling to * fix an issue (I may have introduced) where switching from * a sequential read until EOF caused issues with later * updates by key. AND of course to make it a asm/370 macro * so I get all the needed code with a one-liner in my pgms. * * * R E F E R T O E X A M P A S M P R O G R A M FOR AN EXAMPLE * OF HOW TO USE THE MACRO. The example program provides an easy way to * test all functions I need for keyed VSAM access, test job is * exampjcl. * Also refer to the $DOC member for tips/tweaks to make it easier for * your programs to handle errors (record not found etc). * * MACRO VARIABLES USED * -------------------- * RETURN - a "loop" point label to jump to at either an error * condition or on EOF during sequential reads. * The example program sets this to a label reading the next * sysin card so on error or normal end of a seqential listing * it carries on with the next test request (see the $DOC * member on how to make this more useful). * * FATAL - a label to jump to on a fatal I-O error, this would * normally be a program exit point. Assume the VSAM file * has been opened. Actually this is only used currently * if there is an error closing the file, but I did not want * to hard code a LABEl in the macro one must be provided. * * DDNAME - the DDNAME used in the JCL to reference the VSAM file * * DBKEYL - excpected to be defined as an EQU in the database record * definition used. Database Key length. * * DBKEYOF - key offset into the record, default is 0 (key at start) * * DBRECL - excpected to be defined as an EQU in the database record * definition used. The file max record length. * * USAGE REQUIREMENTS * ------------------ * User should define a record layout which includes constants for the * record key-length, record-length and key offset to be provided to * the macro values; these are EQU constants (See example program). * * General Notes * ------------- * Uses $IOAREA for all its I-O. That is defined inline based on the * RECLEN size provided. That data area is where you will be * performing I-O from/to. * * You should never use R10 (used to address $IOAREA) or R2 (used * for RPL assressing) in your code. * Other registers should also be considered untrusted so save * any important registers you use around calls to the code in this * macro. * * Examples: Some very simple examples * ----------------------------------- * Refer to the example program member for a working example. * * ---- example reading all records in a file ---- * SEEKSTRT MVC $IOAREA+KEYOFFSET(KEYLEN),SPACES # NULL TO KEY * BAL R4,READAPRX * * DO SOMETHING WITH FIRST RECORD IN $IOAREA * EXECL201 BAL R14,MODIFY * GET RPL=(R2) READ NEXT RECORD * * DO SOMETHING WITH NEXT RECORD IN $IOAREA * B EXECL201 LOOP UNTIL VSAM EOF * * NOTE: AT VSAM EOF WE RETURN TO LABEL ON RETURN= ENTRY * * ---- example reading an exact record ---- * EXECREAD MVC $IOAREA+KEYOFFSET(KEYLEN),KEYVALUE * BAL R4,READEXCT * * DO SOMETHING WITH RECORD IN $IOAREA * B READCARD <-- normally same as RETURN= * * ---- example inserting a new record ---- * EXECINS MVC $IOAREA(RECLEN),RECDATA * BAL R4,INSERT * B READCARD <-- normally same as RETURN= * * ---- example deleting an existing record ---- * EXECDELT MVC $IOAREA+KEYOFFSET(KEYLEN),KEYVALUE * BAL R4,READEXCT * BAL R4,DELETE * B READCARD <-- normally same as RETURN= * * ---- example updating an existing record ---- * EXECUPDT MVC $IOAREA+KEYOFFSET(KEYLEN),KEYVALUE * BAL R4,READEXCT * MVC $IOAREA(DBSLEN),RECDATA *KEY MUST BE THE SAME* * BAL R4,UPDATE * B READCARD <-- normally same as RETURN= * * ---- example use of skeleton ---- * VSAMOPEN * LTR R15,R15 * BNZ EXIT08 * READCARD EQU * * * DO LOTS OF USER STUFF IN A LOOP * B READCARD * READCEOF EQU * FINISHED USER STUFF * VSAMCLOS * EXIT00 .... exit RC0 * EXIT04 VSAMCLOS * .... exit RC4 * EXIT08 .... exit RC8 * *......and somewhere is user code area the below.... * VSAMCODE RETURN=READCARD,FATAL=EXIT04,DDNAME=MYDDNAME, * DBKEYL=KEYLEN,DBRECL=RECLEN * * ===================================================================== LTORG EJECT * --------------------------------------------------------------------- * VSAMOPEN CALL BAL R4,VSAMOPEN * OPEN THE VSAM FILE FOR KSDS, INPUT/OUTPUT * TRASHES REGISTERS R2,R7,R10,R14 * R15 CONTAINS RESULT OF OPEN REQUEST, CALLER TO TEST WITH LTR R15,R15 * --------------------------------------------------------------------- VSAMOPEN DS 0F ST R4,$SAVER4 * SAVE DEFAULT RETURN ADDRESS LA R4,&RETURN GET ADDRESS OF COMMON LOOP RETURN ST R4,$VSJUMPX POINT AND STORE IT FOR USE * RESET FIELDS USED FOR STATUS INFORMATION XC $RC,$RC CLEAR RETURN CODE XC $VSRC,$VSRC CLEAR VSAM RETURN CODE XC $VSFUNC,$VSFUNC CLEAR VSAM FUNCTION CODE XC $VSREAS,$VSREAS CLEAR VSAM REASON CODE L R10,=A($IOAREA) THE IO BUFFER AREA SR R7,R7 CLEAR ADDR FOR STORE ST R7,$RECOVRP NO RPL FIXUPS NEEDED YET LA R7,&DBRECL SET RECLEN VALUE, ITS AN EQU VALUE STH R7,$RECLEN SAVE FOR USE LA R7,&DBKEYL SET KEY LENGTH, AN EQU VALUE STH R7,$KEYLEN SAVE FOR USE LA R7,&DBKEYOF KEY OFFSET STH R7,$RKP SAVE FOR USE SR R7,R7 CLEAR AGAIN * BUILD ACCESS CONTROL BLOCK USING MODEL MVC IFGACB($ACBLEN),ACBMODEL LA R2,IFGACB MODCB ACB=(R2),DDNAME=(*,$DDNAME) * BUILD REQUEST PARAMETER LIST USING MODEL MVC IFGRPL($RPLLEN),RPLMODEL LA R2,IFGRPL MODCB RPL=(R2),ACB=(S,IFGACB) * ACCESS MODE TO BE USED, KSDS, IN R7 SR R7,R7 LA R7,18 LA R2,IFGACB MODCB ACB=(R2),MACRF=(KEY) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(KEY) * USE DYNAMIC ACCESS FOR THE VSAM FILE LA R7,6(,R7) LA R2,IFGACB MODCB ACB=(R2),MACRF=(SEQ,DIR) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(SEQ) * FILE TO BE OPENED FOR INPUT/OUTPUT LA R7,2(,R7) LA R2,IFGACB MODCB ACB=(R2),MACRF=(OUT) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(UPD) * DO THE REST OF THE REQUIRED RPL MODS AND OPEN THE DS BAL R14,MODIFY LA R2,IFGACB OPEN ((R2)) * R15 IS TO BE CHECKED BY THE CALLER FOR SUCCESS VIA THE * STANDARD LTR R15,R15 TEST. * OK, DONE HERE OPENKSDX L R4,$SAVER4 BR R4 EJECT * --------------------------------------------------------------------- * CALLED BAL R4,VSAMCLOS * * ON ERROR JUMPS TO &FATAL * TRASHES REGISTERS R2,R7 * --------------------------------------------------------------------- VSAMCLOS LA R7,&FATAL SET VSAM AFTER RECOVER PTR ST R7,$RECOVRP TO A PGM EXIT LOCATION SO THAT * IF THERE IS AN ERROR ON CLOSE * WE DO NOT START LOOPING TO THE * PRIOR RECOVERY ROUTINE. LA R2,IFGACB CLOSE THE VSAM DATASET CLOSE ((R2)) BR R4 RETURN EJECT * --------------------------------------------------------------------- * READ EXACT * CALLED BAL R4,READEXCT * * VALUE OF THE KEY FIELD IN $IOAREA MUST BE SET CORRECTLY * TRASHES REGISTERS R2 AND R7 * * OUTPUTS IF RECORD EXISTS: * RECORD READ IS IN $IOAREA * ACTUAL RECORD LENGTH READ IS IN $RECLEN * * IF RECORD DOES NOT EXIST EXITS VIA THE VSERROR HANDLER ROUTINE * --------------------------------------------------------------------- READEXCT DS 0F READ EXACT ST R4,$SAVER4 BAL R14,MODIFY SR R7,R7 NO NEED TO RESTORE DEFAULT ST R7,$RECOVRP * KEYPOSITION MODCB RPL=(R2),OPTCD=(KEQ) POINT RPL=(R2) MODCB RPL=(R2),OPTCD=(KEQ) * READ BAL R14,MODIFY GET RPL=(R2) CHECK RPL=(R2) SHOWCB RPL=(R2),FIELDS=RECLEN,AREA=$FEEDBAK,LENGTH=4 L R7,$FEEDBAK STH R7,$RECLEN LENGTH ACTUALLY READ (NEED 4 UPDATE/DEL) * DONE LA R1,&RETURN put default back in... ST R1,$VSJUMPX ...to the default return L R4,$SAVER4 BR R4 EJECT * --------------------------------------------------------------------- * READ APROXIMATE * CALLED BAL R4,READAPRX * * READ THE FIRST RECORD MATCHING OR IF NO MATCH NEXT HIGHER KEY * TRASHES REGISTERS R7 AND R14 * * OUTPUTS: * RECORD READ IS IN $IOAREA * ACTUAL RECORD LENGTH READ IS IN $RECLEN * --------------------------------------------------------------------- READAPRX DS 0F READ APROX (GTE) ST R4,$SAVER4 BAL R14,MODIFY * KEYPOSITION MODCB RPL=(R2),OPTCD=(KGE) LA R7,@STARTRS ADDRESS TO RESTORE DEFAULT ST R7,$RECOVRP POINT RPL=(R2) SR R7,R7 TO AVOID LOOPING IF ERROR ON MODCB ST R7,$RECOVRP MODCB RPL=(R2),OPTCD=(KEQ) * READ BAL R14,MODIFY GET RPL=(R2) CHECK RPL=(R2) SHOWCB RPL=(R2),FIELDS=RECLEN,AREA=$FEEDBAK,LENGTH=4 L R7,$FEEDBAK STH R7,$RECLEN LENGTH ACTUALLY READ LA R1,&RETURN put default back in... ST R1,$VSJUMPX ...to the default return * DONE L R4,$SAVER4 BR R4 SPACE 1 @STARTRS SR R7,R7 TO AVOID LOOPING IF ERROR ON MODCB ST R7,$RECOVRP MODCB RPL=(R2),OPTCD=(KEQ) L R4,$VSJUMPX Jump to specified exit point BR R4 * but we just get next request * to be processed EJECT * --------------------------------------------------------------------- * INSERT A NEW RECORD * CALLED BAL R4,INSERT * * INPUTS: RECORD TO BE WRITTEN MUST BE SET IN $IOAREA, AND THE KEY * MUST BE UNIQUE. * TRASHES REGISTERS R7 AND R14 * * IF RECORD INSERT FAILS EXITS VIA THE VSERROR HANDLER ROUTINE * --------------------------------------------------------------------- INSERT DS 0F ST R4,$SAVER4 BAL R14,MODIFY ENDREQ RPL=(R2) IF PRIOR WAS A READ WE DID NOT RESET IT SR R7,R7 NO RESET ON ERROR NEEDED ST R7,$RECOVRP MODCB RPL=(R2),OPTCD=(NUP) LA R7,@WRITERS ADDRESS TO RESTORE DEFAULT ST R7,$RECOVRP PUT RPL=(R2) CHECK RPL=(R2) ENDREQ RPL=(R2) SR R7,R7 TO AVOID LOOPING ON MODCB ERROR ST R7,$RECOVRP MODCB RPL=(R2),OPTCD=(UPD) LA R1,&RETURN put default back in... ST R1,$VSJUMPX ...to the default return L R4,$SAVER4 BR R4 SPACE 1 @WRITERS DS 0H SR R7,R7 TO AVOID LOOPING ON MODCB ERROR ST R7,$RECOVRP MODCB RPL=(R2),OPTCD=(UPD) L R4,$VSJUMPX Jump to specified exit point BR R4 <--- writers runs on modcb error * but we just get next * request and carry on EJECT * --------------------------------------------------------------------- * UPDATE AN EXISTING RECORD * CALLED BAL R4,UPDATE * A READ EXACT M U S T HAVE BEEN DONE PRIOR... AND DATA IN $IOAREA * AT THIS POINT MUST BE THE REPLACEMENT RECORD WITH A MATCHING KEY. * WILL UPDATE THE LAST RECORD READ !. * * TRASHES REGISTERS R3, R7 AND R14 * * IF RECORD UPDATE FAILS EXITS VIA THE VSERROR HANDLER ROUTINE * --------------------------------------------------------------------- UPDATE DS 0F ST R4,$SAVER4 BAL R14,MODIFY LA R7,@WRITERS ADDRESS TO RESTORE DEFAULT ST R7,$RECOVRP LA R2,IFGRPL SR R3,R3 CLEAR R3 TO LOAD LH R3,$RECLEN LENGTH THAT WAS READ MODCB RPL=(R2),RECLEN=(R3),AREALEN=(R3),AREA=(R10) PUT RPL=(R2) CHECK RPL=(R2) ENDREQ RPL=(R2) LA R1,&RETURN put default back in... ST R1,$VSJUMPX ...to the default return L R4,$SAVER4 BR R4 EJECT * --------------------------------------------------------------------- * DELETE AN EXISTING RECORD * * A READ EXACT M U S T HAVE BEEN DONE PRIOR. * WILL DELETE THE LAST RECORD READ !. * * TRASHES R2, R3, R14 * * IF RECORD DELETE FAILS EXITS VIA THE VSERROR HANDLER ROUTINE * --------------------------------------------------------------------- DELETE DS 0F ST R4,$SAVER4 BAL R14,MODIFY LA R2,IFGRPL SR R3,R3 CLEAR R3 TO LOAD LH R3,$RECLEN LENGTH THAT WAS READ MODCB RPL=(R2),RECLEN=(R3),AREALEN=(R3),AREA=(R10) ERASE RPL=(R2) CHECK RPL=(R2) ENDREQ RPL=(R2) LA R1,&RETURN put default back in... ST R1,$VSJUMPX ...to the default return L R4,$SAVER4 BR R4 EJECT * --------------------------------------------------------------------- * CALLED TO SET ALL THE DEFAULT ACB/RPL VALUES. SHOULD BE * CALLED PRIOR TO EACH VSAM REQUEST. * * CALLED BAL R14,MODIFY * * TRASHES REGISTERS R3,R4,R5; R10 IS SET TO BE SAFE BUT R10 SHOULD * ALWAYS ADDRESS THE $IOAREA FOR THE LIFE OF THE PROGRAM. * R2 SHOULD ALWAYS (AND IS SPECIFICALLY SET BACK TO) ADDRESS THE RPL * --------------------------------------------------------------------- MODIFY DS 0F ST R14,$SAVER14 SAVE RETURN ADDRESS LA R2,IFGRPL ADDRESS GENERATED BY RPL SR R3,R3 CLEAR R3 TO LOAD LA R3,&DBRECL LENGTH OF RECORD SR R4,R4 CLEAR R4 FOR KEY ADDRESS SR R5,R5 CLEAR R5 FOR KEY LENGTH LA R4,$RRN ADDRESS RELATIVE RECORD NUM LH R4,$RKP LOAD KEY OFFSET L R10,=A($IOAREA) THE IO BUFFER AREA AR R4,R10 ADD RECORD ADDRESS LH R5,$KEYLEN LOAD KEY LENGTH MODCB RPL=(R2),RECLEN=(R3),AREALEN=(R3),AREA=(R10), X ARG=(R4),KEYLEN=(R5) XR R1,R1 SET LAST REASON CODE ERROR TO 0 STH R1,$VSREAS IN $VSREAS L R14,$SAVER14 RELOAD RETURN ADDRESS BR R14 $SAVER14 DS 1F SAVE LOCAL RETURN ADDRESS EJECT * --------------------------------------------------------------------- * VSAM RECOVERY PROCESSING * ERROR DURING VSAM PROCESSING. THE EXLST BROUGHT US HERE. * --------------------------------------------------------------------- VSERROR DS 0F STM R5,R6,VSERSAV2 LA R2,IFGRPL SHOWCB RPL=(R2),FIELDS=FDBK,AREA=$FEEDBAK,LENGTH=4 ICM R5,B'1111',$FEEDBAK RETRIEVE $FEEDBAK CODES STCM R5,B'0100',$VSRC+1 AND VSAM RETURN CODE STCM R5,B'0010',$VSFUNC+1 AND VSAM FUNCTION CODE STCM R5,B'0001',$VSREAS+1 AND VSAM REASON CODE ENDREQ RPL=(R2) XR R5,R5 LH R5,$VSREAS Reason= bit CL R5,=F'08' DUPLICATE KEY BE VSERRTX1 CL R5,=F'12' SEQUENCE CHECK BE VSERRTX2 CL R5,=F'16' RECORD NOT FOUND BE VSERRTX3 LH R5,$VSRC RC= bit CVD R5,$NUMBUF UNPK $NUMBUF(3),$NUMBUF+6(2) OI $NUMBUF+2,C'0' MVC $ERRDUMP+8(3),$NUMBUF LH R5,$VSFUNC FC= bit CVD R5,$NUMBUF UNPK $NUMBUF(3),$NUMBUF+6(2) OI $NUMBUF+2,C'0' MVC $ERRDUMP+16(3),$NUMBUF LH R5,$VSREAS Reason= bit CVD R5,$NUMBUF UNPK $NUMBUF(3),$NUMBUF+6(2) OI $NUMBUF+2,C'0' MVC $ERRDUMP+33(3),$NUMBUF MVC VSERRTXW+8(36),$ERRDUMP VSERRTXW WTO '....+....1....+....2....+....3....+.' B VSERROR0 VSERRTX1 WTO 'RECORD EXISTS' B VSERROR0 VSERRTX2 WTO 'SEQUENCE CHECK' B VSERROR0 VSERRTX3 WTO 'NO MATCHING RECORD' * B VSERROR0 VSERROR0 LM R5,R6,VSERSAV2 * **** IF WE WERE DOING A STARTGE OR WRITE THEN THE * RPL WAS MODIFIED AND WE NEED TO SET IT BACK L R7,$RECOVRP RECOVERY ACTION ADDRESS LTR R7,R7 BZ VSERROR1 NO ACTION NEEDED XR R4,R4 CLEAR RECOVERY ADDR TO PREVENT ANY ST R4,$RECOVRP CHANCE OF RECURSION BR R7 AND DO IT VSERROR1 L R4,$VSJUMPX Retrieve specified exit point LA R1,&RETURN put default back in... ST R1,$VSJUMPX ...to the default return BR R4 And jump to last explicitly selected VSERSAV2 DS 2F SPACE 2 * --------------------------------------------------------------------- * EOF ON VSAM FILE, FROM SEQUENTIAL READS, NOT AN ERROR :-) * --------------------------------------------------------------------- VSEOF DS 0F MODCB RPL=(R2),OPTCD=(UPD,KEQ) BACK TO UPDATE KEYED MODE BAL R14,MODIFY SR R15,R15 R15 RC=00, no error L R4,$VSJUMPX Jump to specified exit point BR R4 EJECT * --------------------------------------------------------------------- * THIS ACCESS CONTROL BLOCK IS USED AS A MODEL TO BUILD * VSAM ACB'S DYNAMICALLY. * --------------------------------------------------------------------- ACBMODEL ACB DDNAME=VSAMDD,EXLST=VSEXL001 SPACE 1 * --------------------------------------------------------------------- * THE REQUEST PARAMETER BLOCK HERE IS USED AS A MODEL TO * BUILD REQUESTS DYNAMICALLY AS NEEDED. * --------------------------------------------------------------------- RPLMODEL RPL ACB=ACBMODEL SPACE 1 * --------------------------------------------------------------------- * VSAM EXLST - WHERE TO JUMP ON IO ERROR AND FOR SEQUENTIAL READS * WHERE TO GO ON EOF (OR RECORD NOT FOUND). * --------------------------------------------------------------------- VSEXL001 EXLST LERAD=VSERROR,SYNAD=VSERROR,EODAD=VSEOF SPACE 2 LTORG * --------------------------------------------------------------------- * DATA AREAS USED FOR THE VSAM IO * --------------------------------------------------------------------- $VSJUMPX DS F ADDRESS TO JUMP TO ON ACTIVITY COMPLETION $FEEDBAK DS 0F VSAM IO FEEDBACK CODE $RECOVRP DS 0F RECOVERY RPL ADDRESS FOR VSAM IO HANDLING $RC DS H $VSRC DS H $VSFUNC DS H $VSREAS DS H $DDNAME DC CL8'&DDNAME' DDNAME USED FOR VSAM FILE $RECLEN DS H LENGTH OF RECORD LAST READ $RKP DS H $KEYLEN DS H $RRN EQU $RKP $SAVER4 DS 1F $NUMBUF DC D'0' $ERRDUMP DC CL36'VSAM RC=nnn, FC=nnn, REASON CODE=nnn' SPACE 2 * --------------------------------------------------------------------- * THE ACTUAL ACB AND RPL USED * --------------------------------------------------------------------- IFGACB DSECT=NO $ACBLEN EQU (*-IFGACB) IFGRPL DSECT=NO $RPLLEN EQU (*-IFGRPL) SPACE 2 * --------------------------------------------------------------------- * THE VSAM IO RECORD/DATA AREA, ADDRESSED THROUGOUT USING R10 * --------------------------------------------------------------------- $IOAREA DS CL(1*&DBRECL) RECORD LENGTH DS CL50 NOT NEEDED, BUT IF USER SCREWS RECLEN ! LTORG MEND ./ ADD NAME=EXAMPASM //MARKJ JOB (0),'ASSSEMBLE',MSGLEVEL=1,CLASS=A,MSGCLASS=T //ASMLKED EXEC ASMFCL,MAC='SYS1.MACLIB',MAC2='SYS2.MACLIB', // MAC3='INSTALL.MID.VSAM.MACROS', // PARM.ASM='DECK,LOAD,TERM,TEST,SYSPARM((NOSP,NODEBUG)),XREF(SHORT)', // PARM.LKED='XREF,LIST,LET,TEST,AC=0' //ASM.SYSPUNCH DD SYSOUT=* //ASM.SYSIN DD * * --------------------------------------------------------------------- * EXAMPASM: Program VSAMTEST * * Example program to demonstrate how to use the VSAMCODE macro to * generate all the code needed to manage ONE(1) VSAM dataset for KEY * update access from within an assembler program. * * IMPORTANT TO NOTE that this example assumes the key offset is at * position zero (0) in the test data file as we just copy the * entire data field, from keyvalue, into the buffer for insert * and update tests. You are welcome to make it a lot more complicated * if you want; personally I have never come across a file where the * primary key was not at position zero. The changes would be simple. * * See EXAMPJCL for the JCL deck that runs this program to test all the * code functions. * * SYSIN CARD FUNCTIONS (three byte keyword)(space)(data-value) * INS KEYVALUEDATA - insert a new record * DEL KEYVALUE - delete a record to contain DATA * UPD KEYVALUEDATA - update a record to contain DATA * RDX KEYVALUE - read EXACT a record, and write to * sysprint * RDA KEYVALUE - read APROX (exact or next higher) record * and write to sysprint * LST - sequentially list all records * LOG message-text - log message to sysprint and WTO it * And a couple added to demo the tips in the $DOC member * ITT KEYVALUE - show override of exit label on insert fail * RTT KEYVALUE - show override of exit label on read exact * fail (so covers update and delete) * * --------------------------------------------------------------------- SPACE 3 * The VSAM data desription needs to be defined at the start of * the program (before the vsamcode macro is used), otherwise the * assembler cannot calculate the RECLEN EQU value needed to * create the $IOAREA storage space as that must be assigned a * value by the assembler before it is referenced. SPACE 3 VSAMREC DS CL6 KEY DS CL44 DATA RECLEN EQU *-VSAMREC EQU NAME TO PASS TO VSAMCODE MACRO KEYOFF EQU 0 EQU NAME TO PASS TO VSAMCODE MACRO KEYLEN EQU 6 EQU NAME TO PASS TO VSAMCODE MACRO SPACE 3 VSAMTEST CSECT STM R14,R12,12(R13) SAVE REGISTERS BALR R12,0 LOAD BASE REGISTER USING *,R12 ESTABLISH ADDRESSABILITY ST 13,SAVEAREA+4 STORE CALLER'S S/A @ IN OUR S/A LR 14,13 SAVE CALLER'S S/A @ IN R14 LA 13,SAVEAREA POINT R13 TO OUR SAVE AREA ST 13,8(14) STORE OUR S/A @ IN CALLER'S S/A * BAL R4,VSAMOPEN LTR R15,R15 BZ OPENOK OPEN WAS OK BAL R4,VSAMOPEN ELSE ONE RETRY LTR R15,R15 BZ OPENOK WTO 'UNABLE TO OPEN VSAM FILE' B EXIT08 08 - VSAM IO ERROR OPENOK CNOP 0,4 OPEN (SYSIN,(INPUT)) OPEN (SYSPRINT,(OUTPUT)) READCARD GET SYSIN GET CONTROL CARD CLI 0(R1),C'*' COMMENT ? BE READCARD YES, IGNORE AND GET NEXT CLC 0(3,R1),=CL3'INS' INSERT NEW RECORD BE EXECINS CLC 0(3,R1),=CL3'DEL' DELETE EXISTING RECORD BE EXECDEL CLC 0(3,R1),=CL3'UPD' UPDATE EXISTING RECORD BE EXECUPD CLC 0(3,R1),=CL3'LST' LIST ALL RECORDS SEQUENTIALLY BE EXECLIST CLC 0(3,R1),=CL3'RDX' READ RECORD EXACT BE EXECRDX CLC 0(3,R1),=CL3'RDA' READ RECORD APROX, REQUESTED BE EXECRDA OR NEXT HIGHEST CLC 0(3,R1),=CL3'LOG' LOG SYSIN TEXT TO SYSPRINT BE EXECLOG AND AS A WTO CLC 0(3,R1),=CL3'ITT' INS OVERRIDING DEFAULT RETURN BE EXECINST CLC 0(3,R1),=CL3'RTT' RDX OVERRIDING DEFAULT RETURN BE EXECRDXT MVC WTOBADEX+23(3),0(R1) WTOBADEX WTO 'BAD SYSIN CARD:xxx:IGNORED' B READCARD LOOP UNTIL EOF * * ----- insert ----- EXECINS MVC $IOAREA(RECLEN),4(R1) BAL R4,INSERT B READCARD LOOP UNTIL EOF * ----- delete ----- EXECDEL MVC $IOAREA+KEYOFF(KEYLEN),4(R1) BAL R4,READEXCT BAL R4,DELETE B READCARD LOOP UNTIL EOF * ----- update ----- EXECUPD LR R6,R1 SAVE DATA ADDR AS R1 IS * MODIFIED BY IO (R6 IS NOT * USED BY READEXCT) MVC $IOAREA+KEYOFF(KEYLEN),4(R1) BAL R4,READEXCT MVC $IOAREA(RECLEN),4(R6) REMEMBER R1 WAS TRASHED :-) BAL R4,UPDATE B READCARD LOOP UNTIL EOF * ----- read exact ----- EXECRDX MVC $IOAREA+KEYOFF(KEYLEN),4(R1) BAL R4,READEXCT MVC SYSPRLIN(RECLEN),$IOAREA PUT SYSPRINT,SYSPRLIN B READCARD LOOP UNTIL EOF * ----- read aprox ----- EXECRDA MVC $IOAREA+KEYOFF(KEYLEN),4(R1) BAL R4,READAPRX MVC SYSPRLIN(RECLEN),$IOAREA PUT SYSPRINT,SYSPRLIN B READCARD LOOP UNTIL EOF * ----- list all records ----- EXECLIST MVC $IOAREA+KEYOFF(KEYLEN),SPACES # NULL TO KEY BAL R4,READAPRX MVC SYSPRLIN(RECLEN),$IOAREA PUT SYSPRINT,SYSPRLIN EXECL201 BAL R14,MODIFY GET RPL=(R2) READ NEXT RECORD CHECK RPL=(R2) MVC SYSPRLIN(RECLEN),$IOAREA PUT SYSPRINT,SYSPRLIN B EXECL201 LOOP UNTIL VSAM EOF * NOTE: AT VSAM EOF WE RETURN TO LABEL OF RETURN=READCARD * ----- log for debugging ----- EXECLOG MVC SYSPRLIN+2(40),4(R1) MVC EXECLOGW+10(40),4(R1) and to wto before put changes r1 MVC SYSPRLIN(2),=CL2'> ' PUT SYSPRINT,SYSPRLIN EXECLOGW WTO '> ....+....1....+....2....+....3....+....4' B READCARD LOOP UNTIL EOF * * ----------- * And two routines to show temporarily overriding the * default RETURN address. If you were going to do this * in a real program you would do it in the default * INS/RDX handling that is using the default return above EXECINST MVC $IOAREA(RECLEN),4(R1) VSERRSET RETURN=EXECINSE BAL R4,INSERT B READCARD LOOP UNTIL EOF EXECINSE WTO 'INSERT FAILURE HANDLER TRIGGERED' B READCARD EXECRDXT MVC $IOAREA+KEYOFF(KEYLEN),4(R1) VSERRSET RETURN=EXECRDXE BAL R4,READEXCT B READCARD EXECRDXE WTO 'READ EXACT HANDLER TRIGGERED' B READCARD * ----------- EXIT00 BAL R4,VSAMCLOS CLOSE (SYSIN) CLOSE (SYSPRINT) L 13,SAVEAREA+4 LOAD CALLER'S R13 LM 14,12,12(13) RESTORE THE REGISTERS LA 15,0(0,0) LOAD RETURN CODE = 00 BR 14 EXIT04 BAL R4,VSAMCLOS L 13,SAVEAREA+4 LOAD CALLER'S R13 LM 14,12,12(13) RESTORE THE REGISTERS LA 15,4 LOAD RETURN CODE = 04 BR 14 EXIT08 L 13,SAVEAREA+4 LOAD CALLER'S R13 LM 14,12,12(13) RESTORE THE REGISTERS LA 15,8 LOAD RETURN CODE = 08 BR 14 *** * --------------------------------------------------------------------- * All the VSAM code and data areas is generated with the line below. * --------------------------------------------------------------------- *** VSAMCODE RETURN=READCARD,FATAL=EXIT04,DDNAME=VSAMFILE, X DBKEYL=KEYLEN,DBRECL=RECLEN *** * --------------------------------------------------------------------- *** SAVEAREA DS 18F SPACES DC CL6' ' MUST BE AT LEAST KEYLEN LONG SYSIN DCB DDNAME=SYSIN,MACRF=(GL),DSORG=PS,EODAD=EXIT00 SYSPRINT DCB DDNAME=SYSPRINT,MACRF=(PM),DSORG=PS,RECFM=F, X LRECL=132,BLKSIZE=132 SYSPRLIN DS CL132 YREGS END /* //ASM.SYSTERM DD SYSOUT=* //LKED.SYSLMOD DD DISP=SHR,DSN=MARK.LIB.LOAD(VSAMTEST) //LKED.SYSLIN DD * INCLUDE SYSLMOD(VSAMTEST) ENTRY VSAMTEST NAME VSAMTEST(R) /* ./ ADD NAME=EXAMPJCL //MARKJ JOB (0),'RUN VSAMTEST',CLASS=A,MSGCLASS=T //* =================================================================== //* Exercise the test program to ensure all the I-O requests to be //* handled by the VSAMCODE macro are functioning as expected. //* //* This job will //* (1) create a VSAM keyed cluster to use for testing matching the //* record definition used by the test program //* (2) write one record into the file (initialise the database) //* using the test program //* (3) use the test program to perform lots or random I-O tests, //* you can easily customise the tests by altering the sysin //* cards used //* (4) will repro out what data is left in the cluster so you can //* check the output is as you expect //* (5) will delete the test VSAM cluster created in the first step //* =================================================================== //* //* ------------------------------------------------------------------- //* CREATE AND INITIALISE A DATABASE TO TEST AGAINST //* MVS3.8J NOTE: VSAM FILE M U S T BE CREATED ON THE DASD VOLUME THAT //* CONTAINS THE CATALOG FOR THE FILE PREFIX. //* ------------------------------------------------------------------- //* Create a database to be used for testing //CREATEDB EXEC PGM=IDCAMS,COND=(0,NE) //SYSPRINT DD SYSOUT=* //DD1 DD UNIT=3330,VOL=SER=VSAM01,DISP=SHR //SYSIN DD * DELETE (VSAM.MARK.VVDS.TEST) CLUSTER SCRATCH SET MAXCC = 0 DEFINE CLUSTER - (NAME(VSAM.MARK.VVDS.TEST) - VOLUMES(VSAM01) - RECORDS(100 50)) - DATA - (NAME(VSAM.MARK.VVDS.TEST.DATA) - KEYS(6 0) - RECORDSIZE(50 50) - FREESPACE(20 10) - BUFFERSPACE(2000)) - INDEX - (NAME(VSAM.MARK.VVDS.TEST.INDEX)) /* //* ------------------------------------------------------------------- //* Write one entry to initialise the database. As per the VSAM manual //* only PUT can be used on a non-initialised database (any database //* with a record count (high RBA) of zero, so add a record to //* initialise the database. //* Only after that can we run keyed read/write tests. //* ------------------------------------------------------------------- //INITDB EXEC PGM=VSAMTEST,COND=(0,NE) //STEPLIB DD DISP=SHR,DSN=MARK.LIB.LOAD //SYSPRINT DD SYSOUT=* //VSAMFILE DD DISP=OLD,DSN=VSAM.MARK.VVDS.TEST //SYSIN DD * INS TEST01TEST DATA RECORD 1 /* //* ------------------------------------------------------------------- //* RUN LOTS OF TESTS AGAINST THE TEST DATABASE //* ------------------------------------------------------------------- //TEST0001 EXEC PGM=VSAMTEST,COND=(0,NE) //STEPLIB DD DISP=SHR,DSN=MARK.LIB.LOAD //SYSPRINT DD SYSOUT=* //VSAMFILE DD DISP=OLD,DSN=VSAM.MARK.VVDS.TEST //SYSIN DD * * Test inserts done in order LOG INSERTiNG IN ORDER INS TEST02TEST DATA RECORD 2 INS TEST03TEST DATA RECORD 3 INS TEST04TEST DATA RECORD 4 INS TEST06TEST DATA RECORD 6 INS TEST20TEST DATA RECORD 20 * * Test Out of order inserts LOG INSERTING OUT OF ORDER INS TEST25TEST DATA RECORD 25 INS TEST10TEST DATA RECORD 10 INS TEST08TEST DATA RECORD 8 INS TEST07TEST DATA RECORD 7 INS TEST15TEST DATA RECORD 15 INS TEST09TEST DATA RECORD 9 INS TEST11TEST DATA RECORD 11 * * Do a read then insert a lower entry LOG TRY READ THEN LOWER INSERT RDX TEST20 INS TEST12ADD A SINGLE RECORD 9 * * Read exact test LOG READ EXACT TEST02 RDX TEST02 * * List all entries we now have LOG LISTING ALL ENTRIES LST * * Delete, Update, Add LOG DELETE TEST03 UPDATE TEST04 ADD TEST05 DEL TEST03 UPD TEST04RECORD FOUR UPDATED INS TEST05TEST DATA RECORD 6 * * List ehat we have now LOG LISTING ALL ENTRIES LST * * Test an update of a non-existing record * Expectation: it fails from the read exact request LOG UPDATE NON-EXISTING UPD TEST14RECORD DOES NOT EXIST * * Test that trying to insert a duplicate key fails * as it should do. LOG INSERT DUPLICATE INS TEST01RECORD ALREADY EXISTS * * Read a non-existing record LOG READ EXACT NON-EXISTING RDX TEST14 * * Read APROXIMATE on a record that does not exist, * the expectation is that the next record is * returned. LOG READ APROX NON-EXISTING, EXPECT TEST15 RDA TEST14 * * Read APROXIMATE on a record that does exist, * we expect the requested record to be returned. LOG READ APROX TEST09, EXPECT TEST09 RDA TEST09 * * Insert another new record LOG INSERT 1 RECORD INS TEST31TEST DATA RECORD 31 * * Read a non-existing record, default RETURN changed * Repeat read normally to show default reverted OK LOG READ MISSING, UEXIT AND NORMAL RTT TEST14 RDX TEST14 * * Insert exiting to show default error return changed * then repeat normally to show default retern reverted ITT TEST01I ALREADY EXIST INS TEST01I ALREADY EXIST * * Test that deletes after a list are working correctly * now, depends on correct handling after sequential read * EOF to switch back to keyed update mode. LOG LST AND DELETES IN SEQUENCE LST DEL TEST01 DEL TEST02 DEL TEST04 DEL TEST05 DEL TEST06 DEL TEST09 * * And test deletes out of sequence LOG DELETES OUT OF SEQUENCE DEL TEST20 DEL TEST10 DEL TEST15 DEL TEST07 * * Insert a deleted record key again LOG RE-INSERT A DELETED KEY INS TEST02RECORD 2 RE-INSERTED AGAIN * * List all to compare against the repro * * All tested LOG TEST ENDED /* //* ------------------------------------------------------------------- //* REPRO OUT WHATS LEFT IN THE FILE TO COMPARE THE LAST LISTING ABOVE //* ------------------------------------------------------------------- //DUMPKSDS EXEC PGM=IDCAMS,COND=(0,NE) //SYSPRINT DD SYSOUT=* //VSAMFILE DD DISP=OLD,DSN=VSAM.MARK.VVDS.TEST //PRTFILE DD SYSOUT=* //SYSIN DD * REPRO INFILE(VSAMFILE) OUTFILE(PRTFILE) /* //* ------------------------------------------------------------------- //* AND WHEN ALL DONE, DELETE THE TEST DATABASE //* ------------------------------------------------------------------- //DELETEDB EXEC PGM=IDCAMS,COND=(0,NE) //SYSPRINT DD SYSOUT=* //DD1 DD UNIT=3330,VOL=SER=VSAM01,DISP=SHR //SYSIN DD * DELETE (VSAM.MARK.VVDS.TEST) CLUSTER SCRATCH /* // ./ ADD NAME=$DOC Member Type Purpose -------- ------- ----------------------------------------------------- VSERRSET Macro temporarily change default return label for I-O errors from the default to a user label to allow customised handling for things like record not found and duplicate key conditions. VSAMCODE Macro This generates all the code and data areas needed to perform all the key access I-O required to manage a VSAM keyed dataset. EXAMPASM ASM Example program using the VSAMCODE macro to do lots of varied updates to a test vsam file. EXAMPJCL JCL JCL to create a test keyed VSAM file, run the test program against it to perform varied and easily customisable update tests against the file to verify operation of the VSAMCODE macro. Macro usage is documented in the macro(s). You should refer to the example program to see how extremely easily it can be implemented. The exampjcl SYSIN card format to control/customise all the tests is self-explainatory, you should have no trouble following it. And it may be a usefull batch update/maintenance skeleton for and VSAM files you already use (after changing the database record definition of course. TIPS on use =========== By default all I-O errors jump (after cleanup/recovery) to the label passed in the VSAMCODE RETURN= macro value. To manage errors in a more controlled way you may temporarily change the location jumped to for a request using the "VSSETERR RETURN=label" macro. This is temporary and is used only on the next request to be performed, then it is set back to the default. You would use this if you wanted to perform custom error handling after a read exact failure (missing record, would cause update and delete requests to fail) or an insert failure (duplicate record) rather than just ignoring the error. The example test program has examples of using VSSETERR to do that, so as always refer to the example program. ./ ENDUP ZZ //