TITLE 'IKJEGSTA' 00100002 * /* START OF SPECIFICATIONS **** 00150002 *02* PROCESSOR = ASSEMBLER 00160002 **** END OF SPECIFICATIONS ***/ 00170002 COPY IKJEGSIO 00180002 *c177600 @ZA00918 00190003 *C173000,266220 @ZA04792 00192003 *C001690-001700 @ZA07737 00194003 ******************************************************************** 00200002 * * 00300002 * STATUS * 00400002 * CHANGE LEVEL 000, VERSION 01, OS/VS2 * 00500002 * * 00600002 * FUNCTION/OPERATION * 00700002 * THIS ROUTINE IS GIVEN CONTROL WHEN AN ABEND SITUATION OCCURS * 00800002 * IN ANY OF THE TEST COMMAND MODULES. UNLESS THE 'NO MESSAGES' * 00900002 * OPTION IS REQUESTED, IT WILL INITIALIZE TO PRINT A STANDARD * 01000002 * 1ST AND 2ND LEVEL MESSAGE. THE 1ST LEVEL MESSAGE WILL HAVE * 01100002 * THE NAME OF THE ABENDING COMMAND MODULE INSERTED. THE SECOND * 01200002 * LEVEL MSG WILL HAVE AN APPROPRIATE ERROR DESCRIPTION APPENDED.* 01300002 * OBTAINS ADDRESS OF APPROPRIATE RETRY ROUTINE FROM THE ESTAE * 01500002 * PARAMETER LIST WHICH IS MADE AVAILABLE VIA THE 'LIST' KEYWORD * 01550002 * OF THE ESTAE MACRO, AND PASSES THE ADDRESS BACK TO THE * 01560002 * ABEND/STAE INTERFACE ROUTINE. * 01600002 * ENTRY POINTS * 01800002 * IKJEGSTA * 01900002 * * 02000002 * INPUT * 02100002 * * 02200002 * OUTPUT * 02300002 * 1. ERROR MESSAGES TO THE MESSAGE WRITER * 02400002 * 2. RETURN CODE - R15 * 02500002 * * 0 TO INDICATE THAT ABEND PROCESSING SHOULD * 02600002 * * CONTINUE. (THIS RETURN CODE RESULTS WHEN * 02700002 * * EITHER TCOMTAB WAS FREED PRIOR TO ENTRY * 02800002 * * TO THIS ROUTINE OR AN ERROR WAS ENCOUNT- * 02900002 * * ERED BY IKJEGIO1 WHEN CALLED TO WRITE * 03000002 * * OUT MESSAGES.) * 03100002 * * 4 TO INDICATE THAT CONTROL IS TO BE GIVEN * 03200002 * * TO A RETRY ROUTINE. * 03300002 * 3. R0 = ADDRESS OF RETRY ROUTINE 03400002 * * 03500002 * EXTERNAL REFERENCES * 03600002 * IKJEGIO - OUTPUTS ERROR MESSAGES. INVOKED BY THE * 03700002 * * IKJEGSIO MACRO. * 03800002 * IKJEGSCD - USED IN SEARCH FOR NAME OF ABENDING MODULE. * 03900002 * * 04100002 * EXITS,NORMAL * 04200002 * RETURN VIA REGISTER 14 TO THE CALLER * 04300002 * * 04400002 * EXITS,ERROR * 04500002 * RETURN VIA REGISTER 14 TO THE CALLER * 04600002 * * 04700002 * TABLES/WORK AREAS * 04800002 * TCOMTAB * 04900002 * STAWORK - STAE WORK AREA * 05000002 * * 05100002 * ATTRIBUTES * 05200002 * REENTRANT * 05300002 * * 05400002 * CHARACTER CODE DEPENDENCY * 05500002 * THE OPERATION OF THIS MODULE DEPENDS UPON AN INTERNAL * 05600002 * REPRESENTATION OF THE EXTERNAL CHARACTER SET WHICH IS * 05700002 * EQUIVALENT TO THE ONE USED AT ASSEMBLY TIME. THE CODING HAS * 05800002 * BEEN ARRANGED SO THAT REDEFINITION OF 'CHARACTER' CONSTANTS, * 05900002 * BY REASSEMBLY, WILL RESULT IN A CORRECT MODULE FOR THE NEW * 06000002 * DEFINITIONS. * 06100002 * * 06200002 * NOTES * 06300002 * 1. AT ENTRY, THE REGISTER CONTENTS WILL BE - * 06400002 * * 1A. IF A 512-BYTE WORKAREA IS AVAILABLE... * 06500002 * * REG0 = 0 ACTIVE I/O WAS QUISCED AND IS RESTORABLE * 06600002 * * 4 ACTIVE I/O WAS HALTED AND IS NOT RESTORABLE * 06700002 * * 8 NO I/O WAS ACTIVE * 06800002 * * * 06900002 * * REG1 = PTR TO 512 BYTE WORK AREA * 07000002 * * REGS 2-12 = UNPREDICTABLE * 07100002 * * REG13 = ADDR OF A REG SAVE AREA * 07200002 * * REG14 = RETURN ADDR * 07300002 * * REG15 = ADDR OF STAE EXIT ROUTINE * 07400002 * * 07500002 * * 1B. IF STORAGE FOR THE 512-BYTE WORKAREA WAS NOT AVAILABLE..* 07600002 * * REG0 = 12 * 07700002 * * REG1 = ABEND COMPLETION CODE * 07800002 * * REG2 = PTR TO STAE EXIT PARAM LIST * 07900002 * * REGS 3-12 = SAME AS ABOVE * 08000002 * * REG13 = UNPREDICTABLE * 08100002 * * REGS 14-15 = SAME AS ABOVE * 08200002 * * 08300002 * 2. AT EXIT, THE REGISTER CONTENTS WILL BE - * 08400002 * * 08500002 * * REG0 = ADDRESS OF RETRY ROUTINE * 08600002 * * REG1 = ADDR OF WORK AREA OR ZERO IF NOT AVAILABLE * 08700002 * * REGS 2-12 = UNPREDICTABLE * 08800002 * * REGS 13-14 = SAME AS AT ENTRY * 08900002 * * REG15= RETURN CODE OF 4 * 09000002 * 3. PLM = SY35-0004 * 09050002 * * TSO COMMAND PROCESSOR LOGIC * 09060002 * * VOLUME III - TEST * 09070002 * * 09100002 ******************************************************************** 09200002 * CHANGE ACTIVITY: * 09220003 * @AZ17298 - REMOVED JOB STEP DEPENDENCY FOR TEST. * 09240003 ******************************************************************** 09260003 EJECT 09300002 IKJEGSTA CSECT 09400002 ****************************************************************** 09500002 * 09600002 * REGISTER EQUATES 09700002 * 09800002 R0 EQU 0 REFLECTS STATUS OF TASK/WORKAREA 09900002 R1 EQU 1 COMPLETION CODE / WORKAREA PTR 10000002 R2 EQU 2 PTR TO PARM LIST 10100002 R3 EQU 3 WORK REG 10200002 R4 EQU 4 * 10300002 R5 EQU 5 * 10400002 R6 EQU 6 * 10500002 R7 EQU 7 * 10600002 R8 EQU 8 * 10700002 R9 EQU 9 TCOMTAB BASE REG 10800002 R10 EQU 10 STA WORKAREA BASE 10900002 R11 EQU 11 MODULE BASE REG 11000002 R13 EQU 13 SAVE AREA PTR 11100002 R12 EQU 12 NOT USED 11200002 R14 EQU 14 RETURN ADDR 11300002 R15 EQU 15 STAE ADDR 11400002 * 11500002 ****************************************************************** 11600002 SPACE 2 11700002 ****************************************************************** 11800002 * 11900002 * SYMBOL AND NUMBER EQUATES 12000002 * 12100002 ZERO EQU 0 NO. 0 12200002 ONE EQU 1 NO. 1 12300002 TWO EQU 2 NO. 2 12400002 THREE EQU 3 NO. 3 12500002 FOUR EQU 4 NO. 4 12600002 TCBADDR EQU 4 DISPLACEMENT FOR TEST'S TCB ADDR 12700002 FIVE EQU 5 NO. 5 12800002 SIX EQU 6 NO. 6 12900002 SEVEN EQU 7 NO. 7 13000002 EIGHT EQU 8 NO. 8 (DISPL FOR 1ST LEVEL MSG) 13100002 NINE EQU 9 NO. 9 13200002 TEN EQU 10 NO. 10 13300002 TWELVE EQU 12 NO. 12 13400002 THIRTN EQU 13 NO. 13 13500002 N15 EQU 15 NO. 15 13600002 SIXTEEN EQU 16 CVT DISPL 13700002 TWENTY2 EQU 22 NO. 22 13800002 TWENTY4 EQU 24 NO. 24 13850002 TWENTY9 EQU 29 NO. 29 13860002 THIRTY5 EQU 35 NO. 35 13900002 THIRTY7 EQU 37 NO. 37 14000002 THIRTY8 EQU 38 NO. 38 14100002 FORTY4 EQU 44 NO. 44 14200002 FORTY5 EQU 45 NO. 45 14250002 FIFTY3 EQU 53 NO. 53 14300002 SIXTY9 EQU 69 NO. 69 14400002 EIGHTY1 EQU 81 NO. 81 14500002 NINETY3 EQU 93 NO. 93 14600002 NINETY5 EQU 95 NO. 95 14700002 HEX00 EQU X'00' 'NO MESSAGE' CODE 14800002 HEX07 EQU 7 NO. 7 14900002 BLANK EQU X'40' BLANK 15000002 HEX80 EQU X'80' NO. 80 15050002 RBOK EQU X'C0' INDICATES A PRB 15100002 HEXF0 EQU X'F0' MASK TO SET SIGN BYTE 15200002 HEXFF EQU X'FF' MASK BYTE FOR ABEND COMPL CODE 15300002 * 15400002 ****************************************************************** 15500002 EJECT 15600002 * START OF MODULE CODE 15700002 * 15800002 LR R11,R15 SET UP MODULE ADDRESSABILITY 15900002 USING IKJEGSTA,R11 16000002 SPACE 16100002 L R8,CVTPTR ADDR OF CVT 16200002 USING CVTDSECT,R8 ADDRESSABILITY TO CVT 16300002 L R8,CVTTCBP PTR TO TCB ADDR 16400002 DROP R8 16500002 L R8,TCBADDR(ZERO,R8) TCB ADDR 16600002 SPACE 16700002 USING TCB,R8 ADDRESSABILITY TO TCB 16800002 * L R4,TCBJSTCB GET JOB STEP TCB ADDR @ZA06995 16810003 * DELETED @ZA17298 16820003 * DROP R8 DELETED @ZA17298 16826003 * USING TCB,R4 DELETED @ZA17298 16840003 SLR R9,R9 TCBTRN FIELD OF TEST'S TCB @ZA07737 16900003 ICM R9,HEX07,TCBTRN+1 CONTAINS PTR TO TCOMTAB @ZA07737 16950003 * DROP R4 DELETED @ZA17298 16970003 * USING TCB,R8 DELETED @ZA17298 17000003 SPACE 17100002 *********************************************************************** 17150002 * CHECK TO DETERMINE IF THE TCOMTAB HAS BEEN FREED. IF SO, ISSUE * 17152002 * THE 'SETRP' MACRO AND PERCOLATE. * 17154002 *********************************************************************** 17160002 LTR R9,R9 CHECK IF TCOMTAB HAS BEEN FREED 17200002 BZ OOPS IF SO, RECORD IN LOGREC AND RETURN 17250003 * @ZA04792 17300003 SPACE 17400002 USING TCOMTAB,R9 ADDRESSABILITY TO COMMUNICATION AREA 17500002 * 17600002 SPACE 17700002 LR R4,R0 SAVE R0 ZXCZXCZX 17710002 LR R3,R1 SAVE R1 ZXCZXCZX 17720002 L R0,SAVELNGH R0 = SAVE AREA LENGTH ZXCZXCZX 17750002 GETMAIN RU,LV=(0),SP=78 GETMAIN FOR NEW SAVEAREA CHAIN. 17760003 L R10,WORKAREA ADDRESS OF COMMON WORK AREA 17800002 USING TSTCWORK,R10 ESTABLISH ADDRESSABILITY 17900002 SPACE 18000002 LA R10,CWORKSTA R10 = ADDR OF STAE'S WORK AREA 18100002 DROP R10 18200002 SPACE 18300002 USING STAWORK,R10 ESTABLISH ADDRESSABILITY 18400002 MVC FLAGS4(ONE),TSTFLGS4 PRESERVE TSTFLGS4 UNTIL EXIT 18410002 NI TSTFLGS4,HEXFF-TSTVALCK TURN OFF VALIDITY CK INDICATOR 18420002 ST R8,TCBPTR SAVE TCB ADDRESS 18450002 SPACE 18500002 STM R13,R14,REGSAV SAVE REGS 13 AND 14 18800002 LR R13,R1 R13=ADDR NEW SAVEAREA CHAIN ZXCZXCZX 18800402 LR R1,R3 RESTORE R1 TO RTCA ZXCZXCZX 18800802 LR R0,R4 RESTORE R0 ZXCZXCZX 18801202 L R3,ECBTST GET PTR TO TEST DESPATCHABILITY ECB 18802002 TM ZERO(R3),HEX80 IS SVC 97 OR 61 ACTIVE 18804002 BZ CKRETRY NO - GO CHECK FOR RETRY FAILURE 18806002 OI FLAGS,SVCFAIL INDICATE SVC 97 OR 61 FAILURE 18808002 SPACE 18810002 *********************************************************************** 18820002 * CHECK TO DETERMINE IF RETRY WAS IN PROCESS OR IF I/O WAS TRYING TO 18822002 * SERVICE AN ESTAE REQUEST WHEN THE ABEND OCCURRED 18824002 *********************************************************************** 18830002 CKRETRY DS 0H 18832002 TM TSTFLGS4,TSTRERTN WAS A RETRY IN PROCESS 18840002 BNZ DETERMN IF SO, TURN OFF FLAGS AND PERCOLATE 18842002 SPACE 18848002 *********************************************************************** 18848402 * DETERMINE IF THE SYSTEM SUCCEEDED IN ESTABLISHING THE RTCA 18848502 * (RECOVERY TERMINATION COMMUNICATION AREA) 18848602 *********************************************************************** 18848802 LA R3,TWELVE GET DECIMAL TWELVE 18850002 CR R0,R3 DO WE HAVE HAVE THE RTCA 18860002 BE FINDRB NO - WE MUST GET INFORMATION ELSEWHR 18880002 B HAVRTCA YES 18890002 SPACE 2 18900002 *********************************************************************** 18948902 * DETERMINE IF THE RTCA IS AVAILABLE FOR RECORDING 18958902 * IF THERE IS NO RTCA, THERE CAN BE NO RECORDING 18960902 *********************************************************************** 18968902 NOTCOMTB DS 0H 18970902 DETERMN DS 0H 18972902 LA R3,TWELVE GET DECIMAL TWELVE 18978902 CR R0,R3 DO WE HAVE HAVE THE RTCA 18988902 BE PERCOLA1 NO, GO SKIP RECORDING AND PERCOLATE 18990902 B PERCOLAT OTHERWISE, RECORD AND PERCOLATE 19045702 EJECT 19063802 ***************************************************************** 19081902 * * 19100002 * THE OPSW ENTRY IN THE HIGHEST RB ON THE CHAIN, AFTER * 19200002 * THE FIRST SVRB/SIRB, WILL CONTAIN THE ABENDING * 19300002 * MODULE'S PSW IC. (IF THIS RB IS ASSOCIATED WITH A * 19400002 * MODULE THAT IS BEING FETCHED, THE NEXT LOWER RB WILL * 19500002 * BE USED). THIS IC WILL BE COMPARED WITH THE IC TABLE * 19600002 * OF THE LAST MODULE TO ISSUE THE STAE MACRO. A POINTER * 19700002 * TO THIS TABLE IS FOUND IN TCOMTAB AT THE ABENTAB OR * 19800002 * ABENTAB1 ENTRIES. * 19900002 * * 20000002 ***************************************************************** 20100002 SPACE 2 20200002 FINDRB DS 0H 20300002 NI FLAGS,RTCAN INDICATE THAT RTCA DOES NOT EXIST 20300102 ST R2,PARMLST@ SAVE PARAM LIST ADDRESS 20300402 DROP R8 20302002 LR R2,R8 GET TCB ADDRESS 20304002 USING TCB,R2 RESTABLISH ADDRESSABILITY TO TCB 20310002 L R3,TCBRBP GET PTR TO FIRST RB 20350002 USING RBSECT,R3 SET UP ADDRESSABILITY 20400002 ST R3,SVRB@ SAVE LAST SVRB ADDRESS 20450002 SPACE 20500002 SVRBCHK TM RBSTAB1,RBFTSIRB IS THIS AN SVRB/SIRB 20600002 BO RBCHK YES...GO FIND FIRST RB 20700002 ST R3,SVRB@ SAVE LAST SVRB ADDRESS 20750002 SPACE 20800002 L R3,RBLINK CHECK AGAIN 20900002 B SVRBCHK CHECK AGAIN 21000002 SPACE 21100002 RBCHK TM RBSTAB1,RBFTP IS RB A PRB 21200002 BZ GETIC YES... 21300002 ST R3,SVRB@ SAVE LAST SVRB ADDRESS 21350002 L R3,RBLINK GET PTR TO NEXT RB 21400002 B RBCHK CHECK AGAIN 21500002 SPACE 21600002 GETIC EQU * 21700002 TM FLAGS,SVCFAIL ARE WE PROCESSING AN SVC ABEND 21770002 BZ GETCDE NO - GO GET CDE POINTER 21770402 L R3,SVRB@ GET SVRB ADDRESS 21772002 B GETAPSW GO GET PSW 21774002 GETCDE DS 0H 21780002 L R4,RBCDE GET CDE ADDR 21800002 LTR R4,R4 IS IT ZERO 21900002 BZ NEXTRB YES...USE NEXT RB 22000002 SPACE 22100002 USING CDENTRY,R4 ESTABLISH ADDRESSABILITY TO CDE 22150002 TM CDATTR,BLANK CHECK FOR 'HEX 40'--MODULE IS 22200002 * BEING FETCHED 22300002 BZ GETAPSW NO...USE THIS RB 22400002 DROP R4 RELEASE CDE BASE REGISTER 22450002 SPACE 22500002 NEXTRB L R3,RBLINK GET NEXT LOWER RB 22600002 SPACE 22700002 * R3 CONTAINS THE CORRECT RB ADDRESS 22800002 GETAPSW LA R4,RBABOPSW GET APSW LOCATION OF RB 22900002 L R5,ZERO(ZERO,R4) GET APSW ITSELF 23000002 LTR R5,R5 IS IT ZERO 23100002 BNZ USEAPSW NO...APSW = OPSW 23200002 SPACE 23300002 LA R4,RBOPSW+FOUR USE RIGHT HALF OF ABENDING 23400002 * MODULE'S PSW 23500002 DROP R3 23600002 USEAPSW LA R3,0(ZERO,R4) PTR TO IC 23700002 SPACE 23800002 SPACE 23900002 BAL R14,INSERT BUILD FIRST LEVEL MESSAGE 24000002 SPACE 24010002 L R5,PARMLST@ GET PARAM LIST ADDRESS 24050002 L R5,ABENTAB@-LIST(R5) GET ADDRESS OF ABEND TABLE 24060002 LTR R5,R5 IS ABENTAB1 = 0 (IF SO, THERE 24300002 * IS NO COMMAND MODULE IN CORE) 24400002 BZ SRCHABTB SET UP TO SEARCH ABENTAB 24500002 SPACE 24600002 BAL R14,SEARCH SEARCH IC'S OF USER'S ABEND TABLE 24700002 SPACE 24800002 SRCHABTB L R5,ABENTAB GET ADDR OF RESIDENT IC TABLE 24900002 SRCH2 DS 0H 24950002 BAL R14,SEARCH SEARCH IC'S OF ABENTAB 25000002 B MSGIO GO ISSUE MESSAGES 25050002 SPACE 6 25100002 *********************************************************************** 25150002 * GET INFORMATION FORM THE RTCA AS FOLLOWS: 25200002 * DETERMINE IF PERCOLATION HAS OCCURRED; 25250002 * GET PARAM LIST ADDRESS; 25252002 * GET ABEND INSTRUCTION COUNTER. 25260002 *********************************************************************** 25270002 HAVRTCA DS 0H 25280002 USING SDWA,R1 ESTABLISH ADDR TO RTCA(SDWA) 25290002 ST R1,RTCA@ SAVE ADDRESS OF THE RTCA 25290402 TM SDWAERRC,SDWAPERC IS THIS EXIT RTN BEING PERCOLATED TO 25290502 BZ INDICATE NO - GO INDICATE EXISTENCE OF RTCA 25290602 OI TSTFLGS4,TSTPERC INDICATE THAT PERCOLATION HAPPENED 25290702 * B RETURN GO ALLOW RETRY TO BE ATTEMPTED 25292002 INDICATE OI FLAGS,RTCA INDICATE THAT RTCA EXISTS 25294802 MVC PARMLST@(FOUR),SDWAPARM GET PARAM LIST ADDRESS 25295202 LA R4,SDWANXTA GET INSTRUCTION COUNTER POINTER 25348002 LA R3,ZERO(ZERO,R4) PTR TO IC 25398002 N R3,MASKUP POINT TO FULL WORD BOUNDARY 25408002 * 25448002 BAL R14,INSERT BUILD FIRST LEVEL MESSAGE 25498002 L R5,PARMLST@ GET PARAM LIST ADDRESS 25508002 CLC MODNAME-LIST(EIGHT,R5),SVC97 DID SVC 97 ABEND ZXCZXCZX 25518002 BE INDSVC YES SET SVC FLAG ZXCZXCZX 25520002 CLC MODNAME-LIST(EIGHT,R5),SVC61 DID SVC 61 ABEND ZXCZXCZX 25528002 BE INDSVC YES SET SVC FLAG ZXCZXCZX 25538002 CONTABND DS 0H CONTINUE ZXCZXCZX 25540002 L R5,ABENTAB@-LIST(R5) GET ADDRESS OF ABEND TABLE 25548002 LTR R5,R5 DID MODULE PROVIDE ABEND TABLE 25598002 BZ SRCHABTB IF NOT, SEARCH RESIDENT TABLE 25648002 B SRCH2 GO SEARCH MODULE ABEND TABLE 25648502 SPACE 25648902 INDSVC DS 0H SET SVCFLAG INDICATING SVCS FAILED 25649302 OI FLAGS,SVCFAIL SET THE FLAG ZXCZXCZX 25649702 B CONTABND CONTINUE ZXCZXCZX 25649802 EJECT 25650002 SPACE 6 25660002 RETURN EQU * RETURN FOR RETRY 25700002 MVC TSTFLGS4(ONE),FLAGS4 RESTORE TSTFLGS4 25710002 NI TSTFLGS4,HEXFF-TSTESTAE I/O FINISHED ESATE REQUEST 25750002 OI TSTFLGS4,TSTRERTN INDICATE RETRY BENIG ATTEMPTED 25760002 LA R15,FOUR INDICATE CONTROL TO BE GIVEN 25800002 * TO RETRY ROUTINE 25900002 L R1,PARMLST@ GET ADDR OF PARAM LIST 26000002 L R0,ZERO(R1) GET ADDR OF RETRY ROUTINE 26050002 L R1,RTCA@ GET ADDR OF 152-BYTE WORKAREA 26100002 LR R7,R13 SAVE ADDR OF CORE TO FREE @ZAZZZZZ 26150003 LM R13,R14,REGSAV RESTORE SAVE AND RETURN REGS 26300002 TM FLAGS,SVCFAIL DID THE SVCS FAIL. 26350002 BO NOSETRP YES DO NOT ISSUE SETRP ZXCZXCZX 26400002 SETRP RETADDR=(R0),RECORD=YES,FRESDWA=YES,RC=4 26450002 NOSETRP DS 0H RETURN. ZXCZXCZX 26452002 BAL R8,FREECORE GO FREE WORK AREA @ZAZZZZZ 26456003 BR R14 RETURN TO CALLER 26460002 SPACE 26500002 PERCOLAT EQU * 26600002 LR R7,R13 SAVE ADDR OF CORE TO FREE @ZAZZZZZ 26601003 LM R13,R14,REGSAV RESTORE SAVE AND RETURN REGS 26602002 BAL R8,FREECORE FREE WORK AREA @ZAZZZZZ 26606003 NI TSTFLGS4,HEXFF-TSTESTAE TURN OFF I/O SERVING ESTAE FLAG 26610002 NI TSTFLGS4,HEXFF-TSTRERTN TURN OFF RETRY IN PROCESS FLAG 26620002 OOPS LA R3,TWELVE GET DECIMAL TWELVE @ZA04792 26621003 CR R0,R3 DO WE HAVE HAVE THE RTCA 26624002 BE PERCOLA1 NO - WE MUST NOT ATTEMPT TO RECORD 26626002 SETRP RECORD=YES,RC=0 26630002 PERCOLA1 EQU * 26650002 SR R0,R0 SET RETRY ADDRESS TO 0 26700002 SR R15,R15 SET RETURN CODE TO 0 TO ALLOW 26750002 * ABEND TO CONTINUE (PERCOLATION) 26800002 BR R14 RETURN TO CALLER 26900002 EJECT 27000002 FREECORE EQU * 27005003 ******* 27010003 * FREE THE WORK AREA BEFORE EXITING @ZAZZZZZ 27015003 * R7 POINTS TO THE CORE TO FREE ON ENTRY @ZAZZZZZ 27020003 ******* 27025003 SPACE 3 27030003 LR R2,R0 SAVE REG 0 ACROSS THE FREEMAIN @ZAZZZZZ 27035003 LR R3,R1 SAVE R1 @ZAZZZZZ 27040003 LR R4,R15 SAVE R15 @ZAZZZZZ 27045003 L R0,SAVELNGH R0 = WORK AREA LENGTH @ZAZZZZZ 27050003 FREEMAIN RU,LV=(0),A=(7),SP=78 @ZAZZZZZ 27055003 LR R0,R2 RESTORE REG0 @ZAZZZZZ 27060003 LR R1,R3 RESTORE REG1 @ZAZZZZZ 27065003 LR R15,R4 RESTORE REG15 @ZAZZZZZ 27070003 BR R8 RETURN TO CALLER @ZAZZZZZ 27075003 EJECT 27080003 ********************************************************************** 27100002 * * 27150002 ***** CONSTRUCT INSERT FOR FIRST LEVEL MESSAGE **** 27200002 * * 27250002 ********************************************************************** 27300002 INSERT EQU * 27400002 L R15,OUTBUF ADDR OF OUTPUT BUFFER 27800002 USING INSERTS,R15 EXTABLISH ADDRESSABILITY TO INSERTS 27850002 * DSECT 27860002 SPACE 27900002 TM FLAGS,SVCFAIL IS THIS AN SVC 97 OR 61 FAILURE 27950002 BO MOVSVC YES - GET SVC INSERT FOR 1ST LEVEL 28000002 SPACE 28200002 SPACE 28700002 TM TSTFLGS1,ENDSW+RUNSW TEST FOR 'END' COMMAND 28800002 BM MOVEND YES... 28900002 SPACE 29000002 SR R7,R7 CLEAR REG 29100002 IC R7,TSTRTYCD HIGH-ORDER BYTE IS THE 29200002 * MODULE ID 29300002 LTR R7,R7 IF ZERO, NO SUB-COMMAND IN CORE 29400002 BZ MOVETEST ZERO...GO INSERT 'TEST' 29500002 * INTO 1ST LEVEL MSG 29600002 SPACE 29700002 L R6,SCDADDR GET ADDR OF CSECT CONTAINING 29800002 * LIST OF MODULE NAMES 29900002 BAL R7,TSTID SEARCH LIST 30000002 L R6,SCDADDR2 GET ADDR OF CSECT CONTAINING 30100002 * USERS LIST OF MODULE NAMES 30200002 BAL R7,TSTID SEARCH LIST 30300002 B NOFIND NOT FOUND 30400002 SPACE 30500002 TSTID SR R5,R5 CLEAR REG 30600002 SPACE 1 30700002 TSTID1 IC R5,ZERO(ZERO,R6) GET LENGTH OF MODULE NAME IN 30800002 * LIST 30900002 CLI ZERO(R6),HEXFF END OF MODULE NAME LIST 31000002 BCR 8,R7 YES... 31100002 SPACE 31200002 SR R4,R4 CLEAR REG 31300002 IC R4,ONE(R6,R5) GET ABBREVIATION LENGTH 31400002 LA R4,TEN(R4,R5) DISPLACEMENT OF ID 31500002 AR R4,R6 ADDRESS OF ID 31600002 CLC TSTRTYCD(ONE),ZERO(R4) COMPARE ID TO TSTRETRY ID 31700002 SPACE 31800002 BE FOUND BRANCH TO ADD NAME TO MSG 31900002 SPACE 32000002 LA R6,ONE(R4) BUMP TO NEXT MODULE NAME ENTRY 32100002 B TSTID GO CHECK NEXT ID 32200002 SPACE 32300002 NOFIND TM TSTFLGS1,TSTBUILD TEST FOR 'DEFER' COMMAND 32400002 BO MOVDEFER YES... 32500002 SPACE 32600002 LA R6,ASSIGN GET ADDR OF 'ASSIGNMENT' 32700002 B STA001 GO MOVE NAME 32800002 SPACE 32900002 MOVEND LA R6,ENDNAME PTR TO 'END' 33000002 B STA001 GO MOVE NAME 33100002 SPACE 33200002 MOVSVC LA R6,SVCMSG PTR TO 'SVC INSERT' 33250002 B STA001 GO MOVE INSERT TO BUFFER 33260002 SPACE 33270002 MOVDEFER LA R6,DEFERNM PTR TO 'DEFER' 33300002 B STA001 GO MOVE NAME 33400002 SPACE 33500002 MOVETEST LA R6,TSTNAME GET PTR TO 'TEST' 33600002 STA001 DS 0H 33700002 SR R5,R5 CLEAR REG 33750002 IC R5,ZERO(ZERO,R6) GET LENGTH 33800002 SPACE 33900002 *********************************************************************** 33950002 * AT ENTRY TO THIS ROUTINE, REGISTER CONTENT IS ASSUMED TO BE AS * 33960002 * FOLLOWS: * 33970002 * R5 = LENGTH OF NAME TO BE INSERTED * 34000002 * R6 = @ CORRECT ENTRY IN MOD LIST * 34100002 *********************************************************************** 34150002 FOUND DS 0H 34200002 MVI SUBCMDNM,BLANK PUT A BLANK AT END OF NAME 34210002 MVC SUBCMDNM+ONE(TWELVE),SUBCMDNM PLACE BLANKS IN CMD NAME 34220002 BCTR R5,R0 DECR LENGTH BY ONE FOR MOVE 34250002 EX R5,MOVENAME MOVE MODULE NAME INTO INSERT 34300002 MVC LEN1(FOUR),ZERO4 INITIALIZE CONTROL PORTION OF INSERT 34350002 * LEVEL MSG 34400002 LA R5,SIX(R5) GET LENGTH OF INSERT 34450002 STC R5,LEN1+ONE STORE LENGTH OF COMPLETE INSERT 34460002 SPACE 4 34600002 ********************************************************************** 35450002 * SET UP SECOND LEVEL MESSAGE INSERT FOR THE ENTRY POINT 35500002 ********************************************************************** 35550002 L R5,PARMLST@ GET ADDRESS OF PARAM LIST 35600002 USING LIST,R5 ESTABLISH R5 AS PARAM LIST BASE 35650002 UNPK ENTPOINT(NINE),ENTRYPT(FIVE) UNPACK ENTRY POINT 35700002 TR ENTPOINT(EIGHT),TAB-HEXF0 TRANSLATE ENTRY POINT 35750002 MVC LEN2(FOUR),ZERO4 INITIALIZE CONTROL PORTION OF INSERT 35800002 MVI LEN2+ONE,THIRTN PLACE LENGTH OF COMPLETE INSERT 35850002 MVI ENTPOINT+EIGHT,BLANK PUT A BLANK AT END OF NAME 35860002 DROP R5 RELEASE PARAM LIST BASE 35900002 SPACE 36100002 ********************************************************************** 36150002 * SET UP SECOND LEVEL MESSAGE INSERT FOR THE COMPLETION CODE 36160002 ********************************************************************** 36170002 SPACE 36180002 DROP R2 FREE R2 AS BASE 36610002 L R2,TCBPTR GET TCB ADDRESS 36650002 USING TCB,R2 REESTABLISH ADDRESSABILITY TO TCB 36660002 SPACE 36700002 UNPK COMPCODE(THREE),TCBCMPC(TWO) UNPACK 36800002 * COMPLETION CODE 36900002 OI COMPCODE+TWO,HEXF0 SET SIGN PORTION OF LAST BYTE 37000002 TR COMPCODE(THREE),TAB-HEXF0 TRANSLATE COMPLETION 37100002 * CODE TO PRINTABLE HEX 37200002 MVI COMPCODE+THREE,BLANK PLACE A BLANK AFTER COMPLETION CODE 37210002 MVC LEN3(FOUR),ZERO4 INITIALIZE CONTROL PORTION OF INSERT 37250002 MVI LEN3+ONE,EIGHT PLACE LENGTH OF COMPLETE INSERT 37260002 SPACE 37300002 ********************************************************************** 37350002 * SET UP SECOND LEVEL MESSAGE INSERT FOR THE INSTRUCTION COUNTER 37360002 ********************************************************************** 37370002 UNPK INSTCTR(NINE),ZERO(FIVE,R3) UNPACK PSW IC 37400002 MVI INSTCTR+EIGHT,BLANK CLEAR LAST BYTE 37500002 TR INSTCTR(EIGHT),TAB-HEXF0 TRANSLATE PSW IC TO 37600002 MVC LEN4(FOUR),ZERO4 INITIALIZE CONTROL PORITON OF INSERT 37650002 MVI LEN4+ONE,THIRTN PLACE LENGTH OF COMPLETE INSERT 37660002 L R7,ZERO(R3) GET ACTUAL IC 37700002 LA R7,0(R7) CLEAR HIGH ORDER BYTE 37800002 BCTR R7,R0 ADDR OF LAST BYTE 37900002 BAL R6,ADDRCHK CHECK IT 38000002 L R7,ADDRESS GET ADDRESS 38010002 SPACE 38050002 ********************************************************************** 38060002 * SET UP SECOND LEVEL MESSAGE INSERT FOR THE INSTRUCTION IMAGE 38070002 *********************************************************************** 38080002 LA R6,TWELVE-ONE BACK UP THE IC A 38100002 SR R7,R6 TOTAL OF TWELVE BYTES 38200002 BAL R6,ADDRCHK CHECK THIS ADDRESS 38300002 L R7,ADDRESS GET ADDRESS 38310002 LA R6,INST25@ GET ADDRESS OF 5TH INSERT 38350002 OI FLAGS,INSERT25 INDICATE THAT THERE IS A 5TH INSERT 38400002 UNPK INSTIMGE(THIRTN),ZERO(SEVEN,R7) UNPACK PORTION 38450002 * OF INSTRUCTION IMAGE 38500002 TR INSTIMGE(TWELVE),TAB-HEXF0 TRANSLATE 38600002 SPACE 38700002 UNPK INSTIMGE+TWELVE(THIRTN),SIX(SEVEN,R7) UNPACK REST OF 38800002 * THE INSTRUCTION IMAGE 38900002 MVI INSTIMGE+TWENTY4,BLANK CLEAR LAST BYTE 39000002 TR INSTIMGE+TWELVE(TWELVE),TAB-HEXF0 TRANSLATE INSTR IMAGE 39100002 * TO PRINTABLE HEX 39200002 MVC LEN5(FOUR),ZERO4 INITIALIZE CONTROL PORTION OF INSERT 39260002 MVI LEN5+ONE,TWENTY9 ESTABLISH LEN OF COMPLETE INSERT 39270002 RET BR R14 RETURN 39300002 SPACE 1 39400002 ADDRCHK ST R7,ADDRESS SAVE ADDRESS 39550002 LTR R7,R7 IF NOT POSITIVE, 39560002 BNP NOIMAGE DON'T PRINT IMAGE. 39600002 L R5,TCBPQE ADDRESS DUMMY-PQE 39700002 USING PQESECT,R5 39800002 L R5,PQEFPQE ADDRESS OF PQE FOR THIS REGION 39900002 C R7,PQEREGN START OF REGION. 40000002 BL NOIMAGE DON'T PRINT IMAGE. 40200002 L R7,PQEREGN START OF REGION. 40252002 A R7,PQESIZE END OF REGION. 40300002 C R7,ADDRESS IF ADDRESS IS WITHIN REGION, 40400002 BCR TWO,R6 RETURN. 40500002 * ELSE, DON'T PRINT IMAGE. 40600002 SPACE 40700002 NOIMAGE EQU * DON'T PRINT INSTR IMAGE 40800002 LA R6,INST25@ GET ADDRESS OF 4TH INSERT 41160002 OI FLAGS,INSERT25 INDICATE THAT THERE IS A 5TH INSERT 41170002 SR R7,R7 CLEAR REG7 41190002 IC R7,OUTRGN GET TEXT LENGTH 41194102 LA R7,FIVE(R7) GET TOTAL LENGTH OF INSERT 41194402 MVC LEN5(FOUR),ZERO4 INITIALIZE CONTROL PORTION OF INSERT 41194802 STC R7,LEN5+ONE STORE TOTAL LENGTH OF INSERT 41196002 LA R7,OUTRGN+ONE GET ADDRESS OF INSERT TEXT 41196402 MVC INSTIMGE(TWENTY2),ZERO(R7) PLACE TEXT INTO INSERT 41198002 B RET RETURN 41200002 EJECT 41574902 ****************************************************************** 41600002 * * 41700002 * IC SEARCH ROUTINE -- THIS ROUTINE WILL COMPARE THE * 41800002 * ADDRESS PORTION OF THE ABENDING MODULE'S PSW TO THE * 41900002 * ADDRESSES CONTAINED IN THE IC TABLE. IF A MATCH IS * 42000002 * FOUND, THE APPROPRIATE MESSAGE WILL BE INSERTED INTO * 42100002 * THE STANDARD 2ND LEVEL MESSAGE, AND CONTROL GIVEN TO * 42200002 * THE I/O ROUTINE TO WRITE OUT THE MESSAGES. CONTROL IS * 42300002 * THEN GIVEN TO THE RETRY ROUTINE. * 42400002 * IF NO MATCH IS FOUND, RETURN IS MADE TO THE CALLING * 42500002 * ROUTINE. * 42600002 * * 42700002 * AT ENTRY-- REG3 = PTR TO ABENDING RB'S OPSW+4 * 42800002 * REG5 = PTR TO MODULE'S IC TABLE * 43000002 * * 43100002 * AT EXIT -- REG3 = PTR TO ABENDING RB'S OPSW+4 * 43150002 * REG5 = PTR TO MODULE'S IC TABLE * 43170002 * REG7 = INSERT # CORRESPONDING TO IC TABLE * 43172002 * ENTRY * 43180002 * * 43190002 ****************************************************************** 43200002 SPACE 2 43300002 SEARCH EQU * 43400002 TM TSTFLGS1,TSTFIRST IS THIS FLAG ON 43410002 BO RETURN YES - DO NOT PUT OUT A MESSAGE 43420002 SEARCH2 EQU * 43450002 SPACE 43700002 MVC CODESAV(ONE),ZERO(R5) GET CODE FROM ENTRY 43800002 CLI CODESAV,HEXFF CHECK IF CODE = X'FF' (END OF 43900002 * TABLE) 44000002 BE SRCHOUT YES...EXIT 44100002 SPACE 44200002 CLC ONE(THREE,R5),ONE(R3) COMPARE IC TABLE ENTRY TO 44300002 * ABENDING RB'S OPSW+5 44400002 BE MATCH BRANCH IF EQUAL 44500002 SPACE 44600002 LA R5,FOUR(ZERO,R5) BUMP TO NEXT IC TABLE ENTRY 44700002 B SEARCH2 COMPARE THIS NEXT ENTRY 44800002 SPACE 44900002 MOVEXCTL DS 0H 45000002 SR R7,R7 CLEAR INSERT NUMBER REGISTER 45050002 IC R7,MSGXCTL GET NUMBER OF XCTL MSG INSERT 45060002 B MOVEINIT INDICATE THAT THERE IS A 6TH INSERT 45100002 SPACE 45200002 MATCH CLI CODESAV,HEX00 IS IC CODE = 0 45300002 BE RETURN YES...NO MESSAGES, GO TO RETRY 45400002 SPACE 45500002 SR R7,R7 CLEAR REG 45600002 IC R7,CODESAV GET CODE 45700002 MOVEINIT DS 0H 46500002 OI FLAGS,INSERT26 INDICATE 6TH INSERT EXISTS 46760002 SR R6,R6 CLEAR REG 46800002 SPACE 47200002 MOVEMSG DS 0H 47300002 SPACE 47800002 B MSGIO GO PRINT 48400002 SPACE 48500002 SPACE 48800002 SRCHOUT DS 0H 48900002 TM TSTFLGS2,TSTXCTL CHECK FOR 'XCTL' BIT ON 48902002 BO MOVEXCTL YES...GO INSERT 'XCTL FAILED' 48912002 SR R7,R7 CLEAR REG 7 48914002 NI FLAGS,NOINST26 INDICATE NO 6TH INSERT 48920002 BR R14 RETURN TO CALLING ROUTINE 48950002 EJECT 49000002 *********************************************************************** 49010002 * 49020002 * THESE FORMS OF THE IO MACRO ARE USED TO ISSUE THE FIRST AND SECOND 49030002 * LEVEL MESSAGES. 49040002 * 49042002 *********************************************************************** 49044002 MSGIO DS 0H ISSUE MESSAGES 49046002 OI TSTFLGS4,TSTESTAE INDICATE I/O SERVICING ESTAE REQUEST 49046402 XC TSTIOPRM(L'TSTIOPRM),TSTIOPRM CLEAR REMOTE PARM LIST 49048002 LR R4,R15 GET ADDRESS OF INSERTS 49048402 DROP R15 DISCONTINUE R15 AS INSERTS BASE 49048802 USING INSERTS,R4 ESTABLISH R4 AS INSERTS BASE 49049202 L R5,PARMLST@ GET POINTER TO PARAM LIST 49049302 USING LIST,R5 ESTABLISH R4 AS INSERTS BASE 49049602 TM FLAGS,INSERT26 DOES 6TH INSERT EXIST 49049702 BZ IOMACRO2 NO - CHECK SECOND FORM OF MACRO 49049802 TM FLAGS,INSERT25 DOES 5TH INSERT EXIST 49049902 BZ IOMACRO3 NO - USE THIRD FORM OF MACRO 49050102 IOMACRO1 DS 0H 49050202 IKJEGSIO MSG,FIRST=M0058,INST11=(ADDR,INST11@),SECOND=M0259, *49050302 INST21=(ADDR,INST21@),INST22=(ADDR,INST22@), *49050402 INST23=(ADDR,INST23@),INST24=(ADDR,INST24@), *49053702 INST25=(ADDR,INST25@),INST26=(NUM,(R7)), *49054902 ID=STA29,MF=(E,TSTIOPRM) 49056103 B RETURN GO RETURN WITH APPROPRIATE RC 49057302 SPACE 4 49057702 IOMACRO2 DS 0H 49058502 TM FLAGS,INSERT25 IS THERE A 5TH INSERT FOR 2ND LEVEL 49059702 BZ IOMACRO4 NO - USE FOURTH FORM OF MACRO 49060902 IKJEGSIO MSG,FIRST=M0058,INST11=(ADDR,INST11@),SECOND=M0259, *49062102 INST21=(ADDR,INST21@),INST22=(ADDR,INST22@), *49063302 INST23=(ADDR,INST23@),INST24=(ADDR,INST24@), *49063702 INST25=(ADDR,INST25@),ID=STA29,MF=(E,TSTIOPRM) 49064503 B RETURN GO RETURN WITH APPROPRIATE RC 49065702 SPACE 4 49066902 IOMACRO3 DS 0H 49067002 IKJEGSIO MSG,FIRST=M0058,INST11=(ADDR,INST11@),SECOND=M0259, *49067302 INST21=(ADDR,INST21@),INST22=(ADDR,INST22@), *49067702 INST23=(ADDR,INST23@),INST24=(ADDR,INST24@), *49072302 INST26=(NUM,(R7)),ID=STA29,MF=(E,TSTIOPRM) 49073603 B RETURN GO RETURN WITH APPROPRIATE RC 49074902 SPACE 4 49076202 IOMACRO4 DS 0H 49077502 IKJEGSIO MSG,FIRST=M0058,INST11=(ADDR,INST11@),SECOND=M0259, *49078802 INST21=(ADDR,INST21@),INST22=(ADDR,INST22@), *49080102 INST23=(ADDR,INST23@),INST24=(ADDR,INST24@), *49080502 ID=STA29,MF=(E,TSTIOPRM) 49081403 B RETURN GO RETURN WITH APPROPRIATE RC 49082702 EJECT 49176702 * 49178702 SPACE 8 49186702 **** MOVE INSTRUCTIONS **** 49200002 * 49300002 *MOVE1 MVC EIGHT(ZERO,R1),ZERO(R7) MOVE 1ST LEV MSG TO BUFFER 49400002 * OUTPUT BUFFER 49500002 MOVE2 MVC ZERO(ZERO,R4),ZERO(R8) MOVE 2ND LEVEL MESSAGE TO 49600002 * OUTPUT BUFFER 49700002 MOVE3 MVC ZERO(ZERO,R4),ONE(R8) MOVE INSERT TO 2ND LEVEL 49800002 * MESSAGE 49900002 MOVENAME MVC FOUR(ZERO,R15),ONE(R6) MOVE INSERT TO FIRST 50000002 * LEVEL MESSAGE 50100002 * 50200002 SPACE 50300002 * 50400002 * CONSTANTS 50500002 * 50600002 DS 0F 50700002 MASKUP DC X'FFFFFFFC' MASK FOR ROUNDING UP 50800002 ZERO4 DC X'00000000' CONSTANT USED TO INITIALIZE INSERT 50850002 SCDADDR DC V(IKJEGSCD) @ MODULE LIST CSECT-IBM SUBCOMMANDS 51200002 SCDADDR2 DC V(IKJEGSCU) @ MODULE LIST CSECT-USER'S " 51300002 SVC61 DC CL8'IGC0006A' SVC 61 NAME ZXCZXCZX 51350002 SVC97 DC CL8'IGC0009G' SVC 97 NAME ZXCZXCZX 51400002 SAVELNGH DC X'00000048' LENGTH OF GET MAIN 20 @ZA00918 51402003 BLANK9 DC CL9' ' USED TO INITIALIZE TO BLANKS 51410002 MSGXCTL DC X'85' INSERT # OF XCTL MSG INSERT 51440002 EJECT 51450002 *********************************************************************** 51500002 * 51550002 * THIS IS A SEQUENCE OF COMMAND NAMES THAT ARE USED IN CONSTRUCTING 51600002 * THE FIRST LEVEL MESSAGE 51650002 *********************************************************************** 51700002 ENDNAME DS 0H 52292002 DC X'03' LENGTH OF NAME 52300002 DC C'END' COMMAND NAME 52400002 *************************PLEASE DO NOT DISTERB THIS INSERT************ 52550002 SPACE 4 52560002 ASSIGN DS 0H 52560402 DC X'0A' LENGTH OF NAME 52560502 DC C'ASSIGNMENT' MODULE NAME (WILL BE CHANGED 52561202 * TO 'SET') 52561302 *************************PLEASE DO NOT DISTERB THIS INSERT************ 52561602 SPACE 4 52561702 DEFERNM DS 0H 52562002 DC X'05' LENGTH OF NAME 52570002 DC C'DEFER' COMMAND NAME 52590002 *************************PLEASE DO NOT DISTERB THIS INSERT************ 52640002 SPACE 4 52690002 TSTNAME DS 0H 52740002 DC X'04' LENGTH OF NAME 52750002 DC C'TEST' COMMAND NAME 52840002 *************************PLEASE DO NOT DISTERB THIS INSERT************ 52890002 SPACE 4 52940002 SVCMSG DS 0H 52990002 DC X'0C' LENGTH OF INSERT TEXT 52992002 DC C'SVC(97 V 61)' INSERT TEXT 52994002 *************************PLEASE DO NOT DISTERB THIS INSERT************ 52996002 EJECT 52998002 TAB DC C'0123456789ABCDEF' TRANSLATE TABLE FOR ABEND CODE 53000002 * 53100002 SPACE 1 53150002 OUTRGN DS 0X 53150402 DC AL1(OUTRGN2-OUTRGN) TEXT LENGTH 53150802 DC C'NOT WITHIN THIS REGION' INSERT TEXT 53151202 OUTRGN2 DS 0X 53151602 * 53152002 SPACE 1 53154002 CONSTANT DC 60C'Z' PATCH AREA 53160002 EJECT 53200002 SPACE 54400002 * 61300002 * 61450002 STAWORK DSECT STAE WORK AREA DSECT 61600002 * 61700002 REGSAV DS 2F SAVE AREA FOR REGS 13 AND 14 61800002 RTCA@ DS F ADDR OF 512-BYTE WORKAREA SAVE 61900002 CODESAV DS X IC TABLE CODE SAVE 62000002 FLAGS DS X FLAGS TO INDICATE RESOURCE STATUS 62148002 RTCA EQU B'10000000' RTCA OBTAINED 62148402 RTCAN EQU B'01111111' RTCA COMPLEMENT 62148802 INSERT25 EQU B'01000000' 5TH INSERT TO ERROR MSG EXISTS 62148902 NOINST25 EQU B'10111111' NO 5TH INSERT TO ERROR MSG 62149002 INSERT26 EQU B'00100000' 6TH INSERT TO ERROR MSG EXISTS 62149102 NOINST26 EQU B'11011111' NO 6TH INSERT TO ERROR MSG 62149502 SVCFAIL EQU B'00010000' WE ARE PROCESSING AN SVC ABEND 62149902 FLAGS4 DS X STORAGE SPACE FOR TSTFLGS4 62150102 DS X UNASSIGNED 62150302 ADDRESS DS F AREA FOR ADDRESS BEING VALIDITY CKED 62151002 PARMLST@ DS F ADDR OF PARAM LIST FROM ESTAE MACRO 62151202 TCBPTR DS F ADDR OF TCB 62151402 SVRB@ DS F ADDR OF SVRB FOR SVC'S 97 AND 61 62151502 * 62151602 SPACE 6 62151802 LIST DSECT PARAM LIST 62152002 RETRY@ DS F RETRY ROUTINE ADDRESS 62152202 ABENTAB@ DS F ABEND TABLE ADDRESS DSECT 62152402 ENTRYPT DS F ENTRY POINT OF ABENDING MODULE 62156102 MODNAME DS CL8 MODULE NAME 62158102 INST21@ DS 0H *** 1ST INSERT FOR 2ND LEVEL MESSAGE 62162002 INSERTLN DS H LENGTH OF COMPLETE TEXT NAME INSERT 62165402 DS H 62172802 TEXTNM DS C ABENDING MODULE TEXT NAME 62176202 EJECT 62179602 * 62183002 ********************************************************************** 62186402 * THIS DSECT MAPS THE INSERTS FOR THE FIRST AND SECOND LEVEL 62189802 * MESSAGES 62193202 ********************************************************************** 62196602 SPACE 62200002 INSERTS DSECT 62200602 INST11@ DS 0H ADDRESS OF INSERT TO 1ST LEVEL MSG 62205302 LEN1 DS H LENGTH OF INST11 + 5 62210002 DS H AREA USED BY IKJEGIO 62220002 SUBCMDNM DS CL13 SUBCOMMAND NAME 62230002 * 62240002 INST22@ DS 0H ADDRESS OF 2ND INSERT TO 2ND LEVEL 62250002 LEN2 DS H LENGTH OF INST22 + 4 62254002 DS H AREA USED BY IKJEGIO 62256002 ENTPOINT DS CL9 ENTRY POINT 62258002 * 62258402 INST23@ DS 0H ADDRESS OF 3RD INSERT TO ERROR MSG 62258802 LEN3 DS H LENGTH OF INST23 + 5 62259202 DS H AREA USED BY IKJEGIO 62259602 COMPCODE DS CL4 COMPLETION CODE 62259702 * 62259802 INST24@ DS 0H ADDRESS OF 4TH INSERT TO 2ND LEVEL 62260002 LEN4 DS H LENGTH OF INST24 + 5 62262002 DS H AREA USED BY IKJEGIO 62264002 INSTCTR DS CL9 INSTRUCTION COUNTER 62266002 * 62268002 INST25@ DS 0H ADDRESS OF 5TH INSERT TO 2ND LEVEL 62270002 LEN5 DS H LENGTH OF INST25 + 5 62320002 DS H AREA USED BY IKJEGIO 62370002 INSTIMGE DS CL25 INSTRUCTION IMAGE 62380002 * 62382002 INST26@ DS 0H ADDRESS OF 6TH INSERT TO 2ND LEVEL 62390002 LEN6 DS H LENGTH OF INST26 + 5 62392002 DS H AREA USED BY IKJEGIO 62394002 ABENDMSG DS CL38 MESSAGE CORRESPONDING TO CODE IN 62396002 * COMMAND IC TABLE 62398002 EJECT 62400002 TCOMTAB COMMUNICATION TABLE 62500002 EJECT 62600002 TSTCWORK 62700002 EJECT 62800002 CVTDSECT DSECT 62900002 CVT CVT DSECT 63000002 EJECT 63100002 IHAPQE PQE DSECT 63200002 EJECT 63250002 IHACDE CDE DSECT 63260002 EJECT 63300002 IKJRB RB DSECT 63400002 EJECT 63500002 IKJTCB TCB DSECT 63600002 EJECT 63650002 IHASDWA RTCA DSECT 63660002 END 63700002