PRINT GEN TITLE 'ALC$PDSL - PARTITIONED DATASET (PDS) PROCESSING' * REMARKS: THIS PROGRAM WILL READ A PDS. * * REGISTER USAGE * R10 = INTERNAL BRANCH REGISTER * 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 EJECT ALC$PDSL 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 L R10,0(R1) R10=ADDRESS OF PARMS USING PDSPARMS,R10 B PDSGET00 DC C'*' PGMID DC CL8'ALC$PDSL' DC C'*' COMPDATE DC CL8'&SYSDATE' COMPTIME DC CL8'&SYSTIME' DC C'*' DS 0F SAVEAREA DC 18F'0' PDSGET00 EQU * XC PDS$RC,PDS$RC CLEAR RETURN CODE CLC PDS$FUNC,=C'O ' OPEN FILES? BE $OPEN YES, THEN OPEN THEM PUPPIES CLC PDS$FUNC,=C'C ' CLOSE FILES? BE $CLOSE YES, THEN CLOSE THEM PUPPIES CLC PDS$FUNC,=C'G ' GET RECORDS? BE $GET YES, THEN READ THEM PUPPIES CLC PDS$FUNC,=C'L ' LOCATE MEMBER? BE $LOCATE YES, THEN FIND IT CLC PDS$FUNC,=C'GD' GET DIRECTORY BLOCK? BNE PDSGET98 NO, CONTINUE BAL R14,$GETDIR GET NEXT DIRECTORY BLOCK B PDSGET99 EXIT PDSGET98 EQU * MVC PDS$RC,=X'FFFF' SET RETURN CODE PDSGET99 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 *====================================================================* * THIS SECTION WILL CLOSE THE PDS JUST PROCESSED * *====================================================================* $CLOSE EQU * CLOSE (PDSPODCB,) CLOSE (PDSPSDCB,) B PDSGET99 GOBACK TO MOMMA EJECT *====================================================================* * THIS SECTION WILL OPEN THE PDS TO PROCESS *====================================================================* $OPEN EQU * MVC PDS$LOCS,=C'N' SET MODULE LOCATED SWITCH OFF LA R15,PDSPSDCB GET ADDR OF DCB USING IHADCB,R15 ADDRESSIBILITY MVC DCBDDNAM,PDS$DD GET DDNAME LA R6,PDSPSDCB GET DCB OPEN ((R6),(INPUT)) LTR R15,R15 GOOD RETURN? BZ $OPEN010 YES--> CONTINUE MVC PDS$RC,=X'1000' SET BAD RETURN CODE B PDSGET99 GO BACK TO MOMMA $OPEN010 EQU * * BAL R14,$GETDIR GET NEXT DIRECTORY BLOCK * CLC PDS$RC,=X'0100' EOF ON FIRST READ? * BE PDSGET99 YES--> GOBACK TO MOMMA LA R15,PDSPODCB POINT TO DCB USING IHADCB,R15 ADDRESSIBILITY MVC DCBDDNAM,PDS$DD SET DD NAME LA R6,PDSPODCB OPEN ((R6),(INPUT)) LTR R15,R15 GOOD RETURN? BZ $OPEN020 YES--> CONTINUE MVC PDS$RC,=X'1001' SET BAD RETURN B PDSGET99 GO BACK TO MOMMA $OPEN020 EQU * LA R15,PDSPODCB GET DCB USING IHADCB,R15 ADDRESSIBILITY MVC PDS$BLKM,DCBBLKSI SAVE MAX BLOCK SIZE LA R15,JFCBDCB POINT TO DCB USING IHADCB,R15 MVC DCBDDNAM,PDS$DD SET DDNAME MVC PDS$JFCB,=AL1(135) SET JFCB TYPE RDJFCB JFCBDCB GET DATASET NAME LTR R15,R15 GOOD RETURN? BZ $OPEN030 YES--> CONTINUE MVC PDS$RC,=X'1002' SET BAD RETURN B $OPEN999 EXIT $OPEN030 EQU * MVC PDS$DSN,PDS$JFCA SAVE DATASET NAME $OPEN999 EQU * B PDSGET99 GOBACK TO MOMMA EJECT *====================================================================* * THIS SECTION WILL LOCATE A MEMBER IN THE DIRECTORY *====================================================================* $LOCATE EQU * MVC PDS$LOCS,=C'Y' INIT FIRST LOCATE SWITCH MVC PDS$BCNT,=H'1' SET ENTRY COUNT MVC PDS$BLL,=H'76' SET ENTRY LENGTH MVC PDS$BMEM,PDS$MEM GET MEMBER NAME TO LOCATE XC PDS$BTTR(PDS$BLEN),PDS$BTTR CLEAR WORK AREA LA R6,PDSPODCB POINT TO DCB LA R7,PDS$BLDL POINT TO LIST AREA BLDL (R6),(R7) LTR R15,R15 GOOD RETURN? BZ $LOCATE1 YES--> CONTINUE MVC PDS$RC,=X'0010' NO---> MEMBER NOT FOUND BZ $LOCATEX GOBACK TO MOMMA $LOCATE1 EQU * LA R6,PDSPODCB GET DCB ADDRESS LA R7,PDS$BTTR POINT TO BLDL TTR FIND (R6),(R7),C FIND START OF ENTRY LTR R15,R15 GOOD RETURN? BZ $LOCATEX YES--> GOBACK TO MOMMA MVC PDS$RC,=X'1004' SET RETURN CODE $LOCATEX EQU * B PDSGET99 GOBACK TO MOMMA EJECT *====================================================================* * THIS SECTION WILL GET EACH RECORD FOR THE SELECTED MEMBER *====================================================================* $GET EQU * CLC PDS$LOCS,=C'Y' FIRST TIME? BNE $GET0000 NO---> CONTINUE MVC PDS$LOCS,=C'N' SET FIRST TIME TO OFF B $GET1000 YES--> CONTINUE $GET0000 EQU * CLC PDS$BLKD,PDS$BLKL ANYTHING LEFT IN BLOCK? BL $GET2000 YES--> THEN PROCESS IT $GET1000 EQU * XC PDS$BLKD,PDS$BLKD INITIALIZE BLOCK DISPLACEMENT BAL R14,$READBLK READ BLOCK CLC PDS$RC,=X'0100' END-OF-FILE? BE $GETX YES--> EXIT $GET2000 EQU * LA R1,PDS$WORK POINT TO THIS BLOCK (BASE ADDR) LH R2,PDS$BLKD GET DISPLACEMENT INTO BLOCK AR R1,R2 ADD IN BASE MVC PDS$REC,0(R1) MOVE RECORD TO SAVE AREA LA R2,L'PDS$REC(,R2) BUMP DISPLACEMENT STH R2,PDS$BLKD SAVE DISPLACEMENT $GETX EQU * B PDSGET99 GOBACK TO MOMMA EJECT *====================================================================* * DO A READ FOR A BLOCK OF DATA FOR SELECTED MEMBER *====================================================================* $READBLK EQU * ST R14,PDS$R14R SAVE RETURN ADDRESS LA R6,PDSPODCB GET ADDR OF DCB LA R7,PDS$WORK GET ADDR OF PROCESSING AREA READ PDSODECB,SF,(R6),(R7),'S' READ NEXT BLOCK CHECK PDSODECB WAIT FOR READ L R7,PDSODECB+16 GET IOB ADDRESS LH R1,14(,R7) GET RESIDUAL CSW CNT LH R2,PDS$BLKM GET MAX BLOCK SIZE SR R2,R1 DIFF IS LENGTH READ STH R2,PDS$BLKL SAVE IT B $READBLX AND EXIT $READBLE EQU * MVC PDS$RC,=X'0100' SET EOF INDICATOR $READBLX EQU * L R14,PDS$R14R GET RETURN ADDRESS BR R14 RETURN TO MOMMA EJECT *====================================================================* * DO A GET ON THE NEXT DIRECTORY BLOCK *====================================================================* $GETDIR DS 0H ST R14,PDS$R14G SAVE RETURN ADDRESS LA R6,PDSPSDCB GET DIR DCB LA R7,PDS$DIR GET DIRECTORY BLOCK GET (R6),(R7) GET NEXT DIR BLOCK LA R15,PDS$DIR POINT TO THE BLOCK MVC PDS$DUSL,0(R15) SAVE LENGTH OF DIR ENTRIES LA R15,PDS$DIR+2 CURR BLK + RDW USING PDSDIRDS,R15 ADDRESSIBILITY B $GETDIR1 RETURN $GETDIR0 DS 0H MVC PDS$RC,=X'0100' SET EOF INDICATOR B $GETDIR9 RETURN $GETDIR1 DS 0H * XC PDS$UUSD,PDS$UUSD CLEAR LENGTH OF USED AREA MVC PDS$UUSD,=X'0002' SET LENGTH OF USED AREA XC PDS$DIRD,PDS$DIRD INIT DISP INTO DIR XC PDS$DCNT,PDS$DCNT INITIALIZE NUM OF DIR ENTRIES LA R8,PDS$DENT POINT TO FIRST ENTRY CLI 0(R15),X'00' ANYTHING THERE BE $GETDIR9 NO---> EXIT * $GETDIR2 DS 0H *================================================================= * R14=LENGTH OF THIS DIRECTORY ENTRY * R15=ADDRESS OF DIRECTORY ENTRY * R08=ADDRESS OF DIRECTORY ENTRY RETURN AREA *================================================================= XR R14,R14 CLEAR LENGTH IC R14,PDSDUSRS # OF HALFWORDS SH R14,=H'32' SLA R14,1(0) TIMES 2 AH R14,=AL2(PDSDFIXL) ADD IN FIXED LENGTH STH R14,0(R8) SAVE LENGTH OF THIS ENTRY EX R14,$MOVE MOVE DATA LH R2,PDS$DCNT GET NUM OF DIR ENTRIES AH R2,=H'1' INCREMENT STH R2,PDS$DCNT SAVE CH R2,=H'80' BNL $GETDIR9 * LA R15,0(R14,R15) POINT TO NEXT DIRECTORY ENTRY CLI 0(R15),X'FF' LAST ENTRY? BE $GETDIR0 YES--> EXIT CLI 0(R15),X'00' ANYTHING THERE BE $GETDIR9 NO---> EXIT AH R14,PDS$UUSD GET LENGTH ALREADY USED STH R14,PDS$UUSD SAVE LENGTH USED CLC PDS$UUSD,PDS$DUSL HAVE WE USED UP EVERYTHING BNL $GETDIR9 YES--->EXIT LA R8,80(R8) POINT TO NEXT SAVE SLOT B $GETDIR2 CONTINUE $GETDIR9 DS 0H L R14,PDS$R14G GET RETURN ADDRESS BR R14 GO BACK TO MOMMA $MOVE MVC 2(0,R8),0(R15) SAVE THIS DIRECTORY ENTRY * $ERROR1 DS 0H MVC PDS$RC,=X'1000' SET RETURN CODE B PDSGET99 GOBACK TO MOMMA $ERROR2 DS 0H MVC PDS$RC,=X'1001' SET RETURN CODE B PDSGET99 GOBACK TO MOMMA LTORG EJECT DS 0F PDSPSDCB DCB DDNAME=PDSFILE, * MACRF=(GM), * EODAD=$GETDIR0, * SYNAD=$ERROR1, * DSORG=PS, * BLKSIZE=256,LRECL=256 EJECT PDSPODCB DCB DDNAME=PDSFILE, * MACRF=(R), * EODAD=$READBLE, * SYNAD=$ERROR2, * DSORG=PO EJECT JFCBDCB DCB EXLST=(PDS$JFCB),MACRF=(R),DSORG=PS,DDNAME=DD ***************************************************************** * WORK AREA TO GET DATASET NAME ***************************************************************** PDS$JFCB DC AL1(135) END OF LIST DC AL3(PDS$JFCA) ADDR OF AREA FOR RDJFCB PDS$JFCA DS 44F ***************************************************************** * WORK AREA FOR READING BLOCKS ***************************************************************** PDS$WORK DS CL32767 SPACE 3 PDSDIRDS DSECT DIRECTORY ENTRY DSECT PDSDMEM DS CL8 1ST MEMBER NAME PDSDTTR DS XL3 TTR TO 1ST MEMBER PDSDUSRS DS X # OF HALFWORDS OF USER DATA PDSDFIXL EQU *-PDSDMEM FIXED PORTION OF DIRECTORY PDSDVAR DS 0H IHAPDS EJECT PDSPARMS DSECT PDS$FUNC DS CL2 FUNCTION * 'O '=OPEN PDS * 'C '=CLOSE PDS * 'L '=LOCATE MEMBER IN PDS * 'G '=GET RECORDS FOR PDS MEMBER PDS$RC DS XL2 RETURN CODE * X'0000'=GOOD RETURN * X'FFFF'=SERIOUS ERROR * X'0010'=MEMBER NOT FOUND * X'0100'=EOF ON MEMBER DATA * X'1000'=BAD OPEN OF PDS (DIRECTORY) * X'1001'=BAD OOPEN OF PDS * X'1002'=RDJFCB ERROR * X'1003'=BLDL ERROR * X'1004'=FIND ERROR PDS$DD DS CL8 DDNAME OF PDS TO SEARCH PDS$MEM DS CL8 MEMBER TO LOCATE PDS$DSN DS CL44 DATASET NAME PDS$REC DS CL80 RECORD FOR THIS MEMBER ***************************************************************** * WORKAREAS USED BY ALC$PDSL ***************************************************************** PDS$R14R DS F RET ADDR FOR $READBLK ROUTINE PDS$R14G DS F RET ADDR FOR $GETDIR ROUTINE PDS$UUSD DS H LEN OF UNUSED AREA IN DIR BLOCK PDS$BLKM DS H MAX BLOCK SIZE PDS$BLKD DS H DISPLACEMENT INTO BLOCK PDS$BLKL DS H BLOCK SIZE LENGTH PDS$LOCS DS CL1 FIRST TIME INDICATOR FOR LOCATE PDS$DIR DS CL256 WORK AREA FOR PDS DIR BLOCK ***************************************************************** * WORK AREA FOR BLDL (BUILD LABEL LIST FUNCTION) ***************************************************************** DS CL3 FORCE FULL WORK ALIGNMENT PDS$BLDL EQU * PDS$BCNT DS H NUMBER OF ENTRIES IN LIST (1) PDS$BLL DS H LENGTH OF ENTRY (76) PDS$BMEM DS CL8 MEMBER NAME PDS$BTTR DS XL3 RELATIVE BLOCK AND TRACK PDS$BBLK DS X RELATIVE DSN# (IF CONCATENATED) PDS$FIXL EQU *-PDS$BMEM PDS$BBLZ DS X LIBRARY,0=PRIV,1=LINK,2=STEP PDS$BBLC DS X # OF HALFWORDS OF USER AREA PDS$BUSR DS CL62 MAXIMUN USER DATA AREA PDS$BLEN EQU *-PDS$BTTR LEN OF AREA TO CLEAR OUT * SAVE AREA FOR EACH DIRECTORY ENTRY FROM DIRECTORY BLOCK PDS$DIRD DS H PDS$DUSL DS H PDS$DCNT DS H PDS$DENT DS CL80 PDS$DENL EQU *-PDS$DENT DS CL32174 PDS$LXXX EQU *-PDS$FUNC EJECT DCBD DSORG=(PS),DEVD=(DA) END