MACRO 00010000 &LABEL VSAMIO &DDNM,&FUNC=READ,&AREA=,&IOREG=,&KEY=,&LENGTH=, X00020000 &INTENT=,&EOFNRF=,&ERROR=,&ECBLIST=,&DBUF=,&IBUF=, X00021001 &KEYLEN=,&FTYPE=KSDS 00021101 .********************************************************************* 00022000 .* YES, YES, LADIES AND GENTLEMEN, THIS IS THE MACRO YOU'VE ALL * 00023000 .* BEEN WAITING FOR! IT'S A FLOOR WAX, A DESSERT TOPPING, IT CAN * 00024000 .* EVEN BE USED TO PAPER TRAIN YOUR DOG! DONT WAIT, HURRY NOW! * 00024100 .* LIMITED TIME OFFER WHILE SUPPLIES LAST! * 00024200 .********************************************************************* 00024300 .* 00024400 GBLB &VSIOEX BINARY SWITCH INDICATES FIRST 00024500 GBLB &TEST BINARY SWITCH INDICATES FIRST 00024600 GBLA &RTN ROUTINE LABEL COUNTER 00024700 .* MACRO EXECUTION 00024800 .* 00024900 LCLC &VSFUNC FUNCTION BYTE 00025000 LCLC &VSFFLG FUNCTION FLAG 00026000 LCLA &VSFIORP IOREG SUBSTRING POINTER 00027000 LCLA &TSTA IOREG SUBSTRING POINTER 00028000 .* 00029000 AIF ('&FUNC' EQ 'PLIST').PGEN 00030000 AIF ('&FUNC' EQ 'CLOSEALL').VSFCK01 00040000 .********************************************************************* 00050000 .* VALIDATE DDNAME PARAMETER * 00060000 .********************************************************************* 00070000 AIF (T'&DDNM EQ 'O').VSNODD 00080000 AIF ('&DDNM'(1,1) NE '''').VSCKDDL 00090000 AIF ('&DDNM'(1,1) EQ '''' AND '&DDNM'(K'&DDNM,1) EQ '''' X00100000 AND K'&DDNM GT 10).VSINVDD 00110000 AGO .DDNMOK 00120000 .VSCKDDL ANOP , 00130000 AIF (K'&DDNM EQ 0 OR K'&DDNM GT 8).VSINVDD 00140000 .DDNMOK ANOP , 00141000 .* 00142000 .********************************************************************* 00143000 .* SETUP FUNCTION AND FLAG LABEL * 00144000 .********************************************************************* 00145000 &VSFUNC SETC 'VS$#OPEN' 00146000 &VSFFLG SETC '0' 00147000 AIF ('&FUNC' NE 'OPEN').VSFCK01 00148000 &VSFFLG SETC 'VS$#OUPD' 00149000 AIF ('&INTENT' EQ 'UPDATE').VSGOTOP 00150000 &VSFFLG SETC 'VS$#OLOD' 00160000 AIF ('&INTENT' EQ 'LOAD').VSGOTOP 00170000 &VSFFLG SETC 'VS$#ORSU' 00180000 AIF ('&INTENT' EQ 'RESUPD').VSGOTOP 00190000 &VSFFLG SETC 'VS$#ORDO' 00200000 AIF ('&INTENT' EQ 'READ').VSGOTOP 00210000 AIF (K'&INTENT GT 0).VSITERR 00220000 MNOTE 1,'ACCESS INTENT OMMITTED. READ ONLY ASSUMED.' 00230000 AGO .VSGOTOP 00240000 .VSFCK01 ANOP , 00250000 &VSFUNC SETC 'VS$#CLOS' 00260000 AIF ('&FUNC'(1,5) NE 'CLOSE').VSFCK02 00270000 &VSFFLG SETC 'VS$#CLSA' 00280000 AIF ('&FUNC' EQ 'CLOSEALL').VSGOTOP 00290000 &VSFFLG SETC '0' 00300000 AGO .VSGOTOP 00310000 .VSFCK02 ANOP , 00320000 &VSFUNC SETC 'VS$#READ' 00330000 AIF ('&FUNC' EQ 'READ').VSGOTOP 00340000 AIF (T'&FUNC EQ 'O').VSGOTOP 00350000 AIF ('&FUNC' NE 'READU').VSFCK03 00360000 &VSFFLG SETC 'VS$#RUPD' 00370000 AGO .VSGOTOP 00380000 .VSFCK03 ANOP , 00390000 &VSFFLG SETC '0' 00400000 &VSFUNC SETC 'VS$#WRIT' 00410000 AIF ('&FUNC' EQ 'WRITE').VSGOTOP 00420000 &VSFUNC SETC 'VS$#DELT' 00430000 AIF ('&FUNC' EQ 'DELETE').VSGOTOP 00440000 &VSFUNC SETC 'VS$#PONT' 00450000 AIF ('&FUNC' EQ 'POINT' AND T'&KEY EQ 'O').VSNOKEY 00460000 AIF ('&FUNC' EQ 'POINT').VSGOTOP 00470000 &VSFUNC SETC 'VS$#ENRQ' 00480000 AIF ('&FUNC' NE 'ENDREQ').VSFERR 00490000 .********************************************************************* 00500000 .* AT THIS POINT THE OPERATION AND FLAG HAVE BEEN SET. * 00510000 .* NOW VERIFY PARAMETERS ARE CORRECT * 00520000 .********************************************************************* 00530000 .VSGOTOP ANOP , 00540000 AIF (T'&AREA EQ 'O' AND T'&IOREG EQ 'O' AND ('&FUNC' EQ X00550000 'READ' OR '&FUNC' EQ 'READU' X00560000 OR '&FUNC' EQ 'WRITE')).VSARERR 00570000 .* 00580000 .* BEGIN GENERATING CODE 00590000 AIF (T'&LABEL EQ 'O').VSGEN01 00600000 &LABEL DS 0H 00601000 * 00602000 .VSGEN01 ANOP , 00603000 AIF (T'&ECBLIST EQ 'O').VSKPST 00604000 L R1,&ECBLIST 00605000 ST R1,VS$#@LST 00606000 USING VS$#@IOD,R1 RMW 00607000 AGO .VSGEN02 00608000 .VSKPST ANOP , 00609000 USING VS$#@IOD,R1 00610000 ICM R1,15,VS$#@LST CHECK PARAMETER LIST ADDRESS 00611000 BNZ VS$#@&RTN BYPASS GETMAIN IF PRESENT 00612000 * 00612100 GETMAIN R,LV=VS$#@LEN,SP=0 00612200 * 00612300 ST R1,VS$#@LST SAVE PARM LIST ADDR 00612400 XC 0(VS$#@LEN,R1),0(R1) 00612500 * 00612600 .VSGEN02 ANOP , 00612700 VS$#@&RTN DS 0H 00612800 &RTN SETA &RTN+1 00612900 * 00613000 XC VS$#@OPT,VS$#@OPT CLEAR OPTION BYTES 00613100 XC VS$#@FIL,VS$#@FIL CLEAR DDNAME 00613200 XC VS$#@ARE,VS$#@ARE CLEAR RECORD ADDRESS 00613300 XC VS$#@KEY,VS$#@KEY CLEAR KEY 00613400 AIF ('&KEYLEN' EQ 'PRESET').VSKNCLR 00619301 XC VS$#@KYL,VS$#@KYL CLEAR KEY LENGTH 00613500 .VSKNCLR ANOP , XC VS$#@RLN,VS$#@RLN CLEAR RECORD LENGTH 00613600 XC VS$#@RCD,VS$#@RCD CLEAR RETURN CODE 00613700 * 00613800 MVI VS$#@FNC,&VSFUNC+&VSFFLG SET OPERATION 00613900 AIF ('&FUNC' EQ 'CLOSEALL').VSKPDD RMW 00614000 AIF (T'&DDNM EQ 'O').VSKPDD 00614100 AIF ('&DDNM'(1,1) EQ '''').VSLIT 00614200 MVC VS$#@FIL,&DDNM SET DDNAME 00614300 AGO .VSKPDD 00614400 .VSLIT ANOP , 00614500 AIF ('&DDNM'(K'&DDNM,1) NE '''').VSQTERR 00614600 MVC VS$#@FIL,=CL8&DDNM 00614700 .* 00614800 .VSKPDD ANOP , 00614900 AIF ('&FUNC' NE 'OPEN').VSNOBUF 00615000 AIF ('&FTYPE' NE 'ESDS').VSCKKSD MVC VS$#@FTY,=CL4'&FTYPE' AGO .VSCKBUF .VSCKKSD ANOP , AIF ('&FTYPE' NE 'KSDS').VSCKRSD MVC VS$#@FTY,=CL4'&FTYPE' AGO .VSCKBUF .VSCKRSD ANOP , AIF ('&FTYPE' NE 'RRDS').VSFTYER MVC VS$#@FTY,=CL4'&FTYPE' AGO .VSCKBUF .VSFTYER ANOP , MVC VS$#@FTY,=CL4'KSDS' MNOTE 4,'FILE TYPE NOT ESDS, KSDS, OR RRDS. KSDS ASSUMED.' .VSCKBUF ANOP , AIF (T'&DBUF EQ 'O').VSIBUF 00615100 MVC VS$#@DBF,=H'&DBUF' 00615200 .VSIBUF ANOP , 00615300 AIF (T'&IBUF EQ 'O').VSNOBUF 00615400 MVC VS$#@IBF,=H'&IBUF' 00615500 .VSNOBUF ANOP , 00615600 AIF (('&FUNC' EQ 'OPEN' AND '&INTENT' NE 'RESUPD') OR X00615700 '&FUNC' EQ 'CLOSE').VSFCALL 00615800 .* 00615900 AIF ('&FUNC' EQ 'ENDREQ').VSNOLEN 00616000 AIF ('&FUNC' EQ 'POINT').VSNOAR 00616100 AIF ('&FUNC' EQ 'OPEN' AND '&INTENT' EQ 'RESUPD').VSNOAR 00616200 .* 00616300 AIF (T'&AREA EQ 'O').VSNOAR 00616400 AIF ('&AREA'(1,1) NE '(').VSLODA 00616500 ST &AREA(1),VS$#@ARE STORE AREA ADDRESS 00616600 AGO .VSNOAR 00616700 .VSLODA ANOP , 00616800 * 00616900 LA R15,&AREA GET AREA ADDRESS 00617000 ST R15,VS$#@ARE STORE IN PARM LIST 00617100 * 00617200 .VSNOAR ANOP , 00617300 AIF ('&FUNC' EQ 'OPEN' AND '&INTENT' EQ 'RESUPD').VSCKOL 00617400 AGO .VSNOMNO 00617500 .VSCKOL ANOP , 00617600 AIF (T'&LENGTH NE 'O').VSNOMNO 00617700 MNOTE 1,'LENGTH OMMITTED FOR DUMMY RECORD ON RESET/UPDATE' 00617800 MNOTE 1,'DUMMY OF MAXRECL WILL BE CREATED' 00617900 .VSNOMNO ANOP , 00618000 AIF (T'&LENGTH EQ 'O').VSNOLEN 00618100 AIF ('&LENGTH'(1,1) NE '(').VSMOVL 00618200 STH &LENGTH(1),VS$#@RLN STORE RECORD LENGTH 00618300 AGO .VSNOLEN 00618400 .VSMOVL ANOP , 00618500 MVC VS$#@RLN,&LENGTH MOVE LENGTH FIELD IN 00618600 * 00618700 .VSNOLEN ANOP , 00618800 AIF (T'&KEY EQ 'O').VSFCALL 00618900 LA R15,&KEY LOAD THE ADDRESS 00619000 ST R15,VS$#@KEY AND STORE 00619100 AIF (T'&KEYLEN EQ 'O').VSNOKL 00619201 AIF ('&KEYLEN' EQ 'PRESET').VSFCALL 00619301 MVI VS$#@KYL,&KEYLEN 00619401 AGO .VSFCALL 00619501 .VSNOKL ANOP , 00619601 MVI VS$#@KYL,L'&KEY GET KEY LENGTH 00619700 .* 00619800 .VSFCALL ANOP , 00619900 AIF (&VSIOEX).VSSKPL 00620000 B VS$#@LST+L'VS$#@LST BRANCH AROUND LIST ADDR 00620100 VS$#@LST DC A(0) 00620200 .VSSKPL ANOP , 00620300 CLI VS$#@IND,VS$#@ACT TASK ACTIVE? 00620400 BE VS$#@&RTN YES--> DO NOT ATTACH 00620500 * 00621000 AIF ('&FUNC' EQ 'OPEN').VSDOATT 00621100 MVC VS$#@RCD,=3X'FF' SET ERROR 00621200 &TSTA SETA &RTN+2 00621300 B VS$#@&TSTA 00621400 AGO .VSNOATT 00621500 .VSDOATT ANOP , 00621600 XC VS$#@E01,VS$#@E01 CLEAR ECB'S 00621700 XC VS$#@E02,VS$#@E02 00621800 ATTACH EP=VSIOMOD,PARAM=VS$#@LST,SZERO=YES,SHSPV=0 00621900 * 00622000 LR R15,R1 PUT TCB ADDR IN R15 00622100 L R1,VS$#@LST 00622200 ST R15,VS$#@TCB SAVE THE TCB ADDRESS 00622300 CHAP 1,VS$#@TCB BUMP THE PRIORITY UP 00622400 L R1,VS$#@LST 00622500 * 00622600 &TSTA SETA &RTN+1 00622700 B VS$#@&TSTA DONT POST, JUST WAIT 00622800 .VSNOATT ANOP , 00622900 VS$#@&RTN DS 0H 00623000 &RTN SETA &RTN+1 00623100 * 00623200 L R1,VS$#@LST RESTORE LIST 00623300 LA R1,VS$#@E01 GET ADDR OF ECB VSIOMOD WAITING ON 00623400 POST (1) POST IT 00623500 * 00623600 VS$#@&RTN DS 0H 00623700 &RTN SETA &RTN+1 00623800 L R1,VS$#@LST GET PLIST ADDR 00623900 TM VS$#@E02,X'40' POSTED? 00624000 BO VS$#@&RTN 00624100 LA R1,VS$#@E02 ADDR OF ECB WERE GOING TO WAIT ON 00624200 WAIT ECB=(1) AND WAIT FOR COMPLETION 00624300 VS$#@&RTN DS 0H 00624400 &RTN SETA &RTN+1 00624500 * 00624600 L R1,VS$#@LST RESTORE LIST ADDR 00624700 XC VS$#@E02,VS$#@E02 CLEAR THE ECB 00624800 AIF ('&FUNC'(1,5) NE 'CLOSE').VSCKEF 00624900 CLI VS$#@IND,VS$#@ACT TASK STILL ACTIVE? 00625000 &TSTA SETA &RTN+1 00625100 BE VS$#@&TSTA YES--> DO NOT DETACH 00625200 CLC VS$#@TCB,=F'0' ATTACHED? 00625300 BNE VS$#@&RTN YES--> DETACH 00625400 MVC VS$#@RCD,=3X'FF' NO--> MAJOR ERROR 00625500 B VS$#@&TSTA GO TO ERROR PROCESS 00625600 * 00625700 VS$#@&RTN DS 0H 00625800 &RTN SETA &RTN+1 00625900 CHAP -1,VS$#@TCB BUMP THE PRIORITY DOWN 00626000 L R1,VS$#@LST RESTORE LIST ADDR 00626100 DETACH VS$#@TCB KILL IT 00626200 * 00626300 L R1,VS$#@LST RESTORE LIST ADDR 00626400 XC VS$#@TCB,VS$#@TCB CLEAR TCB ADDRESS 00626500 VS$#@&RTN DS 0H 00626600 &RTN SETA &RTN+1 00626700 .VSCKEF ANOP , 00626800 AIF (T'&EOFNRF EQ 'O').VSANOP1 00626900 AIF ('&FUNC'(1,5) EQ 'CLOSE' OR '&FUNC' EQ 'OPEN').VSANOP1 00627000 CLC VS$#@RCD,=X'040004' EOF/NRF? 00627100 BE &EOFNRF RETURNS HERE ON NO RECORD FOUND 00627200 .VSANOP1 ANOP , 00627300 AIF (T'&ERROR EQ 'O').VSANOP2 00627400 AIF ('&FUNC' NE 'OPEN').VSRC0 00627500 CLI VS$#@RCD,4 WAS R15 HIGHER THAN 4(CRITICAL ERR) 00627600 BH &ERROR 00627700 AGO .VSANOP2 00627800 .VSRC0 ANOP , 00627900 L R1,VS$#@LST RESTORE LIST ADDR RMW 00628000 CLI VS$#@RCD,0 WAS R15 NON-ZERO? 00628100 BNE &ERROR 00628200 .VSANOP2 ANOP , 00628300 AIF ('&FUNC'(1,4) NE 'READ').VSNORG 00628400 AIF (T'&IOREG EQ 'O').VSNORG 00628500 L &IOREG(1),VS$#@ARE GET RECORD ADDRESS 00628600 .VSNORG ANOP , 00628700 .* 00628800 AIF (&VSIOEX).VS001 PARMS ALREADY GENNED 00628900 .PGEN ANOP , 00629000 VS$#@IOD DSECT , 00629100 * 00629200 VS$#@E01 DS F POSTED BY US, WAITED ON BY VSIOMOD 00629300 VS$#@E02 DS F POSTED BY VSIOMOD, WAITED ON BY US 00629400 VS$#@IND DS XL1 ATTACH INDICATOR 00629500 VS$#@ACT EQU X'FF' TASK IS ATTACHED AND ACTIVE 00629600 DS XL3 ALIGN IT 00629700 VS$#@OPT DS 0H OPTION BYTES 00629800 * 00629900 VS$#@FNC DS XL1 FUNCTION TYPE 00630000 VS$#OPEN EQU X'01' OPEN FILE 00630100 VS$#OUPD EQU X'10' UPDATE INTENDED 00630200 VS$#OLOD EQU X'20' RESET FILE FOR LOAD 00630300 VS$#ORDO EQU X'40' READ ONLY 00630400 VS$#ORSU EQU X'80' RESET FILE W/DUMMY-OPEN UPDATE 00630500 .* 00630600 VS$#CLOS EQU X'02' CLOSE FILE 00630700 VS$#CLSA EQU X'10' CLOSE ALL FILES 00630800 .* 00630900 VS$#READ EQU X'03' READ FILE (NON-UPDATE) 00631000 VS$#RUPD EQU X'10' UPDATE INTENDED 00631100 .* 00631200 VS$#WRIT EQU X'04' WRITE RECORD (INSERT/UPDATE) 00631300 VS$#DELT EQU X'05' DELETE RECORD 00631400 VS$#PONT EQU X'06' POINT TO SPECIFIED KEY 00631500 VS$#ENRQ EQU X'07' ENDREQ FILE 00631600 DS XL1 EXPANSION BYTE 00631700 * 00631800 VS$#@RLN DS H RECORD LENGTH 00631900 * 00632000 VS$#@FIL DS CL8 FILE DDNAME 00632100 VS$#@ARE DS AL4 RECORD ADDRESS 00632200 ORG VS$#@ARE ORG BACK 00632300 VS$#@DBF DS XL2 NUMBER OF DATA BUFFERS 00632400 VS$#@IBF DS XL2 NUMBER OF INDEX BUFFERS 00632500 ORG , 00632600 VS$#@KEY DS AL4 ADDRESS OF KEY FIELD 00632700 ORG VS$#@KEY ORG BACK 00632300 VS$#@FTY DS CL4 FILE TYPE, ONLY USED ON OPEN ORG , VS$#@KYL DS XL1 LENGTH OF KEY 00632800 VS$#@RCD DS XL3 ERROR RETURN CODE - FORMAT: 00632900 * X'RRCCCC' WHERE 'RR' IS THE 00633000 * CONTENTS OF REGISTER 15 AND 00633100 * 'CCCC' IS THE VSAM RETURN CODE 00633200 VS$#@TCB DS AL4 ADDRESS OF VSIOMOD TCB 00633300 VS$#@LEN EQU *-VS$#@IOD LENGTH OF PARM LIST 00633400 * 00633500 &SYSECT CSECT , 00633600 * 00633700 .VS001 ANOP , 00633800 &VSIOEX SETB 1 00633900 AIF ('&FUNC' EQ 'PLIST').VSEXIT 00634000 DROP R1 00634100 .VSEXIT ANOP , 00634200 MEXIT 00634300 .VSQTERR ANOP , 00634400 MNOTE 8,'INVALID QUOTES ON DDNAME' 00634500 AGO .VSERRMS 00634600 .VSNODD ANOP , 00634700 MNOTE 8,'DDNAME OMMITTED' 00634800 AGO .VSERRMS 00634900 .VSINVDD ANOP , 00635000 MNOTE 8,'DDNAME INVALID' 00636000 AGO .VSERRMS 00637000 .VSITERR ANOP , 00637100 MNOTE 8,'OPEN INTENT SUPPLIED IS INVALID' 00637200 AGO .VSERRMS 00637300 .VSARERR ANOP , 00637400 MNOTE 8,'AREA OR IOREG PARAMETER REQUIRED' 00637500 AGO .VSERRMS 00637600 .VSIOERRT ANOP , 00637700 .VSFERR ANOP , 00637800 .VSNOKEY ANOP , 00637900 MNOTE 8,'KEY OMMITTED FOR POINT REQUEST' 00638000 AGO .VSERRMS 00639000 .VSERRMS ANOP , 00640000 MNOTE 8,'MACRO GENERATION TERMINATED DUE TO ERRORS.' 00650000 MEND 00660000