TITLE 'IGG0CLCC - INITIALIZATION, LOCATE, RELATIVE GDG, ALIAS' 00010002 * /* START OF SPECIFICATIONS **** 00020002 * 00030002 *01* MODULE-NAME = IGG0CLCC @YL026UD 00040002 *01* STATUS = 00 00050002 *01* CHANGE-ACTIVITY = NEW FOR RELEASE 21,CHANGED FOR OSVS Y01113 00060002 * (AS IGG0CLC0,IGG0CLC1,IGG0CLC2,IECPBLDL) 00060402 * RENAMED AND CHANGED FOR VS2 RELEASE 2 @YL026UD 00062002 * 16 BIT UCB ADDRESS SUPPORT FOR VS2-3 @Z30AAEH 00064000 *A042920-042940 YA00090 00066002 * A41320-41400 @Z30AAEH 00066100 * DELETIONS/CHANGES FOR VS2-3.0 00066408 *A041920-041940,042960-042980 ZA00015 00066708 *A199900-1999400,C201000,260800 @ZA01897 00067008 *A197830-197832,198410-198420 @ZA02286 00067308 * VS2 037 CHANGES 00067608 *A020042-020056,A020066-020179 @OZ03161 00067908 *A044600 @OZ04613 00068208 *A136210-136280,A139810-139880 @OZ04937 00068508 *A201800 @OZ05600 00068808 *A017100-017200,A017900 @OZ06685 00069108 *A139871-139877 @OZ14626 00069408 *A192701-192702 @OZ14790 00069508 *D135600-136200 @OZ14792 00069608 *A270802 @OZ20755 00069708 *C017300,C018200,A017370-018420,A247800-248100 @OZ30106 00069808 *D248840-248867,A248962,A250775-250776 @OZ30106 00069908 *C199200,C199320 @OZ31408 00070132 *A144320-144380 @OZ32573 00070437 *A145750,A153220-153280 @OZ32593 00070537 *C136250,C139840,C195030 @OZ33388 00070637 * 00070737 *********************************************************************** 00070837 *********************************************************************** 00071608 *01* DESCRIPTIVE-NAME = INITIALIZATION, LOCATE, @YL026UD 00071708 * EXTENDED MVS CVOL SUPPORT @Z40CSRC 00071808 * SU32 RACF VERSION 2 @G32DSFS 00072432 * 00073032 * 00073808 *01* DESCRIPTIVE-NAME = INITIALIZATION, LOCATE, @YL026UD 00078008 * RELATIVE GDG, AND ALIAS @YL026UD 00082008 *01* FUNCTION = INITIALIZATION @YL026UD 00086008 * 1. ESTABLISHES THE WORKAREA @YL026UD 00090002 * 2. CONSTRUCTS THE NAME REFERENCING TABLE @YL026UD 00100002 * 3. BRANCHES TO IGC0002H TO OPEN SYSCTLG @YL026UD 00100802 * 4. ESTABLISHES RPS WORKAREA FOR NON-LOCATE @YL026UD 00101202 * LOCATE @YL026UD 00102002 * 1. LOCATES THE HIGH LEVEL NAME @YL026UD 00110002 * 2. ENQUES AND DEQUES NECESSARY RESOURCES @YL026UD 00120002 * 3. LOCATES BY BLOCK @YL026UD 00130002 * 4. LOCATES THE REMAINING NAME LEVELS @YL026UD 00140002 * 5. SETS LOCATE RETURN CODE @YL026UD 00142002 * 6. DEQUES ALL RESOURCES FOR NORMAL LOCATE @YL026UD 00144002 * 7. RETURNS VOLUME INFORMATION TO CALLER @YL026UD 00146002 * FOR NORMAL LOCATE @YL026UD 00148002 * 8. MAINTAINS A TTR OF THE FIRST DELETABLE @YL026UD 00148408 * BLOCK FOR UCATDX OPERATION @YL026UD 00148802 * RELATIVE GDG AND ALIAS @YL026UD 00149202 * 1. LOCATES RELATIVELY NAMED GENERATION @YL026UD 00149602 * DATA SETS @YL026UD 00149702 * 2. BUILDS ALIAS ENTRIES @YL026UD 00149802 * 3. BUILDS CVOL POINTER ENTRIES @YL026UD 00149902 * 4. RESOLVES ALIAS NAMES AND RE-ENQUES @YL026UD 00153202 * FOR AN OVERVIEW OF THIS MODULE AND ITS RELATIONSHIP WITH THE 00156702 * OTHER CATALOG MANAGEMENT MODULES, REFER TO THE CVOL PROCESSOR 00160008 * PLM, Y35-0011. 00170008 *01* NOTES = LABELS REFERED TO IN COMMENTARY ARE ENCLOSED IN SINGLE 00180002 * QUOTES. EQUATED CONSTANTS ARE PREFIXED WITH 'D' OR 'X' WHEN THEY 00190002 * ARE DECIMAL OR HEXADECIMAL RESPECTIVELY; FOR EXAMPLE, D12 EQU 12, 00200002 * AND X12 EQU X'12'. ERROR CODES ARE SET USING 'ERRORXX' AT 00210002 * CORRESPONDING LABELS, 'ERRXX'. BRANCHES ORIGINATE FROM LABELS 00220002 * 'IGG0CLCX'. FLAGS ARE LABELED 'FLAGX'. IO IS DONE FROM EITHER A 00230002 * SUBROUTINE NAMED 'CALLBLDL' OR A SUBROUTINE NAMED 'IO'. ADDRESS 00240002 * CONVERSION IS ACCOMPLISHED IN SUBROUTINES NAMED 'TOABSL' AND 00250002 * 'TORLTV'. THESE CONVENTIONS ARE FOLLOWED IN EVERY MODULE WHERE 00260002 * THE EVENT EXISTS. 00270002 *02* DEPENDENCIES = THE OPERATION OF THIS MODULE DEPENDS ON THE 00280002 * COLLATING SEQUENCE OF THE EXTERNAL CHARACTER SET. A TRANSLATE 00290002 * AND TEST TABLE IS CONSTRUCTED FOR THE EBCDIC CHARACTER SET AND 00300002 * IS ARRANGED SO THAT REDEFINITION OF THE CHARACTER CONSTANTS BY 00310002 * REASSEMBLY WILL RESULT IN A CORRECT TABLE. THE CONSTANTS IN 00320002 * QUESTION ARE PREFIXED WITH 'CCD', FOR 'CHARACTER CODE 00330002 * DEPENDENT'. 00340002 *02* PERFORMANCE = 1. AN ENQUEUE SCHEME COMPOSED OF THREE 00350002 * RESOURCES (HIGH LEVEL NAME, VOLUME INDEX, 00360002 * AND VICE), WHICH INCREASES THE AVAILABILITY 00370002 * OF SYSCTLG. 00380002 * 2. CATALOG MANAGEMENT OPERATES ENABLED. 00410002 * 3. A TABLE IS CONSTRUCTED FROM THE GIVEN NAME. 00420002 * 4. THE GIVEN NAME IS CHECKED FOR SYNTAX ERRORS 00430002 * IN THIS MODULE. 00440002 *02* RESTRICTIONS = ALL DIRECT ACCESS STORAGE DEVICES EXCEPT 2321 00450002 * DATA CELL ARE SUPPORTED BY CATALOG MANAGEMENT. 00460002 *02* REGISTER-CONVENTIONS = REGISTERS ARE LABELED 'R0,R1,...,R15'. 00470002 * REQUIRED ADDITIONAL LABELS ARE EQUATED TO THESE. REGISTERS 00480002 * COMMON TO ALL MODULES OF CATALOG MANAGEMENT ARE 00490002 * R4 BASE REGISTER FOR THE MODULE. 00500002 * R6 BASE REGISTER FOR THE WORKAREA DSECT. 00510002 * R8 BASE REGISTER FOR THE CAMLSTD DSECT. 00520002 *02* PATCH-LABEL = 'FIXAREA' @YL026UD 00530002 *01* MODULE-TYPE = MODULE 00540002 *02* PROCESSOR = ASSEMBLER 00550002 *02* MODULE-SIZE = SEE EXTERNAL SYMBOL DICTIONARY ABOVE 00560008 *02* ATTRIBUTES = REENTERABLE, READ ONLY, ENABLED, SUPERVISORY MODE 00570002 *01* ENTRY = IGG0CLCC Y01113 00580002 *02* PURPOSE = (IGG0CLC0) THIS IS THE FIRST LOAD OF OS CATLG Y01113 00590002 * PROCESSING. ENTERED TO INITIALIZE THE WORKAREA, Y01113 00600002 * CERTAIN PARAMETERS, AND OPEN THE APPROPRIATE SYSCTLG. Y01113 00610002 * (IGG0CLC1) ENTERED FOR 'LNKX', 'BLDA', 'BLOCK', 'NAME' @YL026UD 00612002 * FOR RELATIVELY NAMED GENERATION DATA SETS, AND ANY @YL026UD 00614002 * REQUEST REQUIRING A LOCATE BY ALIAS NAME. FOR 'LNKX' @YL026UD 00616002 * AND 'BLDA', INSURES THAT REQUEST CAN BE PERFORMED ON @YL026UD 00618002 * STRUCTURE THAT EXISTS IN SYSCTLG. @YL026UD 00618402 * (IGG0CLC2) ENTERED FOR EVERY REQUEST TO FINISH THE @YL026UD 00618802 * LOCATE FUNCTION AND EITHER RETURN TO IGG0CLCA OR @YL026UD 00619202 * IGG0CLCB OR SET UP FOR THE FOLLOWING LOADS OF CATALOG @YL026UD 00619602 * MANAGEMENT. @YL026UD 00619702 *02* LINKAGE = BALR 14,15 00620008 *02* INPUT = 1. R1 -- POINTER TO THE CAMLST (SEE CAMLSTD DSECT FOR 00630002 * A DESCRIPTION OF THE FIELDS) 00640002 * 2. R12 - POINTER TO CONTROLLER III WORKAREA. @YL026UD 00680002 * MUST BE RESTORED AT RETURN. Y01113 00690002 * 3. R13 - POINTER TO REGISTER SAVEAREA @YL026UD 00692002 * (IN CONTROLLER III WORKAREA) @YL026UD 00696002 *02* OUTPUT = FOR A RETURN TO IGG0CLCA OR IGG0CLCB, THE @YL026UD 00700002 * OUTPUT CONSISTS OF, WHERE APPROPRIATE, @YL026UD 00750002 * . LOCATE RETURN CODES @YL026UD 00760002 * . VOLUME LIST FOR DATA SET @YL026UD 00770002 * . TTR OF DSCB FOR DATA SET @YL026UD 00772002 * . VOLUME IDENTIFICATION OF THE CVOL @YL026UD 00774002 * CONTAINING SYSCTLG @YL026UD 00776002 * . DEVICE TYPE OF THE CVOL CONTAINING SYSCTLG @YL026UD 00778002 * . TTR OF THE NEXT VCB @YL026UD 00778402 * THE FORMAT OF THE RETURNED DATA IS DESCRIBED @YL026UD 00778802 * AT 'RETDATA' IN THE WORKAREA. @YL026UD 00779202 *02* EXIT-NORMAL = IGG0CLCD OR IGG0CLCA OR IGG0CLCB @YL026UD 00780002 *02* EXIT-ERROR = IGG0CLC7 @YL026UD 00790002 *01* EXTERNAL-REFERENCES = AS FOLLOWS: 00800002 *02* ROUTINES = IECPBLDL, FREEMAIN, IGC0002H (OPEN/EXTEND), 00810008 * IGG0CL1A (CVOL DYNAMIC ALLOCATION ROUTINE) @Z40CSRC 00812008 *02* DATA-SETS = SYSCTLG 00820002 *02* DATA-AREA = ALL DATA AREAS ARE DESCRIBED BY DSECTS AT THE END 00830002 * OF THE MODULE 00840002 *01* TABLES = 'NAMTABLE' 00850002 *01* MACROS = ENQ, DEQ, GETMAIN, ESTAE, EXCP, WAIT, RACHECK 00860008 * 00870002 **** END OF SPECIFICATIONS ***/ 00880002 EJECT @YL026UD 00890002 IGG0CLCC CSECT @YL026UD 00900002 * 00910002 * SAVE REGISTERS IN CONTROLLER III WORKAREA @YL026UD 00960002 * (REGISTER 12 POINTS TO THE WORKAREA) @YL026UD 00960402 * @YL026UD 00962002 STM R14,R12,12(R13) SAVE REGISTERS 14-12 @YL026UD 00964002 ST R13,612(R12) SAVE REGISTER 13 @YL026UD 00966002 * @YL026UD 00968002 BALR BASE,0 SET BASE REGISTER @YL026UD 00968402 USING *,BASE 00970002 B MODLABEL BRANCH AROUND MOD LABEL @YL026UD 00970402 DC C'IGG0CLCC ' MODULE IDENTIFIER @Z40CSRC 00970808 DC C'&SYSDATE' COMPILATION DATE @Z40CSRC 00974608 DC C'UZ19845' PTF LEVEL @OZ33388 00975337 MODLABEL DS 0H AROUND LABEL @Z40CSRC 00976008 * #YL026UD 00977408 * OBTAIN ADDRESSES OF THE CVT, CALLER'S TCB, AND #YL026UD 00978808 * THIS TASK'S SVRB FROM THE CONTROLLER III WORKAREA #YL026UD 00980208 * #YL026UD 00981608 L R3,596(R12) OBTAIN CVT ADDRESS #YL026UD 00983008 L R9,600(R12) OBTAIN CALLER'S TCB #YL026UD 00984408 L R5,604(R12) OBTAIN THIS TASK'S SVRB #YL026UD 00985808 * #YL026UD 00987208 USING CAMLSTD,R1 00988608 USING CVT,R3 00990002 USING SVRBEXTD,R5 01000002 USING UCB,R11 01010002 USING WORKAREA,R6 01020002 USING BLDLAREA,R13 01030002 * 01032002 TITLE 'IGG0CLCC - (IGG0CLC0) INITIALIZATION AND LOCATE' 01032402 *********************************************************************** 01032802 * * 01033202 * IGG0CLC0 - INITIALIZATION AND LOCATE * 01033602 * * 01033702 *********************************************************************** 01033802 * @YL026UD 01033902 IGG0CLC0 EQU * 01034002 * 01040002 * NECESSARY TO CHECK CALLER'S WORKAREA POINTER? 01050002 * 01060002 L R0,CAMMASK1 GET MASK FOR CAMLST FLAGS 01070002 N R0,CAMLSTD NON-LOCATE? 01080002 * R0 IS NOW A TEMPORARY LOCATE SWITCH (IF 0, LOCATE FUNCTION) 01090002 LR R13,R0 01100002 LR R14,R1 01110002 BNZ GETWA BRANCH IF YES 01120002 L R6,CAMPTR3 GET WA PTR AND SET DSECT BASE 01130002 * 01140002 * SINCE MODULE IGG0CLCA OR IGG0CLCB HAS BUILT THE @YL026UD 01150002 * PARAMETER LIST IN PROTECT KEY ZERO, VALIDITY @YL026UD 01160002 * CHECKING FORMERLY PERFORMED AT THIS POINT IS @YL026UD 01170002 * NO LONGER REQUIRED. @YL026UD 01180002 * 01610002 * 01620002 GETWA EQU * 01630002 * 01640002 LR R8,R14 ESTABLISH BASE FOR CAMLSTD DSECT 01650002 USING CAMLSTD,R8 01660002 DROP R1 01670002 LTR TLOCSW,R13 TEST AND SAVE TEMPORARY LOC SW 01680002 BNZ CATMAIN BRANCH IF NOT LOCATE 01690002 * 01700002 *********************************************************************** 01710008 * FUNCTION LOCATE - GETMAIN FOR BLDLAREA @ZA06685 01712008 *********************************************************************** 01714008 LA R0,BLDLEND-BLDLAREA GET LENGTH AND SUBPOOL @ZA06685 01720008 GETMAIN RC,LV=(0) @OZ30106 01730008 LTR R15,R15 WAS GETMAIN SUCCESSFUL? @OZ30106 01737008 BNZ GETMNERR BR IF NOT @OZ30106 01740008 LR R13,R1 ESTABLISH BLDLAREA BASE 01743008 B ZEROWA BRANCH TO ZERO WORKAREA @OZ30106 01746008 * 01760002 *********************************************************************** 01770008 * NON-LOCATE FUNCTION - GETMAIN FOR WORKAREA/BLDLAREA @ZA06685 01778008 *********************************************************************** 01786008 CATMAIN EQU * 01794008 LA R0,WORKEND-WORKAREA LENGTH AND SUBPOOL NO. 01802008 GETMAIN RC,LV=(0) @OZ30106 01820008 LTR R15,R15 WAS GETMAIN SUCCESSFUL? @OZ30106 01822008 BNZ GETMNERR BR IF NOT @OZ30106 01823008 LR R6,R1 ESTABLISH WORKAREA BASE 01824008 LA R13,BLDLAREA-WORKAREA(R6) ESTABLISH BLDLAREA BASE 01825008 B ZEROWA BR TO ZERO WORKAREA @OZ30106 01826008 * 01827008 *********************************************************************** 01828008 * SET RETURN CODE AND MESSAGE IEC340I - COND. GETMAIN FAILURE @OZ30106* 01829008 *********************************************************************** 01830008 GETMNERR EQU * 01831008 LA R1,MSG1 POINT TO MESSAGE @OZ30106 01832008 WTO MF=(E,(1)) WRITE MESSAGE IEF340I @OZ30106 01833008 SR R0,R0 CLEAR FOR RETURN @OZ30106 01834008 SR R1,R1 CLEAR FOR RETURN @OZ30106 01835008 LTR TLOCSW,TLOCSW LOCATE FUNCTION? @OZ30106 01836008 BNZ NONLERR BR IF NOT @OZ30106 01837008 LA R15,ERROR24 LOCATE ERROR 24 @OZ30106 01838008 B CLCAEXIT EXIT TO CLCA/CLCB @OZ30106 01839008 NONLERR EQU * 01840008 LA R15,ERROR28 NON-LOCATE ERROR 28 @OZ30106 01841008 B CLCAEXIT EXIT TO CLCA/CLCB @OZ30106 01842008 *********************************************************************** 01843008 * 01860002 ZEROWA EQU * 01870002 * 01880002 * CLEAR WORKAREA (SET ALL FLAGS TO ZERO) AND SAVE POINTER Y01113 01890002 * TO CATALOG CONTROLLER WORKAREA. Y01113 01900002 * 01910002 XC WORKAREA(D256),WORKAREA 01920002 ST R12,CWAP SAVE CONTROLLER WA PTR Y01113 01930002 MVC VOLSN,588(R12) OBTAIN SYSCTLG VOLSER @YL026UD 01932002 LTR TLOCSW,TLOCSW TEST TEMPORARY LOCATE SWITCH 01940002 BNZ ESTAESET BRANCH IF NOT LOCATE @YL026UD 01950002 * 01960002 OI FLAG1,LOCATEF * TURN ON PERMANENT LOCATE SW 01970002 * 01980002 * TEMPORARY LOCATE SWITCH NO LONGER NEEDED 01990002 * @YL026UD 01992002 * @YL026UD 01992402 ESTAESET EQU * @YL026UD 01994002 * @YL026UD 01996002 * BUILD ESTAE PARAMETER LIST, ISSUE ESTAE MACRO, @YL026UD 01998002 * AND SET ESTAE-RELATED FLAGS AND POINTERS TO ZERO @YL026UD 01998402 * @YL026UD 01998802 LA R14,D96(R5) SET SVRB SAVEAREA PTR @YL026UD 01999202 ST R14,ESTAER5 SAVE SVRB SAVEAREA PTR @YL026UD 01999602 ST R6,ESTAER6 SAVE CATALOG WKA PTR @YL026UD 01999702 ST R13,ESTAER13 SAVE BLDL WKA PTR @YL026UD 01999802 XC ESTAESVA(40),ESTAESVA ZERO ESTAE INFO AREA @ZA03161 01999908 LA R14,ESTAEPRM GET ESTAE PARM LIST PTR @YL026UD 02003202 L R7,ESTAEXIT LOAD EXIT ADDRESS @ZA03161 02004208 * @YL026UD 02005202 ESTAE (R7),CT,PARAM=(R14),XCTL=YES, @ZA03161*02005608 RECORD=YES,MF=(E,ESTAELST) @YL026UD 02005702 * @YL026UD 02006002 ST R15,ESTAEFLG SAVE ESTAE RETURN CODE YM4836 02006102 LTR R15,R15 TEST ESTAE RETURN CODE @YL026UD 02006402 BZ SAVESVRB BRANCH IF OK @ZA03161 02006608 OI FLAG2,ESTAEFL SET ESTAE ERROR FLAG @ZA03161 02007408 B ERR28 SET PERM I/O ERROR @ZA03161 02011908 * 02013402 * 02016702 SAVESVRB EQU * @YL026UD 02020002 * 02030002 LA R5,D96(R5) SET DSECT BASE REG TO SAVE AREA 02040002 ST R5,SVRBEXTP SAVE POINTER FOR LATER MODULES 02050002 XC SVRBEXT,SVRBEXT ZERO EXTENDED SAVE AREA 02060002 * 02140002 * FIND AND STORE IN THE WORKAREA THE ENTRY POINTS TO THE 02150002 * FOLLOWING RESIDENT ROUTINES FOR LATER USE: 02160002 * A) IECPRLTV (CONVERTS ABSOLUTE DASD ADDRESS TO RELATIVE) 02170002 * B) IECPCNVT (CONVERTS RELATIVE DASD ADDRESS TO ABSOLUTE) 02180002 * C) IECPBLDL (USED TO LOCATE LEVEL NAMES) 02190002 * 02200002 L R14,CVTPRLTV GET ADDRESS 02210002 L R15,CVTPCNVT 02220002 STM R14,R15,CONVERTS STORE IN WORKAREA 02230002 * 02242002 LA R14,IECPBLDL GET BLDL ENTRY ADDRESS @YL026UD 02244002 ST R14,EPBLDL STORE BLDL ENTRY ADDR @YL026UD 02246002 * 02250002 ST R6,BLDLISTP SET LIST POINTER FOR BLDL 02260002 * 02270002 * CONSTRUCT 8 BYTES OF FF FOR THIS AND LATER MODULES 02280002 * 02290002 MVI HIBIN,XFF 02300002 MVC HIBIN+1(L'HIBIN-1),HIBIN 8 BYTES OF FF 02310002 * 02320002 TM CAMOPTN1,CAMBLOCK IS THIS A LOCATE BY TTR ? 02330002 BO UCBSRCH BRANCH IF YES 02340002 * 02350002 * BUILD ENQ/DEQ PARAMETER LIST IN THE SVRB 02360002 * EXTENDED SAVE AREA 02370002 * 02380002 MVC ENQNAME,QNAM SET UP QNAME 02390002 MVI ENQPARM,ENDLIST SET END OF LIST INDICATOR 02400002 MVI ENQRLEN,L'ENQRNAME SET RNAME LENGTH 02410002 LA R14,ENQNAME ADDRESS OF MAJOR NAME 02420002 LA R15,ENQRNAME ADDRESS OF MINOR NAME 02430002 LA R0,UCBADDR ADDRESS OF UCB ADDR 02440002 STM R14,R0,ENQPTRS PUT INTO PARM LIST 02450002 * 02460002 * 02470002 * SCAN THE GIVEN NAME AND CONSTRUCT THE NAME TABLE 02480002 * (SEE NAMTABLE IN WORKAREA DSECT FOR NAMES AND DESCRIPTIONS OF 02490002 * THE NAME TABLE CONTENTS) 02500002 * 02510002 * NOTE: NAME TABLE WAS ZEROED AT ZEROWA 02520002 XC TRTABLE,TRTABLE CLEAR TRT AREA 02530002 MVI TRTABLE+CCDPERD,CODPERD PERIOD TRANSLATES TO 4 02540002 MVI TRTABLE+CCDBLANK,CODBLANK BLANK TRANSLATES TO 8 02550002 MVI TRTABLE+CCDLPARN,CODPARN LEFT PAREN TRANSLATES TO 12 02560002 XR R1,R1 CLEAR FOR TRT 02570002 * 02580002 * 02590002 * SET ONELVLSW AS A FLAG INDICATING A ONE LEVEL OPERATION 02600002 * (BLDA,DLTA,LINKX OR DRPX) 02610002 * IF ONELVLSW IS ZERO, THEN NOT ONE LEVEL OPERATION 02620002 * IF ONELVLSW IS NON-ZERO, THEN ONE LEVEL OPERATION 02630002 * 02640002 L ONELVLSW,ONELVLMK GET ONE LEVEL BIT MASK 02650002 N ONELVLSW,CAMLSTD 'AND' WITH CAM LIST OPTIONS 02660002 XR LEVELCTR,LEVELCTR SET TO 0 02670002 L NAMPSAV,CAMPTR1 GET NAME POINTER 02680002 * NOTE: SAVE NAMEPSAV FOR LATER USE AS HINAMP 02690002 LR LEVELPTR,NAMPSAV INITIALIZE 02700002 LA NAMENDP,D44(NAMPSAV) 02710002 LA DLPTR,NAMLEN1 POINT TO FIRST LEVEL NAME LEN 02720002 * NOTE: FIRST DISPLACEMENT HAS BEEN SET TO 0 02730002 * 02740002 * 02750002 NAMELOOP EQU * 02760002 * 02770002 * SCAN NAME FOR NEXT DELIMITER 02780002 * 02790002 * FIRST: A LEVEL NAME MAY NOT BEGIN WITH A NUMBER OR X'FF' 02800002 * 02810002 TM 0(LEVELPTR),XFF IS FIRST BYTE BINARY 0 OR -1? 02820002 BNM ERR20 BRANCH IF THE ABOVE 02830002 * 02840002 * 02850002 TRTLEVEL EQU * 02860002 * 02870002 TRT 0(D09,LEVELPTR),TRTABLE SCAN TO NEXT DELIMITER 02880002 * UNDER 9 CHARACTERS IN LEVEL NAME? 02890002 BNZ LEVELOK BRANCH IF YES 02900002 * SCANNED 9 AND NO DELIMITER 02910002 LA R1,D08(LEVELPTR) FAKE A GOOD TRT RESULT 02920002 LA R2,CODBLANK SET DELIM CODE TO A BLANK 02930002 * 9 OR MORE CHARACTERS - DOES THE NAME HAVE MORE THAN 44 CHARS 02940002 CR R1,NAMENDP NAME EQUAL 44 BYTES? 02950002 BL ONELVLCK BRANCH IF LESS THAN 44 02960002 LR R1,NAMENDP SET DELIMITER TO MAX NAME 02970002 B LEVELOK PROCESS LEVEL 02980002 * 02990002 * 03000002 ONELVLCK EQU * 03010002 * 03020002 * IS IT A ONE LEVEL OPERATION? 03030002 LTR ONELVLSW,ONELVLSW BLDA,DLTA,LINKX OR DRPX? 03040002 BZ ERR20 BRANCH IF NO 03050002 * 03060002 * 03070002 * IF THIS IS THE FIRST LEVEL, IT IS OK SINCE A DELIMITER IS NOT 03080002 * REQUIRED FOR A ONE LEVEL NAME 03090002 * 03100002 * IS THIS THE FIRST LEVEL? 03110002 * 03120002 * LEVELCTR NOT UPDATED UNTIL LATER, SO IF FIRST, LEVELCTR IS 0 03130002 LTR LEVELCTR,LEVELCTR ZERO? 03140002 BNZ ERR20 BRANCH IF NO 03150002 * 03160002 * 03170002 LEVELOK EQU * 03180002 * 03190002 LR SAVDELP,R1 SAVE DELIMITER POINTER 03200002 SR R1,LEVELPTR CALCULATE LEVEL LENGTH 03210002 BNP ERR20 BRANCH IF 0 OR NEG LEN 03220002 * DECREMENT LENGTH BY 1 FOR LATER EXECUTE INSTRUCTIONS 03230002 BCTR R1,0 DECREMENT LENGTH BY 1 03240002 STC R1,0(DLPTR) SAVE LENGTH IN NAMTABLE 03250002 * INCREMENT NUMBER OF LEVELS GIVEN IN NAME 03260002 LA LEVELCTR,D01(LEVELCTR) INCREMENT BY 1 03270002 * 03280002 * END OF NAME? 03290002 * 03300002 STC R2,NAMDELIM SAVE POSSIBLE NAME DELIMITER 03310002 CLI NAMDELIM,CODPERD LAST DELIMITER NOT A PERIOD? 03320002 BNE NAMEND BRANCH IF YES 03330002 * 03340002 * CALCULATE DISPLACEMENT FOR THE NEXT LEVEL 03350002 * 03360002 LA LEVELPTR,D01(SAVDELP) POINT TO NEXT LEVEL NAME 03370002 LR NXTDISP,LEVELPTR 03380002 SR NXTDISP,NAMPSAV NXTDISP HAS NEXT DISPLACEMENT 03390002 LA DLPTR,D01(DLPTR) POINT TO NEXT LEVEL DISP FIELD 03400002 STC NXTDISP,0(DLPTR) SAVE DISPLACEMENT 03410002 STC NXTDISP,INDEXLEN 03420002 LA DLPTR,D01(DLPTR) POINT TO NEXT LEVEL LEN FIELD 03430002 B NAMELOOP LOOP THROUGH AGAIN 03440002 * 03450002 * 03460002 NAMEND EQU * 03470002 * 03480002 * THE SCAN OF THE NAME IS FINISHED 03490002 * 03500002 ST SAVDELP,NAMDELMP SAVE POINTER TO ENDING DELIM 03510002 * CALCULATE LENGTH OF NAME (MINUS 1 FOR EX INSTRUCTIONS) 03520002 SR SAVDELP,NAMPSAV CALCULATE LENGTH 03530002 BCTR SAVDELP,0 DECREMENT BY 1 03540002 STH SAVDELP,NAMLEN SAVE IN WORKAREA 03550002 BCTR DLPTR,0 DECREMENT BY 1 03560002 ST DLPTR,NAMLSTP SAVE LAST DISPL. POINTER 03570002 STH LEVELCTR,NAMLG SAVE LEVEL COUNTER 03580002 * 03590002 * IS THIS A ONE LEVEL OPERATION (I.E. BLDA,DLTA,LINK OR DRPX)? 03600002 * IF SO, IS THE GIVEN NAME ONE LEVEL? 03610002 * 03620002 LTR ONELVLSW,ONELVLSW TEST ONE LEVEL FLAG 03630002 BZ MOVEHIL BRANCH IF NOT ONE LEVEL 03640002 * 03650002 * ONE LEVEL OPERATION REQUIRES AN UNQUALIFIED NAME 03660002 * 03670002 BCT LEVELCTR,ERR20 BRANCH IF NO 03680002 * 03690002 * 03700002 MOVEHIL EQU * 03710002 * 03720002 * 03730002 * MOVE HIGH LEVEL NAME INTO HILVLNAM BY PREPARING AND USING 03740002 * AN EXECUTE INSTRUCTION 03750002 XR HILVLEN,HILVLEN CLEAR HILVLEN 03760002 IC HILVLEN,NAMLEN1 GET LENGTH OF HIGH LEVEL NAME 03770002 MVI HILVLNAM,CCDBLANK BLANK HILVLNAM 03780002 MVC HILVLNAM+1(L'HILVLNAM-1),HILVLNAM 03790002 EX HILVLEN,MOVENAME MVC HILVLNAM(0),0(NAMPSAV) 03800002 * 03810002 * PUT FIRST LEVEL NAME IN BLDL AND ENQ INPUT PARM LISTS 03820002 * 03830002 MVC NAME,HILVLNAM FIRST LEVEL NAME 03840002 MVC ENQRNAM8,HILVLNAM SET RNAME FOR ENQ 03850002 * 03860002 * 03870002 UCBSRCH EQU * 03880002 * 03890002 * FIND THE UCB OF THE GIVEN VOLUME @YL026UD 03900002 * 03910002 * ESTABLISH A BASE FOR THE UCB DSECT @YL026UD 03920002 * 03940002 L UCBPTR,CVTSYSAD 03950002 * 04020002 * 04030002 SRCHTAB EQU * 04040002 * 04050002 * SEARCH THE UCB TABLE LOOKING FOR THE VOLUME SERIAL @YL026UD 04060002 * CONTAINED IN VOLSN @YL026UD 04070002 * 04080002 L UCBTABP,CVTILK2 GET POINTER TO UCB TABLE 04090002 * 04100002 * SET UP LOOP TO RETURN HERE EACH TIME FOR NEXT UCB ENTRY 04110002 * 04120002 BALR BALREG1,0 SET LOOP RETURN 04130002 LH UCBPTR,0(UCBTABP) GET NEXT UCB ADDRESS @Z30AAEH 04140000 LA UCBTABP,D02(UCBTABP) POINT TO NEXT UCB ENTRY 04150002 LTR UCBPTR,UCBPTR IF 0, NO UCB ENTRY 04160002 BCR 8,BALREG1 REENTER LOOP IF NO 04170002 BP HAVEUCB TEST VALID UCB @Z30AAEH 04172000 N UCBPTR,FFFF DROP HIGH ORDER BITS @Z30AAEH 04174000 C UCBPTR,FFFF TEST FOR END OF TABLE @Z30AAEH 04176000 * TAKE ERROR EXIT IF END OF UCB TABLE AND VOLUME NOT MOUNTED 04180002 BE ERR04 TAKE ERROR EXIT @Z30AAEH 04190000 HAVEUCB TM UCBSTAT,UCBONLI TEST IF ONLINE ZA00015 04192000 BCR 8,BALREG1 OFFLINE, GET NEXT UCB ZA00015 04194002 * 04200002 TM UCBTBYT3,UCB3DACC TEST DEVICE CLASS 04210002 BCR 8,BALREG1 REENTER LOOP IF NOT DASD 04220002 * 04230002 CLC SRTEVOLI,VOLSN COMPARE VOL SER NUMBERS @YL026UD 04240002 BCR 7,BALREG1 GET NEXT UCB 04250002 * 04260002 CLC ZEROVOLS,VOLSN ALL ZEROES VOLID? YA00090 04292002 BE ERR04A YES, ERROR 4 YA00090 04294002 TM UCBFL1,UCBNOTRD TEST IF READY ZA00015 04296002 BO ERR04 NOTREADY-4,MOUNT ZA00015 04298002 * 04300002 * 04310002 SAVEVOL EQU * 04320002 * 04330002 ST UCBPTR,UCBADDR PUT UCB ADDRESS IN RNAME 04350002 * NOTE: SAVE UCB ADDRESS IN UCBPTR FOR SVC OPENEXT INSTRUCTION 04360002 TM CAMOPTN1,CAMBLOCK LOCATE BY BLOCK? 04370002 BO OPENGTMN BRANCH IF YES 04380002 * 04390002 * IF FUNCTION IS LOCATE, ENQUEUE SHARE ON THE HIGH LEVEL NAME, 04400002 * OTHERWISE ENQUEUE EXCLUSIVE 04410002 * 04420002 * NOTE: RNAME ALREADY SET TO HIGH LEVEL NAME. 04430002 * INITIALIZE FLAGS TO HAVE, EXCLUSIVE, RESERVE @ZA04613 04440008 * X01965 04450002 MVI ENQFLAGS,HAVE+RESERVE @ZA04613 04460008 TM FLAG1,LOCATEF * LOCATE FUNCTION? 04470002 BZ ENQNAM BRANCH IF NOT LOCATE 04480002 * 04490002 OI ENQFLAGS,SHARE SET ENQ TO SHARE 04500002 * 04510002 ENQNAM EQU * 04520002 * 04530002 ENQ ,MF=(E,(R5)) 04540002 * 04550002 * INITIALIZE FLAGS FOR VOLUME INDEX ENQUE 04560002 MVI ENQFLAGS,HAVE+SHARE+SYSTEM 04570002 MVC ENQRNAM8,QNAM SET FIRST 8 BYTES OF RNAME 04580002 TM FLAG1,LOCATEF * LOCATE? 04590002 * BRANCH IF YES -- ENQFLAGS ARE PROPERLY SET 04600002 BO ENQVI ENQ ON VOLUME INDEX 04610002 * 04620002 * TEST AND SET FLAG FOR CATBX 04630002 * 04640002 TM CAMOPTN1,CAMCAT CATALOG OPERATION? 04650002 BZ TSTLEVEL BRANCH IF NO 04660002 TM CAMOPTN2,CAMBLDX BLDX OPERATION? 04670002 BZ TSTLEVEL BRANCH IF NO 04680002 OI FLAG1,CATBXF * TURN FLAG BIT ON 04690002 B ENQEXCL SINCE CATBX ENQ EXCLUSIVE 04700002 * 04710002 * 04720002 TSTLEVEL EQU * 04730002 * 04740002 * HOW MANY LEVELS IN THE NAME? 04750002 * 04760002 CLI NAMLG+1,X02 GREATER THAN 2? 04770002 BH ENQVI BRANCH IF YES & ENQ SHARE 04780002 * 04790002 * 04800002 ENQEXCL EQU * 04810002 * 04820002 * ENQUE EXCLUSIVE SINCE IT IS UNKNOWN AT THIS POINT WHETHER OR 04830002 * NOT THE VOLUME INDEX WILL BE MODIFIED. AFTER THE FIRST LEVEL 04840002 * IS LOCATED, ENOUGH INFORMATION IS AVAILABLE TO KNOW IF THE 04850002 * VOLUME INDEX WILL BE MODIFIED. 04860002 * 04870002 NI ENQFLAGS,EXCL SET FLAG TO EXCLUSIVE 04880002 * 04890002 * 04900002 ENQVI EQU * 04910002 * 04920002 ENQ ,MF=(E,(R5)) 04930002 * 04940002 * 04950002 OPENGTMN EQU * 04960002 * 04970002 * GET MAIN STORAGE IN SUBPOOL 253 TO BE USED AS AN OPEN @YL026UD 04980008 * WORKAREA. OPEN (IGC0002H) WILL BUILD THE DEB AND DCB @YL026UD 04990008 * IN THIS AREA. @YL026UD 05000008 * 05010002 * 05020002 * INPUT TO IGC0002H @YL026UD 05030002 * R0 - SET TO ZERO INDICATES AN OPEN CATALOG REQUEST 05040002 * R1 - UCB ADDRESS 05050002 * R15 - ADDRESS OF OPEN WORKAREA 05060002 * 05070002 * 05080002 L R0,SPNBYTES GET SP ID AND SIZE OF WA 05090002 GETMAIN R,LV=(0) 05100002 ST R1,SVOPNWAP SAVE WKA PTR (ESTAE) @YL026UD 05102002 * 05110002 USING DCBAREA,R1 @YL026UD 05120002 ST R6,CATWAP SAVE WORKAREA PTR FOR 2H 05130002 ST R13,BLDLAP SAVE BLDLAREA PTR @YL026UD 05132002 DROP R1 05140002 * 05150002 LR R15,R1 PUT OPEN WA PTR INTO R15 05160002 XR R0,R0 ZERO R0 TO INDICATE OPEN REQUEST 05170002 LR R1,UCBPTR GET UCB ADDRESS @YL026UD 05180002 L R2,OPENMOD GET IGC0002H MOD ADDR @YL026UD 05190002 BALR R14,R2 ISSUE OPEN @YL026UD 05192002 * 05200002 * UPON RETURN: 05210002 * R1 - CONTAINS DCB ADDRESS 05220002 * R15 - CONTAINS RETURN CODE 05230002 * THE NUMBER OF BYTES FOR THE DCB/DEB IS IN THE FIRST WORD OF THE 05240002 * DCB/DEB CALLED NMBYTES 05250002 * 05260002 LR R2,R1 SAVE DCB ADDRESS 05270002 LCR R1,R15 CHECK RETURN CODE AND SET SW 05280002 BNZ IGG0CLC7 BRANCH IF ERROR 05290002 ST R2,DCBADDR SAVE DCB ADDRESS 05300002 L R2,D44(R2) GET DEB ADDRESS 05310002 ST R2,DEBADDR SAVE DEB ADDRESSS 05320002 * 05330002 * 05340002 ***** THE CATALOG IS NOW OPEN 05350002 * 05360002 * 05370002 * IF LOCATE BY BLOCK, BRANCH TO IGG0CLC1 @YL026UD 05380002 * 05390002 TM CAMOPTN1,CAMBLOCK LOCATE BY TTR? 05400002 BO IGG0CLC1 BRANCH IF YES 05410002 * 05420002 MVI BLDLIST+3,BLDLCON SET BLDL INPUT CONSTANT (76) 05430002 * NOTE: FIRST LEVEL NAME HAS ALREADY BEEN PUT INTO THE NAME 05440002 * FIELD FOR BLDL 05450002 MVI TTR+2,REC1 START BLDL SEARCH AT FIRST BLK 05460002 ST R6,BASESAVE SAVE CATALOG WA BASE 05470002 STM R3,R8,SVAREA6 SAVE NECESSARY REGS OVER BLDL 05480002 LM R15,R1,BLDLPARM LOAD INPUT PARAMETERS 05490002 BALR R14,R15 GO TO BLDL 05500002 * 05510002 * OUTPUT FROM BLDL: 05520002 * R15 CATALOG WA R1 05530002 * 0-ENTRY FOUND ENTRY STARTING AT NAME POINT TO ENTRY 05540002 * IN BUFFER 05550002 * 4-ENTRY NOT FOUND UNCHANGED DESTROYED 05560002 * 8-I/O ERROR UNCHANGED DESTROYED 05570002 * 05580002 L R6,BASESAVE RESTORE WA BASE 05590002 LM R3,R8,SVAREA6 RESTORE REGS 05600002 * 05610002 * THE FOLLOWING SHIFT SETS THE CONDITION AS FOLLOWS: 05620002 * IF R15=0,THEN CC=0 RESULT IS ZERO 05630002 * IF R15=4,THEN CC=2 RESULT IS POSITIVE 05640002 * IF R15=8,THEN CC=3 RESULT OVERFLOWS 05650002 * 05660002 SLA R15,D28 SET CONDITION CODE 05670002 * 05680002 * A ZERO 'FOUNDENT' INDICATES NO ENTRY WAS FOUND 05690002 * 05700002 BP ROUTE BRANCH IF NOT FOUND 05710002 * 05720002 ST R1,FOUNDENT SAVE POSSIBLE POINTER TO GIPE 05730002 BO ERR28 BRANCH IF ERROR (R15=8) 05740002 * 05750002 * WHAT TYPE OF ENTRY FOUND? 05760002 * 05770002 CLI TYPEB,NCVOLTYP NEW CVOL TYPE? 05780002 BE TSTDL BRANCH IF YES 05790002 * 05800002 CLI TYPEB,OCVOLTYP OLD CVOL TYPE? 05810002 BNE SHARETST BRANCH IF NO 05820002 * 05830002 * 05840002 TSTDL EQU * 05850002 * 05860002 * TEST FOR DRPX OR LNKX 05870002 * 05880002 OI FLAG2,CVOLF * INDICATE CVOL ENTRY FOUND 05890002 TM CAMOPTN2,CAMLNKX LNKX? 05900002 BO IGG0CLC1 BRANCH IF YES 05910002 TM CAMOPTN3,CAMDRPX DRPX? 05920002 BNO NEWCAT NO, GO GET NEW CATLG @Z40CSRC 05930008 EJECT 05935008 * @Z40CSRC 05936008 * CHECK FOR A DRPX WITHIN A RACF-DEFINED CATALOG @Z40CSRC 05937008 * @Z40CSRC 05938008 TM FLAG5,OCWRACAT IN A RAC-DEFINED CATLG @Z40CSRC 05939008 BNO IGG0CLC2 NO, CONTINUE @Z40CSRC 05939208 L R15,RACFADDR GET ADDR OF RACF RTN @Z40CSRC 05939408 BALR R14,R15 GO CHECK AUTHORIZATION @Z40CSRC 05939608 LTR R15,R15 IS USER UNAUTHORIZED @Z40CSRC 05939808 BNZ ERRRACF YES, SET UP ERROR EXIT @Z40CSRC 05939908 B IGG0CLC2 CONTINUE PROCESSING @Z40CSRC 05943208 EJECT @Z40CSRC 05944208 NEWCAT EQU * NOT LNKX OR DRPX @Z40CSRC 05944708 * 05945208 ********************************************************************** 05945708 * THIS ROUTINE IS ENTERED WHEN A CVOL POINTER ENTRY IS FOUND * 05947008 * AND THE PRESENT CATALOG IS NOT THE DESIRED ONE. * 05954008 * THE FOLLOWING MUST BE DONE: * 05961008 * 1) DEQ THE VOLUME INDEX AND HIGH LEVEL NAME * 05968008 * 2) CLOSE THIS CATALOG * 05975008 * 3) CALL IGG0CL1A TO DYNAMICALLY ALLOCATE THE NEW CVOL @Z40CSRC 05982008 ********************************************************************** 06003008 * GET VOL SER AND DEVICE TYPE INFORMATION FROM CVOL ENTRY. 06020002 * 06030002 XC DEVTYPE,DEVTYPE 0 DEVICE TYPE AREA 06040002 MVC VOLSN,DATAB SAVE VOL SER IF OLD TYPE CVOL 06050002 CLI TYPEB,OCVOLTYP OLD TYPE ENTRY? 06060002 BE DEQVI BRANCH IF YES 06070002 MVC DEVTYPE,DATAB MOVE DEVICE TYPE CODE FROM ENTRY 06080002 MVC VOLSN,DATAB+4 MOVE VOL SER 06090002 * 06100002 DEQVI EQU * 06110008 * DEQUEUE THE VOLUME INDEX @Z40CSRC 06119008 * @Z40CSRC 06190008 DEQ ,MF=(E,(R5)) DEQ VOL INDEX @Z40CSRC 06240008 * @Z40CSRC 06290008 * DEQUEUE THE HIGH LEVEL NAME & 'UN-RESERVE' THE DEVICE @Z40CSRC 06340008 * @Z40CSRC 06390008 MVC ENQRNAM8,HILVLNAM RESTORE NAME @Z40CSRC 06440008 MVI ENQFLAGS,HAVE+SYSTEMS SET DEQ OPTIONS @Z40CSRC 06490008 DEQ ,MF=(E,(R5)) DEQ HIGH LEVEL NAME @Z40CSRC 06540008 * @Z40CSRC 06590008 * FREE DCB/DEB AND CLOSE CATALOG DATA SET. @Z40CSRC 06592008 * @Z40CSRC 06594008 L R1,DCBADDR POINT TO DCB AREA @Z40CSRC 06596008 USING DCBAREA,R1 DCB AREA ADDRESSABLE @Z40CSRC 06598008 L R0,NMBYTES GET LENGTH TO FREE @Z40CSRC 06598408 LA R1,DCBAREA GET ADDR TO FREE @Z40CSRC 06598508 XC SVOPNWAP,SVOPNWAP CLEAR ESTAE'S PTR @Z40CSRC 06598608 FREEMAIN R,LV=(0),A=(1) FREE DCB/DEB STORAGE @Z40CSRC 06598808 DROP R1 ADDRESSABILITY ENDS @Z40CSRC 06599208 NI FLAG2,CVOLFC RESET 'CVPE FOUND' SW @Z40CSRC 06599608 XC PTRS,PTRS CLEAR POINTERS SINCE THEY ARE 06599908 * USED AS SWITCHES @Z40CSRC 06603208 * @Z40CSRC 06605208 * THE FOLLOWING COUNTER PREVENTS INFINITE LOOPING @Z40CSRC 06605608 * IN A CLOSED CHAIN OF CVOLS @Z40CSRC 06606008 * @Z40CSRC 06606408 SR R2,R2 CLEAR REG @Z40CSRC 06606508 IC R2,CVOLCTR GET CVOL COUNTER (IS INITIALIZED*06606608 TO ZERO & DECREMENTED TO *06612008 ZERO AGAIN @Z40CSRC 06612408 BCT R2,NOLOOP DECREMENT & BR IF NOT 0 @Z40CSRC 06612808 * 06613008 B ERR04A BEEN THRU 256 CVOL'S @Z40CSRC 06613208 * @Z40CSRC 06613308 NOLOOP EQU * LESS THAN 256 CVOL'S @Z40CSRC 06616608 * @Z40CSRC 06618608 * NOT IN A CVOL LOOP @Z40CSRC 06619008 * @Z40CSRC 06619408 STC R2,CVOLCTR STORE UPDATE COUNT @Z40CSRC 06619808 * @Z40CSRC 06619908 * INVOKE IGG0CL1A TO DYNAMICALLY ALLOCATE THE NEW CVOL @Z40CSRC 06620008 * @Z40CSRC 06623308 * INTERFACE WITH IGG0CL1A -- @Z40CSRC 06625308 * R12 - ADDRESS OF CONTROLLER III WORK AREA @Z40CSRC 06625608 * R14 - RETURN ADDRESS @Z40CSRC 06625908 * R15 - ENTRY POINT ADDRESS @Z40CSRC 06626208 * ALL REGISTERS ARE SAVED AND RESTORED BY IGG0CL1A @Z40CSRC 06626508 * IN A SAVE AREA IN THE CONTROLLER WORK AREA. @Z40CSRC 06626608 * R15 - 0 IF SUCCESSFUL, NON-ZERO IF UNSUCCESSFUL @Z40CSRC 06626708 * @Z40CSRC 06627008 L R12,CWAP GET WORK AREA ADDR @Z40CSRC 06627108 USING CC3WA,R12 WORK AREA ADDRESSABLE @Z40CSRC 06627208 MVC CC3CVOLS,VOLSN SET UP CVOL VOLSER @Z40CSRC 06627308 L R15,ALLOCRTN GET ADDR OF ROUTINE @Z40CSRC 06627408 BALR R14,R15 CALL IGG0CL1A @Z40CSRC 06627508 LTR R15,R15 WAS ALLOCATION OK @Z40CSRC 06627608 BZ SRCHTAB YES, GO FIND UCB @Z40CSRC 06627708 STC R15,ERRLOCSV SAVE ERROR CODE @Z40CSRC 06627808 B IGG0CLC7 EXIT TO ERROR ROUTINE @Z40CSRC 06628008 DROP R12 ADDRESSABILITY ENDS @Z40CSRC 06629008 EJECT 06630108 SHARETST EQU * 06633408 * 06636708 TM ENQFLAGS,SHARE ENQUED SHARED? 06640002 BZ DEQTST BRANCH IF NO 06650002 * 06660002 * VOLUME INDEX NO LONGER NEEDED SINCE FIRST LEVEL FOUND 06670002 * 06680002 B DEQUE GO DEQUE & ROUTE X01965 06690002 * 06700002 * 06710002 DEQTST EQU * 06720002 * 06730002 * THE VOLUME INDEX WAS ENQUED EXCLUSIVE. ENOUGH INFORMATION IS 06740002 * NOW AVAILABLE TO CONCLUDE WHETHER THE VOLUME INDEX IS TO BE 06750002 * MODIFIED. IF THE NUMBER OF LEVELS GIVEN IS ONE OR THE 06760002 * FIRST ENTRY IS A A GIPE, THEN THE VOLUME INDEX MAY NOT 06770002 * BE DEQUEUED SINCE IT WILL BE MODIFIED. 06780002 * 06790002 CLI NAMLG+1,X01 NO. OF LEVELS 1? 06800002 BE ROUTE BRANCH IF YES 06810002 * 06820002 CLI TYPEB,GIPETYP GIPE? 06830002 BE ROUTE BRANCH IF YES 06840002 * X01965 06850002 DEQUE EQU * X01965 06860002 * 06870002 * THE VOLUME INDEX WILL NOT BE MODIFIED, SO DEQ 06880002 * 06890002 DEQ ,MF=(E,(R5)) 06900002 * 06910002 * 06920002 ROUTE EQU * 06930002 * 06940002 * ROUTE THE REQUEST TO CLC1 OR CLC2 06950002 * 06960002 TM CAMOPTN2,CAMBLDA+CAMLNKX BLDA OR LNKX OPERATION? 06970002 BM IGG0CLC1 BRANCH IF YES 06980002 * 06990002 * IF AN ALIAS ENTRY, XCTL TO IGG0CLC1 TO RESOLVE ALIAS NAME AND 07000002 * ENQ ON THE TRUE NAME AND DEQ ON THE ALIAS NAME, 07010002 * UNLESS A DLTA OPERATION, THEN XCTL TO CLC2 AND DO NOT ENQ ON 07020002 * THE ALIAS NAME --- THIS AVOIDS A POTENTIAL ENQ INTERLOCK 07030002 * BETWEEN THE VOLUME INDEX RESOURCE AND THE TRUE NAME RESOURCE 07040002 * 07050002 TM CAMOPTN2,CAMDLTA DLTA? 07060002 BO IGG0CLC2 BRANCH IF YES 07070002 * 07080002 CLI TYPEB,ALIASTYP ALIAS ENTRY? 07090002 BE IGG0CLC1 BRANCH IF YES 07100002 * @YL026UD 07102002 * BRANCH TO IGG0CLC2 FOR ALL OTHER REQUESTS @YL026UD 07110002 * 07120002 B IGG0CLC2 @YL026UD 07122002 TITLE 'IGG0CLCC - (IGG0CLC1) RELATIVE GDG AND ALIAS' @YL026UD 09140002 *********************************************************************** 09190002 * * 09240002 * IGG0CLC1 - RELATIVE GDG AND ALIAS * 09290002 * * 09340002 *********************************************************************** 09390002 * @YL026UD 09440002 IGG0CLC1 EQU * 10080002 * 10082002 DROP R3 @YL026UD 10084002 DROP R11 @YL026UD 10086002 * 10088002 USING WORKAREA,R6 ESTABL BASE FOR WORKAREA 10096002 USING CAMLSTD,R8 ESTABL BASE FOR CAMLST 10106002 USING BLDLAREA,R13 ESTABL BASE FOR BLDL'S WORKAREA 10116002 OI MODMAP1,MODCLC1 INDIC ENTRY TO IGG0CLC1 10140002 * 10150002 TM CAMOPTN1,CAMBLOCK LOCATE BY TTR? 10160002 BO BYBLOCK BRANCH IF YES 10170002 * 10180002 * IF CONTROL WAS RECEIVED FROM IGG0CLC2, THEN REQUEST IS FOR 10190002 * LOCATING A RELATIVELY NAMED GENERATION DATA SET. 10200002 * 10210002 TM MODMAP1,MODCLC2 CONTROL FROM IGG0CLC2? 10220002 BO RELGDG YES, MUST BE RELATIVE GDS NAME 10230002 * 10240002 TM CAMOPTN2,CAMBLDA FUNCTION BLDA? 10250002 BO BLDARTN YES, GO TO BUILD ALIAS ROUTINE 10260002 * 10270002 TM CAMOPTN2,CAMLNKX FUNCTION LNKX? 10280002 BO LNKXRTN YES, GO TO 'LNKXRTN' 10290002 * 10300002 CLI TYPEB,ALIASTYP ALIAS ENTRY FOUND? 10310002 BE ALIAS YES, GO RESOLVE ALIAS NAME 10320002 * 10330002 B ERR08 DO NOTHING 10340002 * 10350002 LNKXRTN EQU * 10360002 * 10370002 * LNKX FUNCTION (CONNECT CVOL'S) 10380002 * 10390002 NC FOUNDENT,FOUNDENT WAS AN ENTRY FOUND? 10400002 BNZ ERR12 YES, DON'T LNKX 10410002 * 10420002 * BUILD THE ENTRY AND PASS CONTROL TO IGG0CLC2. 10430002 * 10440002 * ESTABLISH AUXILIARY ADDRESSABILITY TO THE PORTION OF THE 10450002 * WORKAREA IN WHICH THE NEW CVOL POINTER ENTRY WILL BE BUILT. 10460002 * 10470002 LA NEWENTRY,NAME NEW ENTRY STARTS AT NAME 10480002 USING ENTRY,NEWENTRY ESTABL BASE FOR ENTRY 10490002 L POINT,CAMPTR3 DEVICE TYPE & CVOL VOLUME SERIAL 10500002 * 10510002 * BUILD THE ENTRY. 10520002 * 10530002 MVI ETYPE,NCVOLTYP MOVE IN COUNT OF HALF WORDS 10540002 XC ETTR,ETTR ZERO THE TTR FIELD 10550002 * 10560002 * MOVE IN 4-BYTE DEVICE TYPE AND 6-BYTE VOLUME SERIAL 10570002 * 10580002 MVC EDEVTYP(L'EDEVTYP+L'EVOLID),0(POINT) 10590002 B IGG0CLC2 BRANCH TO IGG0CLC2 @YL026UD 10600002 * 10610002 DROP NEWENTRY 10620002 * 10630002 EJECT 10640002 * 10650002 BLDARTN EQU * 10660002 * 10670002 NC FOUNDENT,FOUNDENT WAS AN ENTRY FOUND? 10680002 BZ ERR08 NO, DON'T BLDA 10690002 * 10700002 * BUILD THE ALIAS ENTRY 10710002 * 10720002 CLI TYPEB,IPETYP IS ENTRY FOUND AN IPE? 10730002 BNE ERR08 NOT AN IPE 10740002 * 10750002 MVC TRUE,NAME MOVE TRUE NAME INTO AE 10760002 L R3,TTR0 SAVE THE TTR0 10770002 L R1,CAMPTR3 POINT TO ALIAS 10780002 TM 0(R1),XFF IS FIRST BYTE BINARY 0 OR -1? 10790002 BNM ERR20 YES, ERROR 10800002 * 10810002 MVC NAME,0(R1) MOVE IN ALIAS NAME 10820002 LA R0,X0100 GET TTR TO FIRST BLK 10830002 ST R0,TTR START BLDL AT FIRST BLK 10840002 * 10850002 * SEARCH FOR DUPLICATE ALIAS NAME OR GET BLOCK TO BE UPDATED 10860002 * 10870002 BAL BALREG3,CALLBLDL SEARCH FOR ALIAS 10880002 BZ ERR12 BRANCH IF NAME FOUND 10890002 * 10900002 * CONSTRUCT ALIAS ENTRY 10910002 * 10920002 ST R3,TTR0 RESTORE THE TTR0 10930002 MVI TYPE,ALIASTYP SET TYPE CODE 10940002 OI FLAG2,ALIASBLT * INDIC ALIAS ENTRY IS BUILT 10950002 B IGG0CLC2 BRANCH TO IGG0CLC2 @YL026UD 10960002 * 10970002 EJECT 10980002 * 10990002 ALIAS EQU * 11000002 * 11010002 * FIRST LOAD OF LOCATE FOUND AN ALIAS ENTRY. 11020002 * 11030002 * 1. TRANSLATE THE ALIAS NAME INTO THE TRUENAME 11040002 * 2. MOVE TRUE QUALIFIED NAME INTO DSNAME AREA PASSED BY USER 11050002 * 3. UPDATE THE NAME TABLE. 11060002 * 4. ENQUEUE THE TRUE HIGH-LEVEL NAME. 11070002 * 5. DEQUEUE THE ALIAS NAME. 11080002 * 11090002 * 11100002 OI FLAG2,ALIASSW FLAG ALIAS ENTRY FOUND @YL026UD 11102002 * @YL026UD 11104002 * INITIALIZE REGISTERS. 11110002 * 11120002 L R3,CAMPTR1 ALIAS NAME POINTER 11130002 XR R7,R7 ZERO R7 11140002 XR R1,R1 ZERO R1 11150002 * 11160002 * SET UP TRANSLATE TABLE TO SCAN TRUE NAME IN ALIAS ENTRY FOR 11170002 * FIRST BLANK (OR END). 11180002 * 11190002 XC TRTABLE,TRTABLE CLEAR THE TRANSLATE TABLE 11200002 MVI TRTABLE+CCDBLANK,CODBLANK BLANK TRANSLATES TO 08 11210002 TRT TRUEB,TRTABLE SCAN TRUE NAME 11220002 BNZ UNDER8 FOUND A BLANK 11230002 * 11240002 * ALL EIGHT CHARACTERS ARE SIGNIFICANT. 11250002 * 11260002 LA R1,D08 PUT LENGTH IN R1 11270002 B STRULEN GO STORE TRUE NAME LENGTH 11280002 * 11290002 * 11300002 UNDER8 EQU * 11310002 * 11320002 * LESS THAN EIGHT CHARACTERS ARE SIGNIFICANT. 11330002 * 11340002 LA R0,TRUEB TRUE NAME AS FOUND BY BLDL 11350002 SR R1,R0 LENGTH OF TRUE NAME IN R1 11360002 * 11370002 STRULEN EQU * 11380002 * 11390002 * SAVE THE LENGTH OF THE TRUE FIRST LEVEL NAME. 11400002 * FIND THE TOTAL LENGTH OF THE GIVEN NAME, OUT TO A LEFT 11410002 * PARENTHESIS IF PRESENT. 11420002 * 11430002 LR TRULEN,R1 SAVE TRUE LENGTH 11440002 LH R1,NAMLEN (LENGTH-1) OF FULL NAME 11450002 CLI NAMDELIM,CODBLANK LAST DELIMITER A BLANK? 11460002 BE CHEKLEN YES, CHECK LENGTH 11470002 * 11480002 * R1 CONTAINS (LENGTH-1) OF GIVEN NAME OUT TO LAST LEVEL, WHICH 11490002 * WHEN RESOLVED WILL REQUIRE 8 CHARACTERS PLUS A DELIMITER. 11500002 * 11510002 LA R1,D09(R1) SET R1 TO FINAL NAME LENGTH 11520002 * 11530002 CHEKLEN EQU * 11540002 * 11550002 * SAVE THE NAME AS GIVEN SA48399 11560002 * BLANK THE GIVEN NAME IN THE USER AREA SA48399 11570002 * SA48399 11580002 MVC RESALIAS,0(R3) SAVE THE GIVEN NAME SA48399 11590002 MVI 0(R3),CCDBLANK SET UP TO BLANK USER NAMESA48399 11600002 LR R11,R1 (LENGTH-1) OF FINAL NAME SA48399 11610002 EX R11,MOVE2 BLANK THE AREA SA48399 11620002 * SA48399 11630002 * CALCULATE LENGTH OF 'TRUENAME.SECONDLEVEL...LASTLEVEL' 11640002 * LAST LEVEL IS 8 BYTES LONG IF NAME WAS RELATIVE GDG. 11650002 * 11660002 IC R7,NAMLEN1 (LENGTH-1) OF ALIAS 11670002 SR R1,R7 SUBTRACT (LENGTH-1) OF ALIAS 11680002 * 11690002 * ADD (LENGTH-1) OF TRUE 11700002 * 11710002 AR R1,TRULEN ADD LENGTH OF TRUE 11720002 * 11730002 LA R0,D44 MAXIMUM LENGTH 11740002 CR R1,R0 IS FINAL RESULT TOO LONG? 11750002 BH ERR20 YES SA48399 11760002 * SA48399 11770002 * IF NAME IS LESS THAN 44 BYTES THEN MOVE NAME PLUS SA48399 11780002 * TRAILING BLANK. SA48399 11790002 * SA48399 11800002 * IF NAME IS 44 BYTES LONG THEN MOVE 44 BYTES. SA48399 11810002 * SA48399 11820002 BL RECONSTR GO MOVE NAME +1 BYTE SA48399 11830002 * SA48399 11840002 BCTR R1,0 MINUS 1, NAME IS 44 BYTESSA48399 11850002 * SA48399 11860002 RECONSTR EQU * SA48399 11870002 * 11880002 * FINAL RESULT IS AN ALLOWABLE LENGTH 11890002 * 11900002 * 1. MOVE IN TRUE FIRST LEVEL NAME. SA48399 11910002 * 2. MOVE BACK IN SECOND THRU LAST LEVELS. SA48399 11920002 * 11930002 MVC 0(L'TRUEB,R3),TRUEB MOVE IN TRUE FIRST LEVEL 11940002 CLC NAMLG,H01 ONE LEVEL NAME? 11950002 BE NOLOW YES, NO LOW LEVELS TO MOVE 11960002 * 11970002 AR R3,TRULEN POINT TO FIRST DELIMITER 11980002 * 11990002 * OBTAIN (LENGTH-1) OF SECOND THRU LAST LEVELS, 12000002 * INCLUDING FIRST DELIMITER, FOR AN EXECUTE INSTRUCTION 12010002 * 12020002 SR R1,TRULEN ELIMINATE LENGTH OF FIRST LEVEL 12030002 LA R11,RESALIAS+1(R7) POINT TO FRST DELIM IN SVD NAME 12040002 EX R1,MOVE1 MOVE IN REST OF NAME 12050002 * 12060002 * FULLY QUALIFIED TRUE NAME IS SET UP IN USER'S AREA. 12070002 * 12080002 NOLOW EQU * 12090002 * 12100002 * UPDATE NAME TABLE IF NECESSARY. 12110002 * 12120002 BCTR TRULEN,0 (LENGTH-1) OF TRUE 12130002 STC TRULEN,NAMLEN1 SAVE (LENGTH-1) OF FIRST LEVEL 12140002 SR TRULEN,R7 ARE ALIAS AND TRUE SAME LENGTH? 12150002 BZ RESOLVED YES, NAME TABLE IS OK 12160002 * 12170002 * ALIAS AND TRUE NAMES DIFFER IN LENGTH. UPDATE NAME TABLE. 12180002 * TRULEN CONTAINS (TRUE LENGTH) - (ALIAS LENGTH) 12190002 * 12200002 XR R7,R7 ZERO R7 12210002 LH R9,NAMLG SET LOOP COUNTER 12220002 LA R11,NAMDISP2 POINT TO SECOND DISPLACEMENT 12230002 BCT R9,NXTLVL DECR LOOP COUNTER 12240002 * 12250002 B NOLOW2 NO LOW LEVELS TO UPDATE 12260002 * 12270002 * 12280002 NXTLVL EQU * 12290002 * 12300002 * CHANGE EACH DISPLACEMENT TO CORRESPOND WITH CHANGE IN LENGTH 12310002 * OF FIRST LEVEL. 12320002 * 12330002 IC R7,0(R11) GET DISPLACEMENT 12340002 AR R7,TRULEN CHANGE IT 12350002 STC R7,0(R11) STORE NEW DISPLACEMENT 12360002 LA R11,D02(R11) BUMP TO NEXT 'NAMDISP' 12370002 BCT R9,NXTLVL LOOP, TO END OF NAME TABLE 12380002 * 12390002 NOLOW2 EQU * 12400002 * 12410002 L R11,NAMDELMP GET 'NAMDELMP' 12420002 AR R11,TRULEN CHANGE 'NAMDELMP' 12430002 ST R11,NAMDELMP STORE UPDATED POINTERS 12440002 AH TRULEN,NAMLEN CHANGE 'NAMLEN' 12450002 STH TRULEN,NAMLEN STORE UPDATED LENGTH 12460002 * 12470002 RESOLVED EQU * 12480002 * 12490002 * NAME AND NAME TABLE ARE UPDATED. 12500002 * 12510002 * RE-ENQUEUE 12520002 * 12530002 USING SVRBEXTD,R5 ESTABL ADDRBLTY TO SVRB EXT SA 12540002 L R5,SVRBEXTP SET BASE 12550002 IC R7,ENQFLAGS SAVE FLAG BYTE 12560002 MVI ENQFLAGS,HAVE+SYSTEMS INDIC TYPE OF REQUEST X01965 12570002 TM FLAG1,LOCATEF * LOCATE REQUEST? 12580002 BZ EXCLUSIV NO 12590002 * 12600002 OI ENQFLAGS,SHARE INDIC SHARED ENQ 12610002 * 12620002 EXCLUSIV EQU * 12630002 * 12640002 * ENQUEUE THE TRUE HIGH LEVEL NAME. 12650002 * 12660002 MVC HILVLNAM,TRUEB SAVE TRUE NAME FOR IGG0CLC2 12670002 MVC ENQRNAM8,TRUEB SET RNAME TO TRUE NAME 12680002 ENQ ,MF=(E,(R5)) 12690002 MVC ENQRNAM8,ALIASNAM SET RNAME TO ALIAS NAME 12700002 DEQ ,MF=(E,(R5)) 12710002 MVC ENQRNAM8,ENQNAME SET RNAME BACK TO SYSCTLG 12720002 STC R7,ENQFLAGS RESTORE FLAG BYTE 12730002 * 12740002 * ALIAS NAME IS COMPLETELY RESOLVED. 12750002 * 12760002 * PASS CONTROL TO IGG0CLC2 FOR THE REMAINDER OF LOCATE. 12770002 * 12780002 * IGG0CLC2 WILL RETURN HERE IF RELATIVE NAMING IS USED IN A 12790002 * LATER LEVEL. 12800002 * 12810002 B IGG0CLC2 GO FINISH FUNCTION 12820002 EJECT 12830002 * 12840002 RELGDG EQU * 12850002 * 12860002 TM FLAG1,LOCATEF IS FUNCTION LOCATE? 12870002 BZ ERR20 NO 12880002 * 12890002 * THE FUNCTION IS LOCATE A GENERATION DATA SET AND THE 12900002 * NAME GIVEN IS IN RELATIVE FORMAT. 12910002 * 12920002 * 1. CONVERT RELATIVE MEMBER TO BINARY - RESULT IS 'QUALIFIER'. 12930002 * 2. READ FIRST BLOCK OF GENERATION DATA SET NAMES. 12940002 * 12950002 * IF QUALIFIER IS POSITIVE 12960002 * . TRANSLATE FIRST NAME TO BINARY. 12970002 * . ADD THE QUALIFIER. 12980002 * . BUILD A NEW NAME. 12990002 * . RETURN. 13000002 * 13010002 * IF QUALIFIER IS NEGATIVE OR ZERO 13020002 * . USE QUALIFIER TO COUNT ENTRIES UNTIL QUALIFIER IS ZERO OR 13030002 * NAMES ARE EXHAUSTED. 13040002 * . IF QUALIFIER IS ZERO, DESIRED ENTRY IS FOUND. 13050002 * RETURN TO USER WITH ABSOLUTE NAME AND VOLUME LIST. 13060002 * . IF NAMES ARE EXHAUSTED RETURN TO USER WITH ERRLOC=8. 13070002 * 13080002 L R1,NAMDELMP POINT TO LEFT PAREN '(' 13090002 MVC RELNUMBR,L'CCDLPARN(R1) GET NEXT 8 CHARACTERS 13100002 LA R1,RELNUMBR POINT TO RELATIVE NUMBER 13110002 * 13120002 AGAIN EQU * 13130002 * 13140002 * SCAN DIGITS FOR RIGHT PARENTHESIS ')' TO GET LENGTH. 13150008 * 13160002 LA R1,D01(R1) NEXT DIGIT 13170002 TM 0(R1),XF0 NUMBER? 13180002 BO AGAIN YES 13190002 * 13200002 * NOT A NUMBER, MUST BE RIGHT PARENTHESIS ')' 13210002 * 13220002 CLI 0(R1),CCDRPARN ')'? 13230002 BNE ERR20 NO 13240002 * 13250002 BCTR R1,0 LEAST SIGNIFICANT DIGIT 13260002 CLI RELNUMBR,CCDMINUS IS FIRST CHARACTER '-'? 13270002 BNE POS NO 13280002 * 13290002 MVI RELNUMBR,CCD0 YES, CHANGE IT TO ZERO 13300002 MVZ 0(L'MINUS,R1),MINUS MOVE IN A MINUS ZONE 13310002 B NUMBER GO CONVERT IT TO BINARY 13320002 * 13330002 * 13340002 POS EQU * 13350002 * 13360002 CLI RELNUMBR,CCDPLUS IS FIRST CHARACTER '+'? 13370002 BNE NUMBER NO, GO CONVERT IT TO BINARY 13380002 * 13390002 MVI RELNUMBR,CCD0 YES, CHANGE IT TO A ZERO 13400002 * 13410002 NUMBER EQU * 13420002 * 13430002 TM RELNUMBR,XF0 IS FIRST CHARACTER A NUMBER? 13440002 BNO ERR20 NO 13450002 * 13460002 LA R2,RELNUMBR YES, POINT TO IT 13470002 SR R1,R2 SUBTRACT FOR LENGTH 13480002 XC PKDNUMBR,PKDNUMBR ZERO AREA FOR PACKING 13490002 EX R1,PACK1 PACK THE RELATIVE NUMBER 13500002 CVB Q,PKDNUMBR Q IS QUALIFIER REGISTER 13510002 * 13520002 * THE GIPE WAS READ BY BLDL. THE DATA PORTION IS TWO BYTES 13530002 * DISPLACED FROM ITS NORMAL POSITION IN A CATALOG ENTRY. 13540002 * 13550002 * @ZA04937 13621008 * TEST FOR SUPER LOCATE WITH BASE SUPPLIED AND IF SO @ZA04937 13622008 * SET UP THE SUPPLIED BASE @ZA04937 13623008 * @ZA04937 13624008 TM CAMOPTN3,X'06' TEST FOR SLOC WITH BASE @OZ33388 13625008 BNO NEWBLOCK NO SKIP BASE SETUP @ZA04937 13626008 L R7,CAMDSCBP LOAD POINTER TO BASE @ZA04937 13627008 XC 0(4,R7),MASKFF MATCH PATTERN IN CATALOG @ZA04937 13628008 * 13630002 * QUALIFIER REGISTER IS THE BINARY EQUIVALENT OF THE GIVEN 13640002 * RELATIVE NUMBER AND IS USED AS 13650002 * 13660002 * 1. IF NEGATIVE, AN ENTRY COUNTER WHILE SCANNING THE 13670002 * BLOCKS FOR THE DESIRED ENTRY. 13680002 * 13690002 * 2. IF POSITIVE, AN INCREMENT TO ALTER THE FIRST 13700002 * ENTRY IN THE GENERATION DATA GROUP TO PRODUCE A NEW 13710002 * ABSOLUTE NUMBER. 13720002 * 13730002 * 3. IF ZERO, AN INDICATOR TO LOCATE THE LATEST DATA SET. 13740002 * 13750002 * 13760002 NEWBLOCK EQU * 13770002 * 13780002 * CALL BLDL TO READ IN THE BLOCK AT TTR 13790002 * 13800002 XC NAME,NAME ZERO THE NAME 13810002 BAL BALREG3,CALLBLDL READ THE BLOCK 13820002 * 13830002 * SET UP POINTERS TO INDICATE START OF FIRST ENTRY (POINT) 13840002 * AND END OF LAST ENTRY (LAST). 13850002 * 13860002 USING ENTRY,POINT ESTABL ADDRBLTY TO ENTRY 13870002 LA POINT,BLDLBUFF+L'INBYTSU SKIP HALFWORD OF BYTE CNT 13880002 CLI ETYPE,ICETYP ICE? 13890002 BNE NXTENTRY NO, 'POINT' IS GOOD 13900002 LA POINT,L'ICE(POINT) YES, BUMP 'POINT' TO NEXT ENTRY 13910002 * 13920002 * DETERMINE WHETHER OR NOT THIS IS THE DESIRED ENTRY. 13930002 * 13940002 NXTENTRY EQU * 13950002 * 13960002 CLC ENAME,HIBIN IS NAME ALL FF'S? 13970002 BE FFF YES 13980002 * @ZA04937 13981008 * TEST FOR SUPERLOCATE WITH BASE @ZA04937 13982008 * @ZA04937 13983008 TM CAMOPTN3,X'06' TEST FOR SLOC WITH BASE @OZ33388 13984008 BNO NSLOC BR IF NOT @ZA04937 13985008 CLC EGENNO,0(R7) COMP CATLG GENERATION & BASE 13985408 BL INCRNXT BR IF BASE NOT REACHED YET @ZA04937 13985808 BE NSLOC BASE FOUND - BR @ZA14626 13986208 * THIS CODE ADJUSTS Q WHEN BASE HAS BEEN DELETED 13986608 CVB R0,PKDNUMBR BASE DELETED, GET GIVEN Q @OZ14626 13987008 CR R0,Q HAS Q BEEN INCREMENTED? @OZ14626 13987408 BNE NSLOC YES-BR, Q ALREADY ADJUSTED @OZ14626 13987808 AH Q,H01 REL GEN 0 DELETED, ADJUST SO WE CAN 13988208 * FIND CORRECT (-X) GENERATION@OZ14626 13988608 NSLOC EQU * @OZ04937 13989608 * 13990002 LTR Q,Q IS QUALIFIER NEGATIVE? 14000002 BNM COMPL NO, THIS IS THE DESIRED ENTRY 14010002 * 14020002 AH Q,H01 YES, INCREMENT QUALIFIER 14030002 * 14040002 * INCREMENT POINT TO NEXT ENTRY. 14050002 * 14060002 INCRNXT EQU * @ZA04937 14061008 XR R2,R2 ZERO R2 14070002 IC R2,ETYPE GET COUNT OF HALFWORDS 14080002 LA R2,D12(R2,R2) CALCULATE ENTRY LENGTH 14090002 AR POINT,R2 INCREMENT POINT 14100002 B NXTENTRY GO CHECK 14110002 * 14120002 * 14130002 FFF EQU * 14140002 * 14150002 * END OF BLOCK, CHECK FOR ANOTHER. 14160002 * 14170002 NC ETTR,ETTR ANOTHER BLOCK IN CHAIN? 14180002 BZ NEWGEN NO 14190002 * 14200002 MVC TTR,ETTR YES, GET ITS TTR 14210002 B NEWBLOCK GO READ THE BLOCK 14220002 * 14230002 * 14240002 NEWGEN EQU * 14250002 * 14260002 * NAME WAS NOT FOUND, BUILD ABSOLUTE NAME. 14270002 * 14280002 LTR Q,Q IS QUALIFIER POSITIVE? 14290002 BNP ERR08 NO 14300002 * 14310002 XC ENAME,ENAME SET UP FOR BUILD 14320002 MVI ENAME,CCDG FIRST CHARACTER IS G 14330002 MVI ENAME+5,CCDV SIXTH CHARACTER IS V 14340002 XR R2,R2 ZERO R2 14350002 B ADDQUAL GO ADD QUALIFIER REG 14360002 * 14370002 * 14380002 COMPL EQU * 14390002 * 14400002 * ENTRY AT POINT IS THE DESIRED ENTRY. TRANSLATE ITS 14410002 * GENERATION NUMBER INTO BINARY FOR ENSUING CALCULATION. 14420002 * 14430002 CLI ENAME,CCDG FIRST CHAR A 'G'? @OZ32573 14432008 BNE ERR12 BR IF NOT @OZ32573 14434008 CLI ENAME+5,CCDV SIXTH CHAR A 'V'? @OZ32573 14436008 BNE ERR12 BR IF NOT @OZ32573 14438008 XC EGENNO,MASKFF COMPLEMENT GENERATION NUMBER 14440002 LTR Q,Q GENERATING A NEW NAME? 14450002 BZ MOVE NO 14460002 * 14470002 PACK PKDNUMBR,EGENNO YES, PACK THE NUMBER FOUND 14480002 CVB R2,PKDNUMBR CONVERT IT TO BINARY 14490002 * 14500002 ADDQUAL EQU * 14510002 * 14520002 AR R2,Q ADD QUALIFIER TO GENERATN NO. 14530002 CVD R2,PKDNUMBR CONVERT GENERATN NO. TO DECIMAL 14540002 UNPK EGENNO,PKDNUMBR UNPACK GENERATN NO. 14550002 OI L'EGENNO(POINT),CCD0 ENSURE LO-ORDER DIGIT UNSIGNED 14560002 MVC L'EGENNO+2(L'ZEROS,POINT),ZEROS SET VERSION NO. TO ZERO 14570002 OI FLAG4,GDGPLUS GDG REL. NO. IS PLUS @OZ32593 14575008 * 14580002 MOVE EQU * 14590002 * 14600002 L R2,NAMDELMP POINT TO DELIMITER 14610002 MVI 0(R2),CCDPERD CHANGE '(' TO '.' 14620002 MVC L'CCDPERD(L'ENAME,R2),ENAME MOVE NAME TO USER AREA 14630002 MVC NAME,ENAME IMITATE BLDL 14640002 LTR Q,Q GENERATING A NEW NAME? 14650002 BP ERR00 YES, DONE 14660002 * 14670002 CLI ETYPE,VCBPETYP VCBPE? 14680002 BNE ERR00 NO, GO RETURN 14690002 * 14700002 MVC TTR,ETTR SET UP TTR FOR BLDL 14710002 XC NAME,NAME CLEAR NAME TO READ BLOCK 14720002 BAL BALREG3,CALLBLDL READ VCB 14730002 B ERR00 GO RETURN 14740002 * 14750002 DROP POINT 14760002 * 14770002 EJECT 14780002 * 14790002 BYBLOCK EQU * 14800002 * 14810002 * READ THE SPECIFIED BLOCK 14820002 * BLDL PARM AREA WAS PREVIOUSLY SET TO 0 IN IGG0CLC0 14830008 * 14840002 L R2,CAMPTR1 GET POINTER TO TTR 14850002 MVC TTR,0(R2) MOVE IN TTR FOR BLDL 14860002 CLI TTR+2,X00 IS R OF USER TTR 0? 14870002 BE ERR28 BRANCH IF YES 14880002 * 14890002 BAL BALREG3,CALLBLDL READ SPECIFIED BLK 14900002 NC BLDLECB,BLDLECB WAS A BLOCK READ? 14910002 BZ ERR28 NO, TTR TOO BIG 14920002 * 14930002 B RETURN YES, TAKE LOCATE EXIT 14940002 * 14950002 EJECT 14960002 * 14970002 ERR00 EQU * 14980002 * 14990002 MVI ERRLOCSV,ERROR00 RETURN CODE IS ZERO 15000002 * 15010002 * DEQUEUE ALL RESOURCES, RETURN VOLUME LIST, FREEMAIN AND EXIT. 15020002 * 15030002 USING SVRBEXTD,R5 ESTABL ADDRBLTY TO SVRB EXT SA 15040002 L R5,SVRBEXTP SET BASE 15050002 OI ENQFLAGS,RESERVE TURN ON RESERVE YM5073 15060002 MVC ENQRNAM8,HILVLNAM RESTORE HIGH LEVEL NAME 15070002 DEQ ,MF=(E,(R5)) DEQ NAME & RELEASE DEVICE 15080002 * 15090002 RETURN EQU * 15100002 * 15110002 L R5,SVRBEXTP SET SVRB EXT POINTER Y01113 15120002 L R1,DCBADDR SET BASE TO DCB/DEB 15130002 USING DCBAREA,R1 ESTABL BASE TO DCB/DEB 15140002 L R0,NMBYTES GET SUBPOOL AND NUMBER OF BYTES 15150002 LA R1,DCBAREA AREA TO FREE @YL026UD 15160002 XC SVOPNWAP(4),SVOPNWAP RESET WKA PTR (ESTAE) @YL026UD 15162002 SVC FREEMAIN FREE DCB/DEB & CLOSE CATALOG 15170002 L R12,CWAP RESTORE CONTROLLER WA PTR Y01113 15180002 * 15190002 * MOVE THE APPROPRIATE DATA TO THE CALLER'S AREA. 15200002 * 15210002 * IF THE FUNCTION IS LOCATE A GENERATION DATA SET IN ORDER 15220002 * TO ESTABLISH A NEW NAME, ZERO THE CALLER'S AREA. 15230008 * 15240002 * IF THE FUNCTION IS LOCATE A BLOCK OR IF A VCBPE WAS FOUND, 15250002 * THEN MOVE THE BLOCK INTO THE CALLER'S AREA. 15260002 * 15270002 * IF A DSPE WAS FOUND, THEN MOVE THE VOLUME LIST AND THE DSCBTTR 15280002 * INTO THE CALLER'S AREA. 15290002 * 15300002 * THE VOLUME SERIAL AND DEVICE TYPE ARE IN PLACE AT THIS POINT. 15310002 * 15320002 TM FLAG4,GDGPLUS RELATIVE GDG PLUS? @OZ32593 15322008 BNO MOVEDATA YES, DONT BRANCH @OZ32593 15324008 XC WORKAREA(D256),WORKAREA ZERO CALLER'S WORKAREA @OZ32593 15326008 B FREE GO FREE BLDL WORKAREA @OZ32593 15328008 MOVEDATA EQU * @OZ32593 15329008 USING ENTRY,POINT ESTABL ADDRBLTY TO ENTRY 15330002 NC NAME,NAME WAS A BLOCK READ? 15340002 BZ MOVEBLOK YES 15350002 * 15360002 MVC RETDSCBT(L'EDSCBTTR),EDSCBTTR DSCB TTR TO RETURN AREA 15370002 MVI RETDSCBT+3,X00 ZERO LO-ORDER BYTE 15380002 MVC RETDATA(L'EVOLIST),EVOLIST VOLUME LIST TO RETURN AREA 15390002 B FREE GO FREE BLDLS WORKAREA 15400002 * 15410002 DROP POINT 15420002 * 15430002 * 15440002 MOVEBLOK EQU * 15450002 * 15460002 MVC RETDATA,BLDLBUFF MOVE BLOCK INTO CALLER'S AREA 15470002 * 15480002 FREE EQU * 15490002 * 15500002 LA R1,0(R13) POINT TO AREA TO FREE 15520002 LA R0,BLDLEND-BLDLAREA GET LENGTH TO FREEMAIN @YL026UD 15524002 * AND 0 HIGH ORDER BYTE 15530002 SVC FREEMAIN FREE THE WORKAREA 15540002 * 15550002 XR R15,R15 SET RETURN CODE @YL026UD 15560002 B IGG0CLCA RETURN TO IGG0CLCA/CLCB @YL026UD 15580002 EJECT 15590002 * 15600002 **************** 15610002 * * 15620002 CALLBLDL EQU * 15630002 * * 15640002 **************** 15650002 * 15660002 * FUNCTION: 15670002 * CALLS BLDL TO READ THE BLOCK AT TTR. 15680002 * 15690002 * INPUT: 15700002 * TTR,BALREG3 IS RETURN REGISTER,BLDLPARM 15710002 * 15720002 * OUTPUT: 15730002 * BLDLBUFF CONTAINS BLOCK,R15=0 15740002 * 15750002 * DESTROYED: 15760002 * R0,R1,R2,R10,R11,R12,BALREG1,BASESAVE,SAVEAREA 15770002 * 15780002 * EXITS: 15790002 * RETURN IF PERMANENT I/O ERROR. 15800002 *** 15810002 ST R6,BASESAVE SAVE THE WORKAREA BASE 15820002 STM R3,R9,SVAREA7 SAVE REGISTERS 15830002 LM R15,R1,BLDLPARM GET PARAMETERS FOR BLDL 15840002 BALR BALREG1,R15 CALL BLDL 15850002 L R6,BASESAVE RESTORE WORKAREA BASE 15860002 LM R3,R9,SVAREA7 RESTORE REGISTERS 15870002 SLA R15,D28 SET CC FROM RETURN CODE 15880002 BCR 14,BALREG3 BR IF NO I/O ERROR 15890002 * 15900002 * ELSE FALL THRU TO ERR28 15910002 * 15920002 B ERR28 15922002 TITLE 'IGG0CLCC - (IGG0CLC2) SECOND LOAD OF LOCATE' @YL026UD 17550002 *********************************************************************** 17600002 * * 17650002 * IGG0CLC2 - SECOND LOAD OF LOCATE * 17700002 * * 17750002 *********************************************************************** 17800002 * @YL026UD 17850002 IGG0CLC2 EQU * 18492002 * 18494002 DROP R1 @YL026UD 18496002 * 18506002 USING WORKAREA,R6 18516002 USING BLDLAREA,R13 18526002 USING SVRBEXTD,R5 18536002 USING CAMLSTD,R8 18546002 USING UCB,R2 18560002 OI MODMAP1,MODCLC2 INDIC ENTRY TO IGG0CLC2 18570002 * 18580002 TM CAMOPTN1,CAMUNCAT UNCATALOG OPERATION? 18590002 BZ SKIP1 BRANCH IF NO 18600002 TM CAMOPTN2,CAMDLTX DLTX OPERATION? 18610002 BZ SKIP1 BRANCH IF NO 18620002 OI FLAG1,UCATDXF * TURN FLAG BIT ON 18630002 * 18640002 * 18650002 SKIP1 EQU * 18660002 * 18670002 XR LEVELCNT,LEVELCNT INITIALIZE LEVEL COUNT TO ZERO 18680002 * DID 2F FIND AN ENTRY? YES IF FOUNDENT IS NON-ZERO 18690002 L R1,FOUNDENT RESTORE R1 IN CASE OF GIPE 18700002 LTR R1,R1 R1 0? 18710002 BZ EXIT08 BRANCH IF NO ENTRY FOUND 18720002 LA TABLEPTR,NAMDISP2 POINT TO 2ND LEVEL NAME DATA 18730002 * 18740002 * 18750002 UCATCHK EQU * 18760002 * 18770002 * TEST FOR UCATDX FUNCTION 18780002 * 18790002 LA LEVELCNT,D01(LEVELCNT) INCREMENT LEVELS 18800002 * 18810002 TM FLAG1,UCATDXF UCATDX OPERATION? 18820002 BZ ANALTYPE BRANCH IF NO--ANALYZE TYPE 18830002 * 18840002 LR R10,R1 SAVE R1 -- MAY POINT TO GIPE 18850002 BAL BALREG3,UCATDX BRANCH TO UCATDX UPDATE 18860002 LR R1,R10 RESTORE R1 18870002 * 18880002 * 18890002 ANALTYPE EQU * 18900002 * 18910002 * ANALYZE TYPE OF ENTRY FOUND 18920002 * 18930002 * LAST ENTRY FOUND CVOL ENTRY OR WAS AN ALIAS ENTRY BUILT IN C1? 18940002 TM FLAG2,CVOLF+ALIASBLT 18950002 BM EXIT12 BRANCH IF YES AND SET CODE 18960002 * 18970002 CLI TYPEB,ALIASTYP ALIAS ENTRY? 18980002 BE IPE BRANCH IF YES AN TREAT AS IPE 18990002 * 19000002 CLI TYPEB,IPETYP IPE? 19010002 BE IPE BRANCH IF YES 19020002 * 19030002 CLI TYPEB,GIPETYP GIPE? 19040002 BE GIPE BRANCH IF YES 19050002 * 19060002 * ASSUME ENTRY IS DSPE OR VCBPE 19070002 * 19080002 CH LEVELCNT,NAMLG ANY MORE LEVELS? 19090002 BL ERR16 BRANCH IF YES 19100002 * 19110002 TM FLAG1,LOCATEF * LOCATE? 19120002 BO LOCDLOC YES, PREPARE TO RETURN @Z40CSRC 19130008 * @Z40CSRC 19131008 * TEST FOR UNCATLG OR RECATLG IN A RACF-DEFINED CATALOG @Z40CSRC 19132008 * @Z40CSRC 19133008 TM FLAG5,OCWRACAT IS CATLG RACF DEFINED @Z40CSRC 19134008 BNO CLC3PREP NO, GO SET UP FOR CLC3 @Z40CSRC 19135008 TM CAMOPTN1,CAMUNCAT+CAMRECAT UNCAT OR RECAT @Z40CSRC 19136008 BZ CLC3PREP NO, GO SET UP FOR CLC3 @Z40CSRC 19137008 L R15,RACFADDR GET ADDR OF RACF RTN @Z40CSRC 19138008 BALR R14,R15 GO CHECK AUTHORIZATION @Z40CSRC 19139008 LTR R15,R15 IS USER UNAUTHORIZED @Z40CSRC 19139208 BNZ ERRRACF YES, SET UP ERROR EXIT @Z40CSRC 19139408 B CLC3PREP CONTINUE PROCESSING @Z40CSRC 19139608 * @Z40CSRC 19139808 LOCDLOC EQU * LOCATE LOCATED @Z40CSRC 19139908 * 19140002 CLI NAMDELIM,CODPARN INVALID NAME? 19150002 BE ERR16 BRANCH IF YES 19160002 * 19170002 CLI TYPEB,VCBPETYP VCBPE? 19180002 BNE FREERES BRANCH IF NO 19190002 * 19200002 * READ VCB 19210002 * 19220002 BAL BALREG3,READBLK READ VCB 19230002 B FREERES FREE RESOURES 19240002 * 19250002 * 19260002 IPE EQU * 19270002 TM FLAG2,GDGSW GDG SWITCH ON? @OZ14790 19273008 BO EXIT12 YES, BR-THIS ENTRY INVAL@OZ14790 19276008 * 19280002 CH LEVELCNT,NAMLG ANY MORE LEVELS? 19290002 BNL EXIT12 BRANCH IF NO 19300002 * 19310002 * SAVE ICE TTR OF LEVEL TO BE UPDATED 19320002 MVC ICETTR,TTR0 19330002 * 19340002 * 19350002 MORELVLS EQU * 19360002 * 19370002 BAL BALREG1,NEXTLVL GET NEXT LEVEL FOR BLDL 19380002 * 19390002 * 19400002 FINDNAME EQU * 19410002 * 19420002 BAL BALREG3,BLDLCALL FIND THE LEVEL NAME 19430002 * 19440002 BC 2,EXIT08 BRANCH IF NAME NOT FOUND 19450002 * 19460002 B UCATCHK CHECK IF UCATDX 19470002 * 19480002 * 19490002 GIPE EQU * 19500002 * @ZA04937 19501008 * TEST FOR SUPERLOCATE AND SET INFORMATION @ZA04937 19502008 TM CAMOPTN3,X'02' TEST FOR SUPERLOCATE @OZ33388 19503008 BZ NSLOC3 NO BR @ZA04937 19504008 L R1,CAMDSCBP LOAD POINTER TO WORKAREA @ZA04937 19505008 LA R15,NAME+2 @ZA04937 19506008 USING ENTRY,R15 @ZA04937 19507008 LH R0,EGCURSIZ LOAD CURRENT GEN COUNT @ZA04937 19508008 STH R0,4(,R1) STORE IN SLOC WKAREA @ZA04937 19509008 MVI 6(R1),X'80' SET GDG FLAG FOR CLCA @ZA04937 19509208 LTR R0,R0 TEST FOR EMPTY GDG @ZA04937 19509408 BNZ NSLOC3 BR NOT EMPTY @ZA04937 19509608 OI 6(R1),X'40' SET EMPTY FLAG @ZA04937 19509808 NSLOC3 EQU * @ZA04937 19509908 * 19510002 OI FLAG2,GDGSW TURN ON GDG FLAG 19520002 TM FLAG1,LOCATEF * LOCATE FUNCTION? 19530002 BO CHECKLVL BRANCH IF YES 19540002 * 19550002 TM FLAG2,ALIASSW GIPE ALIAS? @YL026UD 19552002 BO ERR16 BRANCH TO ERROR IF YES @YL026UD 19554002 * @YL026UD 19556002 MVC OUTDATA,INDATA SAVE GIPE BLK FOR UPDATE 19560002 * CALCULATE DISPLACEMENT BETWEEN BUFFERS SO GIPE PTR MAY BE 19570002 * ADJUSTED 19580002 LA R1,OUTDATA-INDATA(R1) ADJUST POINTER 19590002 ST R1,FOUNDENT SAVE POINTER 19600002 BAL BALREG2,TORLTV CONVERT GIPE DASD ADDRESS 19610002 ST R0,WRITETTR SAVE TTR 19620002 * 19630002 * IN CASE OPERATION IS UCATDX, CHANGE TO UNCAT SINCE A GIPE HAS 19640002 * BEEN FOUND 19650002 * 19660002 NI FLAG1,UCATDXFC TURN OFF IN CASE ON 19670002 XC DELTTR1,DELTTR1 0, SINCE IT A SWITCH IN C3 19680002 * 19690002 * 19700002 CHECKLVL EQU * 19710002 * 19750002 TM FLAG2,ALIASSW GIPE ALIAS? @YL026UD 19752002 BO ERR08 BRANCH TO ERROR IF YES @YL026UD 19754002 * @YL026UD 19756002 CH LEVELCNT,NAMLG ANY MORE LEVELS? YA00091 19774002 BL ABSLEVEL BRANCH IF YES YA00091 19776002 CLI NAMDELIM,CODPARN LAST DELIMITER A LEFT PAREN ? 19780002 BNE EXIT12 SET EXIT CODE TO 12 @YL026UD 19782002 * SAVE ICE TTR OF LEVEL TO BE UPDATED @ZA02286 19783008 MVC ICETTR,TTR0 @ZA02286 19783208 * SAVE NO. OF LEVELS FOUND IN CASE OF LATER ERROR EXIT OR CATBX 19784002 STH LEVELCNT,NAMLF @YL026UD 19786002 B IGG0CLC1 RESOLVE RELATIVE GDG @YL026UD 19790002 * 19810002 * 19820002 * 19830002 ABSLEVEL EQU * 19840002 * SAVE ICE TTR OF LEVEL TO BE UPDATED @ZA02286 19841008 MVC ICETTR,TTR0 @ZA02286 19842008 * 19850002 * GET NEXT LEVEL NAME WHICH IS AN ABSOLUTE GDG NAME 19860002 * 19870002 BAL BALREG1,NEXTLVL GET NEXT LEVEL 19880002 * 19890002 * CHECK IF GIVEN ABSOLUTE GENERATION NAME IS IN PROPER FORMAT 19900002 CLI NAME,CCDG FIRST CHAR. A 'G' ? 19910002 BNE ERR08 BRANCH IF NO @OZ31408 19920008 CLI NAME+5,CCDV SIXTH CHAR. A 'V' ? 19926008 BNE ERR08 BRANCH IF NO @OZ31408 19932008 * 19950002 * NAME IS OK - COMPLEMENT THE NUMBER IN THE GENERATION NAME - 19960002 * (I.E. THE X'S OF GXXXXV00) 19970002 * 19980002 CLC GENNO,CCDZERO IS IT G0000VXX? @ZA01897 19990008 BE ERR08B YES, BR-INVALID @ZA01897 19992008 XC GENNO,MASKFF NO, COMPLEMENT GEN. NO. 19994008 * 20000002 * INDICATE TO CLC6 AN ABSOLUTE GDG NAME 20010002 OI FLAG3,GDS SET FLAG 20020002 * 20030002 TM CAMOPTN1,CAMCAT IS THIS A CAT FUNCTION? 20040002 BZ FINDNAME BRANCH IF NO AND SEARCH FOR NAME 20050002 * @Z40CSRC 20050508 * CATALOGING A NEW GDG GENERATION. @Z40CSRC 20051008 * THIS REQUIRES AN AUTHORIZATION CHECK IF PERFORMED @Z40CSRC 20051508 * IN A RACF-DEFINED CATALOG. @Z40CSRC 20052008 * @Z40CSRC 20052508 TM FLAG5,OCWRACAT IN RACF-DEFINED CATALOG @Z40CSRC 20053008 BNO NORAC NO, SKIP RAC CHECK @Z40CSRC 20053508 L R15,RACFADDR GET ADDR OF RACF RTN @Z40CSRC 20054008 BALR R14,R15 GO CHK AUTHORIZATION @Z40CSRC 20054508 LTR R15,R15 IS USER UNAUTHORIZED @Z40CSRC 20055008 BNZ ERRRACF YES, SET UP ERROR EXIT @Z40CSRC 20055508 * @Z40CSRC 20056008 NORAC EQU * NO RACF AUTH FAILURE @Z40CSRC 20056508 * 20060002 * IF THE VERSION NUMBER IS NON-ZERO, THEN THE BLOCK RETURNED 20070002 * BY BLDL MAY NOT BE THE BLOCK TO BE UPDATED (SEE APAR 43345) 20080002 * 20090002 CLC NAME+6(2),CCDZERO ZERO? @ZA01897 20100002 BE FINDNAME BRANCH IF YES 20110002 * 20120002 * CHANGE THE VERSION NUMBER SO BLDL WILL ALWAYS RETURN THE BLOCK 20130002 * TO BE UPDATED 20140002 * 20150002 LH R9,NAME+6 SAVE VERSION NUMBER 20160002 * NOTE: R9 IS TABLEPTR, SO TABLEPTR IS NOW INVALID 20170002 MVC NAME+6(2),CCDZERO SET VERSION NO. TO 0 @ZA05600 20180008 BAL BALREG3,BLDLCALL FIND BLK TO BE UPDATED 20190002 STH R9,NAME+6 RESTORE VERSION NO. 20200002 B EXIT08 SET LOCATE CODE TO NOT FOUND 20210002 * 20220002 * 20230002 FREERES EQU * 20240002 * 20250002 L R12,CWAP RESTORE CONTROLLER WA PTR Y01113 20260002 L R5,SVRBEXTP 20270002 MVC ENQRNAM8,HILVLNAM RESTORE HIGH LEVEL NAME 20280002 * DEQUE NAME AND RELEASE ('UN-RESERVE') THE DEVICE 20290002 MVI ENQFLAGS,HAVE+SYSTEMS SET FLAGS 20300002 * 20310002 DEQNAME EQU * 20320002 * 20330002 DEQ ,MF=(E,(R5)) DEQ NAME 20340002 * 20350002 * FREE DCB/DEB AND CLOSE THE CATALOG 20360002 * 20370002 L R1,DCBADDR GET POINTER TO DCB/DEB 20380002 USING DCBAREA,R1 20390002 L R0,NMBYTES GET NO. OF BYTES TO FREE 20400002 * 20410002 * GET THE ADDRESS OF THE AREA TO FREE AND 0 THE HIGH ORDER BYTE 20420002 * TO INDICATE FREEMAIN 20430002 LA R1,DCBAREA @YL026UD 20440002 XC SVOPNWAP(4),SVOPNWAP RESET WKA PTR (ESTAE) @YL026UD 20442002 SVC FREEMAIN FREEMAIN R,LV=(0),A=(1) 20450002 DROP R1 20460002 * 20470002 CLI TYPEB,VCBPETYP VCBPE? 20480002 BNE DSPE BRANCH IF NO 20490002 * 20500002 MVC RETDATA,BLDLBUFF MOVE BLK INTO USER'S WA 20510002 B RETURN2 FREEMAIN AND RETURN TO CALLER 20520002 * 20530002 * 20540002 DSPE EQU * 20550002 * 20560002 * RETURN DATA TO USER 20570002 * 20580002 MVC RETDSCBT(L'TTR),TTR RETURN DSCB TTR 20590002 MVI RETDSCBT+3,X00 0 FOURTH BYTE 20600002 MVC RETDATA(D62),DATAB RETURN DATA 20610002 * 20620002 * 20630002 RETURN2 EQU * 20640002 * 20650002 * FREE WORKAREA 20660002 * 20670002 LR R1,R13 GET POINTER TO AREA TO FREE 20690002 LA R0,BLDLEND-BLDLAREA GET LENGTH TO FREEMAIN @YL026UD 20694002 SVC FREEMAIN FREEMAIN R,LV=(0),A=(R13) 20700002 * 20710002 XR R15,R15 SET RETURN CODE @YL026UD 20720002 B IGG0CLCA RETURN TO IGG0CLCA/CLCB @YL026UD 20740002 * 20750002 * 20760002 EXIT08 EQU * 20770002 * 20780002 MVI ERRLOCSV,ERROR08 SET ERROR CODE 20790002 B LOCTEST2 TEST IF LOCATE FUNCTION 20800002 * 20810002 * 20820002 EXIT12 EQU * 20830002 * 20840002 MVI ERRLOCSV,ERROR12 SET ERROR CODE 20850002 * 20860002 LOCTEST2 EQU * 20870002 * 20880002 TM FLAG1,LOCATEF LOCATE? 20890002 BZ CLC3PREP BRANCH IF NO AND PREPARE FOR C3 20900002 * 20910002 * NO DSPE OR VCBPE FOUND, LOCATE ERROR -- PREPARE AND BRANCH TO C7 20920002 * 20930002 OI FLAG1,RTNBLK INDIC TO C7 TO RETURN BLK 20940002 * 20950002 CLI ERRLOCSV,ERROR08 ERROR 8? 20960002 BE BRANCHC7 BRANCH IF YES TO C7 @YL026UD 20970002 * 20980002 BAL BALREG3,READBLK READ NEXT BLK FOR ERROR 16 20990002 * @YL026UD 21000002 BRANCHC7 EQU * @YL026UD 21002002 * @YL026UD 21004002 STH LEVELCNT,NAMLF SAVE NO. LEVELS FOUND @YL026UD 21006002 B IGG0CLC7 BRANCH TO CLC7 @YL026UD 21008002 * 21010002 * 21020002 CLC3PREP EQU * 21030002 * 21040002 * PREPARE FOR IGG0CLC3 AND LATER MODULES 21050002 * 21060002 * SAVE THE CCHHR OF THE BLOCK JUST READ. SAVE IT AS A TTR. 21070002 * 21080002 BAL BALREG2,TORLTV SAVE DASD ADDRESS 21090002 ST R0,READTTR SAVE TTR 21100002 * 21110002 * CHECK FIRST NAME IN LAST BLOCK READ FOR AN ICE ENTRY 21120002 * 21130002 CLI INENTRY,X00 DOES NAME START WITH 00? 21140002 MVC ICEPERT,INENTRY+L'INAME ASSUME YES 21150002 BE SKIP3 BRANCH IF YES AND CONTINUE 21160002 OI FLAG1,READICEF SET FLAG TO READ ICE IN CLC3 21170002 * 21180002 SKIP3 EQU * 21190002 * 21200002 * DO INITIAL PREPARATIONS FOR SEVERAL FUNCTIONS 21210002 * 21220002 * 21230002 TM FLAG1,CATBXF * CATBX? 21240002 BZ UCATDXCK BRANCH IF NO 21250002 * 21260002 CLI ERRLOCSV,ERROR00 DSPE OR VCBPE FOUND? 21270002 BE ERR08B BRANCH IF YES @YL026UD 21280002 * 21290002 TM FLAG2,GDGSW HAS A GIPE BEEN FOUND? 21300002 BO RELOC BRANCH IF YES--'NAME' UPDATED 21310002 * 21320002 * PUT LAST LEVEL NAME INTO 'NAME' FOR CATALOG OPERATION 21330002 * 21340002 * POINT TO LAST LEVEL DATA IN 'NAMTABLE' FOR SUBROUTINE NEXTLVL 21350002 L TABLEPTR,NAMLSTP SET POINTER 21360002 BAL BALREG1,NEXTLVL PUT LAST LEVEL NAME INTO 'NAME' 21370002 * 21380002 * 21390002 UCATDXCK EQU * 21400002 * 21410002 TM FLAG1,UCATDXF * UCATDX OPERATION? 21420002 BZ RELOC BRANCH IF NO 21430002 * 21440002 CLI ERRLOCSV,ERROR00 LOCATE FIND DSPE OR VCBPE? 21450002 BNE ERR08B BRANCH IF NO @YL026UD 21460002 MVC NAME,UCATNAM INDIC NAME FOR CLC6 TO DELETE 21470002 CLC UCATICE,ICETTR TTR'S EQUAL? 21480002 BE RELOC BRANCH IF YES 21490002 OI FLAG1,READICEF MUST READ ICE 21500002 MVC ICETTR,UCATICE SET TTR TO READ 21510002 * 21520002 * 21530002 RELOC EQU * 21540002 * 21550002 * RELOCATE THE CCWS TO BE USED BY LATER MODULES. 21560002 * 21570002 DROP R13 NO LONGER NEEDED--NONLOCATE FUN 21580002 LM R9,R2,FIRST5 GET 5 CCWS 21590002 AR R9,R6 RELOCATE 21600002 AR R11,R6 21610002 AR R13,R6 21620002 AR R15,R6 21630002 AR R1,R6 21640002 STM R9,R2,CCWFRST5 STORE INTO WA 21650002 LM R9,R2,SECOND5 GET NEXT 5 CCWS 21660002 AR R9,R6 RELOCATE 21670002 AR R11,R6 21680002 AR R13,R6 21690002 AR R15,R6 21700002 AR R1,R6 21710002 * RELOCATE 2 CONTIGUOUS TO PREVIOUS 5 21720002 STM R9,R12,CCWSEC2 21730002 STM R13,R2,CCWLST3 RELOCATE LAST 3 ELSEWHERE 21740002 LA R1,SIDE1 GET NEW CHANNEL ADDRESS 21750002 ST R1,IOBCHPR UPDATE IOB 21760002 * 21770002 * RPS DEVICE? 21780002 * 21790002 L R5,SVRBEXTP RESTORE FOR CLC2 AND CLC3 21800002 L R2,UCBADDR GET UCB ADDRESS 21810002 TM UCBTBYT2,RPSBIT RPS BIT ON? 21820002 BZ IGG0CLC3 BRANCH IF NO 21830002 * 21840002 * RPS DEVICE 21850002 * 21860002 OI FLAG2,RPSDEV TURN ON RPS FLAG 21870002 * GETMAIN FOR RPS SUPPORT. 21880002 LA R0,RPSEND-RPSD GET LENGTH AND SP NUMBER 21890002 GETMAIN R,LV=(0) 21900002 ST R1,SVRPSWAP SAVE WKA PTR (ESTAE) @YL026UD 21902002 USING RPSD,R1 21910002 ST R1,RPSAVEP SAVE IN WORKAREA 21920002 ST R1,RPSR1 SAVE IN RPS AREA 21930002 ST R1,IOBCHPR UPDATE IOB CHAN PROG POINTER 21940002 LA R15,THETA POINT TO THETA IN WA 21950002 ST R15,RPSPTR PUT POINTER IN RPS AREA 21960002 MVC RPSPTR(D01),UCBTBYT4 PUT IN UCB TYPE CODE 21970002 LM R9,R12,RPSCCWS GET RPS CCWS 21980002 AR R9,R6 RELOCATE 21990002 AR R11,R6 22000002 STM R9,R12,RPSCCW PUT INTO RPS AREA 22010002 * SET UP DD=BLOCKSIZE=256, K=KEYLEN=8, R=RECORD NO. IN RPS AREA 22020002 MVC RPSDDKR,RPSDDK 22030002 L R9,CVTPTR GET POINTER TO CVT 22040002 USING CVT,R9 22050002 * GET POINTER TO SECTOR CONVERT ROUTINE 22060002 MVC RPSCNVT,CVT0SCR1 22070002 DROP R9 22080002 DROP R1 22090002 * 22100002 B IGG0CLC3 22110002 EJECT 22160002 * 22170002 **************** 22180002 * * 22190002 UCATDX EQU * 22200002 * * 22210002 **************** 22220002 * FUNCTION: 22230002 * TO MAINTAIN A TTR TRAIL OF DELETABLE BLOCKS -- THIS IS DONE BY 22240002 * KEEPING A TTR TO THE FIRST BLOCK TO BE DELETED 22250002 * 22260002 * INPUT: 22270002 * A DATA BLOCK IN BLDLBUFF 22280002 * RETURN ADDRESS IN BALREG3 22290002 * 22300002 * OUTPUT: 22310002 * UPDATED TTR FIELD OF DELTTR1 22320002 * 22330002 * 22340002 * DESTROYED: 22350002 * R0,R1,R2,BALREG2,BALREG3,R14,AND R15 22360002 * 22370002 * 22380002 * SUBROUTINES USED: 22390002 * TORLTV 22400002 * 22410002 **************** 22420002 **************** 22430002 * 22440002 USING BLDLAREA,R13 22450002 BAL BALREG2,TORLTV CONVERT CCHHR OF BLK TO TTR 22460002 * R0 HAS TTR0 OF BLK AND MUST BE PRESERVED IN SUBROUTINE 22470002 * 22480002 * 1) THE FIRST LEVEL NAME MAY NOT BE REMOVED OR THE BLK DELETED 22490002 * 2) THE SECOND MAY BE REMOVED BUT THE BLK NOT DELETED 22500002 * 22510002 CH LEVELCNT,THREE FIRST OR SECOND LEVEL? 22520002 BL NOTDEL BRANCH IF YES 22530002 * 22540002 * IS THE ONLY ENTRY (BESIDES THE ICE AND ILE) THE FOUND ENTRY? 22550002 * IF SO THE BLOCK IS DELETABLE 22560002 * 22570002 XR R1,R1 CLEAR 22580002 IC R1,TYPEB GET NO. OF HALF WORDS 22590002 * 22600002 * 2 BYTE LENGTH + ICE(18) + ILE(12) 22610002 * + ENTRY LENGTH BEFORE DATA(12) = 44 BYTES 22620002 * 22630002 LA R1,D44(R1,R1) 22640002 * R1 NOW CONTAINS NO. OF BYTES IN BLK IF FOUND ENTRY THE ONLY ONE 22650002 * 22660002 CH R1,INBYTSU ONE ENTRY? 22670002 BNE NOTDEL BRANCH IF NO 22680002 * 22690002 C R0,ICETTR FIRST BLOCK IN CHAIN? 22700002 BE UPDTTR BRANCH IF YES 22710002 * 22720002 * 22730002 NOTDEL EQU * 22740002 * 22750002 * 22760002 * THIS BLOCK IS NOT DELETABLE (MORE THAN ONE ENTRY OR FIRST OR 22770002 * SECOND LEVEL) 22780002 * 22790002 ST R0,WRITETTR SAVE TTR OF BLK TO BE UPDATED 22800002 * 0 DELTTR1 SINCE NO BLKS ARE DELETABLE 22810002 XC DELTTR1,DELTTR1 22820002 MVC OUTDATA,INDATA SAVE BLK TO UPDATED 22830002 MVC UCATICE,ICETTR SAVE ICE TTR FOR THIS LEVEL 22840002 MVC UCATNAM,NAME SAVE NAME TO BE DELETED 22850002 BR BALREG3 RETURN TO CALLER 22860002 * 22870002 * 22880002 UPDTTR EQU * 22890002 * 22900002 * IF DELTTR1=0, THEN FIRST DELETEABLE BLK, SO UPDATE DELTTR1 22910002 * IF DELTTR1 NOT 0, THEN NOT FIRST DELETEABLE BLK, SO RETURN 22920002 * 22930002 NC DELTTR1,DELTTR1 DELTTR1=0 ? 22940002 BCR 7,BALREG3 RETURN IF NO 22950002 ST R0,DELTTR1 UPDATE FIRST DELETABLE BLK 22960002 BR BALREG3 RETURN 22970002 DROP R13 22980002 EJECT 22990002 * 23000002 **************** 23010002 * * 23020002 READBLK EQU * 23030002 * * 23040002 **************** 23050002 * 23060002 ***FUNCTION: 23070002 * THIS SUBROUTINE READS A BLOCK BY TTR USING BLDL. 23080002 * 23090002 * INPUT: 23100002 * RETURN ADDRES IN BALREG3 23110002 * TTR AT 'TTR0' 23120002 * 23130002 * OUTPUT: 23140002 * IF FOUND, THE BLOCK IS AT BLDLBUFF 23150002 * 23160002 * DESTROYED: 23170002 * REGISTERS R0,R1,R2,R3,R10,R11,R12,R14, AND R15 23180002 * 'NAME' 23190002 * 'BLDLBUFF' 23200002 * 23210002 * EXITS: 23220002 * 23230002 * EXITS TO CALLBLDL 23240002 * 23250002 *************** 23260002 *************** 23270002 * 23280002 XC NAME,NAME 0 NAME FOR BLDL 23290002 * 23300002 * FALL THROUGH TO 'CALLBLDL' 23310002 * 23320002 EJECT 23330002 * 23340002 **************** 23350002 * * 23360002 BLDLCALL EQU * 23370002 * * 23380002 **************** 23390002 * FUNCTION: 23400002 * THIS SUBROUTINE INTERFACES TO BLDL TO SEARCH FOR THE NAME IN 23410002 * 'NAME' OR READ A BLOCK SPECIFIED BY A TTR IN 'TTR' WHEN 'NAME' 23420002 * IS 0 23430002 * 23440002 * INPUT: 23450002 * RETURN ADDRESS IN BALREG3 23460002 * NAME AND TTR SET 23470002 * 23480002 * OUTPUT: 23490002 * 1) CONDITION CODE=0 IF ENTRY IS FOUND 23500002 * 2) CONDITION CODE=2 IF ENTRY IS NOT FOUND 23510002 * 3) IF THE ENTRY IS FOUND, IT IS PLACED AT NAME AND THE DATA 23520002 * IS IN BLDLBUFF WITH R1 POINTING TO THE ENTRY IN THE BLOCK 23530002 * 4) IF THE ENTRY IS NOT FOUND, THE BLOCK IT WOULD GO INTO 23540002 * IS IN BLDLBUFF 23550002 * DESTROYED: 23560002 * REGISTERS R0,R1,R2,R3,R10,R11,R12,R14, AND R15 -- BLDLBUFF 23570002 * 23580002 * EXITS: 23590002 * PERMANENT I/O ERROR, IT WILL BRANCH TO IGG0CLC7 @YL026UD 23600002 *************** 23610002 *************** 23620002 * 23630002 USING BLDLAREA,R13 23640002 ST R6,BASESAVE SAVE THE WA BASE 23650002 STM R4,R9,SVAREA6 SAVE REGS OVER BLDL 23660002 LM R15,R1,BLDLPARM GET BLDL INPUT PARMS 23670002 BALR R14,R15 BRANCH TO BLDL 23680002 L R6,BASESAVE RESTORE WA BASE 23690002 LM R4,R9,SVAREA6 RESTORE REGS 23700002 * THE FOLLOWING SHIFT SETS THE CONDITION CODE AS FOLLOWS: 23710002 * IF R15=0, THEN CC=0 23720002 * IF R15=4, THEN CC=2 23730002 * IF R15=8, THEN CC=3 (OVERFLOW) 23740002 SLA R15,28 SET CC 23750002 BCR 10,BALREG3 RETURN IF R15=0 OR 4 23760002 * 23770002 B ERR28B ERROR EXIT @YL026UD 23780002 DROP R13 23790002 EJECT 23800002 * 23810002 **************** 23820002 * * 23830002 TORLTV EQU * 23840002 * * 23850002 **************** 23860002 * 23870002 ***FUNCTION: 23880002 * THIS SUBROUTINE CONVERTS THE DATA COUNT, READ BY BLDL, FOR THE 23890002 * CURRENT IN CORE DATA BLOCK AND CONVERTS IT TO A TTR 23900002 * 23910002 * INPUT: 23920002 * RETURN ADDRESS IN BALREG2 23930002 * 23940002 * OUTPUT: 23950002 * TTR0 IN REGISTER 0 23960002 * DESTROYED: 23970002 * REGISTERS R0,R1,R2,R14 AND R15 -- SAVEAREA,BLDLCHR 23980002 * 23990002 * SUBROUTINES USED: 24000002 * THE RESIDENT CONVERT ROUTINE -- IECPRLTV 24010002 * 24020002 *************** 24030002 *************** 24040002 * 24050002 USING BLDLAREA,R13 24060002 * 24070002 * FIRST MOVE THE DATA COUNT FIELD INTO THE IOB MBBCCHHR 24080002 MVC BLDLCHR(L'BLDLCHR),BLDLCNT 24090002 * SAVE THE REGS DESTROYED BY CONVERT 24100002 STM R9,R13,SVAREA5 24110002 L R1,DEBADDR GET DEB ADDR 24120002 LA R2,BLDLMBB POINT TO MBBCCHHR IN IOB 24130002 L R15,EPTORLTV GET ENTRY POINT 24140002 BALR BALREG1,R15 CONVERT 24150002 LM R9,R13,SVAREA5 RESTORE MODIFIED REGISTERS 24160002 * THIS ROUTINE ALWAYS GIVES A RETURN CODE OF 0, SO IT IS NOT 24170002 * CHECKED 24180002 BR BALREG2 RETURN TO CALLER 24190002 DROP R13 24200002 EJECT 24210002 * 24220002 **************** 24230002 * * 24240002 NEXTLVL EQU * 24250002 * * 24260002 **************** 24270002 * 24280002 ***FUNCTION: 24290002 * THIS SUBROUTINE GETS THE NEXT LEVEL NAME AND PUTS IT INTO 24300002 * THE 'NAME' WORKAREA LOCATION 24310002 * 24320002 * INPUT: 24330002 * RETURN ADDRESS IN BALREG1 24340002 * REGISTER TABLEPTR (MAINTAINED IN THIS SUBROUTINE) POINTING TO 24350002 * NEXT DISPLACEMENT IN THE NAME TABLE 24360002 * 24370002 * OUTPUT: 24380002 * NEXT LEVEL IN 'NAME' 24390002 * TABLEPTR INCREMENTED TO NEXT ENTRY 24400002 * DESTROYED: 24410002 * REGISTERS R1,R2, AND TABLEPTR 24420002 *************** 24430002 *************** 24440002 * 24450002 MVI NAME,CCDBLANK BLANK NAME 24460002 MVC NAME+1(L'NAME-1),NAME 24470002 XR R1,R1 0 R1 24480002 IC R1,0(TABLEPTR) GET LEVEL DISPLACEMENT 24490002 L R2,CAMPTR1 LOAD POINTER TO NAME 24500002 AR R2,R1 R2 NOW POINTS TO PROPER LEVEL 24510002 IC R1,D01(TABLEPTR) GET LEVEL LENGTH MINUS ONE 24520002 * MOVE LEVEL NAME INTO 'NAME' 24530002 EX R1,MOVELVL MVC NAME(0),0(R2) 24540002 * INCREMENT TO NEXT LEVEL NAME INFORMATION 24550002 LA TABLEPTR,D02(TABLEPTR) 24560002 BR BALREG1 RETURN 24570002 EJECT 24580002 * 24582002 ERR04A EQU * 24584002 * 24586002 * SET SCHEDULER SWITCH SO MOUNT MESSAGE IS NOT ISSUED 24588002 XC DEVTYPE,DEVTYPE 0 SWITCH 24588402 * 24588802 * 24589202 ERR04 EQU * 24589602 * 24589702 MVI ERRLOCSV,ERROR04 SET ERROR CODE 24589802 B IGG0CLC7 BRANCH TO IGG0CLC7 @YL026UD 24589902 * 24592002 * 24600002 ERR08 EQU * 24610002 * 24620002 MVI ERRLOCSV,ERROR08 SET EXIT CODE TO 8 @YL026UD 24630002 B IGG0CLC7 BRANCH TO IGG0CLC7 @YL026UD 24640002 * 24650002 * 24650402 ERR08B EQU * @YL026UD 24650802 * 24651202 * SAVE NO. OF LEVELS FOUND IN CASE OF LATER ERROR EXIT OR CATBX 24652602 STH LEVELCNT,NAMLF @YL026UD 24654602 MVI ERRCATSV,ERROR08 RETURN CODE IS 08 @YL026UD 24656002 B IGG0CLC7 GO TO XCTL 24657402 * 24658802 * 24660202 ERR12 EQU * 24661602 * 24663002 MVI ERRLOCSV,ERROR12 RETURN CODE IS 12 24664402 B IGG0CLC7 BRANCH TO IGG0CLC7 @YL026UD 24665802 * 24667202 * 24668602 ERR16 EQU * 24670002 * 24680002 * SAVE NO. OF LEVELS FOUND IN CASE OF LATER ERROR EXIT OR CATBX 24682002 STH LEVELCNT,NAMLF @YL026UD 24684002 MVI ERRLOCSV,ERROR16 SET ERROR CODE TO 16 24690002 B IGG0CLC7 BRANCH TO IGG0CLC7 @YL026UD 24700002 * 24710002 * 24720002 ERR20B EQU * @YL026UD 24722002 * @YL026UD 24724002 * SAVE NO. OF LEVELS FOUND IN CASE OF LATER ERROR EXIT OR CATBX 24726002 STH LEVELCNT,NAMLF @YL026UD 24728002 * @YL026UD 24728402 ERR20 EQU * 24730002 * 24740002 MVI ERRLOCSV,ERROR20 SET ERROR CODE TO 20 24750002 B IGG0CLC7 BRANCH TO IGG0CLC7 @YL026UD 24760002 * 24770002 ERR28B EQU * @YL026UD 24842002 * @YL026UD 24844002 * SAVE NO. OF LEVELS FOUND IN CASE OF LATER ERROR EXIT OR CATBX 24846002 STH LEVELCNT,NAMLF @YL026UD 24848002 * @YL026UD 24848402 ERR28 EQU * 24850002 * 24860002 MVI ERRLOCSV,ERROR28 SET ERROR TO 28 24870002 B IGG0CLC7 BRANCH TO IGG0CLC7 @YL026UD 24872002 * @YL026UD 24888902 * @YL026UD 24889202 IGG0CLCA EQU * @YL026UD 24889302 * @YL026UD 24889402 * RETURN TO INTERFACE MAPPER (IGG0CLCA OR IGG0CLCB) @YL026UD 24889502 * @YL026UD 24891002 LR R2,R15 SAVE RETURN CODE @YL026UD 24891102 LR R3,R0 SAVE RETURN CODE @YL026UD 24891202 LR R4,R1 SAVE RETURN CODE @YL026UD 24891302 * @YL026UD 24892802 ESTAE 0 RESET ESTAE EXIT @YL026UD 24894502 * @YL026UD 24895702 LR R15,R2 RESTORE RETURN CODE @YL026UD 24895802 LR R0,R3 RESTORE RETURN CODE @YL026UD 24895902 LR R1,R4 RESTORE RETURN CODE @YL026UD 24896102 CLCAEXIT EQU * @OZ30106 24896208 L R13,612(R12) GET CIII SAVEAREA PTR #YL026UD 24896502 LM R2,R12,28(R13) RESTORE REGISTERS 2-12 #YL026UD 24897502 L R14,12(R13) RESTORE RETURN REGISTER #YL026UD 24899002 BR R14 RETURN TO IGG0CLCA/CLCB #YL026UD 24900502 * 24902002 * 24903502 IGG0CLC3 EQU * 24905002 * 24906502 * SAVE NO. OF LEVELS FOUND IN CASE OF LATER ERROR EXIT OR CATBX 24908002 STH LEVELCNT,NAMLF @YL026UD 24909502 L R15,IGG0CLCD OBTAIN MODULE NAME @YL026UD 24911002 BALR R14,R15 BRANCH TO IGG0CLCD MOD @YL026UD 24912502 * 24914002 ERRRACF EQU * RACF ERROR EXIT @Z40CSRC 24914508 * 24915502 IGG0CLC7 EQU * 24917002 * 24918502 L R15,ERRORMOD OBTAIN MODULE NAME @YL026UD 24920002 BALR R14,R15 BRANCH TO ERROR MODULE @YL026UD 24922002 * 24930002 TITLE 'IGG0CLCC - (IECPBLDL) FIND/BLDL ROUTINE' @YL026UD 25000002 *********************************************************************** 25000402 * * 25000802 * IECPBLDL - FIND/BLDL ROUTINE * 25001202 * * 25001602 *********************************************************************** 25001702 * @YL026UD 25001802 IGG0CLCC CSECT 25002002 * 25004002 IECPBLDL BALR RGBASE,0 SET BASE REGISTER FOR MODULE 25008402 USING BASE1,RGBASE ESTABL BASE FOR MODULE 25008802 USING BLDLWKA,RGAREA ESTABL BASE FOR BLDL WORKAREA 25009202 BASE1 L RGA,EPTOABSL GET CONVERT ENTRY PT @YL026UD 25009602 ST RGA,IECPCNVT SAVE ADDR IN BLDL WKA @YL026UD 25009702 SR RGA,RGA ZERO REGISTER 25009802 LA RGAREA,0(RGAREA) CLEAR HI-ORDER BYTE 25009902 ST RGA,ERCODE ERCODE, C.N., Z TO ZERO 25013202 LR RGJ,RGDCB RGJ HAS DCB ADDRESS 25015202 BBBB1 LR RGK,RGADDR RGK POINTS TO FFLL 25015602 STM R6,R11,RDAREA TEMPORARY SAVE 25016002 * 25016402 *** CONSTRUCT CHANNEL PROGRAM, ECB, AND IOB FOR READING 25016502 *** DIRECTORY BLOCKS 25016602 * 25019902 LM R0,R11,CHANPROG GET AND RELOCATE CHAN PROG 25021908 ALR R0,RGAREA CCW1 - SID CCHHR 25022708 ALR R2,RGAREA CCW2 - TIC TO CCW1 25023508 AR R4,RGAREA CCW3 - RDCNT INTO NEWCNT 25024308 AR R8,RGAREA CCW5 - TIC TO CCW3 25025108 AR R10,RGAREA CCW6 - RD DATA INTO RDAREA 25025908 STM R0,R11,CCW STORE IN BLDAREA WA 25026708 SR R0,R0 ZERO ECB 25028602 LA R2,ECBBLDL MOVE AND RELOCATE IOB 25029002 LA R5,CCW 25029402 SR R8,R8 ZERO BLK INCR FIELD 25029802 STM R0,R8,ECBBLDL ECB AND IOB TO WORKAREA 25029902 MVI IOBBLDL,X'02' SET NON-RELATED FLAG 25030002 LM R6,R11,RDAREA RESTORE REGISTERS 25033302 LA RGF,4(RGK) PT TO NAME ARGUMENT 25035308 AH R0,0(RGK) PICK UP NO. OF FIELDS 25035702 BZ H Q. TTR START SUPPLIED 25036102 LR RGA,RGK INIT USERS LIST 25036502 BBB1 MVI 14(RGA),0 ZERO R FIELD 25036602 AH RGA,2(RGK) GO TO NEXT FIELD IN LIST 25036702 BCT 0,BBB1 Q. ANOTHER FIELD 25037802 LH RGG,0(RGK) GET NO. OF ENTRIES 25039802 BB1 SR R0,R0 SET TTR START TO ZERO 25039902 BB1A IC R0,ERCODE+2 INSERT C.N. 25042002 USING IHADCB,RGJ GET ADDRESSIBILITY FOR DCB 25044002 BB2 L R1,DCBDEBAD GET DEB ADDRESS 25044402 LA R2,MBB FOR RESULT MBBCCHHR 25044802 LR R3,RGAREA 25045402 STM R11,R15,RDAREA SAVE VOLATILE REGISTERS 25045802 L R15,IECPCNVT USE TTR CONVERT ROUTINE @YL026UD 25046202 BALR R14,R15 25046602 LTR R15,R15 WAS USER TTR VALID 25047202 LM R11,R15,RDAREA-FIRST(R3) RESTORE VOLATILE REGISTERS 25047602 BNZ BADIO BRANCH IF INVALID TTR 25048002 LR RGH,RGF POINT TO FIRST EMPTY ENTRY 25048402 LR RGI,RGG NO. OF ENTRIES REMAINING 25048502 ST RGJ,IOBBLDL+20 DCB ADDRESS INTO IOB 25048602 A RGH,SKEH SEARCH CCW OP 25048702 B1 ST RGH,CCW4 INIT SEARCH 25048802 LR R2,R15 SAVE BASE 25048902 EXCP IOBBLDL 25049002 DROP RGBASE 25049502 USING BASE1,R2 25049902 WAIT 1,ECB=ECBBLDL 25050302 WAITLOOP TM ECBBLDL,X'60' CHECK COMPLETE AND ERROR BITS 25050402 BZ WAITLOOP Q. NOT YET COMPLETE 25050602 BO GOODIO CONTINUE IF NO ERRORS 25050702 BADIO LA R15,8 GET I/O ERROR CODE 25050802 BR RGRET RETURN 25050902 GOODIO EQU * 25051302 LR R15,R2 RESTORE BASE 25051702 DROP R2 25052102 USING BASE1,RGBASE 25052202 * SCAN DIRECTORY BLOCK 25052302 LA R3,RDAREA GET INPUT BLOCK ADDR @YL026UD 25052502 BCTR R3,0 25052602 AH R3,RDAREA SET END ADDR-1 25052702 LA R1,RDAREA+2 SET START ADDRESS 25052802 LA R0,31 SET MASK FOR C BYTE 25052902 C CLC 0(8,R1),0(RGH) COMPARE NAMES 25053002 BE D Q. FOUND 25053302 BH G Q. NOT IN THIS SECTION 25053702 IC R2,11(R1) GET USERS FIELD LENGTH 25054102 NR R2,R0 MASK 3 H.O. BITS 25054202 LA R2,12(R2,R2) ENTIRE ENTRY LENGTH IN R2 25054302 BXLE R1,R2,C Q. MORE ENTRIES IN BLOCK 25054402 MVC CCHHR,NEWCNT SET NEW START 25054802 B B1 25055202 * 25055302 D MVC 8(3,RGH),8(R1) MOVE TTR 25055402 IC R4,11(R1) GET C FROM DIRECTORY 25055502 NR R4,R0 MASK 3 H.O. BITS 25055602 LH R5,2(RGK) GET USERS LL 25055802 SH R5,C14 25056202 BM E1 Q. LL LESS THAN 14 25056602 BXLE R4,R4,E 25056702 LR R4,R5 USE REG 4 25056802 E EX R4,BLDLMOVE MOVE INTO USERS LIST 25056902 MVC 12(1,RGH),ERCODE+3 GET Z 25057002 E1 IC R4,ERCODE+2 GET C.N. 25057402 STC R4,11(RGH) C.N. INTO USERS LIST 25057502 F BCT RGI,F2 Q. ANOTHER LIST ENTRY 25057602 F1 LR RGI,R15 SAVE BASE 25057702 DROP RGBASE 25057802 USING BASE1,RGI 25057902 LH R15,ERCODE 25058002 BR RGRET BRANCH TO RETURN @YL026UD 25058202 * 25058302 DROP RGI 25064802 USING BASE1,RGBASE 25064902 F2 AH RGH,2(RGK) GO TO NEXT ENTRY 25065202 CLI 10(RGH),0 FIND NEXT ZERO R 25065602 BE C Q. EMPTY ENTRY 25065702 B F SEE IF ANOTHER EMPTY ENTRY 25065802 * 25066102 G CLI 0(R1),X'FF' CHECK FOR CONTINUATION POINTER 25066502 BL G1 Q. NOT HIGH NAME 25066902 CLC 1(7,R1),0(R1) MAKE SURE 25067302 BL G1 Q. REALLY NOT HIGH NAME 25067602 GG1 MVC FNDLST3,8(R1) GET TTR0 ON WORD BOUNDARY 25068002 L R0,FNDLST3 25068402 SH R0,H256 DECREMENT R BY 1 25068802 BNM BB1A Q. CONTINUATION POINTER 25069108 G1 CLI ERCODE+1,4 25069502 BE E1 Q. PREVIOUS ERROR 25069902 LA RGF,0(RGH) POINT TO FIRST EMPTY ENTRY 25070302 * ZERO H.O. BYTE 25070702 LR RGG,RGI NO. OF ENTRIES REMAINING 25071102 MVI ERCODE+1,4 SET ERROR CODE 4 25071502 B E1 25071902 * 25072002 H LA RGG,R1 SET FOR ONE ENTRY 25072102 LR R1,RGF MAKE MOVE AT GG1 WORK 25072202 LR RGH,RGF POINT TO ENTRY 25072302 LR RGI,RGG 25072402 B GG1 25072502 * 25072602 TITLE 'IGG0CLCC - CONSTANT DEFINITIONS' @YL026UD 25072802 * 25073402 *********************************************************************** 25073502 * 25073602 * CONSTANTS FOR ALL EXCEPT RACHECK ROUTINE 25073708 * 25074008 *********************************************************************** 25074108 DS 0F 25074202 CAMMASK1 DC X'387F8000' CHECK ALL BITS USED BY CATALOG 25074602 ONELVLMK DC X'00198000' CHECK FOR ONE LEVEL OPERATION 25075002 FFFF DC X'0000FFFF' @Z30AAEH 25075100 QNAM DC CL8'SYSCTLG ' ENQ NAME 25075402 SPNBYTES DS 0F PUT ON FULL WORD BOUNDARY 25075802 DC AL1(253) SUBPOOL ID 25076202 DC AL3(AREAEND-DCBAREA) GET SIZE OF AREA #YL026UD 25076602 ENABLE DC X'FF' SSM MASK 25077002 ZEROVOLS DC 6X'00' VOLUME ID YA00090 25077402 MSG1 WTO 'IEC340I - IGG0CLCC, INSUFFICIENT STORAGE FOR THE CATALOX25077508 G WORKAREA',ROUTCDE=(11),MF=L @OZ30106 25077608 MOVENAME MVC HILVLNAM(0),0(NAMPSAV) 25077802 MOVELVL MVC NAME(0),0(R2) MOVE LEVEL NAME 25078202 H01 DC H'01' 25078502 ZEROS DC X'F0F0' 25080602 MINUS DC X'D0' 25082702 MOVE1 MVC 0(0,R3),0(R11) MOVE SECOND THRU LAST LEVELS 25084802 MOVE2 MVC 1(0,R3),0(R3) BLANK USER NAME AREA 25086902 PACK1 PACK PKDNUMBR,0(0,R2) PACK THE RELATIVE NUMBER 25089002 RPSDDK DC X'01000800' RPS THETA CONVERT CONSTANT 25091102 * 25092402 BLDLMOVE MVC 13(1,RGH),11(R1) BLDL MOVE 25092802 C14 DC H'14' 25092902 * 25093202 RACFADDR DC A(RACHK) RACHECK ROUTINE @Z40CSRC 25094208 IGG0CLCD DC V(IGG0CLCD) @YL026UD 25095302 ERRORMOD DC V(IGG0CLC7) @YL026UD 25097402 OPENMOD DC V(IGC0002H) @YL026UD 25099502 ESTAEXIT DC V(ESTAEXIT) @YL026UD 25101602 ALLOCRTN DC V(IGG0CL1A) ALLOCATION ROUTINE @Z40CSRC 25101908 * 25103702 TITLE 'IGG0CLCC - CHANNEL COMMAND WORD DEFINITIONS' @YL026UD 25107802 * 25107902 * CHANNEL COMMAND WORDS 25110002 * 25120002 * THE FIRST TWO CCW'S POSITION TO A RECORD 25130002 DS 0F ALIGN ON WORD BOUNDARY 25140002 FIRST5 EQU * 25150002 CCWSIDE1 EQU * 25160002 DC X'31' SEARCH ID EQUAL 25170002 DC AL3(IOBSKADD+3-WORKAREA) POINT TO IOB CCHHR 25180002 DC X'4000' COMMAND CHAIN ON 25190002 DC H'5' COMPARE 5 BYTES 25200002 * 25210002 CCWTIC1 EQU * 25220002 DC X'08' TIC TO SIDE1 25230002 DC AL3(SIDE1-WORKAREA) POINT TO CCWSIDE1 25240002 * MUST KEEP THE FOLLOWING 0 SINCE IT IS USED BY CCWSKE AND CCWNOP 25250002 DC F'0' USUALLY ZERO FOR TIC 25260002 * 25270002 READATA EQU * 25280002 * 25290002 * USED TO READ VICE, ICE AND FIRST PART OF AN EMPTY BLOCK 25300002 * 25310002 DC X'06' READ DATA 25320002 * READS 24 BYTES INTO THE TEMPORARY BUFFER IN THE SAVEAREA 25330002 DC AL3(TEMPBUFF-WORKAREA) 25340002 DC X'2000' SUPPRESS INCORRECT LENGTH 25350002 DC H'24' READ 24 BYTES 25360002 * 25370002 CCWRC EQU * READ COUNT 25380002 DC X'92' MULTI-TRACK OPERATION 25390002 DC AL3(NEXTCNT-WORKAREA) POINT TO INPUT BUFFER 25400002 DC X'4000' COMMAND CHAIN ON 25410002 DC H'8' READ 8 BYTES 25420002 * 25430002 * THE NEXT FOUR CCW'S ARE USED TO FIND THE NEXT AVAILABLE BLK 25440002 * (HAS 0 KEY) IN THE CATALOG BY DOING A SEQUENTIAL SEARCH FROM 25450002 * THE OLD FIRST AVAILABLE BLOCK. 25460002 CCWSKE EQU * 25470002 DC X'29' SEARCH KEY EQUAL (TO 0) 25480002 DC AL3(TIC1+4-WORKAREA) POINT TO 4 BYTES OF 0 25490002 * COMMAND CHAINING AND SUPPRESS INCORRECT LENGTH 25500002 DC X'6000' 25510002 DC H'4' COMPARE ONLY FOUR BYTES 25520002 * 25530002 SECOND5 EQU * 25540002 CCWTIC2 EQU * 25550002 DC X'08' TIC TO READ COUNT 25560002 DC AL3(RC-WORKAREA) POINT TO READ COUNT CCW 25570002 DC F'0' USUALLY ZERO FOR TIC 25580002 * 25590002 CCWNOP EQU * 25600002 * 25610002 * AFTER A KEY MATCH AT CCWSKE, THIS CCW IS EXECUTED 25620002 * 25630002 DC X'03' CCW NOP 25640002 DC AL3(TIC1+4-WORKAREA) SEE REMARK BELOW 25650002 DC X'2000' SUPPRESS INCORRECT LENGTH 25660002 DC H'4' SEE REMARK BELOW 25670002 * THE ABOVE CCW OPCODE IS MODIFIED AND ALSO USED AS A WKD. 25680002 * 25690002 * THE NEXT CCW WRITE VERIFIES (I.E. READS WHAT WAS JUST 25700002 * WRITTEN TO CHECK CYCLIC BITS ON THE DEVICE). 25710002 * 25720002 CCWRKD EQU * 25730002 DC X'0E' READ KEY AND DATA 25740002 DC AL3(OUTPUT-WORKAREA) POINT TO 'OUTPUT' BUFFER 25750002 * SUPPRESS TRANSFER TO MAIN-STORAGE AND SUPPRESS INCORRECT LENGTH 25760002 DC X'3000' 25770002 DC H'264' KEY LEN PLUS DATA LEN 25780002 * 25790002 CCWRD EQU * 25800002 DC X'06' READ A DATA BLOCK 25810002 DC AL3(INPUT-WORKAREA) READ INTO INPUT BUFFER 25820002 DC F'256' ALL FLAGS OFF AND READ 1 BLOCK 25830002 * 25840002 CCWWKD EQU * 25850002 DC X'0D' WRITE KEY AND DATA 25860002 DC AL3(OUTPUT-WORKAREA) WRITE FROM OUTPUT BUFFER 25870002 DC F'264' ALL FLAGS OFF-- WRITE KEY DATA 25880002 * 25890002 DS 0F 25900002 RPSCCWS EQU * 25910002 * 25920002 CCWSS EQU * 25930002 DC X'23' SET SECTOR 25940002 DC AL3(THETA-WORKAREA) POINT TO RPS THETA 25950002 DC X'4000' COMMAND CHAINING 25960002 DC H'1' BYTE COUNT 1 FOR THETA 25970002 * 25980002 CCWTIC3 EQU * 25990002 * 26000002 * TIC TO NORMAL CHANNEL PROGRAM (CCWSIDE1) 26010002 * 26020002 DC X'08' TIC CCW 26030002 DC AL3(CHPROG-WORKAREA) POINT TO USUAL CCW LIST 26040002 DC F'0' USUALLY ZERO FOR TIC 26050002 * 26060002 THREE DC H'3' COMPARE TO LEVELCNT FOR UCATDX 26070002 CCDZERO DC CL4'0000' CHARACTER ZERO @ZA01897 26080002 EJECT 26090002 CHANPROG DS 0F 26092002 *CCW1 26094002 DC X'31' SEARCH ID EQUAL 26096002 DC AL3(0+CCHHR-FIRST) 26098002 DC X'4000' COMMAND CHAIN 26098402 DC H'5' COUNT 26098802 *CCW2 26099202 DC X'08' TIC 26099602 DC AL3(0+CCW1-FIRST) 26099702 DC F'0' 26099802 *CCW3 26099902 DC X'92' RD COUNT, M/T 26103202 DC AL3(NEWCNT-FIRST) 26105202 DC X'4000' 26105602 DC H'8' 26106002 *CCW4 26106402 SKEH DC X'69' SEARCH EQUAL HI KEY 26106502 DC AL3(0) 26106602 DC X'4000' COMMAND CHAIN 26109902 DC H'8' COUNT 26111902 *CCW5 26112302 DC X'08' TIC 26112702 DC AL3(0+CCW3-FIRST) 26113102 DC F'0' 26113202 *CCW6 26113302 DC X'06' READ DATA 26116602 DC AL3(0+RDAREA-FIRST) 26118602 DC H'0' 26119002 H256 DC H'256' 26119402 * @YL026UD 26119502 * @YL026UD 26122002 * MODULE PATCH AREA (MAINTENANCE AREA) @YL026UD 26124002 * @YL026UD 26124402 DS 0H 26124808 FIXAREA DC 100C'Z' @YL026UD 26125308 * 26125808 TITLE 'IGG0CLCC - CONSTANT EQUATE DEFINITIONS' @YL026UD 26126308 * 26127502 * 26130002 * CONSTANT EQUATES 26132502 * 26135002 VICETYP EQU 5 VICE TYPE CODE 26137502 ICETYP EQU 3 ICE TYPE CODE 26140002 ILETYP EQU 0 ILE TYPE CODE 26150002 IPETYP EQU 0 IPE TYPE CODE 26160002 DSPETYP EQU 7 OR MORE, FOR DSPE TYPE CODE 26170002 VCBPETYP EQU 1 VCBPE TYPE CODE 26180002 OCVOLTYP EQU 3 OLD CVOL TYPE CODE 26190002 NCVOLTYP EQU 5 NEW CVOL TYPE CODE 26200002 ALIASTYP EQU 4 ALIAS TYPE CODE 26210002 GIPETYP EQU 2 GIPE TYPE CODE 26220002 ERROR00 EQU 0 26230002 ERROR04 EQU 4 26240002 ERROR08 EQU 8 26250002 ERROR12 EQU 12 26260002 ERROR16 EQU 16 26270002 ERROR20 EQU 20 26280002 ERROR24 EQU 24 26290002 ERROR28 EQU 28 26300002 ERROR72 EQU 72 26320002 *********************************************************************** 26330002 * CHARACTER CODE DEPENDENT CONSTANTS 26340002 *********************************************************************** 26350002 CCDBLANK EQU C' ' 26360002 CCDRPARN EQU C')' 26370002 CCDMINUS EQU C'-' 26380002 CCDPLUS EQU C'+' 26390002 CCD0 EQU C'0' 26400002 CCDG EQU C'G' 26410002 CCDV EQU C'V' 26420002 CCDPERD EQU C'.' 26430002 CCDLPARN EQU C'(' 26440002 *********************************************************************** 26450002 CODPERD EQU 4 26460002 CODBLANK EQU 8 26470002 CODPARN EQU 12 26480002 CLC1 EQU C'1' 26490002 CLC2 EQU C'2' 26500002 CLC3 EQU C'3' 26510002 CLC4 EQU C'4' 26520002 CLC5 EQU C'5' 26530002 CLC6 EQU C'6' 26540002 CLC7 EQU C'7' 26550002 EXIT EQU 3 26560002 FREEMAIN EQU 10 26570002 GETMAIN EQU 10 26600002 FIRSTBLK EQU 256 26610002 RPSBIT EQU X'10' 26620002 BLDLCON EQU 76 26634002 CELLTYPE EQU 5 26634502 DBLWD EQU X'07' 26634902 ENDLIST EQU X'FF' 26635302 REC1 EQU 1 26635402 * 26635702 X00 EQU X'00' 26636202 X01 EQU X'01' 26636702 X02 EQU X'02' 26638002 X48 EQU X'48' 26638102 XF0 EQU X'F0' 26638402 XFF EQU X'FF' 26638802 X0100 EQU X'0100' 26639202 D01 EQU 1 26641202 D02 EQU 2 26643202 D08 EQU 8 26645202 D09 EQU 9 26645602 D12 EQU 12 26645702 D17 EQU 17 26646002 D28 EQU 28 26646402 D44 EQU 44 26646502 D62 EQU 62 26646808 D96 EQU 96 26647008 D256 EQU 256 26647702 D264 EQU 264 26648102 * 26680002 POMASK EQU X'02' MASK INDICATING PARTITIONED ORGANIZATION 26682002 OUTMASK EQU X'0F' MASK INDICATING NOT INPUT PROCESSING 26684002 TITLE 'IGG0CLCC - REGISTER EQUATE DEFINITIONS' @YL026UD 26692002 * 26700002 * REGISTER EQUATES 26710002 * 26720002 R0 EQU 0 26730002 R1 EQU 1 26740002 R2 EQU 2 26750002 R3 EQU 3 26760002 R4 EQU 4 BASE REGISTER FOR ALL MODULES 26770002 R5 EQU 5 26780002 R6 EQU 6 WORKAREA BASE REGISTER 26790002 R7 EQU 7 26800002 R8 EQU 8 CAMLST POINTER 26810002 R9 EQU 9 26820002 R10 EQU 10 26830002 R11 EQU 11 26840002 R12 EQU 12 SECONDARY LINKAGE REGISTER 26850002 R13 EQU 13 BLDL WORKAREA BASE REGISTER 26860002 R14 EQU 14 PRIMARY LINKAGE REGISTER 26870002 R15 EQU 15 26880002 * 26890002 BALREG1 EQU R14 26900002 BALREG2 EQU R12 26910002 BALREG3 EQU R5 26912002 BASE EQU R4 26920002 * 26922002 UCBTABP EQU R12 POINTS TO UCB LOOK UP TABLE 26924002 UCBPTR EQU R11 POINTS TO UCB 26926002 HILVLEN EQU R9 HIGH LEVEL NAME LENGTH 26928402 NXTDISP EQU R9 NEXT DISPLACEMENT 26928802 SAVDELP EQU R9 26929202 DLPTR EQU R10 PTR TO DISP & LEN FIELDS 26929602 NAMENDP EQU R14 END OF LARGEST ALLOWABLE NAME 26929702 LEVELPTR EQU R12 POINTS TO THE LEVEL NAME 26929802 NAMPSAV EQU R7 SAVES THE POINTER TO THE 26929902 LEVELCTR EQU R15 LEVEL COUNTER 26933202 ONELVLSW EQU R0 ONE LEVEL SWITCH 26935202 TLOCSW EQU R7 TEMPORARY LOCATE SWITCH 26935602 LEVELCNT EQU R7 26940002 ERRLOC EQU R3 26950002 TABLEPTR EQU R9 26960002 Q EQU R9 26972002 TRULEN EQU R10 26974002 POINT EQU R10 26976002 NEWENTRY EQU R7 26978002 * 26978102 RGADDR EQU 0 26978202 RGDCB EQU 1 26978302 RGA EQU 2 26980602 RGB EQU 3 26982602 RGC EQU 4 26983002 RGD EQU 5 26985802 RGE EQU 6 26987802 RGF EQU 7 26988202 RGG EQU 8 26988602 RGH EQU 9 26988702 RGI EQU 10 26989102 RGJ EQU 11 26989502 RGK EQU 12 26989902 RGAREA EQU 13 26992702 RGRET EQU 14 26994702 RGBASE EQU 15 26995102 * 26996002 DISABLE EQU ONELVLMK 26998802 * 27001602 *********************************************************************** 27004402 * * 27007202 TITLE 'IGG0CLCC - RACF AUTHORIZATION CHECKING ROUTINE' 27010008 *********************************************************************** 27010508 * @Z40CSRC 27010908 RACHK EQU * RACHECK ROUTINE @Z40CSRC 27011308 * @Z40CSRC 27011708 *********************************************************************** 27012108 * @Z40CSRC 27013008 * FUNCTION: @Z40CSRC 27013508 * CHECK AUTHORIZATION VIA RACF @Z40CSRC 27014008 * @Z40CSRC 27014508 * INPUT: @Z40CSRC 27015008 * R4 - MODULE BASE ADDRESS @Z40CSRC 27015108 * R6 - OS CATALOG WORK AREA ADDR @Z40CSRC 27015508 * R8 - CAMLST ADDR @Z40CSRC 27016008 * R13 - BLDL AREA ADDR @Z40CSRC 27016508 * R14 - RETURN ADDR @Z40CSRC 27017008 * @Z40CSRC 27017508 * OUTPUT: @Z40CSRC 27018008 * R15 - RETURN CODE -- 0=OK, 4=NOT AUTHORIZED. @Z40CSRC 27018508 * ERRLOCSV=8 AND NAMLF=56 IF NOT AUTHORIZED @Z40CSRC 27019008 * @Z40CSRC 27019508 * DESTROYED: @Z40CSRC 27020008 * REGISTER R15 (OTHER REGISTERS ARE PRESERVED) @Z40CSRC 27020508 * CC3SAV1A, CC3RACHK, @Z40CSRC 27021008 * @Z40CSRC 27021508 **************** @Z40CSRC 27022008 * @Z40CSRC 27022508 USING WORKAREA,R6 WORK AREA ADDRESSABLE @Z40CSRC 27023008 USING CAMLSTD,R8 CAMLST ADDRESSABLE @Z40CSRC 27023508 USING BLDLAREA,R13 BLDL AREA ADDRESSABLE @Z40CSRC 27024008 * @Z40CSRC 27024508 L R15,CWAP GET ADDR OF CC3 WK AREA @Z40CSRC 27025008 USING CC3WA,R15 CC3 WK AREA ADDRESSABLE @Z40CSRC 27025508 STM R0,R14,CC3SAV1A SAVE REGISTERS @Z40CSRC 27026008 LR R12,R15 COPY ADDR OF CC3WA @Z40CSRC 27026508 DROP R15 CEASE USING CC3WA,R15 @Z40CSRC 27027008 USING CC3WA,R12 ADDRESS CC3WA VIA R12 @Z40CSRC 27027508 BALR R9,R0 SET BASE REG. @Z40CSRC 27028008 USING *,R9 CODE ADDRESSABLE @Z40CSRC 27028508 MVI CC3NAMSV,X00 SHOW NO NAME SAVED YET @Z40CSRC 27028608 * @Z40CSRC 27029008 * INITIALIZE RACHECK PARAMETER LIST @Z40CSRC 27029508 * @Z40CSRC 27030008 MVC CC3RACHK(ACHKLEN),RACHKMDL MOVE IN DEFAULTS @Z40CSRC 27030508 LA R7,CC3RACHK ADDR OF PARM AREA @Z40CSRC 27031008 USING ACHKLIST,R7 PARM AREA ADDRESSABLE @Z40CSRC 27031508 L R14,CAMPTR1 GET ADDR OF DSNAME @Z40CSRC 27032008 ST R14,ACHKENTW ENTITY NAME ADDR @Z40CSRC 27032508 * @Z40CSRC 27033008 * CHECK FOR CATALOGING A GDG GENERATION @Z40CSRC 27034008 * @Z40CSRC 27034508 TM CAMOPTN1,CAMCAT CATALOG REQUEST @Z40CSRC 27035008 BNO NOTCATG NO, SKIP CAT CODE @Z40CSRC 27035508 MVI ACHKFLG2,ACHKTUPD SET UPDATE LEVEL @Z40CSRC 27036008 * @Z40CSRC 27036508 * TEMPORARILY BLANK OUT '.G----V--' IN GENERATION NAME @Z40CSRC 27037008 * @Z40CSRC 27037508 L R14,NAMLSTP GET ADDR OF LAST @Z40CSRC 27038008 * ENTRY IN NAME TABLE @Z40CSRC 27038508 SR R15,R15 CLEAR REG. @Z40CSRC 27039008 IC R15,X00(,R14) GET OFFSET TO LAST @Z40CSRC 27039508 * QUALIFIER OF NAME @Z40CSRC 27040008 BCTR R15,R0 GET OFFSET TO LAST '.' @Z40CSRC 27040508 A R15,CAMPTR1 ADDR OF LAST '.' @Z40CSRC 27041008 MVC X00(GVLEN,R15),CCDBLKS BLANK .G----V-- @Z40CSRC 27041508 LA R14,VOLSN ADDR OF VOLSER @Z40CSRC 27042008 B RACSETUP GO SET UP FOR RACHECK @Z40CSRC 27042508 * @Z40CSRC 27043008 NOTCATG EQU * NOT CATLG GDG @Z40CSRC 27043508 * @Z40CSRC 27044008 * CHECK FOR DRPX @Z40CSRC 27044508 * @Z40CSRC 27045008 TM CAMOPTN3,CAMDRPX IS IT DRPX @Z40CSRC 27045508 BNO NOTDRPX NO, SKIP DRPX CODE @Z40CSRC 27046008 LA R14,CCDCNAME ADDR OF 'SYSCTLG' @Z40CSRC 27046508 ST R14,ACHKENTW STORE ENTITY NAME @Z40CSRC 27047008 MVI ACHKFLG2,ACHKTALT MUST BE ALTER OWNER @Z40CSRC 27047508 LA R14,CVPEVOLS GET ADDR OF VOLSER @Z40CSRC 27048008 CLI TYPEB,OCVOLTYP WAS THIS CVOL POINTER @Z40CSRC 27048508 * CREATED BEFORE OS @Z40CSRC 27049008 * RELEASE 17 @Z40CSRC 27049508 BNE RACSETUP NO, GO SET UP FOR RACF @Z40CSRC 27050008 LA R14,DATAB ADDR OF VOLSER--OLD TYP @Z40CSRC 27050508 B RACSETUP GO SET UP FOR RACHECK @Z40CSRC 27051008 * @Z40CSRC 27051508 NOTDRPX EQU * NOT DRPX REQUEST @Z40CSRC 27052008 * @Z40CSRC 27052508 * SET AUTHORIZATION LEVEL FOR UNCATALOG & RECATALOG @Z40CSRC 27053008 * @Z40CSRC 27053508 TM CAMOPTN1,CAMRECAT IS IT RECAT @Z40CSRC 27054008 BNO NOTRECAT NO, SKIP RECAT CODE @Z40CSRC 27054508 MVI ACHKFLG2,ACHKTUPD SET UPDATE AUTH LEVEL @Z40CSRC 27055008 B GETVOLS GO GET VOL SER @Z40CSRC 27055508 * @Z40CSRC 27056008 NOTRECAT EQU * NOT RECAT REQUEST @Z40CSRC 27056508 TM CAMOPTN1,CAMUNCAT IS IT UNCAT @Z40CSRC 27057008 BNO RACSETUP NO, GO SET UP RACHECK @Z40CSRC 27057508 MVI ACHKFLG2,ACHKTALT SET ALTER OWNER LEVEL @Z40CSRC 27058008 * @Z40CSRC 27058508 * GET 1ST VOLSER OF DATA SET @Z40CSRC 27059008 * @Z40CSRC 27059508 GETVOLS EQU * GET VOLSER CODE @Z40CSRC 27060008 LA R14,DSPEVOL1 ASSUME ENTRY IS DSPE @Z40CSRC 27060508 CLI TYPEB,VCBPETYP IS IT REALLY A VCBPE @Z40CSRC 27061008 BNE RACFSTUP NO ,DO RACHECK @G32DSFS 27061532 * @Z40CSRC 27062532 * READ IN VCB TO GET VOLSER @Z40CSRC 27062632 * @Z40CSRC 27063008 MVC CC3NAMSV,NAME SAVE NAME @Z40CSRC 27063508 MVC CC3TTRSV,ICETTR SAVE TTR OF CURRENT REC @Z40CSRC 27064008 * (IS ZERO IF IN VICE) @Z40CSRC 27064108 L R15,AREADBLK GET ADDR OF BLK RD RTN @Z40CSRC 27064508 BALR BALREG3,R15 GO READ BLOCK @Z40CSRC 27065008 L R12,CWAP RESTORE CC3WA ADDR @Z40CSRC 27065208 LA R14,VCBVOL1 POINT TO 1ST VOLSER @Z40CSRC 27065508 * @Z40CSRC 27066008 * INVOKE RACF TO CHECK AUTHORIZATION @Z40CSRC 27066508 * @Z40CSRC 27067008 RACFSTUP EQU * TEST FOR TAPE @G32DSFS 27067532 * @G32DSFS 27067632 LR R15,R14 TYPE FIELD +2 @G32DSFS 27067732 SH R15,TYPEOFF TYPE FIELD PTR @G32DSFS 27067832 TM 0(R15),UCB3TAPE IS DEV TYPE EQU TAPE @G32DSFS 27067932 BZ RACSETUP NOT TAPE DEVICE @G32DSFS 27068032 * @G32DSFS 27068132 L R15,CVTPTR LOAD CVT ADDRESS @G32DSFS 27068232 USING CVT,R15 CVT ADDRESSABILITY @G32DSFS 27068332 L R15,CVTRAC LOAD RACF CVT ADDRESS @G32DSFS 27068432 LTR R15,R15 RACF ACTIVE @G32DSFS 27068532 BZ PASTRERR RACF NOT ACTIVE @G32DSFS 27068632 USING RCVT,R15 RCVT ADDRESSABILITY @G32DSFS 27068732 TM RCVTSTA1,RCVTTAPE TEST FOR TAPE VOLUME @G32DSFS 27068832 BZ PASTRERR NOT TAPE VOLUME @G32DSFS 27068932 * @G32DSFS 27069032 STCM R14,B'0111',ACHKENT VOLSER INTO ENTITY @G32DSFS 27069132 LA R14,TAPEVOL TAPE VOL CLASS NAME @G32DSFS 27069232 STCM R14,B'0111',ACHKCLN CLASS NAME INTO LIST @G32DSFS 27069332 SR R14,R14 VOLSER @ ZERO FOR TAPE @G32DSFS 27069432 * @G32DSFS 27069532 RACSETUP EQU * RACHECK SET UP @Z40CSRC 27069632 RACHECK VOLSER=(R14),MF=(E,(R7)) @G32DSFS 27069732 LA R14,ERROR08 LOAD COMPARISON VALUE @Z40CSRC 27069832 CR R15,R14 TEST IF UNAUTHORIZED @Z40CSRC 27069932 BNE PASTRERR BR IF NOT UNAUTHORIZED @Z40CSRC 27070032 MVI ERRCATSV,ERROR08 SET ERROR RETURN CODE @Z40CSRC 27070132 MVI ERRLOCSV,X00 CLEAR LOCATE RET CODE @Z40CSRC 27070232 MVI NAMLF+D01,RACREASN SET REASON CODE TO BE @Z40CSRC 27070332 * RETURNED TO USER IN R0 @Z40CSRC 27070508 * @Z40CSRC 27071008 PASTRERR EQU * BEYOND RACF ERROR CODE @Z40CSRC 27071508 * @Z40CSRC 27072008 * REFRESH IN-CORE CATALOG RECORD @Z40CSRC 27072508 * @Z40CSRC 27073008 CLI CC3NAMSV,X00 IS REFRESHING NEEDED @Z40CSRC 27073208 BE PASTREFR NO, SKIP REFR CODE @Z40CSRC 27074008 MVC NAME,CC3NAMSV RESTORE NAME FOR BLDL @Z40CSRC 27074508 L R15,CC3TTRSV GET ORIGINAL TTR @Z40CSRC 27074708 ST R15,TTR0 SET TTR FOR BLDL @Z40CSRC 27074908 LTR R15,R15 IS TTR ZERO @Z40CSRC 27075108 BNZ BLCALL BRANCH IF TTR NON-ZERO @Z40CSRC 27075308 MVI TTR0+D02,REC1 SET TO START AT 1ST REC @Z40CSRC 27075408 * @Z40CSRC 27075608 BLCALL EQU * SET UP TO CALL BLDL @Z40CSRC 27075708 L R15,ABLDLCAL GET ADDR OF BLDL RTN @Z40CSRC 27075808 BALR BALREG3,R15 GO READ ORIG ENTRY @Z40CSRC 27076008 L R12,CWAP RESTORE CC3WA ADDRESS @Z40CSRC 27076208 * @Z40CSRC 27076508 PASTREFR EQU * PAST REFRESH CODE @Z40CSRC 27077008 * @Z40CSRC 27077508 * RESTORE LAST QUALIFIER OF GDG GENERATION @Z40CSRC 27078008 * @Z40CSRC 27078508 TM CAMOPTN1,CAMCAT IS IT CATLG GDG @Z40CSRC 27079008 BNO RACLNUP NO, GO CLEAN UP @Z40CSRC 27079508 L R14,NAMLSTP PT TO LAST IN NAME TBL @Z40CSRC 27079608 SR R15,R15 CLEAR REG. @Z40CSRC 27079708 IC R15,X00(,R14) OFFSET TO LAST QUAL. @Z40CSRC 27079808 A R15,CAMPTR1 ADDR OF LAST QUALIFIER @Z40CSRC 27079908 MVC X00(L'NAME,R15),NAME MOVE IN NAME @Z40CSRC 27080108 XC D01(4,R15),MASKFF RESTORE TO TRUE NAME @OZ20755 27080208 BCTR R15,R0 POINT TO PERIOD SPOT @Z40CSRC 27080308 MVI X00(R15),CCDPERD MOVE IN '.' @Z40CSRC 27080408 * @Z40CSRC 27080508 * CLEANUP FOR RACF ROUTINE @Z40CSRC 27080608 * @Z40CSRC 27080708 RACLNUP EQU * CLEANUP @Z40CSRC 27080808 LM R0,R14,CC3SAV1A RESTORE REGISTERS @Z40CSRC 27080908 DROP R7,R9,R12 ADDRESSABILITY ENDS @Z40CSRC 27081008 SR R15,R15 ASSUME SUCCESS @Z40CSRC 27081108 CLI NAMLF+D01,RACREASN IS USER UNAUTHORIZED @Z40CSRC 27081208 BNER R14 NO, RETURN @Z40CSRC 27081308 LA R15,ERROR04 SET RETURN CODE @Z40CSRC 27081408 BR R14 RETURN @Z40CSRC 27081508 * @Z40CSRC 27081608 * EQUATES FOR RACF ROUTINE @Z40CSRC 27081708 * @Z40CSRC 27081808 RACSHFT EQU 28 RACF REG CD SHIFT VALUE @Z40CSRC 27082108 RACREASN EQU 56 RACF REASON CODE @Z40CSRC 27082208 GVLEN EQU 9 LENGTH OF .G----V-- @Z40CSRC 27082308 * @Z40CSRC 27082508 *********************************************************************** 27082608 * CONSTANTS FOR RACF ROUTINE @Z40CSRC 27082708 *********************************************************************** 27082808 * @Z40CSRC 27082908 CCDBLKS DC CL9' ' BLANKS @Z40CSRC 27083008 CCDCNAME DC CL44'SYSCTLG' CVOL NAME @Z40CSRC 27083108 CLASNAME DC AL1(L'CCDCLASS) LENGTH OF CLASS NAME @Z40CSRC 27083232 CCDCLASS DC C'DATASET' CLASS NAME--MUST FOLLOW @Z40CSRC 27083332 * LENGTH @G32DSFS 27083432 TAPEVOL DC AL1(L'TAPE) LENGTH OF CLASS NAME @G32DSFS 27083532 TAPE DC C'TAPEVOL' CLASS NAME--MUST FOLLOW @G32DSFS 27083632 * LENGTH @Z40CSRC 27083732 TYPEOFF DC H'2' DISP TO GET TO TYPE FLD @G32DSFS 27083832 AREADBLK DC A(READBLK) READ BLOCK RTN @Z40CSRC 27083932 ABLDLCAL DC A(BLDLCALL) BLDL CALLING RTN @Z40CSRC 27084032 *********************************************************************** 27084132 RACHKMDL RACHECK CLASS=CLASNAME,DSTYPE=N,MF=L @Z40CSRC 27084232 * 27084332 * END OF IGG0CLCC CSECT * 27084432 CLCCSIZE EQU * * 27084532 TITLE 'IGG0CLCC - RACHECK PARAMETER LIST' @Z40CSRC 27084632 ICHACHKL @Z40CSRC 27084732 *********************************************************************** 27084832 TITLE 'IGG0CLCC - RACF CVT DSECT DEFINITIONS' @Z40CSRC 27084932 ICHPRCVT @Z40CSRC 27085032 TITLE 'IGG0CLCC - CATALOG CONTROLLER III WORK AREA' @Z40CSRC 27085632 * @Z40CSRC 27085732 * CATALOG CONTROLLER III WORK AREA @Z40CSRC 27085832 * @Z40CSRC 27085932 * THIS AREA IS OBTAINED BY IGC0002F @Z40CSRC 27086032 * AND FREED BY IGC0002F AND IGG0CLCA. @Z40CSRC 27086132 * FOR A DESCRIPTION OF THE RESERVED FIELDS @Z40CSRC 27086232 * SEE THE ABOVE MODULES. @Z40CSRC 27086332 * @Z40CSRC 27086432 CC3WA DSECT @Z40CSRC 27086532 DS CL588 RESERVED @Z40CSRC 27086632 CC3CVOLS DS CL6 CVOL VOLUME SERIAL @Z40CSRC 27086732 * (SAME AS WKCVOLVS IN CLCA) 27086832 DS CL2886 RESERVED @Z40CSRC 27086932 CC3SAV1A DS 18F SAVE AREA (FOR CL1A) @Z40CSRC 27087008 * (SAME AS WKCL1ASV IN CLCA) 27087108 CC3RACHK DS 12F RACF PARAMETER AREA @Z40CSRC 27087508 * (SAVE AS WKSHRPRM IN CLCA) 27087608 ORG CC3RACHK+ACHKLEN BEYOND ACTUAL LIST @Z40CSRC 27088008 CC3NAMSV DS CL8 SAVE INDEX NAME @Z40CSRC 27088508 CC3TTRSV DS F SAVE TTR OF ORIG BLK @Z40CSRC 27089008 TITLE 'IGG0CLCC - CATALOG WORKAREA DSECT DEFINITION' @YL026UD 27092002 WORKAREA LIST=YES Y01113 27100002 CVPEVOLS EQU DATAB+4 VOLSER IN CVPE @Z40CSRC 27100508 DSPEVOL1 EQU VOLCNTB+6 1ST VOLSER IN DSPE @Z40CSRC 27101008 VCBVOL1 EQU INENTRY+4 1ST VOLSER IN VCB @Z40CSRC 27101508 TITLE 'IGG0CLCC - COMMUNICATIONS VECTOR TABLE DSECT' @YL026UD 27112002 CVT DSECT 27120002 CVT 27130002 TITLE 'IGG0CLCC - UNIT CONTROL BLOCK DSECT' @YL026UD 27142002 UCB DSECT 27150002 IEFUCBOB 27160002 TITLE 'IGG0CLCC - BLDL WORKAREA DSECT DEFINITION' @YL026UD 29290002 * 29650002 *** BLDL WORKAREA DEFINITION 29660002 * 29670002 BLDLWKA DSECT 29680002 FIRST DS 0D 29690002 SAVE2H DS 12F SAVEAREA FOR IGC0002H @YL026UD 29692002 ESTAREA DS 14F ESTAE INFORMATION AREA @YL026UD 29694002 RDAREA DS 64F 256 BYTE READIN AREA 29700002 NEWCNT DS 2F 29710002 CCW DS 0D 29720002 CCW1 DS D 29730002 CCW2 DS D 29740002 CCW3 DS D 29750002 CCW4 DS D 29760002 CCW5 DS D 29770002 CCW6 DS D 29780002 ECBBLDL DS F 29790002 IOBBLDL DS 8F 29800002 MBB DS C'mbb' 29810002 CCHHR DS C'cchhr' 29820002 ERCODE DS F 29830002 FNDLST1 DS F 29840002 IECPCNVT EQU FNDLST1 @YL026UD 29842002 FNDLST2 DS CL8 29850002 FNDLST3 DS F 29860002 REPSW DS X 'AVT REPLACED' INDICATOR 29870002 SAVEAVT DS 3X SAVE AREA FOR USER'S AVT PT 29882002 LAST DS 0D 29890002 * 29900002 TITLE 'IGG0CLCC - DCB DEFINITION DSECT (IHADCB)' @YL026UD 29960002 * 30180002 *** DCB DEFINITION 30190002 * 30200002 DCBD DSORG=PS,DEVD=DA 30210002 * 30220002 TITLE 'IGG0CLCC - DEB DEFINITION DSECT (IHADEB)' @YL026UD 30232002 * 30240002 *** DEB DEFINITION 30250002 * 30260002 IHADEB DSECT 30270002 DS F 30280002 DEBAMLNG DS X LENGTH OF DEB A/M SECTION 30290002 DS 3X 30300002 DEBOFLGS DS X OPEN FLAGS 30310002 DS 3X 30320002 DEBOPATB DS X METHOD OF I/O PROCESSING 30330002 DS 3X 30340002 DEBNMEXT DS X 30350002 DS 12X 30360002 DEBAPPAD DS 3X APPENDAGE VECTOR TABLE ADDRESS 30370002 DEBDVMOD DS F 30380002 DEBBINUM DS H 30390002 DEBSTRCC DS H 30400002 DEBSTRHH DS H 30410002 DEBENDCC DS H 30420002 DEBENDHH DS H 30430002 DEBNMTRK DS H 30440002 * 30450002 END IGG0CLCC 30460002