TITLE 'IEAVLK01 COMMENTARY' 00009040 * /* START OF SPECIFICATIONS **** 00018040 * 00027040 *01* MODULE-NAME = IEAVLK01 00036040 * 00045040 *01* DESCRIPTIVE-NAME = BLDL/FETCH/DSS/TESTRAN INTERFACES 00054040 * MODULE 2 OF 4 00063040 * 00072040 *01* COPYRIGHT = NONE 00081040 * 00090040 *01* STATUS = VERSION 2 00099040 * 00108040 *01* FUNCTION = THIS MODULE DOES THE FOLLOWING 00117040 * 00126040 * 1. CONTROL THE ORDER OF QUEUE AND LIBRARY SEARCHES 00135040 * 00144040 * 2. INTERFACE WITH BLDL SERVICE ROUTINE (svc ENTRY) 00153040 * 00162040 * 3. INTERFACE WITH PROGRAM FETCH SERVICE ROUTINE 00171040 * (BRANCH ENTRY) 00180040 * 00189040 * 4. PROVIDE A SWITCH FOR DSS (ENTRY DSS06) 00198040 * 00207040 * 5. PROVIDE AN INTERFACE FOR TESTRAN (VIA SVC 61) 00216040 * 00225040 * 6. PROCESS ALIAS PDS ENTRIES SO THAT MAJOR NAME MODULES 00234040 * THAT ARE IN CORE WILL BE REUSED, OR FETCHED 00243040 * 00252040 * ORDER OF SEARCHES: 00261040 * NO PDS ENTRY PASSED BY USER 00270040 * (SR.NON-DE1) 1. JOB PACK AREA (IN IEAVLK00) 00279040 * (SR.NON-DE2) 2. IF DCB PASSED SPECIFIC LIBRARY IS SEARCHED 00288040 * VIA BLDL 00297040 * (SR.NON-DE3) 3. IF DCB=0 JOB LIBRARIES ARE SEARCHED VIA BLDL 00306040 * (SR.NON-DE4) 4. ACTIVE LINK PACK AREA QUEUE (IN IEAVLK00) 00315040 * (SR.NON-DE6) 5. PAGEABLE LPA LPDE DIRECTORY 00324040 * (SR.NON-DE7) 6. LINK LIBRARY 00333040 * 00342040 * PDS PASSED BY USER (DE-FORM) 00351040 * (SR.DE1) 1. JOB PACK AREA (IN IEAVLK00) 00360040 * (SR.DE2) 2. IF DE IS FOR LINK LIBRARY OR SVC LIBRARY 00369040 * THE LPAQ IS SEARCHED, THEN STEP 3. 00378040 * IS DONE. OTHERWISE SKIP TO STEP 4 00387040 * (SR.DE3) 3. THE LPDES ARE SEARCHED 00396040 * (SR.DE4) 4. IF DCB SUPPLIED FETCH MODULE FROM LIBRARY 00405040 * (SR.DE5) 5. IF NO DCB, USE Z-BYTE TO LOCATE LIBRARY 00414040 * 00423040 *02* OPERATION = RECOVERY IS HANDLER BY AN FRR WHICH IS 00432040 * RESIDENT IN THE NUCLEUS IN MODULE IEAVLK03 00441040 * 00450040 *01* NOTES = THE FOLLOWING IS A DESCRIPTION OF THE DEPENDENCIES AND 00459040 * CONVENTIONS 00468040 * 00528940 *02* DEPENDENCIES = NONE 00530140 * 00543340 *02* RESTRICTIONS = NONE 00551440 * 00560640 *02* REGISTER-CONVENTIONS = THE REGISTER CONVENTIONS USED BY 00570240 * IEAVLK01 ARE DESCRIBED UNDER THE TOPIC 'GENERAL REGISTER 00580640 * EQUATES'. 00590240 * 00600640 *02* PATCH-LABEL = THIS MODULE IS RESIDENT NUCLEUS, AND HAS NO 00610240 * PATCH SPACE. 00626340 * 00631140 *01* MODULE-TYPE = MODULE 00641040 * 00650540 *02* PROCESSOR = ASSEMBLER 00660540 * 00670140 *02* MODULE-SIZE = 2324 BYTES, X'914' 00680240 * 00690040 *02* ATTRIBUTES = NUCLEUS 00700040 * REENTERABLE 00710040 * SUPERVISOR MODE 00720040 * 00729040 *01* ENTRY-POINT = IEAVLK01 00738040 * 00747040 *02* PURPOSE = SEARCH DCB'S AS REQUIRED, BEGIN SEARCH FOR LPAQ IF 00756040 * NECESSARY 00765040 * 00784840 *02* LINKAGE = IEAVLK01 IS BRANCH ENTERED BY IEAVLK00 00794840 * 00801840 *02* INPUT = FROM IEAVLK00 00808840 * 00824840 * REGISTERS 00832840 * R0 - LEFT HALF OF NAME 00840840 * R1 - RIGHT HALF OF NAME 00848840 * R4 - TCB ADDRESS 00856840 * R5 - SVRB ADDRESS 00874840 * R6 - BASE (IEAVLK01) 00882840 * R8 - ADDRESS OF LAST CDE QUEUE SEARCHED 00890840 * R9 - ADDRESS OF NAME 00898840 * R10- DCB ADDRESS 00906840 * OTHER REGISTERS NOT USED 00924840 * SVRB EXSAVE FULLY INITIALIZED 00932840 * 00940840 *02* OUTPUT = NONE 00948840 * 00956840 *02* REGISTERS-SAVED = NONE 00974840 * 00982840 *01* ENTRY-POINT = DSS06 00990840 * 00998840 *02* PURPOSE = SWITCH (NOP) USED TO ALLOW DSS TO RECORD 01006840 * INFORMATION AFTER EACH MODULE IS FETCHED. - NOT PART OF NORMAL 01024840 * MODULE FLOW 01032840 * 01040840 *02* LINKAGE = THE NOP IS CHANGED TO AN UNCONDITIONAL BRANCH TO DSS 01048840 * BY THE DSS INITIALIZATION ROUTINE WHEN DSS BECOMES ACTIVE. 01056840 * THIS ENTRY IS USED ONLY BY DSS. 01074840 * 01080840 *02* INPUT = SEE MINI-PROLOGUE BEFORE DSS NOP INSTRUCTION 01094840 * 01101840 *02* OUTPUT = NONE 01108840 * 01124840 *01* EXIT-NORMAL 01132840 * 01140840 *02* CONDITIONS = TO CDCONTRL (TO SEARCH LPAQ) 01148840 * 01156840 *02* OUTPUT = REGISTERS 01174840 * R3,4,5 - CVT,TCB,SVRB 01182840 * R6 - BASE FOR IEAVLK00 01190840 * R8 - CDE QUEUE ORIGIN TO SEARCH 01198840 * R9 - ADDRESS OF NAME 01206840 * R10 - DCB ADDRESS 01224840 * OTHER REGISTERS NOT USED 01232840 * SVRB EXSAVE FULLY INITIALIZED 01240840 * 01248840 *02* RETURN-CODES = NONE 01256840 * 01274840 *01* EXIT-NORMAL 01282840 * 01290840 *02* CONDITIONS = TO CDEMERGE (TO EXIT TO FOUND MODULE) 01298840 * 01306840 *02* OUTPUT = REGISTERS 01324840 * R3,4,5 - CVT,TCB,SVRB 01332840 * R6 - BASE FOR IEAVLK00 01340840 * R11 - REQUESTED CDE 01348840 * R12 - MAJOR CDE FOR REQUEST 01356840 * OTHER REGISTERS NOT USED 01374840 * SVRB EXSAVE FULLY INITIALIZED 01383840 * 01392840 *02* RETURN-CODES = NONE 01401840 * 01410840 *01* EXIT-NORMAL 01419840 * 01428840 *02* CONDITIONS = TO CDQUECTL (TO QUEUE AN ALIAS REQUEST BEING 01437840 * FETCHED UNDER MAJOR NAME) 01446840 * 01455840 *02* OUTPUT = REGISTERS 01464840 * R3,4,5 - CVT,TCB,SVRB 01473840 * R6 - BASE FOR IEAVLK00 01482840 * R8 - CDE QUEUE ORIGIN TO SEARCH 01491840 * R9 - ADDRESS OF NAME 01500840 * R10 - DCB ADDRESS 01509840 * R11 - CDE FOR REQUEST 01518840 * R12 - MAJOR CDE FOR REQUEST 01527840 * OTHER REGISTERS NOT USED 01536840 * SVRB EXSAVE FULLY INITIALIZED 01545840 * 01554840 *02* RETURN-CODES = NONE 01563840 * 01572840 *01* EXIT-NORMAL 01581840 * 01590840 *02* CONDITIONS = TO PLUSCONT (TO CHECK USABILITY OF FOUND MAJOR) 01599840 * 01608840 *02* OUTPUT = REGISTERS 01617840 * R0 - LEFT HALF OF NAME 01626840 * R1 - RIGHT HALF OF NAME 01635840 * R3,4,5 - CVT,TCB,SVRB 01644840 * R6 - BASE FOR IEAVLK00 01653840 * R8 - ADDRESS OF CDE QUEUE 01662840 * R9 - ADDRESS OF NAME 01671840 * R10 - DCB ADDRESS 01680840 * R11 - CDE FOR REQUEST 01689840 * R12 - MAJOR CDE FOR REQUEST 01698840 * OTHER REGISTERS NOT USED 01707840 * SVRB EXSAVE FULLY INITIALIZED 01716840 * 01725840 *02* RETURN-CODES = NONE 01734840 * 01743840 *01* EXIT-ERROR = ABNDSET 01752840 * 01761840 *02* CONDITIONS = TO ISSUE THE FOLLOWING ABENDS 01770840 * 106 - FETCH ERROR- R15=E - ADDRESS ERROR 01779840 * =F - I/O ERROR 01788840 * 306 - AN AUTHORIZED ROUTINE ATTEMPTED TO USE 01797840 * NON-AUTHORIZED LIBRARY MODULE. 01806840 * 406 - LOADABLE ONLY MODULE ON NON-LOAD REQUEST 01815840 * 706 - NON-EXECUTABLE MODULE FLAGGED BY LINKAGE EDITOR 01824840 * 806 - BLDL ERROR - R15=4 MODULE NOT FOUND 01833840 * =8 I/O ERROR 01842840 * =C NOT FOUND IN LPAQ OR LPDES 01851840 * =10 DCB FOR BLDL NOT OPEN @ZA18512 01855840 * 01860840 *02* OUTPUT = REGISTERS 01869840 * R13 - ABEND CODE (1,3,4,7, OR 8) 01878840 * R15 - REASON CODE IF 106, 306, OR 806 ABEND 01887840 * OTHER REGISTERS NOT USED 01896840 * SVRB EXSAVE FULLY INITIALIZED 01905840 * 01914840 *02* RETURN-CODES = NONE 01923840 * 01932840 *01* EXTERNAL-REFERENCES = THE FOLLOWING EXTERNAL REFERENCES ARE MADE 01941840 * 01950840 *02* ROUTINES = 01959840 * 1. IEAQCS04 - START OF RETURN ADDRESS TABLE IN IEAVLK00 01968840 * 2. IEAQCS02 - RESTART ADDRESS FOR NOT IN CORE QUEUED MODULES 01977840 * 3. LINKDCB - LINK LIBRARY OPENED DCB 01986840 * 4. SVCDCB - SVC LIBRARY OPENED DCB 01995840 * 5. IEWMSEPT - BRANCH ENTRY TO FETCH 02004840 * 6. IEAQLPAQ - LINK PACK QUEUE ORIGIN 02013840 * 7. POST W/O ECB - RESTART NIC REQUESTS 02022840 * 02031840 *02* DATA-AREAS = THE FOLLOWING DATA AREAS ARE USED BY IEAVLK01 02040840 * 1. DE SAVE AREA- CONTAINS THE DIRECTORY ENTRY, IN LSQA 02049840 * 2. FETCH/PGM. MGR. WORK AREA- CONTAINS FETCH IOB, 02058840 * INTERFACE INFORMATION, AND THE BLDL ENTRY 02067840 * 02076840 *02* CONTROL-BLOCKS = THE FOLLOWING CONTROL BLOCKS ARE USED 02085840 * 1. CDE (C) - CONTENTS DIRECTORY ENTRY 02094840 * 2. PDS (R) - PARTITIONED DATA SET DIRECTORY ENTRY 02103840 * 3. TCB (R) - TASK CONTROL BLOCK 02112840 * 4. RB (R) - REQUEST BLOCK (MODULE) 02121840 * 5. CVT (R) - COMMUNICATIONS VECTOR TABLE 02130840 * 6. LPDE (R) - LINK PACK DIRECTORY ENTRY 02139840 * 7. PSA (R) - OBTAIN LOW CORE ADDRESSES (TCB,ASCB) 02148840 * 8. IHAFRRS (R) - RECPVERU STACK 02157840 * 9. ASCB (R) - ADDRESS SPACE CONTROL BLOCK 02166840 * 10. ASXB (R) - ADDRESS SPACE EXTENTION 02175840 * 02184840 *01* TABLES = NONE 02193840 * 02202840 *01* MACROS = MACROS USED ARE 02211840 * BLDL,CVT,FREEMAIN,GETMAIN,IEZBITS,IEZDEB,IEZJSCB, 02220840 * IHAASCB,IHACDE,IHAFETWK,IHAFRRS,IHALPDS, 02229840 * IHAPSA,IHARB,IKJTCB,MODID,SETFRR,SETLOCK,TESTAUTH 02238840 * 02247840 *02* SERIALIZATION = THE CMS LOCK IS OBTAINED TO DO LPAQ SEARCH. THE 02256840 * LOCAL LOCK IS FREED AND REOBTAINED FOR SVC INTERFACES AND FOR 02265840 * FETCH. 02274840 * 02283840 *01* CHANGE-ACTIVITY = SUPPORT CODE FOR RELEASE 2 = Y02758 02292840 * OZ03829 OZ03896 - RELEASE 4 02301840 * OZ07512 OZ08130 02305840 * OZ10834 02307840 * OZ12661 - SEE LABEL JSCBOFF 02308840 * OZ18512 - CHECK FOR OPEN DCB BEFORE ISSUING THE 02309440 * BLDL SVC (SVC 12) @ZA18512 02310040 * OZ20311 - FREE CDE(S) AND EXTENT LIST IF ERRET 02310240 * WAS SPECIFIED @ZA20311 02310440 * OZ24461 - CONTINUE SEARCH IF AN AUTHORIZED COPY 02310840 * OF A MODULE IS REQUIRED AND AN 02311840 * UNAUTHORIZED COPY IS FOUND UNTIL 02312840 * LINKLIB HAS BEEN SEARCHED OR AN 02313840 * AUTHORIZED COPY IS FOUND BY MOVING 02314840 * JSCBOFF ROUTINE UP TO DEFOUND ROUTINE 02314940 * IMMEDIATELY AFTER THE BLDL @ZA24461 02315040 * OZ24951 - CHECK RESET APF WHEN ATTACH IS NOT A 02315640 * JOBSTEP ATTACH @ZA24951 02315740 * OZ26977 - REINITIALIZE POINTER TO FETCH WA 02315840 * AFTER CALL TO IEWFETCH @ZA26977 02316840 * OZ28734 - IF DE OPTION SPECIFIED ON REQUEST AND 02316940 * REQUESTOR IS AUTHORIZED BUT LIBRARY 02317040 * SPECIFIED OR DEFAULTED IS NOT AUTHOR 02317140 * IZED ABEND 306-C WILL RESULT @ZA28734 02317240 * OZ28886 - RESTORE THE POINTER TO THE WORK AREA 02317340 * BEFORE LOADING THE ABEND AND REASON 02317440 * CODE REGISTERS. @ZA28886 02317540 * OZ26582 - CHECK IF DE FORM OF MACRO IS USED 02317840 * AND, IF SO, CHECK IF UNAUTHORIZED 02318140 * USER REFERENCING AUTHORIZED LIBRARY; 02318440 * IF SO, ISSUE BLDL @ZA26582 02318740 * OZ28494 - PERFORM DEBCHECK TO VERIFY THE DCB 02318840 * ADDRESS IS VALID @ZA28494 02318940 * OZ30995 - IF ATTACH WITH THE DE OPTION WAS 02319040 * ISSUED, LOCATE THE MOTHER TCB THAT 02319140 * WAS RUNNING WHEN THE BLDL WHICH 02319240 * CREATED THE DE WAS ISSUED, SO THAT 02319340 * THE PROPER DCB CAN BE FOUND @ZA30995 02319440 * 02319540 *01* MESSAGES = NONE 02319840 * 02328840 *01* ABEND-CODES = SEE ERROR EXIT FOR ABENDS ISSUED IN IEAVLK01 02337840 * 02346840 **** END OF SPECIFICATIONS ***/ 02355840 EJECT 02364840 */*IEAVLK01: CHART (AMODE,AREF) */ 02373840 */* HEADER 02382840 */* PROGRAM MANAGER SEARCH 02391840 */* SECTION 3.1.11 02400840 */* SEQUENCE AND FETCH ROUTINES 02409840 */* PAGE # */ 02418840 */* E IEAVLK01 */ 02427840 SPACE 2 02436840 IEAVLK01 CSECT CSECT NAME **** SINGLE CSECT 02445840 USING *,BASEREG ADDRESSABILITY PASSED BY VLK00 02454840 MODID BR=YES SET MODULE IDENTIFIER 02463840 TITLE ' IEAVLK01 EXTERNAL REFERENCES' 02472840 ENTRY DSS06 DSS HOOK ENTRY 02481840 EXTRN IEAQCS04 POINTS TO ADDRESS LIST IN VLK00 02490840 EXTRN IEAQCS02 RESUME ADDRESS IN VLK00 02499840 EXTRN LINKDCB DCB FOR LINK LIBRARY 02508840 EXTRN SVCDCB DCB FOR SVC LIBRARY 02517840 EXTRN IEWMSEPT PROGRAM FETCH ENTRY POINT 02526840 EXTRN IEAQLPAQ LPAQ QUEUE ORIGIN 02535840 EXTRN FRRPGMMG PGM. MGR RECOVERY RTN 02544840 TITLE 'IEAVLK01 GENERAL REGISTER EQUATES' 02553840 * EQUATES FOR REGISTER 0 02562840 R0 EQU 0 CROSS REFERENCE EQUATE 02571840 GR0 EQU R0 GENERAL USE REGISTER 0 02580840 ZREG EQU R0 LIBRARY COUNT FOR DCB=0 CASE 02589840 * REGISTER 1 EQUATES 02598840 R1 EQU 1 CROSS REFERENCE EQUATE 02607840 TASKREG EQU R1 POINTS TO A TCB MOTHER 02616840 WKREG1 EQU R1 GENERAL WORK REGISTER 02625840 GR1 EQU R1 GENERAL WORK REGISTER 02634840 TASKLVL EQU R1 TASK LEVEL TCB ADDRESS 02643840 * REGISTER 2 EQUATES 02652840 R2 EQU 2 CROSS REFERENCE EQUATE 02661840 WKREG2 EQU R2 GENERAL WORK REGISTER 02670840 SAVETCB EQU R2 TSO SAVE TCB REG 02679840 * REGISTER 3 EQUATES 02688840 R3 EQU 3 CROSS REFERENCE EQUATE 02697840 COMREG EQU R3 RELOCATE SUBROUTINE RETURN REG 02706840 CVTREG EQU R3 POINTS TO CVT 02715840 * REGISTER 4 EQUATES 02724840 R4 EQU 4 CROSS REFERENCE EQUATE 02733840 TCBREG EQU R4 POINTS TO TCB 02742840 * REGISTER 5 EQUATES 02751840 R5 EQU 5 CROSS REFERENCE EQUATE 02760840 RBREG EQU R5 POINTS TO SVRB OF CONTENTS 02778840 * REGISTER 6 EQUATES 02787840 R6 EQU 6 CROSS REFERENCE EQUATE 02796840 BASEREG EQU R6 BASEREG FOR THIS MODULE 02805840 * REGISTER 7 EQUATES 02814840 R7 EQU 7 CROSS REFERENCE EQUATE 02823840 GR7 EQU R7 FETCH INTERFACE REGISTER 02832840 AREAREG EQU R7 POINTS TO BLDL-FETCH WORK AREA 02841840 ASCBREG EQU R7 ASCB REG FOR GETMAIN/FREEMAIN 02850840 * REGISTER 8 EQUATES 02859840 R8 EQU 8 CROSS REFERENCE EQUATE 02868840 DEBREG EQU R8 DEB POINTER FROM DEBCHK @ZA28494 02877840 TABREG EQU R8 QUEUE POINTER FOR SEARCHES 02886840 * REGISTER 9 EQUATES 02895840 R9 EQU 9 CROSS REFERENCE EQUATE 02904840 LPDIREG EQU R9 MAJOR LPDE POINTER 02913840 GR9 EQU R9 BLDL INTERFACE REGISTER 02922840 NAMEREG EQU R9 NAME IS POINTED TO BY THIS REG 02931840 LAST EQU R9 RB POINTER DURING DQLOAD 02940840 * REGISTER 10 EQUATES 02949840 R10 EQU 10 CROSS REFERENCE EQUATE 02958840 NEXT EQU R10 POINTS TO RB DURING DQLOAD 02967840 GR10 EQU R10 BLDL INTERFACE REGISTER 02976840 DCBREG EQU R10 POINTS TO DCB FOR LIB TO SEARCH 02985840 * REGISTER 11 EQUATES 02994840 R11 EQU 11 MAINLAND WORK REGISTER 03003840 GR11 EQU R11 TASK SWITCH INTERFACE REGISTER 03012840 CDEREG EQU R11 CDE FOR REQUESTED NAME 03021840 * REGISTER 12 EQUATES 03030840 R12 EQU 12 CROSS REFERENCE EQUATE 03039840 GR12 EQU R12 GENERAL WORK REGISTER 03048840 CDIREG EQU R12 POINTS TO MAJOR CDE FOR REQUEST 03057840 * REGISTER 13 EQUATES 03066840 R13 EQU 13 CROSS REFERENCE EQUATE 03075840 RETURND EQU R13 SUBROUTINE RETURN REGISTER 03084840 GR13 EQU R13 GENERAL WORK REGISTER 03093840 * REGISTER 14 EQUATES 03102840 R14 EQU 14 CROSS REFERENCE EQUATE 03111840 RETURN EQU R14 SUBROUTINE RETURN REGISTER 03120840 GR14 EQU R14 GENERAL WORK REGISTER 03129840 SUBREG1 EQU R14 GENERAL WORK REGISTER 03138840 * REGISTER 15 EQUATES 03147840 R15 EQU 15 CROSS REFERENCE EQUATE 03156840 GR15 EQU R15 GENERAL WORK REGISTER 03165840 SUBREG2 EQU R15 GENERAL WORK REGISTER 03174840 TITLE 'IEAVLK01 FLAG AND MASK EQUATES' 03183840 TLIBIND EQU X'87' INDICATES TASKLIB PROCESSING 03192840 MASK EQU X'07' 3 BYTE ICM/STCM/CLM MASK 03201840 MASK4 EQU X'0F' 4 BYTE ICM/STCM/CLM MASK 03210840 MAX EQU X'FF' LARGEST ONE BYTE NUMBER 03219840 DEBAD EQU X'2C' OFFSET OF DEB INTO DCB 03228840 TITLE 'IEAVLK01 GENERAL NUMBER VALUE EQUATES' 03237840 N0 EQU 0 USED FOR ZERO OFFSETS 03246840 ZERO EQU R0 USED FOR ZERO OFFSETS 03255840 N1 EQU 1 USED TO INCREMENT VALUES 03264840 APFLN EQU 1 APF LENGTH CON @ZA08130 03268840 N2 EQU 2 USED TO INCREMENT ABEND VALUE 03273840 N3 EQU 3 USED TO INCREMENT ERROR VALUES 03282840 ADDL EQU 3 MAXIMUM LENTGH OF AOS ADDRESSES 03291840 N4 EQU 4 USED TO INCREMENT VALUES 03300840 WORD EQU 4 USED TO INCREMENT VALUES 03309840 OLD EQU 4 OLD TCB SLOT IN NEW/OLD SLOTS 03318840 FOUR EQU 4 OFFSET IN EXTENT LIST 03327840 * TO NUMBER OF EXTENTS 03336840 NAME EQU 8 LENGTH OF AOS NAMES 03345840 N8 EQU 8 USED AS NUMBER VALUE 03354840 EIGHT EQU 8 USED AS NUMBER VALUE 03363840 EQZER EQU 8 USED TO TEST CONDITION CODES 03372840 N12 EQU 12 OFFSET INTO EXTENT LIST 03381840 BADRETCD EQU 12 USED TO ISSUE RETURN CODE OF 12 03390840 DONTBLDL EQU 16 INDICATE DCB NOT OPEN @ZA18512 03394840 XTLSTSIZ EQU 16 SIZE OF 1 ENTRY EXTENT LIST 03399840 TTSAVE EQU 61 TESTRAN SVC NUMBER 03408840 SPNONREN EQU 251 SUBPOOL FOR NON-RENTRENT MODULES 03417840 SPRENT EQU 252 SUBPOOL FOR REENTRENT MODULES 03426840 TITLE ' IEAVLK01 BLDL FETCH' 03435840 USING PSA,0 ADDRESSIBILITY FOR LOW CORE 03444840 USING TCB,TCBREG REG.4 CONTAINS TCB ADDRESS 03453840 USING RBSECT,RBREG REG.5 CONTAINS RB ADDRESS 03462840 USING WKAREA,AREAREG REG.7 CONTAINS WORK AREA ADDR 03471840 USING CDENTRY,CDEREG REG.11 CONTAINS CDENTRY ADDRESS 03480840 USING CDENTRYJ,CDIREG REG.12 CONTAINS CDENTRY ADDRESS 03489840 USING ADDRTAB,GR15 ADRESS TABLE DSECT IN VLK00 03498840 EJECT 03507840 * THE FOLLOWING CODE, IN CONJUNCTION WITH CDTSLPA, SATMAR, AND 03516840 * DEMISSED, CONTROLS THE ORDER OF SEARCHES FOR THE CDE QUEUES 03525840 * AND LIBRARIES. PLEASE REFER TO THE ORDER OF SEARCHES IN THE 03534840 * PROLOGUE. THIS SECTION OF CODE IS ENTERED AFTER STEPS 03543840 * (SR.NON-DE1,4, OR 5) OR (SR.DE 1,2, OR 3) DEPENDING ON WHETHER 03552840 * OR NOT A DE WAS PASSED BY THE USER. 03561840 * FLOW: 03570840 * 03579840 * A. CHECK IF (SR.NON-DE4) OR (SR.DE2) HAS BEEN DONE. IF NOT, 03588840 * GO TO CDTSLPA FOR FURTHER TESTING. 03597840 * B. CHECK IF THIS IS A TIME SHARING TASK. IF YES, DO STEP C. 03606840 * OTHERWISE DO STEP D. 03615840 * C. (SR.NON-DE5),(SR.DE3) SET R8 TO ADDRESS TSCVTLPA, THEN 03624840 * EXIT TO CDCONTRL (IEAVLK00) TO SEARCH TSLPA. 03633840 * D. CHECK IF LPDE DIRECTORY HAS BEEN BUILT. IF NOT, DO STEP 03642840 * E. OTHERWISE DO STEP F. 03651840 * E. (SR.NON-DE7),(SR.DE5,6) SEARCH LINK LIBRARY VIA SATMAR 03660840 * F. (SR.NON-DE6),(SR.DE4) SEARCH LPDES. IF FOUND GO TO 03669840 * DETOLPAQ AFTER PAGING IN LPDES AND CHECKING FOR 406 ABEND. 03678840 * IF NOT FOUND DO STEP E. 03687840 * 03696840 * REGISTER USAGE 03705840 * R0 - LEFT HALF OF NAME (INPUT) 03714840 * ALTERED (OUTPUT) 03723840 * R1 - RIGHT HALF OF NAME (INPUT) 03732840 * R2 - LPDE ADDRESS (OUTPUT, STEP F) 03741840 * R3 - CVT ADDRESS (OUTPUT) 03750840 * R4,5-TCB,SVRB ADDRESSES (INPUT) 03759840 * R6 - BASE (IEAVLK01) 03768840 * R8 - ALTERED 03777840 * R9 - ADDRESS OF NAME (INPUT) 03786840 * R10- DCB REGISTER (INPUT) 03795840 * OTHER REGISTERS CHANGED, OR NOT USED 03804840 * SVRB EXSAVE FULLY INITIALIZED 03813840 SPACE 2 03822840 */* P SET R3= ADDRESS OF CVT */ 03831840 SPACE 2 03840840 L CVTREG,CVTPTR GET ADDRESS CVT 03849840 USING CVT,CVTREG ADDRESS THE CVT 03858840 SPACE 2 03867840 */* D (NO,CDTSLPA,YES,) ALPAQ BEEN SRCH'D YET (R8= PTR TO ALPAQ HDR)*/ 03876840 SPACE 2 03885840 C TABREG,IEAQLCTA Q. HAS LPACQ BEEN SEARCHED 03894840 BNE CDTSLPA NO-TEST LPA 03903840 SPACE 2 03912840 */*CHKLPDES: D (NO,SATMAR,YES,) LPA DIRECTORY BEEN BUILT (CVTDICOM 03921840 */*=1)*/ 03930840 SPACE 2 03939840 CHKLPDES TM CVTLPDIA,CVTDICOM HAS DIRECTORY BEEN BUILT 03948840 BZ SATMAR IF NOT, DO NOT SEARCH 03957840 SPACE 2 03966840 */* P SAVE R6 IN R2 AND R9 IN R15*/ 03975840 SPACE 2 03984840 LR WKREG2,BASEREG SAVE GR6 OVER INTERFACE 03993840 LR R15,NAMEREG SAVE GR9 OVER INTERFACE 04002840 SPACE 2 04011840 */* P INSURE GOOD SEARCH INDICATOR IS OFF (SET RBCSGSF =0)*/ 04020840 SPACE 2 04029840 NI RBCSFLG1,MAX-RBCSGSF TURN GOOD SEARCH FLAG OFF 04038840 SPACE 2 04047840 */* L (NOTF,%XSKP,FND,)IEAVVMSR-- SEARCH PAGED LINKPACK DIRECTORY */ 04056840 */* P TURN ON GOOD SEARCH INDICATOR (SET RBCSGSF =1)*/ 04065840 */* %XSKP: P RESTORE R6 FROM R2 AND R9 FROM R15*/ 04074840 SPACE 2 04083840 L BASEREG,CVTLPDSR PICK UP SEARCH ROUTINE ADDR 04092840 BALR RETURN,BASEREG SEARCH LPDE DIRECTORY 04101840 OI RBCSFLG1,RBCSGSF TURN ON GOOD SEARCH FLAG IF 04110840 * RETURN ON R14 + 0 04119840 LR BASEREG,WKREG2 RESET ADDRESSABILITY FOR VLK01 04128840 LR NAMEREG,R15 RESET NAME REGISTER 04137840 SPACE 2 04146840 */*LPDSBLE: D (NO,SATMAR,YES,) LPDE FOUND (RBCSGSF =1)*/ 04155840 SPACE 2 04164840 LPDSBLE EQU * LPDE PREFIXING ROUTINE 04173840 TM RBCSFLG1,RBCSGSF IF SEARCH FAILED, GO TO 04182840 BZ SATMAR LIBRARY SEARCH 04191840 SPACE 2 04200840 */* P SET R2= RQSTD LPDE ADDRESS (SET R2=R0)*/ 04209840 SPACE 2 04218840 LR WKREG2,R0 PUT LPDE ADDRESS IN USABLE REG 04227840 USING LPDE,WKREG2 ADDRESS THE LPDE 04236840 SPACE 2 04245840 */*LPDTST: D (NO,DETOLPAQ,YES,) LOAD ONLY MODULE? (LPDENLR =0)*/ 04254840 SPACE 2 04263840 LPDTST EQU * TEST THE ATTRIBUTES OF THE LPDE 04272840 TM LPDEATTR,LPDENLR Q. IS THIS A LOAD ONLY MODULE 04281840 BO DETOLPAQ NO- MODULE CAN BE USED 04290840 SPACE 2 04299840 */* D (YES,DETOLPAQ,NO,) LOAD REQUEST? (RBCDLOAD =1)*/ 04308840 SPACE 2 04317840 TM RBCDFLGS,LOAD Q. IS LOAD REQUEST IN PROGRESS 04326840 BO DETOLPAQ YES- MODULE CAN BE USED 04335840 SPACE 2 04344840 */* P (,ERRRTN) SET ABEND REGISTER (R13) TO 4 FOR 406 ABEND*/ 04353840 SPACE 2 04362840 LA R13,4 SET FOR ERROR CODE 406 @YA01851 04371840 B ERRRTN GO SET UP CODE AND ABEND @YA01851 04380840 EJECT 04389840 * DETOLPAQ IS ENTERED WHEN AN LPDE HAS BEEN FOUND FOR A REQUEST. 04398840 * FIRST THE LPDE IS CHECKED FOR BEING A MINOR. IF THE LPDE IS 04407840 * NOT A MINOR, A MAJOR CDE IS CREATED, QUEUED TO THE LPAQ, AND 04416840 * AN EXTENT LIST IS BUILT TO DESCRIBE THE MODULE. THE ROUTINE 04425840 * THEN EXITS TO CDEMERGE IN IEAVLK00. 04434840 * IF THE LPDE WAS A MINOR, THE LPAQ IS SEARCHED FOR THE MAJOR 04443840 * CDE. IF IT IS FOUND, A MINOR CDE IS CREATED, AND QUEUED 04452840 * BEHIND THE MAJOR, AND EXIT IS AGAIN TO CDEMERGE. 04461840 * IF THE CDE WAS NOT FOUND, THE LPDES ARE SEARCHED FOR THE 04470840 * MAJOR LPDE. IF IT IS FOUND, THE MAJOR AND MINOR CDES ARE 04479840 * CREATED, IN ADDITION TO THE EXTENT LIST, AND ARE QUEUED TO THE 04488840 * LPAQ. EXIT IS AGAIN TO CDEMERGE. 04497840 * IF THE MAJOR CDE OR LPDE ARE NOT FOUND, AN 806 ABEND IS ISSUED 04506840 * VIA ABNDSET IN IEAVLK00. 04515840 * REGISTERS ON ENTRY 04524840 * R2,3,4,5,6 - LPDE,CVT,TCB,SVRB, BASE (IEAVLK01) 04533840 * OTHER REGISTERS NOT REFERENCED. 04542840 * SVRB EXSAVE FULLY INITIALIZED. 04551840 * CMS LOCK HELD ON ENTRY 04560840 SPACE 2 04569840 */*DETOLPAQ: P SET R7= ASCB ADDR FOR GETMAIN (SET R7= PSAAOLD)*/ 04578840 SPACE 2 04587840 DETOLPAQ EQU * 04596840 USING LPDEJ,LPDIREG ADDRESS MAJOR LPDE 04605840 USING LPDE,WKREG2 USE REG 2 TO ADDRESS LPDE 04614840 L ASCBREG,PSAAOLD GET ASCB ADDRESS FOR GETMAIN 04623840 SPACE 2 04632840 */* D (YES,MINORIT,NO,) RQSTD LPDE A MINOR? (LPDEMIN =1)*/ 04641840 SPACE 2 04650840 TM LPDEATTR,LPDEMIN IF MINOR LPDE,GO TO FIND MAJOR 04677840 BO MINORIT CDE OR LPDE 04686840 SPACE 2 04695840 */* P SET LPDIREG = ADDR MAJOR LPDE (SET R9 = R2)*/ 04704840 SPACE 2 04713840 LR LPDIREG,WKREG2 SET UP MAJOR LPDE REG. 04722840 SPACE 2 04731840 */*CREATMAJ: L GETMAIN (BR ENTRY)-- GET A CDE AND EXTENT LIST FROM 04740840 */*SP245 */ 04749840 SPACE 2 04758840 CREATMAJ LA R0,CDXLIN GET SPACE FOR MAJOR CDE 04767840 GETMAIN RU,LV=(0),SP=245,BRANCH=YES GET CDE AND EXTENT LIST 04776840 SPACE 2 04785840 */* P set cderEG = NEW CDE ADDR (R11=R1)*/ 04794840 */* P SET CDIREG (R12) = R11*/ 04803840 */* P INITIALIZE NEW XL (WORD 0) TO 16 (SIZE OF XL)*/ 04812840 */* P INITIALIZE NEW XL (WORDS 2 & 3) FROM LPDEXTLN & LPDEXTAD*/ 04821840 SPACE 2 04830840 LR CDEREG,WKREG1 PUT CDE ADDR. IN USABLE REG. 04839840 LR CDIREG,CDEREG SET UP MAJOR CDE REG. 04848840 LA WKREG1,LPDCDE(WKREG1) CALCULATE ADDR. OF XTLST 04857840 MVC N8(N8,WKREG1),LDXTLTHJ INITIALIZE XTLST 04866840 LA R0,XTLSTSIZ SIZE=16 04875840 ST R0,N0(WKREG1) STORE INTO NEW XLIST 04884840 LA R0,N1 XTENTS=1 04893840 ST R0,FOUR(WKREG1) STORE INTO NEW XLIST 04902840 SPACE 2 04911840 */* P COPY LPDE (VIA R9) INTO NEW CDE*/ 04920840 */* P SET CDXLMJP OF NEW CDE = XL ADDR*/ 04929840 SPACE 2 04938840 MVC CDENTRYJ(LPDCDE),LPDEJ MOVE CDE FIELDS IN 04947840 ST WKREG1,CDXLMJPJ STORE ADDR. OF XTLST IN CDE 04956840 SPACE 2 04965840 */* P CHAIN CDE TO TOP OF ALPA QUEUE */ 04974840 SPACE 2 04983840 L CVTREG,CVTPTR GET ADDRESS OF CVT 04992840 L WKREG1,CVTQLPAQ GET POINTER TO CDE 05001840 MVC CDCHAINJ(WORD),N0(WKREG1) CREATE FORWARD POINTER 05010840 ST CDIREG,N0(WKREG1) SET UP QUEUE POINTER 05019840 SPACE 2 05028840 */* D (YES,MINORCA,NO,CDMRGRET) RQSTD LPDE A MINOR (LPDEMIN =1)*/ 05037840 SPACE 2 05046840 TM LPDEATTR,LPDEMIN TEST FOR MAJOR OR MINOR 05055840 BO MINORCA IF MINOR, GO TO MINOR PROCESSING 05064840 B CDMRGRET LEAVE 05073840 SPACE 2 05082840 */*MINORCR: P SET CDIREG = MAJOR CDE ADDR (SET R12 = R11)*/ 05091840 SPACE 2 05100840 MINORCR LR CDIREG,CDEREG PUT ADDR. OF MAJOR INTO REG 05109840 SPACE 2 05118840 */*MINORCA: L GETMAIN (BR ENTRY)-- GET MINOR CDE FROM SP 245 */ 05127840 SPACE 2 05136840 MINORCA EQU * GET SPACE FOR CDE 05145840 GETMAIN RU,LV=CDESIZE,SP=245,BRANCH=YES IN SQA 05154840 SPACE 2 05163840 */* P SET CDEREG = ADDR OF NEW MINOR CDE (SET R11=R1)*/ 05172840 */* P COPY LPDE (VIA R2) INTO NEW CDE*/ 05181840 SPACE 2 05190840 LR CDEREG,WKREG1 PUT CDE ADDR. IN USABLE REG. 05199840 MVC CDENTRY(LPDCDE),LPDE INITIALIZE CDE 05208840 SPACE 2 05217840 */* P (,CDMRGRET) CHAIN MINOR BEHIND ITS MAJOR CDE */ 05226840 SPACE 2 05235840 MVC CDCHAIN(WORD),CDCHAINJ CHAIN CDE TO NEXT 05244840 ST CDEREG,CDCHAINJ CHAIN MAJOR TO MINOR 05253840 ST CDIREG,CDXLMJP ADDR OF MAJOR IN MINOR 05262840 B CDMRGRET LEAVE 05271840 SPACE 2 05280840 */*MINORIT: P SET R8= ADDR OF ALPAQ HEADER*/ 05289840 */* P SET R9 = ADDR OF MAJOR NAME (SET R9= ADDR OF LPDEXTLN)*/ 05298840 */* L (FND,MINORCR,NOTF,) IEAQCDSR-- SEARCH LPAQ FOR MAJOR CDE*/ 05307840 SPACE 2 05316840 MINORIT LA NAMEREG,LPDEXTLN SEARCH LPAQ FIRST 05325840 L CVTREG,CVTPTR GET CVT ADDRESS 05334840 L TABREG,CVTQLPAQ FOR MAJOR CDE 05343840 L RETURN,CVTQCDSR PICK UP CDSEARCH ADDR 05352840 BALR RETURN,RETURN SEARCH THE QUEUE FOR 05361840 * MAJOR 05370840 B MINORCR IF FOUND,CREATE MINOR 05379840 SPACE 2 05388840 */* P INSURE GOOD SEARCH INDICATOR IS OFF (SET RBCSGSF =0)*/ 05397840 SPACE 2 05406840 NI RBCSFLG1,MAX-RBCSGSF TURN OFF GOOD SEARCH FLAG 05415840 SPACE 2 05424840 */* L (FND,,NOTF,%NOTFOND) IEAVVMSR-- SEARCH LPDE'S FOR MAJOR */ 05433840 SPACE 2 05442840 L BASEREG,CVTLPDSR PICK UP SEARCH RTN ADDR 05451840 BALR RETURN,BASEREG SEARCH THE LPDES FOR MAJOR 05460840 DROP BASEREG BASE IS LOST OVER IEAVVMSR 05469840 USING *,RETURN ESTABLISH TEMPORARY ADDR 05478840 SPACE 2 05487840 */* P SET GOOD SEARCH INDICATOR ON (SET RBCSGSF =1)*/ 05496840 SPACE 2 05505840 OI RBCSFLG1,RBCSGSF TURN ON GOOD FLAG IF RETURN +0 05514840 SPACE 2 05523840 */*%NOTFOND: P RESET BASEREG (R6) DESTROYED BY IEAVVMSR */ 05532840 SPACE 2 05541840 L BASEREG,LINKBASE RESET ADDRESSABILITY 05550840 DROP RETURN DROP TEMPORARY BASE 05559840 USING IEAVLK01,BASEREG ESTABLISH REGULAR BASE 05568840 SPACE 2 05577840 */* D (YES,COMPLETE,NO,) MODULE FOUND (GOOD-SRCH IND. ON)? */ 05586840 */* COMMENT (2,15) 806 ABEND IF*/ 05595840 */* COMMENT (3,15) NOT FOUND*/ 05604840 SPACE 2 05613840 TM RBCSFLG1,RBCSGSF TEST FOR GOOD RETURN 05622840 BO COMPLETE IF GOOD CREATE MAJOR,MINOR CDE 05631840 * OTHERWISE 806 ABEND 05640840 SPACE 2 05649840 */* P SET ABEND REGISTER (R13) TO 8 FOR 806 ABEND*/ 05658840 */* P (,ERRRTN) SET R15 TO REASON CODE C*/ 05667840 SPACE 2 05676840 LA R13,8 SET ABEND CODE TO 8 @YA01851 05685840 LA R15,BADRETCD SET REASON CODE TO C 05694840 B ERRRTN GET ABEND CODE AND ABEND 05703840 SPACE 2 05712840 */*COMPLETE: P (,CREATMAJ) SET LPDIREG = MAJOR LPDE ADDR (SET R9=R0)*/ 05721840 SPACE 2 05730840 COMPLETE LR LPDIREG,R0 SAVE MAJOR ADDRESS 05739840 B CREATMAJ CREATE MAJOR CDE 05748840 EJECT 05757840 * CDTSLPA IS A ROUTINE WHICH CONTROLS THE FLOW BETWEEN THE 05766840 * VARIOUS SEARCHES. THE ROUTINE FLOW IS AS FOLLOWS: 05775840 * 05784840 * A. CHECK IF (SR.NON-DE5) OR (SR.DE3) WAS DONE. IF YES, GO TO 05793840 * CHKLPDES TO SEARCH LPA DIRECTORY. IF NO, DO B. 05802840 * B. CHECK IF STEP C. DONE. IF YES GO TO SATMAR TO DO 05811840 * (SR.NON-DE7) OR (SR.DE5,6). OTHERWISE DO STEP C. 05820840 * C. SET DCB REGISTER POSITIVE. IF DCB REGISTER IS ZERO, DO STEP 05829840 * D. OTHERWISE DO STEP H. 05838840 * D. (SR.NON-DE3),(SR.DE5,6) SET UP JOB LIBRARY DCB. THEN DO 05847840 * STEP E. 05856840 * E. IF NOT DE FORM, DO STEP F. OTHERWISE DO STEP G. 05865840 * F. (SR.NON-DE2,3) SEARCH THE JOB LIBRARIES VIA BLDL. 05874840 * G. IF Z-BYTE ZERO, USE JOB LIBRARY DCB. OTHERWISE USE Z-BYTE 05883840 * AS INDEX TO DO FETCH (SR.DE5,6) 05892840 * H. (SR.DE2) IF DCB FOR SVCLIB OR LINKLIB, SET UP TO SEARCH 05901840 * LPAQ.(SET LINKLIB DCB IN R10, R8= ADDRESS OF LPAQ, AND 05910840 * EXIT TO CDCONTRL (IEAVLK00)). OTHERWISE DO STEP E. 05919840 * 05928840 * REGISTER USAGE: 05937840 * 05946840 * R0,1 - CHANGED 05955840 * R3,4,5- CVT,TCB,SVRB (INPUT) 05964840 * R6 - BASE (IEAVLK01) (INPUT) 05973840 * R8 - ADDRESS OF QUEUE (INPUT) 05982840 * R9 - ADDRESS OF NAME (INPUT) 05991840 * R10 - DCB ADDRESS (INPUT) 06000840 * OTHER REGISTERS NOT REFERENCED 06009840 * SVRB EXSAVE FULLY INITIALIZED 06018840 SPACE 1 06027840 DROP WKREG2 DROP LPDE USAGE 06036840 DROP LPDIREG DROP LPDE USAGE 06045840 DROP CVTREG DROP CVT USAGE 06054840 SPACE 2 06063840 */*CDTSLPA: D (YES,SATMAR,NO,) DCB CHECKING DONE (SIGN DCBREG=+)*/ 06072840 SPACE 2 06081840 CDTSLPA EQU * 06090840 LTR DCBREG,DCBREG HAS DCB CHECKING BEEN DONE 06099840 BP SATMAR A= YES , TAKE BRANCH 06108840 SPACE 2 06117840 */* P SET DCB REG=+ TO INDICATE DCB CHECKING DONE AND NOT TASKLIB 06126840 */*SEARCH*/ 06135840 */* D (YES,GETJLB,NO,) IS DCBREG (R10) ZERO*/ 06144840 SPACE 2 06153840 LPR DCBREG,DCBREG SET REGISTER POSITIVE INDICATING 06162840 * DCB CHECKING HAS BEEN DONE 06171840 BE GETJLB IF REGISTER IS ZERO LOAD JOBLIB 06180840 SPACE 2 06189840 */* D (YES,CDFIL,NO,) DCB FOR SVCLIB? */ 06198840 SPACE 2 06207840 C DCBREG,SVCDCBA Q.IS THIS SVCLIB DCB 06216840 BE CDFIL A=YES TAKE BRANCH 06225840 SPACE 2 06234840 */* D (NO,CITADE,YES,) DCB FOR LINKLIB? */ 06243840 SPACE 2 06252840 C DCBREG,LINKDCBA Q.IS THIS LINKLIB DCB 06261840 BNE CITADE A=NO TAKE BRANCH 06270840 SPACE 2 06279840 */*CDFILIN: P SET DCBREG= LINKLIB DCB ADDRESS */ 06288840 SPACE 2 06297840 CDFILIN L DCBREG,LINKDCBA LOAD LINKLIB DCB ADDRESS. 06306840 SPACE 2 06315840 */*CDFIL: P PREPARE TO SEARCH THE LPAQ (SET R8= ALPAQ HDR)*/ 06324840 SPACE 2 06333840 CDFIL L TABREG,IEAQLCTA LOAD LPACQ ADDRESS 06342840 SPACE 2 06351840 */* L SETLOCK-- GET CMS LOCK FOR LPA SEARCH */ 06360840 SPACE 2 06369840 SETLOCK OBTAIN,TYPE=CMS,MODE=UNCOND, x06378840 RELATED=('FREED BY EXIT PROLOG OR BEFORE LINKLIB BLDL') 06387840 SPACE 2 06396840 */*CDCONTRC: P SET BASEREG (R6) FOR MODULE IEAVLK00*/ 06405840 */* R RETURN TO CDCONTRL IN IEAVLK00*/ 06414840 SPACE 2 06423840 CDCONTRC L GR15,TABLEADD GET TABLE ADDRESS 06432840 L BASEREG,CDLKBASE RESET VLK00 BASE 06441840 L GR15,CDCONTRL BEGIN AT SEARCH ROUTINE 06450840 BR GR15 GO TO MAIN ROUTINE 06459840 SPACE 2 06468840 */*GETJLB: P SET DCBREG = ADDR OF JOBLIB DCB VIA TCBJLB*/ 06477840 SPACE 2 06486840 GETJLB L DCBREG,TCBJLB LOAD JOBLIB DCB ADDRESS 06495840 SPACE 2 06504840 */* P COMPLEMENT DCBREG TO INDICATE TASKLIB SEARCH*/ 06513840 */* D (NO,CDFILIN,YES,) ANY JOBLIB DCB (DCBREG NOT 0)*/ 06522840 SPACE 2 06531840 LNR DCBREG,DCBREG Q. JOBLIB DCB EQUAL ZERO 06540840 BE CDFILIN A= YES , TAKE BRANCH 06549840 SPACE 2 06558840 */*CITADE: P GET DIRECTORY ENTRY ADDR FROM RBCSDE*/ 06567840 */* D (YES,,NO,SATMAR) DE FORM OF MACRO USED (RBCSDE NOT 0)*/ 06576840 SPACE 2 06585840 CITADE ICM R15,MASK,RBCSDEA Q. IS DE FORM OF MACRO GIVEN 06594840 BZ SATMAR A= NO TAKE BRANCH 06603840 SPACE 2 06612840 */* P SET R1= TCB ADDR (SET R1=R4)*/ 06621840 */* D (YES,SATMAR,NO,) NULL DCB? (Z-BYTE =0)*/ 06630840 SPACE 2 06639840 USING PDS2-DESAVEDE+DESAVE,R15 ADDRESS PDS SAVED 06648840 LR TASKREG,TCBREG GET ADDR OF REQUESTOR'S TASK 06657840 TM DEZBYTE,MAX Q. - NULL DCB 06666840 BZ SATMAR A. - YES, TAKE BRANCH 06675840 TM RBCDFLGS,RBCDATCH ATTACH REQUEST? @ZA30995 06676840 BZ MPATCH BRANCH IF NOT @ZA30995 06677840 L TASKREG,TCBMOTH(,TASKREG) GET ADDRESS OF MOTHER @ZA30995 06678840 MPATCH EQU * @ZA30995 06679840 SPACE 1 06684840 * THE NEXT FOUR INSTRUCTIONS PERTAIN TO THE SPECIAL FLAG 06693840 * SET BY BLDL TO DISTINGUISH THE JOBLIB FROM LINKLIB WHERE 06702840 * A NULL DCB HAS BEEN PROVIDED IN THE BLDL MACRO. SEE CPS 06711840 * FOR DETAILS OF BYTE'Z' OF LIST ENTRY. 06720840 SPACE 2 06729840 */* P SET R0= Z-BYTE COUNT */ 06738840 */* P DECREMENT COUNT BY ONE IN R0 */ 06747840 */* D (YES,CDFILIN,NO,LIBLOOP) COUNT ZERO? */ 06756840 */* COMMENT (1,1) NOTE: A Z-BYTE*/ 06765840 */* COMMENT (2,1) OF 1 INDICATES*/ 06774840 */* COMMENT (3,1) LINKLIB*/ 06783840 SPACE 2 06792840 SR ZREG,ZREG INITIALIZE COUNT TO ZERO 06801840 IC ZREG,DEZBYTE GET LIB COUNT SUPPLIED BY BLDL 06810840 BCT ZREG,LIBLOOP Q.COUNT = 0, IMPLIES DE FOUND 06819840 * ON SYS1.LINKLIB 06828840 B CDFILIN YES.SEARCH LPAQ AND LINKLIB 06837840 SPACE 2 06846840 */*LIBLOOP: P SET R10= TASKLIB ADDR (R10= TCBJLB OF TCB VIA R1)*/ 06855840 */* P SET R1= MOTHER TCB ADDR (SET R1= TCBMOTH OF TCB VIA R1)*/ 06864840 */* P DECREMENT COUNT BY ONE IN R0 */ 06873840 */* D (YES,,NO,LIBLOOP) COUNT ZERO? */ 06882840 SPACE 2 06891840 LIBLOOP L DCBREG,TASKLIB(TASKREG) GET TASKLIB DCB ADDR 06900840 L TASKREG,TCBMOTH(TASKREG) GET ADDR OF MOTHER TASK 06909840 BCT ZREG,LIBLOOP LOOP 06918840 DROP R15 DROP PDS USAGE 06927840 EJECT 06936840 * INITIALIZATION FOR BLDL AND FETCH. 06945840 * 06954840 * A. A TEST IS MADE TO SEE IF A BLDL FETCH WORK AREA EXISTS. IF 06963840 * YES, ADD CDE TO JPAQ AND DO C. OTHERWISE DO B. 06972840 * B. GET A CDE AND QUEUE TO JPAQ. THEN GET A BLDL FETCH WORK 06981840 * AREA, AND INITIALIZE THE CDE, WORK AREA, AND SVRB FIELDS, 06990840 * THEN GO TO C. 06999840 * C. IF ALIAS REQUEST, GO TO ALIASRCH. OTHERWISE DO STEP D. 07008840 * D. PICK UP DEB ADDRESS AND, IF NIP IS NOT PROCESSING OR THE 07017840 * DCB IS NOT SVCLIB OR LINKLIB, DO DEBCHECK TO VERIFY THE 07019840 * DEB. @ZA28494 07021840 * E. CHECK FOR DE PASSED BY THE USER. IF NOT, DO BLDL. IF 07023840 * DE WAS PASSED, CHECK IF USER IS AUTHORIZED OR, IF NOT, 07025840 * CHECK IF LIBRARY IS UNAUTHORIZED. IF EITHER CHECK IS 07027840 * SUCCESSFUL, SKIP BLDL. @ZA26582 07029840 * 07035840 * REGISTER USAGE: 07044840 * R0,R1 - CHANGED 07053840 * R3,4,5 - CVT,TCB,SVRB (INPUT) 07062840 * R6 - BASE (IEAVLK01) 07071840 * R7 - ADDRESS OF BLDL FETCH WORK AREA (OUTPUT) 07077840 * R8 - DEB ADDRESS (OUTPUT) @ZA28494 07081840 * R10 - DCB ADDRESS (INPUT) 07089840 * R11 - CDE FOR REQUEST (OUTPUT) 07098840 * R13,14,15-CHANGED 07107840 * OTHER REGISTERS NOT REFERENCED 07116840 * SVRB EXSAVE FULLY INITIALIZED 07125840 SPACE 2 07134840 */*SATMAR: D (YES,PRESET,NO,) CDE & WORK AREA ACQUIRED YET (RBCSWORK 07143840 */*NT 0)*/ 07152840 SPACE 2 07161840 SATMAR L AREAREG,RBCSWORK Q.HAVE THE CDE AND WORK AREA 07170840 LTR AREAREG,AREAREG BEEN ACQUIRED 07179840 BNZ PRESET YES.BRANCH 07188840 SPACE 2 07197840 */* L GETMAIN-- GET A CDE FROM LSQA (SP255) */ 07206840 */* P SET CDEREG = ADDR OF NEW CDE (SET R11=R1)*/ 07215840 */* P CLEAR THE NEW CDE*/ 07224840 */* P SET CDNAME = REQUESTED NAME VIA R9*/ 07233840 */* P INITIALIZE CDE WITH ATTR. NIC, JPA, REN, SER, NLR*/ 07242840 SPACE 2 07251840 L ASCBREG,PSAAOLD GET ADDRESS OF ASCB OF GM 07260840 GETMAIN RU,LV=CDESIZE,SP=255,BRANCH=YES 07269840 LR CDEREG,R1 SET UP CDEREG FOR USING VALUE 07278840 XC CDCHAIN(CDESIZE),CDCHAIN ZERO THE CDE 07287840 MVC CDNAME(NAME),ZERO(NAMEREG) INITIALIZE CDNAME 07296840 MVI CDATTR,CDNIC+CDJPA+CDREN+CDSER+CDNLR INITIALIZE CDATTR 07305840 SPACE 2 07314840 */* S CDEADD: PUT CDE ONTOP OF JPAQ, SET CDRRBP & RBCDE1*/ 07323840 SPACE 2 07332840 BAL SUBREG1,CDEADD ADD CDENTRY TO LIST 07341840 SPACE 2 07350840 */* L GETMAIN-- GET WORK AREA FROM SP 253 (LSQA) */ 07359840 */* P SET AREAREG = ADDR OF FETWK (SET R7=R1)*/ 07368840 SPACE 2 07377840 GETMAIN RU,LV=WKSIZE,SP=253,BRANCH=YES 07386840 LR AREAREG,R1 SET WORK AREA REGISTER AS USING 07395840 SPACE 2 07404840 */* P CLEAR PM WORK AREA AND BLDL AREA IN FETWK*/ 07413840 */* P SET WKPREFX= 0001003C (NO OF ENTRIES AND SIZE OF ENTRY)*/ 07422840 */* P SET WKNAME= RQSTD NAME FROM CDNAME*/ 07431840 */* P SET BLDL AREA = DE SAVE AREA IF DE SPECIFIED.*/ 07440840 */* P SET WKCDADDR= CDE ADDR (SET WKCDADDR= CDEREG)*/ 07449840 SPACE 2 07458840 XC WKPGMMGR(WKEND-WKPGMMGR),WKPGMMGR CLEAR WORKAREA 07467840 MVC WKPREFX(WORD),BLDLMASK MOVE IN 4 BYTE PREFIX 07476840 SPACE 1 07485840 * THE FIRST 8 BYTES OF THE DIRECTORY ENTRY ARE THE NAME 07494840 SPACE 1 07503840 MVC WKNAME(NAME),CDNAME MOVE NAME 07512840 L R15,RBCSDE TEST FOR DE FORM 07521840 LTR R15,R15 OF MACRO 07530840 BZ NOTDEFRM IF NOT DE DONT MOVE DE IN 07539840 USING DESAVE,R15 POINT TO DE SAVE AREA 07548840 MVC WKNAME(DEMAX),DESAVEDE MOVE DE TO WORK AREA 07557840 NOTDEFRM EQU * CONTINUE INITIALIZATION OF WA 07566840 ST CDEREG,WKCDADDR SAVE THE CDE ADDR 07575840 SPACE 2 07584840 */* P SET RBCSWORK = ADDR OF FETWK (SET RBCSWORK = R7)*/ 07593840 SPACE 2 07602840 ST AREAREG,RBCSWORK SAVE WORK AREA ADDRESS IN RB. 07611840 * EXTENDED SAVE AREA. 07620840 SPACE 2 07629840 */* D (NO,SETOUT,YES,) TASKLIB SEARCH IN PROCESS (SIGN DCBREG =-) */ 07638840 SPACE 2 07647840 LTR DCBREG,DCBREG Q. TASKLIB SEARCH IN PROCESS 07656840 BP SETOUT NO.BRANCH 07665840 SPACE 2 07674840 */* P SET DCBREG POSITIVE*/ 07683840 */* P NOW INDICATE TASKLIB SEARCH BY SETTING WKFLAG= X'87'*/ 07692840 */* P SAVE TCB ADDR (SET WKTCBSE=R4)*/ 07701840 */* P (,SETOUT) SAVE DCB ADDR (SET WKDCBSE=R10)*/ 07710840 SPACE 2 07719840 MVI FLAG,TLIBIND YES.SET TASKLIB INDICATOR 07728840 LPR DCBREG,DCBREG INSURE DCB ADDR IS POSITIVE 07737840 ST TCBREG,WKTCBSE INIT TCB ADDR. IN WORKAREA 07746840 ST DCBREG,WKDCBSE INIT DCB ADDR. IN WORKAREA 07755840 B SETOUT CONTINUE 07764840 SPACE 2 07773840 */*PRESET: P SET CDEREG = CDE ADDR (SET R11= WKCDADDR)*/ 07782840 */* S CDEADD: PUT CDE ONTOP OF JPAQ, SET CDRRBP & RBCDE1*/ 07791840 SPACE 2 07800840 PRESET L CDEREG,WKCDADDR LOAD ADDR OF CDENTRY 07809840 BAL SUBREG1,CDEADD ADD CDENTRY TO JPAQ 07818840 SPACE 2 07827840 */*SETOUT: D (YES,ALIASRCH,NO,) CDMIN = 1?*/ 08550040 SPACE 2 08560040 SETOUT EQU * CHECK FOR ALIAS 08568040 TM CDATTR,CDMIN Q. IS ALIAS HANDLING CURRENT 08576040 BO ALIASRCH A=YES, TAKE BRANCH 08584040 SPACE 2 08600040 USING IHADCB,DCBREG @ZA28494 08602040 ICM GR1,MASK,DCBDEBA GET THE DEB ADDRESS @ZA28494 08602440 L CVTREG,CVTPTR GET CVT ADDRESS @ZA28494 08602840 USING CVT,CVTREG @ZA28494 08603240 TM CVTOPTA,CVTNIP IS NIP PROCESSING? @ZA28494 08603640 BO CHECKDE BRANCH IF YES @ZA28494 08604040 C DCBREG,SVCDCBA SVCLIB DCB? @ZA28494 08604440 BE CHECKDE BRANCH IF YES @ZA28494 08604840 C DCBREG,LINKDCBA LINKLIB DCB? @ZA28494 08605240 BE CHECKDE BRANCH IF YES @ZA28494 08605640 TM DCBOFLGS,DCBOFOPN IS DCB OPEN? @ZA28494 08606040 BZ BADDCB BRANCH IF NOT @ZA28494 08606440 STM R10,R11,WKREGIS SAVE REGISTERS @ZA28494 08606840 USING DEBBASIC,GR1 @ZA28494 08607240 ICM GR10,MASK,DEBTCBB GET DEB TCB @ZA28494 08607640 DROP GR1 @ZA28494 08608040 CR GR10,TCBREG SAME AS CURRENT TCB? @ZA28494 08608440 BE CHKDEB BRANCH IF YES @ZA28494 08608840 SPACE 2 @ZA28494 08609240 * LOCATE THE PROPER TCB IF CURRENT IS NOT THE ONE @ZA28494 08609640 SPACE 1 @ZA28494 08610040 * FIRST SEARCH BACKWARD CHAIN OF TCBS @ZA28494 08610440 L R8,TCBBACK POINT TO PREVIOUS TCB @ZA28494 08610840 DROP TCBREG @ZA28494 08611240 USING TCB,R8 @ZA28494 08611640 TCBLPBK EQU * @ZA28494 08612040 LTR R8,R8 IS THERE A PREVIOUS? @ZA28494 08612440 BZ CKTCBTCB BRANCH IF NOT @ZA28494 08612840 CR R10,R8 IS THIS THE TCB WANTED? @ZA28494 08613240 BE CHKDEB BRANCH IF YES @ZA28494 08613640 L R8,TCBBACK GET NEXT TCB @ZA28494 08614040 B TCBLPBK AND CHECK IT @ZA28494 08614440 DROP R8 @ZA28494 08614840 USING TCB,TCBREG @ZA28494 08615240 * NOW SEARCH FORWARD CHAIN OF TCBS @ZA28494 08615640 CKTCBTCB EQU * @ZA28494 08616040 L R8,TCBTCB POINT TO NEXT TCB @ZA28494 08616440 DROP TCBREG @ZA28494 08616840 USING TCB,R8 @ZA28494 08617240 TCBLPTCB EQU * @ZA28494 08617640 LTR R8,R8 IS THERE A TCB? @ZA28494 08618040 BZ BADDCB BRANCH IF NOT @ZA28494 08618440 CR R8,R10 IS THIS THE TCB WANTED? @ZA28494 08618840 BE CHKDEB BRANCH IF YES @ZA28494 08619240 L R8,TCBTCB GET NEXT TCB @ZA28494 08619640 B TCBLPTCB AND CHECK IT @ZA28494 08620040 DROP R8 @ZA28494 08620440 USING TCB,TCBREG @ZA28494 08620840 CHKDEB EQU * @ZA28494 08621240 L R15,CVTEXT2 GET ADDRESS OF CVT EXT @ZA28494 08621640 USING CVTXTNT2,R15 @ZA28494 08622040 L R15,CVTDEBVR GET ADDRESS OF DEBCHK @ZA28494 08622440 DROP R15 @ZA28494 08622840 BALR R14,R15 BRANCH TO DEBCHK RTN @ZA28494 08623240 B RELOAD GOOD RETURN FROM DEBCHK @ZA28494 08623640 RELOAD EQU * @ZA28494 08624040 LM R10,R11,WKREGIS RESTORE REGISTERS @ZA28494 08624440 LTR R15,R15 ERROR IN DEBCHECK? @ZA28494 08624840 BNZ BADDCB BRANCH IF YES @ZA28494 08625240 CHECKDE EQU * @ZA28494 08625640 LR DEBREG,R1 SAVE ADDRESS OF DEB @ZA28494 08626040 USING DEBBASIC,DEBREG @ZA28494 08626440 SPACE 2 08632040 L R15,RBCSDE Q. IS DE FORM OF MACRO GIVEN 08633040 LTR R15,R15 ON REQUEST 08634040 BZ DOBLDL BRANCH IF NOT @ZA26582 08635040 TM CVTOPTA,CVTNIP IS NIP PROCESSING? @ZA26582 08636040 BO DEFOUND BRANCH IF YES @ZA26582 08637040 TM RBCSFLG1,RBCSSYSR IS USER KEY/STATE AUTH? @ZA26582 08638040 BO DEFOUND BRANCH IF YES @ZA26582 08639040 TESTAUTH FCTN=1,BRANCH=YES CHECK AUTHORIZATION @ZA26582 08640040 LTR R15,R15 IS THE USER AUTHORIZED? @ZA26582 08641040 BZ DEFOUND BRANCH IF YES @ZA26582 08642040 C DCBREG,SVCDCBA SVCLIB DCB? @ZA26582 08643040 BE DOBLDL BRANCH IF YES @ZA26582 08644040 C DCBREG,LINKDCBA LINKLIB DCB? @ZA26582 08645040 BE DOBLDL BRANCH IF YES @ZA26582 08646040 TM DEBFLGS1,DEBAPFIN IS THE LIB AUTH? @ZA26582 08647040 BZ DEFOUND BRANCH IF NOT @ZA26582 08650040 DROP DCBREG @ZA26582 08653040 EJECT 1 08656040 *FOLLOWING IS THE ROUTINE THAT SETS UP THE INTERFACE WITH BLDL 08666040 *SERVICE ROUTINE. THIS ROUTINE ESTABLISHES THE PROPER INTERFACE 08674040 *REGISTERS, RESTORES ITS OWN REGISTERS, AND TESTS THE BLDL RETURN CODE. 08682040 * 08700040 * REGISTER USAGE: 08709040 * R0- BLDL LIST (INPUT TO BLDL) 08718040 * R1- DCB ADDRESS (INPUT TO BLDL) 08727040 * R14- RETURN ADDRESS (INPUT TO BLDL) 08736040 * R15- RETURN CODE OF 0,4,0R 8 (OUTPUT FROM BLDL) 08745040 SPACE 2 08754040 */* P SET REGISTERS FOR BLDL (R0=BLDL LIST,R1=DCB ADDR.) */ 08763040 */* P SAVE R11 AND R12 IN WKREGIS*/ 08772040 SPACE 2 08781040 DOBLDL EQU * @ZA26582 08785040 LA GR0,WKBLDE SUPPLY THE LIST ADDRESS ,LIST 08790040 * BEGINS WITH A 1 WORD PREFIX 08799040 LR GR1,DCBREG SUPPLY THE DCB ADDRESS,DCB 08808040 * ADDRESS IS NEVER ZERO. 08817040 STM R11,R12,WKREGIS SAVE VITAL REGISTERS 08826040 SPACE 2 08850040 */* L SETFRR-- REMOVE RECOVERY ROUTINE FROM STACK */ 08858040 SPACE 2 08866040 SETFRR D,WRKREGS=(11,12) PTM0180 08874040 SPACE 2 08882040 */* P ZERO POINTER TO RECOVERY PARM. AREA (SET RBCSFRRA =0) */ 08900040 SPACE 2 08908040 SR R11,R11 CLEAR REG. FOR ZEROING 08916040 ST R11,RBCSFRRA PARM. LIST AREA 08924040 SPACE 2 08932040 */* L SETLOCK-- RELEASE CMS LOCK IF HELD */ 08950040 SPACE 2 08958040 SETLOCK RELEASE,TYPE=CMS,RELATED=('MUST BE FREED OVER SVC') 08966040 SPACE 2 08974040 */* L SETLOCK-- RELEASE LOCAL LOCK */ 08982040 SPACE 2 09000040 SETLOCK RELEASE,TYPE=LOCAL,RELATED=('MUST BE FREED OVER SVC') 09008040 SPACE 2 09016040 */* P RESTORE R11 AND R12 FROM WKREGIS*/ 09024040 SPACE 2 09032040 LM R11,R12,WKREGIS RESTORE REGS SAVED OVER SETLOCK 09050040 SPACE 2 09058040 */* L BLDL (SVC 18)-- GET PDS ENTRY FOR MODULE */ 09066040 */* COMMENT (2,1) BLDL INPUT--*/ 09074040 */* COMMENT (3,1) R0=WKPREFX PTR*/ 09082040 */* COMMENT (4,1) R1=DCB PTR*/ 09100040 ISSUBLDL BLDL (1),(0) GET PDS ENTRY 09122040 SPACE 1 09127040 * BLDL RETURNS WITH A CODE SET IN GR15 09136040 * 1.GR15 = 0 SUCCESSFUL COMPLETION,THE 09145040 * DIRECTORY ENTRY ACQUIRED IS SIGNIFICANT. 09154040 * 2.GR15 = 4 THE NAME COULD NOT BE FOUND ON 09163040 * THE LIBRARY ADDRESSED BY DCB. 09172040 * 3.GR15 = 8 A PERMANENT I/O ERROR DETECTED 09181040 * IN ATTEMPTING OPERATION. 09190040 SPACE 2 09199040 */* P SAVE R11 AND R12 IN WKREGIS*/ 09208040 */* L SETLOCK-- GET LOCAL LOCK */ 09217040 SPACE 2 09226040 NOBLDL STM R11,R12,WKREGIS SAVE VOLITAL REGSITERS 09250040 SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND, x09258040 RELATED=('FREED OVER BLDL, NOW REOBTAINED') 09266040 SPACE 2 09274040 */* L SETFRR-- ESTABLISH RECOVERY ROUTINE */ 09282040 */* P SET RBCSFRRA= ADDR FRR PARM LIST*/ 09300040 */* P SET 1ST WORD OF PARM LIST = ADDR OF PM SVRB*/ 09308040 SPACE 2 09316040 SETFRR A,FRRAD=FRRPGM,WRKREGS=(11,12),PARMAD=(13) 09324040 ST RBREG,N0(R13) SAVE RB ADDRESS 09332040 ST R13,RBCSFRRA SAVE FRR PARM. ADDRESS 09350040 SPACE 2 09359040 */* P RESTORE R11 AND R12 FROM WKREGIS*/ 09368040 */* D (FND,DEFOUND,NOTF,DEMISSED,IOER,ERRBLDL) TEST RETURN CODE IN 09377040 */*R15*/ 09386040 */* COMMENT (1,1) RET CODES ARE-*/ 09395040 */* COMMENT (2,1) 0 IF DE FOUND*/ 09404040 */* COMMENT (3,1) 4 IF DE NOT FND*/ 09413040 */* COMMENT (4,1) 8 IF I/O ERROR*/ 09422040 SPACE 2 09431040 LM R11,R12,WKREGIS RESTORE VOLITAL REGSITERS 09450040 SR R13,R13 CLEAR R13 FOR ABEND 09458040 B *+N4(GR15) TEST RETURN CODE 0,4,8 09466040 B DEFOUND BLDL CODE = 0 09474040 B DEMISSED BLDL CODE = 4 09482040 B ERRBLDL BLDL ERROR = 806 09500040 EJECT 09508040 * THIS SUBROUTINE WILL PROVIDE TASKLIB DCB ADDRESS TO BLDL, 09516040 * STARTING WITH THE REQUESTOR'S TCB JOBLIB DCB FIELD. 09524040 * IT WILL STEP UP THE MOTHER-QUEUE UNTIL THE MODULE HAS 09532040 * BEEN FOUND OR ALL TASKLIBS HAVE BEEN SEARCHED. 09550040 * 09558040 * REGISTER USAGE 09566040 * R1 - MOTHER TCB WORK REG (OUTPUT) 09574040 * R6 - BASE REGISTER (IEAVLK01) 09582040 * R7 - BLDL FETCH WORK AREA (INPUT) 09600040 * R10- DCB ADDRESS (INPUT) 09608040 * OTHER REGISTERS NOT REFERENCED 09616040 SPACE 2 09624040 */*DEMISSED: D (YES,ERRBLDL,NO,) LINKLIB SRCH'D YET (DCBREG = PTR TO 09632040 */*LNKLIB DCB)*/ 09650040 SPACE 2 09658040 DEMISSED EQU * @ZA26582 09666040 ICM R3,MASK,RBCSDE DE FORM OF MACRO? @ZA26582 09667040 BNZ ERRBLDL BRANCH IF YES, ERROR @ZA26582 09668040 C DCBREG,LINKDCBA LINKLIB SEARCHED YET? @ZA26582 09669040 BNE SEARCH NO THEN CONTINUE SEARCH @ZA24461 09674040 TM RBCSFLG1,RBCSA306 306 ABEND INDICATOR SET @ZA24461 09675040 BZ ERRBLDL NO NORMAL 806 ABEND @ZA24461 09676040 SR R13,R13 CLEAR ABEND REGISTER @ZA24461 09677040 LA R15,BADRETCD SET REASON CODE = 12 @ZA24461 09677240 B ERRSYSR ISSUE 306 ABEND @ZA24461 09677440 SEARCH DS 0H CONTINUE SEARCH LABEL @ZA24461 09678040 SPACE 2 09682040 */* S RETHRED:DEQUEUE CDE FROM JPAQ */ 09700040 SPACE 2 09708040 BAL R13,RETHRED DEQUEUE CDE FROM JPAQ 09716040 SPACE 2 09724040 */* D (NO,NOTSLIB1,YES,) TASKLIB SEARCH IN PROCESS (WKFLAG= 87)*/ 09732040 SPACE 2 09750040 CLI FLAG,TLIBIND TASKLIB SEARCH IN PROCESS 09758040 BNE NOTSLIB1 NO.BRANCH 09766040 SPACE 2 09774040 */* P SET R1= TCB ADDR FOR TASKLIB JUST SEARCHED (R1= WKTCBSE)*/ 09782040 SPACE 2 09800040 L R1,WKTCBSE GET TCB FOR LIB JUST SEARC 09808040 SPACE 2 09816040 */*STEPUP: D (YES,CDFILIN,NO,) JS TCB HANDLED YET (R1=JS TCB ADDR)*/ 09824040 */* P SET R1= ADDRESS OF MOTHER TCB VIA TCBMOTH*/ 09832040 SPACE 2 09850040 STEPUP C R1,TCBJSTCB Q.JOB STEP TCB HANDLED 09858040 BE CDFILIN YES SEARCH LPAQ 09866040 L R1,TCBMOTH(R1) STEP UP TCB CHAIN 09874040 SPACE 1 09882040 * SINCE THE DCB ADDRESS IS PROPOGATED DOWNWARD, A ZERO ADDRESS 09900040 * MEANS THAT THERE ARE NO MORE LIBS TO SEARCH. 09908040 SPACE 2 09916040 */* P SET DCBREG = TASKLIB DCB OF NEW TCB (R10= TCBJLB)*/ 09924040 */* D (YES,CDFILIN,NO,) DCB FIELD = 0? (R10=0) */ 09932040 SPACE 2 09950040 ICM DCBREG,MASK4,TCBJLBDI(R1) TEST FOR ZERO ADDR AND PICK 09958040 * UP NEXT DCB POINTER 09966040 BZ CDFILIN NONE LEFT TO CHECK 09974040 SPACE 2 09982040 */* D (YES,STEPUP,NO,) DCB ALREADY CHECKED (R10= WKDCBSE) */ 10000040 SPACE 2 10008040 C DCBREG,WKDCBSE SAME AS LAST ONE DONE 10016040 BE STEPUP IF SO GET NEXT 10024040 SPACE 2 10032040 */* P SAVE TCB ADDR IN WKTCBSE (SET WKTCBSE = R10)*/ 10050040 */* P (,SATMAR) SAVE DCB ADDR IN WKDCBSE (SET WKDCBSE = R10)*/ 10058040 SPACE 2 10066040 ST R1,WKTCBSE SAVE FOR NEXT PASS 10074040 ST DCBREG,WKDCBSE SAVE FOR NEXT PASS 10082040 B SATMAR NO-SEARCH NEW LIB 10100040 SPACE 2 10110040 */*NOTSLIB1: D (NO,CDFILIN,YES,) DCB FOR SVCLIB? */ 10118040 SPACE 2 10126040 NOTSLIB1 C DCBREG,SVCDCBA Q. SVCLIB DCB ADDR IN USE 10134040 * IF SO, THE LPAQ HAS 10150040 * ALREADY BEEN SEARCHED 10158040 BNE CDFILIN NO.GO TO SEARCH LPA 10166040 SPACE 2 10174040 */* P (,SATMAR) GET ADDRESS OF LINKLIB DCB FOR NEXT SEARCH */ 10182040 SPACE 2 10200040 L DCBREG,LINKDCBA PREPARE TO SEARCH LINKLIB 10208040 B SATMAR GO TO BLDL 10216040 EJECT 10224040 *THIS ROUTINE EXAMINES THE DE EXTRACTED BY BLDL FOR ABNORMAL CONDITIONS 10232040 *AND IF NONE EXIST WILL SET ATTRIBUTES IN THE CDENTRY AS INDICATED IN 10250040 *THE DE. THE FOLLOWINGS FLAGS ARE TESTED IN THIS SECTION 10258040 * BYTE (CBYTE) - BIT INDICATING ALIAS DIRECTORY ENTRY. 10266040 * BYTE (DEATTR)- BIT INDICATING REENTRABLE LOAD MODULE 10274040 * BIT INDICATING SERIALLY REUSABLE MOD. 10282040 * BIT INDICATING 'LOAD'ABLE ONLY MODULE 10300040 * BIT INDICATING EXECUTABLE LOAD MODULE 10308040 * REGISTER USAGE 10316040 * R5 - SVRB ADDRESS (INPUT) 10324040 * R6 - BASE (IEAVLK01) 10332040 * R7 - BLDL FETCH WORK AREA (INPUT) 10340040 * R8 - DEB ADDRESS (INPUT) @ZA28494 10346040 * R11- CDE FOR REQUEST (INPUT) 10358040 * R13- ZEROED (OUTPUT) 10366040 * OTHER REGISTERS NOT USED 10374040 */*DEFOUND: P CLEAR ABEND REGISTER (REG 13) */ 10382040 */* D (YES,,NO,ERRXCUTE) MODULE EXECUTABLE? */ 10400040 */* COMMENT (2,15) 706 ABEND IF*/ 10408040 */* COMMENT (3,15) NOT EXEC.*/ 10416040 SPACE 2 10424040 DEFOUND EQU * TEST DE ATTRIBUTES ROUTINE 10432040 SR R13,R13 CLEAR ABEND REGISTER 10450040 TM WKATTR,DEXCUT Q. IS MODULE EXECUTABLE 10458040 BZ ERRXCUTE A=NO GET READY TO ABEND 10466040 TM CVTOPTA,CVTNIP IS NIP PROCESSING @ZA24461 10466340 BO USEDEFND YES USE THIS COPY @ZA24461 10466640 TM RBCDFLGS,RBCDATCH ATTACH REQUEST? @ZA24461 10466940 BZ CHEKAUTH NO CHECK AUTHORIZATION @ZA24461 10467040 CLM TCBREG,MASK,TCBJSTCB+N1 JOBSTEP ATTACH REQUEST @ZA24461 10467140 BNE CHEKSAPF NO CHECK RESET APF? @ZA24951 10467240 TM TCBPKF,X'80' TCB IN KEY 0-7? @ZA24461 10467340 BZ CHECKLIB YES CHECK LIB AUTH @ZA24461 10467440 TM TCBFLGS3,X'80' TCB TO RUN SUPVR STATE? @ZA24461 10467540 BO CHECKLIB YES CHECK LIB AUTH @ZA24461 10467640 B USEDEFND NO USE THIS COPY @ZA24461 10467740 CHEKSAPF TM RBCSFLG1,RBCRSAPF RESET APF REQUEST? @ZA24951 10467840 BO USEDEFND YES USE THIS COPY @ZA24461 10468140 CHEKAUTH DS 0H CHECK USERS AUTHORITY @ZA24461 10468240 TM RBCSFLG1,RBCSSYSR IS USER KEY/STATE AUTH @ZA24461 10468340 BO CHECKLIB YES THEN CHECK THE LIB @ZA24461 10468440 TESTAUTH FCTN=1,BRANCH=YES NO CHECK JSCB AUTH @ZA24461 10468540 LTR R15,R15 IS USER JSCB AUTHORIZED @ZA24461 10468640 BNZ USEDEFND NO USE THIS COPY @ZA24461 10468740 CHECKLIB DS 0H CHECK LIBRARY AUTH @ZA24461 10468840 C DCBREG,SVCDCBA SVCLIB DCB? @ZA28494 10468940 BE USEDEFND BRANCH IF YES @ZA28494 10469040 C DCBREG,LINKDCBA LINKLIB DCB? @ZA28494 10469140 BE USEDEFND BRANCH IF YES @ZA28494 10469240 USING IHADCB,DCBREG SET DCB ADDRESSABILITY @ZA24461 10469340 CLM DEBREG,MASK,DCBDEBA DEB ADDRESSES THE SAME? @ZA28494 10469440 BE GOODDCB YES THEN DCB IS GOOD @ZA24461 10469940 BADDCB EQU * @ZA26582 10470040 SR R13,R13 NO GET READY TO ABEND @ZA24461 10470140 LA R15,DONTBLDL SET REASON CODE TO 10 @ZA24461 10470240 B ERRBLDL ISSUE THE 806 ABEND @ZA24461 10470540 GOODDCB TM DEBFLGS1,DEBAPFIN IS THE LIB AUTHORIZED @ZA24461 10470640 BO USEDEFND YES USE THIS COPY @ZA24461 10470740 DROP DCBREG DROP DCB ADDRESSABILITY @ZA24461 10470840 DROP DEBREG DROP DEB ADDRESSABILITY @ZA24461 10471140 L WKREG2,RBCSDE GET DE SAVE ADDRESS @ZA28734 10471440 LTR WKREG2,WKREG2 IS DE FORM SPECIFIED @ZA28734 10471640 BZ CONSERCH NO CONTINUE THE SEARCH @ZA28734 10471840 SR R13,R13 CLEAR ABEND REGISTER @ZA28734 10472040 LA R15,BADRETCD SET UP FOR 306-C ABEND @ZA28734 10472240 B ERRSYSR ABEND AUTHORIZED USER THAT SPEC 10472440 * IFIED DE OPTION FOR AN UNAUTHOR 10472640 * IZED LIBRARY @ZA28734 10472840 CONSERCH DS 0H CONTINUE SEARCHING LIBS @ZA28734 10473040 OI RBCSFLG1,RBCSA306 SET 306 ABEND INDICATOR @ZA24461 10473240 B DEMISSED GO CONTINUE SEARCH @ZA24461 10473440 USEDEFND NI RBCSFLG1,MAX-RBCSA306 RESET 306 INDICATOR @ZA24461 10473640 SPACE 2 10474040 */* D (YES,,NO,NOVLY) MODULE IN OVERLAY FORM? */ 10482040 */* P SET OVERLAY BIT IN CDE (SET CDOLY=1) */ 10500040 SPACE 2 10508040 TM WKATTR,DEOVLY Q.MODULE IN OVERLAY FORM 10516040 BZ NOVLY NO.DON'T SET CDE FLAG 10524040 OI CDATTR2,CDOLY SET BIT INDICATING OVERLAY 10532040 SPACE 2 10550040 */*NOVLY: D (NO,NOLOLY,YES,) MODULE LOAD-ONLY? */ 10558040 */* P SET LOADABLE ONLY FLAG IN CDE (SET CDNLR =1) */ 10566040 SPACE 2 10574040 NOVLY TM WKATTR,DELODY Q. IS MODULE LOADABLE ONLY 10582040 BZ NOLOLY A= NO TAKE BRANCH 10600040 NI CDATTR,MAX-CDNLR SET LOADABLE ONLY FLAG IN CDE 10608040 SPACE 2 10616040 */* D (NO,ERRLONLY,YES,) IS THIS A LOAD REQUEST? */ 10624040 */* COMMENT (2,15) 406 ADEND*/ 10632040 */* COMMENT (3,15) IF NOT LOAD*/ 10650040 SPACE 2 10658040 TM RBCDFLGS,LOAD Q. IS THIS A LOAD MACRO REQUEST 10666040 BZ ERRLONLY A=NO GET READY TO ABEND 10674040 SPACE 2 10682040 */*NOLOLY: D (RENT,REENDE,REUS,SERIAL,NRUS,) TEST MODULE REUSABILITY */ 10700040 */* P SET REUSABLE BIT OFF IN CDE (SET CDSER =0)*/ 10708040 */*SERIAL: P SET RENTRANT BIT OFF IN CDE (SET CDREN =0)*/ 10716040 SPACE 2 10724040 NOLOLY TM WKATTR,PDS2RENT+PDS2REUS Q. IS MOD REENTERABLE OR 10732040 * OR SERIALLY REUSABLE 10750040 BO REENDE A= REENTRABLE LEAVE SER+REN SET 10758040 BM SERIAL A= SERIALLY REUSE LEAVE SER SET 10766040 NI CDATTR,MAX-CDSER A= NOT REUSABLE RESET REN+SER 10774040 SERIAL NI CDATTR,MAX-CDREN A= SER. REUSABLE RESET REN 10782040 SPACE 2 10800040 */*REENDE: D (NO,PGMFETCH,YES,) IS THIS AN ALIAS DE ENTRY? */ 10808040 SPACE 2 10816040 REENDE TM WKCBYTE,DEALIAS Q. IS AN ALIAS DE ENTRY GIVEN 10824040 BZ PGMFETCH A= NO, TAKE BRANCH 10832040 SPACE 2 10850040 */* D (NO,PGMFETCH,YES,) IS MOD. RENT OR REUS? */ 10858040 SPACE 2 10866040 TM WKATTR,PDS2RENT+PDS2REUS Q. IS MOD EITHER REEN- 10874040 * TRABLE OR SERIALLY REUSABLE 10882040 * INDICATING PRESCENCE OF ALIAS. 10900040 BZ PGMFETCH A = NO, GET NEW COPY 10908040 * A = YES, PROCESS AS ALIAS 10916040 EJECT 10924040 *THIS SECTION OF CODE PROCESSES A BLDL ENTRY THAT IS FLAGGED AS AN 10932040 *ALIAS. THE MEMBER NAME IS SEARCHED UPON IN THE CDENTRY QUEUES - 10950040 *IF IT IS FOUND THE ALIAS ENTRY IS RELOCATED AND A CDENTRY IS BUILT 10958040 *THAT IS ASSOCIATED WITH THE FOUND ENTRY ON A MAJOR / MINOR BASIS. 10966040 *IF THE MEMBER NAME IS NOT FOUND A CDENTRY IS BUILT FOR THE MEMBER 10974040 *NAME ALSO. WHEN THE MODULE IS FETCHED IT WILL HAVE TWO CDENTRIES, ONE 10982040 *FOR THE MEMBER NAME (MAJOR ENTRY) AND ONE FOR THE ALIAS NAME (MINOR ). 10990040 * 11010040 * REGISTER USAGE 11020040 * R0,1 - ALTERED 11027040 * R3,4,5- CVT,TCB,SVRB (INPUT) 11034040 * R6 - BASE (IEAVLK01) 11050040 * R7 - BLDL FETCH WORK AREA (INPUT) 11055040 * R8,9 - ALTERED 11066040 * R10 - DCB ADDRESS (INPUT) 11074040 * R11 - CDE REQUESTED (INPUT) ALTERED (OUTPUT) 11082040 * R12 - ALTERED 11100040 * R14,15- ALTERED 11108040 * OTHER REGISTERS NOT REFERENCED 11116040 SPACE 2 11124040 */*ALIAS1: D (NO,NOSCAT,YES,) MODULE LINKED WITH SCATTER */ 11132040 SPACE 2 11150040 ALIAS1 EQU * SET DE UP IN A CONSISTENT 11158040 * PATTERN REGARDLESS OF WHETHER 11166040 * IT CONTAINS SCATTER INFO. 11174040 TM WKATTR,DESCAT THE ALIAS NAME RESIDES IN 11182040 * EITHER OF TWO PLACES DEPENDING 11200040 * ON WHETHER SCATTER INFO IS 11208040 * PRESENT. 11216040 BZ NOSCAT IF IN SCATTER DE+ 43 IS ALIAS 11224040 SPACE 2 11232040 */* P (,SCATFORM) SET WKMAINEP & WKMAINAM = MAJOR EP & NAME FROM DE*/ 11250040 SPACE 2 11258040 MVC WKMAINEP+N1(PDSS02LN),WKENTSC MOVE IN SCATTER EP AND NM 11266040 B SCATFORM SKIP NEXT MOVE 11274040 SPACE 2 11282040 */*NOSCAT: P SET WKMAINEP & WKMAINAM = MAJOR EP & NAME FROM DIFFERENT 11300040 */*PLACE IN DE*/ 11308040 SPACE 2 11316040 NOSCAT EQU * 11324040 MVC WKMAINEP+N1(PDSS02LN),WKENTBK MOVE IN EP AND NM 11332040 SPACE 2 11350040 */*SCATFORM: P PUT UNRELOCATED MINOR ENTRY POINT FROM WKENTPT INTO 11358040 */*CDENTPT*/ 11366040 */* P INDICATE MINOR CDE (SET CDMIN=1) */ 11374040 SPACE 2 11382040 SCATFORM EQU * NAME AND ENTRY POINT NOW IN 11400040 * SAME LOCATION REGARDLESS OF DE 11408040 * ATTRIBUTES 11416040 SR WKREG2,WKREG2 CLEAR HIGH ORDER BYTE 11424040 ICM WKREG2,MASK,WKENTPT GET UNRELOCATED EP 11432040 ST WKREG2,CDENTPT PUT UNRELOCATED EP IN CDE 11450040 OI CDATTR,CDMIN SET MINOR FLAG IN ALIAS CDE 11458040 ST DEBREG,WKREGIS+N12 SAVE DEB ADDRESS @ZA28494 11462040 SPACE 2 11466040 */*ALIASRCH: P SET UP SEARCH FOR MAJOR NAME R8=JPAQ HDR PTR R9=WKMAINAM 11474040 */* PTR*/ 11482040 SPACE 2 11500040 ALIASRCH LA NAMEREG,WKMAINAM SET UP SEARCH FOR MEMBER NAME. 11508040 L TABREG,TCBJSTCB SET JPAQ ORIGIN ADDRESS 11516040 LA TABREG,TCBJPQ-TCB(N0,TABREG) SET QUEUE ADDRESS 11524040 L CVTREG,CVTPTR GET CVT ADDRESS 11532040 USING CVT,CVTREG ADDRESSABILITY ON CVT 11550040 SPACE 2 11558040 */* L (FND,MAINLANX,NOTF,) IEAQCDSR-- SEARCH JPQ FOR MAJOR NAME */ 11566040 SPACE 2 11574040 L RETURN,CVTQCDSR PICK UP CDSEARCH ADDRESS 11582040 BALR RETURN,RETURN SEARCH THE CDE QUEUE 11600040 * FOR MEMBER NAME. 11608040 B MAINLANX IF MAIN NAME IS IN CONTENTS 11616040 * DIRECTORY, BRANCH TO ROUTINE TO 11624040 * COMPLETE ALIAS REQUEST. 11632040 SPACE 2 11650040 */* D (YES,LPASRCH,NO,) LINKLIB DCB IN USE (DCBREG = PTR LINKLIB DCB)*/ 11658040 SPACE 2 11666040 C DCBREG,LINKDCBA Q.IS LINKLIB IN USE 11674040 BE LPASRCH YES.SEARCH LINK PACK AREA 11682040 SPACE 2 11700040 */* D (NO,CREATCDE,YES,) SVCLIB DCB IN USE (DCBREG = PTR SVCLIB DCB)*/ 11708040 SPACE 2 11716040 C DCBREG,SVCDCBA Q.IS SVCLIB IN USE 11724040 BNE CREATCDE NO.GET ANOTHER CDE 11732040 SPACE 2 11750040 */*LPASRCH: P SAVE R11 THRU R13 IN WKREGIS*/ 11758040 */* L SETLOCK-- GET CMS LOCK FOR LPA SEARCH */ 11767040 */* P RESTORE R11 THRU R13 FROM WKREGIS*/ 11776040 SPACE 2 11785040 LPASRCH EQU * SEARCH THE LPAQ 11794040 STM R11,R13,WKREGIS SAVE VOLATILE REGS @ZA28494 11803040 SETLOCK OBTAIN,TYPE=CMS,MODE=UNCOND, x11810040 RELATED=('WILL BE FREED AT CREATCD1 OR EXIT PROLOG') 11817040 LM R11,R13,WKREGIS RESTORE VOLATILE REGS @ZA28494 11824040 SPACE 2 11850040 */* P SET R8= ADDR OF ALPAQ HEADER*/ 11858040 SPACE 2 11866040 L TABREG,IEAQLCTA GET ADDRESS OF LPACQ ORIGIN 11874040 SPACE 2 11882040 */* L (FND,MAINLANX,NOTF,) IEAQCDSR-- SEARCH ALPAQ FOR MAJOR NAME */ 11900040 SPACE 2 11908040 L RETURN,CVTQCDSR PICK UP CDSEARCH ADDRESS 11916040 BALR RETURN,RETURN SEARCH THE QUEUE 11924040 B MAINLANX FOUND - BRANCH TO MAIN ROUTINE 11932040 SPACE 2 11950040 */*CREATCD1: P SAVE R11 THRU R13 IN WKREGIS*/ 11958040 */* L SETLOCK-- RELEASE CMS LOCK */ 11966040 */* P RESTORE R11 THRU R13 FROM WKREGIS*/ 11974040 SPACE 2 11982040 CREATCD1 STM R11,R13,WKREGIS SAVE VOLATILE REGS @ZA28494 11990040 SETLOCK RELEASE,TYPE=CMS,RELATED=('LK01,OBTAINED AT LPASRCH') 11995040 LM R11,R13,WKREGIS RESTORE VOLATILE REGS @ZA28494 12000040 SPACE 2 12024040 */*CREATCDE: L GETMAIN (BR ENTRY) -- GET CDE FROM SUBPOOL 255 (LSQA) */ 12032040 */* P SET CDIREG = ADDR OF CDE VIA RBCDE1*/ 12050040 SPACE 2 12058040 CREATCDE EQU * BUILD THE CDE 12066040 L ASCBREG,PSAAOLD GET ASCB ADDRESS FOR GETMAIN 12074040 GETMAIN RU,LV=CDESIZE,SP=255,BRANCH=YES GET CDE 12082040 L CDIREG,RBCDFLGS RESET CDIREG TO MINOR 12100040 SPACE 1 12108040 * WE WILL USE NEW CDE AS MINOR, AND OLD CDE AS MAJOR. THIS 12116040 * SIMPILFIES CHAINING. MINOR INFORMATION IS MOVED TO NEW 12124040 * SPACE, AND OLD MINOR IS CHANGED INTO A MAJOR. 12132040 SPACE 1 12150040 */* P SET CDEREG= ADDR OF NEW CDE (SET R11=R1)*/ 12158040 */* COMMENT (2,1) USE NEW CDE AS*/ 12166040 */* COMMENT (3,1) MINOR AND OLD*/ 12174040 */* COMMENT (4,1) CDE AS MAJOR.*/ 12182040 */* P COPY OLD CDE (VIA R12) INTO NEW CDE (VIA R11)*/ 12200040 */* P SET CDCHAIN OF OLD CDE = ADDR OF NEW CDE*/ 12208040 SPACE 2 12216040 LR CDEREG,R1 SET NEW CDE = ALIAS = MINOR 12224040 MVC N0(CDESIZE,CDEREG),N0(CDIREG) PUT ALIAS IN MINOR LOC. 12232040 ST CDEREG,CDCHAINJ POINT OLD CDE TO NEW CDE 12250040 SPACE 2 12258040 */* P SET CDNAME OF OLD CDE = MAJOR NAME IN WKMAINAM*/ 12266040 SPACE 2 12274040 L AREAREG,RBCSWORK GET ADDRESS OF FETCH WORKAREA 12282040 MVC CDNAMEJ(NAME),WKMAINAM INSERT MAJOR NAME IN CDE 12300040 SPACE 2 12308040 */* P MARK OLD CDE AS A MAJOR (SET CDMIN =0) */ 12316040 */* P SET CDXLMJP OF NEW CDE = ADDR OF OLD CDE*/ 12324040 */* P SET RBCDE1 OF PM SVRB = ADDR OF NEW CDE (RQSTD CDE)*/ 12332040 SPACE 2 12350040 NI CDATTRJ,MAX-CDMIN RESET MIN FLAG IN MAJOR 12358040 LA CDIREG,N0(CDIREG) CLEAR HIGH ORDER BYTE 12366040 ST CDIREG,CDXLMJP POINT MINOR BACK TO MAJOR 12374040 MVC RBCDEA(ADDL),CDCHAINJ+N1 RE-INITIALIZE RBCDE 12382040 SPACE 2 12400040 */* P INDICATE 2 CDES OBTAINED (SET RBCSTWO =1)*/ 12408040 */* P (,PGMFETCH) SET R11=R12 FOR FETCH*/ 12416040 SPACE 2 12424040 OI RBCSFLG1,RBCSTWO INDICATE 2 CDES @YA01851 12432040 LR CDEREG,CDIREG SET FOR FETCH ON MINOR 12450040 * MAJOR CDE REG WILL BE SET BY 12458040 * RERIG AFTER PGMFETCH. 12466040 L DEBREG,WKREGIS+N12 RESTORE DEB ADDRESS @ZA28494 12470040 B PGMFETCH GO TO FETCH 12474040 SPACE 2 12482040 */*MAINLANX: D (NO,MAINLAND,YES,) SYSTEM REQUEST? (RBCSSYSR =1)*/ 12500040 SPACE 2 12508040 MAINLANX TM RBCSFLG1,RBCSSYSR Q. THIS A SYSTEM REQUEST 12516040 BZ MAINLAND A. NO-CONTINUE 12524040 SPACE 2 12532040 */* D (YES,MAINLAND,NO,CREATCD1) MODULE FROM AUTH LIB (CDSYSLIB =1)*/ 12550040 SPACE 2 12558040 TM CDATTR2,CDSYSLIB Q. THIS A SYSTEM LIBRARY MODULE 12566040 BO MAINLAND YES- CONTINUE 12574040 B CREATCD1 NO- USE THIS MODULE 12582040 EJECT 12600040 *THIS ROUTINE OPERATES UPON AN ALIAS CDENTRY WHERE MAIN CDENTRY HAS 12608040 *BEEN FOUND TO BE IN STORAGE. OF PRIME CONCERN IS THE EXTENT LIST WHICH 12616040 *IS USED TO RELOCATE THE ALIAS ENTRY POINT. IF THE MAIN CDENTRY HAS ITS 12624040 *NIC FLAG SET INDICATING IT IS NOT IN CORE ,THE ALIAS REQUEST MUST BE 12632040 *QUEUED PENDING THE SUCCESSFUL FETCHING OF THE MAIN NAME. 12650040 * 12658040 * REGISTER USAGE 12666040 * R0,1 - ALTERED 12674040 * R2 - ALTERED 12682040 * R3 - ALTERED 12700040 * R4 - TCB (INPUT) 12708040 * R5 - SVRB (INPUT) 12716040 * R6 - BASE (IEAVLK01) 12724040 * R7 - BLDL FETCH WORK AREA (INPUT) 12732040 * R9 - ADDRESS OF NAME (OUTPUT) 12750040 * R11,12,13,14,15- ALTERED 12758040 * OTHER REGISTERS NOT REFERENCED 12766040 SPACE 1 12774040 */*MAINLAND: P RESET MAJOR CDE POINTER (SET R12=R11)*/ 12782040 */* P RESET REQUESTED CDE POINTER (SET R11= RBCDE1)*/ 12800040 */* P RESET NAMEREG (SET R9= RBCSNAME)*/ 12808040 SPACE 2 12816040 MAINLAND LR CDIREG,CDEREG MAJOR CDE ADDRESSED BY CDIREG 12824040 L CDEREG,RBCDFLGS MINOR CDE ADDRESSED BY CDEREG 12832040 LA NAMEREG,RBCSNAME RESET MINOR NAME PTR 12850040 SPACE 2 12858040 */* P RINITIALIZE MAJOR POINTER IN MINOR CDE SET CDXLMJP= R12)*/ 12866040 SPACE 2 12874040 LA CDIREG,N0(CDIREG) CLEAR HIGH ORDER BYTE 12882040 ST CDIREG,CDXLMJP INITIALIZE CDXLMJP 12900040 SPACE 2 12908040 */* S RETHRED:UNHOOK ALIAS FROM JPACQ */ 12916040 */* P RESTORE R12 FROM CDXLMJP OF RQSTD CDE*/ 12924040 SPACE 2 12932040 BAL R13,RETHRED UNHOOK CDE FROM LIST 12950040 L CDIREG,CDXLMJP RELOAD CDIREG 12958040 SPACE 2 12966040 */* D (NO,NONLPA,YES,) MAJOR LOADED BY NIP? (CDNIP =1) */ 12974040 SPACE 2 12982040 TM CDATTRJ,CDNIP FIXED LPA MOD LOADED BY NIP 13000040 BZ NONLPA NO-BR AROUND LPA PROCESSING 13008040 SPACE 2 13016040 */*GETSOCDE: L GETMAIN (BR ENTRY)-- GET CDE FROM SUBPOOL 245 (SQA) */ 13024040 SPACE 2 13032040 GETSOCDE EQU * GET CDE 13050040 L ASCBREG,PSAAOLD GET ASCB FOR GETMAIN 13060040 GETMAIN RU,LV=CDESIZE,SP=245,BRANCH=YES 13068040 SPACE 2 13076040 */* P COPY REQUESTED CDE (IN LSQA) TO NEW SQA CDE */ 13084040 SPACE 2 13100040 MVC ZERO(CDESIZE,R1),ZERO(R11) MVE CDE FR LSQS TO SQS/TSC 13108040 SPACE 2 13116040 */* P SET CDJPA=0 AND CDNIP=1 IN NEW CDE*/ 13124040 */* P SET CDEREG= ADDR OF NEW CDE (SET R11=R1)*/ 13132040 */* P PREPARE FOR FREEMAIN: SET R2= CDE TO BE FREED AND CLEAR HIGH 13150040 */*ORDER BYTE*/ 13158040 SPACE 2 13166040 LA WKREG2,N0(R11) ADDRESS TO BE FREED M00883 13174040 NI CDATTR-CDENTRY(R1),MAX-CDJPA TURN OFF JPA MOD.BIT M00883 13182040 OI CDATTR-CDENTRY(R1),CDNIP SET LPA INDICATOR M00883 13200040 LR R11,R1 SAVE NEW CDE ADDR. OVER FREEMAIN 13208040 SPACE 2 13216040 */* L FREEMAIN (BR ENTRY) -- FREE LSQA CDE (SUBPOOL 255) */ 13224040 SPACE 2 13232040 FREEMAIN RU,SP=255,LV=CDESIZE,A=(WKREG2),BRANCH=YES 13250040 SPACE 2 13260040 */* P SET RBCDE1 = ADDR OF NEW CDE (RBCDE1 = R11)*/ 13268040 */* P SET WKCDADDR = ADDR OF NEW CDE*/ 13276040 SPACE 2 13284040 STCM R11,MASK,RBCDE1 SAVE PTR TO NEW CDE IN RB 13300040 L AREAREG,RBCSWORK GET FETCH WORKAREA 13308040 ST R11,WKCDADDR UPDATE CDE ADDR IN THE 13316040 * FETCH/BLDL WORK AREA 13324040 SPACE 2 13332040 */*NONLPA: P CHAIN MINOR CDE IN QUEUE BEHIND MAJOR */ 13350040 SPACE 2 13358040 NONLPA EQU * CHAIN CDE 13366040 L WKREG2,CDCHAINJ GET CHAIN FOR MAJOR 13374040 ST WKREG2,CDCHAIN AND PUT IT IN THE MINOR 13382040 MVC CDCHAINJ+N1(ADDL),RBCDEA MOVE POINTER TO MIN INTO MAJOR 13400040 SPACE 2 13408040 */* D (YES,RESOLVE,NO,) MAJOR NAME IN STORAGE? (CDNIC=0)*/ 13416040 SPACE 2 13424040 TM CDATTRJ,CDNIC Q.IS MAIN NAME IN STORAGE 13432040 BZ RESOLVE A=YES, TAKE BRANCH 13450040 SPACE 2 13458040 */* P SET BASEREG (R6) FOR IEAVLK00*/ 13466040 */*R RETURN TO CDQUECTL IN IEAVLK00*/ 13474040 */* COMMENT (1,1) CDQUECTL WILL*/ 13482040 */* COMMENT (2,1) QUEUE THIS RQST*/ 13500040 */* COMMENT (3,1) ONTO THE NIC*/ 13508040 */* COMMENT (4,1) QUEUE OF THE*/ 13516040 */* COMMENT (5,1) MAJOR CDE*/ 13524040 SPACE 2 13532040 L GR15,TABLEADD POINT TO ADDRESS LIST 13550040 USING ADDRTAB,GR15 USE ADDRESS LIST 13558040 L BASEREG,CDLKBASE SET UP VLK00 ADDRESSABILITY 13566040 L GR15,CDQUECTL POINT TO CDQUECTL IN VLK00 13574040 BR GR15 GO THERE 13582040 SPACE 1 13600040 * IF LOAD MODULE IS IN MAIN STORAGE, AND 13608040 * ALIAS TO IT HAS BEEN REQUESTED THIS 13616040 * SECTION IS ENTERED. 13624040 SPACE 1 13632040 */*RESOLVE: P SET R14= UNRELOCATED ENTRY POINT (SET R14= WKENTPT)*/ 13650040 */* S RELOCATE: SET R14= RELOCATED ENTRY POINT*/ 13658040 SPACE 2 13666040 RESOLVE DS 0H 13674040 L SUBREG1,WKENTPT-N1 LOAD ABSOLUTE ENTRY POINT 13682040 BAL COMREG,RELOCATE RELOCATE ENTRY POINT 13700040 SPACE 2 13710040 */* P SET NOT-IN-CORE BIT OFF IN REQUESTED CDE */ 13718040 */* P STORE RELOCATED ENTRY POINT IN REQUESTED CDE (CDENTPT= R14)*/ 13726040 SPACE 2 13734040 NI CDATTR,MAX-CDNIC RESET NIC BIT 13750040 ST SUBREG1,CDENTPT STORE RELOCATED ENTRY POINT 13758040 SPACE 2 13766040 */* P SET BASEREG (R6) FOR IEAVLK00*/ 13774040 */* R RETURN TO PLUSCONT IN IEAVLK00*/ 13782040 */* COMMENT (1,1) PLUSCONT WILL*/ 13800040 */* COMMENT (2,1) CONTINUE WITH*/ 13808040 */* COMMENT (3,1) THE ALLOCATION*/ 13816040 */* COMMENT (4,1) OF THE CDE*/ 13824040 SPACE 2 13832040 L GR15,TABLEADD POINT TO ADDRESS LIST IN VLK00 13850040 L BASEREG,CDLKBASE SET UP VLK00 ADDRESSABILITY 13858040 L GR15,PLUSCONT POINT TO PLUSCONT 13866040 LR R14,R15 SET LOOP REGISTER FOR MAINLINE 13874040 BR GR15 GO TO IT 13882040 EJECT 13900040 *INTERFACE WITH PROGRAM FETCH IS SET UP. THE FOLLOWING IS REQUIRED 13908040 * R5 - SVRB ADDRESS YM8234 13916040 * R6 - BASE (IEAVLK01) 13924040 * R7 - DCB ADDRESS 13930040 * R8 - DEB ADDRESS (INPUT) 13936040 * R9 - 0 13950040 * R10 - SPID (EITHER 251 OR 252) 13958040 * R12 - RELOCATED ENTRY POINT PASSED BACK 13966040 * R13 - WORK AREA 13974040 * R14 - RETURN REG 13982040 * R15 - RETURN CODE 14000040 * MODE UPON ENTRY IS FULLY ENABLED. 14008040 *FETCH WILL BUILD AN EXTENT LIST FOR WHICH CORE IS GOTTEN FROM SP=252 14016040 *A FLAG SET IN THE HI ORDER BYTE OF THE WORD WILL INDICATE THAT FETCH 14024040 *HAS BUILT THE EXTENT LIST AND IS REQUESTING MAIN STORAGE FOR THE 14032040 *MODULE. THIS STORAGE WILL HAVE TO BE FREED IN CASE OF ABEND IN FETCH. 14050040 SPACE 1 14058040 */*PGMFETCH: P SET R9= ADDR OF CDE (VIA R11) IN COMP FORM FOR FETCH*/ 14066040 */* P SAVE DCB ADDRESS (R10) IN WKDCBSE*/ 14074040 SPACE 2 14082040 PGMFETCH EQU * INTERFACE TO FETCH 14100040 LA CDEREG,ZERO(CDEREG) CLEAR HIGH ORDER BYTE 14110040 LNR GR9,CDEREG COMP R9 AS INPUT TO FETCH 14118040 ST DCBREG,WKDCBSE SAVE DCB ADDRESS IN W.A. 14126040 SPACE 2 14134040 */* D (NO,DEBCHKON,YES,) SYSTEM REQUEST? (RBCSSYSR =1) */ 14150040 */* P SUPPRESS DEB CHECK BY SETTING FLAG WKSYSREQ ON IN FETCH W.A.*/ 14158040 SPACE 2 14166040 TM RBCSFLG1,RBCSSYSR Q. IS THIS A SYSTEM REQUEST 14174040 BZ DEBCHKON A. NO-LET FETCH TO DO DEB CHECK 14182040 OI WKFLG1,WKSYSREQ A. YES- SURPRESS FETCH DEB CHECK 14200040 SPACE 2 14208040 */*DEBCHKON: P SET R7 = DCB ADDR (R7=R10)*/ 14216040 */* P SET SUBPOOL ID = 251 (SET R10=251)*/ 14224040 SPACE 2 14232040 DEBCHKON LR GR7,DCBREG SAVE DCB ADDRESS 14250040 LA GR10,SPNONREN SET SUBPOOL ID = 251 14258040 SPACE 2 14266040 */* D (NO,KETCHIT,YES,) MODULE RENTRANT? (CDREN VIA R11 =1) */ 14274040 SPACE 2 14282040 TM CDATTR,CDREN Q. IS MODULE REENTRABLE 14300040 BZ KETCHIT A=NO, TAKE BRANCH 14308040 SPACE 2 14316040 */* D (NO,KETCHIT,YES,) AUTH LIB BIT ON (DEBAPFIN =1)*/ 14324040 SPACE 2 14334040 USING DEBBASIC,DEBREG @ZA28494 14344040 TM DEBFLGS1,DEBAPFIN IS DEB AUTHORIZED? @ZA28494 14353040 BZ KETCHIT NOT AUTH. - USE SP 251 14362040 DROP DEBREG @ZA28494 14371040 SPACE 2 14400040 */* D (NO,FETCHIT,YES,) IS TSO TEST IN PROCESS? (TCBTCP =1) */ 14408040 SPACE 2 14416040 TM TCBTRN,TCBTCP IS TEST BIT ON. 14424040 BZ FETCHIT NO BRANCH USE SUBPOOL 252 14432040 SPACE 2 14450040 */*D (NO,KETCHIT,YES,) SYSTEM REQUEST (RBCSSYSR =1) */ 14458040 SPACE 2 14466040 TM RBCSFLG1,RBCSSYSR Q. IS THIS A SYSTEM REQ. 14474040 BZ KETCHIT Q. NO- USE SP 251 14482040 SPACE 2 14500040 */*FETCHIT: P SET SUBPOOL ID = 252 (SET R10=252)*/ 14508040 */* P TURN OFF JPA INDICATOR IN RQSTD CDE (SET CDJPA=0)*/ 14516040 SPACE 2 14524040 FETCHIT LA GR10,SPRENT SET SUBPOOL ID = 252 14532040 NI CDATTR,MAX-CDJPA RESET JPA BIT IN CDENTRY 14550040 SPACE 2 14558040 */*KETCHIT: L SETFRR-- REMOVE RECOVERY ROUTINE FROM STACK */ 14566040 */* P CLEAR FRR PARM LIST PTR (SET RBCSFRRA = 0)*/ 14574040 SPACE 2 14582040 KETCHIT EQU * 14600040 SETFRR D,WRKREGS=(11,12) 14608040 SR R11,R11 CLEAR REG. TO ZERO PARM. 14616040 ST R11,RBCSFRRA LIST ADDR. 14624040 SPACE 2 14632040 */* L SETLOCK-- FREE CMS LOCK OBTAINED BEFORE LPA SEARCH */ 14650040 SPACE 2 14658040 SETLOCK RELEASE,TYPE=CMS,RELATED=('FREED OVER FETCH') 14666040 SPACE 2 14674040 */* L SETLOCK-- FREE LOCAL LOCK */ 14682040 SPACE 2 14700040 SETLOCK RELEASE,TYPE=LOCAL,RELATED=('FREED OVER FETCH') 14708040 SPACE 2 14716040 */* P SET R3= ADDR CVT & R13= FETWK ADDR FOR FETCH*/ 14724040 */* $ */ 14732040 */* COMMENT (5,1) FETCH INPUT--*/ 14750040 */* COMMENT (6,1) R5= SVRB ADDR*/ 14758040 */* COMMENT (7,1) R7=DCB ADDR*/ 14766040 */* COMMENT (8,1) R9=COMP CDE AD*/ 14774040 */* COMMENT (9,1) R10=SUBPOOL ID*/ 14782040 */* COMMENT (10,1) R13=FETWK ADDR*/ 14800040 */* COMMENT (11,1) R14=RET ADDR*/ 14808040 */* COMMENT (12,1) R15=FETCH EP*/ 14816040 */* L IEWMSEPT-- CAUSE FETCH TO BRING MODULE INTO STORAGE */ 14824040 SPACE 2 14832040 L CVTREG,CVTPTR GET CVT ADDRESS MDC196 14850040 L GR13,RBCSWORK GET FETCH WORKAREA 14858040 * YM8234 14866040 L GR15,CVTFETCH R15-ENTRY POINT TO FETCH MDC196 14874040 BALR GR14,GR15 GO TO PROGRAM FETCH 14882040 SPACE 2 14900040 */* P RE-ESTABLISH BASEREG (R6) */ 14908040 SPACE 2 14916040 BALR BASEREG,ZERO ESTABLISH BASE ADDRESSABILITY 14924040 USING *,BASEREG TEMPORARY BASE 14932040 L BASEREG,LINKBASE SET UP PERMANENT BASE VALUE 14950040 USING IEAVLK01,BASEREG SET BASE 14958040 SPACE 2 14966040 */* P CLEAR ABEND REGISTER (R13) */ 14974040 */* D (YES,,NO,FETCHOK) ANY ERRORS DURING FETCH? (R15 NOT 0)*/ 14982040 */* COMMENT (2,15) 106 ABEND IF*/ 15000040 */* COMMENT (3,15) FETCH ERROR*/ 15008040 */* S RERIG: SET ENVIRN INCL. FRR & LOCAL LOCK*/ 15016040 */* P (,ERRFETCH) SET ABEND REGISTER R13 TO ZERO*/ 15024040 SPACE 2 15032040 SR R13,R13 ZERO REG 13 FOR ERROR ROUTINE 15050040 LTR GR15,GR15 Q. ANY ERRORS IN FETCHING 15058040 BZ FETCHOK TO FETCHOK IF NO @YA01851 15066040 BAL SUBREG1,RERIG RESTORE REGS & LOC LOCK @YA01851 15074040 L AREAREG,RBCSWORK LOAD FETCH WA ADDR @ZA26977 15078040 SR R13,R13 CLEAR ABEND REGISTER @YA01851 15082040 B ERRFETCH FETCH ERROR = 106 @YA01851 15100040 SPACE 2 15108040 */* FETCHOK: P SAVE ENTRY POINT RETURNED BY FETCH (R15=R12)*/ 15116040 */* S RERIG:RESTORE REGS DESTROYED BY FETCH */ 15124040 */* P PUT RELOCATED ENTRY POINT IN RQSTD CDE (CDENTPT= R15)*/ 15132040 SPACE 2 15150040 FETCHOK LA SUBREG2,N0(GR12) SAVE E.P. RETURNED BY FETCH @YA01851 15158040 BAL SUBREG1,RERIG ROUTINE TO RESTORE REGS 15166040 ST SUBREG2,CDENTPT STORE RELOCATED ENTRY POINT 15174040 SPACE 1 15182040 * APF CHECKING FOR FETCHED MODULE. MODULE WILL BE AUTHORIZED IF 15200040 * IT CAN PASS RIGID QUALIFICATIONS. 15208040 */* P SET R1= ADDR OF MAJOR CDE (R1=R12)*/ 15216040 */* P SET AREAREG= ADDR FETWK (R7= RBCSWORK)*/ 15224040 SPACE 2 15232040 LR R1,CDIREG GET MAJOR ADDRESS 15250040 L AREAREG,RBCSWORK LOAD FETCH WA ADDR 15255040 SPACE 2 15266040 */*APFOFF: P TURN OFF AUTHORIZATION FLAG (CDAUTH) IN CDE VIA R1*/ 15274040 */* P GET NEXT CDE (SET R1= CDCHAIN OF RB VIA R1)*/ 15282040 */* D (YES,ALLDONE,NO,) END OF CDE QUEUE? (R1=0)*/ 15300040 */* D (YES,APFOFF,NO,) IS CDE A MINOR? (CDMIN=1)*/ 15308040 SPACE 2 15316040 APFOFF EQU * TURN OFF APF IN MAJOR AND MINORS 15324040 NI CDATTR2-CDENTRY(R1),MAX-CDAUTH TURN OF AUTHORIZATION 15332040 ICM R1,MASK,CDCHAIN+N1-CDENTRY(R1) GET NEXT CDE 15350040 BZ ALLDONE IF END OF QUEUE, LEAVE LOOP 15358040 TM CDATTR-CDENTRY(R1),CDMIN IS CDE A MONOR 15366040 BO APFOFF YES, TURN OFF BIT 15374040 * END OF LOOP WHEN NEXT MAJOR 15382040 SPACE 2 15400040 */*ALLDONE: P RESET CVT POINTER IN CVTREG (R3) */ 15408040 */* D (NO,JSCBOFF,YES,) LIBRARY AUTHORIZED? (WKAUTH=1)*/ 15416040 */* COMMENT (1,1) WKAUTH BIT IS*/ 15424040 */* COMMENT (2,1) SET BY FETCH*/ 15432040 */* COMMENT (3,1) VIA A DEB BIT*/ 15450040 SPACE 2 15458040 ALLDONE EQU * END OF BIT OFF LOOP 15466040 USING CVT,CVTREG SET ADDRESSABLE 15474040 L CVTREG,CVTPTR RESET CVT REGISTER 15482040 TM WKFLG1,WKAUTH Q. LIB AUTHORIZED 15500040 BZ DSS06 NO - CONTINUE @ZA24461 15508040 SPACE 2 15516040 */* D (NO,SETAUTHL,YES,) IS MOD. REENTRANT? (CDREN =1)*/ 15524040 SPACE 2 15532040 TM CDATTRJ,CDREN Q. IS MODULE REENTRABLE 15550040 BZ SETAUTHL NO - SET AUTH. LIB INDIC. 15558040 SPACE 2 15566040 */* D (NO,SETAUTHL,YES,) MODULE IN JPA? (CDJPA =1)*/ 15574040 SPACE 2 15582040 TM CDATTRJ,CDJPA Q. JPA MOD CAN NOT BE AUTH. 15600040 BZ SETAUTHL LIB. IN ANY CASE. 15608040 SPACE 2 15616040 * IF REENT. AND SP 251, A DESCREPENCY EXISTS. IF TEST IS IN CONTROL 15624040 * TURN OFF INDICATOR AND CONTINUE. IF NOT ISSUE A 306 ABEND. 15632040 */* D (NO,,YES,DSS06) TSO TEST IN CONTROL? (TCBTCP =1)*/ 15650040 */* P CLEAR ABEND REGISTER (R13)*/ 15658040 */* P (,ERRSYSR) SET RETURN CODE = X'0C' IN R15*/ 15666040 SPACE 2 15674040 TM TCBTRN,TCBTCP Q. TEST IN CONTROL 15682040 BO DSS06 A. YES- CONTINUE 15700040 SR R13,R13 CLEAR ABEND REG 15708040 LA R15,N12 SET REASON CODE 15716040 B ERRSYSR ISSUE ABEND 15724040 SPACE 2 15732040 */*SETAUTHL: P SET AUTH LIB INDICATOR (CDSYSLIB) IN MAJOR CDE */ 15750040 SPACE 2 15758040 SETAUTHL OI CDATTR2J,CDSYSLIB INDICATE LIBRARY AUTH. IN MAJOR 15766040 SPACE 2 15774040 */*APF02 D (NO,DSS06,YES,) AOS LINKEDIT? (PDSAOSLE =1) */ 15782040 SPACE 2 15800040 APF02 DS 0H CHECK PDS AUTHORIZATION 15808040 USING PDS2-WKNAME+WKAREA,AREAREG POINT TO PDS IN FETCH W.A. 15816040 TM PDS2FTB1,PDSAOSLE IS IT AOS LINK EDIT 15824040 BNO DSS06 NO, CANT AUTHORIZE 15832040 SPACE 2 15850040 */* D (NO,DSS06,YES,) LINKEDITED WITH APF ATTR (PDSAPFLG =1)*/ 15858040 SPACE 2 15866040 TM PDS2FTB1,PDSAPFLG CHECK FOR APF INFO 15874040 BZ DSS06 IF NONE, CANT AUTHORIZE 15882040 SPACE 2 15900040 */* P GET END OF BASIC PDS SECTION */ 15908040 SPACE 2 15916040 LA R14,PDSBCEND POINT TO APF IF COMMON SECTION 15924040 * ONLY. WILL ADD OFFSETS FOR EACH 15932040 * ADDITIONAL SECTION PRESENT 15950040 SPACE 2 15958040 */* D (NO,APF05,YES,) SCATTER INFO. IN PDS (PDS2SCTR =1)*/ 15966040 */* P ADD LENGTH OF SCATTER SECTION OF PDS */ 15974040 SPACE 2 15982040 TM PDS2ATR,PDS2SCTR CHECK FOR SCATTER SECTION 16000040 BNO APF05 IF NONE, SKIP ADD 16008040 LA R14,PDSS01LN(R14) ADDD SCATTER SIZE 16016040 SPACE 2 16024040 */*APF05: D (NO,APF06,YES,) LINKEDITED WITH ALIAS (PDS2ALIS =1)*/ 16032040 */* P ADD LENGTH OF ALIAS SECTION OF PDS */ 16050040 SPACE 2 16058040 APF05 EQU * SKIP SCATTER LABEL 16066040 TM PDS2INDC,PDS2ALIS CHECK FOR ALIAS SECTION 16074040 BNO APF06 IF NONE, SKIP ADD 16082040 LA R14,PDSS02LN(R14) ADD ALIAS LENGTH 16100040 SPACE 2 16108040 */*APF06: D (NO,APF08,YES,) ANY SSI INFO (PDS2SSI =1)*/ 16116040 */* P ROUND UP TO HALFWORD ALIGNMENT AND ADD SSI SIZE */ 16124040 SPACE 2 16132040 APF06 EQU * ALIAS SKIP LABEL 16150040 TM PDS2FTB1,PDS2SSI CHECK FOR SSI 16158040 BNO APF08 IF NONE, SKIP ADD 16166040 LA R14,N1(R14) ROUND UP TO HALFWORD 16174040 N R14,APFROUND BOUNDARY ALIGNMENT 16182040 LA R14,PDSS03LN(R14) ADD SSI SIZE 16200040 SPACE 2 16210040 */*APF08: P GET APF INFORMATION FROM PDS */ 16218040 */* D (NO,DSS06,YES,) MODULE AUTHORIZED (PDSAPF =1)*/ 16226040 */* P SET R1= CDE ADDR (R1=R12)*/ 16234040 SPACE 2 16250040 APF08 EQU * SKIP SSI LABEL 16258040 OC PDSAPFAC-PDSAPF(APFLN,R14),PDSAPFAC-PDSAPF(R14) @ZA08130 16262040 * TEST APF FLAGS FOR ZERO @ZA08130 16266040 BZ DSS06 NOT AUTHORIZED, SKIP SETTINGS 16300040 LR R1,CDIREG GET MAJOR CDE 16308040 SPACE 2 16316040 */*APFON: P SET AUTH. IND. ON IN CDE VIA R1 (CDAUTH =1)*/ 16324040 */* P SET R1= NEXT CDE (R1= CDCHAIN OF RB VIA R1)*/ 16332040 */* D (YES,DSS06,NO,) END-OF-QUEUE? (R1=0) */ 16350040 */* D (NO,DSS06,YES,APFON) CDE A MINOR? (CDMIN =1) */ 16358040 SPACE 2 16366040 APFON EQU * SET ALL CDES AUTHORIZED 16374040 OI CDATTR2-CDENTRY(R1),CDAUTH TURN ON AUTH BIT 16382040 ICM R1,MASK,CDCHAIN+N1-CDENTRY(R1) GET NEXT CDE ADDR 16400040 BZ DSS06 NONE LEFT, LEAVE 16410040 TM CDATTR-CDENTRY(R1),CDMIN IF THIS IS A MINOR CDE 16418040 BO APFON SET IT AUTHORIZED 16425040 DROP AREAREG DROP PDS 16790040 USING WKAREA,AREAREG RESET WORKAREA ADDRESSING 16799040 EJECT 16808040 * THE FOLLOWING INSTRUCTION IS THE INTERFACE TO DSS FROM CONTENTS 16817040 * SUPERVISION. THE REGISTERS MUST BE SET UP AS FOLLOWS - 16826040 * REGISTER 4 = ADDRESS OF TCB 16835040 * REGISTER 11 = ADDRESS OF MINOR CDE IF ONE EXISTS,ELSE MAJOR CDE 16844040 * REGISTER 12 = ADDRESS OF MAJOR CDE 16853040 SPACE 2 16862040 */*DSS06: L DSS-- IF DSS ACTIVE GIVE IT CONTROL */ 16871040 */* $ */ 16880040 */* COMMENT (6,3) DSS INTERFACE---*/ 16889040 */* COMMENT (7,3) R4=TCB ADDR*/ 16898040 */* COMMENT (8,3) R11=MINOR CDE ADDR*/ 16907040 */* COMMENT (9,3) R12=MAJOR CDE ADDR*/ 16916040 DSS06 BCR N0,N0 RESERVED 16950040 SPACE 1 16958040 * TEST IF ISSUER IS AN SVRB.IF IT IS THEN BYPASS TESTING 16966040 * BIT IN THE TCB FOR USING TESTRAN. IF ISSUER IS NOT AN SVRB, 16974040 * THEN TEST BIT IN TCB FOR TEST COMMAND. IF TEST BIT IS ON, 16982040 * TESTRAN IS TO BE USED WHETHER OR NOT THE TEST ATTRIBUTE IS 17000040 * INDICATED IN THE DIRECTORY. 17010040 */* D (YES,CKTESTON,NO,) RB POINT TO TCB ? */ 17020040 */* P SET R1= ADDR OF CALLING RB (VIA RBLINK OF PM SVRB)*/ 17027040 */* D (YES,OKLAHOME,NO,) CALLER AN SVRB? */ 17034040 SPACE 2 17050040 TM RBSTAB2-RBSECT(RBREG),RBTCBNXT RBPOINT TO TCB @ZA03829 17058040 BO CKTESTON YES-CHECK FOR TSO TEST @ZA03829 17066040 L R1,RBLINKZ(RBREG) GET RB LINK FIELD 17074040 TM RBSTABZ(R1),RBFTSVRB IS ISSUER AN SVRB 17082040 BO OKLAHOME YES BYPASS TESTING BIT IN TCB 17100040 SPACE 2 17108040 */*CKTESTON: D (YES,TESTON,NO,) IS TSO TEST IN CONTROL? (TCBTCP=1)*/ 17116040 SPACE 2 17124040 CKTESTON TM TCBTRN,TCBTCP IS TEST BIT ON 17132040 BO TESTON IF ON SKIP DE CHECKING 17150040 */* D (YES,OKLAHOME,NO,) IS IT NIP? */ 17151040 USING CVT,CVTREG SET ADDRESSABILITY @ZA07512 17152040 L CVTREG,CVTPTR RESET CVT REGISTER @ZA07512 17153040 TM CVTOPTA-CVT(CVTREG),CVTNIP IS IT NIP? @ZA07512 17154040 BO OKLAHOME YES-SKIP TSO TEST SVC @ZA07512 17155040 SPACE 2 17160040 */* D (NO,OKLAHOME,YES,) MOD LKED WITH TEST OPTION? (PDS2TEST =1)*/ 17168040 SPACE 2 17176040 TM WKATTR,PDS2TEST IS DE MARKED TEST 17184040 BNO OKLAHOME IF NOT SKIP TESTRAN 17200040 SPACE 1 17210040 *********************************************************************** 17220040 */*TESTON: L SETFRR-- REMOVE RECOVERY ROUTINE BEFORE SVC */ 17227040 */* P CLEAR FRR PARM LIST PTR (SET RBCSFRRA =0)*/ 17234040 SPACE 2 17250040 TESTON EQU * INTERFACE WITH TESTRAN 17258040 LR R1,R12 SAVE CDE ADDR. 17266040 SETFRR D,WRKREGS=(11,12) 17274040 SR R11,R11 CLEAR REG. FOR ZEROING 17282040 ST R11,RBCSFRRA PARM. LIST AREA 17300040 SPACE 2 17308040 */* L SETLOCK-- FREE LOCAL LOCK BEFORE SVC */ 17316040 SPACE 2 17324040 SETLOCK RELEASE,TYPE=LOCAL,RELATED=('FREED OVER SVC 61') 17332040 SPACE 2 17350040 */* P SET R1 (VIA WKDCBSE) =COMP DCB ADDR FOR TEST SVC */ 17358040 */* $ */ 17366040 */* COMMENT (5,3) TSO INTERFACE---*/ 17374040 */* COMMENT (6,3) R1=COMP DCB ADDR*/ 17382040 */* COMMENT (7,3) R3=CVT ADDR*/ 17400040 */* COMMENT (8,3) R4=TCB ADDR*/ 17408040 */* COMMENT (9,3) R5=SVRB ADDR*/ 17416040 */* COMMENT (10,3) SVRB+X'74'=FETWK ADDR*/ 17424040 */* COMMENT (11,3) WKCDADDR=RQSTD CDE ADDR*/ 17432040 */* COMMENT (12,3) WKNAME=RQSTD NAME*/ 17450040 */* L SVC 61 (TEST)-- CALL TSO TEST SVC */ 17458040 SPACE 2 17466040 L R1,WKDCBSE PICK UP DCB ADDR FROM FETCH WORK 17474040 * AREA . DCB ADDR IS IN IOB . 17482040 * IKJEGS6A CNTSUP,PARAM=(1) CALL SVC 61-TSO TEST 17500040 LNR R1,R1 17510040 SVC TTSAVE CALL TEST SVC 17520040 SPACE 2 17527040 */* S RERIG:SET ENVIRONMENT INCL. FRR AND LOCAL LOCK */ 17534040 SPACE 2 17550040 BAL SUBREG1,RERIG RELOAD REGS 11 & 12 17559040 SPACE 2 17568040 */*OKLAHOME: P TURN NIC (NOT-IN-CORE) BIT OFF IN MAJOR CDE */ 17577040 */* D (YES,ISLOAD,NO,) REQUEST FOR LOAD? (RBCDLOAD =1) */ 17586040 */* P SET NOT-FUNCTIONAL FLAG IN RQSTD CDE */ 17595040 SPACE 2 17604040 OKLAHOME NI CDATTRJ,MAX-CDNIC RESET NIC FLAG IN MAJOR. 17613040 TM RBCDFLGS,LOAD LOAD REQUEST. 17622040 BO ISLOAD BYPASS SETT'G NFN IF YES. 17631040 OI CDATTR,CDNFN SET NFN FLAG. 17650040 SPACE 2 17658040 */*ISLOAD: D (NO,CDFOLDUP,YES,) ALIAS REQUEST? (CDMIN =1 IN RQSTD 17666040 */*CDE)*/ 17674040 SPACE 2 17682040 ISLOAD TM CDATTR,CDMIN TEST IF ALIAS HANDLING CURRENT 17700040 BNO CDFOLDUP NO, BRANCH 17710040 EJECT 17720040 *THE FUNCTION OF THE FOLLOWING ROUTINE IS TO COMPLETE THE CDENTRY 17727040 *CREATED FOR THE MAIN NAME OF THE MODULE JUST FETCHED. THE ENTRY POINT 17734040 *TO THE MAIN NAME MUST BE RELOCATED AND THE NOT IN CORE (NIC) FLAG 17750040 *RESET TO ZERO. 17758040 * 17766040 * IF A REQUEST IS MADE FOR A MODULE BY A MINOR NAME, AND THE 17774040 * MODULE MUST BE BROUGHT INTO CORE, THE MINOR ENTRY POINT IS 17782040 * RELOCATED BY FETCH. THE RLC BIT IS TURNED ON IN THE CDATTR2 17800040 * FIELD. THIS BIT IS NOT TURNED ON IF QLK RELOCATES THE MINOR 17808040 * ENTRY POINT IN THE CDFOLDUP SUBROUTINE. 17816040 * THE CDFOLDUP ROUTINE RELOCATES MINOR ENTRY POINTS IF THE 17824040 * MODULE WAS INITIALLY REQUESTED BY A DIFFERENT NAME. 17832040 * 17850040 * REGISTER USAGE 17860040 * R3 - ALTERED 17868040 * R6 - BASE (IEAVLK01) 17876040 * R7 - BLDL FETCH WORK AREA (INPUT) 17884040 * R11- REQUESTED CDE (INPUT) 17900040 * R12- MAJOR CDE (INPUT) 17909040 * R14- ALTERED 17918040 * OTHER REGISTERS NOT REFERENCED 17927040 SPACE 1 17936040 */* P SET R14= MAJOR ENTRY POINT */ 17945040 */* S RELOCATE:RELOCATE THE ENTRY POINT (R14= WKMAINEP)*/ 17954040 */* P PUT RELOCATED ENTRY POINT IN MAJOR CDE FIELD CDENTPT */ 17963040 */* P SET NIC (NOT-IN-CORE) BIT OFF IN RQSTD CDE */ 17972040 */* P SET RELOCATED ENTRY POINT BIT (CDRLC) ON IN RQSTD CDE */ 17981040 SPACE 2 17990040 L SUBREG1,WKMAINEP LOAD ENTRY POINT OF MAIN NAME 17999040 BAL COMREG,RELOCATE GO TO ROUTINE TO CALCULATE 18008040 * RELOCATED ENTRY POINT ADDRESS. 18017040 ST SUBREG1,CDENTPTJ STORE RELOCATED ENTRY POINT 18026040 * IN CDENTRY 18035040 NI CDATTR,MAX-CDNIC RESET NIC FLAG IN MINOR CDE 18044040 OI CDATTR2,CDRLC SET FLAG TO INDICATE RELOCATED 18053040 * MINOR BY FETCH. 18062040 EJECT 18071040 * RELOCATE ENTRY POINTS OF QUEUED MINORS. 18100040 * A MODULE IS REQUESTED BY A MINOR NAME. THE MAJOR NAME IS 18108040 * FOUND TO BE IN CORE BUT THE REQUESTOR IS WAITING ON I/O. 18116040 * THE REQUESTOR OF THE MINOR NAME IS QUEUED UP. WHEN THE MAJOR 18124040 * REQUESTOR REGAINS CONTROL, THE QUEUED MINOR CDE ENTRY POINTS 18132040 * ARE RELOCATED HERE, AND THE QUEUED REQUESTORS ARE DEQUEUED 18150040 * UNDER THE DQLOAD SUBROUTINE. 18158040 * 18166040 * REGISTER USAGE 18174040 * R1 - CHANGED 18182040 * R3 - CHANGED 18200040 * R5 - SVRB (INPUT) 18210040 * R6 - BASE (IEAVLK01) 18220040 * R9,10- CHANGED 18227040 * R12 - MAJOR CDE (INPUT) 18234040 * R15 - ALTERED 18250040 * OTHER REGISTERS NOT REFERENCED 18258040 SPACE 1 18266040 */*CDFOLDUP: P SET R1= MAJOR CDE ADDR (R1=R12) */ 18274040 SPACE 2 18282040 CDFOLDUP DS 0H QUEUED MINORS 18300040 DROP CDEREG RESET CDE BASE 18310040 USING CDENTRY,R1 RESET CDE BASE 18320040 LR R1,R12 LOAD MAJ CDE IN REG 1. 18327040 SPACE 2 18334040 */*CD02: P SET R1= NEXT CDE ON QUEUE (R1= CDCHAIN OF CDE VIA R1)*/ 18350040 */* D (YES,CD01,NO,) END OF QUEUE? (R1=0) */ 18358040 SPACE 2 18366040 CD02 DS 0H RELOCATE LOOP 18374040 L R1,CDCHAIN GET NEXT CDE ON QUEUE. 18382040 LTR R1,R1 TEST OF END OF QUEUE 18400040 * Q. END OF QUEUE. 18408040 BZ CD01 BR IF YES. 18416040 SPACE 2 18424040 */* D (NO,CD01,YES,) MINOR CDE? (CDMIN =1) */ 18432040 SPACE 2 18450040 TM CDATTR,CDMIN Q. IS CDE A MIN. 18458040 BZ CD01 BR IF NOT. 18466040 SPACE 2 18474040 */* D (YES,CD02,NO,) MINOR RELOCATED BY FETCH? (CDRLC =1)*/ 18482040 SPACE 2 18500040 TM CDATTR2,CDRLC Q.MINOR EP RELOC. BY FETCH 18508040 BO CD02 BR IF YES. 18516040 SPACE 2 18524040 */* P SET R14= UN-RELOCATED ENTRY POINT FROM CDENTPT*/ 18532040 */* S RELOCATE:RELOCATE THE ENTRY POINT */ 18550040 */* P TURN NIC (NOT-IN-CORE) BIT OFF IN CDE */ 18558040 */* P (,CD02) PUT RELOCATED ENTRY POINT IN CDE (CDENTPT = R14) */ 18566040 SPACE 2 18574040 L R14,CDENTPT GET UNRELOCATED E.P. 18582040 BAL COMREG,RELOCATE TO RELOCATE EP. 18600040 NI CDATTR,MAX-CDNIC RESET NIC FLAG IN MINOR CDE. 18608040 ST R14,CDENTPT SET RELOCATED EP IN MIN CDE. 18616040 B CD02 LOOP TO PROCESS ALL MINORS 18624040 DROP R1 RESET CDE BASE 18632040 USING CDENTRY,CDEREG RESET CDE BASE 18650040 SPACE 2 18658040 */*CD01: P CLEAR QUEUE HEAD FIELD (CDRRBP) OF MAJOR CDE*/ 18666040 */* P INITIALIZE R9 FOR DQLOAD (R9=ADDR. OF SVRB) */ 18674040 */* S DQLOAD:DEQUEUE ANY WAITING REQUESTS */ 18682040 SPACE 2 18700040 CD01 DS 0H END OF CDES 18708040 SR WKREG2,WKREG2 ZERO TO INITIALIZE A FIELD 18716040 ST WKREG2,CDRBPJ ZERO OUT QUEUE HEAD 18724040 * PRIOR TO DQLOAD 18732040 LR GR9,RBREG SET REGISTER FOR DQLOAD 18750040 BAL SUBREG2,DQLOAD GO DEQUEUE ALL REQUESTERS 18758040 SPACE 2 18766040 */*CDMRGRET: P SET BASEREG (R6) FOR IEAVLK00 */ 18774040 */* R RETURN TO CDMERGE IN IEAVLK00 */ 18782040 SPACE 2 18800040 CDMRGRET L GR15,TABLEADD POINT TO ADDRESS TABLE 18808040 USING ADDRTAB,GR15 ADDRESSABILITY ON ADDRESS LIST 18816040 L BASEREG,CDLKBASE SET UO VLK00 ADDRESSABILITY 18824040 L GR15,CDEMERGE POINT TO CDEMERGE 18832040 BR GR15 GO TO CDEMERGE IN VLK00 18850040 EJECT 18858040 ***** DQLOAD SUBROUTINE ************************************* 18866040 * 18874040 * THIS SECTION IS EXECUTED AFTER A MODULE HAS BEEN FETCHED . IT WILL 18882040 * CHECK IF A QUEUE HAS FORMED WHILE THE MODULE WAS BEING FETCHED, AND 18900040 * IF SO WILL EMPTY THE QUEUE BY MAKING ALL RB'S READY AND STORE INTO 18908040 * THE RBOPSW LOCATION THE ADDRESS OF CDCONTRL. A TEST OF PRIORITIES 18916040 * IS MADE TO DETERMINE IF ANY QUEUE'D RB HAS A TASK PRIORITY HIGHER 18924040 * THAN THE CURRENT, IF SO CONTROL WILL SUBSEQUENTLY BE RELINQUISHED 18932040 * TO THE HIGHER PRIORITY TASK. 18950040 * 18958040 * DQLOAD GETS INFORMATION STORED INTO THE CDE BY THE CDQUECTL 18966040 * SUBROUTINE. 18974040 * 18982040 * NOTE - IT IS THE RESPONSIBILITY OF THE CALLER OF THIS 19000040 * SUBROUTINE TO ZERO OUT THE QUEUE HEAD OF THE WAIT 19008040 * QUEUE. THE QUEUE STARTS AT THE CDE (CDRBP FIELD). 19016040 * 19024040 * REGISTER USAGE 19032040 * R3 - CVT OR LEFT AS ON INPUT (OUTPUT) 19050040 * R5 - SVRB (INPUT) 19058040 * R6 - BASE (IEAVLK01) 19066040 * R9 - INPUT RB (ALTERED ON OUTPUT) 19074040 * R10 - ALTERED 19082040 * R11 - REQUESTED CDE (INPUT) 19100040 * R14 - ALTERED 19108040 * R15 - RETURN ADDRESS (INPUT) 19116040 * OTHER REGISTERS NOT REFERENCED 19124040 SPACE 1 19132040 */*DQLOAD: E DQLOAD */ 19150040 */* P SAVE CDE ADDRESS (R11) IN RBCSGR0 */ 19158040 */* P SAVE CALLERS RETURN ADDRESS (R15) IN RBCSR15 */ 19166040 */* CARRYON: P GET ADDR OF RB TO BE DEQUEUED (R10= RBPGMQ OF RB VIA R9) 19174040 */* */ 19182040 */* D (YES,,NO,PACOUT) ANY RBS TO BE DEQUEUED (R10 NOT 0)*/ 19200040 SPACE 2 19208040 DQLOAD ST CDEREG,RBCSGR0 PRESERVE CDE ADDR OVER INTERFACE 19216040 ST R15,RBCSGR15 SAVE RETURN ADDR. 19224040 CARRYON ICM NEXT,MASK4,RBPGMQZ(LAST) LAST = ADDR OF INPUT RB 19232040 * TO BE DEQUEUED 19250040 * Q. ANY RB'S Q'D OFF INPUT RB 19258040 BZ PACOUT A= NO TAKE BRANCH 19266040 SPACE 2 19274040 */* P CLEAR RBPGMQ FIELD OF RB VIA R9 */ 19282040 */* P SET R9=R10*/ 19300040 */* P PUT ADDRESS OF RESTART ROUTINE (IEAQCS02) IN RESUME PSW OF RB VIA 19308040 */* R9 */ 19316040 */* P INITIALIZE FOR POST W/O ECB- R10=RB ADDR, R11=0, R14= RETURN 19324040 */*ADDR*/ 19332040 SPACE 2 19350040 XC RBPGMQ1Z(ADDL,LAST),RBPGMQ1Z(LAST) A= YES CLEAR RBPGMQ 19360040 LR LAST,NEXT SAVE REG 10 OVER ROUTINE 19368040 MVC RBOPSWZR(WORD,LAST),CONTRLA SET UP ADDR IN PSW 19376040 SR GR11,GR11 INDICATE PRESENT ADDRESS SPACE 19384040 SPACE 2 19400040 */* L POST W/O ECB (BR ENTRY)-- POST THE WAITING RB */ 19410040 SPACE 2 19418040 L CVTREG,CVTPTR INSURE CVT IN REG. 19426040 L R15,CVT0PT01 GET ADDRESS OF POST 19434040 BALR R14,R15 GO TO POST W/O ECB 19450040 SPACE 2 19458040 */* P (,CARRYON) CLEAR CDE POINTER IN POSTED RB (SET RBCDE1 =0)*/ 19466040 SPACE 2 19474040 XC RBCDEAZ(ADDL,LAST),RBCDEAZ(LAST) ZERO RBCDE 19482040 B CARRYON RETRY TEST FOR MORE 19500040 * RB'S ON THE QUEUE 19508040 SPACE 2 19516040 */*PACOUT: P RESTORE CDE REGISTER (R11) FROM RBCSGR0*/ 19524040 */* P RESTORE CALLERS RETURN ADDRESS (R15) FROM RBCSGR15*/ 19532040 */* R RETURN TO CALLER VIA R15*/ 19550040 SPACE 2 19558040 PACOUT L CDEREG,RBCSGR0 RESTORE CDEREG 19566040 L R15,RBCSGR15 RESTORE RETURN ADDRESS 19574040 BR SUBREG2 RETURN 19582040 EJECT 19600040 *REGISTERS 4,5,11,12, ARE INITIALIZED IN THIS ROUTINE TO 19610040 * 4 = TCB 19620040 * 5 = RB THIS ROUTINE IS USED TO RESTORE REGISTERS 19630040 * 11= MINOR CDE THAT ARE CHANGED OVER BLDL AND FETCH 19640040 * 12= MAJOR CDE 19650040 * 6 = BASE (IEAVLK01) 19658040 * 2,13= ALTERED 19666040 * 14= RETURN REGISTER (INPUT) 19674040 * OTHER REGISTERS NOT USED 19682040 SPACE 1 19700040 */*RERIG: E RERIG */ 19710040 */* P SET TCBREG (R4) =ADDR OF TCB VIA PSATOLD*/ 19720040 */* P SET RBREG (R5) = ADDR OF SVRB VIA TCBRBP*/ 19727040 SPACE 2 19734040 RERIG L TCBREG,PSATOLD LOAD ADDRESS OF CURRENT TCB 19750040 L RBREG,TCBRBP LOAD ADDRESS OF CURRENT RB 19760040 SPACE 2 19770040 */* P SAVE RETURN ADDRESS (SET R2=R14)*/ 19777040 */* L SETLOCK-- GET LOCAL LOCK */ 19784040 SPACE 2 19800040 LR WKREG2,SUBREG1 SAVE RETURN REGISTER 19810040 SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND, x19818040 RELATED=('OBTAINS LOCK AFTER FETCH OR SVC 61') 19826040 SPACE 2 19834040 */* L SETFRR-- ESTABLISH RECOVERY ROUTINE */ 19842040 */* P SET RBCSFRRA = ADDR OF FRR PARM LIST*/ 19860040 */* P SET 1ST WORD OF FRR PARM LIST = PM SVRB ADDR*/ 19868040 */* P RESTORE RETURN ADDRESS (SET R14=R2)*/ 19876040 SPACE 2 19884040 SETFRR A,FRRAD=FRRPGM,WRKREGS=(11,12),PARMAD=(13) 19904040 ST R13,RBCSFRRA SAVE PARM. LIST ADDRESS 19910040 ST RBREG,N0(R13) SAVE CURRENT RB (SVRB) 19919040 LR SUBREG1,WKREG2 RESTORE RETURN REGSITER 19928040 SPACE 2 19937040 */* P SET CDEREG = ADDR OF RQSTD CDE (R11= RBCDE1)*/ 19946040 */* P SET CDIREG = ADDR OF RQSTED CDE (R12=R11)*/ 19955040 */* D (YES,,NO,%XOUT) RQSTD CDE A MINOR (CDMIN =1)*/ 19964040 */* P SET R12= ADDR OF MAJOR CDE VIA CDXLMJP OF MINOR*/ 19973040 */* %XOUT: R RETURN TO CALLER */ 19982040 SPACE 2 20000040 L CDEREG,RBCDFLGS PICK UP CDENTRY ADDRESS 20008040 LA CDEREG,N0(CDEREG) CLEAR CDE FLAGS 20016040 LR CDIREG,CDEREG SET MAJOR EQUAL MINOR 20024040 TM CDATTR,CDMIN Q.IS AN ALIAS REQUEST CURRENT 20032040 BCR EQZER,SUBREG1 A=NO, RETURN 20050040 L CDIREG,CDXLMJP PICK UP MAJOR CDE ADDRESS 20058040 BR SUBREG1 RETURN 20066040 EJECT 20074040 *RELOCATE SUBROUTINE TAKES AN ENTRY POINT TO A MODULE THAT HAS PREVIOU 20082040 *SLY BEEN FETCHED AND ADDS A RELOCATION FACTOR TO PRODUCE A RELOCATED 20100040 *ENTRY POINT. 20108040 * 20116040 * REGISTER USAGE 20124040 * R3 - RETURN REGISTER (INPUT) 20132040 * R12 - MAJOR CDE (INPUT) 20150040 * R14 - ENTRY POINT (UNRELOCATED ON INPUT, 20158040 * RELOCATED ON OUTPUT) 20166040 * R15 - ALTERED 20174040 * OTHER REGISTERS NOT REFERENCED 20182040 SPACE 1 20200040 */*RELOCATE: E RELOCATE */ 20208040 */* P GET EXTENT LIST ADDRESS FROM CDXLMJP OF MAJOR*/ 20216040 */* P SET R14= RELOCATED EP (R14= UNRELOCATD EP + LOAD ADDR IN XL*/ 20224040 */* R RETURN TO CALLER VIA R3 */ 20232040 SPACE 2 20250040 RELOCATE EQU * 20258040 L SUBREG2,CDXLMJPJ PICK UP XTLIST ADDRESS 20266040 LA SUBREG1,N0(SUBREG1) ZERO HI ORDER BYTE 20274040 A SUBREG1,N12(SUBREG2) ADD RELOCATION FACTOR TO ADDR 20282040 BR COMREG RETURN 20300040 EJECT 20308040 *THIS ROUTINE ADDS THE CDENTRY ADDRESSED BY CDEREG TO THE CONTROL QUEUE 20316040 *ADDRESSED BY TABREG. THE ADDITION IS DONE IN A PUSH-DOWN FASHION. 20324040 * 20332040 * REGISTER USAGE 20350040 * R4,5 - TCB,SVRB (INPUT) 20360040 * R8 - ALTERED 20370040 * R11 - INPUT CDE 20377040 * R14 - RETURN ADDRESS (INPUT) 20384040 * OTHER REGISTERS NOT REFERENCED 20400040 SPACE 1 20408040 */*CDEADD: E CDEADD */ 20416040 */* P SET R8= JOB STEP TCB ADDR FROM TCBJSTCB*/ 20424040 */* P CHAIN CURRENT 1ST CDE BEHIND NEW CDE (SET CDCHAIN = TCBJPA)*/ 20432040 */* P PUT NEW CDE POINTER INTO TCBJPA*/ 20440040 */* P SET RBCDE1 = ADDR OF NEW CDE*/ 20448040 */* P SET CDRRBP OF NEW CDE = ADDR OF PM SVRB*/ 20470040 */* R RETURN TO CALLER VIA R14 */ 20480040 SPACE 2 20486040 CDEADD EQU * 20500040 L TABREG,TCBJSTCB LOAD JOB STEP TCB ADDR. 20508040 MVC CDCHAIN+N1(ADDL),TCBJSEZ+N1(TABREG) INITIALIZE CDCHAIN 20516040 STCM CDEREG,MASK,TCBJSEZ+N1(TABREG) MOVE IN LISTORG CDE ADDR. 20524040 STCM CDEREG,MASK,RBCDEA MOVE INTO RB CDE ADDRESS 20532040 ST RBREG,CDRRBP INITIALIZE CDRBP 20550040 BR SUBREG1 RETURN 20558040 EJECT 20566040 * 20574040 * REGISTER USAGE 20582040 * R0,1,2 - ALTERED 20600040 * R4 - TCB (INPUT) 20610040 * R6 - BASE(IEAVLK01) 20620040 * R11- - INPUT CDE 20627040 * R13,14,15- ALTERED 20634040 * OTHER REGISTERS NOT REFERENCED 20650040 * 20658040 SPACE 1 20666040 */*RETHRED: E RETHRED */ 20674040 */* P SET R1= ADDR OF JPAQ HEADER*/ 20682040 */*STARLITE: P SET R2= ADDR OF 1ST/NEXT CDE*/ 20700040 */* D (NO,THREDEND,YES,) ARE THERE MORE CDES ? */ 20708040 */* D (YES,THREDOUT,NO,STARLITE) IS THIS THE CDE TO UNHOOK? */ 20716040 RETHRED L WKREG1,TCBJSTCB LOAD ADDR OF JOB STEP TCB 20724040 LA WKREG1,TCBJSEZ(WKREG1) PICK UP LIST ORG OF JPACQ 20732040 STARLITE SR WKREG2,WKREG2 CLEAR WORK REG @ZA03896 20750040 ICM WKREG2,MASK,N1(WKREG1) GET NEXT CDE @ZA03896 20760040 BZ THREDEND NO RETURN TO CALLER @ZA03896 20770040 CLM CDEREG,MASK,N1(WKREG1) Q. IS THE THE CDE TO UNHOOK 20777040 BE THREDOUT A=YES, TAKE BRANCH 20784040 LR WKREG1,WKREG2 GO TO NEXT CDE 20800040 B STARLITE CONTINUE IN LOOP 20810040 SPACE 2 20820040 */*THREDOUT: P UNHOOK CDE FROM JPA QUEUE */ 20827040 */* P SAVE R9 IN R0 & R10 IN R1*/ 20834040 */* P ZERO RB WAITING QUEUE HEADER (SET CDRRBP =0) */ 20850040 */* P SET R9= ADDR OF PM SVRB FOR DQLOAD*/ 20860040 */* S DQLOAD:DEQUEUE ALL WAITING RB'S */ 20868040 */* P RESTORE R9 FROM R0 AND R10 FROM R1*/ 20876040 */* THREDEND: R RETURN TO CALLER VIA R13 */ 20884040 SPACE 2 20892040 THREDOUT MVC N1(ADDL,WKREG1),N1(WKREG2) UNHOOK CDE FROM JPACQ 20910040 LR R0,NAMEREG SAVE NAMRREG 20920040 LR R1,DCBREG SAVE DCBREG 20930040 SR WKREG2,WKREG2 ZERO TO INITIALIZE A FIELD 20937040 ST WKREG2,CDRRBP ZERO QUEUE HEAD BEFORE 20944040 * GOING TO DQLOAD 20960040 LR NAMEREG,RBREG SET INPUT TO DQLOAD 20969040 BAL SUBREG2,DQLOAD DQ ANY Q'D REQUESTS 20978040 LR DCBREG,R1 RESTORE DCBREG 20987040 LR NAMEREG,R0 RESTORE NAMEREG 20996040 THREDEND BR R13 RETURN 21005040 EJECT 21014040 * 21023040 * REGISTER USAGE 21032040 * R13 - ABEND CODE (ZERO ON INPUT) 21050040 * R15 - REASON CODE IF 106 OR 806 ABEND 21058040 * R6 - BASE ADDRESS 21066040 * OTHER REGISTERS NOT REFERENCED 21074040 SPACE 1 21082040 */*ERRBLDL: P ADD 1 TO R13 MAKES 806 ABEND CODE */ 21100040 */*ERRXCUTE: P ADD 3 TO R13 MAKES 706 ABEND CODE */ 21110040 */*ERRLONLY: P ADD 1 TO R13 MAKES 406 ABEND CODE */ 21120040 */*ERRSYSR: P ADD 2 TO R13 MAKES 306 ABEND CODE */ 21127040 */*ERRFETCH: P ADD 1 TO R13 MAKES 106 ABEND */ 21134040 */* D (YES,,NO,ERRRTN) ERRET SPECIFIED (RBCSERIN =1)*/ 21150040 */* P SAVE REGS R13 AND R15 IN R7 AND R8*/ 21158040 */* S RETHRED: DEQUEUE RQSTD CDE FROM JPAQ*/ 21166040 */* D (YES,,NO,ERRDQDON) WERE 2 CDES GOTTEN (RBCSTWO =1)*/ 21174040 */* P SET R11= ADDR OF 2ND (MAJOR) CDE (SET R11=R12)*/ 21182040 */* S RETHRED: DEQUEUE MAJOR CDE FROM JPAQ*/ 21200040 */*ERRDQDON: P (,ERRRTN) RESTORE R13 AND R15 FROM R7 AND R8*/ 21208040 */*ERRRTN: P SET BASEREG (R6) FOR MODULE IEAVLK00*/ 21216040 */* R RETURN TO ABNDSET IN IEAVLK00 */ 21224040 ERRBLDL LA R13,N1(R13) CODE = 806 21232040 ERRXCUTE LA R13,N3(R13) CODE = 706 21250040 ERRLONLY LA R13,N1(R13) CODE = 406 21258040 ERRSYSR LA R13,N2(R13) CODE = 306 21266040 ERRFETCH LA R13,N1(R13) CODE = 106 21274040 TM RBCSFLG1,RBCSERIN ERROR RETURN REQUESTED @YA01851 21282040 BZ ERRRTN SKIP CLEANUP IF NO @YA01851 21300040 TM CDATTR,CDNIP IS IT LPA/MLPA MODULE @ZA20311 21302040 BO ERRRTN YES THEN WONT RETHRED @ZA20311 21304040 STM R13,R15,WKREGIS SAVE ABEND/REASON CODES @ZA20311 21306040 BAL R13,RETHRED DEQUE REQUESTED CDE @YA01851 21327040 L R7,PSAAOLD ASCB ADDR FOR FREEMAIN @ZA20311 21328040 TM CDATTR,CDMIN IS IT A MINOR CDE @ZA20311 21329040 BZ FREEXLST NO FREE XLST AND MAJOR @ZA20311 21330040 FREEMAIN RU,LV=CDESIZE,SP=255,A=(R11),BRANCH=YES @ZA20311 21331040 TM RBCSFLG1,RBCSTWO WAS THERE 2 NEW CDES @YA01851 21334040 BZ ERRDQDON TO ERRDQDON IF NO @YA01851 21350040 LR R11,R12 SET R11 TO NEW MAJOR @YA01851 21360040 BAL R13,RETHRED DEQUEUE NEW MAJOR CDE @YA01851 21368040 FREEXLST SR R1,R1 CLEAR REGISTER FOR ICM @ZA20311 21369040 ICM R1,MASK,CDXLMJP+N1 GET XLIST ADDRESS @ZA20311 21369140 BZ FREECDE NO THEN FREE THE CDE @ZA20311 21369440 USING XTLST,R1 SET UP ADDRESSABILITY @ZA20311 21369540 L R0,XTLLNTH GET XLIST SIZE @ZA20311 21370040 DROP R1 RELEASE THE REGISTER @ZA20311 21370340 FREEMAIN RU,LV=(R0),SP=255,A=(R1),BRANCH=YES @ZA20311 21371040 FREECDE DS 0H LABEL FOR BRANCH @ZA20311 21371540 FREEMAIN RU,LV=CDESIZE,SP=255,A=(R11),BRANCH=YES @ZA20311 21372040 ERRDQDON L AREAREG,RBCSWORK RESTORE WORKREG FOR LM @ZA28886 21372540 LM R13,R15,WKREGIS RESET ABEND/REASON CODES@ZA28886 21381540 ERRRTN L RETURN,TABLEADD GET ADDR LIST IN VLK00 @YA01851 21400040 DROP GR15 MUST NOT USE REG 15 FOR TABLE 21408040 * BECAUSE IT CONTAINS REASON CODE 21416040 USING ADDRTAB,RETURN SET UP ADDRESSABILITY TO VLK00 21424040 L BASEREG,CDLKBASE SET UP VLK00 ADDRESSABILITY 21432040 L RETURN,ABNDSET POINT TO ABNDSET 21450040 BR RETURN GO TO IT 21458040 SPACE 2 21466040 */* FOOTING 21474040 */* 21482040 */* */ 21500040 */*IEAVLK01: END END SECOND OF TWO MODULES */ 21508040 EJECT 21516040 * 21524040 * EXECUTED INSTRUCTION 21532040 * 21550040 TESTAPF OC PDSAPFAC-PDSAPF(ZERO,R14),PDSAPFAC-PDSAPF(R14) TEST APF 21558040 * 21566040 * ADDRESS CONSTANTS 21574040 * 21582040 TABLEADD DC A(IEAQCS04) POINTS TO ADDRESS TABLE 21600040 LINKBASE DC A(IEAVLK01) USED TO SET CORRECT BASE 21608040 * FOR ADDRESSIBILITY 21616040 IEAQLCTA DC A(IEAQLPAQ) ADDRESS OF LINK PACK AREA 21624040 * CONTROL QUEUE . ALSO IN CVT 21632040 SVCDCBA DC A(SVCDCB) ADDRESS OF SVC LIB DCB 21650040 LINKDCBA DC A(LINKDCB) ADDRESS OF LINK LIB DCB 21660040 CONTRLA DC A(IEAQCS02) ADDRESS OF LINK MAINLINE 21668040 * 21676040 * MASKS AND CONSTANTS 21684040 * 21700040 APFROUND DC X'FFFFFFFE' ROUND TO HALFWORD AND-MASK 21710040 BLDLMASK DC X'0001003C' USED FOR BLDL WORK MASK 21720040 FRRPGM DC A(FRRPGMMG) ADDRESS OF RECOVERY FOR PGM.MGR. 21727040 EJECT 21734040 ADDRTAB DSECT MAPS ADRESS LIST IN IEAVLK00 21750040 CDLKBASE DS A BASE VALUE 21758040 CDCONTRL DS A QUEUE SEARCHES 21766040 CDEMERGE DS A FINAL PROCESSING 21774040 CDQUECTL DS A QUEUED REQUEST 21782040 PLUSCONT DS A TEST CDE ATTRIBUTES 21800040 ABNDSET DS A ISSUE ABENDS 21808040 EJECT 21816040 IHACDE 21824040 CDEEND EQU * 21832040 CDESIZE EQU CDEEND-CDENTRY SIZE OF CDE 21850040 CDATTR2Z EQU CDATTR2-CDENTRY OFFSET TO ATTRIBUTES 21858040 CDXLIN EQU CDESIZE+XTLSTSIZ CDE AND EXTENT LIST SIZE 21866040 EJECT 21874040 CDENTRYJ DSECT 21882040 DS (CDESIZE)C 21900040 CDATTRJ EQU CDENTRYJ+CDATTR-CDENTRY MAJOR CDE DSECT 21910040 CDCHAINJ EQU CDENTRYJ+CDCHAIN-CDENTRY TO INCREASE 21920040 CDRBPJ EQU CDENTRYJ+CDRRBP-CDENTRY OF THE 21927040 CDNAMEJ EQU CDENTRYJ+CDNAME-CDENTRY CODE 21934040 CDUSEJ EQU CDENTRYJ+CDUSE-CDENTRY WHILE MAINTAINING 21950040 CDENTPTJ EQU CDENTRYJ+CDENTPT-CDENTRY DEPENDANCY 21960040 CDATTR2J EQU CDENTRYJ+CDATTR2-CDENTRY ON THE 21970040 CDXLMJPJ EQU CDENTRYJ+CDXLMJP-CDENTRY MACRO 21977040 EJECT 21984040 IHAXTLST EXTENT LIST MAPPING @ZA20311 21985040 EJECT @ZA20311 21986040 IHADCB DCB MAPPING MACRO @ZA18512 21989040 EJECT @ZA18512 21994040 IEZDEB 22000040 EJECT 22008040 IHAFETWK 22016040 EJECT 22024040 IHAFRRS 22032040 EJECT 22050040 IHALPDE 22058040 LPDEEND EQU * END OF LPDE DSECT 22066040 LPDCDE EQU CDESIZE LPDE CDE LENGTH 22074040 LPDEJ DSECT 22082040 DS (LPDEEND-LPDE)C 22100040 LDATTRJ EQU LPDEJ+CDATTR-CDENTRY MAJOR LPDE DSECT 22110040 LDCHAINJ EQU LPDEJ+CDCHAIN-CDENTRY TO INCREASE 22120040 LDRBPJ EQU LPDEJ+CDRRBP-CDENTRY OF THE 22127040 LDNAMEJ EQU LPDEJ+CDNAME-CDENTRY CODE 22134040 LDUSEJ EQU LPDEJ+CDUSE-CDENTRY WHILE MAINTAINING 22150040 LDENTPTJ EQU LPDEJ+CDENTPT-CDENTRY DEPENDANCY 22158040 LDATTR2J EQU LPDEJ+CDATTR2-CDENTRY ON THE 22166040 LDXLMJPJ EQU LPDEJ+CDXLMJP-CDENTRY MACRO 22174040 LDXTLTHJ EQU LPDEJ+LPDEXTLN-LPDE 22182040 LDXLEPTJ EQU LPDEJ+LPDEXTAD-LPDE 22200040 EJECT 22208040 IHARB 22216040 *********************************************************************** 22224040 * * 22232040 * REQUEST BLOCK ADDITIONAL LABELS INTERNAL * 22250040 * * 22260040 *********************************************************************** 22270040 ORG RBEXSAVE MAPPED INTO RBEXSAVE 22277040 RBCSEXSA EQU * PROGRAM MANAGER USAGE OF 22284040 * RB EXTENDED SAVE AREA FOR 22300040 * REENTRANT DATA AREA 22307040 RBCSNAME DS CL8 ENTRY POINT NAME CALLER PASSED 22314040 RBCSDE DS 0A ADDRESS OF DE SAVE AREA 22330040 DS C BYTE RESERVED 22337040 RBCSDEA DS AL3 3 BYTE ADDRESS 22344040 RBCSERRA DS F ADDRESS OF ERROR ROUTINE 22360040 RBCSFLG1 DS B FLAG BYTE 22368040 RBCSGSF EQU X'80' GOOD SEARCH INDICATOR 22376040 * ON MEANS IEAVVMSR WAS 22384040 * SUCCESSFUL USED ONLY 22392040 * IN IEAVLK01 22410040 RBCSSYSR EQU X'40' SYSTEM REQUEST FLAG 22420040 RBCSPARM EQU X'20' PARMATER CHECKING IN PROGRESS 22427040 RBCSERIN EQU X'10' ERROR RETURN WAS REQUESTED 22434040 RBCSABEN EQU X'08' ISSUE 906 ABEND 22450040 RBCSA306 EQU X'04' ISSUE 306 ABEND 22459040 RBCSTWO EQU X'02' TWO NEW CDES @YA01851 22468040 RBCRSAPF EQU X'01' RESET APF AUTH @WAB 22472040 RBCSFLG2 DS B RESERVED FLAGS 22477040 RBCSFLG3 DS B RESERVED FLAGS 22486040 RBCSFLG4 DS B RESERVED FLAGS 22495040 RBCSWORK DS 0A ADDRESS OF BLDL FETCH W.A. 22504040 DS C RESERVED BYTE 22513040 RBCSWRKA DS AL3 3 BYTE ADDRESS 22522040 RBCSLLE DS 0A ADDRESS OF LLE DURING LOAD 22531040 DS C RESERVED BYTE 22540040 RBCSLLEA DS AL3 3 BYTE ADDRESS 22549040 RBCSFRRA DS F SAVE AREA FOR RECOVERY RTN. 22558040 * PARM LIST 22567040 RBCSGR15 DS F SAVE AREA FOR REGS 15 TO 1 22576040 RBCSGR0 DS F OVER MODESET MACRO 22585040 RBCSGR1 DS F INTERFACE 22594040 RBCSRESV DS 2F 3 WORDS OF 12 IN WORK SAVE AREA 22603040 * RESERVED FOR FUTURE EXPANSION 22612040 PRBSIZ EQU PRBEND-RBSECT SIZE OF A PRB 22621040 * FLAG SETTINGS FOR RBCDFLGS 22630040 LOAD EQU RBCDLOAD ENTRY BY SVC LOAD 22639040 XCTL EQU RBCDXCTL ENTRY BY SVC XCTL 22648040 SYNC EQU RBCDSYNC ENTRY BY SVC SYNC 22657040 NODE EQU RBCDNODE DO NOT GET A DE SAVE AREA FLAG 22666040 PRBPREF EQU RBPRFXND-RBPRFXST LENGTH OF RB PREFIX 22675040 RBXXDSP EQU RBOPSW+4 USED FOR DISP PRIO IN CTL 22684040 RBCDEA EQU RBCDFLGS+1 EXTRA OFFSET 22693040 RBLINKA EQU RBWCF+1 EXTRA OFFSET 22702040 SPACE 3 22711040 * THE FOLLOWING CODE WAS ADDED FOR AOS2 TO MAKE ALL CODE 22720040 * DEPENDANT ON THE RB DSECT SUPPLIED BY THE OFFICIAL MACRO 22729040 * THE ORIGINAL EQUATES FOR THE NAMES WERE DELETED 22738040 * AND THE PRB DSECT CHANGED 22747040 SPACE 3 22756040 RBSTABZ EQU RBSTAB-RBSECT ALTERNATE 22765040 RBCDEZ EQU RBCDFLGS-RBSECT ALTERNATE 22774040 RBOPSWZ EQU RBOPSW-RBSECT ALTERNATE 22783040 RBPGMQZ EQU RBPGMQ-RBSECT ALTERNATE 22792040 RBLINKZ EQU RBWCF-RBSECT ALTERNATE 22801040 RBWCFZ EQU RBWCF-RBSECT ALTERNATE 22810040 RBCDEAZ EQU RBCDFLGS-RBSECT+1 CDE ADDRESS IN RB 22819040 RBXXDSPZ EQU RBOPSWZ+4 USED FOR DISP PRIO 22828040 RBLINKAZ EQU RBWCF-RBSECT+1 ALTERNATE 22837040 RBOPSWZR EQU RBOPSWZ+4 ALTERNATE 22846040 RBSTAB2Z EQU RBSTAB2-RBSECT ALTERNATE 22900040 RBPGMQ1Z EQU RBPGMQ1-RBSECT ALTERNATE 22908040 EJECT 22916040 *********************************************************************** 22924040 * * 22932040 * PDS DIRECTORY ENTRY * 22950040 * * 22958040 *********************************************************************** 22966040 IHAPDS 22974040 DEMAX EQU PDSBCLN+PDSS01LN+PDSS02LN+PDSS03LN+PDSS04LN MAX DE SIZE 22982040 EJECT 23000040 DESAVE DSECT MAPPING OF DE SAVE AREA 23008040 DESAVESZ DS F SAVE AREA FOR DE SIZE 23016040 DESAVEDE DS 15F 60 BYTES DE SAVE AREA 23024040 EJECT 23032040 *********************************************************************** 23050040 * * 23058040 * TASK CONTROL BLOCK * 23066040 * * 23074040 *********************************************************************** 23082040 IKJTCB 23100040 TCBJLBDI EQU TCBJLB-TCB DISPLACEMENT IN TCB OF DCB ADR. 23108040 TCBMOTH EQU TCBOTC-TCB DISPLACEMENT IN TCB OF MOTHER 23116040 TCBJSEZ EQU TCBJPQ-TCB OFFSET TO JPAQ 23124040 TASKLIB EQU TCBJLB-TCB TASKLIB DCB FIELD IN TCB 23132040 TASKSTEP EQU TCBJSTCA-TCB EQUATE FOR JSTCB 23150040 EJECT 23158040 IEZJSCB 23166040 EJECT 23174040 CVT DSECT=YES,PREFIX=NO 23182040 EJECT 23200040 IHAASCB 23208040 EJECT 23216040 IHAPSA 23224040 END 23232040