TITLE 'IEAVENQ1 - ENQ/DEQ/RESERVE' 00030502 IGC048 CSECT 00030702 * /* START OF SPECIFICATIONS **** 00031003 * 00033502 *01* MODULE-NAME = IEAVENQ1 00034002 * 00034502 *02* CSECT-NAME = IGC048 00035002 * 00035502 *01* DESCRIPTIVE-NAME = ENQ/DEQ/RESERVE 00036002 * 00036502 *01* COPYRIGHT = NONE 00037002 * 00037502 *01* STATUS = 0 00038002 * 00038502 *01* FUNCTION 00039002 * 00039502 * THE ENQ/DEQ ROUTINE PERMITS THE SERIALIZATION OF ONE 00040002 * OR MORE NAMED RESOURCES. AS A MINOR FUNCTION, THIS 00040402 * ROUTINE MAY ALSO ESTABLISH A 'MUST COMPLETE' STATUS 00040802 * AFFECTING THE DISPATCHABILITY OF VARIOUS TASKS IN 00041202 * THE SYSTEM. THIS LATTER SERVICE IS AVAILABLE ONLY 00041602 * TO PROGRAMS WHICH RUN WITH A CONTROL PROGRAM KEY 00042002 * (I.E. KEY 0-7), SUPERVISOR STATE, OR AUTHORIZED 00042402 * (VIA APF). 00042802 * 00043502 * THE SHARED DASD FUNCTION IS SUPPORTED THROUGH THE 00043602 * USE OF RESERVE/DEQ. 00043702 * 00043802 * THE ENQ RESOURCE MANAGER (MANUAL PURGE) PERFORMS 00043902 * CLEAN-UP FUNCTION FOR END OF TASK, ADDRESS SPACE 00044102 * ABEND, AND OUT OF CORE ABEND. 00044302 * 00044502 *02* OPERATION = SEE METHOD OF OPERATION DIAGRAMS OR 00045002 * FLOWCHARTS 00045102 * 00045202 *01* NOTES = THE HEAD OF THE ENQ/DEQ RESOURCE QUEUE IS POINTED 00045502 * BY CVTFQCB AND ALL MAJOR QCBS, MINOR QCBS, AND QELS 00045702 * ARE FORWARD AND BACKWARD CHAINED. 00045902 * 00046102 *02* DEPENDENCIES = THIS MODULE DOES NOT CONTAIN ANY 00046502 * HARDWARE DEPENDENCIES. 00047002 * 00048002 * IN ORDER TO REDUCE SQA (SUBPOOL 245) @Z30BNVD 00048203 * FRAGMENTATION, NIP OBTAINS AND @Z30BNVD 00048503 * INITIALIZES A BLOCK OF STORAGE FOR @Z30BNVD 00048603 * ENQ/DEQ/RESERVE RESOURCE CONTROL @Z30BNVD 00048703 * BLOCKS. ADDITIONALLY, NIP WILL @Z30BNVD 00049003 * UPDATE THE RESPECTIVE QUEUE LIMIT @Z30BNVD 00049103 * COUNTS WITHIN THIS MODULE TO REFLECT @Z30BNVD 00049203 * THE NUMBER OF ELEMENTS IT HAS PLACED @Z30BNVD 00049303 * ON THESE QUEUES. THE LIMIT COUNTS @Z30BNVD 00049503 * ARE LOCATED AT ENTRY LABEL IEAVENQQ @Z30BNVD 00049703 * AND ARE A TOTAL OF 6 WORDS. NIP WILL @Z30BNVD 00050003 * ALSO INITIALIZE THE FOLLOWING DATA @Z30BNVD 00050103 * WITHIN THE ENQ/DEQ/RESERVE GLOBAL @Z30BNVD 00050203 * SAVE AREA (GS): @Z30BNVD 00050303 * - AT X'80', 6 WORDS DEFINING THE @Z30BNVD 00050403 * RESPECTIVE QUEUE ELEMENT @Z30BNVD 00050503 * COUNTS. @Z30BNVD 00050603 * - AT X'98', 6 WORDS DEFINING THE @Z30BNVD 00050703 * POINTERS TO THE RESPECTIVE @Z30BNVD 00050803 * QUEUE HEADS @Z30BNVD 00050903 * - AT X'B0', 1 WORD CONTAINING @Z30BNVD 00051003 * THE BEGINNING ADDRESS OF THE @Z30BNVD 00051103 * BLOCK @Z30BNVD 00051203 * - AT X'B4', 1 WORD CONTAINING @Z30BNVD 00051303 * THE ENDING ADDRESS OF THE @Z30BNVD 00051403 * BLOCK @Z30BNVD 00051503 *03* CHARACTER-CODE-DEPENDENCIES = THIS MODULE IS NOT 00051603 * CHARACTER CODE 00051703 * 00051803 *02* RESTRICTIONS = NONE 00052003 * 00052103 *02* REGISTER-CONVENTIONS = REFER TO 'REGISTER EQUATES' 00052203 * PORTION OF THIS MODULE. 00052303 * 00052403 *02* PATCH-LABEL = NONE WITHIN THIS MODULE. THE COMMON 00052502 * NUCLEUS MAINTENANCE AREA SHOULD BE 00052702 * USED (IEAPATCH). 00052902 * 00053102 *01* MODULE-TYPE = MODULE 00053502 * 00054002 *02* PROCESSOR = ASSEMBLER 00054502 * 00055002 *02* MODULE-SIZE = APPROXIMATELY 7500 BYTES 00055502 * 00056002 *02* ATTRIBUTES = TYPE 2 SVC, KEY 0, 00056502 * SUPERVISOR STATE, ENABLED 00057002 * 00057502 *01* ENTRY-POINT = IGC048 (DEQ) 00058002 * 00058502 *02* PURPOSE = THIS IS THE OTHER HALF OF THE ENQ/RESERVE 00059002 * FUNCTION. IT RELINQUISHES THE SERIALIZATION 00059502 * OBTAINED VIA ENQ/RESERVE. 00060002 * 00060502 *02* LINKAGE = VIA SVC INTERRUPT HANDLER (TYPE 2 SVC) 00061002 * 00061502 *02* INPUT = REGISTERS 00062002 * 0 - IRRELEVANT 00062502 * 1 - ADDRESS OF VARIABLE LENGTH 00063002 * PARAMETER ELEMENT LIST 00063502 * 2 - IRRELEVANT 00064002 * 3 - ADDRESS OF CVT 00064502 * 4 - ADDRESS OF CURRENT TCB 00065002 * 5 - ADDRESS OF CURRENT RB 00065502 * 6 - ENTRY POINT ADDRESS 00066002 * 7 - ADDRESS OF CURRENT ASCB 00066502 * 8-13 - IRRELEVANT 00067002 * 14 - EXIT ADDRESS 00067502 * 15 - IRRELEVANT 00068002 * 00068502 * PARAMETER ELEMENT LIST 00069002 * 00069502 * ********************************************** 00070002 * -4 * TCB POINTER OR DOES NOT EXIST * 00070502 * ********************************************** 00071002 * +0 * FLAGS1 * MINOR LENGTH * FLAGS2 * RET. CODE * 00071502 * ********************************************** 00072002 * +4 * ADDRESS OF MAJOR NAME * 00072502 * ********************************************** 00073002 * +8 * ADDRESS OF MINOR NAME * 00073502 * ********************************************** 00074002 * +12 * ADDRESS OF UCB ADDRESS OR DOES NOT EXIST * 00074502 * ********************************************** 00075002 * 00075502 * NOTE: NON-RESERVE ELEMENTS ARE 3 WORDS IN 00076002 * LENGTH, WHILE RESERVE ELEMENTS ARE 00076502 * 4 WORDS IN LENGTH. IN A MULTIPLE 00077002 * ELEMENT PARAMETER LIST, ELEMENTS ARE 00077502 * CONTIGUOUS STARTING AT OFFSET +0 00078002 * 00078502 * FLAGS1 BIT 0 - END OF LIST 00079002 * BIT 1 - IGNORE FOLLOWING BITS 00079502 * BIT 2 - RESERVED 00080002 * BIT 3 - IRRELEVANT (OUTPUT FROM ENQ) 00080502 * BIT 4 - RESERVED 00081002 * BIT 5 - RESERVED 00081502 * BIT 6 - GENERIC=YES SPECIFIED 00082002 * BIT 7 - TCB= SPECIFIED 00082502 * 00083002 * FLAGS2 BIT 0 - USED BY ENQ/RESERVE ONLY 00083502 * BIT 1 - SEE NOTE A 00084002 * BIT 2 - OBSOLETE PARAMETER 00084502 * (RMC=SYSTEM) 00085002 * BIT 3 - RMC=STEP SPECIFIED 00085502 * BIT 4 - SEE NOTE A 00086002 * BIT 5 - SEE NOTE B 00086502 * BIT 6 - SEE NOTE B 00087002 * BIT 7 - SEE NOTE B 00087502 * 00088002 * NOTE A 00 - SCOPE OF STEP 00088502 * 01 - UCB= SPECIFIED 00089002 * (SYSTEMS REQUIRED) 00089502 * 10 - SCOPE OF SYSTEM 00090002 * 11 - SCOPE OF SYSTEMS 00090502 * 00091002 * NOTE B 000 - RET=NONE SPECIFIED 00091502 * 001 - RET=HAVE SPECIFIED 00092002 * 010 - USED BY ENQ/RESERVED ONLY 00092502 * 011 - USED BY ENQ/RESERVED ONLY 00093002 * 100 - USED BY ENQ/RESERVED ONLY 00093502 * 101 - RESERVED 00094002 * 110 - RESERVED 00094502 * 111 - USED BY ENQ/RESERVE ONLY 00100002 * 00100502 *02* OUTPUT = ELEMENT(S) REMOVED FROM RESOURCE QUEUE AND 00101002 * MUST COMPLETE STATE REMOVED WHEN REQUESTED. 00101502 * 00102002 * REGISTER 0-1 - UNPREDICTABLE 00102502 * 2-13 - SAME AS AT ENTRY 00103002 * (RESTORED WHEN REDISPATCHED) 00103502 * 14 - UNPREDICTABLE 00104002 * 15 - ZERO (ALL RETURN CODES ZERO) 00104502 * OR 00105002 * PARAMETER LIST POINTER (AT 00105502 * LEAST ONE NON-ZERO RETURN CODE) 00106002 * 00106502 * EACH RETURN CODE IS PLACED IN 00107002 * THE RETURN CODE FIELD OF EACH 00107502 * PARAMETER LIST ELEMENT, OFFSET +3 00108002 * INTO EACH ELEMENT (SEE DIAGRAM) 00108502 * 00109002 * RETURN CODES POSSIBLE FOR 00109502 * 00110002 * RET=NONE N/A 00110502 * RET=HAVE 0 - SUCCESSFUL RELEASE 00112002 * 4 - NOT RELEASED, 00112502 * RESOURCE IS 00113002 * BEING WAITED FOR 00113502 * 8 - NOT FOUND 00114002 * GENERIC & 00114502 * RET=HAVE 0 - RELEASED ALL 00115002 * 4 - N/A 00115202 * 8 - NONE FOUND 00115502 * 00116002 *02* REGISTERS-SAVED = NONE (SAVED BY SVC INTERRUPT HANDLER) 00116502 * 00117002 *02* REGISTER-USAGE = REFER TO 'REGISTER EQUATES' PORTION 00117502 * OF THIS MODULE 00118002 * 00118502 *02* REGISTERS-RESTORED = NONE (RESTORED AT EXIT TIME) 00119002 * 00119502 *01* ENTRY-POINT = IGC056 (ENQ) 00120002 * 00120502 *02* PURPOSE = PROVIDE SERIALIZATION OF A RESOURCE THROUGH 00121002 * THE PROPER USE OF PRE-SELECTED NAMES. BASICAL- 00121502 * LY THE CALLER, AFTER ISSUING THE ENQ/RESERVE 00122002 * SVC, WILL EITHER RECEIVE CONTROL BACK 00122502 * IMMEDIATELY OR WILL WAIT UNTIL ANOTHER 00123002 * REQUESTOR RELINQUISHES CONTROL OF THE 00123502 * RESOURCE VIA THE DEQ SERVICE ROUTINE. 00124002 * 00124502 *02* LINKAGE = VIA SVC INTERRUPT HANDLER (TYPE 2 SVC) 00125002 * 00125502 *02* INPUT = REGISTERS - SAME AS AT ENTRY POINT IGC048 00126002 * 00126502 * PARAMETER ELEMENT LIST 00127002 * 00127502 * ********************************************** 00127640 * -8 * TCB PTR IF ECB ALSO CODED OR DOESN'T EXIST @ZA14267 00127740 * ********************************************** 00128002 * -4 * ECB POINTER OR TCB PTR. OR DOES NOT EXIST * 00128502 * ********************************************** 00129002 * +0 * FLAGS1 * MINOR LENGTH * FLAGS2 * RET. CODE * 00129502 * ********************************************** 00130002 * +4 * ADDRESS OF MAJOR NAME * 00130502 * ********************************************** 00131002 * +8 * ADDRESS OF MINOR NAME * 00131502 * ********************************************** 00132002 * +12 * ADDR. OF UCB ADDR.(RESERVE ONLY) OR ABSENT * 00132502 * ********************************************** 00133002 * 00133502 * NOTE: NON-RESERVE ELEMENTS ARE 3 WORDS IN 00134002 * LENGTH, WHILE RESERVE ELEMENTS ARE 4 WORDS 00134502 * IN LENGTH. IN A MULTIPLE ELEMENT PARAMETER 00135002 * LIST, ELEMENTS ARE CONTIGUOUS STARTING AT 00135502 * OFFSET +0 00136002 * 00136502 * FLAGS1 BIT 0 - END OF LIST INDICATOR 00137002 * BIT 1 - IGNORE FOLLOWING BITS 00137502 * BIT 2 - RESERVED 00138002 * BIT 3 - IRRELEVANT (POTENTIAL OUTPUT) 00138502 * BIT 4 - RESERVED 00139002 * BIT 5 - RESERVED 00139502 * BIT 6 - RESERVED (USED BY DEQ ONLY) 00140002 * BIT 7 - TCB= SPECIFIED 00140502 * 00141002 * FLAGS2 BIT 0 - 0=EXCLUSIVE,1=SHARE 00141502 * BIT 1 - SEE NOTE A 00142002 * BIT 2 - OBSOLETE (SMC=SYSTEM SPECIFIED) 00142502 * BIT 3 - SMC=STEP SPECIFIED 00143002 * BIT 4 - SEE NOTE A 00143502 * BIT 5 - SEE NOTE B 00144002 * BIT 6 - SEE NOTE B 00144502 * BIT 7 - SEE NOTE B 00145002 * 00145502 * NOTE A 00 - SCOPE OF STEP 00146002 * 01 - UCB= SPECIFIED 00146502 * (SYSTEMS REQUIRED) 00147002 * 10 - SCOPE OF SYSTEM 00147502 * 11 - SCOPE OF SYSTEMS 00148002 * 00148502 * NOTE B 000 - RET=NONE SPECIFIED 00149002 * 001 - RET=HAVE SPECIFIED 00149502 * 010 - RET=CHNG SPECIFIED 00150002 * 011 - RET=USE SPECIFIED 00150502 * 100 - ECB= SPECIFIED 00151002 * 101 - RESERVED 00151502 * 110 - RESERVED 00152002 * 111 - RET=TEST SPECIFIED 00152202 * 00152502 *02* OUTPUT = NORMALLY, ELEMENT OBTAINED, INITIALIZED, 00153002 * AND PLACED IN RESOURCE QUEUE 00153502 * 00154002 * REGISTERS 0-1 - UNPREDICTABLE 00154502 * 2-13 - SAME AS AT ENTRY 00155002 * (RESTORED WHEN REDISPATCHED) 00155502 * 14 - UNPREDICTABLE 00156002 * 15 - ZERO (ALL RETURN CODES ZERO) 00156502 * OR 00157002 * PARAMETER LIST POINTER (AT 00157502 * LEAST ONE NON-ZERO RETURN CODE) 00158002 * 00158502 * EACH RETURN CODE IS PLACED 00159002 * IN THE RETURN CODE FIELD 00159502 * OF EACH PARAMETER LIST 00160002 * ELEMENT, OFFSET +3 INTO 00160502 * EACH ELEMENT (SEE DIAGRAM) 00161002 * 00161502 * POSSIBLE RETURN CODES FOR 00162002 * 00162202 * RET=NONE 0 - RESOURCE OBTAINED 00162502 * 4 - N/A 00163002 * 8 - N/A 00163502 * 20 - N/A 00164002 * RET=TEST 0 - RESOURCE IS AVAILABLE 00165502 * 4 - RESOURCE NOT AVAILABLE 00165602 * 8 - TASK ALREADY OWNS 00165702 * RESOURCE 00165802 * 20 - TASK IS WAITING 00165902 * FOR RESOURCE 00166002 * RET=USE 0 - RESOURCE OBTAINED 00166102 * 4 - RESOURCE NOT AVAILABLE 00166202 * 8 - TASK ALREADY OWNS 00166302 * RESOURCE 00166502 * 20 - TASK IS WAITING 00166602 * FOR RESOURCE 00166702 * RET=HAVE 0 - RESOURCE OBTAINED 00166802 * 4 - N/A 00167002 * 8 - TASK ALREADY OWNS 00167102 * RESOURCE 00167202 * 20 - TASK IS WAITING 00167502 * FOR RESOURCE 00168002 * RET=CHNG 0 - EXCLUSIVE CONTROL 00168502 * 4 - CURRENTLY SHARING 00169002 * 8 - NOT IN QUEUE 00169502 * 20 - TASK IS WAITING 00170002 * FOR RESOURCE 00170502 * ECB= 0 - RESOURCE OBTAINED, 00171002 * DO NOT WAIT, ECB 00171502 * WILL NOT BE POSTED 00172002 * 4 - WAIT FOR POST 00172502 * 8 - TASK ALREADY OWNS 00173002 * RESOURCE 00173502 * 20 - TASK IS WAITING 00174002 * FOR RESOURCE 00174502 * 00175002 * NOTE: RETURN CODES 12 AND 16 HAVE 00175502 * BECOME OBSOLETE 00176002 * 00176502 * DATA - WHEN A RETURN CODE 8 (MEANING TASK 00176602 * ALREADY OWNS RESOURCE) IS PASSED BACK, 00176702 * THE FORTH BIT (X'10') OF THE PARAMETER 00176802 * LIST IDENTIFYING THE OWNED RESOURCE REFLECTS 00176902 * WHETHER THE TASK HAS EXCLUSIVE CONTROL 00177002 * (BIT OFF) OR SHARED CONTROL (BIT ON). 00177102 * 00177202 *02* REGISTERS-SAVED = NONE (SAVED BY SVC INTERRUPT HANDLER) 00177302 * 00177502 *02* REGISTER-USAGE = REFER TO 'REGISTER EQUATES' PORTION 00178002 * OF THIS MODULE 00178502 * 00179002 *02* REGISTERS-RESTORED = NONE (RESTORED AT EXIT TIME) 00179502 * 00180002 *01* ENTRY-POINT = IEAVENQ2 (RESOURCE MANAGER) 00180502 * 00181002 *02* PURPOSE = CLEAN UP AFTER AN ABEND OR AT END OF TASK 00181502 * TIME. AT EITHER NORMAL OR ABNORMAL TASK 00182002 * TERMINATION, ALL REQUESTS MADE BY THIS 00182502 * TASK WILL BE DEQUEUED. FOR MEMORY 00183002 * TERMINATION, ALL REQUESTS MADE BY THIS 00183502 * ADDRESS SPACE WILL BE DEQUEUED. A MUST 00184002 * COMPLETE TERMINATION WILL BE DONE THE 00184502 * SAME WAY, EXCEPT THAT THE OPERATOR WILL 00185002 * BE NOTIFIED OF THE EXCLUSIVE-SYSTEM(S) 00185502 * WIDE RESOURCES DEQUEUED. 00186002 * 00186502 *02* LINKAGE = BRANCH ENTERED (CVTRENQ) 00187002 * 00187502 *02* INPUT = REGISTERS 00188002 * 0 - IRRELEVANT 00188502 * 1 - INDIRECT POINTER TO RESOURCE MANAGER 00189002 * LIST (IHARMPL) 00189502 * 2-12 - IRRELEVANT 00190002 * 13 - ADDRESS OF 72 BYTE SAVE AREA 00190502 * 14 - IRRELEVANT 00191002 * 15 - IRRELEVANT 00191502 * 00192002 * DATA 00192502 * IHARMPL +0 FLAGS AND ASID 00193002 * +4 ASCB ADDRESS 00193502 * +8 TCB ADDRESS OR ZERO 00194002 * +12 BEGINNING OF WORK AREA 00194502 * (12 WORDS) FOR RESOURCE 00195002 * MANAGER USE 00195502 * 00196002 *02* OUTPUT = POSSIBLE RELEASE OF ENQUEUED RESOURCES 00196502 * 00197002 * REGISTERS 0-14 - SAME AS AT ENTRY 00197502 * 15 - RETURN CODE (0-SUCCESSFUL, 00198002 * 4-UNSUCCESSFUL) 00198502 * 00199002 * DATA - NONE 00199502 * 00200002 *02* REGISTERS-SAVED = ALL REGISTERS SAVED IN SUPPLIED 00200502 * SAVE AREA (INPUT REGISTER 13) 00201002 * 00201502 *02* REGISTER-USAGE = REFER TO 'REGISTER EQUATES' PORTION 00202002 * OF THIS MODULE 00202502 * 00203002 *02* REGISTERS-RESTORED = ALL REGISTERS RESTORED FROM 00203502 * SUPPLIED SAVE AREA 00204002 * 00204502 *01* ENTRY-POINT = IEAVSRR1 (ERROR RECOVERY) 00205002 * 00205502 *02* PURPOSE = INSURE ENQ/DEQ/RESERVE IS STILL FUNCTIONAL 00206002 * BY VERIFYING/FIXING RESOURCE QUEUES. PLUS, 00206502 * SUPPLY ADDITIONAL ERROR DIAGNOSTIC 00207002 * INFORMATION 00207502 * 00208002 *02* LINKAGE = RTM DOES A LPSW OF THIS ENTRY POINT 00208502 * ADDRESS 00209002 * 00209502 *02* INPUT = REGISTERS 00210002 * 0 - IRRELEVANT 00210502 * 1 - ADDRESS OF SDWA 00211002 * 2-13 - IRRELEVANT 00211502 * 14 - RETURN ADDRESS 00212002 * 15 - ENTRY POINT ADDRESS 00212502 * 00213002 *02* OUTPUT = GOOD RESOURCE QUEUES AND SDWA MODIFIED 00213502 * TO REFLECT ADDITIONAL DIAGNOSTIC/RETRY 00214002 * INFORMATION 00214502 * 00215002 * REGISTERS 0 - IRRELEVANT 00215502 * 1 - ADDRESS OF SDWA 00216002 * 2-13 - IRRELEVANT 00216502 * 14 - RETURN ADDRESS 00217002 * 15 - RETURN CODE (0-CONTINUE 00217502 * WITH TERMINATION, 4-RETRY) 00218002 * 00218502 *02* REGISTERS-SAVED = SDWA ADDRESS(REG 1) AND RETURN 00219002 * ADDRESS(REG 14) ARE SAVED IN 00219502 * ENQ/DEQ GLOBAL SAVE AREA 00220002 * 00220502 *02* REGISTER-USAGE = REFER TO 'REGISTER EQUATES' 00221002 * PORTION OF THIS MODULE 00221502 * 00222002 *02* REGISTERS-RESTORED = SDWA ADDRESS(REG 1) AND 00222502 * RETURN ADDRESS(REG 14) ARE 00223002 * RESTORED FROM ENQ/DEQ 00223502 * GLOBAL SAVE AREA 00224002 * 00224502 *01* ENTRY-POINT = ENQXRTRY (ENQ RETRY) 00225002 * 00225502 *02* PURPOSE = PERFORM NORMAL ENQ END PROCESSING, 00226002 * DETERMINE ABEND CODE, AND INVOKE ABEND 00226502 * 00227002 *02* LINKAGE = VIA RTM WHEN AN ERROR HAS OCCURRED AND 00227502 * RETRY HAS BEEN REQUESTED 00228002 * 00228502 *02* INPUT = REGISTERS 00229002 * 0-4 - IRRELEVANT 00229502 * 5 - ADDRESS OF CURRENT RB 00230002 * 6 - FIRST BASE REGISTER 00230502 * 7 - SECOND BASE REGISTER 00231002 * 8-15 - IRRELEVANT 00231502 * 00232002 *02* OUTPUT = AN ABEND 00232502 * 00233002 * REGISTERS 0 - ABEND FLAGS 00233502 * 1 - ABEND CODE 00234002 * 2-15 - IRRELEVANT 00234502 * 00235002 *02* REGISTERS-SAVED = NONE 00235502 * 00236002 * REGISTER-USAGE = REFER TO 'REGISTER EQUATES' 00236502 * PORTION OF THIS MODULE 00237002 * 00237502 *02* REGISTERS-RESTORED = NONE 00238002 * 00238502 *01* ENTRY-POINT = DEQXRTRY (DEQ RETRY) 00239002 * 00239502 *02* PURPOSE = PERFORM NORMAL DEQ END PROCESSING, 00240002 * DETERMINE, ABEND CODE, AND INVOKE ABEND 00240502 * 00241002 *02* LINKAGE = VIA RTM WHEN AN ERROR HAS OCCURRED AND 00241502 * RETRY HAS BEEN REQUESTED 00242002 * 00242502 *02* INPUT = REGISTERS 00243002 * 0-4 - IRRELEVANT 00243502 * 5 - ADDRESS OF CURRENT RB 00244002 * 6 - FIRST BASE REGISTER 00244502 * 7 - SECOND BASE REGISTER 00245002 * 8-15 - IRRELEVANT 00245502 * 00246002 *02* OUTPUT = AN ABEND 00246502 * 00247002 * REGISTERS 0 - ABEND FLAGS 00247502 * 1 - ABEND CODE 00248002 * 2-15 IRRELEVANT 00248502 * 00249002 *02* REGISTERS-SAVED = NONE 00249502 * 00250002 *02* REGISTER-USAGE = REFER TO 'REGISTER EQUATES' 00250502 * PORTION OF THIS MODULE 00251002 * 00251502 *02* REGISTERS-RESTORED = NONE 00252002 * 00252502 *01* ENTRY-POINT = XSTARTIO (CODE EXECUTED UNDER SRB) 00253002 * 00253502 *02* PURPOSE = RELEASE SRB/IOSB STORAGE WHEN I/O COMPLETE. 00254002 * THIS I/O HAS RELEASED A RESERVED DEVICE. 00254502 * 00255002 *02* LINKAGE = VIA SRB DISPATCHER 00255502 * 00256002 *02* INPUT = REGISTERS 00256502 * 0 - IRRELEVANT 00257002 * 1 - ADDRESS OF STORAGE TO BE FREED 00257502 * 2-13 - IRRELEVANT 00258002 * 14 - EXIT ADDRESS 00258502 * 15 - ENTRY POINT ADDRESS 00259002 * 00259502 *02* OUTPUT = REGISTERS - IRRELEVANT 00260002 * 00260502 *02* REGISTERS-SAVED = NONE 00261002 * 00261502 *02* REGISTER-USAGE = REFER TO 'REGISTER EQUATES' 00262002 * PORTION OF THIS MODULE 00262502 * 00263002 *02* REGISTERS-RESTORED = NONE 00263502 * 00264002 *01* EXIT-NORMAL = TEST4 (MAINLINE DEQ EXIT) 00264502 * 00265002 *02* CONDITIONS = FUNCTION COMPLETED, RETURN TO 00265502 * CALLER VIA BRANCHING TO ADDRESS 00266002 * IN REGISTER 14 AT ENTRY 00266502 * 00267002 *02* OUTPUT = SEE OUTPUT FOR ENTRY POINT - IGC048 00267502 * 00268002 *02* RETURN-CODES = SEE OUTPUT FOR ENTRY POINT - IGC048 00268102 * 00268202 *01* EXIT-NORMAL = TEST11 (MAINLINE ENQ EXIT) 00268502 * 00269002 *02* CONDITIONS = FUNCTION COMPLETED, RETURN TO 00269502 * CALLER VIA BRANCHING TO ADDRESS 00270002 * IN REGISTER 14 AT ENTRY 00270502 * 00271002 *02* OUTPUT = SEE OUTPUT FOR ENTRY POINT - IGC056 00271502 * 00272002 *02* RETURN-CODES = SEE OUTPUT FOR ENTRY POINT - IGC056 00272502 * 00273002 *01* EXIT-NORMAL = ERMNWTO1 (MAINLINE RESOURCE MANAGER EXIT) 00273502 * 00274002 *02* CONDITIONS = FUNCTION COMPLETED, RETURN TO 00274502 * CALLER VIA BRANCHING TO ADDRESS 00275002 * IN REGISTER 14 AT ENTRY 00275502 * 00276002 *02* OUTPUT = POSSIBLE RELEASE OF ENQUEUED RESOURCES 00276502 * FOR TASK TERMINATING 00277002 * 00277502 * REGISTERS 0-14 - SAME AS AT ENTRY 00278002 * 15 - RETURN CODE 00278502 * 00279002 * DATA - NONE 00279502 * 00280002 *02* RETURN-CODES = 0 - SUCCESSFUL 00280502 * 4 - UNSUCCESSFUL 00281002 * 00281502 *01* EXIT-NORMAL = TEST62C (MAINLINE EXIT FOR CODE EXECUTING 00282002 * UNDER SRB DURING RELEASE OF A 00282502 * DEVICE) 00283002 * 00283502 *02* CONDITIONS = FUNCTION COMPLETED, EXIT VIA 00284002 * BRANCHING TO THE ADDRESS CONTAINED 00284502 * IN REGISTER 14 AT ENTRY 00285002 * 00285502 *02* OUTPUT = REGISTERS - IRRELEVANT 00286002 * 00286502 *02* RETURN-CODES = NONE 00287002 * 00287502 *01* EXIT-NORMAL = TEST20 (ERROR RECOVERY EXIT FOR 00288002 * CONTINUING WITH TERMINATION) 00288502 * 00289002 *02* CONDITIONS = FUNCTION COMPLETED, RETURN TO 00289502 * CALLER VIA BRANCHING TO ADDRESS 00290002 * CONTAINED IN REGISTER 14 AT ENTRY 00290502 * 00291002 *02* OUTPUT = NORMALLY - SDWA MODIFIED TO REFLECT 00291502 * FREE SDWA, RECORD, 00292002 * FREE LOCKS, AND 00292502 * ADDITIONAL DIAGNOSTIC INFO 00293002 * 00293502 * REGISTERS - 0 - IRRELEVANT 00294002 * 1 - ADDRESS OF SDWA 00294502 * 2-13 - IRRELEVANT 00295002 * 14 - RETURN ADDRESS 00295502 * 15 - ZERO (CONTINUE WITH 00296002 * TERMINATION 00296502 * 00297002 *02* RETURN-CODES = 0 - CONTINUE WITH TERMINATION 00297502 * 00298002 *01* EXIT-NORMAL = TEST19M (ERROR RECOVERY EXIT FOR RETRY) 00298502 * 00299002 *02* CONDITIONS = FUNCTION COMPLETED, RETURN TO 00299502 * CALLER VIA BRANCHING TO ADDRESS 00300002 * CONTAINED IN REGISTER 14 AT ENTRY 00300502 * 00301002 *02* OUTPUT = NORMALLY - SDWA MODIFIED TO REFLECT 00301502 * FREE SDWA, RECORD, RETRY, 00302002 * RETRY REGISTERS, AND 00302502 * ADDITIONAL DIAGNOSTIC INFO 00303002 * 00303502 * REGISTERS 0 - IRRELEVANT 00304002 * 1 - ADDRESS OF SDWA 00304502 * 2-13 - IRRELEVANT 00305002 * 14 - RETURN ADDRESS 00305502 * 15 - FOUR (RETRY) 00306002 * 00306502 *02* RETURN-CODES = 4 - RETRY 00307002 * 00307202 *01* EXIT-ERROR = DEQYABND (ERROR EXIT FOR DEQ MAINLINE) 00307502 * 00308002 *02* CONDITIONS = FUNCTION COMPLETE, ABEND CALLER VIA 00308502 * ABEND (SVC 13) 00309002 * 00309502 *02* OUTPUT = REGISTERS 0 - ABEND FLAGS 00310002 * 1 - ABEND CODE 00310502 * 2-15 - IRRELEVANT 00311002 * 00311502 *02* RETURN-CODES = NONE 00312002 * 00312502 *01* EXIT-ERROR = ENQYABND (ERROR EXIT FOR ENQ MAINLINE) 00313002 * 00313502 *02* CONDITIONS = FUNCTION COMPLETE, ABEND CALLER 00314002 * VIA ABEND (SVC 13) 00314502 * 00315002 *02* OUTPUT = REGISTERS 0 - ABEND FLAGS 00315502 * 1 - ABEND CODE 00316002 * 2-15 - IRRELEVANT 00316502 * 00317002 *02* RETURN-CODES = NONE 00317502 * 00318002 *01* EXTERNAL-REFERENCES 00318502 * 00319002 *02* ROUTINES PURPOSE LINKAGE 00319502 * ABEND TERMINATE TASK SVC 00320002 * FREEMAIN FREE STORAGE BRANCH 00320502 * FREEMAIN FREE STORAGE SVC 00321002 * GETMAIN OBTAIN STORAGE BRANCH 00321502 * POST POST AN ECB BRANCH 00322002 * SETLOCK OBTAIN LOCK BRANCH 00322502 * SPOST PURGE SRBS SVC 00323002 * STATUS SET/RESET STEP MC BRANCH 00323502 * STARTIO RELEASE DEVICE BRANCH 00324002 * SYSEVENT RELEASE/HOLD RESOURCE BRANCH 00324502 * TESTAUTH DETERMINE AUTHORIZATION BRANCH 00325002 * WAIT WAIT FOR A POST BRANCH 00325502 * WTO SEND OPERATOR MESSAGE SVC 00326002 * 00326502 *02* DATA-AREAS = ENQ/DEQ GLOBAL SAVE AREA(GS) - WORK AREA 00327002 * SERIALIZED VIA 00327202 * CMS LOCK 00327502 * PARAMETER ELEMENT LIST(PEL) - REFLECT 00328002 * INPUT 00328502 * PARMS. 00329002 * RB EXTENDED SAVE AREA(WA) - WORK AREA 00329502 * 00330002 *02* CONTROL-BLOCKS = ASCB R,W 00330502 * ASVT R 00331002 * ASXB R 00331502 * CVT R 00332002 * DQE R 00332502 * FRRS R 00333002 * FQE R 00333502 * GDA R 00334002 * IOCM R 00334502 * IOSB C,D, W 00335002 * QCB C,D,R,W 00335502 * PSA R 00336002 * QEL C,D,R,W 00336502 * RB R,W 00337002 * RMPL R 00337502 * SRB C,D, W 00338002 * SCVT R 00338502 * SDWA R,W 00339002 * SPQE R 00339502 * TCB R 00340002 * UCB R,W 00340502 * WSAVT R 00341002 * 00341502 *01* TABLES = ENQ/DEQ GLOBAL SAVE AREA(GS) - SEE DSECT 00342002 * COMMENTARY FOR DESCRIPTION 00342502 * 00343002 *01* MACROS = ABEND 00343502 * FREEMAIN 00344002 * GETMAIN 00344502 * MODESET 00345002 * MODID 00345502 * SETFRR 00346002 * SETLOCK 00346502 * SPOST 00347002 * STARTIO 00347502 * SYSEVENT 00348002 * TESTAUTH 00348502 * WTO 00349002 * 00349502 *02* SERIALIZATION = RESOURCES ENQUEUED - NONE 00350002 * 00350502 * LOCKS - LOCAL, CMS, AND SALLOC 00351002 * 00351502 *01* CHANGE-ACTIVITY = THIS MODULE HAS BEEN COMPLETELY 00352002 * RE-WRITTEN. THE S/D CODE IS Y02752. 00352502 * THE FOLLOWING ADDITIONAL CHANGES HAVE 00352702 * BEEN MADE : 00354502 * Y02113 - N/A - DCRR 00354602 * Y02752 - N/A - DCRR 00354702 * YM01596 - 4/26/73 - CROSS ADDRESS SPACE 00354802 * POST INTERFACE ERROR 00354902 * YM01991 - 6/27/73 - WRONG REGISTER FOR 00355002 * SUB-QEL CHECK 00355202 * YM03340 - 10/9/73 - INTEGRITY ADDITIONAL 00356502 * INFORMATION 00356602 * YM03564 - 10/9/73 - PERFORMANCE IMPROVEMENTS 00356702 * YM04188 - 11/2/73 - STARTIO MACRO ERROR 00356802 * YM04705 - 11/1/73 - ZERO RETURN CODE ERROR 00356902 * FOR A LIST REQUEST AND 00357002 * CLEAR HIGH BYTE OF UCB 00358002 * ADDRESS PRIOR TO SAVING 00359002 * YM05430 - 11/6/73 - INCORRECT DATA BEING 00361002 * RECORDED IN SDWA 00362002 * YA00805 - 07/1/74 - SHARED DASD 00362303 * RESERVE/RELEASE SUPPORT 00362703 * Z30BNVD - 10/9/74 - SQA FRAGMENTATION 00363203 * REDUCTION AND 00363803 * INTELLIGENT WAIT 00364403 * ZA07146 - 10/2/75 - RTM SUPPORT TO FIX 00364540 * INTRA ADDRESS SPACE 00364640 * INTERLOCK PROBLEM 00364740 * ZA03873 - 12/2/75 - ESTAE COVERING WAIT 00364840 * Z40FPVD - 12/15/75 - ESTAE TO FAST ESTAE 00364940 * ZA10756-CHANGE TO PERFORM RECORDING ONLY FOR AN @ZA32935 00365040 * UNEXPECTED ERROR. @ZA32935 00365140 * ZA14267-ENHANCEMENT TO PERMIT ENQ WITH BOTH ECB AND @ZA32935 00365240 * TCB. @ZA32935 00365340 * ZA17306-CHANGE TO ISSUE ENQHOLD AND ENQRELSE SYSEVENTS @ZA32935 00365440 * SO SRM WILL MAKE IT LESS LIKELY FOR ADDRESS @ZA32935 00365540 * SPACES TO BE SWAPPED OUT WHEN RESERVES ARE IN @ZA32935 00365640 * EFFECT. @ZA32935 00365740 * ZA20351-CHANGE TO PREVENT TCBQEL COUNTER FROM WRAPPING @ZA32935 00365840 * AROUND. @ZA32935 00365940 * ZA32935-IEAVENQ1 WILL STEAL RESOURCES TO PREVENT @ZA32935 00366040 * INTERLOCKS IF TCBFA IS ON AND OTHER CONDITIONS @ZA32935 00366140 * ARE MET. HOWEVER, IF AN ESTAE TERM EXIT OR @ZA32935 00366240 * TASK RESOURCE MANAGER OBTAINS A RESOURCE VIA @ZA32935 00366340 * ENQ AND LATER ISSUES ENQ RET=HAVE,SMC=STEP FOR @ZA32935 00366440 * THE SAME RESOURCE, THE CURRENT STEALING LOGIC @ZA32935 00366540 * WILL CAUSE CONTROL OF THE RESOURCE TO BE LOST @ZA32935 00366640 * IF OTHER ENQ REQUESTS HAD BEEN QUEUED. THE FIX @ZA32935 00366740 * IS TO SET A FLAG IN ANY QEL OBTAINED WHEN @ZA32935 00366840 * TCBFA IS ON. (TCBFA MEANS ABNORMAL TERMINATION @ZA32935 00366940 * IS IN PROGRESS AND RETRY IS NOT POSSIBLE.) @ZA32935 00367040 * THEN, IEAVENQ1 WILL NOT STEAL @ZA32935 00368140 * A RESOURCE WHICH WAS OBTAINED WHEN TCBFA WAS @ZA32935 00368640 * ON AND IS NOT OWNED BY THE REQUESTING TASK. @ZA32935 00369140 * 00369640 *01* MESSAGES = THE FOLLOWING MESSAGES ARE REQUESTED BY 00371503 * ENQ/DEQ/RESERVE: 00373003 * IEA801I AAAAAAAAAAAAAAAA BB FAILED 00374003 * WHILE IN STEP MUST COMPLETE 00376503 * STATUS 00377503 * 00379502 * AAA... - JOBNAME STEPNAME 00380503 * OR UNIDENTIFIED TASK 00382403 * BB - ST OR JS INDICATING 00384003 * STEP OR JOBSTEP 00384503 * 00386003 * IEA803I CC FAILED WHILE IN 'STEP MUST 00388003 * COMPLETE' STATUS DUE TO DDDD 00389003 * 00391003 * CC - ST OR JS INDICATING 00393003 * STEP OR JOBSTEP 00394003 * DDDD - S(SYSTEM)CODE OR 00396003 * U(USER)CODE 00397003 * 00398003 * IEA960I ENQ/DEQ CONTROL QUEUES WERE 00400003 * DAMAGED. RESTORATION ATTEMPTED 00402003 * 00403003 * THIS MESSAGE IS PRINTED WHEN 00405003 * ENQ/DEQ/RESERVE CONTROL BLOCKS 00406003 * HAVE BEEN DAMAGED 00408003 * (E.G. WILD STORE) 00409003 * 00410003 * IEA961I RESOURCE NAMED QNAME,RNAME MAY 00412003 * BE DAMAGED 00413003 * 00415003 * THIS MESSAGE IS PRINTED WHEN 00417003 * A TASK IS IN THE MUST COMPLETE 00418003 * STATE AND ABNORMALLY TERMINATES. 00420003 * 00421003 *01* ABEND-CODES = ISSUED BY ENQ/RESERVE: 00422003 * 138 - TASK ALREADY HAD OR WAS WAITING 00424003 * FOR RESOURCE 00426003 * 238 - INVALID MINOR NAME LENGTH 00427003 * 338 - CALLER NOT AUTHORIZED FOR 00429003 * FUNCTION 00430003 * 438 - INVALID PARAMETER LIST 00432003 * 638 - OUT OF STORAGE 00433003 * 738 - UNEXPECTED ERROR 00434003 * 838 - ENQ DENIED DUE TO ENQ/DEQ/RESERVE 00436003 * RESOURCE CONTROL BLOCK DAMAGE 00437003 * 00439003 * ISSUED BY DEQ: 00441003 * 130 - RESOURCE NOT FOUND 00442003 * 230 - INVALID MINOR NAME LENGTH 00444003 * 330 - CALLER NOT AUTHORIZED FOR 00445003 * FUNCTION 00447003 * 430 - INVALID PARAMETER LIST 00448003 * 530 - RESOURCE IS BEING WAITED UPON 00450003 * 630 - OUT OF STORAGE 00451003 * 730 - UNEXPECTED ERROR 00453003 * 00454003 **** END OF SPECIFICATIONS ***/ 00456003 SPACE 00456203 * A-000000-999999 @Y02752 00457003 ENTRY IEAVENQ1 00459003 IEAVENQ1 EQU IGC048 MODULE NAME 00460003 ENTRY IGC056 00462003 ENTRY IEAVENQ2 00463003 ENTRY IEAVENQQ @Z30BNVD 00463503 USING PSA,0 ADDRESSABILITY TO LOW CORE 00464003 USING TCB,R4 TCB ADDRESSABILITY 00466003 USING RBSECT,R5 WORK AREA ADDRESSABILITY 00467003 USING IGC048,R6,R7 00469003 USING PEL,R8 00470003 USING MAJ,R9 00472003 USING MIN,R10 00473003 USING QEL,R11 00475003 USING GS,R13 GLOBAL SAVE ADDRESSABILITY 00476003 USING *,R6 00478003 LM R6,R7,BASE ESTABLISH BASE REGISTERS 00480002 USING IGC048,R6,R7 00510002 MODID BR=YES IDENTIFY MODULE 00570002 DEQID EQU * * 00600002 LA R0,RETRYDEQ INDEX OF RETRY ADDRESS 00630002 LA R2,DEQFRR GET ADDRESS OF RECOVERY ROUTINE 00660002 BAL R3,XSETUP INITIALIZE ENVIRONMENT 00690002 CLI WAERR,ZERO Q. ABEND 00720002 BNE DEQYABN A. YES. 00750002 * CHECK RESERVED BITS 00780002 TM WAPLAST,PELRES1+PELSAVE+PELGEN1 Q. RESERVED @YM03340 00810002 BNZ DEQYRESB A. YES, RESERVED USED. ERROR 00840002 TM WAPFLAG,PELRET1+PELRET2+PELSYSMC Q. RESERVED 00870002 BNZ DEQYRESB A. YES, RESERVED USED. ERROR 00900002 * CHECK FOR MILEN OF 0 (EXCLUDE GENERIC) 00930002 TM WAPLAST,PELGEN2 Q. GENERIC 00960002 BO DEQYGEN A. YES, SKIP CHECK 00990002 TM WAFLAG2,WABADMIL Q. BAD MINOR LENGTH 01020002 BO DEQYMIL0 A. YES, ERROR 01050002 DEQYGEN EQU * * 01080002 * CHECK TCB CONFLICTS 01110002 TM WAPLAST,PELTCBF Q. TCB SPECIFIED 01140002 BZ DEQNDIR A. NO, SKIP NEXT CHECK 01170002 TM WAPFLAG,PELSTPMC Q. SET MUST COMPLETE 01200002 BO DEQYCONF A. YES, CONFLICTING PARAMETERS 01230002 DEQNDIR EQU * * 01260002 * CHECK GENERIC CONFLICTS 01290002 TM WAPLAST,PELGEN2 Q. GENERIC 01320002 BZ DEQNGEN A. NO, SKIP ADDITIONAL CHECKS 01350002 TM WAPFLAG,PELRET1+PELRET2+PELRET3 Q. RET=NONE(DEFAULT) 01380002 BZ DEQYCONF A. YES, CONFLICTING PARAMETERS 01410002 TM WAPFLAG,PELSTPMC Q. SET MUST COMPLETE 01440002 BO DEQYCONF A. YES CONFLICTING PARAMETERS 01470002 DEQNGEN EQU * * 01500002 * CHECK IF AUTHORIZED 01530002 TM WAFLAG2,WANOAUTH Q. AUTHORIZED VIA TESTAUTH. 01560002 BZ DEQYAUTO A. YES. SKIP AUTHORIZATION CHECKS. 01590002 * CHECK AUTHORIZATION FOR TCB,RMC,GENERIC 01620002 TM WAPLAST,PELGEN2+PELTCBF Q.TCB OR GENERIC SPECIFIED. 01650002 BNZ DEQNAUTH A. YES. ABEND. 01680002 TM WAPFLAG,PELSTPMC Q. RMC KEYWORD SPECIFIED. 01710002 BO DEQNAUTH A. YES . ABEND. 01740002 DEQYAUTO EQU * * 01770002 TM WAPFLAG,PELSTPMC Q. RMC SPECIFIED. 01800002 BZ DEQNRMC A. NO. 01830002 OI WAFLAG2,WARMC INDICATE NEED FOR RESET MUST COMPLETE 01860002 DEQNRMC EQU * * 01890002 DEQQPEL EQU * * 01920002 BAL R3,XFINDMAJ FIND A MATCHING MAJOR. 01950002 LTR R9,R9 Q. FIND A MAJOR 01980002 BNP DEQNMAJ A. NO 'RETURN CODE 8' 02010002 TM WAPLAST,PELGEN2 Q. GENERIC=YES 02040002 BZ DEQNGENR A. NO. CONTINUE PROCESSING. 02070002 * GENERIC DEQUEUE 02100002 L R10,MAJFMIN GET THE FIRST MINOR 02130002 DEQQMIN EQU * MINOR QCB LOOP 02160002 LPR R10,R10 Q. IS THERE A MINOR. 02190002 BZ DEQNMIN A. NO SEE WHAT HAPPENED. 02220002 * SCOPE MUST MATCH FOR GENERIC DEQUEUE. 02250002 TM PELFLAG,PELSCPE1+PELSCPE2 Q. REQUESTING STEP. 02280002 BNZ DEQNSTEP A. NO. 02310002 TM MINFLGS,MINSTEP Q. REQUEST FOR THIS MINOR. 02340002 BZ DEQNTHIS A. NO. 02370002 CLC GSASID(TWO),MINASID Q. REQUEST FOR THIS MINOR. 02400002 BNE DEQNTHIS A. NO. GET NEXT MINOR. 02430002 B DEQYTHIS A. YES. SCOPE MATCH. 02460002 DEQNSTEP EQU * * 02490002 TM PELFLAG,PELSCPE2 Q. REQUESTING SYSTEMS. 02520002 BZ DEQNSYSS A. NO. REQUEST IS FOR SYSTEM 02550002 TM MINFLGS,MINSYSS Q. REQUEST FOR THIS MINOR. 02580002 BZ DEQNTHIS A. NO. NOT THIS ONE. 02610002 B DEQYTHIS A. YES. THIS ONE. 02640002 DEQNSYSS EQU * * 02670002 TM MINFLGS,MINSYS Q. REQUEST FOR THIS MINOR. 02700002 BZ DEQNTHIS A. NO. NOT THIS ONE. 02730002 DEQYTHIS EQU * * 02760002 BAL R3,XQELSCAN SCAN THE QELS 02790002 LTR R11,R11 Q. FIND A MATCH 02820002 BNP DEQNDEQ A. NO. GET NEXT MINOR. 02850002 LA R0,TWO INIT REG FOR COMPARE 02880002 C R0,GSGRPNUM MATCH QEL IN GROUP 1 02910002 BH DEQYDEQ A. YES. DEQUEUE IT. 02940002 TM QELLFLGS,QELECBF Q. ECB DEQUEUE 02970002 BO DEQYDEQ A. YES. CAN DEQUEUE 03000002 OI WAFLAG1,WAWAITN INDICATE FOUND A WAITING QEL(NOT ECB) 03030002 B DEQNDEQ GET THE NEXT MINOR. 03060002 DEQYDEQ EQU * * 03090002 * GROUP 1 OR ECB(ANY GROUP) 03120002 BAL R2,XDEQQEL DEQUEUE THE CURRENT QEL 03150002 OI WAFLAG1,WA1DEQ INDICATE AT LEAST ONE QEL DEQUEUED 03180002 LTR R10,R10 Q. CHANGE IN MINOR 03210002 BNP DEQQMIN A. YES. HAVE NEXT ALREADY. 03240002 DEQNDEQ EQU * GET NEXT MINOR. 03270002 DEQNTHIS EQU * * 03300002 L R10,MINNMIN GET NEXT MINOR. 03330002 B DEQQMIN LOOP 03360002 DEQNMIN EQU * CHECK WHAT HAPPENED. 03390002 TM WAFLAG1,WAWAITN+WA1DEQ Q. FIND ANY. 03420002 BZ DEQNFIND A. NO. 'RETURN CODE 8' 03450002 TM WAFLAG1,WAWAITN Q. ANY FOUND WAITING 03480002 BZ DEQYFIND A. NO. 'RETURN CODE 0' 03510002 B DEQYWTNG A. YES. 'RETURN CODE 4' 03540002 EJECT 03570002 DEQNGENR EQU * * 03600002 BAL R3,XFINDMIN FIND A MATCHING MINOR 03630002 LTR R10,R10 Q. FIND ONE. 03660002 BNP DEQNMIN1 A. NO. 'RETURN CODE 8' 03690002 BAL R3,XQELSCAN SCAN THE QELS 03720002 LTR R11,R11 Q. FIND A MATCH QEL 03750002 BZ DEQNQEL A. NO. 'RETURN CODE 8' 03780002 LA R0,TWO USE FOR THE FOLLOWING COMPARE 03810002 C R0,GSGRPNUM Q. GROUP NUMBER ONE 03840002 BH DEQYDEQ1 A. YES.CAN DEQUEUE. 03870002 TM QELLFLGS,QELECBF Q. DEQUEUE ALLOWED. 03900002 BZ DEQNDEQ1 A. NO 'RETURN CODE 4' 03930002 DEQYDEQ1 EQU * QEL IS DEQ-ABLE 03960002 * QEL IS DEQ-ABLE 03990002 BAL R2,XDEQQEL DEQUEUE THE CURRENT QEL 04020002 B DEQYRC0 'RETURN CODE 0' 04050002 EJECT 04080002 DEQYA430 EQU * INVALID PARM LIST 04110002 DEQYRESB EQU * * 04140002 DEQYCONF EQU * CONFLICTING PARMS 04170002 MVI WAERR,AB430 'ABEND CODE 430' 04200002 B DEQPART2 PROCEED TO PART 2 04230002 DEQYA330 EQU * NOT AUTHORIZED 04260002 DEQNAUTH EQU * * 04290002 MVI WAERR,AB330 'ABEND CODE OF 330' 04320002 B DEQPART2 PROCEED TO PART 2 04350002 DEQYA230 EQU * MINOR NAME LENGTH OF ZERO 04380002 DEQYMIL0 EQU * * 04410002 MVI WAERR,AB230 'ABEND CODE 230' 04440002 B DEQPART2 PROCEED TO PART 2 04470002 DEQYRC8 EQU * NO QEL(S) FOUND 04500002 DEQNFIND EQU * * 04530002 DEQNMAJ EQU * * 04560002 DEQNMIN1 EQU * * 04590002 DEQNQEL EQU * * 04620002 MVI WARET,EIGHT 'RETURN CODE 8' 04650002 B DEQPART2 PROCEED TO PART 2 04680002 DEQYRC4 EQU * RESOURCE BEING WAITED UPON 04710002 DEQYWTNG EQU * * 04740002 DEQNDEQ1 EQU * * 04770002 MVI WARET,FOUR 'RETURN CODE 4' 04800002 B DEQPART2 PROCEED TO PART 2 04830002 DEQYRC0 EQU * AOK 04860002 DEQYFIND EQU * * 04890002 MVI WARET,ZERO SET ZERO RETURN CODE @YM04705 04900002 DEQYABN EQU * * 04920002 EJECT 04950002 DEQPART2 EQU * PART 2 OF DEQ 04980002 CLI WARET,ZERO Q. IS THIS RETURN CODE ZERO 05010002 BZ DEQYZERO A. YES. 05040002 OI WAFLAG2,WAR15SW INDICATE HAVE A NON ZERO RET CODE. 05070002 DEQYZERO EQU * * 05100002 CLI WAERR,ZERO Q. ABEND REQ'D 05130002 BNE DEQYABND A.YES 05160002 TM WAPFLAG,PELRET1+PELRET2+PELRET3 Q. RET=NONE 05190002 BNZ DEQYSTOR A. NO. STORE THE RET. CODE. 05220002 * RET=NONE 05250002 CLI WARET,ZERO Q. R.C. OF 0 05280002 BE DEQNSTOR A. YES. DONT STORE 05310002 CLI WARET,FOUR Q. R.C. OF FOUR 05340002 MVI WAERR,AB530 CHANGE TO 530 ABEND 05370002 BE DEQYABND A. YES. ABEND 530 05400002 MVI WAERR,AB130 CHANGE TO ABEND 130 05430002 B DEQYABND ABEND 130 05460002 DEQYSTOR EQU * * 05490002 * NOT RET=NONE 05520002 LR R14,R8 CURRENT PEL 05550002 S R14,WANEWPEL PEL DISPLACEMENT 05580002 AL R14,WAOLDPEL CORRESPONDING PEL 05610002 LH R2,WAKEY GET THE USERS KEY 05640002 TEST1 EQU * * 05670002 MODESET KEYADDR=(2) CHANGE TO USER KEY. 05700002 IC R15,WARET GET RETURN CODE. 05730002 STC R15,PELRET-PEL(R14) STORE THE RET CODE. 05760002 TEST2 EQU * * 05790002 MODESET EXTKEY=SUPR SET KEY BACK TO ZERO 05820002 DEQNSTOR EQU * * 05850002 TM PELLAST,PELEOL Q. END OF LIST 05880002 BO DEQYEOL A. YES. 05910002 TM PELFLAG,PELSCPE2 Q. UCB PARM ELEM 05940002 BZ DEQNUCB A. NO. 05970002 TM PELFLAG,PELSCPE1 Q. UCB PARM ELEM 06000002 BO DEQNUCB A. NO 06030002 LA R8,FOUR(R8) COMPENSATE FOR UCB WORD 06060002 DEQNUCB EQU * * 06090002 LA R8,PELELEM(R8) BUMP TO THE NEXT ELEM 06120002 B DEQQPEL PROCESS THE NEXT ELEMENT. 06150002 DEQYEOL EQU * * 06180002 BAL R3,XENDUP DO END PROCESSING 06210002 SR R15,R15 ASSUME RET CODE OF ZERO. 06240002 TM WAFLAG2,WAR15SW Q. SET R15 TO ZERO. 06270002 BZ DEQYZ15 A. YES 06300002 * AT LEAST ONE NON ZERO RET CODE WAS GOTTEN. 06330002 L R15,WAOLDPEL SET R15 TO POINT TO PARM LIST 06360002 DEQYZ15 EQU * * 06390002 L R14,CVTPTR GET CVT 06420002 TEST4 EQU * * 06450002 L R14,CVTEXPRO-CVT(R14) GET EXIT ADDRESS. 06480002 BR R14 RETURN 06510002 DEQYABND EQU * * 06540002 DEQXRTRY EQU * RETRY FROM HERE AFTER ERROR 06570002 * R5,R6,R7 AND R13 ARE SET CORRECTLY 06600002 BAL R3,XENDUP DO END PROCESSING 06630002 LA R1,DEQCODE GET BACK END OF ABEND CODE. 06660002 ICM R1,M0010,WAERR GET THE FRONT END OF ABEND CODE. 06690002 ABEND (1),DUMP,,SYSTEM ABEND. 06720002 TEST5 EQU * * 06750002 EJECT 06780002 IGC056 DS 0D ENTRY POINT FOR ENQ/RESERVE 06810002 USING *,R6 06840002 DROP R7 06870002 LM R6,R7,BASE ESTABLISH BASE REGISTERS 06900002 USING IGC048,R6,R7 06930002 B ENQID SKIP ENQ IDENTIFIER 06960002 DC CL8'IGC056' ENQ IDENTIFIER 06990002 ENQID EQU * USED ONLY TO BYPASS ENQ IDENTIFIER 07020002 LA R0,RETRYENQ INDEX OF RETRY ADDRESS 07050002 LA R2,ENQFRR OBTAIN FRR E.P. ADDRESS 07080002 BAL R3,XSETUP PERFORM COMMON INITIALIZATION 07110002 TM GSFLAG1,GSNOENQ Q. STOP ENQ 07140002 BO ENQYA838 A. YES. 'ABEND CODE 838' 07170002 CLI WAERR,ZERO Q. ABEND 07200002 BNE ENQYABN A. YES. 07230002 * CHECK RESERVED BITS 07260002 TM WAPLAST,PELRES1+PELSAVE+PELGEN1+PELGEN2 @YM03340 07290002 BNZ ENQYRESB ERROR WHEN BITS USED 07320002 TM WAPFLAG,PELSYSMC Q. SET MUST COMPLETE 07350002 BO ENQYRESB A. YES, CONFLICTING PARAMETERS 07380002 TM WAPFLAG,PELRET1 Q. FURTHER CHECKING NECESSARY 07410002 BZ ENQNRESB A. NO, THEN SKIP 07440002 TM WAPFLAG,PELRET2+PELRET3 Q. RESERVED BITS USED 07470002 BM ENQYRESB A. YES, ERROR 07500002 ENQNRESB EQU * * 07530002 * CHECK FOR MINOR NAME LENGTH OF 0 07560002 TM WAFLAG2,WABADMIL 07590002 BO ENQYMIL0 ERROR WHEN LENGTH ZERO REQUESTED 07620002 TM WAPLAST,PELTCBF Q. DIRECTED ENQ 07650002 BZ ENQNDIR A. NO, THEN SKIP 07680002 * TCB REQUEST 07710002 L R10,PSAAOLD GET FIRST TCB IN THIS ADDR SPACE 07740002 L R10,ASCBASXB-ASCB(R10) DITTO 07770002 L R10,ASXBFTCB-ASXB(R10) DITTO 07800002 ENQQTCB1 EQU * CHECK EACH ACTIVE TCB IN THIS ADDR SPACE 07830002 CR R10,R4 Q. VALID TCB 07860002 BE ENQYTCB1 A. YES. 07890002 ICM R10,M1111,TCBTCB-TCB(R10) Q. ANY MORE TCBS 07920002 BNZ ENQQTCB1 A. YES. LOOP. 07950002 * IF HERE, HAVE INVALID TCB 07980002 B ENQNTCB1 'ABEND 438' 08010002 ENQYTCB1 EQU * * 08040002 * CHECK TCB CONFLICTS 08070002 TM PELFLAG,PELSCPE2 Q. UCB SPECIFIED. 08100002 BZ NRESV4 A. NO. 08130002 TM PELFLAG,PELSCPE1 Q. UCB SPECIFIED. 08160002 BZ ENQYCONF A. YES. CONFLICTING PARMS 08190002 NRESV4 EQU * * 08220002 TM WAPFLAG,PELSTPMC Q. SET STEP MUST COMPLETE 08250002 BO ENQYCONF A. YES, CONFLICTING PARAMETERS 08280002 TM WAECBA,WAECBF Q. ECB SPECIFIED @ZA14267 08287040 BO ENQNDIR A. YES, DO NOT CHECK FOR @ZA14267 08292040 * CHNG, USE, OR TEST @ZA14267 08297040 TM WAPFLAG,PELRET2 Q. CHNG, USE, OR TEST REQUESTED 08310002 BZ ENQYCONF A. NO, ERROR (IF NOT ECB) @ZA14267 08320040 ENQNDIR EQU * * 08370002 * CHECK FOR ECB AND SMC=STEP CONFLICT 08400002 TM WAPFLAG,PELSTPMC Q. SMC=STEP SPECIFIED. 08430002 BZ ENQNSMC3 A. NO. 08460002 TM WAECBA,WAECBF Q. ECB= SPECIFIED. 08490002 BO ENQYCONF A. YES. SMC + ECB CONFLICT. ABEND. 08520002 ENQNSMC3 EQU * * 08550002 * CHECK IF AUTHORIZED 08580002 TM WAFLAG2,WANOAUTH Q. CALLER AUTHORIZED VIA TESTAUTH. 08610002 BZ ENQYAUTO A. YES. SKIP AUTHORIZATION CHECKS. 08640002 * CHECK AUTHORIZATION FOR TCB,ECB,SMC 08670002 TM WAPLAST,PELTCBF Q. TCB KEYWORD SPECIFIED 08700002 BO ENQNAUTH A. YES. ABEND CALLER. 08730002 TM WAPFLAG,PELSTPMC Q. SMC KEYWORD SPECIFIED 08760002 BO ENQNAUTH A. YES. ABEND CALLER 08790002 TM WAECBA,WAECBF Q. ECB KEYWORD SPECIFIED. 08820002 BO ENQNAUTH A. YES. ABEND CALLER. 08850002 SPACE 3 08880002 ENQYAUTO EQU * * 08910002 ENQQPEL EQU * * 08940002 TM PELFLAG,PELSCPE2 Q. UCB SPECIFIED. 08970002 BZ ENQNUCB A. NO. 09000002 TM PELFLAG,PELSCPE1 Q. UCB SPECIFIED. 09030002 BO ENQNUCB A. NO. 09060002 * CHECK FOR VALID UCB 09090002 L R1,PELUCBAA GET THE UCB ADDR ADDR 09120002 L R1,ZERO(R1) GET THE UCB ADDR 09150002 CLI UCBID-UCBOB(R1),XFF Q. ABEND DUE TO BAD UCB AD. 09180002 BNE ENQYA438 A. YES. ABEND WITH 438 CODE. 09210002 TM WAFLAG2,WANOAUTH Q. CHECK UCB ADDRESS FURTHER. 09240002 BZ ENQNCHK A. NO. 09270002 L R14,TCBJSTCB-TCB(R4) GET POINTER TO JOB STEP TCB 09300002 ICM R14,M1111,TCBTIO-TCB(R14) Q. IS THERE A TIOT 09330002 BZ ENQNTIOT A. NO. INVALID UCB. ABEND 438. 09360002 LA R14,TIOELNGH-TIOT1(R14) SKIP TO DD ENTRIES 09390002 ENQQENTY EQU * * 09420002 SR R15,R15 ZERO FOR INSERT 09450002 ICM R15,M0001,TIOELNGH-TIOENTRY(R14) Q. ANY MORE DD-S 09480002 BZ ENQNENTY A. NO 'ABEND 438' INVALID UCB ADDRESS 09510002 LA R15,ZERO(R15,R14) 09540002 LA R14,TIOEFSRT-ONE-TIOENTRY(R14) GET ADDR. OF UCB ADDR 09570002 ENQQDEV EQU * * 09600002 CR R14,R15 Q. END OF DEVICES 09630002 BE ENQYNEXT A. YES, CHECK NEXT DD ENTRY 09660002 BH ENQNDEV A. YES, ERROR ABEND 09690002 CLM R1,M0111,ONE(R14) A. NO. Q. MATCH ON UCB 09720002 BE ENQYDEV A. YES, FOUND 09750002 LA R14,FOUR(R14) A. NO, GET NEXT DEVICE ENTRY ADDR. 09780002 B ENQQDEV LOOP 09810002 ENQYNEXT EQU * * 09840002 LR R14,R15 GET NEXT DD ENTRY 09870002 B ENQQENTY LOOP 09900002 EJECT 09930002 * FIND A MAJOR 09960002 ENQYDEV EQU * * 09990002 ENQNUCB EQU * * 10020002 ENQNCHK EQU * * 10050002 ENQQMAJ EQU * * 10080002 BAL R3,XFINDMAJ FIND MATCHING MAJOR 10110002 * INSERT AT THE TOP 10140002 LTR R9,R9 Q. FOUND ONE 10170002 BP ENQYMAJ A. YES, SKIP CREATING ONE 10200002 TM WAPFLAG,PELRET2 Q. RET=TEST/CHNG/USE 10230002 BZ ENQNTCU A. NO. WAS RET=NONE/HAVE/ECB 10260002 TM WAPFLAG,PELRET1+PELRET3 Q. TEST Q. CHNG 10290002 BO ENQYTEST A. TEST 'RETURN CODE 0' 10320002 BZ ENQYCNG2 A. CHNG. 'RETURN CODE 8' 10350002 ENQNTCU EQU * * 10380002 BAL R3,XGETMAJ OBTAIN STORAGE FOR MAJOR QCB 10410002 TM WAFLAG2,WANOCORE Q. STORAGE AVAILABLE 10440002 BO ENQNCORE A. NO, ERROR 10470002 EJECT 10500002 * INITIALIZE THE MAJOR 10530002 L R12,GSMJWORD GET ADDRESS OF MAJOR QCB 10560002 XC ZERO(MAJLEN,R12),ZERO(R12) ZERO MAJOR QCB STORAGE 10590002 L R15,PELMAJA GET ADDRESS OF QNAME 10620002 MVC MAJNAME-MAJ(EIGHT,R12),ZERO(R15) MOVE QNAME INTO MAJOR 10650002 EJECT 10680002 * CHAIN THE MAJOR 10710002 L R14,CVTPTR GET ADDRESS OF CVT 10740002 TEST6 EQU * * 10770002 L R9,CVTFQCB-CVT(R14) GET ADDRESS OF FIRST MAJOR QCB 10800002 LTR R9,R9 Q. ANY EXIST 10830002 BNZ ENQNFST A. YES, SKIP PROCESS FOR FIRST 10860002 * NO MAJORS EXIST 10890002 ST R12,CVTLQCB-CVT(R14) INIT. POINTER TO LAST MAJOR QCB 10920002 B ENQOUT SKIP INIT. BACKWARD POINTER 10950002 ENQNFST EQU * * 10980002 * NOT THE FIRST MAJOR (CHAIN ON TOP) 11010002 ST R9,MAJNMAJ-MAJ(R12) INITIALIZE NEXT POINTER 11040002 ST R12,MAJPMAJ-MAJ(R9) SET PREVIOUS POINTER 11070002 ENQOUT EQU * 11100002 ST R12,CVTFQCB-CVT(R14) NEW FIRST MAJOR QCB POINTER 11130002 LR R9,R12 TWO POINTERS TO NEW MAJOR QCB 11160002 * CHAIN OF MAJOR COMPLETE 11190002 B ENQNMAJ GO CREATE MINOR QCB 11220002 EJECT 11250002 * FIND A MINOR 11280002 ENQYMAJ EQU * * 11310002 BAL R3,XFINDMIN FIND MATCHING MINOR 11340002 LTR R10,R10 Q. FIND A MATCHING MINOR. 11370002 BP ENQYMIN A. YES. 11400002 TM WAPFLAG,PELRET2 Q. RET=TEST/CHNG/USE 11430002 BZ ENQNTCU1 A. NO. WAS RET=NONE/HAVE/ECB 11460002 TM WAPFLAG,PELRET1+PELRET3 Q. TEST Q. CHNG 11490002 BO ENQYTST1 A. TEST 'RETURN CODE 0' 11520002 BZ ENQYCNG3 A. CHNG. 'RETURN CODE 8' 11550002 ENQNTCU1 EQU * * 11580002 BAL R3,XGETMIN GET CORE FOR A MINOR QCB 11610002 TM WAFLAG2,WANOCORE Q. CORE OBTAINED 11640002 BO ENQYA638 A. NO, ERROR 11670002 EJECT 11700002 * INITIALIZE THE MINOR 11730002 ENQNMAJ EQU * * 11760002 * INITIALIZE AND CHAIN MINOR 11790002 L R12,GSMNWORD GET ADDRESS OF MINOR QCB 11820002 XC ZERO(MINLEN,R12),ZERO(R12) ZERO MINOR QCB STORAGE 11850002 * SET THE SCOPE 11880002 TM PELFLAG,PELSCPE1+PELSCPE2 Q. STEP SPECIFIED 11910002 BNZ ENQNSTEP A. NO, TRY SYSTEMS 11940002 * SET STEP 11970002 OI MINFLGS-MIN(R12),MINSTEP INDICATE STEP 12000002 MVC MINASID-MIN(TWO,R12),GSASID INIT ASID. 12030002 B ENQYSTEP SKIP REMAINING SCOPE PROCESSING 12060002 ENQNSTEP EQU * * 12090002 TM PELFLAG,PELSCPE2 Q. SYSTEMS SPECIFIED 12120002 BZ ENQNSYSS A. NO, MUST BE SYSTEM 12150002 * SET SYSTEMS 12180002 OI MINFLGS-MIN(R12),MINSYSS INDICATE SYSTEMS 12210002 B ENQYSYSS SKIP REMAINING SCOPE PROCESSING 12240002 ENQNSYSS EQU * * 12270002 OI MINFLGS-MIN(R12),MINSYS INDICATE SYSTEM 12300002 ENQYSTEP EQU * USED TO SKIP REMAINING SCOPE PROCESSING 12330002 ENQYSYSS EQU * USED TO SKIP REMAINING SCOPE PROCESSING 12360002 * MOVE MINOR NAME 12390002 L R14,PELMINA GET ADDRESS OF RNAME 12420002 ICM R15,M0001,PELMILEN Q. LENGTH OF RNAME ZERO 12450002 BNZ ENQYMIL A. NO, BYPASS ZERO PROCESSING 12480002 IC R15,ZERO(R14) GET LENGTH FROM BEGINNING OF RNAME 12510002 LA R14,ONE(R14) BUMP RNAME POINTER PAST LENGTH 12540002 ENQYMIL EQU * USED TO BYPASS PROCESSING FOR ZERO LENGTH 12570002 STC R15,MINNAMEL-MIN(R12) SAVE LENGTH 12600002 BCTR R15,ZERO DECREMENT LENGTH FOR EXECUTE 12630002 EX R15,MOVEMIN1 MOVE RNAME INTO MINOR 12660002 EJECT 12690002 * CHAIN THE MINOR 12720002 * INSERT AT THE TOP OF MINOR Q 12750002 L R10,MAJFMIN GET ADDRESS OF FIRST MINOR 12780002 LTR R10,R10 Q. ANY MINORS 12810002 BZ ENQY1ST A. NO, SKIP TO PROCESSING FOR FIRST MINOR 12840002 * NOT THE FIRST MINOR 12870002 ST R10,MINNMIN-MIN(R12) SET NEXT POINTER IN NEW MINOR 12900002 ST R12,MINPMIN-MIN(R10) SET PREVIOUS POINTER IN OLD MINOR 12930002 B ENQN1ST SKIP PROCESSING OF FIRST MINOR 12960002 ENQY1ST EQU * BRANCH TO ONLY WHEN FIRST MINOR 12990002 * FIRST MINOR 13020002 ST R12,MAJLMIN INITIALIZE LAST MINOR POINTER 13050002 ENQN1ST EQU * BRANCHED TO ONLY WHEN NOT FIRST MINOR 13080002 ST R12,MAJFMIN RESET POINTER TO FIRST MINOR 13110002 LR R10,R12 TWO POINTERS TO MINOR QCB 13140002 * CHAIN OF MINOR COMPLETE 13170002 * SET GROUP NUMBER TO 1 13200002 * SET NUMBER OF QELS IN GROUP 1 TO 1 13230002 * SET GROUPS 2,3 AND 4 TO ZERO 13260002 XC GSGPAREA(GSGPLEN),GSGPAREA ZERO GROUP COUNT AREA 13290002 MVI GSGROUP1+ONE,ONE SET GROUP NUMBER TO ONE 13320002 MVI GSGRPNUM+THREE,ONE NEW QEL IS IN GROUP 1 13350002 SR R11,R11 INDICATE NO MATCH QEL 13380002 B ENQNMIN GO CREATE QEL 13410002 EJECT 13440002 ENQYMIN EQU * * 13470002 TM MINFLGS,MINNOENQ Q. STOP ENQ FOR THIS MINOR 13500002 BO ENQYA838 A. YES. ABEND CODE '838' 13530002 TM TCBFLGS1,TCBFA Q. MY TCB ABENDING 13560002 BZ ENQNABND A. NO. 13590002 SPACE 2 13594040 * @ZA07146 13598040 * AVOID STEALING LOGIC FOR ENQ RET=TEST REQUEST @ZA07146 13602040 * @ZA07146 13606040 TM WAPFLAG,PELRET1+PELRET2+PELRET3 Q. RET=TEST @ZA07146 13610040 BO ENQYTST A. YES, PROCESS NORMALLY @ZA07146 13614040 EJECT 13620002 * ENQ'S STEAL QEL ROUTINE 13650002 * 13680002 * REQUIREMENTS FOR STEALING 13710002 * ENQ'S CALLER MUST BE ABEND 13740002 * THE PRESENT OWNER MUST NOT BE ABEND. 13770002 * THE ENQUEUEING PROGRAM MUST HAVE HAD PERMANENTLY LOST CONTROL 13800002 * ENQUEUED TCB MUST BE IN SAME ABEND TCB TREE. 13830002 * 13860002 * R11 IS THE QEL SEARCH REG 13890002 * R12 CONTAINS THE ABENDED QELTCB IN THIS ADDRESS SPACE 13920002 * R14 IS USED AS A QUICKY REG 13950002 * R15 IS USED TO SEARCH TO THE TOP OF BOTH TREES 13980002 * R0 IS USED AS A BCT REG 14010002 * R1 IS USED TO SAVE THE TOP OF THE FIRST TCB TREE 14040002 ENQQQEL1 EQU * * 14070002 L R11,MINLQEL GET BOTTOM QEL 14100002 ENQQQEL EQU * * 14130002 LTR R11,R11 Q. ANY QEL LEFT 14160002 BNP ENQNQEL A. NO. LOOP COMPLETE. 14190002 * CHECK IF THIS QEL BELONGS TO THIS ADDRESS SPACE 14220002 CLC QELASID(TWO),GSASID Q. QEL IN THIS ADDRESS SPACE 14250002 BNE ENQNASID A. NO. DONT STEAL. 14280002 L R12,QELTCB GET THE QEL'S TCB 14310002 LTR R12,R12 DITTO 14340002 BP ENQYTCB DITTO 14370002 L R12,QELTCB-QEL(R12) DITTO 14400002 ENQYTCB EQU * * 14430002 * CHECK IF QEL TCB IS ABENDING 14460002 CR R4,R12 Q. THIS TCB SAME AS QEL TCB 14490002 BE ENQYABNG A. YES. CAN STEAL. 14520002 TM TCBFLGS5-TCB(R12),TCBABWF Q. QEL-TCB ABENDING 14550002 BZ ENQNABNG A. NO. CANT STEAL. 14580002 ENQYABNG EQU * * 14610002 SPACE 3 14640002 * ARE THE TOPS OF BOTH TREES THE SAME 14670002 * INPUT R4 MYTCB R12 QELTCB 14700002 * OUTPUT R1 MYTOPTCB R15 QELTOPTCB 14730002 LR R1,R4 USE MY TCB TO FIND TOP 14760002 ENQQTOP1 EQU * * 14790002 TM TCBFLGS1-TCB(R1),TCBFT Q. IS IT TOP OF ABEND TREE 14820002 BO ENQYTOP1 A. YES. 14850002 ICM R1,M1111,TCBOTC-TCB(R1) A. NO. GET MOTHER 14880002 BNZ ENQQTOP1 LOOP. 14910002 ENQYTOP1 EQU * * 14940002 LR R15,R12 USE QEL TCB TO FIND TOP 14970002 ENQQTOP2 EQU * * 15000002 TM TCBFLGS1-TCB(R15),TCBFT Q. IS IT TOP OF ABEND TREE 15030002 BO ENQYTOP2 A. YES. 15060002 ICM R15,M1111,TCBOTC-TCB(R15) A. NO. GET MOTHER. 15090002 BNZ ENQQTOP2 LOOP. 15120002 ENQYTOP2 EQU * * 15150002 SPACE 3 15180002 CR R1,R15 Q. DOES MY TOP MATCH QEL TCB'S TOP 15210002 BNE ENQNMTCB A. NO, BYPASS STEALING @ZA32935 15240040 * @ZA32935 15391040 * SEE CHANGE ACTIVITY IN THE PROLOGUE FOR A GENERAL @ZA32935 15392040 * DESCRIPTION OF THIS FIX. HERE ARE A COUPLE OTHER @ZA32935 15393040 * COMMENTS: @ZA32935 15394040 * -STEALING IN GENERAL IS PERFORMED BECAUSE RTM WILL SET @ZA32935 15395040 * NONDISPATCHABLE ALL DAUGHTER TASKS OF A TASK WHICH IS @ZA32935 15396040 * ABNORMALLY TERMINATING. THE STEALING IS DONE BECAUSE @ZA32935 15397040 * ENQ RESOURCES MAY BE OWNED BY THESE TASKS. THERE IS @ZA32935 15398040 * VERY LIKELY CODE IN THE SYSTEM WHICH DEPENDS ON @ZA32935 15399040 * STEALING TO HAPPEN IN OTHER SITUATIONS IN ABNORMAL @ZA32935 15400040 * TERMINATION. THEREFORE, IT IS NECESSARY TO BE @ZA32935 15401040 * CAUTIOUS IN CHANGING CODE HERE. ONE KIND OF PROBLEM @ZA32935 15402040 * WHICH CAN OCCUR INVOLVES INTERLOCKS WHICH CAN ARISE @ZA32935 15403040 * BECAUSE OF ENQ'S ON MULTIPLE RESOURCES. @ZA32935 15404040 * -IF A TERM EXIT OR TASK RESOURCE MANAGER HOLDS AN ENQ @ZA32935 15405040 * RESOURCE AND IS THEN SET NON-DISPATCHABLE BY A HIGHER @ZA32935 15406040 * LEVEL TASK FOR ABNORMAL TERMINATION (PERHAPS FOR @ZA32935 15407040 * CANCEL), A DEADLOCK COULD BE CREATED. THEREFORE, IT @ZA32935 15408040 * IS NECESSARY FOR THIS FIX TO BYPASS STEALING ONLY IF @ZA32935 15408740 * THE CURRENT TASK OWNS THE RESOURCE. @ZA32935 15409440 * @ZA32935 15411040 TM QELQFLGS,QELTCBFA WAS TCBFA ON WHEN QEL BUILT? @ZA32935 15412040 BZ ENQYSTL NO, CONTINUE STEAL PROCESSING @ZA32935 15413040 CR R4,R12 IS RESOURCE OWNED BY CURRENT TCB @ZA32935 15414040 BE ENQNSTL YES, BYPASS STEALING @ZA32935 15415040 ENQYSTL EQU * @ZA32935 15416040 * DEQUEUE TO AVOID INTERLOCK IN ABEND PROCESSING 15420002 ST R4,GSR14SAV SAVE REG ACROSS DEQUEUE 15450002 LR R4,R12 INSERT QELTCB FOR DEQ(DIRECTED DEQ) 15480002 BAL R3,XQELSCAN TAKE SNAPSHOT OF QUEUES 15510002 LTR R11,R11 Q. FIND IT 15540002 BZ ENQNFIND A. NO. 15570002 BAL R2,XDEQQEL DEQUEUE THE QEL 15600002 ENQNFIND EQU * * 15630002 L R4,GSR14SAV SAVE REG ACROSS DEQUEUE 15660002 LTR R10,R10 Q. MINOR CHANGE 15690002 BP ENQQQEL1 A. NO. 15720002 B ENQQMAJ A. YES. BEGIN AGAIN. 15750002 SPACE 15753040 ENQNMTCB EQU * * @ZA32935 15756040 ENQNSTL EQU * * @ZA32935 15759040 ENQNABNG EQU * * 15762040 ENQNASID EQU * * 15765040 L R11,QELPQEL GET PREVIOUS QEL. 15768040 B ENQQQEL LOOP. 15771040 EJECT 15780002 ENQNQEL EQU * * 15810002 ENQYTST EQU * BYPASSES ENQ RESOURCE STEALING 15820040 ENQNABND EQU * * 15840002 BAL R3,XQELSCAN SEARCH FOR MATCHING QEL 15870002 LA R12,ONE SET TO ONE FOR COMPARE 15900002 LTR R11,R11 Q. SECOND REQUEST FOR THIS TASK 15930002 BZ ENQYNEW A. NO. THIS IS A NEW REQUEST. 15960002 C R12,GSGRPNUM Q. IS GROUP NUMBER ONE. 15990002 BNE ENQYWTNG A. OWNER WAITING 'RETUN CODE 20' 16020002 TM WAPFLAG,PELSTPMC Q. SMC=STEP AND RET=HAVE 16050002 BZ ENQNSMC A. NO. 16080002 TM WAPFLAG,PELRET1+PELRET2 Q. SMC=STEP AND RET=HAVE 16110002 BNZ ENQNHAVE A. NO. 16140002 TM WAPFLAG,PELRET3 Q. SMC=STEP AND RET=HAVE 16170002 BZ ENQNHAVE A. NO 16200002 * SMC=STEP AND RET=HAVE 16230002 * THE QELMC BIT IS SET , NO QEL IS BUILT 16260002 * THE QEL IS CHANGED FROM THE PREVIOUS REQUEST ONLY IN 16290002 * THAT THE QEL MC FLAG IS SET 16320002 * A STATUS WILL BE ISSUED EVEN THOUGH NO QEL WAS BUILT. 16350002 * THE SAME ACTION CAN BE ACCOMPLISHED BY THE CALLER 16380002 * IF HE ISSUES STATUS DIRECTLY 16410002 TM QELQFLGS,QELMC Q. IN MUST COMPLETE ALREADY 16440002 BO ENQYMC A. YES. DON'T ISSUE STATUS AGAIN 16470002 OI WAFLAG1,WASTATUS TELL MYSELF TO ISSUE STATUS 16500002 OI QELQFLGS,QELMC INDICATE USER IN MUST COMPLETE STATE 16530002 B ENQYHAVE GO BACK TO CALLER WITH 'RETURN CODE 8' 16560002 ENQYMC EQU * * 16590002 ENQNHAVE EQU * * 16620002 ENQNSMC EQU * * 16650002 TM WAPFLAG,PELRET2 Q. RET=CHNG 16680002 BZ ENQNCHNG A. NO 'RETURN CODE 8' 16710002 TM WAPFLAG,PELRET1+PELRET3 Q. RET=CHNG 16740002 BNZ ENQNCHNG A. NO. 'RETURN CODE 8' 16770002 * RET=CHNG 16800002 CH R12,GSGROUP1 Q. ONLY QEL IN GROUP 1 16830002 BNE ENQYSHRN A. NO. CURRENTLY SHARING. 16860002 * CAN CHANGE BECAUSE IT'S THE ONLY QEL IN GROUP 1 16890002 TM WAPFLAG,PELSTPMC Q. SMC=STEP 16920002 BZ ENQNSMC2 A. NO. 16950002 TM QELQFLGS,QELMC Q. IN MUST COMPLETE ALREADY 16980002 BO ENQYMC1 A. YES. DONT REISSUE STATUS 17010002 OI QELQFLGS,QELMC INDICATE USER IN MUST COMPLETE STATE 17040002 OI WAFLAG1,WASTATUS TELL MYSELF TO ISSUE STATUS 17070002 ENQYMC1 EQU * * 17100002 ENQNSMC2 EQU * * 17130002 NI QELQFLGS,XFF-QELSHARE MAKE EXCLUSIVE 17160002 B ENQYCHNG 'RETURN CODE 0' AOK 17190002 EJECT 17220002 ENQYNEW EQU * * 17250002 TM WAPFLAG,PELRET2 Q. RET=CHNG 17280002 BZ ENQNCNG1 A. NO. 17310002 TM WAPFLAG,PELRET1+PELRET3 Q. RET=CHNG 17340002 BZ ENQYCNG1 A. YES. 'RETURN CODE 8' 17370002 ENQNCNG1 EQU * NOT RET=CHNG 17400002 TM WAPFLAG,PELRET2+PELRET3 Q. RET=TEST OR RET=USE 17430002 BNO ENQNTU A. NO. BUILD QEL 17460002 C R12,GSGRPNUM Q. WOULD THE NEW QEL BE IN GROUP 1 17490002 BNE ENQNGP1 A. NO. 'RETURN CODE 4' 17520002 TM WAPFLAG,PELRET1+PELRET2+PELRET3 Q. RET=TEST 17550002 BO ENQYTST2 A. YES. 'RETURN CODE 0' 17580002 ENQNTU EQU * * 17610002 * BUILD A QEL 17640002 BAL R3,XGETQEL GET QEL CORE. 17670002 TM WAFLAG2,WANOCORE Q. OUT OF CORE 17700002 BO ENQNCORE A. YES 'ABEND 638' 17730002 EJECT 17760002 * INITIALIZE THE QEL 17790002 ENQNMIN EQU * * 17820002 * INITIALIZE AND CHAIN THE QEL 17850002 L R12,GSQLWORD GET THE QEL ADDRESS. 17880002 * R11 IS THE CURRENT QEL 17910002 * R12 IS THE NEW QEL TO BE CHAINED 17940002 * R15 IS THE LIST QEL FOR THIS REQUEST. 17970002 * R14 IS USED AS A QUICKY WORK REG 18000002 * R0 IS USED TO CONTAIN A ZERO 18030002 XC ZERO(QELSIZE1,R12),ZERO(R12) ZERO FIRST 4 WORDS 18060002 TM PELFLAG,PELSHARE Q. IS IT A SHARED REQUEST 18090002 BZ ENQNSHR A. NO. 18120002 OI QELQFLGS-QEL(R12),QELSHARE A. YES. INDICATE SHARED. 18150002 ENQNSHR EQU * * 18180002 TM WAPFLAG,PELSTPMC Q. SMC=STEP 18210002 BZ ENQNSMC1 A. NO. 18240002 OI QELQFLGS-QEL(R12),QELMC INDICATE MUST COMPLETE 18270002 OI WAFLAG1,WASTATUS TELL MYSELF TO ISSUE STATUS 18300002 ENQNSMC1 EQU * * 18330002 ICM R15,M1111,GSLSTQEL Q. WILL THE NEW QEL BE THE LIST QEL 18360002 BZ ENQYLQEL A. YES. 18390002 * BUILD A SUB QEL 18420002 O R15,HIGHBIT POINT THIS AT THE LIST QEL 18450002 ST R15,QELLQEL-QEL(R12) DITTO 18480002 ICM R14,M0111,QELLFLGS-QEL(R15) GET FLAGS AND ASID. 18510002 STCM R14,M0111,QELLFLGS-QEL(R12) PROPAGATE THEM 18540002 LA R1,QELSIZE1 ADDRESS OF UCB STORE 18570002 B ENQNLQEL CONTINUE. 18600002 ENQYLQEL EQU * LIST QEL INITIALIZATION. 18630002 SR R0,R0 ZERO FOR STORE 18660002 ST R0,QELLCNT-QEL(R12) ZERO LIST AND WAIT COUNTS. 18690002 * DO NOT UPDATE THE COUNT OF THIS TASKS LIST QEL'S, @ZA20351 18693040 * IF THE COUNT IS ABOUT TO WRAP AROUND. TCBQEL IS USED @ZA20351 18696040 * ONLY BY ENQ AND ITS RESOURCE MANAGER. IF TCBQEL WERE @ZA20351 18699040 * PERMITTED TO GO TO 0 WHEN IT IS REALLY A MULTIPLE OF @ZA20351 18702040 * 256, THE ENQ/DEQ RESOURCE MANAGER WOULD NOT ATTEMPT @ZA20351 18705040 * TO DEQ ANY RESOURCES. @ZA20351 18708040 CLI TCBQEL,XFF @ZA20351 18711040 BE NOUPDATE DO NOT UPDATE QEL COUNT @ZA20351 18714040 IC R0,TCBQEL BUMP TCB QEL(LIST QEL) COUNT 18720002 A R0,FONE DITTO 18750002 STC R0,TCBQEL 18780040 NOUPDATE EQU * @ZA20351 18790040 ICM R14,M1111,WAECBA Q. ECB REQUEST. 18810002 ST R5,QELSVRB-QEL(R12) BEST GUESS ,NOT ECB 18840002 BNM ENQNECB1 A. NO 18870002 ST R14,QELECB-QEL(R12) SAVE ECB ADDRESS 18900002 OI QELLFLGS-QEL(R12),QELECBF INDICATE ECB 18930002 ENQNECB1 EQU * * 18960002 ST R4,QELTCB-QEL(R12) SAVE THE TCB ADDRESS. 18990002 OI QELQFLGS-QEL(R12),QELLIST INDICATE LIST QEL 19020002 LH R14,GSASID GET THE ASID 19050002 STH R14,QELASID-QEL(R12) SAVE THE ASID. 19080002 LR R15,R12 SET THE LIST QEL REG TO THIS QEL 19110002 LA R1,QELSIZE2 ADDRESS OF UCB STORE 19140002 ST R12,GSLSTQEL SAVE THE LIST QEL ADDRESS. 19170002 ENQNLQEL EQU * * 19200002 * STORE UCB IF RESERVE REQUEST 19230002 TM PELFLAG,PELSCPE2 Q. UCB SPECIFIED. 19260002 BZ ENQNUCB1 A. NO. 19290002 TM PELFLAG,PELSCPE1 Q. UCB SPECIFIED. 19320002 BO ENQNUCB1 A. NO. 19350002 L R14,PELUCBAA GET THE UCB ADDR ADDR 19380002 L R14,ZERO(R14) GET THE UCB ADDR 19410002 TM UCBTBYT3-UCBOB(R14),UCB3DACC Q. DASD @YA00805 19440003 BZ ENQNUCB1 A. NO. @YA00805 19470003 TM UCBTBYT2-UCBOB(R14),UCB2OPT2 Q. SHARED @YA00805 19500003 BO ENQYUCB1 A. YES. @YA00805 19530003 LR R0,R14 SAVE UCB ADDR @YA00805 19532003 ICM R14,M0111,UCBEXTP-UCBOB(R14) GET UCB EXT. ADDR @YA00805 19533003 TM UCBFLP1-UCBETI(R14),UCBSHRUP Q. SHR CAPABILITY @YA00805 19536003 LR R14,R0 RESTORE UCB ADDR @YA00805 19538003 BZ ENQNUCB1 A. NO. PROCESS AS NORMAL ENQ @YA00805 19538303 ENQYUCB1 EQU * PROCESS AS RESERVE @YA00805 19538603 LA R14,ZERO(R14) CLEAR HIGH BYTE OF UCB ADDRESS @YM04705 19540002 ST R14,ZERO(R1,R12) STORE UCB ADDRESS 19560002 OI QELQFLGS-QEL(R12),QELRESV SET THE RESERVE INDICATOR 19590002 ENQNUCB1 EQU * * 19620002 TM WAFLAG2,WANOAUTH CHECK FOR NOT AUTH. @ZA17306 19626040 BO ENQNAUT2 NOT AUTH., DO NOT SET FLAG @ZA17306 19632040 OI QELQFLGS-QEL(R12),QELAUTH SET AUTH. FLAG @ZA17306 19638040 ENQNAUT2 EQU * @ZA17306 19644040 TM TCBFLGS1,TCBFA IS TASK TERMINATING ABNORMALLY? @ZA32935 19645040 BZ ENQNFA NO, DO NOT SET FLAG @ZA32935 19646040 OI QELQFLGS-QEL(R12),QELTCBFA YES, SET FLAG @ZA32935 19647040 ENQNFA EQU * @ZA32935 19648040 * BUMP THE LIST QEL COUNT (NUMBER OF ACTIVE QELS) 19650002 LH R14,QELLCNT-QEL(R15) BUMP COUNT 19680002 LA R14,ONE(R14) DITTO 19710002 STH R14,QELLCNT-QEL(R15) DITTO 19740002 EJECT 19770002 * CHAIN THE QEL 19800002 ICM R11,M1111,MINLQEL GET THE LAST QEL OFF MINOR 19830002 BZ ENQYFIRS THERE IS NONE 19860002 * ADD TO BOTTOM 19890002 ST R11,QELPQEL-QEL(R12) SET PREVIOUS 19920002 ST R12,QELNQEL-QEL(R11) SET NEXT 19950002 B ENQNFIRS CONTINUE 19980002 ENQYFIRS EQU * ADD TO THE MINOR 20010002 * ONLY QEL 20040002 ST R12,MINFQEL-MIN(R10) SET FIRST 20070002 ENQNFIRS EQU * * 20100002 ST R12,MINLQEL-MIN(R10) SET LAST 20130002 LR R11,R12 MAKE NEW THE CURRENT 20160002 EJECT 20190002 LA R0,TWO USE TWO FOR COMPARE(S) 20220002 C R0,GSGRPNUM Q. GROUP 1 20250002 BNH ENQNGRP1 A. NO. 20280002 * GROUP 1 20310002 TM QELQFLGS,QELRESV Q. RESERVE 20340002 BZ ENQNRESV A. NO 'RETURN CODE 0' 20370002 * RESERVE AND GROUP 1 20400002 L R15,PELUCBAA GET THE UCB ADDR ADDR 20430002 L R15,ZERO(R15) GET THE UCB ADDR 20460002 SR R14,R14 BUMP UCB RESERVE COUNT 20490002 IC R14,UCBSQC-UCBOB(R15) DITTO 20520002 LA R14,ONE(R14) DITTO 20550002 STC R14,UCBSQC-UCBOB(R15) DITTO 20580002 TM QELQFLGS,QELAUTH CHECK FOR AUTH. INVOKER @ZA17306 20584040 BNO ENQNAUT3 SKIP SYSEVENT @ZA17306 20588040 LR R1,R10 PASS MINOR QCB TO SRM @ZA17306 20592040 LH R0,QELASID PASS ASID TO SRM @ZA17306 20596040 SYSEVENT ENQHOLD,ASID=(0),ENTRY=BRANCH @ZA17306 20600040 ENQNAUT3 EQU * @ZA17306 20604040 B ENQYRESV 'RETURN CODE 0' 20610002 ENQNGRP1 EQU * NOT GROUP 1 20640002 * NOT GROUP 1 20670002 LH R14,QELWCNT-QEL(R15) BUMP THE WAIT COUNT 20700002 LA R14,ONE(R14) DITTO 20730002 STH R14,QELWCNT-QEL(R15) DITTO 20760002 C R0,GSGRPNUM Q. GROUP 2 20790002 BNE ENQNGRP2 A. NO 20820002 * GROUP 2 20850002 LH R14,GSGROUP2 Q. 1 QEL IN GROUP 2 20880002 CR R0,R14 DITTO 20910002 BNH ENQNONE A. NO. 20940002 LH R1,GSGROUP1 GET NUMBER OF QELS IN GROUP 1 20970002 L R12,MINFQEL GET FIRST QEL IN GROUP 1 21000002 BAL R3,XHOLD ISSUE THE HOLD EVENT FOR GROUP 1 21030002 ENQNONE EQU * * 21060002 ENQNGRP2 EQU * * 21090002 * GROUP 2 OR MORE 21120002 TM WAECBA,WAECBF Q. ECB REQUEST 21150002 BO ENQYECB A. YES. 'RETURN CODE 4' 21180002 OI WAFLAG2,WAWAIT SET WILL WAIT WITHIN ENQ. 21210002 L R12,CVTPTR GET CVT ADDRESS @Z30BNVD 21212003 L R12,CVTASVT-CVT(R12) GET ASVT ADDRESS @Z30BNVD 21214003 LA R1,MINFQEL PREPARE QEL PTR FOR LOOP @Z30BNVD 21216003 NEXTQEL EQU * LOOP LABEL @Z30BNVD 21218003 L R1,ZERO(R1) GET FIRST/NEXT QEL ADDR @Z30BNVD 21220003 LTR R1,R1 Q. ANY MORE QELS @Z30BNVD 21222003 BZ ENQNECB A. NO. DONE @Z30BNVD 21224003 LH R3,QELASID-QEL(R1) GET ASID FROM QEL @Z30BNVD 21226003 BCTR R3,ZERO ASVT INDEX = ASID-1 @Z30BNVD 21228003 SLL R3,TWO MULTIPLY INDEX BY 4 @Z30BNVD 21230003 L R3,ASVTENTY-ASVT(R3,R12) GET ASCB ADDR @Z30BNVD 21232003 TM ASCBDSP1-ASCB(R3),ASCBNOQ Q. ASCB REMOVED FROM X21234003 DISPATCHING QUEUE @Z30BNVD 21236003 BZ NEXTQEL A. NO. GO GET ANOTHER @Z30BNVD 21237003 OI WAFLAG3,WALONGWT LONG WAIT TO BE ISSUED @Z30BNVD 21238003 B ENQNECB 'RETURN CODE 0' 21240002 EJECT 21270002 ENQYA838 EQU * * 21300002 * REQUEST DENIED 21330002 MVI WAERR,AB838 'ABEND CODE 838' 21360002 B ENQPART2 PROCEED TO PART 2 21390002 ENQYA638 EQU * 'ABEND CODE 638' 21420002 * OUT OF CORE 21450002 ENQNCORE EQU * OUT OF CORE 21480002 MVI WAERR,AB638 'ABEND CODE 638' 21510002 B ENQPART2 PROCEED TO PART 2 21540002 * ABEND CODE 538 IS OBSOLETE 21570002 ENQYA438 EQU * 'ABEND CODE 438' 21600002 * INVALID PARAMETER LIST 21630002 ENQYRESB EQU * 'RESERVED BITS SPECIFIED' 21660002 ENQNENTY EQU * * 21690002 ENQNDEV EQU * * 21720002 ENQNTIOT EQU * * 21750002 ENQYCONF EQU * CONFLICTING PARAMETERS 21780002 ENQNTCB1 EQU * * 21810002 MVI WAERR,AB438 'ABEND CODE 438' 21840002 B ENQPART2 PROCEED TO PART 2 21870002 ENQYA338 EQU * ' ABEND CODE 338 ' 21900002 * NOT AUTHORIZED FOR REQUESTED FUNCTION 21930002 ENQNAUTH EQU * CALLER NO AUTHORIZED 21960002 MVI WAERR,AB338 ' ABEND CODE 338 ' 21990002 B ENQPART2 PROCEED TO PART 2 22020002 ENQYA238 EQU * 'ABEND CODE 238' 22050002 ENQYMIL0 EQU * MINOR NAME LENGTH OF 0 22080002 * MINOR NAME LENGTH 0 22110002 MVI WAERR,AB238 'ABEND CODE 238' 22140002 B ENQPART2 PROCEED TO PART 2 22170002 ENQYRC20 EQU * 'RETURN CODE 20' 22200002 ENQYWTNG EQU * * 22230002 * TASK IS WAITING FOR RESOURCE 22260002 * RET=NONE (SEE ABEND 138) 22290002 MVI WARET,TWENTY 'RETURN CODE 20' 22320002 B ENQPART2 PROCEED TO PART 2 22350002 * RETURN CODE 12 AND 16 HAVE BECOME OBSOLETE 22356002 ENQYRC8 EQU * * @YM03340 22359002 ENQNCHNG EQU * * @YM03340 22362002 ENQYHAVE EQU * * @YM03340 22368002 * TASK ALREADY OWNS RESOURCE 22374002 NI WAPLAST,XFF-PELSHR INDICATE EXCLUSIVE @YM03340 22380002 * RESOURCE CONTROL 22383002 TM QELQFLGS-QEL(R11),QELSHARE Q. SHARED RESOURCE @YM03340 22386002 BZ ENQYXCLU A. NO - EXCLUSIVE CONTROL @YM03340 22392002 OI WAPLAST,PELSHR INDICATE SHARED RESOURCE @YM03340 22398002 ENQYXCLU EQU * BYPASS SETTING OF SHR FLAG @YM03340 22404002 ENQYCNG2 EQU * * 22440002 ENQYCNG1 EQU * * 22530002 ENQYCNG3 EQU * * 22560002 * RET=CHNG NOTHING FOUND 22620002 * RET=NONE NEVER (SEE ABEND CODE 138) 22650002 MVI WARET,EIGHT 'RETURN CODE 8' 22680002 B ENQPART2 PROCEED TO PART 2 22710002 ENQYRC4 EQU * * 22740002 ENQYSHRN EQU * * 22770002 ENQNGP1 EQU * * 22800002 ENQYECB EQU * * 22830002 * RET=NONE NEVER 22860002 * RET=TEST NOT AVAILABLE 22890002 * RET=USE NOT AVAILABLE 22920002 * RET=HAVE NEVER 22950002 * RET=CHNG CURRENTLY SHARING 22980002 * ECB= NOTAVAILABLE, WAIT FOR POST 23010002 MVI WARET,FOUR 'RETURN CODE 4' 23040002 B ENQPART2 PROCEED TO PART 2 23070002 ENQYRC0 EQU * * 23100002 ENQYTEST EQU * * 23130002 ENQYCHNG EQU * * 23160002 ENQNRESV EQU * * 23190002 ENQNECB EQU * * 23220002 ENQYRESV EQU * * 23250002 ENQYTST1 EQU * * 23280002 ENQYTST2 EQU * * 23310002 * RET=NONE ASSIGNED 23340002 * RET=TEST IS AVAILABLE 23370002 * RET=USE ASSIGNED 23400002 * RET=HAVE ASSIGNED 23430002 * RET=CHNG RESOURCE NOW EXCLUSIVE 23460002 * ECB= ASSIGNED, DO NOT WAIT ON ECB 23490002 MVI WARET,ZERO ZERO RETURN CODE @YM04705 23500002 ENQYABN EQU * * 23520002 EJECT 23550002 ENQPART2 EQU * ENQ PART TWO 23580002 CLI WARET,ZERO Q. IS THIS RETURN CODE ZERO 23610002 BE ENQYZERO A. YES. 23640002 OI WAFLAG2,WAR15SW INDICATE HAVE A NON ZERO RET CODE. 23670002 ENQYZERO EQU * * 23700002 CLI WAERR,ZERO Q. ABEND REQUIRED. 23730002 BNE ENQYABND A. YES 23760002 TM WAPFLAG,PELRET1+PELRET2+PELRET3 Q. RET=NONE (DEFAULT) 23790002 BNZ ENQYSTOR A. NO.STORE RET CODE. 23820002 * RET=NONE 23850002 CLI WARET,ZERO Q. RETURN CODE OF ZERO 23880002 BE ENQNSTOR A. YES NOT A 138 AND DON'T STORE R.C. 23910002 MVI WAERR,AB138 CHANGE TO 138 ABEND. 23940002 B ENQY138 'ABEND WITH CODE 138' 23970002 ENQYSTOR EQU * * 24000002 LR R14,R8 CURRENT PEL 24030002 S R14,WANEWPEL PEL DISPLACEMENT 24060002 AL R14,WAOLDPEL CORRESPONDING OLD PEL 24090002 LH R2,WAKEY GET THE USERS KEY 24120002 TEST6A EQU * * 24150002 MODESET KEYADDR=(2) SET PSW TO CALLERS KEY 24180002 SR R15,R15 ZERO WORK REG @YM03340 24190002 IC R15,WARET GET RETURN CODE 24210002 STC R15,PELRET-PEL(R14) STORE RETURN CODE. 24240002 C R15,FEIGHT Q. RETURN CODE 8 @YM03340 24243002 BNE ENQNNO8 A. NO, SKIP ADDITIONAL SUPPORT @YM03340 24246002 NI PELLAST-PEL(R14),XFF-PELSHR INDICATE EXCLUSIVE @YM03340 24249002 TM WAPLAST,PELSHR Q. SHARED RESOURCE @YM03340 24252002 BZ ENQYXCL A. NO SKIP SETTING SHARE FLAG @YM03340 24255002 OI PELLAST-PEL(R14),PELSHR INDICATE SHARED @YM03340 24258002 ENQYXCL EQU * BYPASS SETTING OF SHR FLAG @YM03340 24261002 ENQNNO8 EQU * BYPASS EXCLUSIVE/SHARE SUPPORT @YM03340 24265002 TEST6B EQU * * 24270002 MODESET EXTKEY=SUPR SET KEY BACK TO ZERO 24300002 ENQNSTOR EQU * * 24330002 TM PELLAST,PELEOL Q. END OF LIST 24360002 BO ENQYEOL A. YES END OF LIST 24390002 TM PELFLAG,PELSCPE2 Q. UCB PARM ELEM 24420002 BZ ENQNUCB2 A. NO. 24450002 TM PELFLAG,PELSCPE1 Q. UCB PARM ELEM 24480002 BO ENQNUCB2 A. NO. 24510002 LA R8,FOUR(R8) COMPENSATE FOR UCB WORD 24540002 ENQNUCB2 EQU * * 24570002 LA R8,PELELEM(R8) BUMP TO NEXT ELEMENT 24600002 B ENQQPEL PROCESS THE NEXT ELEMENT 24630002 ENQYEOL EQU * YES END OF LIST 24660002 NI WAFLAG1,XFF-WACMS INDICATE FREED CMS 24780002 X9 SETLOCK RELEASE,TYPE=CMS,RELATED=((X4)) RELEASE CMS 24810002 TEST7 EQU * * 24840002 NI WAFLAG1,XFF-WAFRR INDICATE DELETED FRR 24870002 SETFRR D,WRKREGS=(R14,R15) DELETE FRR. 24900002 TEST8 EQU * * 24930002 TM WAFLAG2,WAWAIT Q. MUST WAIT. @YM03564 24937002 BZ ENQNWAIT A. NO. SKIP WAIT. @YM03564 24944002 * WAIT 24951002 * 24951940 * NEED ESTAE EXIT TO COVER WAIT - CLEAN-UP RELATED CNTL BLKS @ZA03873 24952840 * REGS 1, 13 AND 15 ARE USED DURING INTERFACE TO ESTAE @Z40FPVD 24953540 LR R1,R5 DUPLICATE RB ADDR @Z40FPVD 24954540 LA R13,ENQESTAE ESTAE EXIT ROUTINE ADDR @ZA03873 24957040 S R1,ERBPREL RB PERFIX ADDR @Z40FPVD 24957540 FESTAE EXITADR=(R13),RBADDR=(R1),TCBADDR=(R4), X24958040 PARAM=(R5),TERM=YES,RECORD=YES @Z40FPVD 24959040 LA R0,ONE WAIT COUNT 24960002 TM WAFLAG3,WALONGWT Q. ISSUE LONG WAIT @Z30BNVD 24970003 BZ NORMWAIT A. NO. SKIP IT @Z30BNVD 24980003 O R0,HIGHBIT LONG WAIT INDICATOR 24990002 NORMWAIT EQU * ECB PREPARATION @Z30BNVD 25000003 SR R1,R1 ZERO ECB MEANS RB WAIT 25020002 L R15,WAITADDR GET BRANCH ENTRY TO WAIT 25050002 STM R0,R15,TCBGRS-TCB(R4) SAVE ENQ REGS 25080002 LA R14,ENQXADDR GET RESUME ADDRESS 25110002 ST R14,RBOPSW+FOUR SET RESUME ADDRESS. 25140002 NI WAFLAG1,XFF-WALOCAL WAIT FREES LOCK, FLAG OFF @YM03564 25150002 TEST9 EQU * * 25170002 BALR R14,R15 WAIT WITH NO ECB. 25200002 * THE ABOVE BALR IS ONLY AN ILLUSION 25230002 ENQXADDR EQU * GET RESUME ADDRESS 25235002 FESTAE 0,WRKREG=(R13) @Z40FPVD 25239040 ENQNWAIT EQU * * 25290002 TM WAFLAG1,WASTATUS Q. ISSUE STATUS 25350002 BZ ENQNSTAT A. NO 25380002 TM WAFLAG1,WALOCAL Q. HOLD LOCAL LOCK @YM03564 25381002 BO YLOCKED3 A. YES NO NEED TO OBTAIN @YM03564 25382002 SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,RELATED=((X7)) @YM03564 25383002 OI WAFLAG1,WALOCAL INDICATE LOCAL LOCK HELD @YM03564 25384002 YLOCKED3 EQU * USED TO BYPASS OBTAIN OF LOCK @YM03564 25385002 * INITIALIZE PARAMETERS FOR BRANCH ENTRY TO STATUS @YM03564 25390002 L R0,FONE STEP MUST COMPLETE @YM03564 25410002 SR R1,R1 SET AND CURRENT TCB @YM03564 25415002 L R15,CVTPTR LOCATE STATUS BRANCH ENTRY ADDR. @YM03564 25420002 L R14,CVTABEND-CVT(R15) DITTO @YM03564 25425002 L R15,SCVTSTAT-SCVTSECT(R14) DITTO @YM03564 25430002 BALR R14,R15 SET MUST COMPLETE @YM03564 25435002 TEST10 EQU * * 25440002 ENQNSTAT EQU * * 25470002 BAL R3,XENDUP PERFORM END PROCESSING @YM03564 25480002 SR R15,R15 ASSUME R15 ZERO. 25500002 TM WAFLAG2,WAR15SW Q. SET R15 TO ZERO 25530002 BZ ENQYZ15 A. YES 25560002 L R15,WAOLDPEL SET R15 TO PARM LIST ADDR. 25590002 ENQYZ15 EQU * * 25620002 L R14,CVTPTR GET CVT ADDRESS 25650002 TEST11 EQU * * 25680002 L R14,CVTEXPRO-CVT(R14) GET EXIT ADDRESS. 25710002 BR R14 RETURN 25740002 ENQY138 EQU * * 25770002 ENQYABND EQU * * 25800002 ENQXRTRY EQU * RETRY FROM HERE AFTER ERROR 25830002 * R5,R6,R7 AND R13 ARE SET CORRECTLY 25860002 BAL R3,XENDUP PERFORM END PROCESSING 25890002 LA R1,ENQCODE GET BACK END OF ENQ CODE 25920002 ICM R1,M0010,WAERR GET FRONT OF ABEND CODE 25950002 ABEND (1),DUMP,,SYSTEM ABEND MY CALLER 25980002 EJECT 26010002 ENQESTAE EQU * SOFTWARE RECOVERY ROUTINE @ZA03873 26017040 BALR R15,ZERO TEMP ADDRESSABILITY @ZA03873 26017140 USING *,R15 DITTO @ZA03873 26017240 LM R6,R7,BASE PERMANENT ADDRESSABILITY @ZA03873 26017340 DROP R15 @ZA03873 26017440 USING IGC048,R6,R7 DITTO @ZA03873 26017540 USING SDWA,R1 @ZA03873 26017640 LA R12,TWELVE Q, SDWA AVAILABLE @ZA03873 26017740 CR R0,R12 DITTO @ZA03873 26017840 BE ENQESKIP A. NO, BYPASS CLEANUP, NO SA @ZA03873 26017940 STM R14,R12,TWELVE(R13) SAVE REGS IN SA @ZA03873 26018040 L R5,SDWAPARM PARM IS RB PTR @ZA03873 26018840 LR R8,R13 SAVE SAVE AREA ADDR @ZA03873 26018940 ENQEGLL SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND, @ZA03873X26019040 RELATED=(ENQERLL) @ZA03873 26019240 OI WAFLAG1,WALOCAL INDICATE LOCAL LOCK HELD @ZA03873 26019340 SETFRR A,PARMAD=(R12),FRRAD=ENQFRR,WRKREGS=(R10,R11) @ZA03873 26020940 ST R5,ZERO(R12) FRR INPUT - WA @ABILITY @ZA03873 26021640 ENQEGCMS SETLOCK OBTAIN,TYPE=CMS,MODE=UNCOND,RELATED=(ENQECMS) @ZA03873 26021840 OI WAFLAG1,WACMS INDICATE CMS LOCK HELD @ZA03873 26022040 L R13,CVTPTR GET GLOBAL SAVE AREA ADDR @ZA03873 26022240 L R13,CVTSPSA-CVT(R13) DITTO @ZA03873 26022440 L R13,WSAGNQDQ-WSAG(R13) DITTO @ZA03873 26022640 XC GSCLEAR(GSCLEARL),GSCLEAR ZERO COMMON GS @ZA03873 26022840 L R14,PSAAOLD SAVE THE ASID @ZA03873 26023040 MVC GSASID(TWO),ASCBASID-ASCB(R14) DITTO @ZA03873 26023240 ST R8,GSPSAVE SAVE CALLERS SA ADDR @ZA03873 26023440 L R8,WANEWPEL GET CORRECT PLIST ADDR @ZA03873 26023640 L R4,PSATOLD SUBROUTINES NEED TCB ADDR @ZA03873 26023740 ENQELOOP EQU * RESTART RESOURCE SEARCH @ZA03873 26023840 BAL R3,XFINDMAJ FIND MATCHING MAJOR @ZA03873 26024040 LTR R9,R9 Q. FOUND A MAJOR @ZA03873 26024240 BNP ENQENELM A. NO, SKIP ELEMENT @ZA03873 26024440 BAL R3,XFINDMIN FIND MATCHING MINOR @ZA03873 26024640 LTR R10,R10 Q. FOUND A MINOR @ZA03873 26024840 BNP ENQENELM A. NO, SKIP ELEMENT @ZA03873 26025040 BAL R3,XQELSCAN SCAN THE QELS @ZA03873 26025240 LTR R11,R11 Q. FOUND MATCH QEL @ZA03873 26025440 BZ ENQENELM A. SKIP ELEMENT @ZA03873 26025640 BAL R2,XDEQQEL DEQUE CURRENT QEL @ZA03873 26025840 ENQENELM EQU * SKIPS PROCESSING OF ELEMENT @ZA03873 26026040 TM PELLAST,PELEOL Q. END OF LIST @ZA03873 26026240 BO ENQEDONE A. YES, GET OUT @ZA03873 26026440 TM PELFLAG,PELSCPE2 Q. UCB ADDR PRESENT @ZA03873 26026640 BZ ENQENUCB A. NO, GET NEXT ELEMENT @ZA03873 26026840 TM PELFLAG,PELSCPE1 Q. UCB ADDR PRESENT @ZA03873 26027040 BZ ENQENUCB A. NO, GET NEXT ELEMENT @ZA03873 26027240 LA R8,FOUR(R8) COMPENSATE FOR UCB WORD @ZA03873 26027440 ENQENUCB EQU * SKIPS UCB COMPENSATION @ZA03873 26027640 LA R8,PELELEM(R8) BUMP TO NEXT ELEMENT @ZA03873 26027840 B ENQELOOP PROCESS NEXT ELEMENT @ZA03873 26028040 ENQEDONE EQU * PLIST PROCESSING COMPLETE @ZA03873 26028240 L R8,GSPSAVE CALLERS SA ADDR @ZA03873 26028440 NI WAFLAG1,XFF-WACMS FREED CMS LOCK @ZA03873 26028640 ENQECMS SETLOCK RELEASE,TYPE=CMS,RELATED=(ENQEGCMS) @ZA03873 26028840 SETFRR D,WRKREGS=(R14,R15) DELETE FRR @ZA03873 26029040 ENQERLL SETLOCK RELEASE,TYPE=LOCAL,RELATED=(ENQEGLL) @ZA03873 26029240 LR R13,R8 RESTORE CALLERS REG 13 @ZA03873 26029440 LM R14,R12,TWELVE(R13) RESTORE REGS @ZA03873 26029640 LR R8,R14 SAVE RETURN ADDR @ZA03873 26029840 SETRP DUMP=IGNORE,RC=0,RECORD=NO @ZA10756 26029940 LR R14,R8 RESET RETURN ADDR @ZA03873 26030240 ENQESKIP EQU * BYPASSES PLIST PROCESSING @ZA03873 26030440 SR R15,R15 NO SDWA - CONT WITH TERM @ZA03873 26030640 BR R14 RETURN TO RTM @ZA03873 26030840 EJECT 26031040 IEAVENQ2 EQU * RESOURCE MANAGER 26040002 STM R14,R12,TWELVE(R13) SAVE REGS 26070002 LR R9,R13 SAVE CALLER'S REG 13 26100002 BALR R6,ZERO TEMP ADDRESSABILITY 26130002 USING *,R6 26160002 DROP R7 26190002 LM R6,R7,BASE GET MODULE ADDRESSABILITY 26220002 USING IGC048,R6,R7 MODULE ADDRESSABILITY 26250002 USING RMPL,R8 RES. MGR. PARM LIST ADDRESSABILITY 26280002 L R8,ZERO(R1) SAVE RMPL ADDRESS. 26310002 L R5,RMPLRMWA OBTAIN R.M. WORK AREA 26340002 LA R14,RBEXSAVE-RBSECT GET DISPLACEMENT TO XSAVE 26370002 SLR R5,R14 MAKE WORK AREA LOOK LIKE XSAVE 26400002 * REFERENCES ARE ONLY ALLOWED TO THE WORK AREA (NONE ALLOWED TO THE RB) 26430002 XC WA(WARMLEN),WA ZERO R.M. SECTION 26460002 ICM R4,M1111,RMPLTCBA Q. MEMORY TERMINATION 26490002 BZ ERMYMEM A. YES. MUST CHECK ALL QELS. 26520002 * TASK TERMINATION 26550002 TM TCBFLGS2,TCBFJMC Q. THIS TASK IN STEP MUST COMPLETE 26580002 BZ ERMNSTAT A. NO DONT ISSUE STATUS. 26610002 OI WAFLAG2,WARMC REMINDER TO ISSUE STATUS 26640002 TM RMPLFLG1,RMPLTYPE Q. ABNORMAL TERMINATION 26670002 BZ ERMNAB A. NO. 26700002 OI WAFLAG1,WAABNDMC INDICATE ABENDED IN MUST COMPLETE 26730002 ERMNAB EQU * * 26760002 ERMNSTAT EQU * * 26790002 CLI TCBQEL,ZERO Q. ANY QELS FOR THIS TASK 26820002 BE ERMNQELS A. NO. NOTHING TO DO. 26850002 B ERMNMEM CONTINUE 26880002 ERMYMEM EQU * * 26910002 * MEMORY TERMINATION 26940002 L R14,RMPLASCB GET THE TERMINATED ASCB 26970002 CLI ASCBSMCT-ASCB(R14),ZERO Q. DID MEM FAIL IN M.C. 27000002 BE ERMNSMC A. NO 27030002 OI WAFLAG1,WAABNDMC A. YES. REMEMBER THIS. 27060002 ERMNSMC EQU * * 27090002 ERMNMEM EQU * * 27120002 * NEED TO SCAN QUEUES 27150002 * INITIALIZE FOR MAIN LINE CODE 27180002 X5 SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,RELATED=((X7)) LOCK 27210002 TEST12 EQU * * 27240002 OI WAFLAG1,WALOCAL INDICATE LOCAL LOCK SET 27270002 LA R2,ERMFRR SETUP RM RECOVERY 27300002 SETFRR A,PARMAD=(R13),FRRAD=(R2),WRKREGS=(R14,R15) COVER 27330002 TEST13 EQU * * 27360002 OI WAFLAG1,WAFRR INDICATE A NEED TO RESET FRR. 27390002 ST R5,ZERO(R13) FRR INPUT IS W.A. ADDRESSABILITY 27420002 X6 SETLOCK OBTAIN,TYPE=CMS,MODE=UNCOND,RELATED=((X8)) LOCK 27450002 TEST14 EQU * * 27480002 OI WAFLAG1,WACMS INDICATE CMS SET 27510002 L R13,CVTPTR GET CVT ADDRESS. 27540002 TEST15 EQU * * 27570002 L R13,CVTSPSA-CVT(R13) GET THE GLOBAL SAVE AREA TABLE 27600002 L R13,WSAGNQDQ-WSAG(R13) GET ENQ GLOBAL SAVE AREA 27630002 XC GSCLEAR(GSCLEARL),GSCLEAR RESET TO ZERO. 27660002 ST R9,GSPSAVE SAVE CALLER'S REG 13 27690002 LH R15,RMPLASID SAVE THE ASID 27720002 STH R15,GSASID DITTO 27750002 EJECT 27780002 * MAIN PROCESSING 27810002 MVI WARETRY,RETRYERM PASS INDEX TO RETRY 27840002 USING PEL,R8 ADDRESSABILITY TO PEL. 27870002 LA R8,DUMMYPEL SETUP DUMMY PEL FOR QELSCAN RTN 27900002 L R9,CVTPTR GET THE CVT ADDRESS 27930002 TEST16 EQU * * 27960002 L R9,CVTFQCB-CVT(R9) GET THE FIRST MAJOR QCB 27990002 ERMQMAJ EQU * * 28020002 LPR R9,R9 Q. ANY MAJORS 28050002 BZ ERMNMAJ A. NO. NONE LEFT. 28080002 L R10,MAJFMIN GET FIRST MINOR. 28110002 ERMQMIN EQU * * 28140002 LPR R10,R10 Q. ANY MOINORS 28170002 BZ ERMNMIN A. NO. NONE LEFT 28200002 ERMQQEL EQU * * 28230002 L R11,MINLQEL DEQUEUE FROM BOTTOM. 28260002 * DEQ FROM BOTTOM AVOIDS SOME OVERHEAD (POSTS,SYSEVENTS,ETC.) 28290002 ERMQQEL1 EQU * * 28320002 LPR R11,R11 Q. ANY QELS LEFT. 28350002 BZ ERMNQEL A. NO. TRY NEXT MINOR. 28380002 LH R15,QELASID Q. SAME MEMORY 28410002 CH R15,GSASID DITTO 28440002 BE ERMYQEL A. YES. POSSIBLE DEQUEUE. 28470002 L R11,QELPQEL GET THE PREVIOUS QEL. 28500002 B ERMQQEL1 LOOP 28530002 ERMYQEL EQU * * 28560002 BAL R3,XQELSCAN Q. MATCH FOR THIS ASID.TCB 28590002 LTR R11,R11 DITTO 28620002 BZ ERMNMTCH A. NO. 28650002 * HAVE A MATCH QEL 28680002 TM WAFLAG1,WAABNDMC Q. NEED A WARNING MESSAGE. 28710002 BZ ERMNWTO A. NO. 28740002 TM QELQFLGS,QELSHARE Q. NEED FOR WARNING MESSAGE 28770002 BO ERMNWTO A. NO 28800002 TM MINFLGS,MINSTEP Q. NEED FOR WTO WARNING MSG 28830002 BO ERMNWTO A. NO 28860002 ICM R12,M1111,QELLQEL Q. HAVE THE LIST QEL ADDRESS. 28890002 BM ERMYHAVE A. YES 28920002 LR R12,R11 A. NO. HAVE NOW. 28950002 ERMYHAVE EQU * * 28980002 ICM R15,M0011,QELWCNT-QEL(R12) Q. HAVE RESOURCE 29010002 BNZ ERMNWTO A. NO. NEVER HAD THIS ONE. 29040002 LA R0,WTOLEN GET MESSAGE LENGTH 29070002 L R14,SP253 GET SUBPOOL 29100002 BAL R12,XGET GET STORAGE 29130002 LTR R15,R15 Q. CAN WTO BE WRITTEN 29160002 BNZ ERMNWTO A. NO 29190002 * CONSTRUCT WTO MESSAGE 29220002 MVC FOUR(WTOLEN-FOUR,R1),ERMWTO2 'RESOURCE MAY BE DAMAGED' 29250002 MVC INSERT6+FOUR(INSERT6L,R1),MAJNAME MOVE IN MAJOR NAME 29280002 SR R15,R15 CLEAR FOR INSERT 29310002 IC R15,MINNAMEL GET LENGTH 29340002 CH R15,HMAXLEN Q. LENGTH LT MAXIMUM LENGTH 29370002 BL ERMYLESS A. YES. 29400002 LA R15,INSERT7L NO. SET TO MAXIMUM LENGTH. 29430002 ERMYLESS EQU * * 29460002 BCTR R15,ZERO MOVE MINOR NAME TO GOTTEN STORAGE. 29490002 EX R15,MOVEMIN2 DITTO 29520002 LA R15,INSERT7+TWO(R1,R15) FORMULATE ADDRESS 29550002 MVC FOUR(MAYLEN,R15),MAYBEDAM MOVE REST OF MESSAGE 29580002 L R15,WAWTOQ GET TOP OF QUEUE 29610002 ST R15,ZERO(R1) SAVE TOP 29640002 ST R1,WAWTOQ CHAIN THIS ONE. 29670002 ERMNWTO EQU * * 29700002 BAL R2,XDEQQEL DEQ THE MATCH QEL 29730002 LTR R9,R9 Q. DID MAJOR CHANGE 29760002 BNP ERMQMAJ A. YES. PROCESS MAJOR. 29790002 LTR R10,R10 Q. MINOR CHANGE 29820002 BNP ERMQMIN A. YES. PROCESS MINOR. 29850002 B ERMQQEL PROCESS QEL 29880002 ERMNQEL EQU * * 29910002 ERMNMTCH EQU * * 29940002 L R10,MINNMIN GET NEXT MINOR 29970002 B ERMQMIN LOOP ON MINOR QUEUE 30000002 ERMNMIN EQU * * 30030002 L R9,MAJNMAJ GET NEXT MAJOR 30060002 B ERMQMAJ LOOP ON MAJOR QUEUE. 30090002 ERMNMAJ EQU * * 30120002 * PROCESSED ALL QELS. 30150002 ICM R15,M1111,WAWTOQ Q. ANY WTO'S 30180002 BZ ERMNWTOS A. NO. 30210002 LA R0,WTOLEN GET CORE FOR WTO. 30240002 L R14,SP253 GET SUBPOOL NUMBER 30270002 BAL R12,XGET GET STORAGE 30300002 LTR R15,R15 Q. CAN WTO BE WRITTEN 30330002 BNZ ERMNWTOS A. NO. 30360002 MVC FOUR(WTOLEN-FOUR,R1),ERMWTO1 'JOB FAILED IN STEP M.C.' 30390002 LTR R4,R4 Q. TCB 30420002 BZ ERMNTCB A. NO. 30450002 ICM R15,M1111,TCBTIO Q. TIOT. 30480002 BZ ERMNTIOT A. NO. 30510002 MVC INSERT3+FOUR(INSERT3L,R1),TIOCNJOB-TIOT1(R15) JOB NAME 30540002 MVI INSERT4+FOUR(R1),C',' COMMA 30570002 MVC INSERT5+FOUR(INSERT5L,R1),TIOCSTEP-TIOT1(R15) STEP NAME 30600002 ERMNTIOT EQU * * 30630002 C R4,TCBJSTCB Q. JOB STEP TCB. 30660002 BE ERMYJBST A. YES 30690002 MVC INSERT5A+FOUR(TWO,R1),ST MOVE IN STEP 30720002 ERMYJBST EQU * * 30750002 L R15,WAWTOQ GET TOP OF QUEUE 30780002 ST R15,ZERO(R1) SAVE TOP 30810002 ST R1,WAWTOQ CHAIN THIS ONE. 30840002 LA R0,WTOLEN GET CORE FOR WTO. 30870002 L R14,SP253 GET SUBPOOL NUMBER 30900002 BAL R12,XGET GET STORAGE 30930002 LTR R15,R15 Q. CAN WTO BE WRITTEN 30960002 BNZ ERMNWTOS A. NO. 30990002 MVC FOUR(WTOLEN-FOUR,R1),ERMWTP 'JOB FAILED IN M.C. (CODE)' 31020002 C R4,TCBJSTCB Q. JOB STEP TCB 31050002 BE ERMYJS A. YES. 31080002 MVC INSERT1+FOUR(INSERT1L,R1),ST MOVE IN STEP ABREV. 31110002 ERMYJS EQU * * 31140002 MVO ZERO(THREE,R1),TCBCMPC(TWO) MOVE ABC TO 0ABC 31170002 ICM R15,M1100,ZERO(R1) Q. SYSTEM CODE 31200002 BNZ ERMYSYST A. YES. 31230002 MVI INSERT2+FOUR(R1),C'U' A.NO. USER CODE. 31260002 MVC ZERO(TWO,R1),TCBCMPC+ONE MOVE XABC TO XABC 31290002 ERMYSYST EQU * * 31320002 UNPK ZERO(FOUR,R1),ZERO(THREE,R1) UNPACK XABC TO FAFBFC 31350002 TR ZERO(THREE,R1),TABLE-C'0' TRANSLATE FAFBFC TO C'ABC' 31380002 MVC INSERT2+FOUR+ONE(THREE,R1),ZERO(R1) MOVE RESULT. 31410002 ERMNTCB EQU * * 31440002 L R15,WAWTOQ GET TOP OF QUEUE 31470002 ST R15,ZERO(R1) SAVE TOP 31500002 ST R1,WAWTOQ CHAIN THIS ONE. 31530002 ERMNWTOS EQU * * 31560002 ERMXRTRY EQU * * 31590002 L R9,GSPSAVE GET CALLER'S REG 13 31620002 ERMNQELS EQU * * 31650002 BAL R3,XENDUP CLEAN UP WHERE NECESSARY 31680002 ERMQWTO1 EQU * * 31710002 ICM R12,M1111,WAWTOQ Q. ANY WTO MESSAGES. 31740002 BZ ERMNWTO1 A. NO. 31770002 L R15,NEXT(R12) UNCHAIN 31800002 ST R15,WAWTOQ DITTO 31830002 * WRITE MESSAGE 31860002 LA R1,FOUR(R12) GET MESSAGE ADDRESS 31890002 LH R0,ZERO(R1) GET LENGTH 31920002 WTO MF=(E,(1)) WRITE TO OPERATOR OR PROGRAMER 31950002 TEST18 EQU * * 31980002 LA R0,WTOLEN GET LENGTH TO FREE 32010002 LR R1,R12 PASS ADDRESS TO FREE 32040002 L R14,SP253 GET SUBPOOL 32070002 BAL R12,XSVCFREE FREE THE STORAGE 32100002 B ERMQWTO1 LOOP. 32130002 ERMNWTO1 EQU * * 32160002 LR R13,R9 RESTORE CALLER'S REG13 32190002 LM R14,R12,TWELVE(R13) RESTORE REGS. 32220002 TEST19 EQU * * 32250002 BR R14 RETURN 32280002 BASE DC A(IGC048) FIRST BASE REGISTER VALUE 32300040 BASE1 DC A(IGC048+4096) SECOND BASE REGISTER VALUE 32320040 EJECT 36120002 XDEQQEL EQU * DEQUEUE THE INPUT QEL 36150002 * INPUT-- 36180002 * R11 IS THE QEL TO BE DEQUEUED 36210002 ICM R12,M1111,QELLQEL Q. IS CURRENT QEL A SUB QEL 36240002 BM YSUBQEL A. YES 36270002 * MAY HAVE TO DECREMENT THE TCBQEL COUNT (NUMBER OF LIST QELS) 36300002 LR R12,R11 A. NO. CURRENT IS A LIST QEL 36330002 YSUBQEL EQU * * 36360002 LH R1,QELLCNT-QEL(R12) GET THE NUMBER OF ACTIVE QELS. 36390002 BCTR R1,ZERO DITTO 36420002 STH R1,QELLCNT-QEL(R12) DITTO 36450002 LA R0,ONE USED FOR COMPARE 36480002 C R0,GSGRPNUM Q. MATCH IN GROUT 1 36510002 BNE NGROUP1 A. NO 36540002 * THE MATCH QEL IS IN GROUP 1 36570002 TM QELLFLGS-QEL(R12),QELPOST+QELECBF Q. SPOST NECESSARY 36600002 BNO NSPOST A. NO. 36630002 OI WAFLAG1,WASPOST INDICATE SPOST MUST BE ISSUED. 36660002 NSPOST EQU * * 36690002 LH R1,GSGROUP2 GET NUMBER OF QELS IN GRP 2 36720002 LTR R1,R1 Q. GROUP 2 EXIST 36750002 BZ NGROUP2 A. NO 36780002 * MATCH IN GRP 1 AND GRP 2 EXISTS 36810002 CH R0,GSGROUP1 Q. LAST QEL IN GROUP 1 36840002 BNE NALONE A. NO. 36870002 * LAST QEL IN GROUP 1 AND A GROUP 2 EXISTS. 36900002 L R12,QELNQEL GET THE 1ST QEL IN GROUP 2 36930002 BAL R3,XPOST POST GROUP 2 36960002 LH R1,GSGROUP3 GET QEL COUNT FOR GRP 3 36990002 LTR R1,R1 Q. GROUP 3 EXIST 37020002 BZ NGROUP3 A. NO. 37050002 L R12,QELNQEL GET 1ST QEL IN GROUP 2 37080002 LH R1,GSGROUP2 GET GROUP 2 QEL COUNT. 37110002 BAL R3,XHOLD ISSUE SYSEVENT FOR GROUP 2 37140002 NGROUP3 EQU * * 37170002 NALONE EQU * * 37200002 LA R1,ONE NUMBER OF QELS TO BE RLSE'D 37230002 LR R12,R11 RLSE CURRENT QEL 37260002 BAL R3,XRLSE ISSUE SYSEVENT FOR THIS QEL 37290002 NGROUP2 EQU * * 37320002 TM QELQFLGS,QELRESV Q. IS CURRENT QEL RESERVE QEL 37350002 BZ NRESERVE A. NO. 37380002 * MATCH QEL IS IN GROUP 1 AND IS RESERVE 37410002 TM QELQFLGS,QELLIST Q. LIST QEL 37440002 L R12,QELSIZE1(R11) GET THE UCB ADDRESS 37470002 BZ NLSTQEL A. NO. 37500002 L R12,QELSIZE2(R11) GET THE UCB ADDRESS 37530002 NLSTQEL EQU * * 37560002 * GROUP 1 AND RESERVE AND DASD DEVICE IS SHARABLE 37590002 SR R0,R0 ZERO FOR INSERT 37620002 IC R0,UCBSQC-UCBOB(R12) DECREMENT THE RESERVE COUNT 37650002 S R0,FONE DITTO 37680002 STC R0,UCBSQC-UCBOB(R12) DITTO 37710002 TM QELQFLGS,QELAUTH CHECK FOR AUTH. INVOKER @ZA17306 37713040 BNO ENQNAUT4 SKIP SYSEVENT @ZA17306 37716040 LR R1,R10 PASS MINOR QCB TO SRM @ZA17306 37719040 LH R0,QELASID PASS ASID TO SRM @ZA17306 37722040 SYSEVENT ENQRLSE,ASID=(0),ENTRY=BRANCH @ZA17306 37725040 ENQNAUT4 EQU * @ZA17306 37728040 CLI UCBSQC-UCBOB(R12),ZERO CHECK RESERVE COUNT @ZA17306 37731040 BNZ NRELEASE COUNT DID NOT GO TO ZERO 37740002 TM UCBFLB-UCBOB(R12),UCBRESVH Q. RESV. OUTSTANDING @YA00805 37741003 BZ NRELEASE A. NO. SKIP RELEASE @YA00805 37743003 * GRP 1 AND RESERVE AND SHRD DASD AND RESV COUNT HIT ZERO 37770002 * RELEASE THE RESERVED DEVICE (IF NOT ALREADY RELEASED) 37800002 STM R0,R15,GSSAVE1 SAVE REGS ACROSS 'STARTIO' 37830002 LR R2,R12 SAVE UCB ADDRESS. 37860002 L R14,SP245 GET SUBPOOL NUMBER 37890002 LA R0,ZLEN GET LENGTH FOR IOSB AND SRB 37920002 BAL R12,XGET GET CORE FOR IOSB AND SRB 37950002 LTR R15,R15 Q. CORE GOTTEN 37980002 BNZ NSIOCORE A. NO. IGNORE 'STARTIO' 38010002 LA R3,ZSRB-Z(R1) GET SRB ADDRESS. 38040002 LA R4,ZIOSB-Z(R1) GET IOSB ADDRESS. 38070002 XC Z-Z(ZLEN,R1),Z-Z(R1) INITIALIZE IOSB AND SRB TO ZERO. 38100002 ST R4,SRBPARM-SRB(R3) PASS IOSB ADDRESS AS PARAMETER 38130002 OI IOSOPT-IOSB(R4),IOSBYP+IOSRELSE BYPASS CK.ADD RLSE CCW 38160002 OI IOSDVRID-IOSB(R4),IOSMISID SET MISCELLANEOUS I.D. 38190002 MVI IOSASID+ONE-IOSB(R4),ONE I/O RELATED TO MASTER A.S. 38220002 LA R1,XSTARTIO ADDRESS OF SCHEDULED ROUTINE. 38250002 ST R1,IOSPGAD-IOSB(R4) SAVE IT. 38280002 ST R2,IOSUCB-IOSB(R4) PASS UCB ADDRESS. 38310002 LA R14,BR14 ADDRESS OF NOP EXIT ROUTINE. 38340002 ST R14,IOSNRM-IOSB(R4) NOP NORMAL EXIT ROUTINE 38370002 ST R14,IOSABN-IOSB(R4) NOP ABNORMAL EXIT ROUTINE 38400002 STARTIO SRB=(3) RELEASE DEVICE, IF NEED BE. @YM04188 38430002 NSIOCORE EQU * * 38460002 LM R0,R15,GSSAVE1 RESTORE REGS 38490002 NRELEASE EQU * * 38520002 NRESERVE EQU * * 38550002 B YGROUP1 CONTINUE. 38580002 NGROUP1 EQU * * 38610002 * MATCH NOT IN GROUP 1 38640002 LH R1,QELWCNT-QEL(R12) LOWER THE WAIT COUNT. 38670002 BCTR R1,ZERO DITTO 38700002 STH R1,QELWCNT-QEL(R12) DITTO 38730002 LA R0,TWO USE FOR COMPARE 38760002 C R0,GSGRPNUM Q. MATCH IN GROUP 2 38790002 BNE NGRP2 A. NO. 38820002 * MATCH QEL IS IN GROUP 2 38850002 LA R0,ONE USE FOR COMPARE 38880002 CH R0,GSGROUP2 Q. LAST QEL IN GROUP 2 38910002 BNE NALONE1 A. NO. 38940002 * MATCH IN GRP 2 AND LAST QEL IN GROUP 2 38970002 L R12,MINFQEL GET 1ST QEL IN GROUP 1 39000002 CH R0,GSGROUP3 Q. GRP 3 EXIST 39030002 BNH YGRP3 A. YES. 39060002 * MATCH IN GRP 2 AND LAST QEL IN GRP 2 AND THERE IS NO GROUP 3 39090002 LH R1,GSGROUP1 GET THE NUMBER OF QELS IN GROUP 1 39120002 BAL R3,XRLSE ISSUE SYSEVENT FOR GROUP 1 39150002 B NGRP3 CONTINUE. 39180002 YGRP3 EQU * * 39210002 * MATCH IN GRP 2 AND LAST QEL IN GROUP 2 AND A GRP 3 EXISTS 39240002 TM QELQFLGS-QEL(R12),QELSHARE Q. GRP 1 SHARE 39270002 BZ NSHARE A. NO. 39300002 L R12,QELNQEL GET 1ST QEL IN GROUP 3 39330002 TM QELQFLGS-QEL(R12),QELSHARE Q. GRP 3 SHARE 39360002 BZ NSHARE A. NO. 39390002 * MATCH QEL IS ONLY QEL IN GRP 2 AND GRPS 1 & 3 ARE SHARE 39420002 LH R1,GSGROUP3 GET QEL COUNT FOR GROUP 3 39450002 BAL R3,XPOST POST GROUP 3 39480002 SR R0,R0 USE FOR COMPARE 39510002 CH R0,GSGROUP4 Q. GRP 4 EXIST 39540002 BNE YGRP4 A. YES. 39570002 * MATCH QEL IS LONE QEL IN GRP 2 AND GRPS 1&3 ARE SHARE AND NO GRP 4 39600002 LH R1,GSGROUP1 GET NUMBER OF QELS IN GROUP 1 39630002 L R12,MINFQEL GET 1ST QEL IN GROUP 1 39660002 BAL R3,XRLSE ISSUE SYSEVENT FOR GROUP 1 39690002 B NGRP4 CONTINUE. 39720002 YGRP4 EQU * * 39750002 * MATCH QEL IS LONE QEL IN GRP 2 AND GRPS 1&3 ARE SHARE AND A GRP 4 39780002 LH R1,GSGROUP3 GET NUMBER OF QELS IN GROUP 3 39810002 L R12,QELNQEL GET 1ST QEL IN GROUP 3 39840002 BAL R3,XHOLD ISSUE SYSEVENT FOR GROUP 3 39870002 NGRP4 EQU * * 39900002 NSHARE EQU * * 39930002 NGRP3 EQU * * 39960002 NALONE1 EQU * * 39990002 NGRP2 EQU * * 40020002 YGROUP1 EQU * * 40050002 * MOST OF DEQUEUE COMPLETE 40080002 * FREE THE QEL (POSSIBLY THE MINOR AND THEN POSSIBLY THE MAJOR) 40110002 * FREEQMM 40140002 LR R12,R11 SAVE QEL TO BE FREED. 40170002 L R11,QELNQEL SET CURRENT QEL TO NEXT QEL 40200002 LCR R11,R11 INDICATE A QEL CHANGE 40230002 * UNCHAIN THE INPUT QEL 40260002 LA R1,MINFQEL PASS FIRST/LAST TO UNCHAIN RTN 40290002 BAL R3,XUNCHAIN UNCHAIN 40320002 TM QELQFLGS-QEL(R12),QELLIST Q. IS THIS A LIST QEL 40350002 BO YLISTQEL A. YES. 40380002 LR R1,R12 PASS QEL TO BE FREED. 40410002 L R12,QELLQEL-QEL(R12) GET THE LIST QEL ADDRESS. 40440002 ST R12,GSR2SAVE SAVE THE LIST QEL ADDRESS 40470002 BAL R3,XFREEQEL FREE THE SUB QEL 40500002 L R12,GSR2SAVE RESTORE THE LIST QEL ADDRESS 40530002 YLISTQEL EQU * * 40560002 ICM R0,M0011,QELLCNT-QEL(R12) Q. CAN LIST QEL BE FREED. 40590002 BNZ NFREE A. NO. 40620002 LTR R4,R4 Q. POSSIBLE TO DECREMENT 40650002 BZ NDECR A. NO. TCB NOT THERE 40680002 * DECREMENT 40732040 L R14,QELTCB-QEL(R12) GET THE QEL TCB 40740002 * DO NOT DECREMENT THE TCB LIST QEL COUNT IF IT IS 255. @ZA20351 40742040 * TO PREVENT WRAPPING, WHEN TCBQEL IS INCREMENTED, IT @ZA20351 40744040 * IS NOT INCREMENTED BEYOND 255. THAT MAKES IT @ZA20351 40746040 * NECESSARY TO NOT DECREMENT TCBQEL ONCE IT REACHES 255.@ZA20351 40748040 * (IF IT WERE DECREMENTED FROM 255, IT MIGHT REACH 0 @ZA20351 40750040 * PREMATURELY.) THE ONLY EFFECT OF LEAVING THE COUNT AT @ZA20351 40752040 * 255 IS THAT THE RESOURCE MANAGER WILL SCAN @ZA20351 40754040 * FOR UN-DEQED RESOURCES EVEN WHEN THE TASK DOES @ZA20351 40756040 * NOT HAVE ANY ENQED RESOURCES. @ZA20351 40758040 CLI TCBQEL-TCB(R14),XFF @ZA20351 40760040 BE NDECR DO NOT DECREMENT @ZA20351 40762040 IC R1,TCBQEL-TCB(R14) DECREMENT THE TCB QEL COUNT 40770002 BCTR R1,ZERO DITTO 40796040 STC R1,TCBQEL-TCB(R14) DITTO 40830002 NDECR EQU * * 40860002 LA R1,ZERO(R12) PASS THE LIST QEL ADDRESS 40890002 BAL R3,XFREEQEL FREE THE LIST QEL 40920002 NFREE EQU * * 40950002 ICM R15,M1111,MINFQEL Q. MINOR EMPTY 40980002 BNZ YQEL A. NO. 41010002 * UNCHAIN THE MINOR. 41040002 LR R12,R10 GET MINOR TO BE FREED. 41070002 L R10,MINNMIN MAKE NEXT THE CURRENT 41100002 LCR R10,R10 INDICATE A MINOR CHANGE 41130002 LA R1,MAJFMIN PASS ADDR OF FIRST/LAST 41160002 BAL R3,XUNCHAIN UNCHAIN THE MINOR. 41190002 LR R1,R12 PASS ADDRESS TO BE FREED 41220002 BAL R3,XFREEMIN FREE THE MINOR. 41250002 ICM R15,M1111,MAJFMIN Q. MAJOR EMPTY 41280002 BNZ YMIN A. NO. 41310002 * UNCHAIN THE MAJOR 41340002 LR R12,R9 MAJOR TO BE FREED. 41370002 L R9,MAJNMAJ MAKE NEXT MAJOR CURRENT 41400002 LCR R9,R9 INDICATE A MAJOR CHANGE 41430002 L R1,CVTPTR GET CVT ADDRESS. 41460002 TEST21 EQU * * 41490002 LA R1,CVTFQCB-CVT(R1) GET FIRST/LAST ADDRESS. 41520002 BAL R3,XUNCHAIN UNCHAIN THE MAJOR. 41550002 LR R1,R12 PASS ADDRESS TO FREE 41580002 BAL R3,XFREEMAJ FREE THE MAJOR. 41610002 YMIN EQU * * 41640002 YQEL EQU * * 41670002 * COMPLEMENTED REGISTER INDICATES A CHANGE TO THAT QUEUE. 41700002 * THE COMPLEMENTED ADDRESS IS THE NEW CURRENT ADDRESS. 41730002 BR R2 RETURN 41760002 EJECT 41790002 XENDUP EQU * * 41820002 TM WAFLAG1,WACMS Q. HAVE CMS. 41850002 BZ NCMS A. NO. 41880002 NI WAFLAG1,XFF-WACMS INDICATE FREED CMS 41910002 X8 SETLOCK RELEASE,TYPE=CMS,RELATED=((X4),(X6)) UNLOCK 41940002 TEST22 EQU * * 41970002 NCMS EQU * * 42000002 TM WAFLAG1,WAFRR Q. HAVE AN FRR 42030002 BZ NFRR1 A. NO 42060002 SETFRR D,WRKREGS=(R14,R15) DELETE FRR. 42090002 TEST23 EQU * * 42120002 NFRR1 EQU * * 42150002 TM WAFLAG2,WANWPEL Q. WAS PARM LIST CORE GOTTEN 42540002 BZ NMOVE A. NO 42570002 TM WAFLAG1,WALOCAL Q. HOLD LOCAL LOCK @YM03564 42575002 BO YLOCKED1 A. YES, NO NEED TO OBTAIN @YM03564 42580002 SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,RELATED=((X7)) @YM03564 42585002 OI WAFLAG1,WALOCAL INDICATE LOCAL LOCK HELD @YM03564 42590002 YLOCKED1 EQU * USED TO BYPASS OBTAIN OF LOCK @YM03564 42595002 L R1,WANEWPEL GET ADDRESS OF CORE TO FREE 42600002 L R0,WAPARMSZ GET THE STORAGE LENGTH 42630002 A R0,WANAMESZ DITTO 42660002 L R14,SP253 GET SUBPOOL 42690002 BAL R12,XFREE FREE THE STORAGE @YM03564 42720002 NMOVE EQU * * 42750002 TM WAFLAG2,WARMC Q. ISSUE RESET M.C. 42780002 BZ NRMC A. NO. 42810002 TM WAFLAG1,WALOCAL Q. HOLD LOCAL LOCK @YM03564 42815002 BO YLOCKED2 A. YES, NO NEED TO OBTAIN @YM03564 42819002 SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,RELATED=((X7)) @YM03564 42823002 OI WAFLAG1,WALOCAL INDICATE LOCAL LOCK HELD @YM03564 42827002 YLOCKED2 EQU * USED TO BYPASS OBTAIN OF LOCK @YM03564 42831002 * INITIALIZE PARAMETERS FOR BRANCH ENTRY TO STATUS @YM03564 42835002 L R0,FONE STEP MUST COMPLETE @YM03564 42840002 L R1,HIGHBIT RESET AND CURRENT TCB @YM03564 42845002 L R15,CVTPTR LOCATE STATUS BRANCH ENTRY ADDR. @YM03564 42850002 L R14,CVTABEND-CVT(R15) DITTO @YM03564 42855002 L R15,SCVTSTAT-SCVTSECT(R14) DITTO @YM03564 42860002 BALR R14,R15 RESET MUST COMPLETE STATUS @YM03564 42865002 TEST26 EQU * * 42870002 NRMC EQU * * 42900002 TM WAFLAG1,WALOCAL Q. HAVE LOCAL LOCK @YM03564 42902002 BZ NLOCAL A. NO. @YM03564 42904002 X7 SETLOCK RELEASE,TYPE=LOCAL,RELATED=((X3),(X5)) @YM03564 42906002 TEST24 EQU * * @YM03564 42908002 NLOCAL EQU * * @YM03564 42910002 TM WAFLAG2,WADAMAGE Q. QUEUES BEEN DAMAGED. @YM03564 42912002 BZ NDAMAGE A. NO. @YM03564 42914002 LA R1,FRRWTO GET Q-DAMAGE MESSAGE @YM03564 42916002 LH R0,ZERO(R1) GET LENGTH @YM03564 42918002 WTO MF=(E,(1)) WRITE IT. @YM03564 42920002 TEST25 EQU * * @YM03564 42922002 NDAMAGE EQU * * @YM03564 42924002 TM WAFLAG1,WASPOST Q. ISSUE SPOST 42930002 BZ NSPOST1 A. NO. 42960002 SPOST 42990002 TEST29 EQU * * 43020002 NSPOST1 EQU * * 43050002 BR R3 RETURN. 43080002 EJECT 43110002 XFINDMAJ EQU * * 43140002 L R9,CVTPTR GET ADDRESS OF CVT 43170002 TEST30 EQU * * 43200002 ICM R9,M1111,CVTFQCB-CVT(R9) Q. ANY MAJOR 43230002 L R12,PELMAJA GET ADDRESS OF QNAME 43260002 QMAJOR EQU * * 43290002 BZR R3 A. NO. 43320002 CLC ZERO(EIGHT,R12),MAJNAME Q. MAJOR NAMES MATCH 43350002 BER R3 A. YES, STOP SEARCH 43380002 ICM R9,M1111,MAJNMAJ Q. ANY MORE MAJORS 43410002 B QMAJOR GO CHECK RESULTS 43440002 EJECT 43470002 XFINDMIN EQU * * 43500002 * INPUT-- 43530002 * R3 IS THE RETURN REGISTER. 43560002 * R8 HAS POINTER TO INPUT PARM ELEM. 43590002 * PELSCPE1,PELSCPE2,PELMINA,PELMILEN 43620002 * INPUT MINOR NAME (POINTED TO BY PELMINA) 43650002 * R9 CONTAINS POINTER TO CURRENT MAJOR 43680002 * MAJFMIN 43710002 * MINNMIN,MINSTEP,MINSYS,MINSYSS,MINASID,MINNAMEL,MINNAME 43740002 * R13 HAS POINTER TO GS (GLOBAL SAVE) 43770002 * GSASID 43800002 * PROCESS-- 43830002 * R10 IS USED FOR CURRENT MINOR IN MINOR SEARCH. 43860002 * R12 IS USED TO POINT TO THE INPUT MINOR NAME. 43890002 * R14 IS USED AS A QUICKY REGISTER 43920002 * R15(LOW ORDER BYTE) CONTAINS THE INPUT PARM ELEM'S MINOR LENGTH. 43950002 * OUTPUT-- 43980002 * R10 CONTAINS THE MATCHING MINOR (FIND) OR ZERO (NO FIND) 44010002 * R12,R14,R15 ARE DESTROYED. 44040002 L R10,MAJFMIN GET THE FIRST MINOR. 44070002 L R12,PELMINA GET ADDRESS OF MINOR NAME(OR MIN LEN) 44100002 ICM R15,M0001,PELMILEN Q. IS MINOR LENGTH ZERO(DYNAMIC) 44130002 BNZ NDYNAM A. NO. HAVE THE MINOR LENGTH. 44160002 IC R15,ZERO(R12) GET THE DYNAMIC LENGTH. 44190002 LA R12,ONE(R12) ADJUST ADDR TO POINT TO NAME 44220002 B QMINOR MINOR LOOP. @YM03564 44225002 NEQSCOPE EQU * * @YM03564 44230002 NEQNAME EQU * * @YM03564 44235002 NEQLEN EQU * * @YM03564 44240002 L R10,MINNMIN GET NEXT MINOR @YM03564 44245002 NDYNAM EQU * * 44250002 * HAVE THE MINOR NAME LENGTH 44280002 QMINOR EQU * * 44310002 LTR R10,R10 Q. ANY MORE MINORS. 44340002 BZR R3 A. NO. RETURN (NO FIND) 44370002 LR R14,R15 DUPLICATE MINOR NAME LENGTH @YM03564 44400002 IC R14,MINNAMEL GET LENGTH FROM MINOR QCB @YM03564 44410002 CR R14,R15 Q. MINOR NAME LENGTHS EQUAL @YM03564 44420002 BNE NEQLEN A. NO. LENGTH NOT EQUAL. 44430002 * LENGTHS ARE EQUAL 44460002 * NOW CHECK FOR NAME MATCH. 44490002 BCTR R14,ZERO Q. REQUEST FOR THIS MINOR @YM03564 44550002 EX R14,COMPMIN DITTO 44580002 BNE NEQNAME A. NO. GET NEXT MINOR. 44610002 * NAMES ARE THE SAME 44640002 * NOW CHECK FOR SCOPE MATCH. 44670002 TM PELFLAG,PELSCPE1+PELSCPE2 Q. REQUESTING STEP 44700002 BNZ NSTEP A. NO. REQUEST FOR SYSTEM OR SYSTEMS 44730002 TM MINFLGS,MINSTEP Q. REQUEST FOR THIS MINOR 44760002 BZ NEQSCOPE A. NO. SCOPE NOT EQUAL. 44790002 LH R14,GSASID GET THE INPUT ASID. 44820002 CH R14,MINASID Q. REQUEST FOR THIS MINOR 44850002 BER R3 A. YES. FOUND A MATCH. RETURN. 44880002 B NEQSCOPE A. NO. SCOPE NOT EQUAL. 44910002 NSTEP EQU * * 44940002 TM PELFLAG,PELSCPE2 Q. REQUESTING SYSTEMS 44970002 BZ NSYSTEMS A. NO. REQUEST IS FOR SYSTEM 45000002 TM MINFLGS,MINSYSS Q. REQUEST FOR THIS MINOR 45030002 BOR R3 A. YES. FOUND A MATCH. RETURN. 45060002 B NEQSCOPE A. NO. SCOPE NOT EQUAL. 45090002 NSYSTEMS EQU * * 45120002 TM MINFLGS,MINSYS Q. REQUEST FOR THIS MINOR 45150002 BOR R3 A. YES. FOUND A MATCH. RETURN. 45180002 B NEQSCOPE A. NO. SCOPE NOT EQUAL @YM03564 45270002 EJECT 45360002 XFREE EQU * * 45390002 STM R3,R4,WADWORD SAVE REGS ACROSS FREEMAIN 45420002 TEST31 EQU * * 45450002 LR R3,R14 KEY AND SUBPOOL 45480002 L R4,PSATOLD SETUP CURRENT TCB 45510002 L R7,PSAAOLD GET CURRENT ASCB 45540002 BALR R15,ZERO GET TEMP ADDRESSABILITY 45570002 USING *,R15 GET TEMP ADDRESSABILITY 45600002 FREEMAIN RC,LV=(0),A=(1),KEY=(3),SP=(3),BRANCH=YES FREE CORE 45630002 TEST32 EQU * * 45660002 DROP R15 RELEASE TEMP ADDRESSABILITY 45690002 L R7,BASE1 RESTORE CLOBBERED BASE 45720002 LM R3,R4,WADWORD RESTORE REGS 45750002 BR R12 EXIT 45780002 EJECT 45810002 XFREEMAJ EQU * * 45840002 LA R0,MAJLEN GET MAJOR LENGTH 45870002 B XFREEE FREE IT. 45900002 SPACE 2 45930002 XFREEMIN EQU * * 45960002 LA R0,MINLEN GET MINOR LENGTH 45990002 SR R14,R14 DITTO 46020002 IC R14,MINNAMEL-MIN(R1) DITTO 46050002 ALR R0,R14 DITTO 46080002 B XFREEE FREE IT. 46110002 SPACE 2 46140002 XFREEQEL EQU * * 46170002 LA R0,QELSIZE1 GET FIRST SIZE(SUB QEL SIZE) 46200002 TM QELQFLGS-QEL(R1),QELLIST Q. LIST QEL 46230002 BZ YSIZE1 A. NO. SUB QEL. 46260002 LA R0,QELSIZE2 GET SECOND SIZE (LIST QEL N/RESV) 46290002 YSIZE1 EQU * * 46320002 TM QELQFLGS-QEL(R1),QELRESV Q. RESERVE 46350002 BZ NRESV2 A. NO. 46380002 * UCB WORD 46410002 A R0,FFOUR ADD WORD FOR UCB. 46440002 NRESV2 EQU * * 46470002 YFREMAIN EQU * * 46500002 XFREEE EQU * * 46530002 * CORE WILL BE RECYCLED IF IT FALLS WITHIN THE RANGE OF GSQUEUE AND 46560002 * THE MAXIMUM COUNT FOR GSQUEUE HAS NOT BEEN REACHED. 46590002 * OTHERWISE, THE CORE WILL BE FREED 46620002 LR R12,R0 SAVE THE LENGTH 46650002 * INPUT LENGTH IN R12 AND ADDRESS IN R1 46680002 LA R12,SEVEN(R12) OBTAIN INDEX WHILE ROUNDING 46710002 SRL R12,THREE DITTO 46740002 SLL R12,TWO DITTO 46770002 C R12,QRANGE Q. FALL WITHIN QUEUES 46800002 BH YFREEIT A. NO. DO FREEMAIN. 46830002 L R14,GSCOUNT(R12) Q. LIMITS REACHED @Z30BNVD 46860003 C R14,QTAB(R12) DITTO 46890002 BNL FREECHK A. YES. CHECK WHICH TO FREE @Z30BNVD 46920003 LA R14,ONE(R14) BUMP THE QUEUE COUNT. 46950002 L R15,GSQUEUE(R12) INSERT AT TOP OF QUEUE. 46980002 ST R15,NEXT(R1) DITTO 47010002 ST R1,GSQUEUE(R12) DITTO 47040002 ST R14,GSCOUNT(R12) STORE THE COUNT 47070002 BR R3 EXIT 47100002 FREECHK EQU * ONLY INVOKED FROM XFREEE @Z30BNVD 47102003 L R14,GSBLOCKB BEGINNING ADDR OF BLK @Z30BNVD 47104003 CR R14,R1 Q. FALLS WITHIN RANGE @Z30BNVD 47110003 BH YFREEIT A. NO. DO NOT SAVE @Z30BNVD 47112003 L R15,GSBLOCKE ENDING ADDR OF BLOCK @Z30BNVD 47113003 CR R1,R15 Q. FALLS WITHIN RANGE @Z30BNVD 47114003 BNL YFREEIT A. NO. DO NOT SAVE @Z30BNVD 47116003 STM R9,R10,GSGBSV NEED WORK REGS @Z30BNVD 47118003 LA R9,GSQUEUE(R12) TREAT Q HEAD LIKE FIRST ELEMENT @Z30BNVD 47120003 L R10,GSQUEUE(R12) GET QUEUE HEAD @Z30BNVD 47121003 CHECKEM EQU * USED TO LOOP THRU FREE QUEUE @Z30BNVD 47122603 CR R14,R10 Q. FALLS WITHIN RANGE @Z30BNVD 47124203 BH GOTONE A. NO. FOUND ONE TO FREE @Z30BNVD 47126603 CR R10,R15 Q. FALLS WITHIN RANGE @Z30BNVD 47128203 BNL GOTONE A. NO. FOUND ONE TO FREE @Z30BNVD 47128603 LR R9,R10 SAVE PREVIOUS ELEMENT ADDR @Z30BNVD 47129203 L R10,NEXT(R10) GET NEXT ELEMENT @Z30BNVD 47129603 LTR R10,R10 Q. IS THERE ANOTHER ELEMENT @Z30BNVD 47129703 BNZ CHECKEM A. YES. KEEP LOOKING @Z30BNVD 47129803 LM R9,R10,GSGBSV RESET WORK REGS @Z30BNVD 47129903 B YFREEIT NO ELEMENT TO REPLACE @Z30BNVDX47130003 - FREE CURRENT @Z30BNVD 47132003 GOTONE EQU * GOUND FREEABLE ELEMENT @Z30BNVD 47132503 L R15,NEXT(R10) GET FORWARD PTR @Z30BNVD 47133003 ST R15,NEXT(R1) PUT FORWARD PTR IN NEW BLOCK @Z30BNVD 47133503 ST R1,NEXT(R9) PREVIOUS POINTS TO NEW @Z30BNVD 47133603 LR R1,R10 BLOCK TO BE FREED @Z30BNVD 47133703 LM R9,R10,GSGBSV RESET WORK REGS @Z30BNVD 47133803 B YFREEIT FREE ELEMENT FOUND @Z30BNVD 47134003 YFREEIT EQU * * 47136003 L R14,SP245 GET SUBPOOL 47160002 BAL R12,XFREE FREE STORAGE 47190002 BR R3 RETURN. 47220002 EJECT 57840002 XGET EQU * * 57870002 STM R3,R4,WADWORD SAVE REGS ACROSS GETMAIN 57900002 TEST33 EQU * * 57930002 LR R3,R14 KEY AND SUBPOOL 57960002 L R4,PSATOLD SETUP CURRENT TCB 57990002 L R7,PSAAOLD GET CURRENT ASCB 58020002 BALR R15,ZERO GET TEMP ADDRESSABILITY 58050002 USING *,R15 GET TEMP ADDRESSABILITY 58080002 GETMAIN RC,LV=(0),KEY=(3),SP=(3),BRANCH=YES GET CORE 58110002 TEST34 EQU * * 58140002 DROP R15 RELEASE TEMP ADDRESSABILITY 58170002 L R7,BASE1 RESTORE CLOBBERED BASE 58200002 LM R3,R4,WADWORD RESTORE REGS 58230002 BR R12 EXIT 58260002 EJECT 58290002 XGETQEL EQU * * 58320002 SR R14,R14 SET REGISTER TO ZERO 58350002 ST R14,GSMJWORD SET MAJOR LENGTH TO ZERO 58380002 ST R14,GSMNWORD SET MINOR LENGTH TO ZERO 58410002 B XGETQEL1 GET QEL SIZE 58440002 SPACE 2 58470002 XGETMIN EQU * * 58500002 SR R14,R14 SET REGISTER TO ZERO 58530002 ST R14,GSMJWORD SET MAJOR LENGTH TO ZERO 58560002 B XGETMIN1 GET MINOR AND QEL 58590002 SPACE 2 58620002 XGETMAJ EQU * * 58650002 * COMPUTE MAJOR 58680002 LA R14,MAJLEN GET LENGTH OF MAJOR 58710002 ST R14,GSMJWORD SAVE MAJOR LENGTH 58740002 XGETMIN1 EQU * * 58770002 * COMPUTE MINOR 58800002 SR R15,R15 ZERO WORK REGISTER 58830002 ICM R15,M0001,PELMILEN Q. DYNAMIC MINOR NAME LENGTH 58860002 BNZ NDYNAMIC A. NO. MILEN NOT ZERO 58890002 L R14,PELMINA GET THE DYNAMIC LENGTH 58920002 IC R15,ZERO(R14) DITTO 58950002 NDYNAMIC EQU * * 58980002 LA R14,MINLEN(R15) GET THE MINOR LENGTH(WITHOUT NAME) 59010002 ST R14,GSMNWORD SAVE MINOR LENGTH 59040002 XGETQEL1 EQU * * 59070002 * COMPUTE QEL SIZE 59100002 LA R14,QELSIZE2 SET SIZE 2 59130002 ICM R15,M1111,GSLSTQEL Q. LIST QEL EXIST 59160002 BZ NSUBQEL A. YES. BUILD LIST QEL 59190002 LA R14,QELSIZE1 SET SIZE 1 59220002 NSUBQEL EQU * * 59250002 TM PELFLAG,PELSCPE2 Q. UCB SPECIFIED. 59280002 BZ NRESV3 A. NO. 59310002 TM PELFLAG,PELSCPE1 Q. UCB SPECIFIED. 59340002 BO NRESV3 A. NO. 59370002 L R12,PELUCBAA GET THE UCB ADDR ADDR 59400002 L R12,ZERO(R12) GET THE UCB ADDR 59430002 TM UCBTBYT3-UCBOB(R12),UCB3DACC Q. DASD @YA00805 59460003 BZ NRESV3 A. NO. @YA00805 59490003 TM UCBTBYT2-UCBOB(R12),UCB2OPT2 Q. SHARED @YA00805 59520003 BO YRESV3 A. YES. @YA00805 59550003 LR R0,R12 SAVE UCB ADDR @YA00805 59552003 ICM R12,M0111,UCBEXTP-UCBOB(R12) EXTENSION ADDR @YA00805 59554003 TM UCBFLP1-UCBETI(R12),UCBSHRUP Q. SHR POTENTIAL @YA00805 59556003 LR R12,R0 RESTORE UCB ADDR @YA00805 59558003 BZ NRESV3 A. NO. PROCESS AS NORMAL ENQ @YA00805 59560003 YRESV3 EQU * PROCESS AS RESERVE @YA00805 59562003 LA R14,FOUR(R14) ADD UCB WORD. 59580002 NRESV3 EQU * * 59610002 ST R14,GSQLWORD SAVE THE COMPUTED SIZE. 59640002 * CORE WILL EITHER BE 'GETMAINED' OR GOTTEN FROM GSQUEUE 59670002 * GSQUEUE IS A RECYCLING STORAGE QUEUE 59700002 * GSQUEUE IS INDEXABLE BY LENGTH/2 59730002 * GSCOUNT IS THE NUMBER OF FREE ELEMENTS HUNG FROM GSQUEUE 59760002 * EACH LENGTH IS CHECKED FOR A FREE ELEMENT. IF ONE EXISTS, 59790002 * IT IS TAKEN FROM GSQUEUE. IF NONE EXISTS, THE SIZE 59820002 * IS ADDED TO THAT OF OTHERS NOT FOUND. 59850002 * SIZES NOT FOUND ARE SUMED AND 1 GETMAIN IS DONE. 59880002 SR R0,R0 GETMAIN LENGTH ACCUMULATOR 59910002 LA R12,EIGHT LOOP CONTROL 59940002 Q3 EQU * * 59970002 L R14,GS3WORDS(R12) GET LENGTH OR 0 60000002 LA R14,SEVEN(R14) OBTAIN INDEX WHILE ROUNDING 60030002 SRA R14,THREE Q. IS IT ZERO. 60060002 BZ YZERO A. YES. IGNORE 60090002 SLL R14,TWO LENGTH ROUNDED TO DBL WD DIVIDED BY 2 60120002 C R14,QRANGE Q. LENGTH WITHIN RANGE 60150002 BH NELEM1 A. NO. ACCUMULATE LENGTH FOR GET 60180002 L R1,GSQUEUE(R14) GET QUEUED ELEMENT OR 0 60210002 LTR R1,R1 Q. DOES ELEMENT EXIST 60240002 BNZ YELEM2 A. YES 60270002 NELEM1 EQU * * 60300002 SLL R14,ONE GET ROUNDED LENGTH 60330002 AR R0,R14 ACCUMULATE LENGTH 60360002 O R14,HIGHBIT INDICATE LENGTH NOT PROCESSED 60390002 ST R14,GS3WORDS(R12) SAVE THE LENGTH 60420002 B NELEM2 CONTINUE 60450002 YELEM2 EQU * * 60480002 L R15,NEXT(R1) UNCHAIN @Z30BNVD 60484003 ST R15,GSQUEUE(R14) DITTO @Z30BNVD 60485003 ST R1,GS3WORDS(R12) SAVE THE ELEMENT'S ADDRESS @Z30BNVD 60487003 L R15,GSCOUNT(R14) DECREMENT THE Q COUNT 60510002 BCT R15,YNOTZERO SKIP WHEN Q NOT EMPTY @Z30BNVD 60540003 STM R10,R12,GSGBSV NEED WORK REGS @Z30BNVD 60544003 LR R10,R0 SAVE CONTENTS OF REG @Z30BNVD 60546003 L R0,BLKSIZE(R14) GET SIZE OF BLOCK @Z30BNVD 60548003 LR R11,R14 SAVE CONTENTS OF REG @Z30BNVD 60550003 L R14,SP245 INDICATE SUBPOOL @Z30BNVD 60552003 BAL R12,XGET GET A BLOCK @Z30BNVD 60554003 LR R14,R11 RESTORE INDEX @Z30BNVD 60556003 LTR R15,R15 Q. GOT SOME @Z30BNVD 60558003 BZ YGOTSOME A. YES. GO PROCESS @Z30BNVD 60560003 SR R15,R15 ZERO COUNT REG @Z30BNVD 60560503 B NGOT SKIP CHAINING PROCESS @Z30BNVD 60561003 YGOTSOME EQU * BRANCHED TO WHEN STORAGE GOTTEN @Z30BNVD 60561503 ST R1,GSQUEUE(R14) INITIALIZE QUEUE HEAD @Z30BNVD 60562003 AR R0,R1 DETERMINE END OF BLOCK @Z30BNVD 60564003 SLL R11,ONE INDEX TO ELEMENT SIZE @Z30BNVD 60566003 BLDLOOP EQU * LOOP TO BUILD FREE QUEUE @Z30BNVD 60568003 LR R12,R1 SAVE CURRENT @Z30BNVD 60570003 LA R15,ONE(R15) COUNT ELEMENT @Z30BNVD 60572003 AR R1,R11 GET NEXT @Z30BNVD 60574003 ST R1,NEXT(R12) CHAIN CURRENT TO NEXT @Z30BNVD 60576003 CR R0,R1 Q. PROCESSING LAST ONE @Z30BNVD 60577003 BH BLDLOOP A. NO. GO PROCESS ANOTHER @Z30BNVD 60579003 SR R0,R0 RESET ENTRY VALUE @Z30BNVD 60581003 ST R0,NEXT(R12) ZERO PTR IN LAST ONE @Z30BNVD 60583003 NGOT EQU * LABEL USED WHEN GET FAILS @Z30BNVD 60585003 LR R0,R10 RESET ENTRY VALUE @Z30BNVD 60588003 LM R10,R12,GSGBSV RESET WORK REGS @Z30BNVD 60590003 YNOTZERO EQU * USED WHEN BLOCK NOT NEEDED @Z30BNVD 60592003 ST R15,GSCOUNT(R14) SAVE NEW COUNT @Z30BNVD 60594003 NELEM2 EQU * * 60690002 YZERO EQU * * 60720002 SL R12,FFOUR Q. IS THIS THE LAST 60750002 BNM Q3 A. NO. LOOP. 60780002 LTR R0,R0 Q. ACCUMULATED LENGTH 0 60810002 BZR R3 YES. EXIT 60840002 * GETMAIN 60870002 L R14,SP245 GET SUBPOOL 60900002 BAL R12,XGET GET STORAGE 60930002 LTR R15,R15 Q. GO O.K. 60960002 BZ YGOTIT A. YES. 60990002 OI WAFLAG2,WANOCORE SET NO CORE SWITCH 61020002 BR R3 EXIT 61050002 YGOTIT EQU * * 61080002 LA R12,EIGHT LOOP CONTROL. ALSO USED AS INDEX 61110002 QBREAKIT EQU * * 61140002 L R14,GS3WORDS(R12) Q. IGNORE THIS WORD 61170002 LTR R14,R14 DITTO 61200002 BNM YIGNORIT A. YES 61230002 LA R14,ZERO(R14) CLEAR HIGH BIT 61260002 ST R1,GS3WORDS(R12) SAVE THE ADDRESS 61290002 LA R1,ZERO(R1,R14) ADDRESS PLUS LENGTH (CLEAR HIGH BIT) 61320002 YIGNORIT EQU * * 61350002 SL R12,FFOUR Q. IS THIS THE END. 61380002 BNM QBREAKIT A. NO. LOOP. 61410002 BR R3 EXIT 61440002 EJECT 61470002 XHOLD EQU * * 61500002 OI GSFLAG1,GSHOLD WANT ENQHOLD 61530002 B YSYSEVNT CONTINUE. 61560002 SPACE 2 61590002 XRLSE EQU * * 61620002 NI GSFLAG1,XFF-GSHOLD WANT ENQRLSE 61650002 YSYSEVNT EQU * * 61680002 TM MINFLGS,MINSTEP Q. STEP WIDE MINOR 61710002 BOR R3 A. YES. DONT ISSUE SYSEVENT. 61740002 STM R14,R4,GSR3SAVE SAVE REGS 61770002 LR R3,R1 SAVE COUNT 61800002 LR R1,R10 MINOR ADDRESS TO OPTIMIZER 61920002 QHOLDQEL EQU * * 61950002 LH R2,QELASID-QEL(R12) GET ASID FOR OPT. 61980002 TM GSFLAG1,GSHOLD Q. HOLD. 62040002 BO YHOLD A. YES. 62070002 * ENQRLSE 62100002 SYSEVENT ENQRLSE,ASID=(2),ENTRY=BRANCH CALL OPT. 62130002 TEST38 EQU * * 62160002 B NHOLD CONTINUE. 62190002 YHOLD EQU * * 62220002 * ENQHOLD 62250002 SYSEVENT ENQHOLD,ASID=(2),ENTRY=BRANCH CALL OPT. 62280002 TEST39 EQU * * 62310002 NHOLD EQU * * 62340002 L R12,QELNQEL-QEL(R12) GET NEXT QEL FOR LOOP 62370002 BCT R3,QHOLDQEL LOOP ON COUNT 62400002 LM R14,R4,GSR3SAVE RESTORE REGS. 62430002 BR R3 RETURN 62460002 EJECT 62490002 XPOST EQU * POST A GROUP OF QELS 62520002 QPOSTQEL EQU * * 62550002 ICM R15,M1111,QELLQEL-QEL(R12) Q. LIST QEL ADDRESS 62610002 LA R14,QELSIZE1 GET SUB-QEL SIZE 62640002 BM NLQEL A. NO. 62670002 LA R14,QELSIZE2 GET LIST-QEL SIZE 62700002 LR R15,R12 GET THE LIST-QEL ADDRESS 62730002 NLQEL EQU * * 62760002 TM QELQFLGS-QEL(R12),QELRESV Q. RESERVE 62790002 BZ NRESERV1 A. NO. 62820002 * SHARED DASD 62850002 L R14,ZERO(R14,R12) GET UCB ADDRESS 62880002 SR R0,R0 BUMP RESERVE COUNT 62910002 IC R0,UCBSQC-UCBOB(R14) DITTO 62940002 AL R0,FONE DITTO 62970002 STC R0,UCBSQC-UCBOB(R14) DITTO 63000002 TM QELQFLGS-QEL(R12),QELAUTH CHECK FOR AUTH. @ZA17306 63005040 BNO NRESERV1 SKIP SYSEVENT @ZA17306 63010040 STM R14,R1,GSR3SAVE @ZA17306 63012040 LR R1,R10 PASS MINOR QCB TO SRM @ZA17306 63015040 LH R0,QELASID-QEL(R12) PASS ASID TO SRM @ZA17306 63020040 SYSEVENT ENQHOLD,ASID=(0),ENTRY=BRANCH @ZA17306 63025040 LM R14,R1,GSR3SAVE @ZA17306 63027040 NRESERV1 EQU * * 63030002 STM R0,R15,GSSAVE1 @ZA17306 63050040 LR R9,R13 SAVE GLOBAL SAVE AREA ADDRESS 63060002 LH R11,QELWCNT-QEL(R15) DECREMENT WAIT COUNT. 63090002 S R11,FONE DITTO 63120002 STH R11,QELWCNT-QEL(R15) DITTO 63150002 BNZ NPOST DONT POST TILL COUNT GOES TO 0 63180002 OI QELLFLGS-QEL(R15),QELPOST INDICATE POST OCCURED. 63210002 SR R11,R11 NO ECB,SVRB ADDR ALREADY IN R10 63240002 ICM R10,M1111,QELECB-QEL(R15) Q. ECB POST 63270002 BNM NECB A. NO. SVRB POST. 63300002 * ECB POST 63330002 LA R11,ZERO(R10) INDICATE NO SHEDULE 63360002 SR R10,R10 NO COMPLETION CODE 63390002 NECB EQU * * 63420002 LH R13,QELASID-QEL(R12) Q. CROSS MEMORY POST 63450002 CH R13,GSASID-GS(R9) DITTO 63480002 BE NSCHED A. NO. 63510002 * CROSS MEMORY POST 63540002 O R11,HIGHBIT INDICATE SCHEDULE IS NECESSARY 63570002 L R1,CVTPTR GET CVT ADDRESS 63600002 TEST41 EQU * * 63630002 L R1,CVTASVT-CVT(R1) GET THE ASVT 63660002 BCTR R13,ZERO ASID-1 63710002 SLL R13,TWO (ASID-1) X 4 63730002 L R13,ASVTENTY-ASVT(R13,R1) GET ASCB ADDRESS @YM01596 63750002 LA R12,BR14 ADDRESS OF BR14 INSTUCTION 63780002 NSCHED EQU * * 63810002 L R15,POSTADDR GET POST'S ADDRESS 63840002 TEST42 EQU * * 63870002 BALR R14,R15 POST 63900002 * NO ADDRESSABILITY HERE OTHER THAN R9 63930002 NPOST EQU * * 63960002 LM R0,R15,GSSAVE1-GS(R9) GET ALL REGS BACK 63990002 BCTR R1,ZERO DECREMENT POST COUNT 64020002 LTR R1,R1 Q. DONE WITH POSTS 64050002 BZR R3 A. YES. RETURN 64080002 L R12,QELNQEL-QEL(R12) GET THE NEXT QEL 64110002 B QPOSTQEL LOOP 64140002 EJECT 64170002 XQELSCAN EQU * * 64200002 * INPUT-- 64230002 * GSASID CONTINS THE CURRENT ASID 64260002 * R3 IS THE RETURN ADDRESS 64290002 * R4 CONTAINS A TCB ADDRESS OR 0 64320002 * R8 CONTAINS THE CURRENT PEL 64350002 * R10 CONTAINS THE MINOR TO BE SEARCHED 64380002 * R13 CONTAINS THE ADDRESS OF THE GS(GLOBAL SAVE) 64410002 * PROCESS-- 64440002 * R11 IS USED TO CONTAIN THE MATCH QEL OR 0 64470002 * R12 CONTAINS THE CURRENT QEL 64500002 * R14 CONTAINS EITHER THE PREVIOUS TYPE OR THE CURRENT TYPE (E/S) 64530002 * R15 IS USED AS A MULTI USE WORK REG 64560002 * R0 CONTAINS THE CURRENT QEL COUNT FOR THE CURRENT GROUP 64590002 * R1 IS USED TO CONTAIN THE CURRENT GROUP NUMBER TIMES TWO 64620002 * WORK REGISTERS R11,R12,R14,R15,R0,R1 64650002 * NOT TO BE USED ARE R2,R3,R4,R5,R6,R7,R8,R9,R10,R13 64680002 * R2 MAY AT A LATER TIME BECOME THE LINK REGISTER 64710002 * OUTPUT-- 64740002 * R11 WILL CONTAIN THE MATCH QEL OR 0 64770002 * GSGRPNUM CONTAINS THE MATCH GROUP NUMBER OR THE GROUP NUMBER OF THE 64800002 * TO BE BUILT QEL (FUTURE OR POTENTIAL QEL),MULTIPLIED BY TWO 64830002 * GSGROUPS 1 THRU 4 WILL CONTAIN THEIR RESPECTIVE QEL COUNTS 64860002 * THE LAST COUNT MAY REFLECT AN MATCH COUNT OR THE POTENTIAL COUNT 64890002 SPACE 3 64920002 * INITIALIZE 64950002 SR R11,R11 SET THE MATCH QEL TO ZERO 64980002 SR R1,R1 SET CURRENT GROUP TO ZERO 65010002 XC GSGPAREA(GSGPLEN),GSGPAREA ZERO GROUP RELATED INFO 65040002 SR R14,R14 SET PREVIOUS TYPE TO EXCLUSIVE 65070002 ICM R12,M1111,MINFQEL Q. FIRST QEL ZERO 65100002 BZ YEND1 A. YES. CANNOT HAVE A MATCH. 65130002 QQEL1 EQU * SCAN THE QEL(S) 65160002 LTR R14,R14 Q. PREV=EXCL 65190002 L R14,QELQFLGS-QEL(R12) MAKE CURR THE PREV 65220002 BNM YCHANGE0 A. YES. HAS TO BE GROUP CHANGE 65250002 LTR R14,R14 Q. CURR=EXCL 65280002 BNM YCHANGE0 A. YES HAS TO BE GROUP CHANGE 65310002 A R0,FONE ADD ONE TO CURRENT QEL COUNT 65340002 B NCHANGE0 BYPASS THE CHANGE OF GROUP 65370002 YCHANGE0 EQU * CHANGE GROUP COUNT 65400002 LA R1,TWO(R1) BUMP GROUP OFFSET 65430002 LA R0,ONE SET CURRENT QEL COUNT TO ONE 65460002 NCHANGE0 EQU * * 65490002 CLC GSASID(TWO),QELASID-QEL(R12) Q.BELONG TO THE TARGET A.S. 65520002 BNE NMATCH MISSED THE TARGET 65550002 L R15,QELTCB-QEL(R12) GET TCB OR LIST QEL ADDRESS 65580002 LTR R15,R15 Q. TCB 65610002 BP YTCB A. YES 65640002 L R15,QELTCB-QEL(R15) OBTAIN THE TCB 65670002 YTCB EQU * HAVE THE TCB 65700002 CR R4,R15 TCB'S MATCH 65730002 BE YMATCH YES. ASID.TCB = ASID.TCB 65760002 LTR R4,R4 CHECK FOR A TCB OF 0 65790002 BNZ NMATCH NOT 0 (NO MATCH) ZERO TCB = ALL TCB'S 65820002 YMATCH EQU * FOUND A MATCH QEL 65850002 LR R11,R12 SAVE IT. 65880002 SRL R1,ONE SAVE THE MATCH GROUP NUMBER 65910002 ST R1,GSGRPNUM DITTO 65940002 SLL R1,ONE DITTO 65970002 NMATCH EQU * * 66000002 C R1,FEIGHT 66030002 BH YIGNORE3 A. YES 66060002 STH R0,GSGROUP(R1) SAVE THE CURRENT QEL COUNT 66090002 YIGNORE3 EQU * * 66120002 ICM R12,M1111,QELNQEL-QEL(R12) Q. NEXT QEL ZERO. 66150002 BNZ QQEL1 A. NO. LOOP ON QELS 66180002 YEND EQU * FINISH UP 66210002 LTR R11,R11 Q. HAVE A MATCH QEL 66240002 BNZR R3 YES. EXIT 66270002 LTR R14,R14 Q. GROUP CHANGE 66300002 BNM YCHANGE1 A. YES 66330002 TM PELFLAG,PELSHARE Q. GROUP CHANGE 66360002 BZ YCHANGE1 A. YES 66390002 A R0,FONE BUMP THE CURRENT QEL COUNT. 66420002 B NCHANGE1 CONTINUE PROCESSING 66450002 YCHANGE1 EQU * * 66480002 YEND1 EQU * * 66510002 LA R1,TWO(R1) BUMP GROUP OFFSET 66540002 LA R0,ONE RESET THE QEL COUNT TO ONE. 66570002 NCHANGE1 EQU * * 66600002 C R1,FEIGHT Q. OVER FOUR GROUPS. 66630002 SRL R1,ONE SAVE THE POTENTIAL GROUP NUMBER. 66660002 ST R1,GSGRPNUM DITTO 66690002 BHR R3 A. YES. QUIT. 66720002 SLL R1,ONE RESTORE INDEX 66750002 STH R0,GSGROUP(R1) BUMP THIS GROUPS QEL COUNT. 66780002 BR R3 BYE 66810002 EJECT 66840002 XSETUP EQU * * 66870002 * INPUT-- 66900002 * R1 IS THE INPUT PARM LIST 66930002 * R2 IS FRR E.P. 66960002 * R3 IS THE LINK REGISTER 66990002 * ADDRESSABILITY TO WA (USING R5) 67020002 * WORK-- 67050002 * R8 THRU R2 67080002 * OUTPUT-- 67110002 * WA ALL ZEROS PLUS-- 67140002 * WAOLDPEL,WANEWPEL,WAKEY,WAPLAST,WAPFLAG,WAPARMSZ,WANAMESZ 67170002 * WALOCAL,WAFRR,WABADMIL,WAERR,WANOAUTH,WANOCORE 67200002 * PORTION OF GLOBAL SAVE CLEARED 67230002 * A MOVED LIST,IF CALLER NOT AN AUTHORIZED CALLER. 67260002 * FRR ENVIRONMENT 67290002 * POSSIBLY A MOVED LIST 67320002 * LOCAL AND CMS LOCK 67350002 * R4 CONTAINS THE CURRENT OR PARM LIST TCB ADDR 67380002 * R8 IS ADDRESS OF TOP PARM OF WACURPEL 67410002 * R13 IS ADDRESS OF GS 67440002 LA R8,ZERO(R1) SAVE THE PARM LIST 67470002 XC WA(WALEN),WA ZERO THE WORK AREA 67500002 STC R0,WARETRY SET RETRY ADDRESS 67530002 ST R8,WAOLDPEL INIT OLD LIST AS INPUT LIST 67560002 ST R8,WANEWPEL SET NEW=OLD 67590002 X3 SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,RELATED=((X7),IEAVWAIT) 67620002 TEST43 EQU * * 67650002 * SETLOCK DESTROYS R11 THRU R14 67680002 OI WAFLAG1,WALOCAL INDICATE LOCAL LOCK OBTAINED. 67710002 SETFRR A,PARMAD=(R13),FRRAD=(R2),WRKREGS=(R14,R15) COVER 67740002 TEST44 EQU * * 67770002 ST R5,ZERO(R13) FRR INPUT IS W.A. ADDRESSABILITY 67800002 * SETFRR DESTROYS R14 AND R15 67830002 OI WAFLAG1,WAFRR INDICATE FRR OUTSTANDING 67860002 L R2,RBLINK-RBSECT(R5) GET MY CALLER'S KEY 67890002 IC R2,RBOPSWKY-RBSECT(R2) DITTO 67920002 N R2,KEYMASK DITTO 67950002 STH R2,WAKEY SAVE MY CALLER'S KEY 67980002 * SCAN THE INPUT PARM LIST 68010002 * FOR THIS ENTIRE ROUTINE R2 CONTAINS MY CALLER'S KEY 68040002 * COMPUTE THE PARM LIST SIZE AND NAME LENGTH SIZE 68070002 LR R12,R8 SET CURRENT ELEMENT TO TOP ELEMENT 68100002 SR R14,R14 SET CURRENT PARM SIZE TO 0 68130002 SR R15,R15 SET CURRENT NAME SIZE TO 0 68160002 SR R0,R0 ZERO FOR INSERT OF MINOR NAME LENGTH 68190002 SR R9,R9 USE FOR MINOR LENGTH 0, NON 0 SWITCH 68220002 TEST45 EQU * * 68250002 MODESET KEYADDR=(2) GO INTO CALLER'S KEY 68280002 QLAST EQU * LOOP TILL END OF LIST 68310002 LA R14,PELELEM(R14) ACCUMULATE PARM LIST SIZE 68340002 TM PELFLAG-PEL(R12),PELSCPE2 Q. HAVE UCB 68370002 BZ NRESV A. NO. 68400002 TM PELFLAG-PEL(R12),PELSCPE1 Q. HAVE UCB 68430002 BO NRESV A. NO. 68460002 L R1,PELUCBAA-PEL(R12) REFERENCE UCB ADDR ADDR 68490002 L R11,ZERO(R1) REFERENCE UCB ADDRESS 68520002 L R11,ZERO(R11) REFERENCE UCB 68550002 LA R14,FOUR(R14) BUMP PARM SIZE BY UCB ADDR SIZE 68580002 LA R15,FOUR(R15) BUMP NAME SIZE BY UCB WORD SIZE 68610002 NRESV EQU * * 68640002 L R1,PELMAJA-PEL(R12) REFERENCE MAJOR ADDRESS 68670002 IC R11,ZERO(R1) REFERENCE MAJOR NAME 68700002 IC R11,PELMAJSZ-ONE(R1) DITTO 68730002 LA R15,PELMAJSZ(R15) ACCUMULATE NAME LENGTH SIZE 68760002 ICM R1,M1111,PELMINA-PEL(R12) Q. MINOR NAME 68790002 BNZ YMINAME A. YES. CHECK LENGTH 68820002 BALR R9,ZERO A. NO. ABEND ALL BUT GENERIC DEQ. 68850002 B NMINAME CONTINUE PROCESSING 68880002 YMINAME EQU * * 68910002 ICM R0,M0001,PELMILEN-PEL(R12) Q. DYNAMIC LENGTH 68940002 BNZ NDYN A. NO. REFERENCE MINOR NAME 68970002 ICM R0,M0001,ZERO(R1) Q. LENGTH ZERO 69000002 LA R1,ONE(R1) PREPARE FOR NON-ZERO LENGTH 69030002 BNZ YMILEN A. NO. REFERENCE MINOR NAME 69060002 BALR R9,ZERO A. NO. ABEND ALL BUT GENERIC DEQ. 69090002 B NMILEN CONTINUE 69120002 YMILEN EQU * * 69150002 NDYN EQU * * 69180002 IC R11,ZERO(R1) REFERENCE MINOR NAME 69210002 BCTR R1,ZERO DITTO 69240002 ALR R1,R0 DITTO 69270002 IC R11,ZERO(R1) DITTO 69300002 NMINAME EQU * * 69330002 NMILEN EQU * * 69360002 ALR R15,R0 BUMP NAME SIZE BY MINOR LENGTH SIZE 69390002 TM PELLAST-PEL(R12),PELEOL Q. END OF LIST 69420002 BO YLAST A. YES 69450002 LA R12,ZERO(R8,R14) GET ADDRESS OF NEXT ELEM 69480002 B QLAST LOOP ON ELEMENTS 69510002 YLAST EQU * FINISHED WITH LIST 69540002 ICM R1,M0010,PELLAST-PEL(R12) GET PROPER(LAST ELEM)FLAG BYTE 69570002 IC R1,PELFLAG-PEL(R8) GET PROPER(TOP ELEM) FLAG BYTE 69600002 TEST46 EQU * * 69630002 MODESET EXTKEY=SUPR SET KEY BACK TO 0 69660002 LTR R9,R9 Q. MINOR LEN OF ZERO FOUND 69690002 BZ NLEN0 A. NO. 69720002 OI WAFLAG2,WABADMIL A. YES. ABEND ALL BUT GENERIC DEQ. 69750002 NLEN0 EQU * * 69780002 STH R1,WAPFLGS SAVE PROPER(GLOBAL TO THE REQUEST) FLAGS 69810002 TM WAPLAST,PELIGNOR Q. OLD OPTIONS 69840002 BZ NOLDOPTN A. NO. HAVE NEW OPTIONS. 69870002 NI WAPLAST,PELEOL A. YES. CONVERT TO NEW OPTIONS 69900002 NOLDOPTN EQU * WAPLAST IS NOW ALWAYS NEW OPTIONS 69930002 ST R14,WAPARMSZ SAVE THE TOTAL PARM SIZE 69960002 ST R15,WANAMESZ SAVE THE TOTAL NAME SIZE 69990002 TM WAPFLAG,PELRET1 Q. ECB REQUESTED 70020002 BZ NECB1 A. NO. 70050002 TM WAPFLAG,PELRET2+PELRET3 Q. ECB REQUESTED 70080002 BNZ NECB1 A. NO. CHECK FOR ONLY TCB @ZA14267 70090040 TM WAPLAST,PELTCBF Q. BOTH ECB AND TCB @ZA14267 70130040 BNO YECB1 A. NO. ONLY ECB @ZA14267 70170040 * 70260040 * BOTH TCB AND ECB WERE SPECIFIED @ZA14267 70262040 * 70264040 SH R8,HPREFIX GET PREFIX ADDRESS OF PEL @ZA14267 70266040 MODESET KEYADDR=(2) SWITCH TO CALLERS KEY @ZA14267 70267040 L R4,PELTCB-PELPREFX(0,R8) SET TCB ADDRESS @ZA14267 70268040 L R9,PELDUAL-PELPREFX(0,R8) GET ECB ADDRESS @ZA14267 70269040 MODESET EXTKEY=SUPR GO BACK TO KEY 0 @ZA14267 70270040 O R9,HIGHBIT INDICATE ECB @ZA14267 70271040 B NTCB1 COMMON TCB/ECB PROCESSING @ZA14267 70272040 NECB1 EQU * * 70278240 TM WAPLAST,PELTCBF Q. TCB REQUEST @ZA14267 70278440 BZ NTCBECB A. NO. 70278640 YECB1 EQU * * 70278840 * 70279040 * ONLY TCB SPECIFIED OR ONLY ECB SPECIFIED @ZA14267 70279240 * 70279440 SH R8,HPREFIX GET PREFIX ADDRESS OF PEL @ZA14267 70280040 TEST47 EQU * * 70320002 MODESET KEYADDR=(2) SWITCH TO CALLER'S KEY 70350002 L R9,PELDUAL-PELPREFX(R8) GET TCB OR ECB ADDRESS 70380002 TEST48 EQU * * 70410002 MODESET EXTKEY=SUPR GO BACK TO KEY 0 70440002 O R9,HIGHBIT INDICATE ECB (GUESS) @ZA14267 70470040 TM WAPLAST,PELTCBF Q. TCB REQUEST 70530002 BZ NTCB1 A. NO. 70560002 LA R9,ZERO(R9) CLEAR HIGH BIT 70590002 LR R4,R9 SET TCB ADDRESS 70620002 NTCB1 EQU * * 70650002 ST R9,WAECBA SAVE THE TCB OR ECB ADDRESS @ZA14267 70660040 * 70685040 * WATCBA WILL BE USED ONLY IF ECB WAS SPECIFIED (INDICATED BY HIGH 70690040 * ORDER BIT). @ZA14267 70693040 * 70700040 AH R8,HPREFIX RESET TO TOP ELEM @ZA14267 70705040 NTCBECB EQU * * 70710002 TM WAKEY+ONE,NOSUPKEY Q. SUPR KEY @YM03564 70720002 BZ YAUTH A. YES - BYPASS TESTAUTH @YM03564 70730002 LR R11,R3 SAVE THE LINK REGISTER 70750002 TESTAUTH FCTN=1,STATE=YES,KEY=YES,BRANCH=YES CHECK AUTH 70770002 TEST49 EQU * * 70800002 * R14 THRU R3 CLOBBERED. 70830002 LR R3,R11 RESTORE THE LINK REGISTER 70860002 LTR R15,R15 Q. AUTHORIZED CALLER 70890002 BZ YAUTH A. YES. DONT MOVE PARM LIST 70920002 * MOVE PARM LIST IF COMING THRU HERE 70950002 LH R2,WAKEY RESTORE CALLER'S KEY 70980002 OI WAFLAG2,WANOAUTH INDICATE NOT AUTHORIZED CALL 71010002 * MOVE LIST NOW. 71040002 * R8 USED FOR OLD PEL 71070002 * R9 USED FOR NEW PEL PARMS 71100002 * R10 USED FOR NEW PEL NAMES 71130002 * R12 USED FOR PARM SIZE 71160002 * R14 USED FOR NAME SIZE 71190002 * R15, R0, R1 USED FOR QUICK WORK 71220002 * R2 USED FOR KEY REG 71250002 L R0,WAPARMSZ GET PARM SIZE 71280002 A R0,WANAMESZ GET TOTAL SIZE (PARM SIZE+NAME SIZE) 71310002 L R14,SP253 GET SUBPOOL 71340002 BAL R12,XGET GET STORAGE 71370002 LTR R15,R15 Q. GET THE CORE 71400002 BZ YGOT2 A. YES CONTINUE. 71430002 MVI WAERR,AB6XX A. NO. INDICATE 638 OR 630 ABEND. 71460002 B NGOT2 RETURN. 71490002 YGOT2 EQU * PROCEED WITH MOVE. 71520002 L R12,WAPARMSZ GET PARM SIZE 71550002 LA R9,ZERO(R1) SAVE NEW PARM LIST ADDRESS. 71580002 ST R9,WANEWPEL SAVE NEW PARM LIST FOR FREEMAIN 71610002 OI WAFLAG2,WANWPEL INDICATE NEW PEL GOTTEN 71640002 * R8 CONTAINS ADDRESS OF OLD PEL. 71670002 L R14,WANAMESZ GET THE NAME SIZE 71700002 LA R10,ZERO(R9,R12) GET THE ADDRESS TO NAME START 71730002 QMOVLIST EQU * * 71760002 SH R12,HPELSZ Q. MOVE COMPLETE. 71790002 BM YMOVLIST A. YES EXIT. 71820002 TEST50 EQU * * 71850002 MODESET KEYADDR=(2) SET CALLER'S KEY. 71880002 LM R15,R1,ZERO(R8) GET ONE ELEMENT(LESS UCB) 71910002 TEST51 EQU * * 71940002 MODESET EXTKEY=SUPR GO BACK TO KEY 0 71970002 STM R15,R1,ZERO(R9) SAVE ONE ELEMENT(LESS UCB) 72000002 SH R14,HMAJSZ Q. MOVE COMPLETE 72030002 BM YERRLIST A. YES. VOLATILE INPUT LIST 72060002 L R15,PELMAJA-PEL(R9) GET ADDRESS OF MAJOR NAME 72090002 TEST52 EQU * * 72120002 MODESET KEYADDR=(2) SWITCH TO CALLER'S KEY 72150002 TM ZERO(R15),ZERO REFERENCE MAJOR NAME 72180002 TM EIGHT-ONE(R15),ZERO DITTO 72210002 TEST53 EQU * * 72240002 MODESET EXTKEY=SUPR SWITCH BACK TO KEY 0 72270002 MVC ZERO(EIGHT,R10),ZERO(R15) MOVE MAJOR NAME 72300002 ST R10,PELMAJA-PEL(R9) RELOCATE MAJOR NAME POINTER 72330002 CLC ZERO(FOUR,R10),SYSZ Q. AUTHORIZED NAME 72360002 BH NAUTHNAM A. NO. 72390002 BE YAUTHNAM A. YES. RESTRICTED NAME 72420002 LA R1,SYSTABLE-EIGHT SEARCH THRU AUTH NAME TABLE 72450002 QAUTHNAM EQU * * 72480002 LA R1,EIGHT(R1) GET ADDRESS CURRENT AUTH NAME 72510002 CLC ZERO(EIGHT,R10),ZERO(R1) Q. AUTHORIZED NAME 72540002 BH QAUTHNAM A. NO. LOOP. 72570002 BL NAUTHNAM A. NO. NAME NOT IN TABLE 72600002 YAUTHNAM EQU * * 72630002 MVI WAERR,AB3XX INDICATE NOT AUTHORIZED FOR FUNCTION 72660002 NAUTHNAM EQU * * 72690002 LA R10,PELMAJSZ(R10) UPDATE NAMES ADDRESS 72720002 ICM R15,M1111,PELMINA-PEL(R9) Q. MINOR NAME 72750002 BZ NMINMOVE A. NO. NO MOVE 72780002 SR R1,R1 ZERO FOR INSERT 72810002 ICM R1,M0001,PELMILEN-PEL(R9) Q. DYNAMIC MI LENGTH 72840002 BNZ YMINMOVE A. NO. HAVE LENGTH 72870002 TEST54 EQU * * 72900002 MODESET KEYADDR=(2) SWITCH TO CALLER'S KEY 72930002 ICM R1,M0001,ZERO(R15) Q. MINOR 72960002 TEST55 EQU * * 72990002 MODESET EXTKEY=SUPR SWITCH BACK TO KEY 0 73020002 LA R15,ONE(R15) ADJUST MINOR NAME ADDRESS 73050002 BNZ YMINMOVE A. YES. 73080002 * THIS PATH IS LEGAL IF GENERIC DEQ WAS SPECIFIED. 73110002 SR R15,R15 ZERO MINOR NAME 73140002 ST R15,PELMINA-PEL(R9) DITTO 73170002 B NMINMOVE CONTINUE. 73200002 YMINMOVE EQU * * 73230002 SR R14,R1 Q. MOVE COMPLETE 73260002 BM YERRLIST A. YES. VOLATILE LIST 73290002 STC R1,PELMILEN-PEL(R9) SAVE MINOR NAME LENGTH 73320002 BCTR R1,ZERO DECREMENT FOR EXECUTE 73350002 TEST56 EQU * * 73380002 MODESET KEYADDR=(2) SWITCH TO CALLER'S KEY 73410002 IC R0,ZERO(R15) REFERENCE MINOR NAME 73440002 IC R0,ZERO(R15,R1) DITTO 73470002 TEST57 EQU * * 73500002 MODESET EXTKEY=SUPR SWITCH BACK TO KEY 0 73530002 EX R1,MOVEMIN MOVE MINOR NAME 73560002 ST R10,PELMINA-PEL(R9) RELOCATE MINOR ADDRESS 73590002 LA R10,ONE(R10,R1) UPDATE NAMES ADDRESS 73620002 NMINMOVE EQU * * 73650002 TM PELFLAG-PEL(R9),PELSCPE2 Q. UCB SPECIFIED 73680002 BZ NRESV1 A. NO. 73710002 TM PELFLAG-PEL(R9),PELSCPE1 Q. UCB SPECIFIED. 73740002 BO NRESV1 A. NO. 73770002 SH R12,HFOUR Q. END OF MOVE 73800002 BM YERRLIST A. YES. INPUT LIST VOLATILE. 73830002 SH R14,HFOUR Q. END OF MOVE 73860002 BM YERRLIST A. YES. INPUT LIST VOLATILE. 73890002 TEST58 EQU * * 73920002 MODESET KEYADDR=(2) SWITCH TO CALLER'S KEY 73950002 L R15,PELUCBAA-PEL(R8) GET THE UCB ADDR ADDR 73980002 L R15,ZERO(R15) GET THE UCB ADDR 74010002 TEST59 EQU * * 74040002 MODESET EXTKEY=SUPR SWITCH BACK TO KEY 0 74070002 ST R15,ZERO(R10) SAVE THE UCB ADDRESS 74100002 ST R10,PELUCBAA-PEL(R9) SAVE UCB ADDR ADDR 74130002 LA R8,FOUR(R8) UPDATE OLD PEL ADDRESS 74160002 LA R9,FOUR(R9) UPDATE NEW PEL ADDRESS 74190002 LA R10,FOUR(R10) UPDATE NAMES ADDR 74220002 NRESV1 EQU * * 74250002 LA R8,PELELEM(R8) UPDATE OLD PEL ADDRESS 74280002 LA R9,PELELEM(R9) UPDATE NEW PEL ADDRESS 74310002 B QMOVLIST LOOP. 74340002 YERRLIST EQU * INPUT LIST VOLATILE 74370002 MVI WAERR,AB4XX INDICATE INVALID PARM LIST 74400002 YMOVLIST EQU * * 74430002 NGOT2 EQU * * 74460002 YAUTH EQU * * 74490002 * OBTAIN CMS LOCK 74520002 X4 SETLOCK OBTAIN,TYPE=CMS,MODE=UNCOND,RELATED=((X8),(X9)) LOCK 74550002 TEST60 EQU * * 74580002 OI WAFLAG1,WACMS INDICATE CMS OBTAINED 74610002 L R13,CVTPTR GET GLOBAL SAVE ADDRESS 74640002 TEST61 EQU * * 74670002 L R13,CVTSPSA-CVT(R13) DITTO 74700002 L R13,WSAGNQDQ-WSAG(R13) DITTO 74730002 XC GSCLEAR(GSCLEARL),GSCLEAR ZERO PORTION OF GLOBAL STORE 74760002 TEST62 EQU * * 74790002 L R14,PSAAOLD SAVE THE ASID 74820002 MVC GSASID(TWO),ASCBASID-ASCB(R14) DITTO 74850002 L R8,WANEWPEL SETUP CORRECT PARM LIST ADDRESS 74880002 * WANEWPEL CONTAINS EITHER THE NEWLY GOTTEN LIST OR THE INPUT LIST 74910002 BR R3 RETURN 74940002 EJECT 74970002 XSTARTIO EQU * * 75000002 * ROUTINE TO BE SCHEDULED BY IOS AT THE COMPLETION OF 75030002 * THE I/O DONE TO RELEASE A RESERVED DEVICE. 75060002 LR R8,R14 SAVE RETURN REG. 75090002 BALR R15,ZERO OBTAIN ADDRESSABILITY 75120002 USING *,R15 DITTO 75150002 LM R6,R7,BASES OBTAIN ADDRESSABILITY TO ENTIRE MODULE 75180002 DROP R15 * 75210002 X1 SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,RELATED=((X2)) LOCK 75240002 TEST62A EQU * * 75270002 LA R0,ZLEN LENGTH OF IOSB-SRB CORE 75300002 L R3,SP245 SUBPOOL 245 75330002 SR R4,R4 PASS NO TCB ADDRESS 75360002 L R7,PSAAOLD GET CURRENT ASCB 75390002 BALR R15,ZERO TEMP ADDRESSABILITY 75420002 USING *,R15 DITTO 75450002 FREEMAIN RC,LV=(0),A=(1),KEY=(3),SP=(3),BRANCH=YES FREE CORE 75480002 TEST62B EQU * * 75510002 DROP R15 RELEASE TEMP ADDRESSABILITY 75540002 L R7,BASES+FOUR RESTORE 2ND BASE REG. 75570002 X2 SETLOCK RELEASE,TYPE=LOCAL,RELATED=((X1)) UNLOCK 75600002 TEST62C EQU * * 75630002 LR R14,R8 RESTORE RETURN REGISTER 75660002 BR R14 BRANCH TO DISPATCHER. 75690002 EJECT 75720002 XSVCFREE EQU * * 75750002 FREEMAIN RC,LV=(0),A=(1),SP=(14) FREE STORAGE 75780002 TEST63 EQU * * 75810002 BR R12 EXIT 75840002 EJECT 75870002 XUNCHAIN EQU * * 75900002 ICM R14,M1111,PREV(R12) GET PREVIOUS 75930002 L R15,NEXT(R12) GET THE NEXT 75960002 BZ NPREV THERE IS NO PREVIOUS 75990002 * YES PREVIOUS 76020002 LTR R15,R15 Q. IS THERE A NEXT. 76050002 BZ NNEXT A. NO. 76080002 * NEXT AND PREVIOUS (UNCHAIN FROM MIDDLE) 76110002 ST R15,NEXT(R14) NEXT=NEXT 76140002 ST R14,PREV(R15) PREV=PREV 76170002 BR R3 RETURN 76200002 NNEXT EQU * * 76230002 * NO NEXT AND PREVIOUS (UNCHAIN FROM BOTTOM) 76260002 ST R15,NEXT(R14) NEXT=0 76290002 ST R14,LAST(R1) LAST=PREV 76320002 BR R3 RETURN 76350002 NPREV EQU * * 76380002 LTR R15,R15 Q. IS THERE A NEXT 76410002 BZ NNEXT1 A. NO. 76440002 * NO PREVIOUS AND A NEXT (UNCHAIN FROM TOP) 76470002 ST R15,FIRST(R1) FIRST=NEXT 76500002 ST R14,PREV(R15) PREV=0 76530002 BR R3 RETURN 76560002 NNEXT1 EQU * * 76590002 * NO PREVIOUS AND NO NEXT (UNCHAIN ONLY) 76620002 ST R15,FIRST(R1) FIRST=0 76650002 ST R14,LAST(R1) LAST=0 76680002 BR R3 RETURN 76710002 DROP R6,R7 76720040 EJECT 76740002 IHAASCB 76777703 EJECT 76780002 IHAASVT @YM01596 76790002 EJECT 76800002 IHAASXB 76830002 EJECT 76860002 CVT DSECT=YES,LIST=YES 76890002 EJECT 76920002 IHADQE 76950002 EJECT 76980002 IHAFRRS 77010002 EJECT 77040002 IHAFQE 77070002 EJECT 77100002 IHAGDA 77130002 EJECT 77160002 ********************************************************************** 77162003 * * 77164003 * ENQ/DEQ/RESERVE GLOBAL SAVE AREA * 77166003 * * 77168003 * * 77170003 * A NIP DEPENDENCY REQUIRES THAT THE FOLLOWING @Z30BNVD 77172003 * DATA FIELDS BEGIN AT DISPLACEMENT X'80' AND ARE @Z30BNVD 77174003 * CONTIGUOUS. NIP INITIALIZES THESE FIELDS. @Z30BNVD 77176003 * GSCOUNT - 6 WORDS @Z30BNVD 77178003 * GSQUEUE - 6 WORDS @Z30BNVD 77180003 * GSBLOCKB - 1 WORD @Z30BNVD 77182003 * GSBLOCKE - 1 WORD @Z30BNVD 77184003 * * 77186003 ********************************************************************** 77188003 GS DSECT 77190002 GSSAVE DS 0F 18 WORD SAVE AREA 77220002 DS F 1ST WORD 77250002 GSPSAVE DS F PREVIOUS SAVE 77280002 GSNSAVE DS F NEXT SAVE 77310002 GSSAVE1 DS 16F REGISTER SAVE AREA (MUST BE 16 WORDS) 77340002 GSR14SAV DS 1F LINK R14 SAVE AREA 77370002 GSR2SAVE DS 1F LINK R2 SAVE AREA 77400002 GSGBSV DS 0F GET/FREE BLOCK RTN SAVE AREA @Z30BNVD 77402003 GSR3SAVE DS 11F LINK R3 SAVE AREA 77430002 GSCOUNT DS 6F CONTAINS COUNT OF FREE CELLS IN QUEUE 77460002 GSQUEUE DS 6F POINTERS TO HEADS OF FREE CELL QUEUES 77490002 GSBLOCKB DS F BEGINNING ADDR OF BLOCK @Z30BNVD 77492003 GSBLOCKE DS F ENDING ADDR OF BLOCK @Z30BNVD 77502003 GSCLEAR EQU * HERE TO GSCLEARL IS CLEARED ON EACH ENTRY 77520002 GSLSTQEL DS F LIST QEL SAVE FOR DEQ 77550002 GS3WORDS DS 0F BLOCK LENGTH SAVE LOCATIONS 77580002 GSMNWORD DS F LENGTH OF MINOR BEING OBTAINED 77610002 GSMJWORD DS F LENGTH OF MAJOR BEING OBTAINED 77640002 GSQLWORD DS F LENGTH OF QEL BEING OBTAINED 77670002 GSGPAREA EQU * BEGINNING OF GROUP INDICATORS 77700002 GSGRPNUM DS F ACTUAL OR POTENTIAL GROUP NUMBER 77730002 GSGROUP DS 0H BEGINNING OF GROUP COUNTERS 77760002 GSGROUP0 DS H DUMMY GROUP. 77790002 GSGROUP1 DS H NUMBER OF QELS IN GROUP 1 77820002 GSGROUP2 DS H NUMBER OF QELS IN GROUP 2 77850002 GSGROUP3 DS H NUMBER OF QELS IN GROUP 3 77880002 GSGROUP4 DS H NUMBER OF QELS IN GROUP 4 77910002 GSGPLEN EQU *-GSGPAREA LENGTH OF GROUP INDICATOR AREA 77940002 GSASID DS H ASID SAVE LOCATION 77970002 GSCLEARL EQU *-GSCLEAR LENGTH OF AREA REINIT. ON EACH ENTRY 78000002 GSFLAG1 DS B GENERAL ENQ/DEQ STATUS FLAGS 78030002 GSHOLD EQU X'80' USED ONLY BY THE XHOLD/XRLSE ROUTINE 78060002 GSNOENQ EQU X'40' ENQ ON-OFF SWITCH 78090002 GSFRRSER EQU X'20' SERIOUS ERROR (SET BY FRR) 78120002 * FROM HERE ON IS FRR WORK AREA 78150002 GSFRRSAV DS 4F GENERAL SAVE AREA 78180002 GSFRRSDW EQU GSFRRSAV+12 SDWA AD (REG 1) 78210002 GSFRR2SV DS 4F LINK REG2 SAVE AREA 78240002 GSFRR3SV DS 4F LINK REG3 SAVE AREA 78270002 GSFRR4SV DS 4F LINK REG4 SAVE AREA 78300002 EJECT 78330002 IECDIOCM 78360002 EJECT 78390002 IECDIOSB 78420002 IOSBLEN EQU IOSEND-IOSB LENGTH OF IOSB 78450002 EJECT 78480002 IHAQCB 78510002 MAJBASIC EQU 24 LENGTH OF ALL MAJORS 78540002 MAJLEN EQU MAJNAME-MAJ+8 BASIC SIZE OF A MAJOR QCB 78570002 MINLEN EQU MINNAME-MIN NON-VARIABLE SIZE OF MINOR QCB 78600002 MINBASIC EQU 20 MINIMUM LENGTH OF ALL MINORS 78630002 EJECT 78660002 PELPREFX DSECT 78690002 PELTCB DS A IF BOTH TCB AND ECB ARE CODED, TCB 78700040 * ADDRESS @ZA14267 78706040 PELDUAL DS A PEL PREFIX WORD (TCB ADDR. OR ECB ADDR.) 78720002 PEL EQU * BEGINNING OF PEL 78750002 PELLAST DS X FLAG 1 BYTE 78780002 PELEOL EQU X'80' LAST ELEMENT OF LIST 78810002 PELIGNOR EQU X'40' IGNORE REMAINING BITS OF THIS BYTE 78840002 PELRES1 EQU X'20' RESERVED 78870002 PELSHR EQU X'10' SHARED RESOURCE @YM03340 78900002 PELSAVE EQU X'08' RESERVED 78930002 PELGEN1 EQU X'04' SEE COMMENTS BELOW 78960002 PELGEN2 EQU X'02' SEE COMMENTS BELOW 78990002 PELTCBF EQU X'01' TCB= WAS SPECIFIED 79020002 * PELGEN1 AND PELGEN2 79050002 * 00- NO GENERIC 79080002 * 01- GENERIC=YES 79110002 * 10- GENERIC=COND (VS1 ONLY) 79140002 * 11- GENERIC=ALL (VS1 ONLY) 79170002 PELMILEN DS X RNAME LENGTH 79200002 PELFLAG DS X FLAG 2 BYTE 79230002 PELSHARE EQU X'80' 0 = EXCLUSIVE, 1 = SHARE 79260002 PELSCPE1 EQU X'40' SEE COMMENTS BELOW 79290002 PELSYSMC EQU X'20' OBSOLETE (SET/RESET SYSTEM MUST COMPLETE) 79320002 PELSTPMC EQU X'10' SET/RESET STEP MUST COMPLETE SPECIFIED 79350002 PELSCPE2 EQU X'08' SEE COMMENTS BELOW 79380002 PELRET1 EQU X'04' SEE COMMENTS BELOW 79410002 PELRET2 EQU X'02' SEE COMMENTS BELOW 79440002 PELRET3 EQU X'01' SEE COMMENTS BELOW 79470002 * PELRET1 AND PELRET2 AND PELRET3 79500002 * 000- RET=NONE (NO RET) 79530002 * 001- RET=HAVE 79560002 * 010- RET=CHNG 79590002 * 011- RET=USE 79620002 * 100- ECB= 79650002 * 101- RESERVED 79680002 * 110- RESERVED 79710002 * 111- RET=TEST 79740002 * PELSCPE1 AND PELSCPE2 79770002 * 00- STEP 79800002 * 01- SYSTEMS AND UCB 79830002 * 10- SYSTEM 79860002 * 11- SYSTEMS 79890002 PELRET DS X RETURN CODE AREA 79920002 PELMAJA DS A ADDRESS OF QNAME 79950002 PELMAJSZ EQU 8 LENGTH OF QNAME 79980002 PELMINA DS A ADDRESS OF RNAME 80010002 PELELEM EQU *-PEL LENGTH OF ONE PARAMETER ELEMENT 80040002 PELUCBAA DS A ADDRESS OF POINTER TO UCB 80070002 EJECT 80100002 IHAPSA 80130002 EJECT 80160002 IHAQEL 80190002 QELSIZE1 EQU 16 SUBORDINATE QEL (NOT LIST QEL) 80220002 QELSIZE2 EQU 24 LISTQEL WITHOUT UCB 80250002 QELSIZE3 EQU 28 LIST QEL WITH UCB 80280002 QELBASIC EQU 16 MINIMUM LENGTH OF ALL QELS 80310002 EJECT 80340002 IHARB 80370040 RBOPSWKY EQU RBOPSW+1 PSW KEY IN RB 80400002 EJECT 80430002 ORG RBEXSAVE 80460002 WA EQU * ENQ WORK AREA 80490002 * WARNING----WARNING----WARNING----WARNING----WARNING----WARNING * 80520002 * ENQ/DEQ MAY USE 12 WORDS 80550002 * THE RESOURCE MANAGER AND SUBROUTINES MAY ONLY USE THE 1ST 7 WORDS 80580002 * COMMON TO ENQ/DEQ/RESOURCE MANAGER 80610002 WADWORD DS D QUICK SAVE AREA (NOT USED ACROSS BAL) 80640002 WAWTOQ DS F PTR. TO FIRST MSG. IN MSG. QUEUE 80670002 WARETRY DS X INDEX TO RETRY ADDRESS 80700002 WAERR DS X FIRST DIGIT OF ABEND CODE 80730002 WARESV1 DS H RESERVED 80760002 WAFLAG1 DS B CURRENT PROCESSING FLAGS 80790002 WACMS EQU X'80' ON - CMS LOCK HELD 80820002 WAFRR EQU X'40' ON - FRR ESTABLISHED 80850002 WALOCAL EQU X'20' ON - LOCAL LOCK HELD 80880002 WASPOST EQU X'10' ON - ISSUE SPOST 80910002 WASTATUS EQU X'08' ON - ISSUE STATUS 80940002 WAABNDMC EQU X'04' THIS TASK/ADDRSPACE ABEND IN M.C. 80970002 WAWAITN EQU X'02' ON - WAITING QEL FOUND (NOT ECB) 81000002 WA1DEQ EQU X'01' ON - INDICATES AT LEAST ONE QEL DEQUEUED 81030002 WAFLAG2 DS B USER/INPUT SUMMARY FLAGS 81060002 WABADMIL EQU X'80' ON - BAD MINOR LENGTH SPECIFIED 81090002 WARMC EQU X'40' ISSUE STATUS RESET,MC,STEP 81120002 WADAMAGE EQU X'20' TRIGGERS Q-DAMAGE MESSAGE 81150002 WANOCORE EQU X'10' ON - NO STORAGE AVAILABLE 81180002 WAR15SW EQU X'08' ON - INDICATES NON-ZERO RETURN CODE 81210002 WAWAIT EQU X'04' ON - WAIT WITHIN ENQ 81240002 WANOAUTH EQU X'02' ON - FAILED AUTHORIZATION CHECK 81270002 WANWPEL EQU X'01' INDICATES GOT NEW PARM LIST CORE 81300002 WAPFLGS DS H SAVED PARM FLAGS 81330002 WAPLAST EQU WAPFLGS+0 SAVED PELLAST FLAG BYTE 81360002 WAPFLAG EQU WAPFLGS+1 SAVED PELFLAG FLAG BYTE 81390002 WARMLEN EQU *-WA RES. MGR. WA LENGTH 81420002 * COMMON TO JUST ENQ/DEQ 81450002 WANEWPEL DS F NEW PARAMETER LIST ADDR (UNAUTH. CALLER) 81480002 WAOLDPEL DS F INPUT PARAMETER LIST ADDRESS 81510002 WAPARMSZ DS F SIZE OF NEW PARAM. LIST OBTAINED 81540002 WANAMESZ DS F TOTAL SIZE OF MINOR NAME 81570002 WAFLAG3 DS B ADDITIONAL PROCESSING FLAGS @Z30BNVD 81600003 WALONGWT EQU X'80' ON - ISSUE LONG WAIT @Z30BNVD 81610003 WARET DS B RETURN CODE SAVE LOCATION 81630002 WAKEY DS H CALLER'S KEY 81660002 WAECBA DS F ECB SAVE FOR ENQ (HIGH BIT 1) 81690002 WATCBA EQU WAECBA TCB SAVE FOR ENQ/DEQ (HIGH BIT 0) 81720002 WAECBF EQU X'80' HIGH BIT 1 MEANS ECB SPECIFIED. 81750002 WALEN EQU *-WA LENGTH OF WORK AREA 81780002 EJECT 81810002 IHARMPL 81840002 EJECT 81845040 IHASCB 81850040 EJECT 81860040 EJECT 81870002 IHASRB 81900002 SRBLEN EQU *-SRB LENGTH OF SRB 81930002 EJECT 81960002 IHASCVT LIST=YES @YM03564 81970002 EJECT 81980002 IHASDWA 81990002 ORG SDWAVRA VARIABLE RECORDING AREA 82020002 VRA EQU * * 82050002 VRACOUNT DS XL4 ERROR COUNT 82080002 * FROM HERE DOWN IS INFO PERTAINING TO FIRST ERROR ENCOUNTERED 82110002 VRACSECT DS XL4 ADDRESS OF IEAVENQ1 82140002 VRALINKA DS XL4 LAST 'BAL' PRIOR TO RECORDING 82170002 VRACODE DS XL4 CODE X'10' QEL, X'14' MINOR, X'18' MAJOR 82200002 VRAADDR1 DS XL4 FIRST ADDRESS OF INVALID RANGE 82230002 VRAADDR2 DS XL4 LAST ADDRESS OF INVALID RANGE 82260002 VRALEN1 EQU *-VRA MINIMUM RECORD LENGTH 82290002 VRAIMAGE DS XL64 INVALID RANGE IMAGE 82320002 VRALEN2 EQU *-VRAIMAGE MAXIMUM IMAGE LENGTH 82350002 EJECT 82380002 IHASPQE 82410002 EJECT 82440002 IKJTCB 82470002 EJECT 82500002 TIOT DSECT 82530002 IEFTIOT1 82560002 EJECT 82590002 IEFUCBOB DSECT 82620002 IEFUCBOB LIST=YES 82650002 UCBSKA EQU UCBOB+X'30' SEEK ADDRESS 82680002 EJECT 82710002 IHAWSAVT CLASS=GLOBAL 82740002 EJECT 82750040 IHAWSAVT 82760040 EJECT 82770002 Z DSECT 82800002 * COMBINES THE IOSB AND SRB FOR 'STARTIO' LOGIC. 82830002 ZIOSB DS 0D IOSB 82860002 ORG *+IOSBLEN IOSB END 82890002 ZSRB DS 0D SRB 82920002 ORG *+SRBLEN SRB END 82950002 ZLEN EQU *-Z Z END 82980002 EJECT 83010002 IGC048 CSECT 83040002 * THESE CONSTANTS MUST BE ADDRESSABLE BY THE FRR, 83042040 * THE ESTAE, AND NORMAL ENQ/DEQ PROCESSING. THE 83044040 * TECHNIQUE USED IS THAT THE FRR USES THE START OF 83046040 * THE CONSTANTS AS THE BEGINNING OF ITS ADDRESSABILITY. 83048040 * ALL OTHER PROCESSING USES THE BEGINNING OF THE 83050040 * MODULE AS THE START OF ADDRESSABILITY; THUS, THE 83052040 * CONSTANT AREA IS AT THE END OF THAT ADDRESSABILITY. 83054040 * 83056040 FRRBASE DS 0D DUMMY FOR FRR ADDRESSABILITY 83058040 * THE FOLLOWING CONSTANTS ARE NEEDED FOR INTRA MODULE 83060040 * ADDRESSABILITY. 83062040 * 83064040 BASES DC A(IGC048),A(IGC048+4096) BASE ADDRESS'S FOR THIS MODULE 83070002 ERBPREL DC AL4(RBPRFXND-RBPREFIX) LENGTH OF RB PREFIX @ZA03873 83080040 POSTADDR DC V(IEA0PT01) POST E.P. 83100002 WAITADDR DC V(IEAVWAIT) BRANCH E.P. TO WAIT 83130002 SP245 DC 0F'0',AL3(245),AL1(0) SUBPOOL 245 83160002 SP253 DC 0F'0',AL3(253),AL1(0) SUBPOOL 253 83190002 FONE DC F'1' FULL WORD ONE 83220002 HONE EQU FONE+2 HALF WORD ONE 83250002 FFOUR DC F'4' FULL WORD FOUR 83280002 HFOUR EQU FFOUR+2 HALF WORD FOUR 83310002 FEIGHT DC F'8' FULL WORD EIGHT 83340002 HEIGHT EQU FEIGHT+2 HALF WORD EIGHT 83370002 HIGHBIT DC X'80000000' MASK TO TURN ON HIGH ORDER BIT 83400002 KEYMASK DC X'000000F0' MASK TO TURN OFF ALL BUT KEY BITS 83430002 HMAJSZ EQU FEIGHT+2 MAJOR NAME LENGTH 83460002 HPELSZ DC H'12' ELEMENT SIZE IN INPUT PARM LIST 83490002 HMAXLEN DC AL2(INSERT7L) MAXIMUM MINOR LENGTH FOR MSG 83520002 ST DC CL2'ST' ST MEANS STEP. 83550002 HPREFIX DC AL2(PEL-PELPREFX) LENGTH OF PEL PREFIX @ZA14267 83560040 TABLE DC CL16'0123456789ABCDEF' TRANSLATE TABLE 83580002 SYSTABLE DS 0D AUTHORIZED NAME TABLE 83610002 * THIS TABLE MUST BE IN ALPHABETICAL ORDER 83640002 DC CL8'SYSCTLG' SYSCTLG @Y02113 83690002 DC CL8'SYSDSN' SYSDSN 83700002 DC CL8'SYSIEA01' SYSIEA01 83730002 DC CL8'SYSIEECT' SYSIEECT 83760002 DC CL8'SYSIEFSD' SYSIEFSD 83790002 DC CL8'SYSIGGV1' SYSIGGV1 @Y02113 83800002 DC CL8'SYSIGGV2' SYSIGGV2 @Y02113 83810002 DC CL8'SYSPSWRD' SYSPSWRD 83820002 DC CL8'SYSVSAM' SYSVSAM @Y02113 83830002 DC CL8'SYSVTOC' SYSVTOC 83850002 SYSZ DC CL4'SYSZ',XL4'FFFFFFFF' THIS IS A STOPPER 83880002 LIST DC CL8'IEAVENQ1' LOAD MUDULE NAME 83910002 DC CL8'IGC048' CSECT NAME 83940002 DC CL8'IEAVSRR1' FRR NAME 83970002 LISTLEN EQU *-LIST * 84000002 RETRY DS 0F RETRY ADDRESSES 84030002 RETRYDEQ EQU *-RETRY INDEX TO RETRY ADDRESS 84060002 DC A(DEQXRTRY) DEQ RETRY ADDRESS 84090002 RETRYENQ EQU *-RETRY INDEX TO RETRY ADDRESS 84120002 DC A(ENQXRTRY) ENQ RETRY ADDRESS 84150002 RETRYERM EQU *-RETRY INDEX TO RETRY ADDRESS 84180002 DC A(ERMXRTRY) RES. MGR. RETRY ADDRESS 84210002 DUMMYPEL DS 0F DUMMY PEL FOR QEL SCAN ROUTINE 84240002 DUMMYWD1 DC X'80010000' END OF LIST AND MINOR LENGTH OF ONE 84270002 DUMMYWD2 DC X'00000000' DUMMY QNAME ADDRESS 84300002 DUMMYWD3 DC X'00000000' DUMMY RNAME ADDRESS 84330002 FZERO EQU DUMMYWD3 FULLWORD OF ZERO 84360002 HZERO EQU FZERO HALFWORD OF ZERO 84390002 * NOTE: BY CHANGING QTAB,GSCOUNT AND GSQUEUE THE NUMBER OF 84420002 * QUEUES CAN BE CHANGED. 84450002 IEAVENQQ DS 0F USED BY NIP TO INIT LIMITS @Z30BNVD 84460003 QTAB DC F'0',F'0',F'48',F'98',F'18',F'10' Q LIMITS=4K @Z30BNVD 84480003 QLENGTH EQU *-QTAB-4 TABLE LENGTH 84510002 QRANGE DC A(QLENGTH) ALL INSIDE OF RANGE CAN BE QUEUED 84540002 BLKSIZE DC F'0',F'0',F'384',F'1152',F'256',F'160' SECONDARY X84544003 BLOCK SIZES 24,48,8,4 ELEMENTS RESPECTIVELY @Z30BNVD 84554003 BR14 BR R14 ERROR ROUTINE FOR BAD CROSS MEM POSTS 84570002 MOVEMIN MVC ZERO(ZERO,R10),ZERO(R15) MOVE RNAME 84600002 MOVEMIN1 MVC MINNAME-MIN(ZERO,R12),ZERO(R14) MOVE RNAME 84630002 MOVEMIN2 MVC INSERT7+FOUR(ZERO,R1),MINNAME MOVE MINOR TO WTO STORAGE 84660002 COMPMIN CLC MINNAME(ZERO),ZERO(R12) COMPARE MINOR NAMES 84690002 EJECT 84720002 ERMWTP WTO 'IEA803I JS FAILED WHILE IN ''STEP MUST COMPLETE'' STATU-84750002 S DUE TO S ',MF=L,ROUTCDE=(1) WTP MSG 84780002 INSERT1 EQU 12 JS OR ST INSERT 84810002 INSERT2 EQU 66 COMP CODE INSERT 84840002 ERMWTO1 WTO 'IEA801I UNIDENTIFIED TASK JS FAILED WHILE IN ''STEP MUS-84870002 T COMPLETE STATUS''',ROUTCDE=(1),DESC=3,MF=L WTO MSG 84900002 INSERT5A EQU 30 ST OR JS INSERT 84930002 INSERT3 EQU 12 JOB NAME INSERT 84960002 INSERT4 EQU 20 COMMA INSERT 84990002 INSERT5 EQU 21 STEP NAME INSERT 85020002 ERMWTO2 WTO 'IEA961I RESOURCE NAMED , -85050002 ',ROUTCDE=(1),DESC=3,MF=L WTO MSG 85080002 INSERT6 EQU 27 MAJOR NAME INSERT 85110002 INSERT7 EQU 36 MINOR NAME INSERT 85140002 FRRWTO WTO 'IEA960I ENQ/DEQ CONTROL QUEUES WERE DAMAGED. RESTORATIO-85170002 N ATTEMPTED',ROUTCDE=(1),DESC=3,MF=L WTO MSG 85200002 INSERT1L EQU 2 JS OR ST LENGTH 85230002 INSERT3L EQU 8 JOB NAME LENGTH 85260002 INSERT5L EQU 8 STEP NAME LENGTH 85290002 INSERT6L EQU 8 MAJOR NAME LENGTH 85320002 INSERT7L EQU 24 MAX MINOR NAME LENGTH 85350002 MAYBEDAM DC CL14'MAY BE DAMAGED' INSERT FOR ERMWTO2 85380002 MAYLEN EQU *-MAYBEDAM MSG LENGTH 85410002 EJECT 85440002 * BIT MASKS 85450002 M0001 EQU B'0001' MASK USED IN ICM INSTR. 85470002 M0010 EQU B'0010' MASK USED IN ICM INSTR. 85490002 M0011 EQU B'0011' MASK USED IN ICM INSTR. 85510002 M0111 EQU B'0111' MASK USED IN ICM INSTR. 85530002 M1000 EQU B'1000' MASK USED IN ICM INSTR. 85550002 M1100 EQU B'1100' MASK USED IN ICM INSTR. 85570002 M1111 EQU B'1111' MASK USED IN ICM INSTR. 85590002 * REGISTER EQUATES - INDICATE GENERAL USAGE 85610002 R0 EQU 0 WORK 85680002 R1 EQU 1 ADDRESS OF SDWA OR WORK 85700002 R2 EQU 2 RETURN ADDR. - FIRST LEVEL SUBROUTINES 85720002 R3 EQU 3 RETURN ADDR. - SECOND LEVEL SUBROUTINES 85740002 R4 EQU 4 ADDRESS OF CURRENT TCB 85760002 R5 EQU 5 ADDRESS OF CURRENT RB 85780002 R6 EQU 6 FIRST BASE 85800002 R7 EQU 7 SECOND BASE 85820002 R8 EQU 8 ADDR. OF PEL OR ADDR. OF RMPL 85840002 R9 EQU 9 ADDRESS OF MAJOR 85860002 R10 EQU 10 ADDRESS OF MINOR 85880002 R11 EQU 11 ADDRESS OF QEL 85900002 R12 EQU 12 RETURN ADDR. - THIRD LEVEL SUBROUTINES 85920002 R13 EQU 13 ADDR. OF ENQ/DEQ GLOBAL SAVE AREA 85940002 R14 EQU 14 WORK 85960002 R15 EQU 15 WORK AND RETURN CODE 85980002 EJECT 86140002 * CONSTANTS 86150002 ZERO EQU 0 ZERO 86160002 ONE EQU 1 ONE 86190002 TWO EQU 2 TWO 86220002 THREE EQU 3 THREE 86250002 FOUR EQU 4 FOUR 86280002 FIVE EQU 5 FIVE 86310002 SEVEN EQU 7 SEVEN 86340002 EIGHT EQU 8 EIGHT 86370002 NINE EQU 9 NINE 86400002 TWELVE EQU 12 TWELVE 86430002 TWENTY EQU 20 TWENTY 86460002 BLKRANGE EQU 20 INDEX TO LAST AVAILABLE X86461003 COUNT/QUEUE IN THE GS @Z30BNVD 86463003 AB138 EQU 1 PREFIX FOR ABEND CODE 86490002 AB238 EQU 2 PREFIX FOR ABEND CODE 86520002 AB338 EQU 3 PREFIX FOR ABEND CODE 86550002 AB438 EQU 4 PREFIX FOR ABEND CODE 86580002 AB638 EQU 6 PREFIX FOR ABEND CODE 86610002 AB838 EQU 8 PREFIX FOR ABEND CODE 86640002 AB130 EQU 1 PREFIX FOR ABEND CODE 86670002 AB230 EQU 2 PREFIX FOR ABEND CODE 86700002 AB330 EQU 3 PREFIX FOR ABEND CODE 86730002 AB430 EQU 4 PREFIX FOR ABEND CODE 86760002 AB530 EQU 5 PREFIX FOR ABEND CODE 86790002 AB630 EQU 6 PREFIX FOR ABEND CODE 86820002 AB3XX EQU 3 PREFIX FOR ABEND CODE 86850002 AB4XX EQU 4 PREFIX FOR ABEND CODE 86880002 AB6XX EQU 6 PREFIX FOR ABEND CODE 86910002 AB7XX EQU 7 PREFIX FOR ABEND CODE 86940002 NEXT EQU 0 NEXT MAJ,MIN,QEL 86970002 PREV EQU 4 PREVIOUS MAJ,MIN,QEL 87000002 FIRST EQU 0 FIRST MAJ,MIN,QEL 87030002 LAST EQU 4 LAST MAJ,MIN,QEL 87060002 FWORD EQU 3 FULLWORD BOUNDRY CHECK 87090002 DWORD EQU 7 DOUBLEWORD BOUNDRY CHECK 87120002 XFF EQU X'FF' ALL ONES 87150002 DEQCODE EQU X'30' BACK END OF DEQ ABEND CODE. 87180002 ENQCODE EQU X'38' BACK END OF ENQ CODE. 87210002 NOSUPKEY EQU X'80' WHEN ON - NOT SUPR KEY @YM03564 87220002 WTOLEN EQU 88 LENGTH OF WTO GOTTEN STORAGE 87270002 EJECT 87290040 IEAVSRR1 EQU * SOFTWARE RECOVERY ROUTINE 87310040 DEQFRR EQU * * 87330040 ENQFRR EQU * * 87350040 ERMFRR EQU * * 87370040 XFRR EQU * * 87390040 BALR R15,ZERO TEMPORARY ADDRESSABILITY 87410040 USING *,R15 TEMPORARY ADDRESSABILITY 87430040 L R6,XFRRBASE GET PERMANENT ADDRESSABILITY 87440040 DROP R15 87470040 USING FRRBASE,R6 PERMANENT ADDRESSABILITY 87480040 USING SDWA,R1 SDWA ADDRESSABILITY 87510040 MVC SDWAMODN(LISTLEN),LIST MOVE 3 NAMES 87530040 OI SDWAACF2,SDWAFREE+SDWARCRD FREE SDWA, ALSO RECORD. 87550040 ICM R0,M0011,SDWAFMID Q. LSQA ADDRESSABLE 87570040 BNZ NREF A. NO. 87590040 L R5,SDWAPARM GET W.A. ADDRESSABILITY 87610040 L R5,ZERO(R5) DITTO 87630040 MVI WAERR,AB7XX INDICATE UNEXPECTED ABEND 87650040 L R9,CVTPTR GET ENQ/DEQ GLOBAL S.A. 87670040 TEST19A EQU * * 87690040 L R13,CVTSPSA-CVT(R9) DITTO. 87710040 L R13,WSAGNQDQ-WSAG(R13) DITTO 87730040 * 87750040 * PARM LIST IS INVALID, IF--- 87770040 * PROGRAM CHECK OCCURRED 87790040 * PROGRAM CHECK PSW KEY IS NOT ZERO 87810040 * FRR WAS NOT PERCOLATED TO. 87830040 * NOTE-THE RESOURCE MANAGER RUNS ONLY IN KEY 0. 87850040 * 87870040 TM SDWAERRA,SDWAPCHK Q. INVALID PARM LIST 87890040 BZ NINVALID A. NO. 87910040 TM SDWAMWP1,SDWAKEY1 Q. INVALID PARM LIST 87930040 BZ NINVALID A. NO. 87950040 TM SDWAERRC,SDWAPERC Q. INVALID PARM LIST. 87970040 BO NINVALID A. NO. 87990040 MVI WAERR,AB4XX INDICATE INVALID LIST ABEND 88010040 NI SDWAACF2,XFF-SDWARCRD DON'T RECORD 88030040 B YINVALID A. YES. INVALID PARM LIST 88050040 NINVALID EQU * * 88070040 STM R14,R1,GSFRRSAV SAVE RETURN AD,SDWA AD 88090040 TM WAFLAG1,WACMS Q. HAVE CMS. 88110040 BZ NSEARCH A. NO. 88130040 LR R0,R13 SAVE REG 88150040 XX SETLOCK OBTAIN,TYPE=SALLOC,MODE=UNCOND,RELATED=((XY)) 88170040 TEST19B EQU * * 88190040 LR R13,R0 RESTORE REG 88210040 * SCAN,VERIFY AND FIX QUEUES. 88230040 LA R12,CVTFQCB-CVT(R9) ADDRESS OF FIRST/LAST (MAJOR) 88250040 LA R8,MAJBASIC PASS COMMON LENGTH OF MAJOR 88270040 BAL R2,XFRRFIX VERIFY AND MAYBE FIX, Q. SERIOUS ERROR 88290040 BZ NSERIOUS A. NO. 88310040 OI GSFLAG1,GSNOENQ A. YES, TURN OFF ENQ. 88330040 NSERIOUS EQU * * 88350040 ICM R9,M1111,CVTFQCB-CVT(R9) Q. ANY MAJORS 88370040 QMAJOR1 EQU * * 88390040 BZ NMAJOR1 A. NO. 88410040 LA R12,MAJFMIN ADDRESS OF FIRST/LAST (MINOR) 88430040 LA R8,MINBASIC PASS COMMON LENGTH OF MINOR 88450040 BAL R2,XFRRFIX VERIFY AND MAYBE FIX. Q. SERIOUS ERROR 88470040 BZ NSER A. NO. 88490040 OI GSFLAG1,GSNOENQ A. YES. TURN OFF ENQ. 88510040 NSER EQU * * 88530040 ICM R10,M1111,MAJFMIN Q. ANY MINORS. 88550040 QMINOR1 EQU * * 88570040 BZ NMINOR1 A. NO. 88590040 LA R12,MINFQEL ADDRESS OF FIRST/LAST (QEL) 88610040 LA R8,QELBASIC PASS COMMON LENGTH OF QEL 88630040 BAL R2,XFRRFIX VERIFY AND MAYBE FIX, Q. SERIOUS ERROR 88650040 BZ NSERI A. NO. 88670040 OI MINFLGS,MINNOENQ A. YES. NO ENQS FOR THIS MINOR 88690040 NSERI EQU * * 88710040 ICM R10,M1111,MINNMIN Q. ANY MORE MINORS. 88730040 BNZ QMINOR1 A. YES. 88750040 NMINOR1 EQU * * 88770040 ICM R9,M1111,MAJNMAJ Q. ANY MAJORS LEFT. 88790040 BNZ QMAJOR1 A. YES. 88810040 NMAJOR1 EQU * * 88830040 L R1,QRANGE GET THE HIGHEST VALID INDEX 88850040 QGOODQS EQU * * 88870040 L R14,GSQUEUE(R1) GET TOP OF QUEUE. 88890040 QGOODQ EQU * * 88910040 LTR R14,R14 Q. THIS QUEUE O.K. 88930040 BZ YGOODQ A. YES. 88950040 LR R15,R14 GET END OF STORAGE PLUS ONE 88970040 AR R15,R1 DITTO 88990040 AR R15,R1 DITTO 89010040 BAL R4,XFRRQGOT Q. GOOD QUEUE 89030040 BNZ NGOODQ A. NO. 89050040 L R14,NEXT(R14) GET NEXT FREE ELEMENT ADDRESS 89070040 B QGOODQ LOOP. 89090040 NGOODQ EQU * * 89110040 SR R4,R4 RESTORE QUEUE 89130040 ST R4,GSQUEUE(R1) DITTO 89150040 YGOODQ EQU * * 89170040 S R1,FFOUR Q. LAST INDEX 89190040 BNZ QGOODQS A. NO. LOOP. 89210040 * GSQUEUE IS STILL GOOD OR HAS BEEN MADE GOOD. 89230040 LR R0,R13 SAVE REG 89250040 XY SETLOCK RELEASE,TYPE=SALLOC,RELATED=((XX)) FREE LOCK 89270040 TEST19D EQU * * 89290040 LR R13,R0 RESTORE REG 89310040 NSEARCH EQU * * 89330040 LM R14,R1,GSFRRSAV RESTORE REGS 89350040 YINVALID EQU * * 89370040 SR R15,R15 CLEAR FOR INSERT 89390040 ICM R15,M0001,WARETRY Q. RETRY 89410040 BZ NRETRY A. NO. 89430040 L R15,RETRY(R15) GET RETRY ADDRESS 89450040 MVI WARETRY,ZERO ZERO FOR RECURSION 89470040 * SETUP INPUT REGS FOR RETRY 89490040 LM R6,R7,BASES SET MAINLINE BASE REGS @ZA03873 89500040 STM R5,R13,SDWASR05 PASS R5,R6,R7,R13 89510040 * RETRY 89530040 ST R15,SDWARTYA SET RETRY ADDRESS 89550040 MVI SDWARCDE,FOUR INDICATE RETRY 89570040 SR R15,R15 RETURN 89590040 TEST19M EQU * * 89610040 BR R14 DITTO 89630040 NRETRY EQU * * 89650040 NREF EQU * * 89670040 OI SDWAACF4,SDWACMS+SDWAFLLK FREE LOCKS 89690040 MVI SDWARCDE,ZERO CONTINUE W/TERMINATION 89710040 SR R15,R15 A.O.K. 89730040 TEST20 EQU * * 89750040 BR R14 EXIT 89770040 EJECT 89830040 XFRRFIX EQU * * 89850040 * VERIFY AND MAYBE FIX THE QUEUES 89870040 STM R1,R4,GSFRR2SV SAVE REGS. 89890040 SR R1,R1 PREVIOUS ELEMENT =0 89910040 SR R2,R2 PREVIOUS ELEMENT =0 89930040 NI GSFLAG1,XFF-GSFRRSER RESET ANSWER FLAGS 89950040 L R14,FIRST(R12) GET FIRST 89970040 QBADFOW EQU * * 89990040 LR R15,R14 GET END OF BASIC SECTION PLUS 1 90010040 AR R15,R8 DITTO 90030040 LTR R14,R14 Q. ANY MORE 90050040 BZ NBADFOW A. NO MORE FOWARD POINTERS 90070040 BAL R3,XFRRQADR Q. BAD ADDRESS. 90090040 BNZ YBADFOW A. YES. 90110040 CLR R14,R12 Q. CIRCULAR QUEUE 90130040 BE YCIRCLE A. YES. BAD FOWARD POINTER 90150040 LTR R1,R1 Q. TOP ELEMENT. 90170040 BZ NCIRCLE A. YES. NOT CIRCULAR YET. 90190040 L R4,FIRST(R12) A. NO. CHECK FOR CIRCLE. 90210040 QCIRCLE EQU * * 90230040 CLR R14,R4 Q. CIRCULAR QUEUE 90250040 BE YCIRCLE A. YES. 90270040 CLR R4,R1 Q. END OF SEARCH 90290040 BE NCIRCLE A. YES. 90310040 L R4,NEXT(R4) CONTINUE SEARCH. 90330040 B QCIRCLE DITTO. 90350040 NCIRCLE EQU * * 90370040 CL R1,PREV(R14) Q. HAS BACKWARD QUEUE BEEN HIT. 90390040 BE NHITBACK A. NO. 90410040 BAL R4,XFRRSM INDICATE SMALL ERROR 90430040 ST R1,PREV(R14) FIX PREVIOUS. 90450040 NHITBACK EQU * * 90470040 CL R1,LAST(R12) Q. DOES LAST POINT WITHIN Q. 90490040 BNE NWITHIN A. NO. 90510040 BAL R4,XFRRSM INDICATE SMALL ERROR. 90530040 XC LAST(FOUR,R12),LAST(R12) FIX IT. 90550040 NWITHIN EQU * * 90570040 LR R1,R14 PREVIOUS=CURRENT 90590040 ICM R14,M1111,NEXT(R14) CONTINUE DOWN QUEUE 90610040 B QBADFOW DITTO 90630040 YCIRCLE EQU * * 90650040 YBADFOW EQU * * 90670040 LTR R1,R1 Q. BAD ADDRESS IN HEADER 90690040 BZ YBADFIRS A. YES. 90710040 BAL R4,XFRRSM INDICATE SMALL ERROR 90730040 XC NEXT(FOUR,R1),NEXT(R1) FIX CHAIN POINTER 90750040 B NBADFIRS CONTINUE 90770040 YBADFIRS EQU * * 90790040 BAL R4,XFRRSER INDICATE LARGE ERROR. 90810040 XC FIRST(FOUR,R12),FIRST(R12) FIX HEADER 90830040 NBADFIRS EQU * * 90850040 NBADFOW EQU * * 90870040 L R14,LAST(R12) GET LAST 90890040 QBADBACK EQU * * 90910040 LR R15,R14 GET END OF BASIC BLOCK PLUS 1 90930040 AR R15,R8 DITTO 90950040 LTR R14,R14 Q. ANY MORE 90970040 BZ NBADBACK A. NO MORE BACKWARD POINTERS 90990040 BAL R3,XFRRQADR Q. BAD ADDRESS 91010040 BNZ YBADBACK A. YES. 91030040 CLR R14,R12 Q. CIRCULAR QUEUE 91050040 BE YCIRCL A. YES. 91070040 LTR R2,R2 Q. CIRCULAR QUEUE 91090040 BZ NCIRCL A. NO. FIRST TIME CANNOT BE CIRCULAR 91110040 L R4,LAST(R12) A. MAYBE 91130040 QCIRCL EQU * * 91150040 CLR R14,R4 Q. CIRCULAR QUEUE 91170040 BE YCIRCL A. YES. 91190040 CLR R4,R2 Q. CIRCULAR QUEUE 91210040 BE NCIRCL A. NO. THIS IS END OF SEARCH. 91230040 L R4,PREV(R4) A. MAYBE. CONTINUE SEARCH. 91250040 B QCIRCL DITTO. 91270040 NCIRCL EQU * * 91290040 CL R2,NEXT(R14) Q. HAS FOWARD Q BEEN HIT 91310040 BE NHITFOW A. NO. 91330040 BAL R4,XFRRSM INDICATE SMALL ERROR 91350040 ST R2,NEXT(R14) FIX IT. 91370040 NHITFOW EQU * * 91390040 LR R2,R14 PREVIOUS=CURRENT 91410040 ICM R14,M1111,PREV(R14) CONTINUE UP QUEUE. 91430040 B QBADBACK Q. END OF QUEUE. 91450040 YCIRCL EQU * * 91470040 YBADBACK EQU * * 91490040 LTR R2,R2 Q. BAD 'LAST' ADDRESS. 91510040 BZ YBADLAST A. YES. 91530040 BAL R4,XFRRSM INDICATE SMALL ERROR. 91550040 XC PREV(FOUR,R2),PREV(R2) FIX IT. 91570040 B NBADBACK CONTINUE 91590040 YBADLAST EQU * * 91610040 BAL R4,XFRRSER INDICATE SERIOUS ERROR 91630040 XC LAST(FOUR,R12),LAST(R12) FIX IT. 91650040 NBADBACK EQU * * 91670040 SR R1,R1 PREVIOUS=0 91690040 ICM R14,M1111,FIRST(R12) Q. EMPTY Q. 91710040 QLASTFOW EQU * * 91730040 BZ YLASTFOW A. YES. 91750040 LR R1,R14 PREVIOUS=CURRENT 91770040 ICM R14,M1111,NEXT(R14) CONTINUE DOWN QUEUE. 91790040 B QLASTFOW Q. IS IT THE END. 91810040 YLASTFOW EQU * * 91830040 CL R1,LAST(R12) Q. IS FOWARD QUEUE GOOD 91850040 BE YFOW A. YES. 91870040 CL R2,FIRST(R12) Q. IS BACKWARD QUEUE GOOD 91890040 BE NFOWYBCK A. YES. 91910040 LTR R1,R1 Q. IS BACKWARD QUEUE GOOD. 91930040 BZ NFOWYBCK A. YES. 91950040 LTR R2,R2 Q. IS FOWARD QUEUE GOOD 91970040 BZ YFOWNBCK A. YES. 91990040 NFOWNBCK EQU * * 92010040 * BAD FOWARD, BAD BACKWARD. 92030040 BAL R4,XFRRSER INDICATE SERIOUS ERROR. 92050040 ST R1,PREV(R2) CHAIN THE LOOSE ENDS. 92070040 ST R2,NEXT(R1) DITTO. 92090040 B YFOWYBCK CONTINUE. 92110040 NFOWYBCK EQU * * 92130040 * BAD FOWARD, GOOD BACKWARD. 92150040 BAL R4,XFRRSER INDICATE SERIOUS ERROR. 92170040 ST R2,FIRST(R12) FIX IT. 92190040 B YFOWYBCK CONTINUE. 92210040 YFOW EQU * * 92230040 * GOOD FOWARD. 92250040 CL R2,FIRST(R12) Q. IS BACKWARD QUEUE GOOD. 92270040 BE YFOWYBCK A. YES. 92290040 YFOWNBCK EQU * * 92310040 * GOOD FOWARD, BAD BACKWARD. 92330040 BAL R4,XFRRSER INDICATE SERIOUS ERROR. 92350040 ST R1,LAST(R12) FIX IT. 92370040 YFOWYBCK EQU * * 92390040 TM GSFLAG1,GSFRRSER CC=0 OK, CC NE 0 SERIOUS ERROR 92410040 LM R1,R4,GSFRR2SV RESTORE REGS 92430040 BR R2 RETURN. 92450040 EJECT 92470040 XFRRQADR EQU * * 92490040 * VERIFY THAT ADDRESS PASSED IN R14 IS A GOOD ADDRESS 92510040 * R15 CONTAINS THE LAST BYTE +1 TO BE VERIFIED 92530040 STM R1,R4,GSFRR3SV SAVE REGS. 92550040 BAL R4,XFRRQGOT Q. BAD ADDRESS. 92570040 * OUTPUT IS COND. CODE 0=GOOD ADDRESS, NZ=BAD ADDRESS 92590040 BNZ YBADADR A. YES. 92610040 LA R1,MINBASIC GET MIDDLE BASIC LENGTH 92630040 CLR R8,R1 DETERMINE EXIT ROUTINE 92650040 BE XMINCK MINOR EXIT. 92670040 BL XQELCK QEL EXIT. 92690040 XMAJCK EQU * MAJOR EXIT. 92710040 B NBADADR NOT A BAD ADDRESS. 92730040 XMINCK EQU * * 92750040 SR R1,R1 CLEAR 92770040 IC R1,MINNAMEL-MIN(R14) GET MINOR NAME LENGTH 92790040 AR R15,R1 CALCULATE MINOR QCB END ADDR. +1 92810040 BAL R4,XFRRQGOT Q. BAD ADDRESS. 92830040 * AN OUTPUT CC OR NZ MEANS BAD ADDRESS 92850040 BNZ YBADADR A. YES. 92870040 * CHECK MINOR SCOPE 92890040 TM MINFLGS-MIN(R14),MINSYSS+MINSYS Q. BAD SCOPE 92910040 BO YBADADR A. YES 92930040 TM MINFLGS-MIN(R14),MINSYSS+MINSTEP Q. BAD SCOPE. 92950040 BO YBADADR A. YES. 92970040 TM MINFLGS-MIN(R14),MINSYS+MINSTEP Q. BAD SCOPE 92990040 BO YBADADR A. YES. 93010040 B NBADADR A. NO. GOOD CONTROL BLOCK. 93030040 XQELCK EQU * * 93050040 LR R1,R14 SAVE REG 14 93070040 LR R2,R15 SAVE REG 93090040 TM QELTCB-QEL(R14),FWORD Q. FULL WORD BNDY. 93110040 BNZ YBADQEL A. NO. BAD QEL ADDRESS. 93130040 TM QELQFLGS-QEL(R14),QELLIST Q. LIST QEL 93150040 BO YLSTQEL A. YES. 93170040 * SUBQEL THRU HERE. 93190040 TM QELQFLGS-QEL(R14),QELRESV Q. RESERVE 93210040 BZ NRESERV2 A. NO. 93230040 A R15,FFOUR ADD UCB ADDRESS LENGTH 93250040 BAL R4,XFRRQGOT Q. BAD QEL 93270040 BNZ YBADQEL A. YES. 93290040 L R3,QELSIZE1(R14) GET UCB ADDRESS 93310040 BAL R4,XFRRQUCB Q. GOOD UCB ADDRESS 93330040 BZ YGOODUCB A. YES. 93350040 BAL R4,XFRRSM RECORED SMALL ERROR 93370040 NI QELQFLGS-QEL(R14),XFF-QELRESV RESET RESERVE BIT. 93390040 YGOODUCB EQU * * 93410040 NRESERV2 EQU * * 93430040 ICM R14,M1111,QELLQEL-QEL(R1) GET LIST QEL ADDRESS 93450040 BNM YBADQEL Q. HIGH BIT ON. A. NO. BAD ADDRESS 93470040 X R14,HIGHBIT ZERO HIGH BIT @YM01991 93490040 YLSTQEL EQU * * 93510040 * R14 CONTAINS LISTQEL ADDRESS TO BE CHECKED. 93530040 * R1 CONTAINS A SUBQEL OR SAME AS R14 93550040 LA R15,QELSIZE2 GET END ADDRESS PLUS 1 93570040 AR R15,R14 DITTO 93590040 BAL R4,XFRRQGOT Q. GOTTEN IN SP245 93610040 BNZ YBADQEL A. NO. 93630040 TM QELTCB-QEL(R14),QELXLIST Q. CORRECT BIT SETTING 93650040 BO YBADQEL A. NO. BAD ADDRESS. 93670040 TM QELQFLGS-QEL(R14),QELRESV Q. RESERVE 93690040 BZ NRESERV A. NO. 93710040 A R15,FFOUR ADD UCB ADDRESS LENGTH 93730040 BAL R4,XFRRQGOT Q. BAD QEL 93750040 BNZ YBADQEL A. YES. 93770040 L R3,QELSIZE2(R14) GET UCB ADDRESS. 93790040 BAL R4,XFRRQUCB Q. GOOD UCB ADDR. 93810040 BZ YUCBOK A. YES. 93830040 BAL R4,XFRRSM RECORD SMALL ERROR 93850040 NI QELQFLGS-QEL(R14),XFF-QELRESV RESET RESERVE BIT. 93870040 YUCBOK EQU * * 93890040 NRESERV EQU * * 93910040 TM QELECB-QEL(R14),QELXECB Q. ECB 93930040 BO YECB A. YES. 93950040 * SVRB THRU HERE 93970040 TM QELLFLGS-QEL(R14),QELECBF Q. BITS CONFLICT 93990040 BO YBADQEL A. YES. BAD QEL ADDRESS. 94010040 B NECB2 CONTINUE 94030040 YECB EQU * * 94050040 TM QELLFLGS-QEL(R14),QELECBF Q. BITS CONFLICT 94070040 BZ YBADQEL A. YES. 94090040 NECB2 EQU * * 94110040 CLC QELLCNT-QEL(TWO,R14),HZERO Q. LIST COUNT INACCURATE 94130040 BE YBADQEL A. YES. 94150040 * GOOD QEL, SO FAR. 94170040 CLC QELLFLGS-QEL(THREE,R14),QELLFLGS-QEL(R1) Q. COMMON MATCH 94190040 BNE YBADQEL A. NO. BAD QEL. 94210040 LR R14,R1 RESTORE REG 14 94230040 LR R15,R2 RESTORE REG 94250040 B NBADADR GOOD ADDRESS RETURN. 94270040 YBADQEL EQU * * 94290040 * BAD QEL 94310040 LR R14,R1 RESTORE REG 14 94330040 LR R15,R2 RESTORE REG 94350040 YBADADR EQU * * 94370040 * BAD ADDRESS, CC NE 0 94390040 LM R1,R4,GSFRR3SV RESTORE REGS. 94410040 LTR R3,R3 CC NE 0 94430040 BR R3 RETURN 94450040 NBADADR EQU * * 94470040 * GOOD ADDRESS, CC EQ 0 94490040 LM R1,R4,GSFRR3SV RESTORE REGS. 94510040 CLR R3,R3 CC EQ 0. 94530040 BR R3 RETURN. 94550040 EJECT 94570040 XFRRQGOT EQU * * 94590040 STM R1,R3,GSFRR4SV SAVE REGS. 94610040 L R1,CVTPTR GET SPQE FOR SUBPOOL 245 94630040 L R1,CVTGDA-CVT(R1) DITTO. 94650040 L R1,SQASPQEP-GDA(R1) DITTO. 94670040 TEST32E EQU * * 94690040 ICM R1,M1111,SPDQEPTR-SPQESECT(R1) Q. ANY DQE-S LEFT. 94710040 QDQE EQU * * 94730040 TEST32F EQU * * 94750040 BZ NDQE A. NO. 94770040 * HAVE DQE IN R1 94790040 L R2,DQEBLKAD-DQESECT(R1) GET LOW ADDRESS OF BLOCK 94810040 LR R3,R2 GET END OF BLOCK AD PLUS 1 94830040 A R3,DQELNTH-DQESECT(R1) DITTO. 94850040 * CHECK IF ADDRESS RANGE LIES WITHIN ALLOCATED STORAGE. 94870040 CLR R14,R2 Q. LOW ADDRESS IN THIS BLOCK. 94890040 BL NINDQE A. NO. H=MAYBE,L=NO,E=YES. 94910040 CLR R15,R3 Q. HIGH ADDRESS IN THIS BLOCK 94930040 BNH YDQE A. YES. 94950040 NINDQE EQU * * 94970040 TEST32G EQU * * 94990040 ICM R1,M1111,DQEPTR-DQESECT(R1) Q. ANY MORE DQE-S 95010040 B QDQE LOOP 95030040 YDQE EQU * * 95050040 ICM R1,M1111,DQFQEPTR-DQESECT(R1) A. ANY FQE-S. 95070040 QFQE EQU * * 95090040 BZ NFQE A. NO. 95110040 * HAVE FQE IN REG 1 95130040 LA R3,FQESLNTH GET END OF FREE AREA PLUS 1 95150040 AR R3,R1 DITTO 95170040 LR R2,R3 GET BEGINING OF FREE AREA. 95190040 S R2,FQELNTH-FQESECT(R1) DITTO. 95210040 * CHECK FOR OVERLAP OF ADDRESS RANGE VS. FREE AREA. 95230040 CLR R15,R2 Q. HIGH ADDRESS LE FREE AREA. 95250040 BNH NINFQE A. YES. NOT IN THIS FREE AREA. 95270040 CLR R14,R3 Q. LOW ADDRESS HE FREE AREA. 95290040 BL YFQE A. NO. RANGE AND FREE AREA OVERLAP. 95310040 NINFQE EQU * * 95330040 ICM R1,M1111,FQEPTR-FQESECT(R1) Q. ANY MORE FQE-S 95350040 B QFQE LOOP 95370040 NFQE EQU * * 95390040 * CHECK FOR OVERLAP OF ADDRESS RANGE AND STORAGE CHECKS 95410040 L R1,GSFRRSDW GET SDWA ADDRESS 95430040 USING SDWA,R1 ADDRESSABILITY 95450040 CL R15,SDWASCKB Q. LE BEGIN 95470040 BNH NSTORCK A. YES. NOT A STORAGE CK. 95490040 CL R14,SDWASCKE Q. HIGHER THAN END 95510040 BH NSTORCK A. YES. NOT A STORAGE CK. 95530040 TM SDWAMCHD,SDWASCK Q. STORAGE CHECK. 95550040 BO YSTORCK A. YES. BAD ADDRESS. 95570040 NSTORCK EQU * * 95590040 LM R1,R3,GSFRR4SV RESTORE REGS. 95610040 CLR R4,R4 SET CC=0 95630040 BR R4 RETURN 95650040 YSTORCK EQU * * 95670040 YFQE EQU * * 95690040 NDQE EQU * * 95710040 LM R1,R3,GSFRR4SV RESTORE REGS. 95730040 LTR R4,R4 SET CC NE 0 95750040 BR R4 RETURN. 95770040 EJECT 95790040 XFRRSER EQU * * 95810040 OI GSFLAG1,GSFRRSER INDICATE SERIOUS ERROR. 95830040 XFRRSM EQU * * 95850040 STM R1,R4,GSFRR4SV SAVE REGS. 95870040 OI WAFLAG2,WADAMAGE INDICATE QUEUE DAMAGE 95890040 L R1,GSFRRSDW GET SDWA ADDRESS 95910040 USING SDWA,R1 ADDRESSABILITY 95930040 L R2,VRACOUNT ADD 1 TO ERROR COUNT 95950040 A R2,FONE DITTO 95970040 ST R2,VRACOUNT DITTO 95990040 ST R6,VRACSECT SAVE ADDRESS OF THIS MODULE 96010040 CLI SDWAURAL,ZERO Q. FIRST TIME THRU 96030040 BNE NSAVE A. NO. DON'T SAVE 96050040 MVC VRACOUNT(FOUR),FONE START COUNTING 96070040 OI SDWADPVA,SDWAHEX INDICATE HEX DATA. 96090040 ST R4,VRALINKA SAVE THE LAST LINK(BAL) ADDRESS 96110040 LR R2,R8 CONTROL BLOCK CODE 96130040 LR R3,R14 START ADDRESS 96150040 LR R4,R15 END ADDRESS 96170040 BCTR R4,ZERO DITTO 96190040 STM R2,R4,VRACODE SAVE IT 96210040 MVI SDWAURAL,VRALEN1 INDICATE LENGTH 96230040 TEST32J EQU * * 96250040 LRA R2,ZERO(R3) Q. CAN SAVE 96270040 BNZ NSAVE A. NO. 96290040 LA R2,VRALEN2-ONE GET MAXIMUM LENGTH TO MOVE 96310040 SR R4,R3 GET CORRECT LENGTH 96330040 CLR R2,R4 Q. MOVE MAXIMUM 96350040 BNH YMAX A. YES. 96370040 LR R2,R4 A. NO. SAVE LENGTH MINUS 1 96390040 YMAX EQU * * 96410040 LR R4,R3 OBTAIN END ADDRESS 96430040 AR R4,R2 DITTO. @YM05430 96450040 TEST32K EQU * * 96470040 LRA R4,ZERO(R4) Q. CAN SAVE 96490040 BNZ NSAVE A. NO. 96510040 EX R2,BADMOVE MOVE IT. 96530040 BADMOVE MVC VRAIMAGE(ZERO),ZERO(R3) DITTO 96550040 LA R2,VRALEN1+ONE(R2) ACQUIRE TOTAL LENGTH 96570040 STC R2,SDWAURAL SAVE TOTAL 96590040 NSAVE EQU * * 96610040 LM R1,R4,GSFRR4SV RESTORE REGS. 96630040 BR R4 RETURN. 96650040 EJECT 96670040 XFRRQUCB EQU * * 96690040 STM R1,R3,GSFRR4SV SAVE REGS. 96710040 TEST32L EQU * * 96730040 LRA R1,UCBID-UCBOB(R3) Q. VALID UCB. 96750040 BNZ NREALAD A. NO. 96770040 CLI UCBID-UCBOB(R3),XFF Q. VALID UCB. 96790040 NREALAD EQU * * 96810040 LM R1,R3,GSFRR4SV RESTORE REGS. 96830040 BR R4 RETURN (CC OF 0 IS O.K.) 96850040 * THE FOLLOWING CONSTANT MUST STAY AT FRR END TO BE 96900040 * ABLE TO ADDRESS THE COMMON CONSTANTS. 96950040 XFRRBASE DC A(FRRBASE) ADDR OF CONSTANTS FOR BASE 97000040 END IGC048 97050040