TITLE 'IEAVECH0 - CHAP SVC - ENTRY POINT IGC044' 00060002 * /* START OF SPECIFICATIONS **** 00120002 * 00180002 *01* MODULE-NAME = IEAVECH0 00240002 * 00300002 *02* CSECT-NAME = IGC044 00310002 * 00378602 *01* DESCRIPTIVE-NAME = CHAP 00427502 * 00484302 *01* COPYRIGHT = NONE 00563902 * 00639502 *01* STATUS = OSVS2 RELEASE 2 VERSION 1 00660402 * 00720302 *01* FUNCTION = THIS ROUTINE ALTERS THE DISPATCHING PRIORITY OF A 00780702 * TASK 00900002 * 00910002 *02* OPERATION = CHAP SVC: THIS ROUTINE ALTERS THE DISPATCHING 01020002 * PRIORITY OF A TASK AND REPOSITIONS THE TCB, ACCORDING TO THE 01080002 * NEW PRIORITY, ON THE TCB DISPATCHING QUEUE. FOR OTHER THAN 01090002 * SYSTEM TASK CALLERS, THE SUBJECT TASK MUST BE EITHER THE 01200002 * CURRENT TASK OR ONE OF ITS SUBTASKS. 01260002 * 01320002 * IGC044R1: THIS ROUTINE IS AN FRR FOR CHAP. IT CALLS ROUTINE 01380002 * IGC044R2 TO VERIFY TCB QUEUES, AND PERCOLATES. 01440002 * 01500002 * IGC044R2: THIS ROUTINE VALIDATES THE TCB FAMILY AND 01560002 * DISPATCHING QUEUES FOR RECOVERY. THE CURRENT ASCB AND ASXB ARE 01620002 * VEFIFIED BY CONTROL BLOCK VERIFIER, THE DISPATCHING QUEUE IS 01680002 * VERIFIED BY QUEUE VERIFIER, AND THE FAMILY QUEUE IS VERIFIED 01740002 * BY PERFORMING A TREE SCAN, VERIFYING THE REQUIRED POINTERS BY 01800002 * CALLING CONTROL BLOCK VERIFIER. 01860002 * 01920002 *01* NOTES = 01980002 * 02040002 *02* DEPENDENCIES = THE LOCAL LOCK IS REQUIRED THROUGH OUT THIS 02100002 * MODULE. 02160002 * 02220002 *03* CHARACTER-CODE-DEPENDENCIES = NONE 02280002 * 02340002 *02* RESTRICTIONS = NONE 02400002 * 02450002 *02* REGISTER-CONVENTIONS = REGISTER DEFINITIONS FOLLOW THE CSECT 02500002 * STATEMENT. FURTHER DESCRIPTIONS IN INTRODUCTORY COMMENTS FOR 02550002 * EACH SUBROUTINE AND EACH RECOVERY ROUTINE. 02600002 * 02700002 *02* PATCH-LABEL = IEAPATCH 02750002 * 02800002 *01* MODULE-TYPE = SVC ROUTINE, WITH RECOVERY 02850002 * 02900002 *02* PROCESSOR = ASSEMBLER 02950002 * 03050002 *02* MODULE-SIZE = SEE SYMBOL IGC044 IN THE EXTERNAL SYMBOL 03100002 * DICTIONARY. 03150002 * 03220002 *02* ATTRIBUTES = NUCLEUS,ZERO PROTECT KEY, REFRESHABLE, SUPERVISOR 03300002 * MODE 03360002 * 03420002 *01* ENTRY-POINT = IGC044 03480002 * 03540002 *02* PURPOSE = SVC CHAP 03600002 * 03660002 *02* LINKAGE = SVC 44 ONLY (CHAP MACRO) 03720002 * 03780002 *02* INPUT = REGISTER 0 CONTAINS THE ALGEBRAIC VALUE BY WHICH THE 03840002 * DISPATCHING PRIORITY IS TO BE CHANGED. REGISTER 1 CONTAINS 03900002 * ZERO OR THE ADDRESS OF A FULLWORD ON A FULLWORD BOUNDARY, 03960002 * WHICH IN TURN CONTAINS THE ADDRESS OF THE TCB TO BE CHAPPED. 04020002 * REGISTER 1 EQUAL TO ZERO INDICATES THAT THE CURRENT TASK IS TO 04080002 * BE CHAPPED. FOR OTHER THAN SYSTEM TASKS, IF A TCB ADDRESS IS 04140002 * SPECIFIED, IT MUST BE THE ADDRESS OF THE TCB OF A SUBTASK OF 04200002 * THE CURRENT TASK. 04260002 * 04320002 *02* OUTPUT = NONE 04380002 * 04440002 *01* EXIT-NORMAL = 04500002 * 04550002 *02* CONDITIONS = SVC CHAP EXITS TO IEAVEXP1, THE FORCE DISPATCHER 04610002 * ENTRY TO EXIT PROLOGUE (OBTAINED FROM CVTEXP1). 04670002 * 04730002 *02* OUTPUT = NONE 04800002 * 04860002 *02* RETURN-CODES = NONE 04920002 * 04980002 *01* EXIT-ERROR = CHAP9030 05040002 * 05100002 *02* CONDITIONS = FOR A DETECTED ERROR DURING SVC PROCESSING, ABEND 05150002 * IS ISSUED. AN INVALID PARAMETER ADDRESS CAN ALSO CAUSE THE FRR 05210002 * TO BE ENTERED TO PROCESS THE ERROR (SEE INTRODUCTORY COMMENTS 05270002 * FOR IGC044R1). 05330002 * 05400002 *02* OUTPUT = ABEND CODE, 12C OR 22C 05450002 * 05510002 *02* RETURN-CODES = NONE 05570002 * 05630002 *01* ENTRY-POINT = IGC044R1 05700002 * 05760002 *02* PURPOSE = A FUNCTIONAL RECOVERY ROUTINE (FRR) TO PROVIDE 05820002 * RECOVERY FOR TCB QUEUE ERRORS. 05880002 * 05940002 *02* LINKAGE = ENTRY FROM RECOVERY TERMINATION MANAGER (RTM) 06000002 * FROM A STACK ELEMENT CREATED BY SETFRR MACRO CODE IN IGC044 06050002 * ENTRY PROCESSING. 06110002 * 06170002 *02* INPUT = REGISTER 1 CONTAINS THE ADDRESS OF AN SDWA. REGISTER 06230002 * 14 CONTAINS THE RETURN ADDRESS. REGISTER 15 CONTAINS THE ENTRY 06290002 * POINT ADDRESS. REGISTER 0 CONTAINS THE ADDRESS OF A 200 BYTE 06350002 * WORKAREA. 06410002 * 06470002 *02* OUTPUT = RETURN CODE. NEW SYSTEM COMPLETION CODE IN CASE OF 06530002 * ENTRY CAUSED BY INVALID PARAMETER. 06600002 * 06650002 *01* EXIT-NORMAL = CHAP7000 06710002 * 06770002 *02* CONDITIONS = RETURN TO RTM VIA BR 14. 06830002 * 06900002 *02* OUTPUT = RETURN CODE. TCB QUEUES AS MODIFIED BY IGC044R2. 06950002 * 07010002 *02* RETURN-CODES = 0, NO RETRY. 07070002 * 07130002 *01* EXIT-ERROR = NONE 07200002 * 07260002 *01* ENTRY-POINT = IGC044R2 07320002 * 07380002 *02* PURPOSE = RECOVERY ROUTINE WHICH VALIDATES THE TCB FAMILY AND 07440002 * DISPATCHING QUEUES. 07500002 * 07560002 *02* LINKAGE = BRANCH ENTRY ONLY, ADDRESS OBTAINED FROM V-TYPE 07620002 * ADDRESS CONSTANT. CALLED BY CHAP SVC, STATUS, ATTACH SVC 07680002 * MODULE IEAVEAT0, DETACH SVC MODULE IEAVEED0. 07740002 * 07800002 *02* INPUT = REGISTER 1 CONTAINS THE ADDRESS OF AN SDWA. REGISTER 07850002 * 14 CONTAINS THE RETURN ADDRESS. REGISTER 15 CONTAINS THE ENTRY 07900002 * POINT ADDRESS. REGISTER 0 CONTAINS THE ADDRESS OF A 200 BYTE 07950002 * WORKAREA. REGISTER 2 CONTAINS 0 FOR NO DUMP, OR THE ADDRESS OF 08000002 * THE TITLE FOR AN SVC DUMP. 08050002 * 08100002 *02* OUTPUT = RETURN CODE. 08170002 * 08240002 *02* REGISTERS-SAVED = 0, 1, 9, 14 08310002 * 08400002 *01* EXIT-NORMAL = CHAP8000 08450002 * 08510002 *02* CONDITIONS = RETURN TO CALLER VIA BR 14. 08570002 * 08630002 *02* OUTPUT = RETURN CODE. TCB DISPATCHING AND FAMILY QUEUE MAY BE 08700002 * RESTRUCTURED TO CORRECT ERRORS (SEE INTRODUCTORY COMMENTS FOR 08760002 * IGC044R2). 08820002 * 08880002 *02* RETURN-CODES = SEE INTRODUCTORY COMMENTS FOR IGC044R2. 08940002 * 09000002 *01* EXIT-ERROR = NONE 09060002 * 09120002 *01* EXTERNAL-REFERENCES = 09180002 * 09240002 *02* ROUTINES = TESTAUTH TO CHECK CALLER FOR SYSTEM OR APF 09300002 * AUTHORIZATION, BRANCH LINKAGE GENERATED BY TESTAUTH MACRO. 09350002 * STATUS TO STOP THE TCB TO BE CHAPPED, BRANCH ADDRESS OBTAINED 09410002 * FROM SCVTSTAT. QUEUE VERIFIER, IEAVEQV1 AT ENTRY POINT 09470002 * IEAVEQV3, TO VERIFY TCB DISPATCHING QUEUE, BRANCH ADDRESS 09530002 * FROM V-TYPE ADDRESS CONSTANT. TCB CONTROL BLOCK VERIFIER 09600002 * IEAVETCB, TO VERIFY TCB'S ON THE FAMILY QUEUE, BRANCH 09650002 * ADDRESS FROM V-TYPE ADDRESS CONSTANT. ASCB CONTROL BLOCK 09700002 * VERIFIER IEAVECAS, TO VERIFY THE CURRENT ASXB BEFORE USING 09750002 * THE TCB DISPATCHING QUEUE POINTERS, BRANCH ADDRESS FROM 09800002 * V-TYPE ADDRESS CONSTANT. SVC DUMP TO DUMP THE SQA, LSQA, AND 09850002 * TRACE TABLE ON SYSTEM ERROR, BRANCH LINKAGE GENERATED BY SDUMP 09900002 * MACRO. 10000002 * 10050002 *02* DATA-AREAS = SDWA 10100002 * 10200002 *02* CONTROL-BLOCKS = ASCB(W), ASXB(W), TCB(W), RB(R), CVT(R), 10250002 * SCVT(R), PSA(R) 10300002 * 10360002 *01* TABLES = 200 BYTE WORKAREA PROVIDED TO FRR BY RTM 10420002 * 10500002 *01* MACROS = SETFRR, TESTAUTH, SETRP, ABEND, MODESET, SDUMP 10560002 * 10620002 *02* SERIALIZATION = LOCAL LOCK, HELD ON ENTRY, NEITHER OBTAINED NOR 10680002 * RELEASED IN THIS MODULE. 10740002 * 10800002 *01* CHANGE-ACTIVITY = Y02752, Y02753, VS02632, VS04242 10860002 * 10920002 *01* MESSAGES = NONE 10980002 * 11040002 *01* ABEND-CODES = 12C, INVALID PARAMETER. 22C, INVALID PARAMETER WORD 11100002 * ADDRESS. 11160002 * 11220002 **** END OF SPECIFICATIONS ***/ 11280002 EJECT 11340002 IGC044 CSECT 11400002 ENTRY IGC044R2 11450002 *A-000000-999999 @Y02752 11500002 SPACE 3 11560002 * EQUATES 11620002 KEYMASK EQU X'F0' MASK FOR CLEARING PSW CMWP BITS 11700002 STATMASK EQU X'0B' MASK FOR STATUS STOP TCB 11760002 WORDMASK EQU B'00000011' MASK FOR CHECKING FULLWORD 11820002 ABEND12C EQU X'12C' ABEND CODE, PARM INVALID 11880002 ABEND22C EQU X'22C' ABEND CODE, PARM ADDR INVALID 11940002 SAVELNG EQU 72 STANDARD SAVE AREA LENGTH 12000002 SPID245 EQU 245 SUBPOOL ID, SQA 12060002 C0 EQU 0 CONSTANT 0 12120002 C1 EQU 1 CONSTANT 1 12180002 C2 EQU 2 CONSTANT 2 12240002 C3 EQU 3 CONSTANT 3 12300002 C8 EQU 8 CONSTANT 8 12360002 C12 EQU 12 CONSTANT 12 12420002 C16 EQU 16 CONSTANT 16 12480002 RCODE4 EQU 4 RETURN CODE, RECOVERY RTN 12540002 RCODE8 EQU 8 RETURN CODE, RECOVERY RTN 12600002 RCODE12 EQU 12 RETURN CODE, RECOVERY RTN 12660002 SPACE 3 12720002 * REGISTERS 12780002 R0 EQU 0 REGISTER 0 12840002 R1 EQU 1 REGISTER 1 12900002 R2 EQU 2 REGISTER 2 12960002 R2ASXB EQU 2 ADDRESS OF ASXB 13020002 R3 EQU 3 REGISTER 3 13080002 R4CURTCB EQU 4 ADDRESS OF CURRENT TCB 13140002 R4 EQU 4 REGISTER 4 13200002 R5CURRB EQU 5 ADDRESS OF CURRENT SVRB 13260002 R5 EQU 5 REGISTER 5 13320002 R6BASE EQU 6 ADDRESS OF ENTRY POINT 13380002 R7ASCB EQU 7 ADDRESS OF ASCB 13440002 R7 EQU 7 REGISTER 7 13500002 R8CHAP EQU 8 ADDRESS OF TCB TO BE CHAPPED 13560002 R8 EQU 8 REGISTER 8 13620002 R9FRRWA EQU 9 ADDRESS OF FRR WORKAREA 13680002 R9 EQU 9 REGISTER 9 13740002 R10 EQU 10 REGISTER 10 13800002 R10VALUE EQU 10 NUMERICAL VALUE FOR CHAPPING 13860002 R11 EQU 11 REGISTER 11 13920002 R12 EQU 12 REGISTER 12 13980002 R13 EQU 13 REGISTER 13 14040002 R13FORWD EQU 13 CHAP TCB FORWARD PTR 14100002 R14 EQU 14 REGISTER 14 14160002 R14RET EQU 14 RETURN ADDRESS 14220002 R15 EQU 15 REGISTER 15 14280002 R15BACK EQU 15 CHAP TCB BACK PTR 14340002 R15RETCD EQU 15 RETURN CODE 14400002 EJECT 14460002 *********************************************************************** 14520002 * * 14580002 * CHAP SVC * 14640002 * * 14700002 *********************************************************************** 14750002 SPACE 4 14800002 */* IGC044: CHART BEGIN FLOWCHART */ 14850002 */* FOOTING 14900002 */* SVC CHAP MAINLINE */ 15000002 SPACE 15060002 */* IGC044: E ENTER CHAP SVC */ 15120002 SPACE 15180002 USING IGC044,R6BASE ESTABLISH ADDRESSABILITY 15240002 USING RBSECT,R5CURRB 15300002 SPACE 15350002 MODID BR=YES IDENTIFIER 15410002 SPACE 15470002 LR R10VALUE,R0 SAVE CHANGE VALUE 15530002 LR R11,R1 SAVE PARM ADDRESS 15600002 SPACE 15660002 */* L SETFRR: ESTABLISH FRR */ 15720002 SPACE 15780002 LA R14,IGC044R1 ADDRESS OF FRR @Y02753 15840002 SETFRR A,FRRAD=(R14),PARMAD=(R9FRRWA),WRKREGS=(R15,R1) @Y02753 15900002 SPACE 15960002 */* D (YES,CHAP0010,NO,) IS THERE A PARM WORD */ 16020002 SPACE 16080002 LTR R11,R11 WAS INPUT REG 1 NONZERO 16140002 BNZ CHAP0010 YES, MAY HAVE TO VALIDITY CHK 16200002 SPACE 16260002 */* P (,CHAP0070) SET CHAP TCB ADDR TO CURRENT TCB */ 16320002 SPACE 16380002 LA R8CHAP,0(,R4CURTCB) SET ADDR, CLEAR HIGH ORDER BYTE 16440002 B CHAP0070 BYPASS VALIDITY CHECKING 16500002 SPACE 16560002 */* CHAP0010: L TESTAUTH: CHECK CALLER FOR KEY, STATE, APF AUTH */ 16620002 SPACE 16680002 CHAP0010 EQU * * 16740002 TESTAUTH FCTN=1,STATE=YES,KEY=YES,RBLEVEL=2,BRANCH=YES 16800002 SPACE 16860002 */* D (NO,CHAP0030,YES,) IS CALLER AUTHORIZED */ 16920002 SPACE 16980002 LTR R15RETCD,R15RETCD TESTAUTH RETURN CODE 17040002 BNZ CHAP0030 NONZERO, VALIDITY CHECK 17100002 SPACE 17160002 */* P (,CHAP0020) SET CHAP ADDR TO PARM VALUE */ 17220002 SPACE 17280002 L R8CHAP,0(,R11) INPUT TCB ADDRESS 17340002 LA R8CHAP,0(,R8CHAP) INSURE HIGH ORDER BYTE ZERO 17400002 B CHAP0020 BYPASS VALIDITY CHECK 17460002 SPACE 17520002 */* CHAP0030: D (NO,CHAP9000,YES,) IS INPUT PARM A FULLWORD */ 17580002 SPACE 17640002 CHAP0030 EQU * * 17700002 LA R3,WORDMASK ALIGNMENT MASK 17760002 NR R3,R11 IS ADDR ON WORD BOUNDARY 17820002 BNZ CHAP9000 NO, GO ABEND 22C 17880002 SPACE 17940002 */* P VALIDITY CHECK PARM WORD, SETTING CHAP ADDR TO PARM VALUE */ 18000002 SPACE 18060002 SR R2,R2 CLEAR 18120002 L R1,RBLINK ADDRESS OF CALLERS RB 18180002 LA R3,KEYMASK MASK TO CLEAR KEY 18240002 IC R2,RBOPSW+C1-RBSECT(,R1) PSW KEY-CMWP BITS 18300002 NR R2,R3 CALLERS PROTECT KEY 18360002 MODESET KEYADDR=(2) SET CALLERS KEY 18420002 L R8CHAP,0(,R11) PARM 18480002 ST R8CHAP,0(,R11) CHECK PROTECT KEY 18540002 MODESET EXTKEY=SUPR RESET KEY ZERO 18600002 LA R8CHAP,0(,R8CHAP) CLEAR HIGH ORDER BYTE 18660002 SPACE 18720002 */* D (NO,CHAP9010,YES,) IS CHAP TCB A SUBTASK OF CURRENT TASK */ 18780002 SPACE 18840002 ICM R11,B'1111',TCBLTC-TCB(R4CURTCB) ADDR OF FIRST SUBTASK 18900002 B CHAP0050 ENTER CHECKING LOOP 18960002 SPACE 19020002 CHAP0060 EQU * TOP OF CHECKING LOOP 19080002 ICM R11,B'1111',TCBNTC-TCB(R11) ADDR OF NEXT SUBTASK 19140002 CHAP0050 EQU * LOOP ENTRY POINT 19200002 BZ CHAP9010 ALL SUBTASKS CHECKED WITH NO 19260002 * MATCH, GO ABEND 12C 19320002 CR R8CHAP,R11 IS THIS THE CHAP TCB 19380002 BNE CHAP0060 NO, CHECK NEXT SUBTASK 19440002 * YES, CONTINUE 19500002 EJECT 19560002 *********************************************************************** 19620002 * * 19680002 * PARAMETER VALIDITY CHECKING COMPLETE * 19740002 * * 19800002 *********************************************************************** 19860002 SPACE 4 19920002 */* CHAP0020: D (YES,CHAP9010,NO,) HAS THE CHAP TCB TERMINATED */ 19980002 SPACE 20040002 CHAP0020 EQU * * 20100002 TM TCBFLGS5-TCB(R8CHAP),TCBFC IS THE TASK COMPLETE FLAG ON 20160002 BO CHAP9010 YES, GO ABEND 12C 20220002 SPACE 20280002 */* D (NO,CHAP0070,YES,) IS THE CHAP TCB ACTIVE */ 20340002 SPACE 20400002 TM TCBFBYT1-TCB(R8CHAP),TCBACTIV IS THE CHAP TASK ACTIVE 20460002 * ON ANOTHER CPU 20520002 BZ CHAP0070 NO, BYPASS STATUS STOP 20580002 SPACE 20640002 */* L STATUS: STOP THE CHAP TASK */ 20700002 SPACE 20750002 LA R0,STATMASK INDICATE RESET TCB NON DISP 20800002 LR R1,R8CHAP CHAP TCB TO BE RESET 20850002 SR R13,R13 NO NODISP BITS TO BE SET 20900002 L R15,CVTPTR CVT ADDRESS 20950002 L R15,CVTABEND-CVT(,R15) SCVT ADDRESS 21000002 L R15,SCVTSTAT-SCVTSECT(,R15) STATUS BRANCH ENTRY ADDR 21070002 BALR R14RET,R15 INVOKE STATUS 21140002 EJECT 21210002 *********************************************************************** 21300002 * * 21360002 * UNCHAIN CHAP TCB FROM DISPATCHING QUEUE * 21420002 * * 21480002 *********************************************************************** 21540002 SPACE 4 21600002 */* CHAP0070: S UNCHAIN: REMOVE CHAP TCB FROM DISPATCH QUEUE */ 21650002 SPACE 21710002 CHAP0070 EQU * * 21770002 L R2ASXB,ASCBASXB-ASCB(,R7ASCB) CURRENT ASXB ADDR 21830002 BAL R14,UNCHAIN REMOVE CHAP TCB FROM QUEUE 21900002 SPACE 4 21960002 *********************************************************************** 22020002 * * 22080002 * ALTER CHAP TASK PRIORITIES * 22140002 * * 22200002 *********************************************************************** 22260002 SPACE 4 22320002 */* P CALCULATE NEW DISPATCHING PRIORITY */ 22380002 SPACE 22440002 SR R13,R13 CLEAR 22500002 IC R13,TCBDSP-TCB(,R8CHAP) GET PRESENT DISPATCH PRIORITY 22560002 AR R13,R10VALUE CALCULATE NEW DISP PRIORITY 22620002 SPACE 22680002 */* D (YES,CHAP0080,NO,) IS NEW DISP GT ZERO */ 22740002 SPACE 22800002 LTR R13,R13 IS DISP POSITIVE 22860002 BP CHAP0080 YES, CONTINUE CHECK 22920002 SPACE 22980002 */* P (,CHAP0090) RESET NEW DISP TO ZERO */ 23040002 SPACE 23100002 SR R13,R13 ZERO 23160002 B CHAP0090 GO SET TCB DISP 23220002 SPACE 23280002 */* CHAP0080: D (NO,CHAP0100,YES,) IS NEW DISP GE CURRENT TCB LIMIT */ 23340002 SPACE 23400002 CHAP0080 EQU * * 23460002 SR R10,R10 CLEAR 23520002 IC R10,TCBLMP-TCB(,R4CURTCB) CURRENT TCB LIMIT PRIORITY 23580002 CR R13,R10 DOES NEW DISP EXCEED THIS LIMIT 23640002 BL CHAP0100 NO, CONTINUE CHECK 23700002 SPACE 23760002 */* P (,CHAP0110) SET NEW DISP AND NEW LIMIT TO CURRENT LIMIT */ 23820002 SPACE 23880002 LR R13,R10 RESET CALCULATED DISP 23940002 * NEW LIMIT VALUE=CURRENT LIMIT 24000002 B CHAP0110 GO STORE VALUES INTO CHAP TCB 24050002 SPACE 24100002 */* CHAP0100: D (NO,CHAP0090,YES,) IS NEW DISP GT CHAP TCB LIMIT */ 24150002 SPACE 24200002 CHAP0100 EQU * * 24250002 IC R10,TCBLMP-TCB(,R8CHAP) CHAP TCB LIMIT PRIORITY 24300002 CR R13,R10 DOES NEW DISP EXCEED LIMIT 24370002 BNH CHAP0090 NO, GO STORE NEW DISP 24440002 SPACE 24510002 */* P SET NEW LIMIT TO NEW DISP */ 24600002 SPACE 24660002 LR R10,R13 CHAP TCB LIMIT WILL INCREASE 24720002 SPACE 24780002 */* CHAP0110: P STORE NEW LIMIT INTO CHAP TCB */ 24840002 SPACE 24900002 CHAP0110 EQU * * 24960002 STC R10,TCBLMP-TCB(,R8CHAP) SAVE 25020002 SPACE 25080002 */* CHAP0090: P STORE NEW DISP INTO CHAP TCB */ 25140002 SPACE 25200002 CHAP0090 EQU * * 25260002 STC R13,TCBDSP-TCB(,R8CHAP) SAVE 25320002 EJECT 25380002 *********************************************************************** 25440002 * * 25500002 * RECHAIN CHAP TCB AT PROPER POSITION ON DISPATCHING QUEUE * 25560002 * * 25620002 *********************************************************************** 25680002 SPACE 4 25740002 */* S CHAIN: ADD CHAP TCB TO DISPATCHING QUEUE */ 25800002 SPACE 25860002 BAL R14RET,CHAIN INVOKE QUEUING SUBROUTINE 25920002 SPACE 3 25980002 *********************************************************************** 26040002 * * 26100002 * CHAP PROCESSING COMPLETE OR ERROR DETECTED, EXIT FROM CHAP SVC * 26160002 * * 26220002 *********************************************************************** 26280002 SPACE 4 26340002 */* P (,CHAP0180) RESTORE REGS 0, 1, 14, 15 */ 26400002 SPACE 26460002 L R15,CVTPTR ADDRESS OF THE CVT 26520002 L R14RET,CVTEXP1-CVT(,R15) RETURN ADDRESS IN EXIT PROLOGUE 26580002 * TO FORCE DISPATCHER ENTRY 26640002 L R15,RBGRS15 RESTORE 15 26700002 LM R0,R1,RBGRS0 RESTORE 0, 1 26760002 B CHAP0180 GO CANCEL FRR 26820002 SPACE 26880002 */* CHAP9000: P (,CHAP9020) SET ABEND CODE 22C */ 26940002 SPACE 27000002 CHAP9000 EQU * * 27060002 LA R1,ABEND22C INVALID PARM WORD ADDR 27120002 B CHAP9020 GO CLEAR RETURN ADDRESS 27180002 SPACE 27240002 */* CHAP9010: P SET ABEND CODE 12C */ 27300002 SPACE 27360002 CHAP9010 EQU * * 27420002 LA R1,ABEND12C INVALID PARM 27480002 SPACE 27540002 */* CHAP9020: P INDICATE ABEND */ 27600002 SPACE 27660002 CHAP9020 EQU * * 27720002 SR R14RET,R14RET NO RETURN ADDR - ABEND 27780002 SPACE 27840002 */* CHAP0180: L SETFRR: CANCEL FRR */ 27900002 SPACE 27960002 CHAP0180 EQU * * 28020002 SETFRR D,WRKREGS=(R10,R11) CANCEL FRR @Y02753 28080002 SPACE 28140002 */* D (YES,CHAP9030,NO,) IS ABEND INDICATED */ 28200002 SPACE 28260002 LTR R14RET,R14RET IS RETURN ADDRESS ZERO 28320002 SPACE 28380002 */* R () RETURN VIA EXIT PROLOGUE (IEAVEXP1) */ 28440002 SPACE 28500002 BNZR R14RET RETURN ADDRESS NONZERO, RETURN 28550002 SPACE 28600002 */* CHAP9030: L () ABEND: TERMINATE CURRENT TASK */ 28650002 SPACE 28700002 CHAP9030 EQU * * 28750002 ABEND (1),DUMP,,SYSTEM INVOKE ABEND 28800002 SPACE 28870002 */* IGC044: END FLOWCHART */ 28940002 SPACE 2 29010002 DROP R5CURRB 29100002 EJECT 29160002 */* CHAIN: CHART */ 29220002 */* FOOTING 29280002 */* SUBROUTINE QUEUES A TCB ONTO TCB DISPATCHING QUEUE */ 29340002 SPACE 2 29400002 *********************************************************************** 29460002 * * 29520002 * SUBROUTINE CHAIN ADDS A TCB TO THE DISPATCHING QUEUE. * 29580002 * * 29640002 * REGISTER USAGE : R2ASXB - ADDRESS OF THE CURRENT ASXB * 29700002 * R8CHAP - ADDRESS OF TCB TO BE CHAINED * 29760002 * R10 - DESTROYED * 29820002 * R11 - DESTROYED * 29880002 * R14RET - RETURN ADDRESS * 29940002 * * 30000002 *********************************************************************** 30060002 SPACE 4 30120002 */* E ENTER CHAIN */ 30180002 SPACE 30240002 */* P SET 'PRESENT' (ASXBFTCB) AND 'PREVIOUS' (0) TCB PTRS */ 30300002 SPACE 30360002 CHAIN EQU * * 30420002 L R10,ASXBFTCB-ASXB(,R2ASXB) ADDR OF TOP TCB ON QUEUE 30480002 SR R11,R11 NO PREVIOUS TCB 30540002 SPACE 30600002 */* CHAP0130: D (YES,CHAP0230,NO,) IS 'PRESENT' PTR 0 */ 30660002 SPACE 30720002 CHAP0130 EQU * TOP OF POSITION SEARCH LOOP 30780002 LTR R10,R10 IS THIS THE END OF THE QUEUE 30840002 BZ CHAP0230 YES, PROCESS AS SUCH 30900002 SPACE 30960002 */* D (YES,CHAP0160,NO,) IS CHAP TCB DISP GT 'PRESENT' TCB DISP */ 31020002 SPACE 31080002 CLC TCBDSP-TCB(C1,R8CHAP),TCBDSP-TCB(R10) 31140002 BH CHAP0160 CORRECT POSITION, GO CHAIN 31200002 SPACE 31260002 */* P (,CHAP0130) SET PREVIOUS TO PRESENT, PRESENT TO NEXT ON QUEUE */ 31320002 SPACE 31380002 LR R11,R10 CHECKED TCB BECOMES PREVIOUS 31440002 L R10,TCBTCB-TCB(R10) GET NEXT ON QUEUE 31500002 B CHAP0130 REPEAT SEARCH LOOP 31560002 SPACE 31620002 * END OF POSITION SEARCH LOOP 31680002 SPACE 31740002 */* CHAP0230: P (,CHAP0120) CHAIN CHAP TCB AT END OF DISPATCH QUEUE */ 31800002 SPACE 31860002 CHAP0230 EQU * * 31920002 ST R8CHAP,ASXBLTCB-ASXB(,R2ASXB) RESET END OF QUEUE PTR 31980002 B CHAP0120 GO SET REMAINING CHAIN PTRS 32040002 SPACE 32100002 */* CHAP0160: P SET 'PRESENT' TCB'S BACK PTR TO CHAP TCB */ 32160002 SPACE 32220002 CHAP0160 EQU * * 32280002 ST R8CHAP,TCBBACK-TCB(,R10) CHAIN PRESENT BACK TO CHAP 32340002 SPACE 32400002 */* CHAP0120: D (NO,CHAP0150,YES,) IS PRESENT PTR THE TOP OF QUEUE */ 32450002 SPACE 32500002 CHAP0120 EQU * * 32550002 LTR R11,R11 ANY PREVIOUS TCB 32600002 BNZ CHAP0150 YES, BYPASS TOP OF QUEUE RESET 32700002 SPACE 32760002 */* P (,CHAP0140) CHAIN CHAP TCB AT TOP OF DISPATCHING QUEUE */ 32820002 SPACE 32880002 ST R8CHAP,ASXBFTCB-ASXB(,R2ASXB) RESET TOP OF QUEUE PTR 32940002 B CHAP0140 GO SET CHAP TCB CHAIN PTRS 33000002 SPACE 33060002 */* CHAP0150: P CHAIN CHAP TCB AFTER 'PREVIOUS' TCB */ 33120002 SPACE 33180002 CHAP0150 EQU * * 33240002 ST R8CHAP,TCBTCB-TCB(,R11) CHAP TCB FOLLOWS PREVIOUS TCB 33300002 SPACE 33360002 */* CHAP0140: P SET CHAIN FIELDS IN CHAP TCB */ 33420002 SPACE 33480002 CHAP0140 EQU * * 33540002 ST R11,TCBBACK-TCB(,R8CHAP) CHAIN CHAP TCB TO PREVIOUS 33600002 ST R10,TCBTCB-TCB(,R8CHAP) CHAIN CHAP TCB TO PRESENT 33660002 SPACE 33720002 */* R () RETURN */ 33780002 SPACE 33840002 BR R14RET RETURN 33900002 SPACE 33960002 */* CHAIN: END FLOWCHART */ 34020002 EJECT 34080002 */* UNCHAIN: CHART */ 34140002 */* FOOTING 34200002 */* SUBROUTINE REMOVES A TCB FROM THE DISPATCHING QUEUE */ 34260002 SPACE 2 34320002 *********************************************************************** 34380002 * * 34440002 * SUBROUTINE UNCHAIN REMOVES A TCB FROM THE TCB DISPATCHING QUEUE * 34500002 * * 34560002 * REGISTER USAGE: * 34620002 * R2ASXB - ADDRESS OF THE CURRENT ASXB * 34680002 * R8CHAP - ADDRESS OF THE TCB TO BE UNCHAINED * 34740002 * R13 - DESTROYED * 34800002 * R14 - RETURN ADDRESS * 34860002 * R15 - DESTROYED * 34920002 * * 34980002 *********************************************************************** 35040002 SPACE 4 35100002 */* E ENTER UNCHAIN */ 35160002 SPACE 35220002 */* P SET FORWARD PTR TO CHAP TCBTCB, BACK PTR TO CHAP TCBBACK */ 35280002 SPACE 35340002 UNCHAIN EQU * ENTRY POINT 35400002 L R13FORWD,TCBTCB-TCB(,R8CHAP) TCB FOLLOWING CHAP TCB 35460002 L R15BACK,TCBBACK-TCB(,R8CHAP) TCB PRECEEDING CHAP TCB 35520002 SPACE 35580002 */* D (NO,CHAP0290,YES,) IS CHAP TCB AT TOP OF DISPATCHING QUEUE */ 35640002 SPACE 35700002 CL R8CHAP,ASXBFTCB-ASXB(,R2ASXB) IS CHAP FIRST ON QUEUE 35760002 BNE CHAP0290 NO, UNCHAIN FROM PRECEEDING TCB 35820002 SPACE 35880002 */* P (,CHAP0190) RESET TOP OF QUEUE PTR (ASXBFTCB) TO FORWARD PTR */ 35940002 SPACE 36000002 ST R13FORWD,ASXBFTCB-ASXB(,R2ASXB) RESET PTR TO FIRST TCB 36060002 B CHAP0190 GO CHECK BOTTOM PTR 36120002 SPACE 36180002 */* CHAP0290: P SET PRECEEDING TCB'S TCBTCB TO FORWARD PTR */ 36240002 SPACE 36300002 CHAP0290 EQU * * 36360002 ST R13FORWD,TCBTCB-TCB(,R15BACK) BREAK FORWARD CHAIN 36420002 SPACE 36480002 */* CHAP0190: D (NO,CHAP0200,YES,) IS CHAP TCB AT BOTTOM OF QUEUE */ 36540002 SPACE 36600002 CHAP0190 EQU * * 36660002 CL R8CHAP,ASXBLTCB-ASXB(,R2ASXB) IS CHAP LAST ON QUEUE 36720002 BNE CHAP0200 NO, UNCHAIN FROM FOLLOWING TCB 36780002 SPACE 36840002 */* P (,CHAP0240) RESET END OF QUEUE PTR (ASXBLTCB) TO BACK PTR */ 36900002 SPACE 36960002 ST R15BACK,ASXBLTCB-ASXB(,R2ASXB) RESET PTR TO END TCB 37020002 B CHAP0240 GO TO EXIT SUBROUTINE 37080002 SPACE 37140002 */* CHAP0200: P SET FOLLOWING TCB'S TCBBACK TO BACK PTR */ 37200002 SPACE 37260002 CHAP0200 EQU * * 37320002 ST R15BACK,TCBBACK-TCB(,R13FORWD) BREAK BACK CHAIN 37380002 SPACE 37440002 */* CHAP0240: R () RETURN TO CALLER */ 37500002 SPACE 37560002 CHAP0240 EQU * * 37620002 BR R14 RETURN 37680002 SPACE 3 37740002 */* UNCHAIN: END FLOWCHART */ 37800002 TITLE 'IEAVECH0 - FRR FOR CHAP SVC - ENTRY POINT IGC044R1' 37860002 */* IGC044R1: CHART */ 37920002 */* FOOTING 37980002 */* FRR FOR SVC CHAP */ 38040002 SPACE 2 38100002 *********************************************************************** 38160002 * * 38220002 * IGC044R1 IS THE ENTRY POINT OF CHAP'S FUNCTIONAL RECOVERY ROUTINE * 38280002 * (FRR). IT MAY BE ENTERED IN NORMAL PROCESSING BY MEANS OF A * 38340002 * PARAMETER VALIDITY CHECK IN THE CALLER'S KEY, IN WHICH CASE THE FRR * 38400002 * SETS COMPLETION CODE 22C AND PERCOLATES, OR THROUGH AN UNEXPECTED * 38460002 * ERROR. IN THE LATTER CASE, ROUTINE IGC044R2 IS INVOKED TO VALIDATE * 38520002 * THE TCB QUEUES, AND THE ERROR IS PERCOLATED (I.E., THE FRR RETURNS * 38580002 * CONTROL TO RTM SPECIFYING NO RETRY). IF ENTERED VIA PERCOLATION, * 38640002 * STATUS HAS ALREADY CALLED IGC044R2 AND RECORDED, HENCE THIS FRR * 38650002 * ONLY PERCOLATES. (STATUS IS THE ONLY ROUTINE CALLED BY CHAP HAVING * 38660002 * ITS OWN FRR.) * 38670002 * * 38700002 * SYSTEM ROUTINES CALLED / MACROS ISSUED: SETRP * 38760002 * * 38820002 * SUBROUTINES CALLED: IGC044R2 * 38880002 * * 38940002 * RETURN CODES SET: 0 (VIA SETRP) * 39000002 * * 39060002 * REGISTER USAGE: * 39120002 * R0 - INPUT, ADDRESS OF 200 BYTE WORKAREA * 39180002 * R1 - INPUT, ADDRESS OF SDWA * 39240002 * R9 - RETURN ADDRESS SAVE REGISTER * 39300002 * R14 - RETURN ADDRESS * 39302002 * R15 - ENTRY POINT ADDRESS * 39408802 * * 39426402 *********************************************************************** 39500002 SPACE 3 39600002 */* E ENTER IGC044R1 */ 39650002 SPACE 39700002 IGC044R1 EQU * ENTRY POINT 39750002 USING IGC044R1,R15 @Y02753 39800002 L R6BASE,CHAP044E SVC ENTRY POINT ADDRESS @Y02753 39850002 DROP R15 @Y02753 39900002 SPACE 39970002 */* D (NO,CHAP7000,YES,) DID ERROR OCCUR IN CURRENT ADDRESS SPACE */ 40040002 SPACE 40110002 OC SDWAFMID-SDWA(C2,R1),SDWAFMID-SDWA(R1) ASID 0 @Y02753 40180002 BNZ CHAP7000 NO, EXIT FRR @Y02753 40250002 SPACE 40300002 */* D (YES,CHAP7010,NO,) ENTRY DUE TO VALIDITY CHECK */ 40350002 SPACE 40400002 LR R9,R14 SAVE RETURN ADDRESS @Y02753 40450002 IC R7,SDWAMWP1-SDWA(,R1) ERROR-TIME PSW KEY-CMWP @Y02753 40500002 LA R8,KEYMASK MASK CLEARS CMWP BITS @Y02753 40560002 NR R7,R8 WAS ERROR TIME KEY ZERO @Y02753 40620002 BZ CHAP7020 YES, CONTINUE RECOVERY @Y02753 40680002 * NO, CHECK INVALID PARM @Y02753 40740002 TM SDWAERRA-SDWA(R1),SDWAPCHK DID A PGM CHECK OCCUR @Y02753 40800002 BO CHAP7010 YES, ASSUME INVALID PARM @Y02753 40870002 * NO, CONTINUE RECOVERY 40940002 SPACE 40948002 */* CHAP7020: D (YES,CHAP7030,NO,) DID STATUS PERCOLATE THIS ERROR */ 40956002 SPACE 40964002 CHAP7020 EQU * * 40972002 TM SDWAERRC-SDWA(R1),SDWAPERC HAS PERCOLATION @YM04242 40980002 * OCCURRED 40988002 BO CHAP7030 YES, TURN OFF RECORDING @YM04242 40996002 SPACE 41010002 */* S (,CHAP7000) IGC044R2: VALIDATE TCB QUEUES */ 41100002 SPACE 41150002 SETRP RECORD=YES,RECPARM=CHAPFRR ERROR RECORDING @Y02753 41250002 LA R15,IGC044R2 ENTRY POINT ADDRESS @Y02753 41300002 LA R2,CHAPSLNG TITLE FOR SVC DUMP @Y02753 41350002 BALR R14,R15 QUEUE VALIDATION RTN @Y02753 41400002 * NOTE: REGISTER 6 (BASE) IS RESET TO SAME VALUE IN IGC044R2. 41470002 * REGISTERS 0, 1, 9, 14 RETURNED UNCHANGED. 41540002 B CHAP7000 GO EXIT FRR @Y02753 41610002 SPACE 41700002 */* CHAP7030: P (,CHAP7000) REQUEST NO RECORDING */ 41708002 SPACE 41716002 CHAP7030 EQU * * @YM04242 41720002 SETRP RECORD=NO NO RECORDING @YM04242 41724002 B CHAP7000 GO EXIT @YM04242 41732002 SPACE 41740002 */* CHAP7010: P RESET COMPLETION CODE TO 22C */ 41750002 SPACE 41800002 CHAP7010 EQU * * 41850002 SETRP RECORD=NO,DUMP=YES USER ERROR, NO RECORDING @Y02753 41900002 MVC SDWACMPC-SDWA(C3,R1),CHAP22C INVALID PARMS @Y02753 41950002 SPACE 42000002 */* CHAP7000: R () RETURN TO RTM, NO RETRY (RC=0) */ 42060002 SPACE 42120002 CHAP7000 EQU * * 42180002 SETRP FRELOCK=(LOCAL),RC=0 NO RETRY @Y02753 42240002 LR R14,R9 RESTORE @Y02753 42300002 BR R14 RETURN @Y02753 42370002 SPACE 42440002 */* IGC044R1: END FLOWCHART */ 42510002 TITLE 'IEAVECH0 - TCB QUEUE VALIDATION ROUTINE - IGC044R2' 42600002 */* IGC044R2: CHART */ 42660002 */* FOOTING 42720002 */* TCB QUEUE VERIFICATION ROUTINE */ 42780002 SPACE 2 42840002 *********************************************************************** 42900002 * * 42960002 * THIS ROUTINE VERIFIES THE TCB DISPATCHING QUEUE AND THE TCB FAMILY * 43020002 * QUEUE FOR THE CURRENT ADDRESS SPACE. IT IS AN EXTERNAL ENTRY TO * 43080002 * CHAP, AND IS INVOKED BY OTHER MODULES FOR RECOVERY, SPECIFICALLY * 43140002 * ATTACH, DETACH, AND STATUS. * 43200002 * * 43260002 * THE ERROR RECORDING OUTPUT DATA AREA IS SDWA FIELD SDWAVRA. * 43320002 * ERROR RECORDING IS DONE IN THE FOLLOWING FORMAT: * 43380002 * * 43440002 * (1) IF QUEUE VERIFIER IS CALLED, THE RECORD BEGINS WITH AN 8 * 43500002 * BYTE ID ENTRY, FOLLOWED BY ERROR RECORDING PERFORMED BY * 43560002 * QUEUE VERIFIER. * 43620002 * (2) FOLLOWING RECORDING BY QUEUE VERIFIER, AN 8 BYTE ID * 43680002 * ENTRY FOR IGC044R2, IF THAT ID WILL FIT INTO SPACE LEFT. * 43740002 * (3) FOLLOWING THE ID, A 4 BYTE DESCRIPTOR: * 43800002 * BYTE1 - FLAGS: * 43860002 * BIT0 - 1, ERRORS WERE DETECTED BUT NOT RECORDED* 43920002 * 0, ANY ERRORS DETECTED WERE RECORDED * 43980002 * BITS1-7 - RESERVED * 44040002 * BYTE2 - A COUNT OF THE NUMBER OF ERRORS RECORDED * 44100002 * BYTE3 - A COUNT OF THE NUMBER OF ERRORS DETECTED * 44160002 * BYTE4 - THE RETURN CODE FROM IGC044R2 * 44220002 * (4) FOLLOWING THE DESCRIPTOR, A 16 BYTE ENTRY FOR EACH ERROR * 44280002 * DETECTED (AND CORRECTED), PROVIDED THERE WAS SPACE FOR * 44340002 * THE ENTRY. THE FORMAT OF THE 16 BYTE ENTRIES IS DESCRIBED* 44400002 * IN THE GENERAL COMMENTS FOR SUBROUTINE RECERROR. * 44460002 * * 44520002 * SUBROUTINES CALLED: TCBCHECK * 44580002 * * 44640002 * SYSTEM ROUTINES CALLED / MACROS ISSUED: * 44700002 * * 44760002 * IEAVEQV0 (QUEUE VERIFIER) AT ENTRY POINT IEAVEQV3 * 44820002 * ASCB/ASXB CONTROL BLOCK VERIFIER - IEAVECAS * 44880002 * SDUMP * 44940002 * * 45000002 * RETURN CODES SET: * 45060002 * * 45120002 * 0 - THE TCB QUEUES OF THE CURRENT ADDRESS SPACE ARE USABLE * 45180002 * 4 - THE TCB QUEUES OF THE CURRENT ADDRESS SPACE ARE UNUSABLE * 45240002 * BECAUSE THE ASCB OR ASXB IS INVALID. * 45300002 * 8 - THE TCB DISPATCHING QUEUE WAS EMPTY AFTER PROCESSING BY * 45360002 * QUEUE VERIFIER. * 45420002 * * 45480002 * REGISTER USAGE: * 45540002 * * 45600002 * 0 - ADDRESS OF 200 BYTE WORKAREA (UNCHANGED) * 45650002 * 1 - ADDRESS OF THE SDWA (UNCHANGED) * 45700002 * 2 - INPUT, 0 FOR NO SVC DUMP; ADDRESS OF DUMP TITLE FOR SVC * 45750002 * DUMP. CONTAINS ADDRESS OF CURRENT ASXB DURING PROCESSING.* 45800002 * 3 - WORKAREA ADDRESS DURING PROCESSING. * 45850002 * 6 - BASE REGISTER * 45900002 * 9 - UNCHANGED * 45970002 * 14 - RETURN ADDRESS (UNCHANGED) * 46040002 * 15 - INPUT, ENTRY POINT ADDRESS * 46110002 * OUTPUT, RETURN CODE * 46200002 * ALL OTHER REGISTERS VOLATILE * 46250002 * * 46300002 * WORKAREA: * 46350002 * THE 200 BYTE WORKAREA ADDRESSED BY REGISTER 0 ON ENTRY IS * 46400002 * MAPPED AS FOLLOWS: FIRST PORTION MAPPED BY DSECT WKAREA, * 46450002 * ADDRESSED BY REG 3, THEN THE PARM LIST AREA, MAPPED BY * 46500002 * DSECT QVPL (AREA ALSO USED FOR SDUMP LIST FORM), ADDRESSED * 46560002 * BY REG 1, THEN A 72 BYTE REGISTER SAVE AREA ADDRESSED BY * 46620002 * REG 13, THEN A WORKAREA FOR IEAVEQV3 (LENGTH DEFINED BY * 46680002 * QVPLWASZ). * 46740002 * * 46800002 *********************************************************************** 46860002 SPACE 3 46920002 */* E ENTER IGC044R2 */ 46980002 SPACE 47040002 IGC044R2 EQU * ENTRY POINT 47100002 USING IGC044R2,R15 @Y02753 47160002 L R6BASE,CHAP044E SVC ENTRY POINT ADDRESS @Y02753 47220002 DROP R15 @Y02753 47280002 LR R3,R0 200 BYTE WORKAREA ADDR @Y02753 47340002 USING WKAREA,R3 @Y02753 47400002 ST R14,WKRETAD SAVE RETURN ADDRESS @Y02753 47470002 LA R13,WKLENGTH+QVPLSIZE(,R3) SAVE AREA ADDRESS @Y02753 47540002 SPACE 47610002 */* L IEAVECAS: VERIFY CURRENT ASCB/ASXB */ 47700002 SPACE 47750002 STM R2,R7,0(R13) SAVE REGISTERS @YM02632 47800002 L R0,PSAAOLD-PSA(,R0) ADDRESS OF CURRENT ASCB @Y02753 47850002 L R15,CHAPAVER ENTRY POINT ADDRESS @Y02753 47900002 BALR R14,R15 CONTROL BLOCK VERIFIER @Y02753 47950002 * NOTE: REGISTERS 2-7, 15 MAY BE CHANGED 48000002 LM R2,R7,0(R13) RESTORE REGISTERS @YM02632 48070002 SPACE 48140002 */* D (YES,CHAP8090,NO,) VALID */ 48210002 SPACE 48300002 LTR R15,R15 CAN ASXB BE REFERENCED @Y02753 48360002 BZ CHAP8090 YES, CONTINUE @Y02753 48420002 SPACE 48480002 */* P (,CHAP8010) SET RETURN CODE 4 */ 48540002 SPACE 48600002 BAL R14,HDSETUP MOVE HEADER, DESCRIPTOR @Y02753 48650002 LA R15,RCODE4 QUEUES ARE UNUSABLE @Y02753 48700002 B CHAP8010 GO SET RETURN CODE @Y02753 48750002 SPACE 48800002 */* CHAP8090: D (NO,CHAP8080,YES,) WAS SVC DUMP REQUESTED */ 48850002 SPACE 48900002 CHAP8090 EQU * * 48970002 LTR R2,R2 WAS DUMP TITLE PROVIDED @Y02753 49040002 BZ CHAP8080 NO, BYPASS SVC DUMP @Y02753 49110002 SPACE 49200002 */* L SVC DUMP: REQUEST DUMP OF SQA, LSQA, TRACE */ 49250002 SPACE 49300002 LR R7,R1 SAVE ADDRESS OF SDWA @Y02753 49350002 LA R1,WKLENGTH(,R3) ADDRESS OF LIST AREA @Y02753 49400002 MVC 0(SDUMPLNG,R1),CHAPSDMP MOVE LIST FORM @Y02753 49450002 * NOTE: REGISTER 15 CONTAINS ZERO, INDICATING CURRENT ADDRESS SPACE 49500002 SDUMP HDRAD=(R2),ASID=(R15),BRANCH=YES,MF=(E,(1)) @Y02753 49550002 LR R1,R7 ADDRESS OF SDWA @Y02753 49600002 SPACE 49650002 */* CHAP8080: L IEAVEQV3: VERIFY AND CORRECT TCB DISPATCHING QUEUE */ 49700002 SPACE 49800002 CHAP8080 EQU * * 49860002 LA R4,CHAPQVID RECORDING HEADER FOR QV3 @Y02753 49920002 LA R5,L'CHAPQVID LENGTH OF HEADER @Y02753 49980002 BAL R14,RECMOVE HEADER INTO OUTPUT AREA @Y02753 50040002 SPACE 50100002 * BUILD PARAMETER LIST FOR IEAVEQV3 50160002 SPACE 50220002 L R2,PSAAOLD-PSA(,R0) ADDRESS OF CURRENT ASCB @Y02753 50280002 LR R0,R1 ADDRESS OF SDWA @Y02753 50340002 LA R10,SDWARA-SDWA(,R1) ADDR OF RECORDING AREA @YM02632 50400002 LA R1,WKLENGTH(,R3) ADDRESS OF QVPL @Y02753 50460002 XC 0(QVPLSIZE,R1),0(R1) CLEAR LIST AREA @Y02753 50520002 L R2ASXB,ASCBASXB-ASCB(,R2) ADDR OF CURRENT ASXB @Y02753 50580002 LA R8,QVPLSIZE+SAVELNG(,R1) WORKAREA ADDRESS @Y02753 50640002 L R15,CHAPTVER ADDR OF TCB VERIFIER RTN @Y02753 50700002 ST R15,QVPLEVR-QVPL(,R1) INTO PARM LIST @Y02753 50760002 ST R10,QVPLODA-QVPL(,R1) ADDR OF OUTPUT DATA AREA @Y02753 50820002 ST R8,QVPLWKA-QVPL(,R1) ADDR IEAVEQV3 WORKAREA @Y02753 50880002 LA R10,ASXBFTCB-ASXB(,R2ASXB) ADDR TCB QUEUE HEADER @Y02753 50940002 ST R10,QVPLHDR-QVPL(,R1) INTO PARM LIST @Y02753 51000002 LA R10,ASXBLTCB-ASXB(,R2ASXB) ADDR QUEUE TRAILER @Y02753 51060002 ST R10,QVPLTRLR-QVPL(,R1) INTO PARM LIST @Y02753 51120002 LA R10,TCBTCB-TCB(,R0) FORWARD PTR OFFSET @Y02753 51180002 STH R10,QVPLFPTR-QVPL(,R1) INTO PARM LIST @Y02753 51240002 LA R10,TCBBACK-TCB(,R0) BACK CHAIN PTR OFFSET @Y02753 51300002 STH R10,QVPLBPTR-QVPL(,R1) INTO PARM LIST @Y02753 51370002 * FIELDS QVPLLELM, QVPLNOEL, QVPLFELM ARE INPUT, CONTAIN 0 51440002 * BECAUSE LIST AREA WAS CLEARED. 51510002 SPACE 51600002 * INVOKE IEAVEQV3 51650002 SPACE 51700002 * REGISTER 13 CONTAINS ADDRESS OF A 72 BYTE SAVE AREA 51750002 L R15,CHAPQV3 ADDRESS OF IEAVEQV3 @Y02753 51800002 BALR R14,R15 INVOKE QUEUE VERIFIER @Y02753 51850002 SPACE 51900002 */* S HDSETUP: SET UP OUTPUT RECORDING AREA FOR IGC044R2 */ 51960002 SPACE 52020002 LR R1,R0 RESTORE SDWA ADDRESS @Y02753 52080002 BAL R14,HDSETUP MOVE HEADER, DESCRIPTOR @Y02753 52140002 SPACE 52200002 */* CHAP8130: D (NO,CHAP8020,YES,) IS TCB DISPATCHING QUEUE EMPTY */ 52260002 SPACE 52320002 CHAP8130 EQU * * 52380002 ICM R10,B'1111',ASXBFTCB-ASXB(R2ASXB) ADDR FIRST TCB @Y02753 52440002 BNZ CHAP8020 NONZERO, CONTINUE @Y02753 52500002 SPACE 52570002 */* P SET RETURN CODE 8, ASCBFAIL=1 */ 52640002 SPACE 52710002 L R7,PSAAOLD-PSA(,R0) ADDRESS OF CURRENT ASCB @Y02753 52800002 OI ASCBDSP1-ASCB(R7),ASCBFAIL ADDRESS SPACE FAILURE @Y02753 52850002 LA R15,RCODE8 QUEUES ARE UNUSABLE @Y02753 52900002 SPACE 52950002 */* CHAP8010: D (NO,CHAP8000,YES,) IS THERE A DESCRIPTOR WORD */ 53000002 SPACE 53050002 CHAP8010 EQU * * 53100002 ICM R10,B'1111',WKOUTDP ADDRESS OF DESCRIPTOR @Y02753 53160002 BZ CHAP8000 NO DESCRIPTOR, GO EXIT @Y02753 53220002 SPACE 53280002 */* P (,CHAP8000) SAVE RETURN CODE IN DESCRIPTOR */ 53340002 SPACE 53400002 ST R15,0(,R10) RETURN CODE @Y02753 53460002 B CHAP8000 GO EXIT THIS ROUTINE @Y02753 53520002 SPACE 53580002 */* CHAP8020: P SET SEARCH TCB = TOP OF QUEUE, ITS TCBNTC=0, OTC=0 */ 53640002 SPACE 53700002 CHAP8020 EQU * * 53760002 L R10,ASXBETSK-ASXB(,R2ASXB) ADDRESS OF OLDEST TCB @Y02753 53820002 SR R11,R11 CLEAR OTC @Y02753 53880002 ST R11,TCBNTC-TCB(,R10) OLDEST TCB HAS NO SISTER @Y02753 53940002 EJECT 54000002 *********************************************************************** 54070002 * * 54140002 * INNER LOOP, ON TCBLTC * 54210002 * * 54300002 *********************************************************************** 54350002 SPACE 54400002 */* CHAP8030: P SET SEARCH TCB'S TCBOTC=OTC */ 54450002 SPACE 54500002 CHAP8030 EQU * * 54550002 ST R11,TCBOTC-TCB(,R10) UNCOND UPDATE TCBOTC @Y02753 54600002 SPACE 54660002 */* CHAP8140: D (YES,CHAP8040,NO,) IS TCBLTC OF SEARCH TCB = 0 */ 54720002 SPACE 54780002 CHAP8140 EQU * * 54840002 ICM R7,B'1111',TCBLTC-TCB(R10) PTR MOST RECENT SUB @Y02753 54900002 BZ CHAP8040 NO SUBTASK-CHECK SISTERS @Y02753 54977202 SPACE 55050002 */* P SET OTC = SEARCH TCB */ 55100002 SPACE 55150002 LR R11,R10 UPDATE OTC FOR TCBCHECK @Y02753 55240002 SPACE 55300002 */* S TCBCHECK: VERIFY SEARCH TCB'S TCBLTC */ 55360002 SPACE 55420002 BAL R14,TCBCHECK INVOKE CHECK OUT ROUTINE @Y02753 55480002 SPACE 55540002 */* D (NO,CHAP8060,YES,) ANY REPLACEMENT */ 55600002 SPACE 55660002 LTR R15,R15 UPDATE SEARCH TCBLTC @Y02753 55720002 BZ CHAP8060 NO, CONTINUE @Y02753 55780002 SPACE 55840002 */* S RECERROR: SET ERROR ENTRY INTO OUTPUT AREA */ 55900002 SPACE 55960002 L R4,CHAPNTC ERROR IDENTIFIER @Y02753 56020002 CLI WKCHKRCD+C1,RCODE8 WAS A TCBNTC UPDATED @Y02753 56080002 BE CHAP8150 YES, LEAVE IDENT AS IS @Y02753 56140002 L R4,CHAPLTC ERROR IDENTIFIER @Y02753 56200002 CHAP8150 EQU * * 56260002 BAL R14,RECERROR GO SET UP AND MOVE ENTRY @Y02753 56320002 SPACE 56380002 */* D (NO,CHAP8140,YES,) WAS TCBCHECK RETURN CODE = 4 */ 56440002 SPACE 56500002 CLI WKCHKRCD+C1,RCODE4 WAS A TCBNTC UPDATED @Y02753 56560002 BNE CHAP8140 GO RECHECK SEARCH TCBLTC @Y02753 56620002 SPACE 56680002 */* P UPDATE SEARCH TCB'S TCBLTC WITH REPLACEMENT */ 56740002 SPACE 56800002 ST R8,TCBLTC-TCB(,R10) FIX INVALID POINTER @Y02753 56860002 SPACE 56920002 */* D (YES,CHAP8040,NO,) IS NEW TCBLTC ZERO */ 56980002 SPACE 57040002 LTR R7,R8 RESET SUBTASK PTR @Y02753 57100002 BZ CHAP8040 NO SUBTASK-CHECK SISTERS @Y02753 57160002 SPACE 57220002 */* CHAP8060: P (,CHAP8030) SET SEARCH TCB=TCBLTC */ 57280002 SPACE 57340002 CHAP8060 EQU * * 57400002 LR R10,R7 NEW SEARCH TCB @Y02753 57460002 B CHAP8030 CHECK SEARCH TCB SUBTSKS @Y02753 57520002 EJECT 57580002 *********************************************************************** 57640002 * * 57700002 * OUTER LOOP 1, ON TCBNTC OF LAST CHECKED TCB * 57760002 * * 57820002 *********************************************************************** 57880002 SPACE 2 57940002 */* CHAP8040: D (YES,CHAP8050,NO,) IS SEARCH TCBNTC ZERO */ 58000002 SPACE 58060002 CHAP8040 EQU * * 58120002 ICM R7,B'1111',TCBNTC-TCB(R10) NEXT SISTER PTR ZERO @Y02753 58180002 BZ CHAP8050 NO NEXT SISTER, CHECK @Y02753 58240002 * SEARCH TCB'S MOTHER'S SISTER 58300002 SPACE 58360002 */* S TCBCHECK: VERIFY SISTER TCB */ 58420002 SPACE 58480002 BAL R14,TCBCHECK INVOKE CHECKOUT ROUTINE @Y02753 58540002 SPACE 58600002 */* D (NO,CHAP8070,YES,) ANY REPLACEMENT */ 58660002 SPACE 58720002 LTR R15,R15 UPDATE SEARCH TCBNTC @Y02753 58780002 BZ CHAP8070 NO, CONTINUE @Y02753 58840002 SPACE 58900002 */* S RECERROR: INDICATE ERROR IN OUTPUT DATA AREA */ 58960002 SPACE 59020002 L R4,CHAPNTC ERROR IDENTIFIER @Y02753 59080002 BAL R14,RECERROR GO SET UP AND MOVE ENTRY @Y02753 59140002 SPACE 59200002 */* D (NO,CHAP8040,YES,) WAS TCBCHECK RETURN CODE = 4 */ 59260002 SPACE 59320002 CLI WKCHKRCD+C1,RCODE4 WAS SOME TCBNTC UPDATED @Y02753 59380002 BNE CHAP8040 GO RECHECK SEARCH TCBNTC @Y02753 59440002 SPACE 59500002 */* P UPDATE SEARCH TCB'S TCBNTC WITH REPLACEMENT */ 59560002 SPACE 59620002 ST R8,TCBNTC-TCB(,R10) FIX INVALID POINTER @Y02753 59680002 SPACE 59740002 */* D (YES,CHAP8050,NO,) IS NEW TCBNTC ZERO */ 59800002 SPACE 59860002 LTR R7,R8 RESET SISTER PTR @Y02753 59920002 BZ CHAP8050 NO SISTER, CHECK LAST @Y02753 59980002 * CHECKED TCB'S MOTHER'S SISTERS 60040002 SPACE 60100002 */* CHAP8070: P (,CHAP8030) SET SEARCH TCB = TCBNTC OF SEARCH TCB */ 60160002 SPACE 60220002 CHAP8070 EQU * * 60280002 LR R10,R7 NEW SEARCH TCB @Y02753 60340002 B CHAP8030 CONTINUE SCAN @Y02753 60400002 EJECT 60460002 *********************************************************************** 60520002 * * 60580002 * OUTER LOOP 2, ON TCBNTC OF MOTHER OF LAST CHECKED TCB * 60640002 * * 60700002 *********************************************************************** 60760002 SPACE 2 60820002 */* CHAP8050: D (YES,CHAP8110,NO,) IS OTC=ASXBETSK */ 60880002 SPACE 60940002 CHAP8050 EQU * * 61000002 C R11,ASXBETSK-ASXB(,R2ASXB) ARE THERE ANY TCBS @YM02632 61060002 * ON FAMILY QUEUE NOT YET CHECKED 61120002 BE CHAP8110 NO, SCAN COMPLETE @Y02753 61180002 SPACE 61240002 */* P SET SEARCH TCB = TCBOTC OF SEARCH TCB */ 61300002 SPACE 61360002 LR R10,R11 TO CONTINUE SCAN FROM @Y02753 61420002 * PREVIOUSLY CHECKED TCB 61480002 SPACE 61540002 */* P (,CHAP8040) SET OTC = TCBOTC OF OTC TCB */ 61600002 SPACE 61660002 L R11,TCBOTC-TCB(,R11) SET TO PREV UPDATED PTR @Y02753 61720002 B CHAP8040 CONTINUE SCAN WITH PREV @Y02753 61780002 * CHECKED TCB'S SISTER PTR 61840002 EJECT 61900002 *********************************************************************** 61960002 * * 62020002 * TREE SCAN COMPLETE * 62080002 * * 62140002 *********************************************************************** 62200002 SPACE 2 62260002 */* CHAP8110: P UPDATE ASXBTCBS, ASCBTCBS */ 62320002 SPACE 62380002 CHAP8110 EQU * * 62390002 L R12,PSAAOLD-PSA(,R0) ADDRESS OF CURRENT ASCB @Y02753 62400002 SR R4,R4 CLEAR FOR COMPARE @Y02753 62410002 L R13,ASCBTCBS-ASCB(,R12) PRESENT READY COUNT @Y02753 62420002 CHAP8190 EQU * TOP OF COMPARE-AND-SWAP LOOP 62440002 L R11,ASXBFTCB-ASXB(,R2ASXB) TOP OF DISPATCH QUEUE @Y02753 62500002 SR R10,R10 INITIALIZE TOTAL COUNT @Y02753 62560002 SR R7,R7 INITIAL READY TCB COUNT @Y02753 62590002 CHAP8160 EQU * TOP OF COUNTING LOOP 62620002 LA R10,C1(,R10) INCREMENT TOTAL COUNT @Y02753 62680002 CH R4,TCBFLGS4-TCB(,R11) IS THE TASK DISPATCHABLE @Y02753 62687002 BNZ CHAP8180 NO, DON'T UP READY COUNT @Y02753 62694002 L R8,TCBRBP-TCB(,R11) ADDRESS OF TOP RB @Y02753 62701002 CLI RBWCF-RBSECT(R8),C0 IS WAIT COUNT ZERO @Y02753 62708002 BNZ CHAP8180 NO, DON'T UP READY COUNT @Y02753 62715002 LA R7,C1(,R7) INCREMENT READY COUNT @Y02753 62722002 CHAP8180 EQU * * 62729002 ICM R11,B'1111',TCBTCB-TCB(R11) ADDRESS OF NEXT TCB @Y02753 62740002 BNZ CHAP8160 IF IT EXISTS, COUNT IT @Y02753 62800002 CS R13,R7,ASCBTCBS-ASCB(R12) UPDATE READY COUNT IF @Y02753 62810002 * UNCHANGED 62820002 BNE CHAP8190 OR RECOMPUTE COUNT @Y02753 62830002 STH R10,ASXBTCBS-ASXB(,R2ASXB) SAVE TOTAL COUNT @Y02753 62860002 SPACE 62920002 */* P SET RETURN CODE = 0 */ 62980002 SPACE 63040002 SR R15,R15 NO PERMANENT ERRORS @Y02753 63100002 SPACE 63160002 */* CHAP8000: R () RETURN TO CALLER */ 63220002 SPACE 63280002 CHAP8000 EQU * * 63340002 L R14,WKRETAD RETURN ADDRESS @Y02753 63400002 LR R0,R3 RESTORE @Y02753 63460002 BR R14 RETURN @Y02753 63520002 SPACE 2 63580002 */* IGC044R2: END FLOWCHART */ 63640002 EJECT 63700002 */* TCBCHECK: CHART */ 63760002 */* FOOTING 63820002 */* SUBROUTINE VALIDITY CHECKS INPUT TCB, FINDS ALTERNATE */ 63880002 SPACE 2 63940002 *********************************************************************** 64000002 * * 64060002 * SUBROUTINE TCBCHECK IS CALLED BY ROUTINE IGC044R2 TO VALIDITY CHECK * 64120002 * A TCB. IN CASE IT IS NOT VALID, A SEARCH IS MADE TO FIND THE MOST * 64180002 * RECENT SUBTASK OF THE TCB ADDRESSED BY REGISTER 11, BEGINNING WITH * 64240002 * A TCB HAVING TCBNTC=0. IF THERE IS NO SUBTASK WITH TCBNTC=0, A * 64300002 * SEARCH IS MADE FOR THE END OF THE SUBTASK QUEUE, AND THEN THE * 64360002 * SEARCH FOR THE MOST RECENT SUBTASK IS MADE. THE ADDRESS OF THE TCB * 64420002 * FOUND IS RETURNED TO IGC044R2 FOR USE IN CORRECTING THE INVALID * 64480002 * POINTER. * 64540002 * * 64600002 * SYSTEM ROUTINES CALLED / MACROS ISSUED: TCB CONTROL BLOCK VERIFIER * 64660002 * - IEAVETCB * 64720002 * * 64780002 * SUBROUTINES CALLED: CHAIN, UNCHAIN * 64840002 * * 64900002 * RETURN CODES SET: 0, 4 * 64960002 * * 65020002 * REGISTER USAGE: * 65080002 * R1 - ADDRESS OF THE SDWA * 65140002 * R2ASXB - ADDRESS OF THE CURRENT ASXB * 65200002 * R3 - WORKAREA ADDRESS * 65260002 * R7 - INPUT TCB ADDRESS * 65320002 * R8 - OUTPUT TCB ADDRESS * 65380002 * R11 - MOTHER TCB ADDRESS FOR SEARCHING FAMILY QUEUE * 65440002 * R13 - SAVE AREA ADDRESS * 65500002 * R14 - RETURN ADDRESS * 65560002 * R15 - OUTPUT, RETURN CODE * 65620002 * * 65680002 *********************************************************************** 65740002 SPACE 3 65800002 */* E ENTER TCBCHECK */ 65860002 SPACE 65920002 TCBCHECK EQU * ENTRY POINT 65980002 STM R14,R12,SVREG14-SAVEAREA(R13) SAVE REGISTERS @Y02753 66040002 SPACE 66100002 */* P INITIALIZE OUTPUT TCB ADDR TO 0, CLEAR FAMILY PTR, RETURN CODE */ 66160002 SPACE 66220002 SR R8,R8 CLEAR @Y02753 66280002 STH R8,WKCHKRCD CLEAR RETURN CODE @Y02753 66340002 ST R8,WKFAMPTR CLEAR FAMILY POINTER @Y02753 66400002 EJECT 66460002 */* L IEAVETCB: VALIDITY CHECK INPUT TCB ADDRESS */ 66520002 SPACE 66580002 LR R0,R7 ADDR OF TCB TO CHECKED @Y02753 66640002 L R15,CHAPTVER ENTRY POINT ADDRESS @Y02753 66700002 BALR R14,R15 TCB CONTROL BLK CHECKER @Y02753 66760002 * NOTE: REGISTERS 2-7,15 MAY BE CHANGED 66820002 SPACE 66880002 */* D (YES,CHAP8500,NO,) IS INPUT TCB VALID */ 66940002 SPACE 67000002 LR R7,R0 RESTORE @Y02753 67060002 LM R2,R3,SVREG2-SAVEAREA(R13) RESTORE @Y02753 67120002 L R6BASE,SVREG6-SAVEAREA(,R13) RESTORE @Y02753 67180002 LTR R15,R15 VALID @Y02753 67240002 BZ CHAP8500 YES, CONTINUE @Y02753 67300002 SPACE 67360002 */* P SET RETURN CODE 4 */ 67420002 SPACE 67480002 MVI WKCHKRCD+C1,RCODE4 RET CODE, TCB NOT VALID @Y02753 67540002 EJECT 67600002 *********************************************************************** 67660002 * * 67720002 * LOOP RUNS THE DISPATCHING QUEUE SEARCHING FOR TCBS WITH TCBOTC * 67780002 * MATCHING THE INPUT MOTHER TCB ADDRESS (REGISTER 11), IN ORDER TO * 67840002 * BACK UP THE FAMILY QUEUE (TCBNTC POINTERS), AND THUS LOCATE THE * 67900002 * BEST REPLACEMENT FOR THE INVALID TCB ADDRESS. * 67960002 * * 68020002 *********************************************************************** 68080002 SPACE 2 68140002 */* CHAP8510: P SET SEARCH TCB TO TOP OF DISPATCHING QUEUE */ 68200002 SPACE 68260002 CHAP8510 EQU * TOP OF FAMILY SEARCH LOOP 68320002 L R7,ASXBFTCB-ASXB(,R2ASXB) ADDRESS OF RCT TCB @Y02753 68380002 SPACE 68440002 */* CHAP8520: D (NO,CHAP8530,YES,) IS TCBOTC = INPUT OTC */ 68500002 SPACE 68560002 CHAP8520 EQU * * 68620002 C R11,TCBOTC-TCB(,R7) SEARCH TCB IN THE FAMILY @Y02753 68680002 BNE CHAP8530 NO, CONTINUE SCAN @Y02753 68740002 SPACE 68800002 */* P SET FAMILY TCB POINTER TO ADDR OF SEARCH TCB */ 68860002 SPACE 68920002 ST R7,WKFAMPTR SAVE ADDRESS @Y02753 68980002 SPACE 69040002 */* D (NO,CHAP8530,YES,) IS TCBNTC OF SEARCH TCB = OUTPUT TCB */ 69100002 SPACE 69160002 C R8,TCBNTC-TCB(,R7) IS SEARCH TCB NEXT @Y02753 69220002 BNE CHAP8530 NO, CONTINUE SEARCH @Y02753 69280002 SPACE 69340002 */* P (,CHAP8510) SET OUTPUT TCB = SEARCH TCB ADDR */ 69400002 SPACE 69460002 LR R8,R7 SAVE MOST RECENT SUBTASK @Y02753 69520002 B CHAP8510 SEARCH FOR ANOTHER @Y02753 69580002 SPACE 69640002 */* CHAP8530: P SET SEARCH TCB TO NEXT ON THE DISPATCHING QUEUE */ 69700002 SPACE 69760002 CHAP8530 EQU * * 69820002 ICM R7,B'1111',TCBTCB-TCB(R7) NEXT TCB @Y02753 69880002 SPACE 69940002 */* D (NO,CHAP8520,YES,) IS SEARCH TCB PTR 0 */ 70000002 SPACE 70060002 BNZ CHAP8520 NOT ZERO, CHECK THIS TCB @Y02753 70120002 SPACE 70180002 */* D (NO,CHAP8540,YES,) IS OUTPUT TCB ADDRESS = 0 */ 70240002 SPACE 70300002 LTR R8,R8 SEARCH SUCCESSFUL @Y02753 70360002 BNZ CHAP8540 YES, PREPARE TO RETURN @Y02753 70420002 SPACE 70480002 */* D (YES,CHAP8590,NO,) IS FAMILY POINTER = 0 */ 70540002 SPACE 70600002 ICM R7,B'1111',WKFAMPTR WERE THERE NO SUBTASKS @Y02753 70660002 BZ CHAP8590 YES, RETURN @Y02753 70720002 SPACE 70780002 */* N SEARCH TCB IS NOW INITIALIZED TO FAMILY POINTER */ 70840002 EJECT 70900002 *********************************************************************** 70960002 * * 71020002 * END OF FAMILY QUEUE POINTER LOST. RUN FAMILY QUEUE TO LOCATE END. * 71080002 * * 71140002 *********************************************************************** 71200002 SPACE 71260002 */* CHAP8550: P OUTPUT = SEARCH, SEARCH = TCBNTC OF SEARCH TCB */ 71320002 SPACE 71380002 CHAP8550 EQU * * 71440002 LR R4,R7 SAVE @Y02753 71500002 L R7,TCBNTC-TCB(,R7) NEXT OLDER SUBTASK @Y02753 71560002 SPACE 71620002 */* D (YES,CHAP8560,NO,) IS SEARCH TCB ADDR = FAMILY PTR */ 71680002 SPACE 71740002 C R7,WKFAMPTR IS FAMILY QUEUE CIRCULAR @Y02753 71800002 BE CHAP8560 YES, CLEAR CIRCULAR PTR @Y02753 71860002 SPACE 71920002 */* L IEAVETCB: VALIDITY CHECK SEARCH TCB ADDR */ 71980002 SPACE 72040002 LR R0,R7 ADDR TCB TO BE CHECKED @Y02753 72100002 L R15,CHAPTVER ENTRY POINT ADDRESS @Y02753 72160002 BALR R14,R15 TCB CONTROL BLOCK VERIFR @Y02753 72220002 SPACE 72280002 */* D (YES,CHAP8550,NO,) IS SEARCH TCB ADDR VALID */ 72340002 SPACE 72400002 LR R7,R0 RESTORE @Y02753 72460002 LM R2,R3,SVREG2-SAVEAREA(R13) RESTORE @Y02753 72520002 L R6BASE,SVREG6-SAVEAREA(,R13) RESTORE @Y02753 72580002 LTR R15,R15 VALIDITY CHECK RET CODE @Y02753 72640002 BZ CHAP8550 CHECK NEXT OLDER SISTER @Y02753 72700002 SPACE 72760002 */* CHAP8560: P OUTPUT = LAST VALID SISTER, CLEAR TCBNTC */ 72820002 SPACE 72880002 CHAP8560 EQU * * 72940002 SR R8,R8 CLEAR @Y02753 73000002 ST R8,TCBNTC-TCB(,R4) SEARCH TCB NOW CHAIN END @Y02753 73060002 SPACE 73120002 */* P (,CHAP8590) SET RETURN CODE 8 */ 73180002 SPACE 73240002 MVI WKCHKRCD+C1,RCODE8 INDICATE A TCBNTC FIELD @Y02753 73300002 * HAS BEEN UPDATED @Y02753 73360002 B CHAP8590 GO EXIT THIS ROUTINE @Y02753 73420002 EJECT 73480002 *********************************************************************** 73540002 * * 73600002 * INPUT TCB IS VALID. INSURE THAT IT IS ON THE DISPATCHING QUEUE IF * 73660002 * TCBFC=1, AND NOT ON THE QUEUE IF TCBFC=0. * 73720002 * * 73780002 *********************************************************************** 73850002 SPACE 3 73900002 */* CHAP8500: P START SEARCH AT TOP OF DISPATCHING QUEUE */ 73950002 SPACE 74000002 CHAP8500 EQU * * 74050002 L R8,ASXBFTCB-ASXB(,R2ASXB) ADDR TOP TCB ON QUEUE @Y02753 74100002 SPACE 74170002 */* CHAP8570: D (YES,CHAP8540,NO,) IS SEARCH TCB = INPUT TCB */ 74240002 SPACE 74310002 CHAP8570 EQU * TOP OF DISP QUEUE SEARCH LOOP 74400002 C R8,SVREG7-SAVEAREA(,R13) IS THIS THE INPUT TCB @Y02753 74450002 BE CHAP8540 ON QUEUE, GO CHECK TCBFC @Y02753 74500002 SPACE 74550002 */* P SET SEARCH TCB = NEXT TCB ON DISPATCHING QUEUE */ 74600002 SPACE 74650002 ICM R8,B'1111',TCBTCB-TCB(R8) NEXT TCB @Y02753 74700002 SPACE 74750002 */* D (NO,CHAP8570,YES,) IS SEARCH TCB PTR = 0 */ 74800002 SPACE 74850002 BNZ CHAP8570 GO CHECK THIS TCB @Y02753 74900002 SPACE 2 75000002 * FALL THROUGH LOOP MEANS INPUT TCB NOT ON DISPATCHING QUEUE 75070002 SPACE 2 75150002 */* D (YES,CHAP8590,NO,) IS INPUT TCB'S TCBFC =1 */ 75220002 SPACE 75300002 L R8,SVREG7-SAVEAREA(,R13) RESTORE INPUT @Y02753 75360002 TM TCBFLGS5-TCB(R8),TCBFC HAS END OF TASK OCCURRED @Y02753 75420002 BO CHAP8590 YES, RETURN TO CALLER @Y02753 75480002 SPACE 75540002 */* S (,CHAP8590) CHAIN: PUT INPUT TCB ON DISPATCHING QUEUE */ 75600002 SPACE 75660002 BAL R14,CHAIN PUT INPUT TCB ON QUEUE @Y02753 75720002 B CHAP8590 GO EXIT THIS ROUTINE @Y02753 75780002 EJECT 75840002 */* CHAP8540: D (NO,CHAP8590,YES,) IS TCBFC=1 */ 75900002 SPACE 75960002 CHAP8540 EQU * * 76020002 TM TCBFLGS5-TCB(R8),TCBFC HAS END OF TASK OCCURRED @Y02753 76080002 BZ CHAP8590 LEAVE TCB ON DISP QUEUE @Y02753 76140002 SPACE 76200002 */* S UNCHAIN: REMOVE COMPLETE TCB FROM DISPATCH QUEUE */ 76250002 SPACE 76300002 LR R7,R13 SAVE @Y02753 76350002 BAL R14,UNCHAIN TAKE TCB OFF QUEUE @Y02753 76400002 LR R13,R7 RESTORE @Y02753 76450002 SPACE 76500002 */* CHAP8590: R RETURN TO CALLER */ 76560002 SPACE 76620002 CHAP8590 EQU * * 76680002 LM R14,R7,SVREG14-SAVEAREA(R13) RESTORE REGS @Y02753 76740002 LM R9,R12,SVREG9-SAVEAREA(R13) RESTORE REGS @Y02753 76800002 LH R15,WKCHKRCD RETURN CODE @Y02753 76870002 BR R14 RETURN @Y02753 76940002 SPACE 2 77010002 */* TCBCHECK: END FLOWCHART */ 77100002 EJECT 77160002 */* RECERROR: CHART */ 77220002 */* FOOTING 77280002 */* ERROR RECORDING SUBROUTINE */ 77340002 SPACE 2 77400002 *********************************************************************** 77460002 * * 77520002 * SUBROUTINE RECERROR SETS UP AN ENTRY FOR RECORDING EITHER AN * 77580002 * INVALID TCBLTC FIELD OR INVALID TCBNTC FIELD. EACH ENTRY CONSISTS * 77640002 * OF AN IDENTIFIER WORD CONTAINING C'NTC ' OR C'LTC ', THE ADDRESS * 77700002 * OF THE TCB CONTAINING THE INVALID FIELD, THE INVALID FIELD CONTENTS * 77760002 * AND THE REPLACEMENT ADDRESS. EACH OF THESE ADDRESSES IS A FULLWORD, * 77820002 * SO THAT EACH ENTRY IS 4 WORDS. * 77880002 * * 77940002 * SUBROUTINES CALLED: RECMOVE * 78000002 * * 78060002 * SYSTEM ROUTINES CALLED / MACROS ISSUED: NONE * 78120002 * * 78180002 * RETURN CODES SET: NONE * 78240002 * * 78300002 * REGISTER USAGE: * 78360002 * 4 - INPUT, ADDRESS OF IDENTIFIER WORD, DESTROYED * 78420002 * 5 - DESTROYED * 78480002 * 7 - INVALID FIELD CONTENTS * 78540002 * 8 - REPLACEMENT FIELD CONTENTS * 78600002 * 10 - ADDRESS OF TCB HAVING INVALID FIELD * 78660002 * 14 - RETURN ADDRESS * 78720002 * 15 - DESTROYED * 78780002 * * 78840002 *********************************************************************** 78900002 SPACE 2 78950002 */* E ENTER RECERROR */ 79000002 SPACE 79050002 RECERROR EQU * * 79100002 ST R4,WKWORD1 SET IDENTIFIER IN ENTRY @Y02753 79150002 SPACE 79200002 */* D (NO,CHAP8700,YES,) IS THERE A DESCRIPTOR WORD */ 79260002 SPACE 79320002 ICM R4,B'1111',WKOUTDP PTR TO DESCRIPTOR WORD @Y02753 79380002 BZ CHAP8700 NO DESCRIPTOR, EXIT @Y02753 79440002 SPACE 79500002 */* P INCREMENT COUNT OF ERRORS DETECTED */ 79560002 SPACE 79620002 SR R5,R5 CLEAR @Y02753 79680002 IC R5,C2(,R4) COUNT OF ERRORS DETECTED @Y02753 79740002 LA R5,C1(,R5) INCREMENT BY ONE @Y02753 79800002 STC R5,C2(,R4) INTO DESCRIPTOR @Y02753 79870002 STM R4,R5,WKTEMP1 SAVE COUNT AND ADDRESS @Y02753 79940002 SPACE 80010002 */* D (YES,CHAP8700,NO,) HAS OVERFLOW OCCURRED */ 80100002 SPACE 80160002 TM WKFLAGS,WKOVERF IS OUTPUT AREA FULL @Y02753 80220002 BO CHAP8700 YES, GO EXIT SUBROUTINE @Y02753 80280002 SPACE 80340002 */* S RECMOVE: MOVE ENTRY TO OUTPUT DATA AREA */ 80400002 SPACE 80450002 LR R15,R14 SAVE RETURN ADDRESS @Y02753 80500002 ST R10,WKWORD2 ADDRESS OF ERROR TCB @Y02753 80550002 STM R7,R8,WKWORD3 OLD, NEW FIELD CONTENTS @Y02753 80600002 LA R4,WKWORD1 ADDRESS OF ENTRY @Y02753 80650002 LA R5,C16 LENGTH OF ENTRY @Y02753 80700002 BAL R14,RECMOVE MOVE ENTRY TO DATA AREA @Y02753 80770002 LR R14,R15 RESTORE @Y02753 80840002 LM R4,R5,WKTEMP1 RESTORE @Y02753 80910002 SPACE 81000002 */* D (NO,CHAP8720,YES,) WAS MOVE SUCCESSFUL */ 81060002 SPACE 81120002 TM WKFLAGS,WKOVERF DID OVERFLOW OCCUR @Y02753 81180002 BO CHAP8720 SET INDICATOR IN OUTPUT @Y02753 81240002 SPACE 81300002 */* P (,CHAP8700) INCREMENT COUNT OF ERRORS RECORDED */ 81360002 SPACE 81420002 STC R5,C1(,R4) UPDATE COUNT @Y02753 81480002 B CHAP8700 GO EXIT SUBROUTINE @Y02753 81540002 SPACE 81600002 */* CHAP8720: P SET OVERFLOW INDICATOR IN OUTPUT DATA AREA */ 81660002 SPACE 81720002 CHAP8720 EQU * * 81780002 OI 0(R4),WKOVERF BIT0=1 FOR OVERFLOW @Y02753 81840002 SPACE 81900002 */* CHAP8700: R () RETURN */ 81960002 SPACE 82020002 CHAP8700 EQU * * 82080002 BR R14 RETURN @Y02753 82140002 SPACE 2 82200002 */* RECERROR: END FLOWCHART */ 82260002 EJECT 82320002 */* HDSETUP: CHART */ 82380002 */* FOOTING 82440002 */* SUBROUTINE MOVES HEADER AND DESCRIPTOR WORD INTO OUTPUT AREA */ 82500002 SPACE 2 82560002 *********************************************************************** 82620002 * * 82680002 * SUBROUTINE HDSETUP MOVES THE OUTPUT HEADER AND DESCRIPTOR WORD * 82740002 * INTO THE OUTPUT DATA AREA FOR RECORDING, PROVIDED THERE IS ROOM. * 82800002 * IF THE MOVE IS MADE, WORKAREA FIELD WKOUTDP IS SET TO THE ADDRESS * 82860002 * OF THE DESCRIPTOR WORD; OTHERWISE, WKOUTDP IS LEFT ZERO. * 82920002 * * 82980002 * SUBROUTINES CALLED: RECMOVE * 83040002 * * 83100002 * RETURN CODES SET: NONE * 83160002 * * 83220002 * REGISTER USAGE: * 83280002 * R4, R5, R7, R10 - DESTROYED * 83340002 * * 83400002 *********************************************************************** 83450002 SPACE 2 83500002 */* E ENTER HDSETUP */ 83550002 SPACE 83600002 HDSETUP EQU * * 83650002 LR R10,R14 SAVE RETURN ADDRESS @Y02753 83700002 LA R4,CHAPR2ID ADDRESS OF HEADER @Y02753 83750002 LA R5,C12 LNG OF HEADER+DESCRIPTOR @Y02753 83800002 SR R7,R7 CLEAR @Y02753 83850002 IC R7,SDWAURAL-SDWA(,R1) SAVE OFFSET @Y02753 83900002 SPACE 84000002 */* S RECMOVE: MOVE HEADER DESCRIPTOR */ 84070002 SPACE 84140002 BAL R14,RECMOVE MOVE HEADER, DESCRIPTOR @Y02753 84210002 SPACE 84300002 */* D (NO,CHAP8170,YES,) WAS DESCRIPTOR MOVED */ 84360002 SPACE 84420002 TM WKFLAGS,WKOVERF DID OVERFLOW OCCUR @Y02753 84480002 BO CHAP8170 LEAVE DESCRIPTOR PTR 0 @Y02753 84540002 SPACE 84600002 */* P SAVE ADDRESS OF DESCRIPTOR WORD */ 84660002 SPACE 84720002 LA R5,SDWAVRA-SDWA+C8(R7,R1) ADDR DESCRIPTOR WORD @Y02753 84780002 ST R5,WKOUTDP INTO WORKAREA @Y02753 84840002 SPACE 84900002 */* CHAP8170: R () RETURN */ 84950002 SPACE 85000002 CHAP8170 EQU * * 85050002 LR R14,R10 RESTORE RETURN ADDRESS @Y02753 85100002 BR R14 RETURN @Y02753 85150002 SPACE 85200002 */* HDSETUP: END FLOWCHART */ 85270002 EJECT 85340002 */* RECMOVE: CHART */ 85410002 */* FOOTING 85500002 */* SUBROUTINE MOVES ERROR INFORMATION INTO OUTPUT DATA AREA */ 85560002 SPACE 2 85620002 *********************************************************************** 85680002 * * 85740002 * SUBROUTINE RECMOVE MOVES AN ERROR ENTRY INTO THE ERROR RECORDING * 85800002 * OUTPUT DATA AREA, UPDATING THE OFFSET IN THE DATA AREA HEADER. AN * 85860002 * INDICATOR, WKOVERF IN WKFLAGS, IS SET IF THE ENTRY WILL NOT FIT. * 85920002 * * 85980002 * SUBROUTINES CALLED: NONE * 86040002 * * 86100002 * RETURN CODES SET: NONE * 86160002 * * 86220002 * REGISTER USAGE: * 86280002 * * 86340002 * 4 - ADDRESS OF THE ERROR ENTRY * 86400002 * 5 - LENGTH OF THE ERROR ENTRY * 86410002 * 13 - SAVE AREA ADDRESS * 86500002 * 14 - RETURN ADDRESS * 86550002 * ALL REGISTERS RESTORED ON RETURN * 86620002 * * 86700002 *********************************************************************** 86702002 SPACE 2 86800002 */* E ENTER RECMOVE */ 86850002 SPACE 86900002 RECMOVE EQU * * 86950002 STM R14,R12,SVREG14-SAVEAREA(R13) SAVE REGISTERS @Y02753 87049902 SPACE 87069902 */* D (YES,CHAP8810,NO,) WILL DATA FIT INTO RECORDING AREA */ 87149802 SPACE 87189802 SR R7,R7 CLEAR 87243102 IC R7,SDWAURAL-SDWA(,R1) OFFSET TO AVAILABLE AREA @Y02753 87302002 LA R8,0(R5,R7) NEW OFFSET @Y02753 87367002 CH R8,SDWAVRAL-SDWA(,R1) NEW OFFSET WITHIN AREA @Y02753 87450002 BNH CHAP8810 YES, CONTINUE @Y02753 87480002 SPACE 87543202 */* P (,CHAP8800) SET RECORDING OVERFLOW INDICATOR */ 87605802 SPACE 87665802 OI WKFLAGS,WKOVERF FLAG NO MORE RECORDING @Y02753 87721802 B CHAP8800 GO EXIT SUBROUTINE @Y02753 87780302 SPACE 87840002 */* CHAP8810: P MOVE ERROR INFORMATION INTO RECORDING AREA */ 87901402 SPACE 87960502 CHAP8810 EQU * * 88021402 STC R8,SDWAURAL-SDWA(,R1) SAVE NEW OFFSET @Y02753 88080102 LA R8,SDWAVRA-SDWA(R7,R1) ADDR OF AVAILABLE SPACE @Y02753 88140602 BCTR R5,R0 ENTRY LENGTH LESS ONE @Y02753 88200102 EX R5,CHAPMVC MOVE ENTRY @Y02753 88266602 SPACE 88320202 */* CHAP8800: R () RETURN */ 88406902 SPACE 88441002 CHAP8800 EQU * * 88520002 LM R14,R12,SVREG14-SAVEAREA(R13) RESTORE REGISTERS @Y02753 88574602 BR R14 RETURN @Y02753 88627802 DROP R3 WORKAREA NO LONGER USED @Y02753 88681802 SPACE 2 88741802 */* RECMOVE: END FLOWCHART */ 88809002 TITLE 'IEAVECH0 - CHAP SVC - ENTRY POINT IGC044' 88860402 *********************************************************************** 88921702 * * 88980602 * CONSTANTS * 89100002 * * 89160002 *********************************************************************** 89220002 SPACE 3 89280002 CHAP044E DC A(IGC044) SVC ENTRY POINT ADDRESS 89340002 CHAPQV3 DC V(IEAVEQV3) QUEUE VERIFIER ENTRY POINT ADDR 89400002 CHAPTVER DC V(IEAVETCB) TCB CONTROL BLOCK VERIFIER 89460002 CHAPAVER DC V(IEAVECAS) CURRENT ASCB VERIFIER 89520002 CHAPLTC DS 0F FULLWORD ALIGNMENT 89580002 DC CL4'LTC' IDENTIFIER FOR TCBLTC FIELD 89640002 CHAPNTC DS 0F FULLWORD ALIGNMENT 89700002 DC CL4'NTC' IDENTIFIER FOR TCBNTC FIELD 89760002 CHAPR2ID DS 0F 12 BYTE ENTRY 89820002 DC CL8'IGC044R2' TCB QUEUE VALIDATION RTN ID 89880002 DC F'0' DESCRIPTOR WORD 89940002 CHAPQVID DC CL8'IEAVEQV3' QUEUE VERIFIER ID 90000002 CHAPMVC MVC 0(0,R8),0(R4) EXECUTE TARGET, MOVES ENTRY 90060002 CHAP22C DC X'22C000' COMPLETION CODE, INVALID PARM 90120002 CHAPSLNG DC FL1'24' LENGTH OF TITLE FOR SVC DUMP 90180002 CHAPFRR DS 0CL24 RECORD PARAMETER LIST 90240002 DC CL8'IEAVECH0' MODULE NAME 90300002 DC CL8'IGC044' CSECT NAME 90360002 DC CL8'IGC044R1' FRR ID 90420002 CHAPSDMP SDUMP SDATA=(SQA,LSQA,TRT),MF=L SVC DUMP FOR RECOVERY 90480002 SDUMPLNG EQU *-CHAPSDMP LENGTH OF MACRO LIST FORM 90540002 EJECT 90600002 *********************************************************************** 90660002 * * 90720002 * MAPPING MACROS * 90780002 * * 90840002 *********************************************************************** 90900002 SPACE 4 90960002 CVT DSECT=YES 91020002 EJECT 91080002 IHASCVT DSECT=YES,LIST=YES 91140002 EJECT 91200002 IHAASCB 91260002 EJECT 91320002 IHAASXB 91380002 EJECT 91440002 IHAPSA 91500002 EJECT 91560002 IHAFRRS 91620002 EJECT 91680002 IKJTCB LIST=YES 91740002 EJECT 91800002 IHARB 91850002 EJECT 91900002 IHASDWA 91950002 EJECT 92000002 IHAQVPL 92100002 EJECT 92160002 *********************************************************************** 92220002 * * 92280002 * FRR TCB QUEUE ROUTINE WORKAREA * 92340002 * * 92400002 *********************************************************************** 92460002 SPACE 3 92520002 WKAREA DSECT WORKAREA FOR IGC044R2 92580002 WKRETAD DS A RETURN ADDRESS FROM IGC044R2 92640002 WKFAMPTR DS A FAMILY PTR USED IN TCBCHECK 92700002 WKOUTDP DS A ADDRESS OF OUTPUT DESCRIPTOR 92750002 WKWORD1 DS F ERROR ENTRY WORD 92800002 WKWORD2 DS F ERROR ENTRY WORD 92850002 WKWORD3 DS F ERROR ENTRY WORD 92900002 WKWORD4 DS F ERROR ENTRY WORD 92950002 WKTEMP1 DS F TEMPORARY SAVE WORD 93005102 WKTEMP2 DS F TEMPORARY SAVE WORD 93069902 WKCHKRCD DS H RETURN CODE FROM TCBCHECK 93149802 WKFLAGS DS C FLAGS 93189802 WKOVERF EQU X'80' 1 - OVERFLOW HAS OCCURRED 93300002 * 0 - NO OVERFLOW YET 93400002 * BITS 1-7 RESERVED 93500002 WKLENGTH EQU ((*-WKAREA+3)/4)*4 LENGTH OF WORKAREA 93600002 SPACE 4 93700002 *********************************************************************** 93800002 * * 93900002 * SAVE AREA * 94000002 * * 94100002 *********************************************************************** 94200002 SPACE 3 94300002 SAVEAREA DSECT MAPPING OF STANDARD SAVE AREA 94400002 SVWORD1 DS A NOT USED 94500002 SVPREVA DS A ADDRESS OF PREVIOUS SAVE AREA 94600002 SVNEXTA DS A ADDRESS OF NEXT SAVE AREA 94700002 SVREG14 DS A REGISTER 14 94800002 SVREG15 DS A REGISTER 15 94900002 SVREG0 DS A REGISTER 0 95000002 SVREG1 DS A REGISTER 1 95100002 SVREG2 DS A REGISTER 2 95200002 SVREG3 DS A REGISTER 3 95300002 SVREG4 DS A REGISTER 4 95400002 SVREG5 DS A REGISTER 5 95500002 SVREG6 DS A REGISTER 6 95600002 SVREG7 DS A REGISTER 7 95700002 SVREG8 DS A REGISTER 8 95800002 SVREG9 DS A REGISTER 9 95900002 SVREG10 DS A REGISTER 10 96000002 SVREG11 DS A REGISTER 11 96100002 SVREG12 DS A REGISTER 12 96200002 EJECT 96300002 *********************************************************************** 96400002 * * 96500002 * FRR SIX-WORD WORKAREA * 96600002 * * 96700002 *********************************************************************** 96800002 SPACE 3 96900002 CHAPXA DSECT WORKAREA OBTAINED BY SETFRR 97000002 CHAPX1 DS A WORD 1 97100002 CHAPX2 DS F WORD 2 97200002 CHAPX3 DS F WORD 3 97300002 CHAPX4 DS F WORD 4 97400002 CHAPX5 DS F WORD 5 97500002 CHAPX6 DS F WORD 6 97600002 SPACE 4 97700002 END 97800002