PRINT GEN TITLE 'ALC$GET - PERFORM I/O FUNCTIONS AGAINST ANY FILE' *---------------------------------------------------------------------* * REMARKS: THIS PROGRAM WILL PERFORM I/O FUNCTIONS AGAINST ANY FORMAT * OF FILE (EXCLUDING VSAM) *---------------------------------------------------------------------* * REGISTER USAGE * R08 = ADDRESSIBILITY TO DCB=IFILE * R09 = ADDRESSIBILITY TO INPUT PARMS * R10 = ADDRESSIBILITY TO INPUT RECORD PROCESSING AREA * R11 = BASE REGISTER * R12 = BASE REGISTER R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 R00 EQU 0 R01 EQU 1 R02 EQU 2 R03 EQU 3 R04 EQU 4 R05 EQU 5 R06 EQU 6 R07 EQU 7 R08 EQU 8 R09 EQU 9 ALC$GET CSECT USING *,R11,R12 R11,R12=BASE REGISTERS STM R14,R12,12(R13) SAVE REGISTERS LR R11,R15 ADDRESSIBILITY LA R12,2048(0,R11) LA R12,2048(0,R12) LR R1,R13 SAVE SAVE AREA POINTER LA R13,SAVEAREA POINT TO MY SAVEAREA ST R13,8(0,R1) SET FORW CHAIN IN CALLERS SAREA ST R1,4(0,R13) SET BACK CHAIN IN MY SAVEAREA L R1,24(0,R1) REACQUIRE R1 AS IT CAME HERE LM R9,R10,0(R1) R09=ADDRESS OF PARMS * R10=ADDR FOR INPUT RECORD SLL R9,1 DROP OFF HI-ORDER BIT SRL R9,1 AND RETURN USING $$DCBPRM,R9 LA R8,IFILE POINT TO DCB=FILE AND USING IHADCB,R8 ESTABLISH ADDRESSIBILITY B $$DCBBEG DS 0F DC C'*' PGMID DC CL8'ALC$GET ' DC C'*' COMPDATE DC CL8'&SYSDATE' COMPTIME DC CL8'&SYSTIME' SAVEAREA DC 18F'0' $$DCBEND EQU * L R13,4(0,R13) POINT BACK TO CALLERS SAVEAREA LM R14,R12,12(R13) RESTORE REGISTERS XR R15,R15 CLEAR RETURN CODE BR R14 GOBACK TO MOMMA EJECT $$DCBBEG EQU * MVI $$DCBRC,C' ' CLEAR RETURN CODE CLI $$DCBOPT,C'O' OPEN FILES? BE $OPEN YES--> OPEN THEM PUPPIES CLI $$DCBOPT,C'C' CLOSE FILES? BE $CLOSE YES--> CLOSE THEM PUPPIES CLI $$DCBOPT,C'G' GET A RECORD? BE $GET YES--> GET THEM PUPPIES MVI $$DCBRC,X'FF' SET RETURN CODE B $$DCBEND EJECT *--------------------------------------------------------------------* * $GET = GET A RECORD FROM THE DATASET * *--------------------------------------------------------------------* $GET EQU * GET IFILE * R1=IS WHERE THE RECORD IS XR R3,R3 CLEAR WORK AREA LH R3,DCBLRECL GET LENGTH CVD R3,DBLEWORD CONVERT TO DECIMAL UNPK $$DCBLRE,DBLEWORD UNPACK IT OI $$DCBLRE+4,X'F0' FORCE CORRECT SIGN LH R3,DCBBLKSI GET BLOCK SIZE CVD R3,DBLEWORD CONVERT TO DECIMAL UNPK $$DCBBLK,DBLEWORD UNPACK IT OI $$DCBBLK+4,X'F0' FORCE CORRECT SIGN * * SETUP MVCL XR R3,R3 CLEAR WORK AREA LR R2,R10 R2=ADDR OF RECEIVING FIELD LH R3,DCBLRECL R3=LENGTH OF RECEIVING FIELD LR R4,R1 R4=ADDR OF SENDING FIELD LR R5,R3 R5=LENGTH OF SENDING FIELD MVCL R2,R4 MOVE DATA TO USER AREA B $GETEXIT $GET9999 EQU * MVI $$DCBRC,C'E' SIGNAL END-OF-FILE $GETEXIT EQU * B $$DCBEND GO BACK TO MOMMA EJECT *--------------------------------------------------------------------* * $CLOSE = CLOSE DATASET * *--------------------------------------------------------------------* $CLOSE EQU * B $CLOSE99 THIS WILL BE CHANGED TO NOP * AFTER FILE IS OPENED CLOSE (IFILE,),MODE=31 MVI $OPEN+1,X'00' FORCE NO-OP CONDITION MVI $CLOSE+1,X'F0' FORCE UNCONDITIONAL BRANCH $CLOSE99 EQU * B $$DCBEND GO BACK TO MOMMA *--------------------------------------------------------------------* * $OPEN = OPEN DATASET * *--------------------------------------------------------------------* $OPEN EQU * NOP $OPEN999 THIS WILL BE CHANGED TO AN * UNCONDITIONAL BRANCH MVC DCBDDNAM,$$DCBDD MOVE IN THE CORRECT DDNAME $OPEN000 EQU * OPEN (IFILE,INPUT),MODE=31 MVI $OPEN+1,X'F0' FORCE UNCONDITIONAL BRANCH MVI $CLOSE+1,X'00' FORCE NO-OP CONDITION MVC $$DCBRFM,=C'? ' CLEAR RECORD FORMAT LA R4,$$DCBRFM POINT TO RECORD FORMAT INDIC TM DCBRECFM,B'11000000' UNFORMATED RECORD? BNO *+4+4+4 NO--> CHECK SOMETHING ELSE MVI $$DCBRFM,C'U' SET AS UNFORMATTED B $OPEN100 CHECK RECORD LENGTH TM DCBRECFM,B'10000000' FIXED LENGTH RECORDS? BNO *+4+4+4+4 NO--> CHECK SOMETHING ELSE MVI 0(R4),C'F' SET AS FIXED LENGTH LA R4,1(R4) POINT TO NEXT OCCURRENCE B $OPEN010 CHECK IF BLOCKED TM DCBRECFM,B'01000000' VARIABLE LENGTH RECORDS? BNO *+4+4+4 NO--> CHECK SOMETHING ELSE MVI 0(R4),C'V' SET AS FIXED LENGTH LA R4,1(R4) POINT TO NEXT OCCURRENCE $OPEN010 EQU * TM DCBRECFM,B'00010000' BLOCKED RECORDS? BNO *+4+4+4 NO--> CHECK SOMETHING ELSE MVI 0(R4),C'B' SET AS FIXED LENGTH LA R4,1(R4) POINT TO NEXT OCCURRENCE TM DCBRECFM,B'01000000' VARIABLE RECORDS? BNO $OPEN020 NO--> CHECK SOMETHING ELSE TM DCBRECFM,B'00001000' SPANNED RECORDS? BNO $OPEN020 NO--> CHECK SOMETHING ELSE MVI 0(R4),C'S' SET AS SPANNED LA R4,1(R4) POINT TO NEXT OCCURRENCE $OPEN020 EQU * TM DCBRECFM,B'00000100' RECFM=FA,FBA,VA,VBA? BNO *+4+4+4 NO--> CHECK SOMETHING ELSE MVI 0(R4),C'A' SET AS FIXED LENGTH LA R4,1(R4) POINT TO NEXT OCCURRENCE TM DCBRECFM,B'00000010' RECFM=FM,FBM,VM,VBM? BNO $OPEN100 NO--> GET RECORD LENGTH MVI 0(R4),C'M' SET AS FIXED LENGTH LA R4,1(R4) POINT TO NEXT OCCURRENCE $OPEN100 EQU * XR R4,R4 CLEAR WORK REGISTER LH R4,DCBLRECL GET RECORD LENGTH CVD R4,DBLEWORD CONVERT TO DECIMAL UNPK $$DCBLRE,DBLEWORD OI $$DCBLRE+4,X'F0' FORCE CORRECT SIGN XR R4,R4 CLEAR WORK REGISTER LH R4,DCBBLKSI GET MAX BLOCK SIZE CVD R4,DBLEWORD CONVERT TO DECIMAL UNPK $$DCBBLK,DBLEWORD OI $$DCBBLK+4,X'F0' FORCE CORRECT SIGN $OPEN999 EQU * B $$DCBEND LTORG EJECT DS 0D DBLEWORD DS D EJECT IFILE DCB DSORG=PS,MACRF=GL,DDNAME=IFILE,EODAD=$GET9999, X DCBE=ABV01 ABV01 DCBE RMODE31=BUFF EJECT DCBD DSORG=PS,DEVD=DA EJECT $$DCBPRM DSECT $$DCBOPT DS CL1 OPTION * 'O' = OPEN * 'C' = CLOSE * 'G' = READ $$DCBRC DS CL1 RETURN CODE DS CL8 ** UNUSED BY THIS PROGRAM ** $$DCBLN1 DS H LENGTH OF DD NAME $$DCBLN3 DS H LENGTH OF INPUT DATASET NAME $$DCBLN4 DS H LENGTH OF FOUND DATASET NAME DS CL11 ** UNUSED BY THIS PROGRAM ** $$DCBDD DS CL8 DD NAME $$DCBDSN DS CL44 DATASET NAME $$DCBDSF DS CL44 DATASET NAME FOUND ON INQUIRES DS CL3 ** UNUSED BY THIS PROGRAM ** $$DCBRFM DS CL3 RECFM OF THIS FILE DS CL5 ** UNUSED BY THIS PROGRAM ** $$DCBLRE DS CL5 LENGTH OF DATA DS CL5 ** UNUSED BY THIS PROGRAM ** $$DCBBLK DS CL5 BLOCKSIZE OF DATA DS CL52 ** UNUSED BY THIS PROGRAM ** $$DCBML DS XL2 LENGTH OF MEMBER NAME TO ALLOC $$DCBMEM DS CL8 MEMBER NAME $$DCB$$L EQU *-$$DCBPRM END ALC$GET