TITLE 'IGG0CLCD - UPDATE AND ENTRY BUILDING' @YL026UD 00010002 * /* START OF SPECIFICATIONS **** 00020002 * 00030002 *01* MODULE-NAME = IGG0CLCD @YL026UD 00040002 *01* STATUS = 00 00050002 *01* CHANGE-ACTIVITY = NEW FOR RELEASE 21 00060002 * (AS IGG0CLC3,IGG0CLC4,IGG0CLC5) @YL026UD 00062002 * RENAMED AND CHANGED FOR VS2 RELEASE 2 @YL026UD 00064002 *01* DESCRIPTIVE-NAME = UPDATE AND ENTRY BUILDING @YL026UD 00090002 *01* FUNCTION = (IN IGG0CLC3) @YL026UD 00092002 * 1. ENQUES ON THE VICE 00100002 * 2. READS THE CONTROL ENTRIES (ICE AND VICE). 00110002 * 3. INSURES THAT SOME SPACE IS AVAILABLE TO PROCESS 00120002 * REQUEST. 00130002 * 4. BUILDS INDEX ENTRIES 00140002 * 5. BUILDS INDEX CHAINS 00150002 * 6. BUILDS GENERATION INDEX ENTRIES 00160002 * 7. ROUTES CONTROL TO THE NEXT LOAD ACCORDING TO THE 00170002 * REQUEST TYPE. 00180002 * 8. MAINTAINS ALIAS COUNTS 00190002 * (IN IGG0CLC4) @YL026UD 00192002 * 1. UPDATES A GENERATION INDEX POINTER ENTRY. @YL026UD 00194002 * 2. REMOVES LAST ENTRY FROM A FULL @YL026UD 00196002 * GENERATION DATA GROUP. @YL026UD 00198002 * 3. SCRATCHES ALL DATA SETS REMOVED FROM @YL026UD 00198402 * A GENERATION DATA GROUP. @YL026UD 00198802 * 4. BUILDS A DATA SET POINTER ENTRY. @YL026UD 00199202 * 5. BUILDS VOLUME CONTROL BLOCK POINTER ENTRY.@YL026UD 00199602 * (IN IGG0CLC5) @YL026UD 00199702 * 1. FREES A CHAIN OF INDEX LEVELS. @YL026UD 00199802 * 2. FREES A CHAIN OF VCBS. @YL026UD 00199902 * 3. FREES A BLOCK. @YL026UD 00203202 * 4. WRITES A BLOCK CONTAINING A NEW GIPE. @YL026UD 00205202 * 5. WRITES A NEW LAST BLOCK OF A GDG. @YL026UD 00205602 * 6. EMPTYS A GDG. @YL026UD 00206002 * 7. BUILDS A CHAIN OF VCBS. @YL026UD 00206402 * 8. CLEANS UP PARTIALLY CREATED INDEX @YL026UD 00206502 * STRUCTURES AND VCB CHAINS ON CATALOG @YL026UD 00206602 * FULL ERROR CONDITIONS. @YL026UD 00207702 * FOR AN OVERVIEW OF THIS MODULE AND ITS RELATIONSHIP WITH THE 00208902 * OTHER CATALOG MANAGEMENT MODULES, REFER TO THE CATALOG MANAGEMENT 00210002 * PLM, Y28-6606. 00220002 *01* NOTES = LABELS REFERED TO IN COMMENTARY ARE ENCLOSED IN SINGLE 00230002 * QUOTES. EQUATED CONSTANTS ARE PREFIXED WITH 'D' OR 'X' WHEN THEY 00240002 * ARE DECIMAL OR HEXADECIMAL RESPECTIVELY; FOR EXAMPLE, D12 EQU 12, 00250002 * AND X12 EQU X'12'. ERROR CODES ARE SET USING 'ERRORXX' AT 00260002 * CORRESPONDING LABELS, 'ERRXX'. BRANCHES ORIGINATE FROM LABELS 00270002 * 'IGG0CLCX'. FLAGS ARE LABELED 'FLAGX'. IO IS DONE FROM EITHER A 00280002 * SUBROUTINE NAMED 'CALLBLDL' OR A SUBROUTINE NAMED 'IO'. ADDRESS 00290002 * CONVERSION IS ACCOMPLISHED IN SUBROUTINES NAMED 'TOABSL' AND 00300002 * 'TORLTV'. THESE CONVENTIONS ARE FOLLOWED IN EVERY MODULE WHERE 00310002 * THE EVENT EXISTS. 00320002 *02* DEPENDENCIES = THE OPERATION OF THIS MODULE DEPENDS ON THE 00330002 * COLLATING SEQUENCE OF THE EXTERNAL CHARACTER SET. A TRANSLATE 00340002 * AND TEST TABLE IS CONSTRUCTED FOR THE EBCDIC CHARACTER SET AND 00350002 * IS ARRANGED SO THAT REDEFINITION OF THE CHARACTER CONSTANTS BY 00360002 * REASSEMBLY WILL RESULT IN A CORRECT TABLE. THE CONSTANTS IN 00370002 * QUESTION ARE PREFIXED WITH 'CCD', FOR 'CHARACTER CODE 00380002 * DEPENDENT'. 00390002 *02* PERFORMANCE = 1. THE ICE IS NOT REREAD. 00400002 * 2. THE VOLUME INDEX IS ENQUED SHARED WHEN AN 00410002 * ENTRY IS NOT BEING INSERTED INTO IT. 00420002 * 3. THE BLOCK TO BE UPDATED IS NOT 00430002 * OVERLAID IN MOST CASES. 00440002 * 4. BEFORE THE SYSCTLG DATA SET IS MODIFIED, THE 00450002 * 'STEP MUST COMPLETE' (SMC) ENQ IS ISSUED 00460002 * 5. UPON AN ERROR CONDITION, ALL USED DATA BLOCKS 00470002 * ARE FREED 00480002 * 6. CHECKS ARE MADE FOR CONSISTENCY BETWEEN 00490002 * THE REQUEST AND THE STATE OF SYSCTLG IN 00500002 * ORDER TO MAINTAIN THE INTEGRITY OF SYSCTLG 00510002 *02* RESTRICTIONS = ALL DIRECT ACCESS STORAGE DEVICES EXCEPT 2321 00520002 * DATA CELL ARE SUPPORTED BY CATALOG MANAGEMENT. 00530002 *02* REGISTER-CONVENTIONS = REGISTERS ARE LABELED 'R0,R1,...,R15'. 00540002 * REQUIRED ADDITIONAL LABELS ARE EQUATED TO THESE. REGISTERS 00550002 * COMMON TO ALL MODULES OF CATALOG MANAGEMENT ARE 00560002 * R4 BASE REGISTER FOR THE MODULE. 00570002 * R6 BASE REGISTER FOR THE WORKAREA DSECT. 00580002 * R8 BASE REGISTER FOR THE CAMLSTD DSECT. 00590002 *02* PATCH-LABEL = 'FIXAREA' @YL026UD 00600002 *01* MODULE-TYPE = MODULE 00610002 *02* PROCESSOR = ASSEMBLER 00620002 *02* MODULE-SIZE = 4000 BYTES @YL026UD 00630002 *02* ATTRIBUTES = REENTERABLE READ ONLY, ENABLED, SUPERVISORY MODE 00640002 *01* ENTRY = IGG0CLCD @YL026UD 00650002 *02* PURPOSE = (IGG0CLC3) ENTERED FOR EVERY NON-LOCATE @YL026UD 00660002 * REQUEST. BUILDS ALL MISSING INDEX LEVELS. FOR BLDA, @YL026UD 00670002 * DLTA, BLDX, DLTX, DRPX, BLDG, IT INSURES THE REQUEST @YL026UD 00680002 * CAN BE PERFORMED ON THE EXISTING SYSCTLG STRUCTURE. @YL026UD 00690002 * (IGG0CLC4) ENTERED FOR 'CAT', 'UNCAT', 'RECAT', @YL026UD 00692002 * 'CATBX', FOR EITHER GDG OR NON-GDG. @YL026UD 00694002 * (IGG0CLC5) ENTERED FOR A VARIETY OF REQUESTS FOR THE @YL026UD 00696002 * PERFORMANCE OF NECESSARY IO OTHER THAN THE NORMAL @YL026UD 00698002 * UPDATING OF AN INDEX LEVEL. @YL026UD 00698402 *02* LINKAGE = LINK @YL026UD 00700002 *02* INPUT = FOR ALL MODULES, EXCEPT IGC0002F, CONSISTS OF 00710002 * . WORKAREA (BLDLAREA) 00720002 * . SVRB EXTENSION 00730002 * . DCB 00740002 * . DEB 00750002 * . CAMLST AND PARAMETERS 00760002 * . SYSCTLG 00770002 * IN ADDITION, IGG0CLC3 REQUIRES @YL026UD 00780002 * . 'READICEF'--INDICATES IF ICE MUST BE READ 00790002 * . 'ICETTR'--TTR OF ICE FOR THIS REQUEST 00800002 * . 'NAMETTR0'--USED TO CONSTRUCT AN INDEX 00810002 * IN ADDITION, IGG0CLC4 REQUIRES @YL026UD 00812002 * . 'FOUNDENT'--POINTER TO THE GIPE (CAT,UNCAT) @YL026UD 00814002 * . 'NAMLG'--NUMBER OF LEVELS GIVEN (CAT,CATBX) @YL026UD 00816002 * . 'NAMLF'--NUMBER OF LEVELS FOUND (CAT,CATBX) @YL026UD 00818002 * IN ADDITION, IGG0CLC5 REQUIRES @YL026UD 00818402 * . 'DELTTR1'--POINTER TO INDEX LEVEL CHAIN TO FREE @YL026UD 00818802 * . 'DELTTR3'--POINTER TO VCB CHAIN TO FREE @YL026UD 00819202 * . 'TTR0'--POINTER TO BLOCK TO FREE @YL026UD 00819602 * . 'WRITETTR'--POINTER TO NEW BLOCK TO WRITE @YL026UD 00819702 * . 'READTTR'--POINTER TO NEW LAST GDG BLOCK TO WRITE @YL026UD 00819802 * . 'ICE'--FOR EMPTYING A GENERATION DATA GROUP @YL026UD 00819902 *02* OUTPUT = SEE INPUT FOR NEXT LOAD 00820002 *02* EXIT-NORMAL = IGG0CLCE @YL026UD 00830002 *02* EXIT-ERROR = IGG0CLC7 (IN IGG0CLCE) @YL026UD 00840002 *01* EXTERNAL-REFERENCES = AS FOLLOWS: 00850002 *02* ROUTINES = IECPRLTV, IECPCNVT, ENQ, OPENEXT(IGC0002H) @YL026UD 00860002 *02* DATA-SETS = SYSCTLG 00870002 *02* DATA-AREA = ALL DATA AREAS ARE DESCRIBED BY DSECTS AT THE END 00880002 * OF THE MODULE LISTING. 00890002 *01* TABLES = NAME TABLE (SEE LABELS PREFIXED WITH 'NAM' IN WORKAREA 00900002 * DSECT) 00910002 *01* MACROS = EXCP, GETMAIN, ENQ, DEQ, FREEMAIN, SCRATCH, @YL026UD 00920037 * SETRP, SDUMP, TESTAUTH, WAIT 00923037 * 00930002 * VS2 RELEASE 037 CHANGES 00932037 *A286018-286028 @OZ03161 00934037 *C115700 @OZ14792 00934437 *C285940 @OZ17516 00934837 *A173810-173880,A286551 @OZ19636 00935237 *A173916,A173924 @OZ27009 00935637 *A285940-285943,A286689-286701,A297708-297716 @OZ29464 00935837 * 00936037 **** END OF SPECIFICATIONS ***/ 00940002 EJECT @YL026UD 00950002 IGG0CLCD CSECT 00960002 * 00962002 BALR BASE,0 SET BASE REGISTER 00970002 USING *,BASE 00980002 USING WORKAREA,R6 00990002 USING SVRBEXTD,R5 01000002 USING CAMLSTD,R8 01010002 USING CVT,R3 01020002 B MODLABEL BRANCH AROUND MOD LABEL @YL026UD 01020402 DC C'IGG0CLCD ' MODULE IDENTIFIER @YL026UD 01020802 DC C'&SYSDATE' DATE OF ASSEMBLY 01021037 MODLABEL EQU * 01021202 * 01022002 TITLE 'IGG0CLCD - (IGG0CLC3) UPDATE INITIALIZATION' @YL026UD 01022402 *********************************************************************** 01022802 * * 01023202 * IGG0CLC3 - UPDATE INITIALIZATION * 01023602 * * 01023702 *********************************************************************** 01023802 * @YL026UD 01023902 IGG0CLC3 EQU * @YL026UD 01024002 * 01026002 OI MODMAP1,MODCLC3 INDIC ENTRY TO IGG0CLC3 01030002 XC DELTTR3,DELTTR3 RESET TO ZERO Y01113 01040002 * 01050002 TM MODMAP1,MODCLC4 BEEN TO CLC4? 01060002 BO CATBX BRANCH IF YES AND BUILD INDEXES 01070002 * 01080002 TM FLAG1,READICEF MUST READ ICE? 01090002 BZ ENQVI BRANCH IF NO 01100002 * 01110002 * READ ICE ENTRY 01120002 * 01130002 L R0,ICETTR GET ICE TTR 01140002 * 01150002 * IF ICETTR=0, THEN ICE=VICE FOR THIS REQUEST 01160002 * 01170002 LTR R0,R0 ICETTR 0? 01180002 MVI ITYPE,VICETYP ASSUME YES 01190002 BZ ENQVI BRANCH IF YES 01200002 * 01210002 BAL BALREG2,TOABSL CONVERT TTR 01220002 * 01230002 * CHANNEL PROGRAM SET DURING RELOCATE. 01240002 * 01250002 BAL BALREG1,IO1 ***READ ICE*** 01260002 MVC ICEPERT,TEMPBUFF+L'INBYTSU+L'INAME SAVE ICE 01270002 * 01280002 ENQVI EQU * 01290002 * 01300002 * ENQUEUE ON VOLUME INDEX (IF NECESSARY), AND VICE AND READ VICE. 01310002 * 01320002 MVI ENQFLAGS,SHARE+HAVE+SYSTEM INDIC TYPE OF REQUEST X01965 01330002 ENQ ,MF=(E,(R5)) 01340002 * 01350002 * ENQUE ON VICE 01360002 * 01370002 XC ENQRNAM8,ENQRNAM8 RNAME OF ZERO 01380002 MVI ENQFLAGS,HAVE+SYSTEM INDIC TYPE OF REQUEST X01965 01390002 ENQ ,MF=(E,(R5)) 01400002 * 01410002 * READ VICE ENTRY 01420002 * 01430002 LA R0,VICETTR SET VICE TTR OF 001 01440002 BAL BALREG2,TOABSL CONVERT 01450002 * 01460002 * CHANNEL PROGRAM WAS SET DURING RELOCATE IN CLC2 01470002 * 01480002 BAL BALREG1,IO1 READ THE BLOCK 01490002 * GET THE NEEDED PART OF THE VICE 01500002 MVC VICEPERT,TEMPBUFF+L'INBYTSU+L'VNAME 01510002 * 01520002 * SAVE ORIGINAL 'VFHOLE' --- IF 'VFHOLE' IS NOT CHANGED THEN THE 01530002 * VICE DOES NOT HAVE TO BE UPDATED, HENCE NOT REREAD AND WRITTEN 01540002 * IN IGG0CLC7 01550002 * 01560002 MVC VICESAVE,VSAVE SAVE ORIGINAL VFHOLE 01570002 * 01580002 * IF THE VOLUME INDEX WAS PREVIOUSLY DEQUEUED AND ENQUEUED AGAIN, 01590002 * THEN A CHECK MUST BE MADE TO BE SURE THE CATALOG WAS NOT 01600002 * EXTENDED DURING THE INTERVENING TIME. IF SO, CLOSE AND REOPEN 01610002 * THE CATALOG SO THE DEB REFLECTS THE NEW EXTENT. 01620002 * 01630002 L R0,VCLSTBLK TTR TO LST BLK IN CURRENT CTLG 01640002 BAL BALREG2,TOABSL TTR WITHIN DEB EXTENTS? 01650002 LTR R15,R15 RETURN CODE 0? (I.E. WITHIN DEB) 01660002 BZ SPACECHK BRANCH IF YES 01670002 * 01680002 * CLOSE CATALOG BY FREEING THE DCB/DEB 01690002 * 01700002 L R1,IOBDCB GET DCB POINTER 01710002 USING DCBAREA,R1 ESTABL ADDRBLTY TO DCBAREA 01720002 L R0,NMBYTES GET NUMBER OF BYTES TO FREE 01730002 LA R1,DCBAREA POINTER TO AREA @YL026UD 01740002 XC SVOPNWAP(4),SVOPNWAP RESET WKA PTR (ESTAE) @YL026UD 01742002 SVC FREEMAIN FREEMAIN R,LV=(0),A=(1) 01750002 * 01760002 L R0,SPNBYTES GET SP ID AND SIZE OF WA 01770002 GETMAIN R,LV=(0) GET NEW DCB/DEB AREA FOR 2H 01780002 ST R1,SVOPNWAP SAVE WKA PTR (ESTAE) @YL026UD 01782002 * 01790002 * PREPARE FOR OPEN 01800002 * 01810002 USING DCBAREA,R1 ESTABL DCBAREA ADDRBLTY @YL026UD 01820002 ST R6,CATWAP SAVE WORKAREA PTR FOR 2H 01830002 LA R0,BLDLAREA OBTAIN 'BLDLAREA' ADDRESS 01832002 ST R0,BLDLAP SAVE BLDLAREA PTR (2H) @YL026UD 01834002 DROP R1 01840002 LR R15,R1 OPEN WA POINTER 01850002 XR R0,R0 INDICATE OPEN REQUEST 01860002 L R1,UCBADDR GET UCB ADDRESS 01870002 L R2,OPENMOD GET IGC0002H MODULE ADDRESS 01880002 BALR R14,R2 RE-OPEN CATALOG 01884002 * 01890002 LR R2,R1 SAVE DCB ADDRESS 01900002 LCR R1,R15 CHECK RETURN CODE 01910002 BNZ IGG0CLC7 TAKE ERROR EXIT 01920002 * 01930002 ST R2,IOBDCB UPDATE IOB DCB 01940002 L R2,D44(R2) GET DEB ADDRESS 01950002 ST R2,DEBADDR SAVE DEB ADDRESS 01960002 * 01970002 * 01980002 SPACECHK EQU * 01990002 * 02000002 * IS THERE SUFFICIENT SPACE AVAILABLE IN THE CATALOG TO PROCEED 02010002 * BEYOND THIS POINT? 02020002 * 02030002 * WILL DATA BE ADDED TO THE CATALOG? 02040002 * 02050002 TM CAMOPTN1,CAMCAT+CAMRECAT CATALOG OR RECAT? SA52093 02060002 * BRANCH IF YES AND CHECK SPACE SA52093 02070002 BM FULLCHK BRANCH IF YES SA52093 02080002 * BLDX OR BLDG OR BLDA OR LNKX? 02090002 TM CAMOPTN2,CAMBLDX+CAMBLDG+CAMBLDA+CAMLNKX 02100002 BZ ROUTE BRANCH IF NO - CHECK UNNECESSARY 02110002 * 02120002 * 02130002 FULLCHK EQU * 02140002 * 02150002 CLI VFHOLE,XFF CATALOG FULL? 02160002 BE ERR20 BRANCH IF YES 02170002 * 02180002 * 02190002 ROUTE EQU * 02200002 * 02210002 * ROUTE THE REQUEST TO THE PROPER MODULE OR ROUTINE 02220002 * 02230002 * IF UCATDX AND BLOCKS HAVE TO BE FREED -- GO TO CLC5 02240002 * 02250002 NC DELTTR1,DELTTR1 ANY BLKS TO FREE? 02260002 BNZ IGG0CLC5 BRANCH IF YES 02270002 * 02280002 * CAT, RECAT, UNCAT, CATBX OR UCATDX ---- GO TO IGG0CLC4 02290002 * 02300002 TM CAMOPTN1,CAMCAT+CAMRECAT+CAMUNCAT 02310002 BM IGG0CLC4 BRANCH IF YES 02320002 * 02330002 * TEST FOR LNKX 02340002 * 02350002 TM CAMOPTN2,CAMLNKX LNKX? 02360002 BO IGG0CLC6 BRANCH IF YES AND GO TO CLC6 02370002 * 02380002 * TEST FOR BLDX OR BLDG 02390002 * 02400002 TM CAMOPTN2,CAMBLDX+CAMBLDG 02410002 BM BLDX BRANCH IF BLDX OR BLDG 02420002 * 02430002 * IS LAST ENTRY FOUND AN IPE, ALIAS OR CVOL? 02440002 * 02450002 CLI ERRLOCSV,ERROR12 IS LOCATE ERROR CODE 12? 02460002 BNE ERR08 BRANCH IF NO 02470002 * 02480002 * TEST FOR DRPX 02490002 * 02500002 TM CAMOPTN3,CAMDRPX DRPX? 02510002 BO DRPX BRANCH IF YES 02520002 * 02530002 * CHECK FOR DLTX FUNCTION 02540002 * 02550002 TM CAMOPTN2,CAMDLTX IS DLTX BIT ON? 02560002 BO DLTXRTN BRANCH IF YES 02570002 * 02580002 * CHECK FOR BLDA OR DLTA 02590002 * 02600002 TM CAMOPTN2,CAMBLDA+CAMDLTA IS BLDA OR DLTA BIT ON? 02610002 BM BDLTARTN BRANCH IF YES 02620002 * 02630002 * ALL POSSIBLITIES ARE EXHAUSED --- NO FUNCTION MATCH 02640002 * 02650002 B ERR08 ERROR EXIT 02660002 * 02670002 * 02680002 DRPX EQU * 02690002 * 02700002 TM FLAG2,CVOLF * CVOL LAST ENTRY FOUND? 02710002 BO IGG0CLC6 YES, CONTINUE PROCESSING 02720002 B ERR08 ERROR--INCORRECT ENTRY 02730002 * 02740002 * 02750002 BLDX EQU * 02760002 * 02770002 * ALL PREVIOUS LEVELS TO THE LAST MUST EXIST BEFORE BUILDING AN 02780002 * INDEX 02790002 LH R15,NAMLG NAME LEVELS GIVEN 02800002 BCTR R15,0 DECREMENT BY 1 02810002 CH R15,NAMLF 02820002 BL ERR08 BRANCH IF EQUAL (DUPLICATE) 02830002 BH ERR16 BRANCH IF LEVELS MISSING 02840002 * 02850002 * BUILD AN INDEX. 02860002 * 02870002 * CONSTRUCT FIRST 28 BYTES OF THE KEY AND DATA FIELDS 02880002 BAL BALREG1,KEYICE CONSTRUCT FIRST PART OF BLK 02890002 * 02900002 * PUT IN LINK ENTRY 02910002 MVC OUTDATA+L'OUTBYTSU+L'ICE(L'LNKENTRY),LNKENTRY 02920002 * 02930002 * SINCE THE CATALOG DATA SET IS TO BE MODIFIED, ISSUE THE STEP 02940002 * MUST COMPLETE ENQ 02950002 * 02960002 OI ENQFLAGS,SMCSTEP SET FLAGS FOR SMC 02970002 ENQ ,MF=(E,(R5)) ISSUE REQUEST 02980002 * WRITE BLOCK, FIND NEXT FREE BLOCK AND PUT INTO VICE 02990002 BAL BALREG5,WRTSRCH ***WRITE BLOCK*** 03000002 * 03010002 * 03020002 BLDXCHK EQU * 03030002 * 03040002 TM CAMOPTN2,CAMBLDX BLDX? 03050002 BO IGG0CLC6 BRANCH IF YES 03060002 * 03070002 * BUILD A GIPE. 03080002 * 03090002 LA R2,NAME POINT TO ENTRY 03100002 USING EINDEX,R2 USE ENTRY DSECT 03110002 XC EGIPEF,EGIPEF ZERO GIPE DATA FIELD 03120002 MVI ETYPE,GIPETYP SET TYPE TO GIPE 03130002 MVC EGMAXSIZ,CAMGEN GET MAXIMUM GENERATION COUNT 03140002 TM CAMOPTN3,CAMEMPTY 'EMPTY' OPTION SPECIFIED? 03150002 BZ TSTDELET BRANCH IF NO 03160002 OI EGFLAGS,EGEMPTY TURN ON EMPTY FLAG 03170002 * 03180002 TSTDELET EQU * 03190002 * 03200002 TM CAMOPTN3,CAMDELET 'DELETE' OPTION SPECIFIED? 03210002 BZ IGG0CLC6 BRANCH IF NO 03220002 OI EGFLAGS,EGDELETE TURN ON DELETE FLAGS 03230002 B IGG0CLC6 GO TO CLC6 AND INSERT NAME 03240002 * 03250002 DROP R2 03260002 * 03270002 CATBX EQU * 03870002 * 03880002 * BUILD ALL INDEXES FOR CATBX. 03890002 * 03900002 * FIRST BUILD THE BLOCK TO CONTAIN THE DSPE OR VCBPE ENTRY 03910002 * 03920002 * SINCE THE CATALOG DATA SET WILL BE MODIFIED, WILL ISSUE 03930002 * 'STEP MUST COMPLETE' 03940002 * 03950002 TM ENQFLAGS,SMCSTEP SMC ALREADY ISSUED? Y01965 03960002 BO SKIPSMC BRANCH IF YES Y01965 03970002 * 03980002 OI ENQFLAGS,SMCSTEP SET FLAGS FOR SMC 03990002 ENQ ,MF=(E,(R5)) ISSUE REQUEST 04000002 * Y01965 04010002 SKIPSMC EQU * Y01965 04020002 * Y01965 04030002 * 04040002 * CONSTRUCT KEY AND ICE IN 'OUTPUT' AND 0 REMAINING BLOCK 04050002 BAL BALREG1,KEYICE CONSTRUCT FIRST PART OF BLK 04060002 LH LEVEL,NAMLG GET NUMBER OF LEVELS GIVEN 04070002 * DECREMENT BY ONE SO PROPER EXIT IS TAKEN ON CORRECT LEVEL 04080002 BCTR LEVEL,0 DECREMENT BY 1 04090002 LA R1,D02 INITIALIZE FOR VCBPE 04100002 CLI TYPE,VCBPETYP VCBPE? 04110002 BE MOVENTRY BRANCH IF YES 04120002 * ASSUME ENTRY IS DSPE. 04130002 IC R1,TYPE GET NUMBER OF HALFWORDS 04140002 LA R1,0(R1,R1) DOUBLE 04150002 BCTR R1,0 DECREMENT FOR EX INSTRUCTION 04160002 L R2,CAMPTR3 GET POINTER TO VOLUME LIST 04170002 EX R1,MOVEVOLS MVC OUTDATA+32(0),0(R2) 04180002 LA R1,D01(R1) RESET DATA LENGTH 04190002 * 04200002 * 04210002 MOVENTRY EQU * 04220002 * 04230002 * PUT NEW ENTRY INTO BUFFER. 04240002 * 04250002 MVC OUTENTRY+L'ICE(L'NAMTTR0),NAMTTR0 04260002 * 04270002 * IF THE ENTRY IS A VCBPE, ONLY 12 BYTES OF THE ENTRY ARE MOVED 04280002 * BY THE ABOVE INSTRUCTION, BUT THE LAST TWO BYTES OF A VCBPE 04290002 * ARE 0 AND THE BLOCK WAS ZEROED IN THE 'KEYICE' ROUTINE. THE 04300002 * EXTRA TWO BYTES ARE ALLOWED FOR IN THE FOLLOWING BY THE ABOVE 04310002 * LA R1,2 INSTRUCTION. 04320002 * 04330002 LA R1,D12(R1) CALCULATE LENGTH OF ENTRY 04340002 * ADD 32 FOR HALFWORD COUNT, ICE AND ILE 04350002 AH R1,OUTBYTSU 04360002 * UPDATE BYTES USED FIELD IN BLOCK 04370002 STH R1,OUTBYTSU 04380002 * POINT R2 TO WHERE ILE GOES 04390002 LA R2,OUTDATA-L'LNKENTRY(R1) 04400002 MVC 0(L'LNKENTRY,R2),LNKENTRY PUT IN ILE 04410002 * SAVE TTR OF BLOCK, WRITE IT AND FIND NEXT FREE BLOCK 04420002 BAL BALREG5,WRTSRCH ***WRITE BLOCK*** 04430002 * 04440002 * NOW BUILD REMAINING INDEXES 04450002 * 04460002 BCTR LEVEL,0 DECREMENT TO NEXT LEVEL 04470002 BAL BALREG1,MOVELVL MOVE NEXT LEVEL NAME INTO 'NAME' 04480002 MVI TYPE,IPETYP SET AS IPE 04490002 CH LEVEL,NAMLF LESS THAN NO. OF LEVELS FOUND? 04500002 BE BLDXCHK BRANCH IF YES 04510002 BL ERR08 ERROR CONDITION 04520002 * 04530002 * ANOTHER INDEX LEVEL TO BUILD. 04540002 * 04550002 BAL BALREG1,KEYICE BUILD KEY AND ICE AND 0 BLOCK 04560002 XR R1,R1 SET R1 TO CORRECT LENGTH 04570002 B MOVENTRY BRANCH AND PUT ENTRY INTO BUFFER 04580002 * 04590002 * 04600002 DLTXRTN EQU * 04610002 * 04620002 * DELETE INDEX ROUTINE 04630002 * 04640002 * THE ONLY POSSIBLE ENTRY TYPES AT THIS POINT ARE IPE AND ALIAS 04650002 * 04660002 L R0,TTR 04670002 BAL BALREG2,TOABSL CONVERT TTR 04680002 BAL BALREG1,IO1 READ 20 BYTES INTO TEMPBUFF 04690002 CLI TEMPBUFF+1,X20 IS THERE AN ENTRY IN THE BLOCK? 04700002 BNE ERR12 BRANCH IF YES--CAN'T DELETE 04710002 CLI TEMPBUFF+ALIASDSP,X00 CHECK ALIAS COUNT 04720002 BNZ ERR12 CAN'T DELETE--HAS ALIASES 04730002 * OK TO DELETE INDEX -- INDICATE TO CLC5 TO FREE BLK AT 'TTR' 04740002 OI FLAG3,FRBLK 04750002 B IGG0CLC5 GO TO CLC5 AND FREE BLK 04760002 * 04770002 * 04780002 BDLTARTN EQU * 04790002 * 04800002 * BUILD AND DELETE ALIAS ROUTINE 04810002 * 04820002 * UPDATE THE ALIAS COUNT IN THE ICE AT 'TTR', AND PASS CONTROL 04830002 * TO IGG0CLC5 04840002 * 04850002 L R0,TTR0 GET TTR OF ICE 04860002 IC R0,ZERO ZERO THE COUNT FIELD 04870002 BAL BALREG2,TOABSL CONVERT THE TTR 04880002 MVC OPTNCCW,RD MOVE IN CCW TO READ DATA 04890002 BAL BALREG1,IO1 READ DATA INTO INPUT 04900002 * 04910002 * UPDATE ALIAS COUNT OF ICE IN BLOCK JUST READ. 04920002 * 04930002 XR ALIASCNT,ALIASCNT CLEAR 04940002 IC ALIASCNT,INDATA+ALIASDSP GET ALIAS CNT 04950002 LA INTEGER,D01 PUT 1 IN ANOTHER REGISTER 04960002 * 04970002 * IF FUNCTION IS BLDA, INCREMENT THE ALIAS COUNT 04980002 * IF FUNCTION IS DLTA, DECREMENT THE ALIAS COUNT 04990002 * 05000002 TM CAMOPTN2,CAMBLDA BLDA? 05010002 BO ADDREG BRANCH IF YES 05020002 * 05030002 * DLTA FUNCTION. 05040002 * 05050002 CLI TYPEB,ALIASTYP ALIAS ENTRY? 05060002 BNE ERR08 BRANCH IF NO -- INCORRECT ENTRY 05070002 LCR INTEGER,INTEGER COMPLEMENT INTEGER TO DECREMENT 05080002 * 05090002 ADDREG EQU * 05100002 * 05110002 AR ALIASCNT,INTEGER MODIFY ALIAS COUNT 05120002 STC ALIASCNT,INDATA+ALIASDSP UPDATE ALIAS CNT 05130002 * 05140002 * ALIAS COUNT IN ICE UPDATED. READY FOR WRITE. 05150002 * INDICATE TO CLC5 TO WRITE UPDATED BLOCK 05160002 * 05170002 OI FLAG3,WRBLK+NEEDBLK 05180002 * PREPARE FOR IGG0CLC5 05190002 MVC OUTDATA,INDATA MOVE BLK TO OUTPUT BUFFER 05200002 MVC WRITETTR(L'TTR),TTR INDICATE WHERE TO WRITE BLK 05210002 B IGG0CLC5 GO TO CLC5 TO WRITE BLK 05220002 EJECT 05230002 * 05240002 **************** 05250002 * * 05260002 WRTSRCH EQU * 05270002 * * 05280002 **************** 05290002 * 05300002 * FUNCTION: 05310002 * WRITE THE KEY AND DATA BLOCK AT 'OUTPUT' INTO THE FREE BLOCK 05320002 * POINTED TO BY 'VFHOLE' - WRITE VERIFY WHAT WAS JUST WRITTEN AND 05330002 * THEN SEARCH FOR A NEW FREE BLOCK. 05340002 * 05350002 * INPUT: 05360002 * 1) RETURN ADDRESS IN BALREG3 05370002 * 2) UPDATE OUTPUT BLOCK 05380002 * 05390002 * OUTPUT: 05400002 * 1) PUT TTR0 OF BLOCK WRITTEN INTO 'TTR' 05410002 * 2) BLOCK WRITTEN FROM BUFFER 'OUTPUT' 05420002 * 3) NEW HOLE INTO VFHOLE 05430002 * 05440002 * DESTROYED: 05450002 * NEXTCNT UPON FIRST HOLE SEARCH 05460002 * VFHOLE IN VICE 05470002 * 05480002 * EXITS: 05490002 * 1) TOABSL - TO CONVERT THE TTR 05500002 * 2) IO - TO WRITE, WRITE VERIFY AND SEARCH FOR NEXT FREE 05510002 * BLOCK. 05520002 * 05530002 *************** 05540002 *************** 05550002 * 05560002 L R0,VFHOLE GET FREE BLOCK TTR 05570002 ST R0,TTR0 SAVE TTR TO CONSTRUCT IPE 05580002 BAL BALREG2,TOABSL CONVERT 05590002 MVC OPTNCCW,WKD MOVE IN WRITE KEY AND DATA CCW 05600002 BAL BALREG1,IO1 WRITE BLOCK 05610002 MVC OPTNCCW,RKD MOVE IN WRITE VERIFY CCW 05620002 OI OPTNCCW+4,CC COMMAND CHAIN TO SEARCH NXT HOLE 05630002 BAL BALREG1,IO1 WRITE VERIFY 05640002 LTR R15,R15 ANOTHER FREE BLK FOUND? 05650002 BZ CONTINUE BRANCH IF YES 05660002 * 05670002 OI FLAG1,ERRFULL SET ERROR FLAG FOR CLC5 05680002 B IGG0CLC5 GO TO CLC5 AND FREE BLKS 05690002 * 05700002 CONTINUE EQU * 05710002 * 05720002 BAL BALREG2,TORLTV CONVERT NEW FREE BLK ADDR TO TTR 05730002 ST R0,VFHOLE PUT INTO VICE 05740002 BR BALREG5 RETURN TO CALLER 05750002 EJECT 05760002 **************** 05770002 * * 05780002 KEYICE EQU * 05790002 * * 05800002 **************** 05810002 * 05820002 * FUNCTION: 05830002 * CONSTRUCT AN ICE ENTRY IN OUTPUT. ALSO PUT IN AN FF KEY AND 32 05840002 * IN THE BYTES USED FIELD OF THE DATA BLOCK. 05850002 * 05860002 * INPUT: 05870002 * RETURN ADDRESS IN BALREG1 05880002 * 05890002 * OUTPUT: 05900002 * KEY, BYTES USED FIELD, AND ICE IN OUTPUT 05910002 * REMAINING BLOCK ZEROED 05920002 * 32 IN BYTES USED FIELD OF DATA BLOCK 05930002 * 05940002 * DESTROYED: 05950002 * OUTPUT 05960002 * OUTKEY 05970002 * SAVETTR 05980002 * 05990002 *************** 06000002 *************** 06010002 * 06020002 MVC OUTKEY,HIBIN PUT IN FF KEY 06030002 XC OUTDATA,OUTDATA 0 BLOCK 06040002 * SET UP HALFWORD BYTE COUNT AND ICE 06050002 MVI OUTBYTSU+1,X20 HLFWD BYTE COUNT 06060002 MVI OUTICE+7,X01 SET ICE NAME 06070002 MVI OUTICECD,X03 SET ICE CODE 06080002 MVC OUTILBLK,VFHOLE UPDATE THE LAST BLOCK ADDRESS 06090002 MVC OUTILL,VFHOLE UPDATE THE INDEX LOWER LIMIT 06100002 BR BALREG1 RETURN TO CALLER 06110002 EJECT 06120002 * 06890002 **************** 06900002 * * 06910002 IO1 EQU * 06920002 * * 06930002 **************** 06940002 * 06950002 * FUNCTION: 06960002 * 1. IF THE DEVICE HAS THE RPS FEATURE, THE SET SECTOR CCW IS 06970002 * UPDATED. 06980002 * 2. ISSUE EXCP FOR THE CHANNEL PROGRAM POINTED TO BY THE IOB. 06990002 * 3. WAIT FOR THE OPERATION TO COMPLETE AND CHECK THE ECB. 07000002 * 4. IF AN END OF EXTENT CONDITION, BRANCH TO IGC0002H @YL026UD 07010002 * AND EXTEND THE CATALOG. @YL026UD 07020002 * 5. IF A PERMANENT I/O ERROR, SET AN ERROR CODE AND BRANCH TO 07030002 * IGG0CLC7. 07040002 * 07050002 * INPUT: 07060002 * UPDATED CHANNEL PROGRAM 07070002 * RETURN ADDRESS IN BALREG 1 07080002 * 07090002 * OUTPUT: 07100002 * 1. FILLED BUFFER OR 07110002 * 2. EMPTIED BUFFER OR 07120002 * 3. ANOTHER FREE BLOCK ADDRESS 07130002 * 07140002 * DESTROYED: 07150002 * REGISTERS R0,R1,R15 (IF EXTENDS) 07160002 * 07170002 * EXTERNAL ROUTINES USED: 07180002 * EXCP, WAIT, IGC0002H TO EXTEND CATALOG @YL026UD 07190002 * 07200002 * EXITS: 07210002 * IGC0002H TO EXTEND THE CATALOG @YL026UD 07220002 * IGG0CLC7 FOR PERMANENT I/O ERROR 07230002 *************** 07240002 *************** 07250002 * 07260002 TM FLAG2,RPSDEV RPS FEATURE? 07270002 BZ EXCP1 BRANCH IF NO 07280002 L R1,RPSAVEP GET RPS SAVE AREA PTR 07290002 USING RPSD,R1 07300002 STM R9,R2,RPSAVE SAVE REGISTERS TO BE DESTROYED 07310002 LM R15,R2,RPSINPUT GET THETA CONVERT INPUT PARMS 07320002 IC R0,IOBSKADD+7 GET R OF CCHHR 07330002 BALR R14,R15 CONVERT R TO THETA 07340002 * NOTE: R1 AND R3 THROUGH R8 ARE NOT DESTROYED BY THE CONVERT 07350002 LM R9,R2,RPSAVE RESTORE REGISTERS 07360002 * 07370002 * 07380002 EXCP1 EQU * 07390002 * 07400002 EXCP IOB ISSUE EXCP 07410002 WAIT ECB=ECB WAIT FOR REQUEST 07420002 XR R15,R15 SET RETURN CODE TO 0 07430002 CLI ECB,X7F NORMAL COMPLETION? 07440002 BCR 8,BALREG1 BRANCH IF YES 07450002 CLI ECB,X42 OUT OF EXTENT? 07460002 BNE ERR28 NO, PERMANENT I/O ERROR 07470002 * 07480002 * FALL THROUGH AND EXTEND CATALOG 07490002 * 07500002 ST BALREG1,SVBALREG SAVE CURRENT BALREG1 @YL026UD 07502002 L R0,IOBDCB GET DCB ADDRESS 07510002 L R2,OPENMOD GET IGC0002H ADDRESS @YL026UD 07520002 BALR BALREG1,R2 EXTEND @YL026UD 07522002 * 07524002 L BALREG1,SVBALREG RESTORE SAVED BALREG1 @YL026UD 07526002 CH R15,H08 NO MORE EXTENDS? 07530002 BCR 8,BALREG1 RETURN IF YES 07540002 * 07550002 LCR R1,R15 CHECK RETURN CODE 07560002 * 07570002 BNZ IGG0CLC7 BRANCH IF DID NOT EXTEND 07580002 B EXCP1 RE-ISSUE REQUEST 07590002 DROP R1 07600002 EJECT 07610002 * 07620002 **************** 07630002 * * 07640002 MOVELVL EQU * 07650002 * * 07660002 **************** 07670002 * 07680002 * FUNCTION: 07690002 * TO PUT THE CURRENT LEVEL NAME INTO THE 'NAME' WORKAREA LOCATION 07700002 * 07710002 * INPUT: 07720002 * 1) RETURN ADDRESS IN BALREG1 07730002 * 2) CURRENT LEVEL NUMBER IN REGISTER 'LEVEL' 07740002 * 07750002 * OUTPUT: 07760002 * 1) CURRENT LEVEL IN 'NAME' 07770002 * 2) REGISTER 'LEVEL' DECREMENTED BY 1 07780002 * 07790002 * DESTROYED: 07800002 * 1) REGISTERS - R1,R2, AND R15 07810002 * 07820002 *************** 07830002 *************** 07840002 * 07850002 MVI NAME,CCDBLANK INSERT BLANK 07860002 MVC NAME+1(L'NAME-1),NAME BLANK NAME 07870002 LA R15,0(LEVEL,LEVEL) DOUBLE LEVEL 07880002 * SET R15 POINT TO THE DATA FOR THE LEVEL INDICATED BY 'LEVEL' 07890002 LA R15,NAMTABLE(R15) 07900002 XR R1,R1 CLEAR R1 07910002 IC R1,0(R15) GET DISPLACEMENT 07920002 L R2,CAMPTR1 GET POINTER NAME 07930002 AR R2,R1 POINT TO LEVEL NAME 07940002 IC R1,D01(R15) GET LENGTH 07950002 EX R1,MOVELVLN MVC NAME(0),0(R2) 07960002 BR BALREG1 RETURN TO CALLER 07970002 TITLE 'IGG0CLCD - (IGG0CLC4) ENTRY BUILDING' @YL026UD 09280002 *********************************************************************** 09290002 * * 09300002 * IGG0CLC4 - ENTRY BUILDING * 09310002 * * 09320002 *********************************************************************** 09330002 * @YL026UD 09340002 IGG0CLC4 EQU * @YL026UD 10160002 * 10162002 DROP R3 10172002 DROP R5 10182002 * 10184002 USING WORKAREA,R6 10186002 USING CAMLSTD,R8 10188002 * 10192002 OI MODMAP1,MODCLC4 INDIC ENTRY TO IGG0CLC4 10210002 * 10220002 * INITIALIZE 10230002 * 10240002 L GIPE,FOUNDENT SET BASE TO GIPE IF PRESENT 10250002 * 10260002 * SAVE LENGTH OF ALL LEVELS OUT TO THE LAST LEVEL OF THE DATA 10270002 * SET NAME IN CASE OF AN EVENTUAL SCRATCH. 10280002 * 10290002 * TEST THE FUNCTION REQUESTED FOR CONSISTENCY WITH WHETHER OR NOT 10300002 * THIS ENTRY WAS FOUND IN PHASE I. 10310002 * 10320002 CLI ERRLOCSV,ERROR00 WAS THE ENTRY FOUND? 10330002 BE FOUND YES 10340002 * 10350002 * ENTRY NOT FOUND, CHECK FOR ALLOWABLE FUNCTIONS, CAT & CATBX. 10360002 * 10370002 TM CAMOPTN1,CAMCAT IS FUNCTION CAT? 10380002 BO CATRTN YES 10390002 * 10400002 * FUNCTION IS NOT COMPATIBLE WITH LOCATE RETURN CODE. 10410002 * 10420002 B ERR08 NO 10430002 * 10440002 * 10450002 FOUND EQU * 10460002 * 10470002 * ENTRY FOUND, CHECK FOR ALLOWABLE FUNCTIONS, RECAT & UNCAT 10480002 * 10490002 TM CAMOPTN1,CAMUNCAT IS FUNCTION UNCAT? 10500002 BO ALTERTN YES 10510002 * 10520002 OI FLAG1,RECATF SET RECAT SWITCH IN CASE 10530002 TM CAMOPTN1,CAMRECAT IS FUNCTION RECAT? 10540002 BO ALTERTN YES 10550002 * 10560002 * FUNCTION REQUESTED IS NOT COMPATIBLE WITH LOCATE RETURN CODE. 10570002 * 10580002 B ERR08 ERROR EXIT 10590002 * 10600002 EJECT 10610002 * 10620002 CATRTN EQU * 10630002 * 10640002 * FUNCTION IS CAT OR CATBX 10650002 * 10660002 * 1. COMPARE LEVELS GIVEN AND LEVELS FOUND. 10670002 * 10680002 * . (GIVEN)-(FOUND)=0, CATALOG ERROR CODE=8. 10690002 * 10700002 * . (GIVEN)-(FOUND)=1, FUNCTION IS CAT. 10710002 * 10720002 * . (GIVEN)-(FOUND)=2 OR MORE, DO 2. 10730002 * 10740002 * 2. CHECK FUNCTION. 10750002 * 10760002 * . IF FUNCTION IS NOT CATBX, CATALOG ERROR CODE = 8. 10770002 * 10780002 * . IF FUNCTION IS CATBX, DO 3A OR 3B. 10790002 * 10800002 * 3A. IF A DSPE IS REQUIRED (FOR 5 OR FEWER VOLUMES), THE ENTRY 10810002 * IS BUILT AND CONTROL IS PASSED TO IGG0CLC3 FOR THE BUILDING 10820002 * OF MISSING INDEX LEVELS. 10830002 * 10840002 * 3B. IF A VCBPE IS REQUIRED (FOR 6 OR MORE VOLUMES), THE ENTRY 10850002 * IS BUILT WITHOUT THE TTR FIELD AND CONTROL IS PASSED TO 10860002 * IGG0CLC5 FOR THE BUILDING OF REQUIRED VCB'S. 10870002 * 10880002 * COMPARE LEVELS GIVEN WITH LEVELS FOUND. 10890002 * 10900002 LH LEVEL2,NAMLG GET NUMBER OF LEVELS GIVEN 10910002 SH LEVEL2,NAMLF SUBTRACT NUMBER FOUND 10920002 BNP ERR08 DIFFERENCE=0 10930002 * 10940002 BCTR LEVEL2,0 MINUS ONE 10950002 LTR LEVEL2,LEVEL2 RESULT ZERO? 10960002 BZ CATNOBLD YES, DIFFERENCE=1 10970002 * 10980002 * DIFFERENCE IS 2 OR MORE, CHECK FUNCTION 10990002 * 11000002 TM FLAG1,CATBXF * IS FUNCTION CATBX? 11010002 BZ ERR16 NO 11020002 * 11030002 * FUNCTION IS CATBX. 11040002 * 11050002 BAL BALREG1,BLDENTRY BUILD ENTRY 11060002 TM FLAG3,BLVCB * MORE THAN 5 VOLUMES? 11070002 BO IGG0CLC5 YES, GO BUILD VCBS 11080002 * 11090002 L R5,SVRBEXTP RESTORE BASE FOR CLC3 11092002 B IGG0CLC3 NO, GO BUILD INDEX LEVELS 11100002 * 11110002 EJECT 11120002 * 11130002 CATNOBLD EQU * 11140002 * 11150002 * 11160002 * CHANGE CATBX FUNCTION TO CAT FUNCTION. 11170002 * 11180002 NI FLAG1,CATBXFC * TURN OFF CATBXF 11190002 * 11200002 CATONLY EQU * 11210002 * 11220002 * FUNCTION IS CAT 11230002 * 11240002 * THE LAST BLOCK BLDL SEARCHED IS AT INPUT 11250002 * 11260002 TM FLAG2,GDGSW GENERATION DATA SET? 11270002 BZ CULMINAT NO 11280002 * 11290002 * DATA SET NAME IS IN COMPLIMENT FORM (FROM IGG0CLC2) AT NAME 11300002 * 11310002 BAL BALREG1,SETUP SET POINT AND LAST 11320002 * 11330002 CATCMPR EQU * 11340002 * 11350002 USING ENTRY,POINT ESTABL ADDRBLTY TO ENTRY 11360002 CLC EGENNO,GENNO DO THE ABSOL NUMBERS MATCH? 11370002 BNE CATRTN1 NO, GO LOOK AT NEXT ENTRY 11380002 * 11390002 CLC ENAME,NAME ARE THE NAMES IDENTICAL? 11400002 BNE ALTER NO, SET RECAT YA00092 11402002 MVI ERRLOCSV,ERROR00 YES,ZERO LOCATE CODE YA00092 11404002 * IN CASE NON-ZERO VERSION YA00092 11406002 BE ERR08 DUPLICATE NAME 11410002 * 11420002 ALTER OI FLAG1,RECATF * SET RECAT FLAG YA00092 11430002 B ALTERTN GO TO ALTER ROUTINE 11440002 * 11450002 * 11460002 CATRTN1 EQU * 11470002 * 11480002 LR R1,POINT SAVE POINT TEMPORARILY 11490002 BAL BALREG1,INCR INCREMENT 'POINT' 11500002 CR POINT,LAST ANY MORE ENTRIES? 11510002 BL CATCMPR YES 11520002 * 11530002 DROP POINT 11540002 USING ENTRY,GIPE ESTABL ADDRBLTY TO GIPE 11550002 CLC EGMAXSIZ,EGCURSIZ+1 IS GROUP FULL? 11560002 BNH OPTION YES, GO PROCESS OPTIONS @OZ14792 11570037 * 11580002 * ADD 1 TO GENERATION COUNT AND INDICATE A WRITE FOR IGG0CLC5 11590002 * 11600002 LH R1,EGCURSIZ GET CURRENT SIZE OF GROUP 11610002 LA R1,D01(R1) ADD ONE 11620002 STH R1,EGCURSIZ UPDATE IN-CORE GIPE 11630002 OI FLAG3,WRBLK * TURN ON WRITE BLOCK FLAG 11640002 BAL BALREG1,BLDENTRY BUILD ENTRY 11650002 B IGG0CLC5 GO WRITE BLOCK WITH UPDATED GIPE 11660002 * 11670002 EJECT 11680002 * 11690002 OPTION EQU * 11700002 * 11710002 * GROUP IS FULL. IF NEW ENTRY HAS GENERATION NUMBER GREATER 11720002 * THAN THE GREATEST IN THE GROUP, THE NEW ENTRY WILL NOT BE ADDED. 11730002 * 11740002 DROP GIPE 11750002 USING ENTRY,R1 POINT WAS SAVED IN R1 11760002 CLC EGENNO,GENNO IS NEW ENTRY OLDER THAN LAST? 11770002 BL ERR24 YES, RETURN TO ISSUER OF SVC 26 11780002 * 11790002 DROP R1 11800002 USING ENTRY,GIPE ESTABL ADDRBLTY TO GIPE 11810002 * 11820002 * NAMED ENTRY WILL BE ADDED TO GENERATION DATA GROUP. 11830002 * GROUP IS FULL AND OPTIONS MUST BE PROCESSED. 11840002 * 11850002 TM EGFLAGS,EGEMPTY EMPTY SPECIFIED? 11860002 BNO REMOVLST NO, REMOVE ONLY LAST ENTRY 11870002 * 11880002 * EMPTY OPTION WAS SPECIFIED. 11890002 * 11900002 MVI EGCURSIZ+1,X01 UPDATE GIPE 11910002 OI FLAG3,EMPTY+WRBLK * SET EMPTY & WRITE BLOCK FLAG 11920002 TM EGFLAGS,EGDELETE DELETE SPECIFIED? 11930002 BZ CULMINAT NO 11940002 * 11950002 * START AT THE BEGINNING OF THE GENERATION DATA GROUP AND 11960002 * SCRATCH ALL DATA SETS, READING NEW BLOCKS AS NECESSARY. 11970002 * 11980002 CLC ETTR,READTTR TTR IN GIPE = TTR OF 'INPUT'? 11990002 BE NOREAD YES 12000002 * 12010002 MVC READTTR(L'ETTR),ETTR GET TTR FROM GIPE 12020002 * 12030002 READ EQU * 12040002 * 12050002 BAL BALREG4,GET ***READ BLOCK INTO INPUT*** 12060002 * 12070002 NOREAD EQU * 12080002 * 12090002 BAL BALREG1,SETUP SETUP 'POINT' AND 'LAST' 12100002 * 12110002 RECUR EQU * 12120002 * 12130002 BAL BALREG1,SCRATCH SCRTCH ALL VOLS OF DS AT 'POINT' 12140002 BAL BALREG1,INCR BUMP 'POINT' TO NEXT ENTRY 12150002 CR POINT,LAST POINTING TO THE ILE? 12160002 BL RECUR NOT YET 12170002 * 12180002 DROP GIPE 12190002 USING ENTRY,POINT ESTABL ADDRBLTY TO ENTRY 12200002 NC ETTR,ETTR ANOTHER BLOCK IN CHAIN? 12210002 BZ CULMINAT NO 12220002 * 12230002 MVC READTTR(L'ETTR),ETTR GET TTR FROM ILE 12240002 B READ GO READ THE NEXT BLOCK 12250002 * 12260002 EJECT 12270002 * 12280002 REMOVLST EQU * 12290002 * 12300002 * STORE READTTR FOR POSSIBLE USE BY WRLSTRTN IN C5 YA00091 12302002 * IF WE NOW HAVE THE LAST BLOCK YA00091 12304002 * YA00091 12306002 MVC SAVETTR3,READTTR SAVE TTR OF BLK TO BE UPDATED 12308002 * YA00091 12308402 CLC ILSTBLK,READTTR ALREADY HAVE THE LAST BLOCK? 12310002 BE FINDLAST YES, GO SCAN IT FOR LAST ENTRY 12320002 * 12330002 MVC READTTR(L'ILSTBLK),ILSTBLK NO, GET TTR OF LAST BLOCK 12350002 BAL BALREG4,GET ***READ BLOCK INTO INPUT*** 12360002 * 12370002 FINDLAST EQU * 12380002 * 12390002 * ADJUST 'POINT' TO POINT TO ENTRY JUST PRECEDING THE INDEX LINK 12400002 * ENTRY IN 'INPUT'. 12410002 * 12420002 BAL BALREG1,SETUP SET UP 'POINT' AND 'LAST' 12430002 * SA52084 12440002 * IF 'POINT' AND 'LAST' ARE EQUAL THEN THE BLK IS EMPTY, SA52084 12450002 * SO DO NOT SCAN THE BLK NOR DELETE THE LAST ENTRY. SA52084 12460002 * SA52084 12470002 CR POINT,LAST EQUAL? SA52084 12480002 BE SETFLG3 BRANCH IF YES SA52084 12490002 * 12500002 FINDSCAN EQU * 12510002 * 12520002 * SCAN BLOCK FOR THE LAST ENTRY. LENGTH WILL CONTAIN LENGTH OF 12530002 * ENTRY JUST PRECEDING INDEX LINK ENTRY. 12540002 * 12550002 CR POINT,LAST THERE YET? 12560002 BNL FINDED YES 12570002 * 12580002 BAL BALREG1,INCR BUMP POINT TO NEXT ENTRY 12590002 B FINDSCAN CHECK AGAIN 12600002 * 12610002 * 12620002 FINDED EQU * 12630002 * 12640002 * POINT POINTS TO LAST ENTRY (ILE) AND LENGTH CONTAINS THE LENGTH 12650002 * OF THE PRECEDING ENTRY. 12660002 * SUBTRACT LENGTH FROM POINT TO FIND THE LAST NON-'FF' ENTRY IN 12670002 * THE BLOCK. 12680002 * 12690002 SR POINT,LENGTH BACKUP ONE ENTRY 12700002 USING ENTRY,POINT EST. ADDRBLTY TO ENTRY SA55225 12710002 * SA55225 12720002 * CHECK FOR ANY DELETABLE VCBS SA55225 12730002 * SA55225 12740002 CLI ETYPE,VCBPETYP VCBPE? SA55225 12750002 BNE TESTDLT BRANCH IF NO SA55225 12760002 * SA55225 12770002 * SET FLAG AND TTR FOR MODULE SA55225 12780002 * IGG0CLC5 TO DELETE THE VCBS SA55225 12790002 * SA55225 12800002 OI FLAG3,FRVCB * SET FREE VCB FLAG SA55225 12810002 MVC DELTTR3(L'ETTR),ETTR SAVE VCB CHAIN PTR SA55225 12820002 * SA55225 12830002 * SA55225 12840002 TESTDLT EQU * SA55225 12850002 * SA55225 12860002 DROP POINT 12870002 USING ENTRY,GIPE EST ADDRBLTY TO GIPE 12880002 TM EGFLAGS,EGDELETE DELETE SPECIFIED? 12890002 BZ DONTSCR NO 12900002 * 12910002 BAL BALREG1,SCRATCH SCRATCH ALL VOLS OF LAST ENTRY 12920002 * 12930002 DONTSCR EQU * 12940002 * 12950002 DROP GIPE 12960002 USING ENTRY,POINT REESTABL PRIOR ADDRBLTY 12970002 MVC EINDEX,0(LAST) MOVE ILE OVER LAST ENTRY 12980002 LCR LENGTH,LENGTH PREPARE TO SUBTRACT 12990002 AH LENGTH,INBYTSU DECREMENT BYTES USED BY LENGTH 13000002 STH LENGTH,INBYTSU UPDATE IN-CORE BYTES USED FIELD 13010002 * SA52084 13020002 * SA52084 13030002 SETFLG3 EQU * SA52084 13040002 * SA52084 13050002 OI FLAG3,WRLST * SET WRITE LAST FLAG 13060002 B CULMINAT GO BUILD ENTRY @YL026UD 13070002 * 13080002 EJECT 13090002 * 13100002 ALTERTN EQU * 13110002 * 13120002 * ALTER ROUTINE PROCESSES RECAT & UNCAT REQUESTS 13130002 * 13140002 * CHECK FOR ANY DELETABLE VCBS 13150002 * 13160002 CLI TYPEB,VCBPETYP VCBPE FOUND? 13170002 BNE VCBSNONE NO 13180002 * 13190002 MVC DELTTR3(L'TTR),TTR GET VCB CHAIN POINTER 13200002 OI FLAG3,FRVCB * SET FREE VCB FLAG 13210002 * 13220002 * STARTING TTR OF VCB CHAIN IS IN DELTTR3 AND FRVCB FLAG IS ON 13230002 * FOR IGG0CLC5, AS AN INDICATION TO DELETE THOSE VCBS. 13240002 * 13250002 VCBSNONE EQU * 13260002 * 13270002 * CHECK FUNCTION 13280002 * 13290002 TM CAMOPTN1,CAMUNCAT REQUESTED FUNCTION UNCAT? 13300002 BO CHEKGDG YES 13310002 * 13320002 TM FLAG1,RECATF * REQUESTED FUNCTION RECAT? 13330002 BNO ERR08 NO 13340002 * 13350002 * FUNCTION IS RECAT, BUILD A NEW ENTRY. 13360002 * 13370002 B CULMINAT GO BUILD ENTRY @YL026UD 13380002 * 13390002 * 13400002 CHEKGDG EQU * 13410002 * 13420002 * FUNCTION IS UNCAT 13430002 * CHECK FOR GDG OR NON-GDG, FOR GIPE PROCESSING 13440002 * 13450002 TM FLAG2,GDGSW * GDG PROCESSING? 13460002 BNO NEXTLOAD NO 13470002 * 13480002 * ESTABLISH ADDRESSABILITY TO THE GIPE 13490002 * 13500002 DROP POINT 13510002 USING ENTRY,GIPE ESTABL ADDRBLTY TO GIPE 13520002 * 13530002 * UPATE GIPE & INDICATE NEED TO WRITE IT 13540002 * 13550002 LH R1,EGCURSIZ GET CURRENT SIZE OF GROUP 13560002 BCTR R1,0 MINUS ONE 13570002 STH R1,EGCURSIZ UPDATE IN-CORE CURRENT SIZE 13580002 OI FLAG3,WRBLK * SET WRITE BLOCK FLAG 13590002 * 13600002 * BLOCK IS IN 'OUTPUT' & ITS TTR IS IN 'WRITETTR' 13610002 * 'WRBLK' SWITCH IS SET FOR IGG0CLC5 13620002 * 13630002 DROP GIPE 13640002 B IGG0CLC5 BRANCH TO IGG0CLC5 @YL026UD 13650002 * 13660002 EJECT 13670002 * 13680002 CULMINAT EQU * 13690002 * 13700002 * BUILD THE REQUIRED ENTRY AND BRANCH TO THE APPROPRIATE MODULE. 13710002 * 13720002 BAL BALREG1,BLDENTRY GO BUILD ENTRY 13730002 * 13740002 NEXTLOAD EQU * 13750002 * 13760002 * THE NEXT MODULE IS DETERMINED BY WHETHER OR NOT SPECIAL 13770002 * PROCESSING IS REQUIRED. IF IT IS, IGG0CLC5 IS BRANCHED TO 13780002 * TO FREE AND WRITE ANY VCB'S, WRITE ANY NEW INDEX @YL026UD 13790002 * BLOCKS, AND PROCESS EMPTY REQUESTS. 13800002 * 13810002 * IF NO SPECIAL PROCESSING IS REQUIRED, IGG0CLC5 IS 13820002 * BYPASSED AND IGG0CLC6 IS THE NEXT MODULE TO RECEIVE CONTROL. 13830002 * 13840002 TM FLAG3,WRBLK+FRVCB+BLVCB+WRLST+EMPTY * NEED IGG0CLC5? 13850002 BZ IGG0CLC6 NO 13860002 * 13870002 B IGG0CLC5 YES 13880002 * 13890002 EJECT 13900002 * 13910002 **************** 13920002 * * 13930002 TOABSL2 EQU * 13940002 * * 13950002 **************** 13960002 * 13970002 * FUNCTION: 13980002 * CONVERT THE TTR0 IN R0 TO AN ABSOLUTE DASD ADDRESS AND 13990002 * PUT IT INTO THE IOB MBBCCHHR 14000002 * 14010002 * INPUT: 14020002 * R0 IS THE TTR0 TO BE CONVERTED 14030002 * RETURN ADDRESS IN BALREG2 14040002 * 14050002 * OUTPUT: 14060002 * ABSOLUTE DASD ADDRESS IN IOB 14070002 * ERROR CODE IN R15 14080002 * 14090002 * DESTROYED: 14100002 * REGISTERS - R0,R1,R2,R14, AND R15=0 14110002 * WA - SAVEAREA AND MBBCCHHR OF THE IOB 14120002 * 14130002 * SUBROUTINES USED: 14140002 * THE RESIDENT CONVERT ROUTINE - IECPCNVT 14150002 * 14160002 * 14170002 *** 14180002 * 14190002 L R15,EPTOABSL GET EP TO 'IECPCNVT' 14200002 STM R9,R13,SAVEAREA SAVE REGS DESTROYED BY CONVERT 14210002 L R1,DEBADDR GET DEB ADDRESS 14220002 LA R2,IOBSKADD POINT TO MBBCCHHR 14230002 BALR BALREG1,R15 GO TO CONVERT 14240002 LM R9,R13,SAVEAREA RESTORE REGISTERS 14250002 BR BALREG2 RETURN 14260002 * 14270002 EJECT 14280002 * 14290002 **************** 14300002 * * 14310002 IO2 EQU * 14320002 * * 14330002 **************** 14340002 * 14350002 * FUNCTION: 14360002 * 1. IF THE DEVICE HAS THE RPS FEATURE, THE SET SECOTR CCW IS 14370002 * UPDATED. 14380002 * 2. ISSUE EXCP FOR THE CHANNEL PROGRAM POINTED TO BY THE JOB. 14390002 * 3. WAIT FOR THE OPERATION TO COMPLETE AND CHECK THE ECB. 14400002 * 4. IF AN END OF EXTENT CONDITION, BRANCH TO IGC0002H @YL026UD 14410002 * AND EXTEND THE CATALOG. @YL026UD 14420002 * 5. IF A PERMANENT I/O ERROR, SET AN ERROR CODE AND BRANCH TO 14430002 * IGG0CLC7. 14440002 * 14450002 * INPUT: 14460002 * UPDATED CHANNEL PROGRAM 14470002 * RETURN ADDRESS IN BALREG 1 14480002 * 14490002 * OUTPUT: 14500002 * 1. FILLED BUFFER 14510002 * 2. EMPTIED BUFFER 14520002 * 3. ANOTHER FREE BLOCK ADDRESS 14530002 * 14540002 * DESTROYED: 14550002 * REGISTERS R0,R1,R15 (IF EXTENDS), AND ERRCAT 14560002 * 14570002 * EXTERNAL ROUTINES USED: 14580002 * EXCP, WAIT, IGC0002H TO EXTEND CATALOG @YL026UD 14590002 * 14600002 * EXITS: 14610002 * IGG0CLC7 FOR PERMANENT I/O ERROR 14620002 *** 14630002 * 14640002 USING RPSD,R1 ESTABL BASE TO RPS WORKAREA 14650002 TM FLAG2,RPSDEV RPS FEATURE? 14660002 BZ EXCP2 BRANCH IF NO 14670002 * 14680002 L R1,RPSAVEP GET RPS SAVE AREA PTR 14690002 STM R9,R2,RPSAVE SAVE REGS DESTROYED BY CONVERT 14700002 LM R15,R2,RPSINPUT GET THETA CONVERT INPUT PARMS 14710002 IC R0,IOBSKADD+7 GET R OF CCHHR 14720002 BALR BALREG1,R15 GO TO CONVERT R TO THETA 14730002 LM R9,R2,RPSAVE RESTORE REGISTERS 14740002 * 14750002 EXCP2 EQU * 14760002 * 14770002 EXCP IOB ISSUE EXCP 14780002 WAIT ECB=ECB WAIT FOR REQUEST 14790002 CLI ECB,X7F I/O ERROR? 14800002 BCR 8,BALREG1 BRANCH IF NO 14810002 * 14820002 B ERR28 ERROR EXIT 14830002 * 14840002 DROP R1 14850002 * 14860002 EJECT 14870002 * 14880002 **************** 14890002 * * 14900002 GET EQU * 14910002 * * 14920002 **************** 14930002 * 14940002 * FUNCTION: 14950002 * CONVERTS READTTR INTO AN ABSOLUTE ADDRESS AND READS THE BLOCK 14960002 * AT THAT ADDRESS INTO INPUT. 14970002 * INPUT: 14980002 * READTTR,BALREG3 IS RETURN REGISTER 14990002 * OUTPUT: 15000002 * INDEX BLOCK AT INPUT,MBBCCHHR OF BLOCK AT MBBCCHHR 15010002 * DESTROYED: 15020002 * BALREG2,R0,OPTNCCW 15030002 * SUBROUTINES USED: 15040002 * TOABSL,IO 15050002 *** 15060002 * 15070002 L R0,READTTR GET TTR FOR CONVERSION 15080002 BAL BALREG2,TOABSL2 CONVERT FOR IO 15090002 MVC OPTNCCW,RD MOVE READ DATA CCW 15100002 BAL BALREG1,IO2 READ 256 BYTE BLOCK INTO 'INPUT' 15110002 BR BALREG4 RETURN 15120002 * 15130002 EJECT 15140002 * 15150002 **************** 15160002 * * 15170002 SETUP EQU * 15180002 * * 15190002 **************** 15200002 * 15210002 * FUNCTION: 15220002 * SETS TWO REGISTERS, POINT AND LAST, TO POINT TO THE FIRST ENTRY 15230002 * IN INPUT AND THE LAST ENTRY IN INPUT, RESPECTIVELY. 15240002 * INPUT: 15250002 * INBLKSZ,H12,BALREG1 IS RETURN REGISTER 15260002 * OUTPUT: 15270002 * POINT,LAST 15280002 * DESTROYED: 15290002 * NOTHING 15300002 * SUBROUTINES USED: 15310002 * NONE 15320002 *** 15330002 * 15340002 LA POINT,INENTRY ADDRESS OF FIRST ENTRY 15350002 LA LAST,INBYTSU ADDR OF HALFWORD BLOCK SIZE 15360002 AH LAST,INBYTSU POINT TO END OF ILE 15370002 SH LAST,H12 SUBTRACT LENGTH OF ILE 15380002 BR BALREG1 RETURN 15390002 * 15400002 EJECT 15410002 * 15420002 **************** 15430002 * * 15440002 INCR EQU * 15450002 * * 15460002 **************** 15470002 * 15480002 * FUNCTION: 15490002 * ADJUSTS POINT TO POINT TO THE NEXT ENTRY IN INPUT 15500002 * INPUT: 15510002 * ETYPE,POINT,BALREG1 IS RETURN REGISTER 15520002 * OUTPUT: 15530002 * POINT,LENGTH 15540002 * DESTROYED: 15550002 * NOTHING 15560002 * 15570002 *** 15580002 * 15590002 USING ENTRY,POINT ESTABL BASE FOR ENTRY 15600002 SR LENGTH,LENGTH ZERO LENGTH 15610002 IC LENGTH,ETYPE PICK UP ENTRY TYPE 15620002 * 15630002 * TOTAL LENGTH OF THE ENTRY IS 12 + 2*(ETYPE) 15640002 * 15650002 LA LENGTH,D12(LENGTH,LENGTH) CALCULATE LENGTH 15660002 AR POINT,LENGTH ADJUST POINT 15670002 BR BALREG1 POINT IS AT NEXT ENTRY 15680002 * 15690002 DROP POINT 15700002 * 15710002 EJECT 15720002 * 15730002 **************** 15740002 * * 15750002 BLDENTRY EQU * 15760002 * * 15770002 **************** 15780002 * 15790002 * FUNCTION: 15800002 * BUILDS AN ENTRY TO REPRESENT THE DATA SET LEVEL OF A QUALIFIED 15810002 * NAME. 15820002 * 1. IF A VCB IS REQUIRED, A VCBPE IS BUILT. SINCE THIS MODULE 15830002 * DOES NOT WRITE IN THE SYSCTLG DATA SET, A SWITCH (BLVCB) 15840002 * IS TURNED ON TO INDICATE TO PHASE III THAT A CHAIN OF VCB'S 15850002 * REQUIRE BUILDING. 15860002 * 2. IF A VCB IS NOT REQUIRED, A DSPE IS BUILT. IF THE NUMBER 15870002 * OF VOLUMES IS ONE, THE DSCBTTR OPTION IS PROCESSED. 15880002 * N.B. IF THE FUNCTION IS CATBX AND CONTROL IS RETURNING TO 15890002 * CLC3, THE VOLUME LIST IS NOT APPENDED TO THE ENTRY AT THIS 15900002 * POINT, BECAUSE NAMTABLE MUST BE PRESERVED. 15910002 * THE ENTRY IS BUILT STARTING AT NAME IN THE WORKAREA AND CONTINUING 15920002 * THRU AS MANY BYTES AS ARE NECESSARY, NOT OVER 74. 15930002 * INPUT: 15940002 * BITS USED AS SWITCHES ARE DESIGNATED "BYTE(BIT,BIT,...)" 15950002 * CAMPTR3,H06,CAMDSCBP,VOLUME LIST,CAMOPTN2(CAMDSCBT),MOVE1, 15960002 * FLAG1(CATBXF),CAMOPTN1(CAMRECAT),BALREG1 IS RETURN REGISTER 15970002 * OUTPUT: 15980002 * BITS SET AS SWITCHES ARE DESIGNATED "BYTE(BIT,BIT,...)" 15990002 * TTR,TYPE, VOLCNT,DATA,FLAG3(BLVCB) 16000002 * 16010002 * DESTROYED: 16020002 * R1,R2 16030002 * 16040002 * SUBROUTINES USED: 16050002 * NONE 16060002 *** 16070002 * 16080002 * DECIDE WHAT TYPE OF ENTRY TO BUILD, VCBPE OR DSPE. 16090002 * 16100002 L R1,CAMPTR3 POINT TO VOLUME LIST 16110002 LH TALLY,0(R1) GET THE COUNT 16120002 * SA53641 16130002 LTR TALLY,TALLY SA53641 16140002 BNP ERR08 SA53641 16150002 * SA53641 16160002 CH TALLY,H06 VCB REQUIRED? 16170002 BL BLDDSPE GO BUILD DSPE 16180002 * 16190002 * VCB'S ARE REQUIRED. INDICATE SO FOR PHASE III. 16200002 * 16210002 MVI TYPE,VCBPETYP MOVE IN ENTRY TYPE 16220002 XC VOLCNT,VOLCNT CLEAR LAST HFWD OF ENTRY 16230002 OI FLAG3,BLVCB INDIC NEED TO BUILD VCBS 16240002 BR BALREG1 RETURN 16250002 * 16260002 * 16270002 BLDDSPE EQU * 16280002 * 16290002 * DSPE IS REQUIRED. 16300002 * 16310002 * CALCULATE NUMBER OF HALFWORDS REQUIRED TO CONTAIN VOLUME LIST; 16320002 * (NO. OF HALFWORDS) = 6*(NO. OF VOLUMES) + 1 16330002 * 16340002 * RESULT GOES IN THE TYPE FIELD OF THE ENTRY. 16350002 * 16360002 MH TALLY,H06 MULTIPLY BY 6 16370002 LA TALLY,D01(TALLY) ADD ONE 16380002 STC TALLY,TYPE MOVE IN THE ENTRY TYPE 16390002 * 16400002 * DECIDE WHETHER OR NOT TO APPEND VOLUME LIST TO ENTRY. 16410002 * 16420002 TM FLAG1,CATBXF * IS FUNCTION CATBX? 16430002 BO BLDLATER YES, DON'T APPEND 16440002 * 16450002 * FUNCTION IS NOT CATBX. COMPLETE THE ENTRY. 16460002 * 16470002 SLL TALLY,1 DOUBLE NUMBER OF HALFWORDS 16480002 BCTR TALLY,0 MINUS ONE FOR EXECUTE 16490002 EX TALLY,MOVE1 MVC VOLCNT(0),0(R1) 16500002 * 16510002 BLDLATER EQU * 16520002 * 16530002 * CHECK FOR DSCBTTR PROCESSING 16540002 * 16550002 CLI TYPE,DSPETYP ONLY ONE VOLUME? 16560002 BNE BLDCLEAR NO, DON'T PROCESS DSCBTTR OPTION 16570002 * 16580002 TM CAMOPTN2,CAMDSCBT DSCBTTR SPECIFIED? 16590002 BO BLDDSCBT YES 16600002 * 16610002 * DSCBTTR IS NOT SPECIFIED, SET TO ZERO SA52095 16620002 * 16630002 * 16640002 BLDCLEAR EQU * 16650002 * 16660002 * ZERO TTR FIELD AND RETURN 16670002 * 16680002 XC TTR,TTR 3 BYTES OF ZEROS IN TTR 16690002 BR BALREG1 ENTRY IS BUILT 16700002 * 16710002 * 16720002 BLDDSCBT EQU * 16730002 * 16740002 * TTR OF DSCB OF NAMED DATA SET IS SPECIFIED. 16750002 * 16760002 L R1,CAMDSCBP POINT TO 3 BYTE DSCBTTR 16770002 MVC TTR,0(R1) MOVE IN DSCBTTR 16780002 BR BALREG1 ENTRY IS BUILT 16790002 * 16800002 EJECT 16810002 * 16820002 **************** 16830002 * * 16840002 SCRATCH EQU * 16850002 * * 16860002 **************** 16870002 * 16880002 * FUNCTION: 16890002 * RELEASES SPACE ALLOCATED TO DATA SET NAMED AT POINT. MAY RESIDE 16900002 * ON MORE THAN ONE VOLUME. ROUTINE SCRATCHES UP TO 20 VOLUMES 16910002 * AT A TIME UNTIL ALL SPACE HAS BEEN RELEASED. 16920002 * INPUT: 16930002 * CAMPTR1, USER-PASSED DATA SET INDEX LEVELS, LASTLEV,MOVE2, 16940002 * POINT, ENTRY AT POINT, MASKFF, SCROPTN, VCB'S IF PRESENT. 16950002 * BALREG1 IS RETURN REGISTER 16960002 * OUTPUT: 16970002 * NOTHING 16980002 * DESTROYED: 16990002 * DSNAME,LEN,DSN,SCRPARM,R0,R1,R3,VCBMAIN,BALREGS,BALREG2 17000002 * SUBROUTINES USED: 17010002 * GETMAIN SERVICE ROUTINE, FREEMAIN SERVICE ROUTINE, TOABSL, 17020002 * IO, SCRATCH SERVICE ROUTINE. 17030002 *** 17040002 * 17050002 USING ENTRY,POINT ESTABL ADDRBLTY TO ENTRY 17060002 * 17070002 * SETUP PARAMETERS FOR SCRATCH 17080002 * 17090002 * BUILD THE NAME 17100002 * 17110002 MVI DSNAME,CCDBLANK MOVE IN A BLANK 17120002 MVC DSNAME+1(L'DSNAME-1),DSNAME CLEAR THE DSNAME AREA 17130002 L DSN,CAMPTR1 POINT TO NAME 17140002 XR LEN,LEN ZERO 'LEN' 17150002 IC LEN,INDEXLEN GET LNGTH OF ALL BUT LAST LVL 17160002 * 17170002 * MOVE ALL BUT LAST LEVEL INTO 'DSNAME', INCLUDING LAST DELIMITER 17180002 * 17190002 BCTR LEN,0 MINUS ONE FOR EXECUTE 17200002 EX LEN,MOVE2 MVC DSNAME(0),0(DSN) 17210002 * 17220002 * POINT TO WHERE LAST LEVEL WILL GO. '+1' IS TO CORRECT FOR 17230002 * BCTR ON LEN. 17240002 * 17250002 LA LEN,DSNAME+1(LEN) 17260002 TM ENAME,XFF ICE OR ILE? 17270002 BCR 11,BALREG1 YES, DON'T SCRATCH IT 17280002 * 17290002 MVC 0(L'ENAME,LEN),ENAME APPEND LAST LEVEL 17300002 DROP POINT 17310002 USING ENTRY,LEN ESTABL ADDRBLTY TO GEN DSPE 17320002 XC EGENNO,MASKFF COMPLIMENT GENERATION NUMBER 17330002 DROP LEN 17340002 USING ENTRY,POINT REESTABL ADDRBLTY 17350002 * 17360002 * BUILD THE SCRATCH CAMLST 17370002 * 17380002 TM CAMOPTN3,CAMTIOT IS TIOT ENQUED? @OZ19636 17390037 BZ SCROPTNA NO, BR TO CONTINUE @OZ19636 17390737 * 17391437 * TEST CALLER AUTHORIZATION @OZ19636 17391537 * 17391637 LR R9,R14 SAVE R14 @OZ19636 17391737 STM R0,R3,SVAREA4 SAVE REGS @OZ27009 17391837 TESTAUTH FCTN=1,STATE=YES,KEY=YES,BRANCH=YES,RBLEVEL=2 17391937 LR R14,R9 RESTORE R14 @OZ19636 17392237 LM R0,R3,SVAREA4 RESTORE REGS @OZ27009 17392437 LTR R15,R15 CALLER AUTHORIZED? @OZ19636 17392837 BNZ SCROPTNA NO, BR AROUND @OZ19636 17393537 L R0,SCROPTN2 SET TIOT ENQUED OPTION @OZ19636 17394237 * AND ALL OTHER SCRATCH OPTIONS 17394937 B SCROPTNB @OZ19636 17395637 SCROPTNA EQU * 17396337 L R0,SCROPTN GET OPTION BYTES 17397037 SCROPTNB EQU * 17397737 LA R1,DSNAME GET ADDR OF FULLY QUALIFIED NAME 17400002 STM R0,R1,SCRPARM FRST TWO WRDS OF SCRATCH CAMLST 17410002 * 17420002 * THIRD WORD OF SCRATCH CAMLST IS NOT USED. 17430002 * FOURTH WORD CONTAINS ADDRESS OF THE VOLUME LIST. 17440002 * 1. IF THE DATA SET RESIDES ON FROM 1 THRU 5 VOLUMES, THE 17450002 * ADDRESS OF THE VOLUME LIST IS EVOLCNT IN INPUT. 17460002 * 2. IF THE DATA SET RESIDES ON 6 OR MORE VOLUMES, THE ADDRESS 17470002 * OF THE VOLUME LIST IS THE ADDRESS OF A 256 BYTE GETMAIN 17480002 * AREA OBTAINED FOR THE PURPOSE OF READING VCB'S. 17490002 * 17500002 CLI ETYPE,VCBPETYP IS ENTRY A VCBPE? 17510002 BNE SCR1TO5 NO 17520002 * 17530002 * GETMAIN TO SERVE AS AN INPUT BUFFER 17540002 * 17550002 USING VCBD,VCBMAIN2 VCBMAIN2 EQU R11 17560002 LA R0,BLOCK GET SIZE OF AREA SA53664 17570002 GETMAIN R,LV=(0) 17580002 ST R1,SVVCBLK4 SAVE BLOCK PTR (ESTAE) @YL026UD 17582002 LR VCBMAIN2,R1 SET BASE FOR AREA 17590002 ST VCBMAIN2,SCRVOLS FOURTH WORD OF SCRATCH CAMLST 17600002 * 17610002 * SAVE RETURN SO THAT SCRATCHY CAN BE LINKED TO REPETITIVELY 17620002 * FROM THIS VCB PROCESSING PORTION. 17630002 * 17640002 ST BALREG1,BALREGS SAVE RETURN REG 17650002 * 17660002 * GET TTR OF FIRST VCB OF CHAIN FROM THE VCBPE 17670002 * 17680002 MVC SAVEAREA(L'ETTR),ETTR MOVE IT INTO A WORD 17690037 L R0,SAVEAREA PREPARE FOR CONVERT 17700002 IC R0,ZERO ZERO TYPE, ETTR IS 3-BYTE FIELD 17710002 * 17720002 * SETUP TO READ DATA INTO GETMAIN AREA 17730002 * 17740002 MVC OPTNCCW,RD MOVE IN CCW TO READ DATA 17750002 ST VCBMAIN2,OPTNCCW MOVE IN ADDRESS 17760002 MVI OPTNCCW,RDOP MOVE IN READ DATA OP-CODE 17770002 * 17780002 SCREAD EQU * 17790002 * 17800002 BAL BALREG2,TOABSL2 CONVERT TTR 17810002 BAL BALREG1,IO2 READ DATA INTO VCBMAIN 17820002 * 17830002 * SET VOLUME COUNT FOR SCRATCH 17840002 * 17850002 LA R0,D20 GET 20 FOR COMPARAND 17860002 CH R0,VCBVOLCT MORE VOLUMES THAN IN THIS LIST? 17870002 BNL SCRLAST NO, VOLUME COUNT IS GOOD 17880002 * 17890002 STH R0,VCBVOLCT YES, CORRECT SIZE OF LIST = 20 17900002 * 17910002 SCRLAST EQU * 17920002 * 17930002 * CALL 'SCRATCHY' FOR THIS LIST 17940002 * 17950002 BAL BALREG1,SCRATCHY SCRATCH A SET OF VOLUMES 17960002 * 17970002 * PREPARE FOR NEXT READ 17980002 * 17990002 L R0,VCBLNK GET TTR OF NEXT VCB 18000002 LTR R0,R0 IS THERE A NEXT BLOCK 18010002 BNZ SCREAD YES, GO READ IT 18020002 * 18030002 * END OF VCB CHAIN, FREEMAIN AND RETURN 18040002 * 18050002 LA R0,BLOCK GET THE SIZE OF THE AREA 18060002 LR R1,VCBMAIN2 GET THE ADDRESS OF THE AREA 18070002 XC SVVCBLK4(4),SVVCBLK4 RESET BLOCK PTR (ESTAE) @YL026UD 18072002 FREEMAIN R,LV=(0),A=(1) 18080002 L BALREG1,BALREGS RESTORE RETURN REG 18090002 BR BALREG1 RETURN 18100002 * 18110002 * 18120002 SCR1TO5 EQU * 18130002 * 18140002 * ENTIRE VOLUME LIST IS CONTAINED IN DSPE 18150002 * 18160002 LA R0,EVOLCNT POINT TO VOLUME LIST 18170002 ST R0,SCRVOLS FOURTH WORD OF SCRATCH CAMLST 18180002 * 18190002 SCRATCHY EQU * 18200002 * 18210002 * ISSUE SCRATCH MACRO & RETURN VIA BALREG1 18220002 * 18230002 SR R0,R0 ZERO 'R0' 18240002 SCRATCH SCRPARM 18250002 BR BALREG1 RETURN 18260002 * 18270002 DROP VCBMAIN2 18280002 DROP POINT 18290002 * 18300002 TITLE 'IGG0CLCD - (IGG0CLC5) FIRST LOAD OF UPDATE' @YL026UD 20000002 *********************************************************************** 20010002 * * 20020002 * IGG0CLC5 - FIRST LOAD OF UPDATE * 20030002 * * 20040002 *********************************************************************** 20050002 * @YL026UD 20060002 IGG0CLC5 EQU * @YL026UD 20940002 * 20942002 USING CAMLSTD,R8 20952002 USING WORKAREA,R6 20962002 OI MODMAP1,MODCLC5 INDIC ENTRY TO IGG0CLC5 20990002 TM FLAG1,ERRFULL * BEING ENTERED TO CLEAN UP? 21000002 BO ERRTN YES, GO DELETE INDEX STRUCTURE 21010002 * 21020002 * START THE UPDATE PROCESS. SINCE SYSCTLG IS GOING TO BE WRITTEN 21030002 * IN, OTHER TASKS IN THE REGION MUST BE NON-DISPATCHABLE. 21040002 * 21050002 USING SVRBEXTD,R1 ESTABL ADRBLTY TO SVRBEXT Y01965 21060002 L R1,SVRBEXTP POINT TO PARAMETER LIST 21070002 TM ENQFLAGS,SMCSTEP SMC ALREADY ISSUED? Y01965 21080002 BO SMCSKIP BRANCH IF YES Y01965 21090002 * Y01965 21100002 OI ENQFLAGS,SMCSTEP SET ENQ TO SMC Y01965 21110002 ENQ ,MF=(E,(1)) DISABLE STEP TASKS Y01965 21120002 DROP R1 Y01965 21130002 * Y01965 21140002 SMCSKIP EQU * Y01965 21150002 * Y01965 21160002 * 21170002 * CHECK0 21180002 * 21190002 * CHECK FOR REQUEST TO FREE INDEX LEVELS FOR UCATDX FUNCTION. 21200002 * 21210002 NC DELTTR1,DELTTR1 NEED TO FREE INDEX BLOCKS? 21220002 BZ CHECK1 NO 21230002 * 21240002 BAL BALREG3,FRNDXRTN YES, CALL FREE INDEX ROUTINE 21250002 B RESTORE GO MOVE BLK TO BE UPDTD TO INPUT 21260002 * 21270002 * 21280002 CHECK1 EQU * 21290002 * 21300002 * CHECK FOR REQUEST TO FREE A CHAIN OF VCB'S. 21310002 * 21320002 TM FLAG3,FRVCB * NEED TO FREE VCB'S? 21330002 BNO CHECK2 NO 21340002 * 21350002 BAL BALREG3,FRVCBRTN YES, CALL FREE VCB ROUTINE 21360002 * 21370002 CHECK2 EQU * 21380002 * 21390002 * CHECK FOR REQUEST TO FREE A BLOCK FOR DLTX FUNCTION. 21400002 * 21410002 TM FLAG3,FRBLK * NEED TO FREE BLOCK? 21420002 BNO CHECK3 NO 21430002 * 21440002 L R0,TTR0 GET ADDR OF BLOCK 21450002 BAL BALREG3,FRBLKRTN YES, CALL FREE BLOCK ROUTINE 21460002 * 21470002 CHECK3 EQU * 21480002 * 21490002 * CHECK FOR REQUEST TO WRITE THE BLOCK CONTAINING AN UPDATED GIPE. 21500002 * 21510002 TM FLAG3,WRBLK * NEED TO WRITE A BLOCK? 21520002 BNO CHECK4 NO 21530002 * 21540002 BAL BALREG3,WRBLKRTN YES, CALL WRITE BLOCK ROUTINE 21550002 * 21560002 CHECK4 EQU * 21570002 * 21580002 * CHECK FOR A REQUEST TO REWRITE THE NEW LAST BLOCK OF A CHAIN 21590002 * OF GENERATION DATA SET POINTERS 21600002 * 21610002 TM FLAG3,WRLST * NEED TO WRITE LAST? 21620002 BNO SAVE NO 21630002 * 21640002 BAL BALREG3,WRLSTRTN YES, CALL WRITE LAST ROUTINE 21650002 * 21660002 * 21670002 SAVE EQU * 21680002 * 21690002 * SAVE THE BLOCK IN INPUT BY MOVING IT TO OUTPUT AND ITS TTR 21700002 * FROM READTTR TO WRITETTR. 21710002 * 21720002 * IT MAY BE: 21730002 * 21740002 * 1. THE BLOCK TO BE UPDATED, IF WRLST IS NOT ON. THIS WILL 21750002 * BE PASSED TO THE NEXT LOAD OF UPDATE. 21760002 * 21770002 * 2. THE BLOCK WHICH WRLSTRTN WAS REQUESTED TO WRITE. 21780002 * 21790002 * IF WRLST IS ON AND THE BLOCK DOES NOT CONTAIN AN ICE, THE 21800002 * BLOCK WAS ACTUALLY WRITTEN AND THIS IS A MEANINGLESS MOVE. 21810002 * 21820002 * IF WRLST IS ON AND THE BLOCK DOES CONTAIN AN ICE, THE BLOCK 21830002 * WAS NOT WRITTEN AND THIS MOVE SAVES IT FOR THE NEXT LOAD OF 21840002 * UPDATE. 21850002 * 21860002 MVC OUTDATA,INDATA SAVE THE BLOCK 21870002 MVC WRITETTR,READTTR SAVE ITS TTR 21880002 XC READTTR,READTTR CLEAR READTTR 21890002 * 21900002 * CHECK5 21910002 * 21920002 * CHECK FOR REQUEST TO PROCESS EMPTY OPTION FOR A FULL GENERATION 21930002 * DATA GROUP. 21940002 * 21950002 TM FLAG3,EMPTY * NEED TO EMPTY GDG? 21960002 BNO RESTORE NO 21970002 * 21980002 BAL BALREG3,EMPTYRTN YES, CALL EMPTY ROUTINE 21990002 * 22000002 * 22010002 RESTORE EQU * 22020002 * 22030002 * MOVE BLOCK AND TTR BACK INTO INDATA 22040002 * 22050002 MVC INDATA,OUTDATA MOVE BLOCK BACK TO 'INDATA' 22060002 MVC READTTR,WRITETTR MOVE TTR BACK TO 'READTTR' 22070002 XC WRITETTR,WRITETTR CLEAR 'WRITETTR' 22080002 * 22090002 * 22100002 * CHECK6 22110002 * 22120002 * CHECK FOR REQUEST TO BUILD A CHAIN OF VCB'S. 22130002 * 22140002 TM FLAG3,BLVCB * NEED TO BUILD VCB'S? 22150002 BNO NXTLOAD NO 22160002 * 22170002 BAL BALREG3,BLVCBRTN YES, CALL BUILD VCB ROUTINE 22180002 * 22190002 NXTLOAD EQU * 22200002 * 22210002 TM FLAG1,CATBXF * REQUESTED FUNCTION CATBX? 22220002 BNO IGG0CLC6 NO, GO UPDATE 22224002 * 22226002 L R5,SVRBEXTP RESTORE BASE FOR CLC3 22228002 B IGG0CLC3 YES, GO BUILD NEEDED INDICES 22230002 * 22260002 EJECT 22270002 * 22280002 **************** 22290002 * * 22300002 WRBLKRTN EQU * 22310002 * * 22320002 **************** 22330002 * 22340002 * FUNCTION: 22350002 * WRITES THE BLOCK FROM OUTPUT AT THE ADDRESS IN WRITETTR. 22360002 * 22370002 * INPUT: 22380002 * OUTPUT,WRITETTR,BALREG3 IS RETURN REGISTER 22390002 * 22400002 * OUTPUT: 22410002 * NONE 22420002 * 22430002 * DESTROYED: 22440002 * R0,BALREG2,BALREG1,OPTNCCW 22450002 * 22460002 * SUBROUTINES USED: 22470002 * TOABSL,IO 22480002 *** 22490002 * 22500002 * 22510002 * WRITE THE BLOCK. 22520002 * 22530002 * IT IS IN 'OUTDATA' AND ITS TTR IS IN 'WRITETTR'. 22540002 * 22550002 L R0,WRITETTR GET WRITE ADDRESS 22560002 BAL BALREG2,TOABSL CONVERT IT 22570002 LA R0,OUTDATA GET ADDRESS OF BUFFER 22580002 MVC OPTNCCW,RD GET SKELETON CCW 22590002 ST R0,OPTNCCW MOVE IN ADDRESS 22600002 BAL BALREG2,WRITE ***WRITE DATA FROM OUTPUT*** 22610002 BR BALREG3 RETURN 22620002 * 22630002 EJECT 22640002 * 22650002 **************** 22660002 * * 22670002 WRLSTRTN EQU * 22680002 * * 22690002 **************** 22700002 * 22710002 * FUNCTION: 22720002 * WRITES THE LAST BLOCK OF A CHAIN OF DATA SET LEVEL POINTERS IN 22730002 * GENERATION DATA GROUP. IGG0CLC4 HAS PREVIOUSLY REMOVED THE 22740002 * LAST ENTRY TO MAKE ROOM IN THE GROUP FOR THE NEW ENTRY. 22750002 * IF THE LAST BLOCK IS ALSO THE FIRST BLOCK, IT IS SAVED FOR 22760002 * FURTHER UPDATING (IN THE ICE), TO BE DONE BY IGG0CLC7. 22770002 * 22780002 * INPUT: 22790002 * INPUT,READTTR,BALREG3 IS RETURN REGISTER. 22800002 * 22810002 * OUTPUT: 22820002 * NONE 22830002 * 22840002 * DESTROYED: 22850002 * POINT,R0,BALREG2,OPTNCCW 22860002 * 22870002 * SUBROUTINES USED 22880002 * TOABSL,IO 22890002 *** 22900002 * 22910002 * 22920002 * ESTABLISH ADDRESSABILITY FOR THE FIRST ENTRY IN THE BLOCK TO 22930002 * BE WRITTEN. IF THE FIRST ENTRY IS AN ICE, THE BLOCK WILL 22940002 * NOT BE WRITTEN; THE BLOCK IS SAVED SO THAT WHEN THE ICE 22950002 * IS UPDATED, A READ IS NOT REQUIRED. 22960002 * 22970002 LA POINT2,INENTRY GET ADDRESS OF FIRST ENTRY 22980002 USING ENTRY,POINT2 ESTABL ADDRBLTY TO ENTRY 22990002 CLI ETYPE,ICETYP IS ENTRY AN ICE? 23000002 BCR 8,BALREG3 YES, DO NOT WRITE THE BLOCK 23010002 * 23020002 * WRITE THE BLOCK. IT IS IN INPUT AND ITS TTR IS IN READTTR. 23030002 * 23040002 L R0,READTTR GET WRITE ADDRESS 23050002 BAL BALREG2,TOABSL CONVERT IT 23060002 MVC OPTNCCW,RD MOVE IN READ DATA CCW 23070002 BAL BALREG2,WRITE ***WRITE DATA FROM INPUT*** 23080002 MVC READTTR,SAVETTR3 SET TTR TO BLK TO BE UPDATED 23090002 OI FLAG3,NEEDBLK * SET FLAG SO C6 WILL READ BLK 23100002 BR BALREG3 RETURN 23110002 * 23120002 DROP POINT2 23130002 * 23140002 EJECT 23150002 * 23160002 **************** 23170002 * * 23180002 EMPTYRTN EQU * 23190002 * * 23200002 **************** 23210002 * 23220002 * FUNCTION: 23230002 * PROCESSES A REQUEST TO EMPTY A GENERATION DATA GROUP. 23240002 * 1. READS BLOCK. 23250002 * 2. REMOVES ALL VCB'S POINTED TO FROM BLOCK. 23260002 * 3. MOVES NEW ENTRY INTO FIRST BLOCK AND SAVES IT. 23270002 * 4. FREES BLOCK, IF NOT THE FIRST. 23280002 * 5. REPEATS 1 THRU 4 UNTIL END OF CHAIN AND GROUP IS EMPTIED. 23290002 * 23300002 * FIRST BLOCK IS SAVED FOR IGG0CLC7, WHICH UPDATES THE ICE 23310002 * AND WRITES THE BLOCK. 23320002 * 23330002 * INPUT: 23340002 * ICE,LNKENTRY,FLAG4(COMPLETE=0), NEW ENTRY AT NAME, BALREG3 23350002 * IS RETURN REGISTER. 23360002 * 23370002 * OUTPUT: 23380002 * OUTPUT,WRITETTR 23390002 * 23400002 * DESTROYED: 23410002 * BALREGS,DELTTR3=0,OPTNCCW,R0,BALREG2,BALREG1,LEN,LINKTTR=0, 23420002 * POINT,TARGET,SIZE,INPUT 23430002 * 23440002 * SUBROUTINES USED: 23450002 * TOABSL,IO,SETUP,FRVCBRTN,INCR,FRBLOK 23460002 *** 23470002 * 23480002 * 23490002 * ESTABLISH POINT AS A BASE REGISTER FOR INSPECTING ENTRIES. 23500002 * 23510002 USING ENTRY,POINT2 ESTABL ADDRBLTY TO ENTRY 23520002 ST BALREG3,BALREGS SAVE THE RETURN REGISTER 23530002 * 23540002 * TTR OF FIRST BLOCK OF CHAIN TO BE EMPTIED IS IN THE ICE OF 23550002 * THAT BLOCK. 23560002 * 23570002 MVC READTTR(L'IFSTBLK),IFSTBLK GET TTR 23580002 * 23590002 EMPREAD EQU * 23600002 * 23610002 * READ THE BLOCK AND SETUP THE ENTRY POINTERS. 23620002 * 23630002 MVC OPTNCCW,RD GET CCW 23640002 L R0,READTTR GET READ ADDRESS 23650002 BAL BALREG2,TOABSL CONVERT IT 23660002 BAL BALREG1,IO3 ***READ DATA INTO INPUT*** 23670002 LA POINT2,INENTRY ADDRESS OF FIRST ENTRY 23680002 * 23690002 EMPCHEK EQU * 23700002 * 23710002 * INSPECT THE INDICATED ENTRY 23720002 * 23730002 CLC ENAME,HIBIN IS THE NAME ALL 'FF'S? 23740002 BE EMPRENEW YES, END OF BLOCK 23750002 * 23760002 CLI ETYPE,VCBPETYP IS THE ENTRY A VCBPE? 23770002 BNE EMPNEXT NO, DONE WITH THIS ENTRY 23780002 * 23790002 MVC DELTTR3(L'ETTR),ETTR GET VCB CHAIN PTR 23800002 BAL BALREG3,FRVCBRTN GO FREE THEM 23810002 * 23820002 EMPNEXT EQU * 23830002 * 23840002 BAL BALREG1,INCR2 INCREMENT ENTRY POINTER 23850002 B EMPCHEK LOOP BACK 23860002 * 23870002 * 23880002 EMPRENEW EQU * 23890002 * 23900002 * IF THE BLOCK JUST SCANNED WAS THE FIRST BLOCK, THEN 23910002 * BUILD THE NEW FIRST BLOCK IN OUTPUT, COMPLETE. PUT ITS TTR 23920002 * IN WRITETTR. THE BLOCK IS THEN PASSED TO IGG0CLC7 FOR 23930002 * THE UPDATE OF ITS ICE. 23940002 * 23950002 * IF THE BLOCK JUST SCANNED WAS NOT THE FIRST BLOCK THEN GO TO 23960002 * EMPFR TO FREE IT. 23970002 * 23980002 TM FLAG4,COMPLETE * IS THE FIRST BLOCK COMPLETE? 23990002 BO EMPFR YES 24000002 * 24010002 * SET UP AN EMPTY BLOCK SO THE NEXT LOAD OF UPDATE CAN INSERT 24020002 * THE NEW ENTRY. 24030002 * 24040002 MVC OUTDATA,INDATA PUT 1ST BLK INTO OUTPUT SA55202 24050002 XC LINKTTR,LINKTTR ENSURE LINK ENTRY HAS ZERO TTR 24060002 MVC OUTENTRY+L'ICE(L'LNKENTRY),LNKENTRY SET ILE 24070002 MVI OUTBYTSU+1,X20 SET BYTES USED FOR UPDATE 24080002 * 24090002 * INDICATE BLOCK IS COMPLETE AND SAVE ITS TTR. 24100002 * 24110002 OI FLAG4,COMPLETE * SET COMPLETE 24120002 MVC WRITETTR(L'IFSTBLK),IFSTBLK NEW BLOCK'S WRITE ADDR 24130002 * 24140002 B EMPRESET GO CHECK FOR ANOTHER BLOCK 24150002 * 24160002 * 24170002 EMPFR EQU * 24180002 * 24190002 * FREE THE BLOCK JUST SCANNED. 24200002 * 24210002 L R0,READTTR GET WRITE ADDRESS 24220002 BAL BALREG3,FRBLKRTN GO TO FREE BLOCK ROUTINE 24230002 * 24240002 * 24250002 EMPRESET EQU * 24260002 * 24270002 * IF THERE IS ANOTHER BLOCK, GET ITS READ ADDRESS AND GO TO 24280002 * 'EMPREAD' TO READ IT. 24290002 * 24300002 * IF THERE IS NOT ANOTHER BLOCK, RETURN. 24310002 * 24320002 MVC READTTR(L'ETTR),ETTR GET LINK TTR 24330002 NC READTTR,READTTR IS IT ZERO? 24340002 BNZ EMPREAD NO 24350002 * 24360002 * END OF CHAIN. 24370002 * 24380002 MVI FLAG4,X00 * RESET FLAG4 24390002 L BALREG3,BALREGS RESTORE RETURN REGISTER 24400002 BR BALREG3 RETURN 24410002 * 24420002 DROP POINT2 24430002 * 24440002 EJECT 24450002 * 24460002 **************** 24470002 * * 24480002 FRNDXRTN EQU * 24490002 * * 24500002 **************** 24510002 * 24520002 ST BALREG3,BALREGS SAVE THE RETURN REG 24530002 USING ENTRY,POINT2 ESTABL ADDRBLTY TO ENTRY 24540002 LA POINT2,INENTRY+L'ICE POINT TO FIRST ENTRY IN BLOCK 24550002 * 24560002 FRNDXRD EQU * 24570002 * 24580002 L R0,DELTTR1 ADDR OF FREEABLE BLOCK 24590002 LTR R0,R0 ABOUT TO READ RECORD ZERO? 24600002 BZ FRNDXEND YES, END OF CHAIN 24610002 * 24620002 BAL BALREG2,TOABSL GO TO CONVERT 24630002 MVC OPTNCCW,RD MOVE IN READ DATA CCW 24640002 BAL BALREG1,IO3 ***READ DATA INTO INPUT*** 24650002 L R0,DELTTR1 ADDR OF FREEABLE BLOCK 24660002 BAL BALREG3,FRBLKRTN ***FREE BLOCK*** 24670002 MVC DELTTR1(L'ETTR),ETTR ADDR OF NEXT FREEABLE BLOCK 24680002 CLI ETYPE,VCBPETYP ENTRY FOUND A VCBPE? 24690002 BE FRNDXVCB GO FREE THEM 24700002 * 24710002 CLI ETYPE,DSPETYP ENTRY FOUND A DSPE? 24720002 BNL FRNDXEND YES, DONE 24730002 * 24740002 B FRNDXRD READ NEXT BLOCK IF THERE IS ONE 24750002 * 24760002 * 24770002 FRNDXVCB EQU * 24780002 * 24790002 MVC DELTTR3,DELTTR1 GET VCB CHAIN PTR 24800002 BAL BALREG3,FRVCBRTN ***FREE VCBS*** 24810002 * 24820002 FRNDXEND EQU * 24830002 * 24840002 L BALREG3,BALREGS RESTORE RETURN REG 24850002 BR BALREG3 RETURN 24860002 * 24870002 EJECT 24880002 * 24890002 **************** 24900002 * * 24910002 FRVCBRTN EQU * 24920002 * * 24930002 **************** 24940002 * 24950002 USING VCBD,VCBMAIN ESTABL ADDRBLTY TO VCB 24960002 LA R0,BLOCK+L'VCBBAL LENGTH OF REQUIRED AREA 24970002 GETMAIN R,LV=(0) 24980002 ST R1,SVVCBLK5 SAVE BLOCK PTR (ESTAE) @YL026UD 24982002 LR VCBMAIN,R1 SET BASE TO AREA 24990002 ST BALREG3,VCBBAL SAVE RETURN REG 25000002 * 25010002 FRVCBRD EQU * 25020002 * 25030002 * SET UP CHANNEL PROGRAM TO READ DATA INTO VCBMAIN AREA. 25040002 * 25050002 MVC OPTNCCW,RD MOVE IN READ DATA CCW 25060002 ST VCBMAIN,OPTNCCW MOVE IN ADDRESS 25070002 MVI OPTNCCW,RDOP RESTORE READ DATA OP-CODE 25080002 L R0,DELTTR3 25090002 LTR R0,R0 ZERO? 25100002 BZ FRVCBEND YES, DONE 25110002 BAL BALREG2,TOABSL GO TO CONVERT 25120002 BAL BALREG1,IO3 ***READ DATA INTO VCBMAIN*** 25130002 L R0,DELTTR3 ADDR OF VCB 25140002 BAL BALREG3,FRBLKRTN ***FREE BLOCK*** 25150002 MVC DELTTR3,VCBLNK ADDR OF NEXT VCB 25160002 B FRVCBRD GO READ IT 25170002 * 25180002 * 25190002 FRVCBEND EQU * 25200002 * 25210002 L BALREG3,VCBBAL RESTORE RETURN REG 25220002 LA R0,BLOCK+L'VCBBAL LENGTH OF AREA TO FREE 25230002 LR R1,VCBMAIN ADDR OF AREA TO FREE 25240002 XC SVVCBLK5(4),SVVCBLK5 RESET BLOCK PTR (ESTAE) @YL026UD 25242002 FREEMAIN R,LV=(0),A=(1) 25250002 BR BALREG3 RETURN 25260002 * 25270002 DROP VCBMAIN 25280002 * 25290002 EJECT 25300002 * 25310002 **************** 25320002 * * 25330002 FRBLKRTN EQU * 25340002 * * 25350002 **************** 25360002 * 25370002 * FREE ONE BLOCK 25380002 * 25390002 * PRIOR TO FIRST HOLE IN SYSCTLG? SA52119 25400002 CL R0,VFHOLE SA52119 25410002 BNL FROK NO, OK TO JUST FREE IT 25420002 ST R0,VFHOLE YES, RESET 'VFHOLE' 25430002 * 25440002 FROK EQU * 25450002 * 25460002 BAL BALREG2,TOABSL GO TO CONVERT 25470002 MVC OPTNCCW,NOP MOVE IN SKELETON CCW 25480002 MVI OPTNCCW,WKDOP MOVE IN WRITE KEY & DATA OP-CODE 25490002 BAL BALREG1,IO3 ***WRITE ZERO KEY & DATA*** 25500002 BR BALREG3 RETURN 25510002 * 25520002 EJECT 25530002 * 25540002 **************** 25550002 * * 25560002 BLVCBRTN EQU * 25570002 * * 25580002 **************** 25590002 * 25600002 LA VCBMAIN,OUTDATA SET BASE FOR VCB 25610002 USING VCBD,VCBMAIN ESTABL BASE FOR VCB 25620002 MVC OUTKEY,HIBIN SET KEY TO X'FF' 25630002 XC VCBTTR,VCBTTR ZERO 'VCBTTR' 25640002 LA MODULUS,D20 NUMBER OF VOLUMES PER VCB 25650002 XR WORK2,WORK2 ZERO 'WORK2' 25660002 L WORK1,CAMPTR3 POINT TO VOLUME LIST 25670002 LH WORK3,0(WORK1) GET NUMBER OF VOLUMES 25680002 BCTR WORK3,0 MINUS 1 25690002 DR WORK2,MODULUS NUMBER OF VCB'S - 1 IN WORK3 25700002 LA WORK2,D01(WORK2) NUMBER OF VOLUMES IN LAST VCB 25710002 LA COUNT,D01(WORK3) VCB COUNTER 25720002 MH WORK3,H240 TIMES NUMBER OF BYTES/VCB 25730002 LA POINT2,D02(WORK1,WORK3) 1ST VOLUME ENTRY FOR LAST VCB 25740002 LR WORK1,WORK2 NUMBER OF VOLUMES IN LAST VCB 25750002 MH WORK1,H12 NUMBER OF BYTES TO BE MOVED 25760002 * 25770002 BLVCB1 EQU * 25780002 * 25790002 XC OUTDATA,OUTDATA CLEAR BLOCK 25800002 BCTR WORK1,0 MINUS 1 FOR EXECUTE 25810002 EX WORK1,MOVE3 MOVE USERS VOLUME LIST 25820002 STH WORK2,VCBVOLCT VOLUME COUNT TO VCB 25830002 MVC VCBLNK,VCBTTR WRITE LINK TTR 25840002 L R0,VFHOLE GET NEXT BLOCK ADDR 25850002 ST R0,VCBTTR SAVE AS NEXT LINK TTR 25860002 BAL BALREG2,TOABSL GO TO CONVERT 25870002 MVC OPTNCCW,WKD MOVE IN WRITE KEY & DATA OP-CODE 25880002 BAL BALREG1,IO3 ***WRITE KEY & DATA*** 25890002 MVC OPTNCCW,RKD READ KEY & DATA -- NO TRANSFER 25900002 OI OPTNCCW+4,CC COMMAND CHAIN 25910002 BAL BALREG1,IO3 ***VERIFY WRITE & SEARCH KEY=0** 25920002 * 25930002 * CHECK FOR CATALOG FULL CONDITION. 25940002 * 25950002 LTR R15,R15 CATALOG FULL? 25960002 BZ BLVCB2 NO 25970002 * 25980002 MVC DELTTR3,VCBTTR GET VCB CHAIN PTR 25990002 BAL BALREG3,FRVCBRTN GO FREE THEM 26000002 B ERR20 AND EXIT 26010002 * 26020002 * 26030002 BLVCB2 EQU * 26040002 * 26050002 BAL BALREG2,TORLTV GET THE NEW TTR 26060002 ST R0,VFHOLE PUT NEW TTR IN VICE 26070002 LA WORK2,D20(WORK2) BUMP VOL COUNT BY 20 26080002 SH POINT2,H240 BACKUP IN VOLUME LIST 26090002 LA WORK1,L'VCBVOLS NUMBER OF BYTES TO BE MOVED 26100002 BCT COUNT,BLVCB1 BRANCH IF ANY MORE VCB'S 26110002 MVC TTR,VCBTTR HEAD OF CHAIN TTR INTO VCBPE 26120002 XC VCBTTR,VCBTTR ZERO 'VCBTTR' 26130002 BR BALREG3 RETURN 26140002 * 26150002 DROP POINT2 26160002 * 26170002 EJECT 26180002 * 26190002 **************** 26200002 * * 26210002 INCR2 EQU * 26220002 * * 26230002 **************** 26240002 * 26250002 * FUNCTION: 26260002 * ADJUSTS POINT TO POINT TO THE NEXT ENTRY IN INPUT 26270002 * INPUT: 26280002 * ETYPE,POINT,BALREG1 IS RETURN REGISTER 26290002 * OUTPUT: 26300002 * POINT,LENGTH 26310002 * DESTROYED: 26320002 * NOTHING 26330002 * 26340002 *** 26350002 * 26360002 USING ENTRY,POINT2 ESTABL ADDRBLTY TO ENTRY 26370002 * 26380002 XR LENGTH2,LENGTH2 ZERO 'LENGTH2' 26390002 IC LENGTH2,ETYPE PICK UP ENTRY TYPE 26400002 * 26410002 * TOTAL LENGTH OF THE ENTRY IS 12 + 2*(ETYPE) 26420002 * 26430002 LA LENGTH2,D12(LENGTH2,LENGTH2) CALCULATE LENGTH 26440002 AR POINT2,LENGTH2 ADJUST POINT 26450002 BR BALREG1 POINT IS AT NEXT ENTRY 26460002 * 26470002 DROP POINT2 26480002 * 26490002 EJECT 26500002 * 26510002 **************** 26520002 * * 26530002 WRITE EQU * 26540002 * * 26550002 **************** 26560002 * 26570002 MVI OPTNCCW,WDOP MOVE IN WRITE DATA OP CODE 26580002 BAL BALREG1,IO3 WRITE DATA 26590002 * 26600002 * VERIFY THE WRITE OPERATION 26610002 * 26620002 MVC OPTNCCW,RKD MOVE IN CCW - NO TRANSFER 26630002 BAL BALREG1,IO3 ***READ KEY & DATA*** 26640002 BR BALREG2 RETURN 26650002 * 26660002 EJECT 26670002 * 26680002 **************** 26690002 * * 26700002 TOABSL EQU * 26710002 * * 26720002 **************** 26730002 * 26740002 * FUNCTION: 26750002 * CONVERT THE TTR0 IN R0 TO AN ABSOLUTE DASD ADDRESS AND 26760002 * PUT IT INTO THE IOB MBBCCHHR 26770002 * 26780002 * INPUT: 26790002 * R0 IS THE TTR0 TO BE CONVERTED 26800002 * RETURN ADDRESS IN BALREG2 26810002 * 26820002 * OUTPUT: 26830002 * ABSOLUTE DASD ADDRESS IN IOB 26840002 * ERROR CODE IN R15 26850002 * 26860002 * DESTROYED: 26870002 * REGISTERS - R0,R1,R2,R14, AND R15=0 26880002 * WA - SAVEAREA AND MBBCCHHR OF THE IOB 26890002 * 26900002 * SUBROUTINES USED: 26910002 * THE RESIDENT CONVERT ROUTINE - IECPCNVT 26920002 * 26930002 * 26940002 *** 26950002 * 26960002 L R15,EPTOABSL GET EP TO 'IECPCNVT' 26970002 B CONVERT GO SET UP FOR CONVERT 26980002 * 26990002 EJECT 27000002 * 27010002 **************** 27020002 * * 27030002 TORLTV EQU * 27040002 * * 27050002 **************** 27060002 * 27070002 * FUNCTION: 27080002 * MOVE THE DASD ADDRESS OF CCHHR FROM NXTCNT INTO THE CCHHR OF THE 27090002 * IOB. THIS GIVES THE TTR OF THE NEXT FREE BLOCK. 27100002 * 27110002 * INPUT: 27120002 * RETURN IN BALREG2 27130002 * UPDATED NXTCNT 27140002 * 27150002 * OUTPUT: 27160002 * TTR0 IN R0 27170002 * 27180002 * DESTROYED: 27190002 * REGISTERS -- R0,R1,R2,R14, AND R15=0 27200002 * WA -- SAVEAREA AND CCHHR OF IOB 27210002 * 27220002 * SUBROUTINES USED: 27230002 * THE RESIDENT CONVERT ROUTINE -- IECPRLTV 27240002 * 27250002 * 27260002 *** 27270002 * 27280002 * MOVE DATA COUNT FIELD INTO IOB 27290002 * 27300002 MVC IOBSKADD+3(L'NXTCCHHR),NXTCCHHR MOVE DATA COUNT FIELD 27310002 L R15,EPTORLTV GET EP TO 'IECPRLTV' 27320002 * 27330002 CONVERT EQU * 27340002 * 27350002 STM R9,R13,SVAREA5 SAVE REGS DESTROYED BY CONVERT 27360002 L R1,DEBADDR GET DEB ADDRESS 27370002 LA R2,IOBSKADD POINT TO MBBCCHHR 27380002 BALR BALREG1,R15 GO TO CONVERT 27390002 LM R9,R13,SVAREA5 RESTORE REGISTERS 27400002 BR BALREG2 RETURN 27410002 * 27420002 EJECT 27430002 * 27440002 **************** 27450002 * * 27460002 IO3 EQU * 27470002 * * 27480002 **************** 27490002 * 27500002 * FUNCTION: 27510002 * 1. IF THE DEVICE HAS THE RPS FEATURE, THE SET SECOTR CCW IS 27520002 * UPDATED. 27530002 * 2. ISSUE EXCP FOR THE CHANNEL PROGRAM POINTED TO BY THE JOB. 27540002 * 3. WAIT FOR THE OPERATION TO COMPLETE AND CHECK THE ECB. 27550002 * 4. IF AN END OF EXTENT CONDITION, BRANCH TO IGC0002H @YL026UD 27560002 * AND EXTEND THE CATALOG. @YL026UD 27570002 * 5. IF A PERMANENT I/O ERROR, SET AN ERROR CODE AND BRANCH TO 27580002 * IGG0CLC7. 27590002 * 27600002 * INPUT: 27610002 * UPDATED CHANNEL PROGRAM 27620002 * RETURN ADDRESS IN BALREG 1 27630002 * 27640002 * OUTPUT: 27650002 * 1. FILLED BUFFER 27660002 * 2. EMPTIED BUFFER 27670002 * 3. ANOTHER FREE BLOCK ADDRESS 27680002 * 27690002 * DESTROYED: 27700002 * REGISTERS R0,R1,R15 (IF EXTENDS), AND ERRCAT 27710002 * 27720002 * EXTERNAL ROUTINES USED: 27730002 * EXCP, WAIT, SVC 28 TO EXTEND CATALOG 27740002 * 27750002 * EXITS: 27760002 * IGC0002H TO EXTEND THE CATALOG @YL026UD 27770002 * IGG0CLC7 FOR PERMANENT I/O ERROR 27780002 *** 27790002 * 27800002 USING RPSD,R1 ESTABL ADDRBLTY TO RPS AREA 27810002 TM FLAG2,RPSDEV * RPS FEATURE? 27820002 BZ EXCP3 BRANCH IF NO 27830002 * 27840002 L R1,RPSAVEP GET RPS SAVE AREA PTR 27850002 STM R9,R2,RPSAVE SAVE REGS DESTROYED BY CONVERT 27860002 LM R15,R2,RPSINPUT GET CONVERT INPUT PARAMETERS 27870002 IC R0,IOBSKADD+7 GET R OF CCHHR 27880002 BALR R14,R15 CONVERT R TO THETA 27890002 LM R9,R2,RPSAVE RESTORE REGISTERS 27900002 * 27910002 EXCP3 EQU * 27920002 * 27930002 EXCP IOB ISSUE EXCP 27940002 WAIT ECB=ECB WAIT FOR REQUEST 27950002 XR R15,R15 ZERO RETURN CODE 27960002 CLI ECB,X7F I/O ERROR? 27970002 BCR 8,BALREG1 BRANCH IF NO 27980002 * 27990002 CLI ECB,X42 END OF EXTENT? 28000002 BNE ERR28 BRANCH IF NO AND EXIT 28010002 * 28020002 * EXTEND CATALOG 28030002 * 28040002 ST BALREG1,SVBALREG SAVE CURRENT BALREG1 @YL026UD 28042002 L R0,IOBDCB GET DCB ADDRESS 28050002 L R2,OPENMOD GET IGC0002H ADDRESS @YL026UD 28060002 BALR BALREG1,R2 EXTEND @YL026UD 28064002 * 28070002 L BALREG1,SVBALREG RESTORE SAVED BALREG1 @YL026UD 28072002 CH R15,H08 ANY MORE EXTENTS? 28080002 BCR 8,BALREG1 BRANCH IF NO 28090002 * 28100002 LCR R1,R15 RETURN CODE 0? 28110002 BNZ IGG0CLC7 BRANCH IF NO 28120002 * 28130002 B EXCP3 RE-ISSUE REQUEST 28140002 * 28150002 DROP R1 28160002 * 28170002 EJECT 28180002 * 28190002 ERRTN EQU * 28200002 * 28210002 MVC DELTTR1,TTR0 PREPARE FOR FRNDXRTN 28220002 BAL BALREG3,FRNDXRTN GO FREE INDEX CHAIN 28230002 B ERR20 SET RETURN CODE OF 20 @YL026UD 28230102 * 28230402 * 28232002 ERR08 EQU * 28234002 * 28236002 MVI ERRCATSV,ERROR08 RETURN CODE IS 08 28238002 B IGG0CLC7 BRANCH TO IGG0CLC7 @YL026UD 28238402 * 28238802 * 28239202 ERR12 EQU * 28239602 * 28239702 MVI ERRCATSV,ERROR12 RETURN CODE IS 12 28239802 B IGG0CLC7 BRANCH TO IGG0CLC7 @YL026UD 28239902 * 28243202 * 28245202 ERR16 EQU * 28245602 * 28246002 MVI ERRCATSV,ERROR16 RETURN CODE IS 16 28246402 B IGG0CLC7 BRANCH TO IGG0CLC7 @YL026UD 28246502 * 28246602 * 28246702 ERR20 EQU * 28250002 * 28260002 MVI ERRCATSV,ERROR20 RETURN CODE IS 20 28270002 B IGG0CLC7 BRANCH TO IGG0CLC7 @YL026UD 28280002 * 28290002 * 28292002 ERR24 EQU * 28294002 * 28296002 MVI ERRCATSV,ERROR24 RETURN CODE IS 24 28298002 B IGG0CLC7 BRANCH TO IGG0CLC7 @YL026UD 28298402 * 28298802 * 28300002 ERR28 EQU * 28310002 * 28320002 MVI ERRCATSV,ERROR28 RETURN CODE IS 28 28330002 B IGG0CLC7 BRANCH TO IGG0CLC7 @YL026UD 28340002 * 28350002 * 28430002 IGG0CLC6 EQU * 28440002 * 28450002 L R15,IGG0CLCE OBTAIN MODULE NAME @YL026UD 28460002 BALR R14,R15 BRANCH TO IGG0CLCE @YL026UD 28470002 * 28480002 * 28490002 IGG0CLC7 EQU * 28500002 * 28510002 L R15,ERRORMOD OBTAIN MODULE NAME @YL026UD 28520002 BALR R14,15 BRANCH TO ERROR MODULE @YL026UD 28522002 * 28530002 TITLE 'IGG0CLCD - (ESTAEXIT) ESTAE EXIT ROUTINE' @YL026UD 28572002 *********************************************************************** 28572402 * * 28572802 * ESTAEXIT - ESTAE EXIT ROUTINE * 28572902 * * 28573002 *********************************************************************** 28573102 * @YL026UD 28573202 ENTRY ESTAEXIT @YL026UD 28573602 * @YL026UD 28573702 * ESTAEXIT IS GIVEN CONTROL ON PERCOLATION FROM ANOTHER @YL026UD 28574002 * ESTAE EXIT ROUTINE, OR RECEIVES CONTROL BECAUSE OF AN @YL026UD 28574402 * INTERRUPT IN MODULES IGG0CLCC, IGG0CLCD, IGG0CLCE. @YL026UD 28574802 * REGISTER 14 MUST BE SAVED FOR RETURN TO THE TRM. @YL026UD 28575202 * AN RTCA MAY OR MAY NOT BE AVAILABLE. ESTAEXIT ALWAYS @YL026UD 28575602 * PERCOLATES TO THE NEXT ESTAE ON THE CHAIN. @YL026UD 28576002 * @YL026UD 28576402 * @YL026UD 28576802 ESTAEXIT EQU * @YL026UD 28578002 * @YL026UD 28578402 BALR BASE,0 SET BASE REG FOR MODULE @YL026UD 28578802 USING *,BASE ESTABLISH BASE REGISTER @YL026UD 28579202 * @YL026UD 28579602 CH R0,H12 IS RTCA AVAILABLE @YL026UD 28579702 BE NORTCA NO, PROCESS WITHOUT IT @YL026UD 28579802 STM R14,R12,12(R13) SAVE REGISTERS @YL026UD 28580002 LR R2,R14 SAVE RETURN REGISTER @YL026UD 28583202 L R15,0(R1) GET ESTAE INFO LIST PTR @YL026UD 28585202 L R5,0(R15) RESTORE SVRB BASE REG @YL026UD 28585602 L R6,4(R15) RESTORE CATLG WKA REG @YL026UD 28586002 L R13,8(R15) RESTORE BLDL WKA REG @YL026UD 28586402 LR R3,R1 SAVE SDWA-RTCA ADDRESS @YL026UD 28586502 USING SDWA,R3 SET SDWA ADDRESSIBILITY @YL026UD 28586602 TM SDWAERRC,SDWAPERC WERE WE PERCOLATED TO? @YL026UD 28587702 BO PERC YES, BYPASS DUMPING @YL026UD 28588102 * @YL026UD 28588502 * NOT PERCOLATED TO @YL026UD 28588602 * @YL026UD 28588702 SETRP RECORD=YES,DUMP=NO,RECPARM=RECORD,RC=0, @YL026UD*28588802 WKAREA=(R3) @YL026UD 28591602 * @YL026UD 28593602 MVC DUMPHDR(L'SKELHDR),SKELHDR STORE SDUMP HEADER @OZ29464 28594037 MVC DUMPLIST(SDUMPSIZ),DUMPL STORE PARM LIST @OZ29464 28594137 LA R2,DUMPHDR POINT TO HEADER @OZ29464 28594737 SDUMP HDRAD=(R2),MF=(E,DUMPLIST) ISSUE SDUMP MACRO @OZ29464 28594837 B DEQALL BRANCH TO DEQUES @YL026UD 28594937 * @YL026UD 28595037 PERC EQU * @YL026UD 28595137 * @YL026UD 28595202 * PERCOLATED TO @YL026UD 28595602 * @YL026UD 28596002 SETRP RECORD=YES,DUMP=IGNORE,RECPARM=RECORD,RC=0, @YL026UD*28596102 WKAREA(R3) @YL026UD 28596202 B DEQALL BRANCH TO DEQUES @YL026UD 28597102 DROP R3 @YL026UD 28597602 * @YL026UD 28598002 NORTCA EQU * @YL026UD 28598102 * @YL026UD 28599402 L R5,0(R2) RESTORE SVRB BASE REG @YL026UD 28599802 L R6,4(R2) RESTORE CATLG WKA REG @YL026UD 28600202 L R13,8(R2) RESTORE BLDL WKA REG @YL026UD 28600602 LR R2,R14 SAVE RETURN REGISTER @YL026UD 28600702 * @YL026UD 28600802 TM FLAG2,ESTAEFL TEST ESTAE FLAG @ZA03161 28601837 BO FREEALL BRANCH IF ESTAE FAILURE @ZA03161 28602837 * 28603802 * @YL026UD 28604002 DEQALL EQU * @YL026UD 28604502 * @YL026UD 28605002 * DEQUE ALL ENQUED RESOURCES @YL026UD 28605502 * @YL026UD 28606002 USING SVRBEXTD,R5 ENQ INFO ADDRESSIBILITY @YL026UD 28606502 XC ENQRNAM8,ENQRNAM8 RESET RNAME FOR VICE @YL026UD 28607002 OI ENQFLAGS,HAVE SET FLAG IN CASE NO @YL026UD 28607502 * PREVIOUS ENQ @YL026UD 28608002 DEQ ,MF=(E,(R5)) DEQUE VICE @YL026UD 28608502 * @YL026UD 28609002 NI ENQFLAGS,SMCSTEPC RESET 'STEP MUST CMPLT' @YL026UD 28609502 MVC ENQRNAM8,ENQNAME SET RNAME FOR VOL INDEX @YL026UD 28610002 DEQ ,MF=(E,(R5)) DEQUE VOLUME INDEX @YL026UD 28610502 * @YL026UD 28611002 OI ENQFLAGS,RESERVE TURN ON RESERVE FLAG @YL026UD 28611502 MVC ENQRNAM8,HILVLNAM SET RNAME FOR HIGH LEVEL@YL026UD 28612002 DEQ ,MF=(E,(R5)) DEQUE HIGH LEVEL NAME @YL026UD 28612502 * AND RELEASE THE DEVICE @YL026UD 28613002 * @YL026UD 28613502 * @YL026UD 28614002 FREEALL EQU * @YL026UD 28614502 * @YL026UD 28615002 * FREE ALL ACQUIRED STORAGE AREAS @YL026UD 28615502 * @YL026UD 28616002 L R1,SVEXTWAP GET EXTEND WKA PTR @YL026UD 28616502 LTR R1,R1 DOES WKA EXIST? @YL026UD 28617002 BZ FREEFMT BRANCH IF NOT @YL026UD 28617502 * @YL026UD 28618002 FREEEXT EQU * @YL026UD 28618502 * @YL026UD 28619002 LA R0,EXTWALEN GET EXTEND WKA LENGTH @YL026UD 28619502 SVC FREEMAIN FREE EXTEND WORKAREA @YL026UD 28620002 * @YL026UD 28620502 FREEFMT EQU * @YL026UD 28621002 * @YL026UD 28621502 L R1,SVFMTWAP GET FORMAT WKA PTR @YL026UD 28622002 LTR R1,R1 DOES WKA EXIST? @YL026UD 28622502 BZ FREEVCB5 BRANCH IF NOT @YL026UD 28623002 LA R0,FMTWALEN GET FORMAT WKA LENGTH @YL026UD 28623502 SVC FREEMAIN FREE FORMAT WORKAREA @YL026UD 28624002 * @YL026UD 28624502 FREEVCB5 EQU * @YL026UD 28625002 * @YL026UD 28625502 L R1,SVVCBLK5 GET VCB WKA PTR (CLC5) @YL026UD 28626002 LTR R1,R1 DOES WKA EXIST? @YL026UD 28626502 BZ FREEVCB4 BRANCH IF NOT @YL026UD 28627002 LA R0,VCB5LEN GET VCB WKA LENGTH @YL026UD 28627502 SVC FREEMAIN FREE VCB WORKAREA (CLC5)@YL026UD 28628002 * @YL026UD 28628502 FREEVCB4 EQU * @YL026UD 28629002 * @YL026UD 28629502 L R1,SVVCBLK4 GET VCB WKA PTR (CLC4) @YL026UD 28630002 LTR R1,R1 DOES WKA EXIST? @YL026UD 28630502 BZ FREEOPN BRANCH IF NOT @YL026UD 28631002 LA R0,VCB4LEN GET VCB WKA LENGTH @YL026UD 28631502 SVC FREEMAIN FREE VCB WORKAREA (CLC4)@YL026UD 28632002 * @YL026UD 28632502 FREEOPN EQU * @YL026UD 28633002 * @YL026UD 28633502 L R1,SVOPNWAP GET OPEN WKA PTR @YL026UD 28634002 LTR R1,R1 DOES WKA EXIST? @YL026UD 28634502 BZ FREERPS BRANCH IF NOT @YL026UD 28635002 USING DCBAREA,R1 @YL026UD 28635502 L R0,NMBYTES GET OPEN WKA LENGTH @YL026UD 28636002 DROP R1 @YL026UD 28636502 SVC FREEMAIN FREE OPEN WORKAREA @YL026UD 28637002 * @YL026UD 28637502 FREERPS EQU * @YL026UD 28638002 * @YL026UD 28638502 L R1,SVRPSWAP GET RPS WKA PTR @YL026UD 28639002 LTR R1,R1 DOES WKA EXIST? @YL026UD 28639502 BZ FREECAT BRANCH IF NOT @YL026UD 28640002 LA R0,RPSEND-RPSD GET RPS WKA LENGTH @YL026UD 28640502 SVC FREEMAIN FREE RPS WORKAREA @YL026UD 28641002 * @YL026UD 28641502 FREECAT EQU * @YL026UD 28642002 * @YL026UD 28642502 TM FLAG1,LOCATEF LOCATE REQUEST? @YL026UD 28643002 BZ NOLOCATE BRANCH IF NOT @YL026UD 28643502 LR R1,R13 GET BLDL WKA PTR @YL026UD 28644002 LA R0,BLDLEND-BLDLAREA GET BLDL WKA LENGTH @YL026UD 28644502 B FREECAT1 BRANCH TO FREEMAIN @YL026UD 28645002 * @YL026UD 28645502 NOLOCATE EQU * @YL026UD 28646002 * @YL026UD 28646502 LR R1,R6 GET CATALOG WKA PTR @YL026UD 28647002 LA R0,WORKEND-WORKAREA GET CATALOG WKA LENGTH @YL026UD 28647502 * @YL026UD 28648002 FREECAT1 EQU * @YL026UD 28648502 * @YL026UD 28649002 SVC FREEMAIN FREE WORKAREA @YL026UD 28649502 * @YL026UD 28650002 SR R15,R15 ZERO REGISTER 15 @YL026UD 28650502 LR R14,R2 RESTORE RETURN REGISTER @YL026UD 28651002 BR R14 RETURN TO RTM @YL026UD 28651502 * @YL026UD 28652002 TITLE 'IGG0CLCD - CONSTANT DEFINITIONS' @YL026UD 28652502 * 28653002 * CONSTANTS 28653502 * 28654002 DS 0F 28654502 SCROPTN DC XL4'41004000' NO PURGE SCRATCH OPTIONS 28655037 SCROPTN2 DC XL4'4100C000' OPTNS WITH TIOT ENQUED @OZ19636 28655137 H06 DC H'06' 28655502 H08 DC H'08' 28656002 H12 DC H'12' 28656502 H240 DC H'240' 28657002 * 28657402 MOVEVOLS MVC OUTDATA+32(0),0(R2) 28658602 MOVELVLN MVC NAME(0),0(R2) 28658902 MOVE1 MVC VOLCNT(0),0(R1) APPEND VOLUME LIST 28659002 MOVE2 MVC DSNAME(0),0(DSN) MOVE IN ALL BUT LAST LEVEL 28659502 MOVE3 MVC OUTENTRY(0),0(POINT2) 28660002 * 28660502 EXTWALEN DC AL1(253) EXTEND WORKAREA SUBPOOL @YL026UD 28661002 DC AL3(250) EXTEND WORKAREA LENGTH @YL026UD 28661502 FMTWALEN DC F'512' FORMAT WORKAREA LENGTH @YL026UD 28662002 VCB5LEN DC F'260' VCB BLOCK (CLC5) LENGTH @YL026UD 28662502 VCB4LEN DC F'256' VCB BLOCK (CLC4) LENGTH @YL026UD 28663002 RECORD DC C'IGG0CLCa' ESTAE RECORD MODULE @YL026UD 28663502 DC C'IGG0CLCD' ESTAE RECORD CSECT @YL026UD 28664002 DC 8X'00' ESTAE RECORD FRR ID @YL026UD 28664502 * 28665002 SPNBYTES DS 0F PUT ON WORD BOUNDARY 28665502 DC AL1(253) SET SUBPOOL ID 28666002 DC AL3(AREAEND-DCBAREA) SIZE @YL026UD 28666502 * 28667002 IGG0CLCE DC V(IGG0CLCE) 28667502 ERRORMOD DC V(IGG0CLC7) 28668002 OPENMOD DC V(IGC0002H) 28668502 DUMPL SDUMP SDATA=(PSA,LSQA,RGN,LPA),MF=L SDUMP LIST FORM @OZ29464 28668937 SDUMPSIZ EQU *-DUMPL 28669237 SKELHDR DS 0XL43 SDUMP HEADER @OZ29464 28669537 DC AL1(42+1) SDUMP HEADER SIZE FIELD @OZ29464 28669837 SKELMSG DC CL42'SDUMP - IGG0CLCD - CVOL CATALOG MANAGEMENT' OZ29464 28670137 * @YL026UD 28670437 * @YL026UD 28671102 * PATCH AREA (MAINTENANCE AREA) @YL026UD 28673102 * @YL026UD 28673202 FIXAREA DC 100X'00' @YL026UD 28673302 * @YL026UD 28676002 TITLE 'IGG0CLCD - CONSTANT EQUATE DEFINITIONS' @YL026UD 28679202 * 28681902 * CONSTANT EQUATES 28684602 * 28687302 VICETYP EQU 5 VICE TYPE CODE 28690002 ICETYP EQU 3 ICE TYPE CODE 28700002 ILETYP EQU 0 ILE TYPE CODE 28710002 IPETYP EQU 0 IPE TYPE CODE 28720002 DSPETYP EQU 7 OR MORE, FOR DSPE TYPE CODE 28730002 VCBPETYP EQU 1 VCBPE TYPE CODE 28740002 OCVOLTYP EQU 3 OLD CVOL TYPE CODE 28750002 NCVOLTYP EQU 5 NEW CVOL TYPE CODE 28760002 ALIASTYP EQU 4 ALIAS TYPE CODE 28770002 GIPETYP EQU 2 GIPE TYPE CODE 28780002 ERROR00 EQU 0 28790002 ERROR04 EQU 4 28800002 ERROR08 EQU 8 28810002 ERROR12 EQU 12 28820002 ERROR16 EQU 16 28830002 ERROR20 EQU 20 28840002 ERROR24 EQU 24 28850002 ERROR28 EQU 28 28860002 ERROR32 EQU 32 28870002 ERROR72 EQU 72 28880002 *********************************************************************** 28890002 * CHARACTER CODE DEPENDENT CONSTANTS 28900002 *********************************************************************** 28910002 CCDBLANK EQU C' ' 28920002 CCDRPARN EQU C')' 28930002 CCDMINUS EQU C'-' 28940002 CCDPLUS EQU C'+' 28950002 CCD0 EQU C'0' 28960002 CCDG EQU C'G' 28970002 CCDV EQU C'V' 28980002 CCDPERD EQU C'.' 28990002 CCDLPARN EQU C'(' 29000002 *********************************************************************** 29010002 CODPERD EQU 4 29020002 CODBLANK EQU 8 29030002 CODPARN EQU 12 29040002 CLC1 EQU C'1' 29050002 CLC2 EQU C'2' 29060002 CLC3 EQU C'3' 29070002 CLC4 EQU C'4' 29080002 CLC5 EQU C'5' 29090002 CLC6 EQU C'6' 29100002 CLC7 EQU C'7' 29110002 EXIT EQU 3 29120002 FREEMAIN EQU 10 29130002 * 29150002 CC EQU X'40' COMMAND CHAIN 29160002 BLOCK EQU 256 29170002 VICETTR EQU 256 29172002 ALIASDSP EQU 17 29174002 * 29184002 X00 EQU X'00' 29190002 X01 EQU X'01' 29192002 X03 EQU X'03' 29194002 X20 EQU X'20' 29200002 X42 EQU X'42' 29210002 X7F EQU X'7F' 29220002 XFF EQU X'FF' 29222002 D01 EQU 1 29230002 D02 EQU 2 29240002 D12 EQU 12 29242002 D20 EQU 20 29250002 D44 EQU 44 29252002 TITLE 'IGG0CLCD - REGISTER EQUATE DEFINITIONS' @YL026UD 29262002 * 29270002 * REGISTER EQUATES 29280002 * 29290002 R0 EQU 0 29300002 R1 EQU 1 29310002 R2 EQU 2 29320002 R3 EQU 3 29330002 R4 EQU 4 BASE REGISTER FOR ALL MODULES 29340002 R5 EQU 5 29350002 R6 EQU 6 WORKAREA BASE REGISTER 29360002 R7 EQU 7 29370002 R8 EQU 8 CAMLST POINTER 29380002 R9 EQU 9 29390002 R10 EQU 10 29400002 R11 EQU 11 29410002 R12 EQU 12 SECONDARY LINKAGE REGISTER 29420002 R13 EQU 13 BLDL WORKAREA BASE REGISTER 29430002 R14 EQU 14 PRIMARY LINKAGE REGISTER 29440002 R15 EQU 15 29450002 * 29460002 BALREG1 EQU R14 29470002 BALREG2 EQU R12 29480002 BASE EQU R4 29490002 * 29500002 BALREG3 EQU R7 29510002 BALREG4 EQU R3 29512002 BALREG5 EQU R9 29514002 * 29516002 COUNT EQU R13 29520002 MODULUS EQU R0 29530002 POINT EQU R10 29540002 POINT2 EQU R5 @YL026UD 29542002 SIZE EQU R0 29550002 TARGET EQU BALREG2 29560002 LENGTH EQU R9 @YL026UD 29570002 LENGTH2 EQU R7 @YL026UD 29572002 LEVEL EQU R7 29574002 LEVEL2 EQU R1 @YL026UD 29576002 VCBMAIN EQU R9 29580002 VCBMAIN2 EQU R11 @YL026UD 29580402 * 29582002 INTEGER EQU R15 29584002 ALIASCNT EQU R11 29586002 DSN EQU R1 29588002 GIPE EQU R5 29588402 LAST EQU R7 29588802 LEN EQU R2 29589202 TALLY EQU R2 29589602 * 29589702 WORK1 EQU R3 29590002 WORK2 EQU R10 29600002 WORK3 EQU R11 WORK2 + 1 29610002 * 29620002 *********************************************************************** 29630002 * * 29640002 * END OF IGG0CLCD CSECT * 29650002 * * 29660002 CLCDSIZE EQU * * 29670002 MAXISIZE EQU IGG0CLCD+X'1000' * 29680002 AVAILABL EQU MAXISIZE-CLCDSIZE * 29690002 * * 29700002 *********************************************************************** 29710002 * 29720002 TITLE 'IGG0CLCD - CATALOG WORKAREA DSECT' @YL026UD 29732002 * 29740002 * DSECTS 29750002 * 29760002 WORKAREA LIST=YES Y01113 29770037 DUMPLIST EQU SAVEAREA SDUMP PARM LIST IN WORKAREA @OZ29464 29770837 DUMPHDR EQU INPUT SDUMP HEADER @OZ29464 29771637 TITLE 'IGG0CLCD - COMMUNICATION VECTOR TABLE DSECT' @YL026UD 29772402 CVT DSECT 29774002 CVT 29776002 TITLE 'IGG0CLCD - UNIT CONTROL BLOCK DSECT' @YL026UD 29778102 UCB DSECT 29778402 IEFUCBOB 29778802 TITLE 'IGG0CLCD - STAE DIAGNOSTIC WORK AREA DSECT' @YL026UD 31072002 IHASDWA DSECT=YES @YL026UD 31080002 END IGG0CLCD @YL026UD 31090002