*30740007************************************************************* 29300000 006A TITLE 'IGC0006A - TEST SVC' 29350000 COPY IKJEGSIO 29400000 EJECT 29450000 IGC0006A CSECT 29500000 *C229080,229092,264547,264603 @YM02260 29550000 *A229068,264546 @YM02260 29600000 *A264544-264545,264672-264684 @YM02404 29650000 *A159720-159740,159804 @YM03486 29700000 *C265071-265156 @YM04131 29750000 *A104008,252040,265151 @YM05036 29800000 *A098876,278314 @YM04978 29850000 *A152452,152480-152571,278338 @YM07115 29900000 *C158821 @YM06810 29950000 *D127000 @YM07131 30000000 *A216500 @ZA01570 30050000 * A 153220,158510,278334 @ZA07138,@ZA09259,@ZA10462 30100000 * A 015060,265673-265678,265682 @ZA11389 30150000 * C 265679 @ZA11389 30200000 *********************************************************************** 30250000 * * 30300000 * STATUS -- * 30350000 * VERSION NO. 01, OS/VS2 RELEASE NO. 2 08/01/73 * 30400000 * * 30450000 * FUNCTION/OPERATION -- * 30500000 * THE TEST SVC (SVC 61-IGC0006A) SAVES INFORMATION ABOUT * 30550000 * LOAD MODULES FOR USE BY THE TSO TEST SYMBOL PROCESSOR, * 30600000 * MODULE IKJEGSYM AND INFORMS THE AT COMMAND OF THE NAME * 30650000 * OF THE MODULE BEING FETCHED SO DEFERRED BREAKPOINTS * 30700000 * CAN BE ESTABLISHED. * 30750000 * SVC 061 IS ISSUED BY FETCH WHEN BRINGING A LOAD MODULE * 30800000 * INTO CORE THAT HAS THE TEST ATTRIBUTE IN THE DIRECTORY ENTRY * 30850000 * FOR THE MEMBER OR WHEN A LOAD MODULE IS BROUGHT INTO CORE BY * 30900000 * TSO TEST. THIS SVC OPERATES IF THE MODULE IS RUNNING UNDER * 30950000 * A TSO TASK * 31000000 * IGC0006A BUILDS A INFO BLK REFLECTING THE LOAD MODULE * 31050000 * NAME, LOADED ADDRESS, ATTRIBUTES AND, IF AVAILABLE, A DDNAME * 31100000 * WHICH IKJEGSYM CAN OPEN A DCB TO READ THE ASSEMBLER'S SYMBOL * 31150000 * TABLES AND LINKAGE EDITORS CESD RECORDS. * 31200000 * IF TEST IS RUNNING, THESE INFO BLOCKS ARE CHAINED FROM * 31250000 * A WORD IN TCOMTAB. IF NOT, THEY ARE CHAINED FROM THE TCB * 31300000 * TRN FIELD. * 31350000 * ALSO, IF TEST IS RUNNING, THE ECB POINTED TO FROM THE * 31400000 * ECBTST FIELD IN TCOMTAB IS POSTED WITH A X'44'. * 31450000 * SVC 61 IS ALSO ISSUED BY THE OVERLAY SUPERVISOR IF * 31500000 * TEST IS RUNNING AND A NEW SEGMENT OF AN OVERLAY STRUCTURE * 31550000 * IS BROUGHT INTO CORE. IN THIS CASE, SVC 61 WILL PASS THE * 31600000 * NAME OF THE LOAD MODULE TO THE AT COMMAND VIA POST-WAIT. * 31650000 * * 31700000 * NOTE * 31750000 * TESTRAN IS NO LONGER SUPPORTED, IE SVC 61 IS ONLY A TSO TEST SVC.* 31800000 * * 31850000 * * 31900000 * ENTRY POINTS -- * 31950000 * IGC0006A ONLY ENTRY TO SVC 61 * 32000000 * * 32050000 * INPUT -- * 32100000 * REGISTERS POINT TO SYSTEM INFORMATION * 32150000 * -FROM CONTENTS SUPERVISOR * 32200000 * 1 - NEGATIVE ADDRESS OF DCB USED TO FETCH THE MEMBER * 32250000 * 3 - ADDRESS OF CVT * 32300000 * 4 - ADDRESS OF TCB * 32350000 * 5 - ADDRESS OF MY SVRB * 32400000 * WKNAME(IHAFETWK) - ADDR OF BLDL ENTRY FOR MEMBER * 32450000 * WKCDADDR(IHAFETWK) - ADDR OF EXTENT LIST FOR MEMBER * 32500000 * -FROM OVERLAY SUPERVISOR * 32550000 * 1 - ZERO * 32600000 * 80(5) - ADDRESS OF SEGTAB * 32650000 * * 32700000 * OUTPUT -- * 32750000 * SVCINFO BLOCK FOR TEST SYMBOL PROCESSOR, IKJEGSYM * 32800000 * IF TEST IS RUNNING, PASS LOADNAME TO AT COMMAND VIA GENERAL * 32850000 * WORK AREA * 32900000 * * 32950000 * EXTERNAL REFERENCES -- * 33000000 * XCTL TO SECOND LOAD, IF TESTRAN REQUESTED * 33050000 * GETMAIN OBTAIN CORE FOR A SYMINFO BLOCK OR AN ECB * 33100000 * POST MAINLINE SO AT CMD CAN PROCESS * 33150000 * WAIT FOR AT CMD TO FINISH PROCESSING * 33200000 * OR IF MULTI-TASKING, FOR MAINLINE TO FINISH * 33250000 * SYNCH TO PASS CONTROL TO IKJEGIO OR IKJEGSTA * 33300000 * * 33350000 * EXITS, NORMAL -- * 33400000 * ISSUE A BRANCH REGISTER ON REGISTER 14 * 33450000 * * 33500000 * EXITS, ERROR -- * 33550000 * N/A * 33600000 * * 33650000 * TABLES/WORKAREAS -- * 33700000 * TCOMTAB IF TEST IS RUNNING * 33750000 * TCB TTRN FIELD, TIOT ADDRESS * 33800000 * MY SVRB WORK AREAS, POINTERS * 33850000 * BLDL ENTRY FOR FETCH MEMBER * 33900000 * XL FOR FETCHED MEMBER * 33950000 * DCB USED TO FETCH MEMBER * 34000000 * TIOT IF AVAILABLE, GET DDNAME ALLOCATING PDS * 34050000 * * 34100000 * ATTRIBUTES -- * 34150000 * REENTRANT AND REFRESHABLE * 34200000 * * 34250000 * CHARACTER CODE DEPENDENCY -- * 34300000 * RE-ASSEMBLY IS REQUIRED FOR CHANGE OF CODE * 34350000 * * 34400000 * NOTES -- * 34450000 * THE SVC INFO BLOCKS ARE FREED BY MAINLINE AT THE END * 34500000 * OF A TEST SESSION. * 34550000 * 34600000 * CHANGE-ACTIVITY - 34650000 * APAR OZ07138 - CHANGES TO PRIVIDE MNL WITH A POINTER 34700000 * TO THE POSTING SVRB. ECBPP+1 IN TCOMTAB IS THE 34750000 * POINTER. IT IS SERIALIZED AT THE TASK LEVEL VIA ENQ. 34800000 * ANY PRIOR POINTER IS SAVED IN THE SVRB WORKAREA AT 34850000 * WRKSVRBS AND RESTORED BEFORE DEQ AND RETURN. 34900000 * APAR OZ09259 - SAME AS ABOVE. 34950000 * APAR OZ10462 - SAME AS ABOVE. 35000000 * APAR OZ11389 - CHANGE ESTAE/RETRY LINKAGES TO 35050000 * CONFORM TO REGISTER CONVENTIONS 35100000 * 35150000 * * 35200000 EJECT 35250000 *********************************************************************** 35300000 * * 35350000 * EQUATES * 35400000 * * 35450000 *********************************************************************** 35500000 * 35550000 * REGISTER EQUATES 35600000 * 35650000 PARMREG0 EQU 0 REGISTER 0 35700000 R0 EQU 0 REGISTER 0 35750000 PARMREG1 EQU 1 REGISTER 1 35800000 R1 EQU 1 REGISTER 1 35850000 R2 EQU 2 REGISTER 2 35900000 DCBPTR EQU 2 ADDRESS OF DCB 35950000 ADDRCVT EQU 3 ADDRESS OF CVT 36000000 R3 EQU 3 WORK REG @ZA04126 36050000 TCBPTR EQU 4 ADDRESS OF TCB 36100000 SVRBPTR EQU 5 ADDRESS OF MY SVRB 36150000 TSVCBASE EQU 6 BASE REGISTER FOR IGC0006A 36200000 R7 EQU 7 WORK REG 7 36250000 WORKA EQU 7 REGISTER 7 36300000 WORKB EQU 8 REGISTER 8 36350000 TCOMTABB EQU 9 WHEN TEST IS RUNNING, ADDRESS OF TCOMTAB 36400000 SVCINFOB EQU 10 ADDR OF ANSWER BLOCK, BASE FOR 36450000 * DESCRIPTIVE SEC 36500000 R10 EQU 10 REG 10 36550000 WKPARTB EQU 11 ADDR OF EXTENDED AREA IN SVRB, 36600000 * USE AS WORKAREA 36650000 SEGTABAD EQU 12 IF ISSUER IS OVLY SUPRVSR, 36700000 * ADDRESS OF SEGTAB 36750000 SOMESAVE EQU 13 REGISTER 13 36800000 R13 EQU 13 REGISTER 13 36850000 RETURN EQU 14 REGISTER 14 36900000 REG15 EQU 15 REGISTER 15 36950000 * 37000000 * NUMBER EQUATES 37050000 * 37100000 N1 EQU 1 DECIMAL 1 37150000 N2 EQU 2 DECIMAL 2 37200000 N0 EQU 0 DECIMAL 0 37250000 N4 EQU 4 DECIMAL 4 37300000 N8 EQU 8 DECIMAL 8 37350000 N12 EQU 12 DECIMAL 12 37400000 * 37450000 * LENGTH EQUATES 37500000 * 37550000 L2 EQU 2 LENGTH OF 2 37600000 L4 EQU 4 LENGTH OF 4 37650000 L8 EQU 8 LENGTH OF 8 37700000 * 37750000 * CONDITION CODE EQUATES FOR BCR INSTRUCTIONS 37800000 * 37850000 EQUAL EQU 8 BRANCH IF EQUAL 37900000 ONES EQU 1 BRANCH IF ONES 37950000 * 38000000 * DISPLACMENT EQUATES 38050000 * 38100000 D0 EQU 0 ZERO DISPLACMENT 38150000 D3 EQU 3 DISPLACMENT OF 3 38200000 D4 EQU 4 DISPLACMENT OF 4 38250000 D8 EQU 8 DISPLACMENT 0F 8 38300000 D24 EQU 24 DISPLACMENT OF 24 38350000 D32 EQU 32 DISPLACMENT OF 32 38400000 D76 EQU 76 DISPLACMENT 0F 76 38450000 D80 EQU 80 DISPLACMENT 0F 80 38500000 D96 EQU 96 DISPLACMENT OF 96 38550000 TIOTDD EQU 4 OFFSET INTO TIOT ENTRY OF DDNAME 38600000 * 38650000 * OTHER EQUATES 38700000 * 38750000 EXIT EQU 3 THREE 38800000 SP250 EQU 250 SUBPOOL 250, GET CORE IN SUBPOOL 0 38850000 * 38900000 * IMMEDIATE OPERANDS 38950000 * 39000000 N00 EQU X'00' HEX 00 39050000 N01 EQU X'01' HEX 01 39100000 X80 EQU X'80' HEX 80 39150000 X74 EQU X'74' HEX 74 39200000 X40 EQU X'40' HEX 40 39250000 XFF EQU X'FF' HEX FF 39300000 TCBCHAIN EQU X'80' SW IN FLAGS, FIRST TIME - CHAIN FROM TCB 39350000 OVLYBLK EQU X'40' SW IN FLAGS, OVLYED A DUPLICATE LOADNAME 39400000 OVLYBIT EQU X'20' OVLY ATTRIBUTE BIT IN BLDL ATTRIBUTE FIELD 39450000 FF EQU X'FF' MASK BYTE 39500000 EJECT 39550000 *********************************************************************** 39600000 * * 39650000 * THIS IS THE ENTRY INITILIZATION ROUTINE * 39700000 * * 39750000 *********************************************************************** 39800000 S6A01010 EQU * 39850000 BALR TSVCBASE,D0 ADDRESSABILITY 39900000 BCTR TSVCBASE,D0 MAKE BASE EQUAL 39950000 BCTR TSVCBASE,D0 TO ENTRY POINT 40000000 USING IGC0006A,TSVCBASE 40050000 USING RBSECT,SVRBPTR ADDRESSABILITY TO THIS SVRB. 40100000 USING TCB,TCBPTR ADDRESSABILITY TO TCB. 40150000 USING CVT,ADDRCVT ADDRESSABILITY TO CVT. 40200000 USING PSA,PARMREG0 ADDRESSABILITY TO PSA. 40250000 LPR DCBPTR,PARMREG1 POSITIVE ADDRESS OF DCB 40300000 *********************************************************************** 40350000 * ISSUE A GETMAIN FOR A WORKAREA AND REG SAVE AREA. 40400000 *********************************************************************** 40450000 LR TCOMTABB,RETURN SAVE THE RETURN ADDRESS 40500000 LA PARMREG0,WRKLEN R0= LENGTH OF THE GOTTEN AREA. 40550000 L WORKA,PSAAOLD R7= ADDR OF THE NEW (CURRENT) ASCB 40600000 GETMAIN RU,LV=(0),BRANCH=YES ISSUE GETMAIN FOR WORKAREA 40650000 LR WKPARTB,PARMREG1 R11= ADDR OF THE GOTTEN AREA 40700000 USING WORKPART,WKPARTB ESTABLISH ADDR'ABILITY TO WORKAREA 40750000 XC WRKSTART(WRKLEN),WRKSTART CLEAR THE WORKAREA 40800000 MVC S6ASPL(S6ASPLEN),S6ASPLST INIT ESTAE PLIST @ZA11389 40850000 ST TCOMTABB,WRKREGRT SAVE THE RETURN ADDRESS 40900000 L ADDRCVT,FLCCVT R3= ADDR OF THE CVT DESTROYED BY GETMAIN 40950000 SPACE 41000000 ********************************************************************** 41050000 * ISSUE AN ESTAE HERE 41100000 ********************************************************************** 41150000 SPACE 41200000 ESTAE S6AESTAE,CT,PARAM=S6ASPL,XCTL=NO,BRANCH=YES, *41250000 SVEAREA=WRKREGSV,MF=(E,WRKESTAE) 41300000 SPACE 41350000 S6A01030 EQU * 41400000 MVI S6AFLAGS,N00 CLEAR SVC STATUS FLAGS 41450000 LA TCBPTR,D0(,TCBPTR) ADDR OF LOADNAME'S TCB 41500000 XC S6ATCBPT(S6ALEN),S6ATCBPT CLEAR TCB ADDR FOR MNL 41550000 SPACE 41600000 **** NOW WE CAN SEE IF THE ESTAE WAS OK..... 41650000 LTR REG15,REG15 WAS THE ESTAE OK 41700000 BNZ ESTAFAIL NO HANDLE THE ESTAE ERROR 41750000 SPACE 41800000 MVC WRKFLGSV(N1),TCBTSFLG SAVE THE TCB FLAG STATUS @YM04978 41850000 OI TCBTSFLG,TCBATT DISABLE FOR ATTN THROUGTHOUT SVC61. 41900000 TM TCBABF,TCBTCP IS TEST RUNNING 41950000 BZ S6A07010 NO, GO SAVE FOR LATER USE 42000000 L TCOMTABB,TCBTRN GET ADDR OF TCOMTAB 42050000 USING TCOMTAB,TCOMTABB ADDRESSABILITY TO TCOMTAB 42100000 L WORKA,WORKAREA ADDR OF AREA TO BE CHANGED 42150000 LR WORKB,TCBPTR SAVE MY TCB ADDR. 42200000 L TCBPTR,TSTTCB GET THE ADDR OF THE TEST TCB. 42250000 BAL RETURN,CHKSTKEY GO CHECK STORAGE KEY 42300000 LR WORKA,TCOMTABB ADDR OF AREA TO BE CHANGED 42350000 BAL RETURN,CHKSTKEY GO CHECK STORAGE KEY 42400000 L WORKA,ECBTST ADDR OF AREA TO BE CHANGED 42450000 BAL RETURN,CHKSTKEY GO CHECK STORAGE KEY 42500000 LR TCBPTR,WORKB RESTORE THE ADDR OF MY TCB. 42550000 BAL RETURN,CHKPPRB CHECK OUT THE P. P. FOR VALIDITY 42600000 LTR DCBPTR,DCBPTR IS ISSUER OVLY SUPERVISOR 42650000 BZ S6A06010 YES, GO SEARCH SVCINFO BLKS 42700000 SPACE 42750000 BAL RETURN,GETPARMS GET THE PARAMETERS @YM05036 42800000 SPACE 42850000 L R10,PSAAOLD ADDR OF THE NEW ASCB @ZA06226 42900000 L R10,ASCBASXB-ASCB(R10) ADDR OF THE ASXB @ZA06226 42950000 L R10,ASXBLWA-ASXB(R10) ADDR OF THE LWA @ZA06226 43000000 L R10,LWATEST-LWA(R10) ADDR OF SVCINFO BLOCK @ZA06226 43050000 ST SVCINFOB,TSTTRN HEAD OF SVCINFO BLK CHAIN @ZA06226 43100000 USING IKJEGSVQ,SVCINFOB 43150000 LTR SVCINFOB,SVCINFOB IS THEIR A CHAIN 43200000 BZ S6A02030 NO, GO SET UP TO HAVE MAIN 43250000 * LINE CREATE A TCB CNTRL 43300000 * CHAIN BLK FOR THIS TCB 43350000 S6A01050 EQU * 43400000 C TCBPTR,SVQTCBPT IS CNTRL BLK FOR THIS TCB 43450000 BNE S6A02010 NO, GO CHECK NEXT CNTRL BLK 43500000 * 43550000 * A TCB CONTROL BLOCK AND THE ASSOCIATED SVCINFO BLOCK CHAIN 43600000 * EXISTS FOR THE TCB THE SVC IS OPERATING UNDER. CHECK IF THIS 43650000 * IS A NEW TCB WHOSE ADDR IS THE SAME AS ONE THAT WAS DETACHED 43700000 * 43750000 L WORKA,RBLINK ADDR OF CALLERS PRB 43800000 TM RBSTAB2-RBSECT(WORKA),RBTCBNXT IS HE ONLY RB ON TCB 43850000 BZ S6A02050 NO, TCB NOT NEW, GO 43900000 TM RBCDFLGS-RBSECT(WORKA),RBCDLOAD HAS LOAD BEEN ISSUED 43950000 BO S6A02050 YES, TCB NOT NEW, GO 44000000 L WORKA,TCBLLS ADDR OF LOAD LIST 44050000 LTR WORKA,WORKA IS THEIR A LOAD LIST 44100000 BNZ S6A02050 YES, TCB NOT NEW, GO 44150000 * 44200000 * THE TCB IS NEW OR THE ONLY RB HAS XCTLED. START A NEW SVCINFO 44250000 * BLOCK CHAIN USING THE OLD TCB CONTROL BLOCK 44300000 * 44350000 LA WORKA,SVQBLKPT ADDR OF SVC CHAIN SLOT IN 44400000 * TCB CONTROL BLOCK 44450000 ST WORKA,S6ASIBCH SAVE FOR CHAINNING 44500000 B S6A03010 GO GET A SVCINFO BLOCK 44550000 S6A02010 EQU * 44600000 L SVCINFOB,SVQLNKPT NO, ADDR OF NEXT CNTRL BLK 44650000 LTR SVCINFOB,SVCINFOB IS THEIR ANY MORE 44700000 BNZ S6A01050 YES, GO SEE IF FOR THIS TCB 44750000 S6A02030 EQU * 44800000 ST TCBPTR,S6ATCBPT ADDR OF TCB FOR MAINLINE 44850000 B S6A03010 GO GET AN SVCINFO BLOCK 44900000 S6A02050 EQU * 44950000 L SVCINFOB,SVQBLKPT ADDR OF CHAIN FOR CURR TCB 45000000 DROP SVCINFOB 45050000 USING IKJEGSVB,SVCINFOB 45100000 BAL RETURN,S6A21010 GO SEARCH FOR END OF CHAIN 45150000 * OR DUPLICATE ON CHAIN 45200000 LR WORKA,SVCINFOB ADDR OF AREA TO BE CHANGED 45250000 TM S6AFLAGS,S6AFOVLY WAS A DUPLICATE FOUND 45300000 BO S6A03030 YES, GO CHECK MULTI-TASK SW 45350000 LA WORKA,SVBLNKPT END OF CHAIN, 0 NEXTBLK PTR 45400000 ST WORKA,S6ASIBCH SAVE FOR CHAINNING 45450000 S6A03010 EQU * 45500000 BAL RETURN,S6A11010 GO GET A NEW SVCINFO BLOCK 45550000 ST SVCINFOB,S6ASIBPT ADDR OF SVC BLK FOR MAINLNE 45600000 S6A03030 EQU * 45650000 LTR DCBPTR,DCBPTR IS ISSUER OVLY SUPERVISOR 45700000 BZ S6A04010 YES, GO PROCESS FOR OVLY 45750000 BAL RETURN,S6A31010 GO FILL IN SVCINFO BLOCK 45800000 L WORKA,S6ATCBPT CHAIN STATUS INDICATOR 45850000 LTR WORKA,WORKA DOES CHAIN EXIST FOR TCB 45900000 BNZ GETCHAIN NO, GO LET MAINLINE CHAIN @ZA06226 45950000 BAL RETURN,S6A41010 GO CHAIN BLOCK 46000000 EJECT 46050000 *********************************************************************** 46100000 * * 46150000 * IF TEST IS RUNNING, POST THE ECB * 46200000 * * 46250000 *********************************************************************** 46300000 SPACE 2 46350000 S6A04010 EQU * 46400000 L WORKB,WORKAREA BASE FOR TSTCWORK FROM 46450000 USING TSTCWORK,WORKB TCOMTAB 46500000 MVC CWORKCMD(L'SVBLDNAM),SVBLDNAM LOADNAME TO GENERAL WORK 46550000 * AREA FOR AT COMMAND 46600000 MVC CWORKCMD+L'SVBLDNAM(L'SVBATTR1+L'SVBATTR2),SVBATTR1 46650000 * ATTRIBUTES FOR AT CMD 46700000 DROP WORKB 46750000 SPACE 46800000 *********************************************************************** 46850000 * DO THE FOLLOWING; 46900000 * 1) FREE THE LOCAL LOCK, 2)ENQUE ON THE TEST ECB 'TSTSVCNQ' 46950000 * 3) ENABLE FOR ATTN'S, 4) WAIT ON MNL 47000000 *********************************************************************** 47050000 DROP WKPARTB RELEASE ADDR'ABILITY TO WORKAREA. 47100000 USING WORKPART,WORKB REESTABLISH WITH REG 8. 47150000 LR WORKB,WKPARTB REG 8 = WORKAREA ADDR. 47200000 S6ALOCKB EQU * 47250000 STM TCOMTABB,WORKA,WRKREGSV SAVE THE REGS ACROSS THE LOCK. 47300000 SPACE 47350000 S6ALOCK1 SETLOCK RELEASE,TYPE=LOCAL,RELATED=(LOCAL,IGC0006A(S6ALOCK1)) 47400000 LM TCOMTABB,WORKA,WRKREGSV RESTORE THE REGS. 47450000 TM TSTFLGS2,TSTLDF IS A LOAD IN PROCESS 47500000 BO S6A04020 YES THEREFORE DO NOT ENQ 47550000 OC DEFERTAB(L'DEFERTAB),DEFERTAB ANY DEFERED BKPTS @ZA06226 47600000 BZ S6A05015 NO, DON'T BOTHER MAINLINE @ZA06226 47650000 MVC WRKENQ(L'SVCNQ),SVCNQ MOVE ENQ WORD TO WORKAREA 47700000 LA WORKA,WRKENQ R7= ADDR OF THE ENQ ELEMENT 47750000 L R2,CVTPTR GET CVT ADDRESS @ZA07137 47800000 L R2,CVTTCBP-CVT(R2) GET ADDR OF TCB WORDS @ZA07137 47850000 L R2,N0(R2) GET ADDRESS OF CURRENT TCB @ZA07137 47900000 L R2,TCBJSCB-TCB(R2) GET JSCB ADDRESS @ZA07137 47950000 L R2,JSCBPSCB-IEZJSCB(R2) GET PSCB ADDRESS @ZA07137 48000000 USING PSCB,R2 SET ADDRESSABILITY TO PSCB @ZA07137 48050000 MVC WRKNQRNM(7),PSCBUSER USE USERID AS RNAME @ZA07137 48100000 MVI WRKNQRNM+7,C' ' BLANK OUT LAST RNAME BYTE @ZA07137 48150000 DROP R2 DONE WITH PSCB @ZA07137 48200000 LA R2,WRKNQRNM POINT TO RNAME @ZA07137 48250000 MVC WRKENQWK(LISTENQE),LISTENQF SET UP FOR ENQ. 48300000 LA SVRBPTR,D0(,SVRBPTR) CLEAR HIGH ORDER BYTE 48350000 ST SVRBPTR,WRKECB PLACE SVRB ADDR IN ECB @YM07115 48400000 ENQ ((7),(2),E,8),ECB=WRKECB,MF=(E,WRKENQWK) ISSUE ENQ 48450000 LTR REG15,REG15 IS THE RETURN CODE ZERO @YM07115 48500000 BZ S6A04020 YES THEREFORE CONTINUE @YM07115 48550000 SR PARMREG1,PARMREG1 CLEAR REG 1 @YM07115 48600000 IC PARMREG1,D3(REG15) PICK UP RETURN CODE @YM07115 48650000 LA WORKA,D4 R7= 4 (FOR COMPARE) @YM07115 48700000 CR PARMREG1,WORKA WAS THE RETURN CODE A 4 @YM07115 48750000 BNE S6A04020 NO THEREFORE CONTINUE @YM07115 48800000 NI TCBTSFLG,FF-TCBATT DO NOT DEFER ATTNS @YM07115 48850000 LA PARMREG1,WRKECB R1= ADDR OF THE ECB @YM07115 48900000 WAIT ECB=(1) WAIT FOR RESOURCE @YM07115 48950000 S6A04020 DS 0H CONTINUE BY POSTING MNL 49000000 NI TCBTSFLG,FF-TCBATT DO NOT DEFER ATTNS ANY LONGER. 49050000 MVC WRKSVRBS(3),ECBPP+1 SAVE PRIOR SVRB POINTER @ZA07138 49100000 * @ZA09259 49150000 * @ZA10462 49200000 ST SVRBPTR,ECBPP PTR TO MY SVRB FOR MAINLINE 49250000 L PARMREG1,ECBTST ADDR OF ECB TO POST 49300000 LA PARMREG1,D0(,PARMREG1) ZERO HIGH ORDER BYTE 49350000 L PARMREG0,POSTCODE COMPLETION CODE 49400000 POST (1),(0) POST TEST ECB 49450000 WAIT N1,ECB=ECBPP WAIT FOR MAINLINE 49500000 SPACE 49550000 SR REG15,REG15 CLEAR RETURN CODE 49600000 EJECT 49650000 *********************************************************************** 49700000 * * 49750000 * RETURN TO ISSUER OF SVC 061 * 49800000 * 1) ISSUE THE FREEMAIN, 2)DEQUE THE TSTSVCNQ ELEMENT, 3)RETURN* 49850000 * * 49900000 *********************************************************************** 49950000 DROP WORKB RELEASE ADDR'ABILITY TO WORKAREA 50000000 USING WORKPART,WKPARTB REESTABLISH WITH R11. 50050000 SPACE 2 50100000 S6A05010 EQU * 50150000 MVC ECBPP+1(3),WRKSVRBS RESTORE PRIOR SVRB POINT @ZA07138 50200000 * @ZA09259 50250000 * @ZA10462 50300000 TM TSTFLGS2,TSTLDF IS A LOAD IN PROCESS 50350000 BO S6A05015 YES THEREFORE DO NOT DEQ 50400000 LA WORKA,WRKENQ SETUP THE DEQUE 50450000 LA R2,WRKNQRNM POINT TO RNAME FOR DEQ @ZA07137 50500000 MVC WRKENQWK(LISTDEQE),LISTDEQF SET UP FOR DEQ. 50550000 DEQ ((7),(2),8),RET=HAVE,MF=(E,WRKENQWK) DEQ ON ECBTST WORD 50600000 XC WRKENQ(L'WRKENQ),WRKENQ CLEAR TEH ENQ ELEMENT 50650000 S6A05015 EQU * 50700000 *-*-* SETUP REG 14 FOR THE RETURN 50750000 MVC TCBTSFLG(N1),WRKFLGSV RESTORE TCB FLAG STATUS @YM06810 50800000 LR DCBPTR,REG15 SAVE THE RETURN CODE 50850000 L WORKA,WRKREGRT R7= THE RETRUN ADDRESS 50900000 LA PARMREG0,WRKLEN R0= LENGTH OF THE FREEMAIN 50950000 FREEMAIN R,LV=(0),A=(11) ISSUE FREEMAIN OF WORKAREA @YM04131 51000000 SPACE 51050000 ESTAE 0 REMOVE THE ESTAE 51100000 TM TCBABF,TCBTCP IS TEST RUNNING @YM02404 51150000 BZ S6A05020 CONTINUE WITH EXIT. @YM02404 51200000 NI TSTFLGS4,FF-TSTRERTN TURN OFF THE RERTY SW 51250000 S6A05020 EQU * EXIT FROM SCV 61. @YM02404 51300000 LR RETURN,WORKA R14= ADDR OF RETURN 51350000 LR REG15,DCBPTR RESTORE THE RETURN CODE 51400000 LM PARMREG0,SOMESAVE,RBGRSAVE RESTORE REGS FROM MY SVRB 51450000 BR RETURN RETURN TO ISSUER OF SVC 61 51500000 EJECT 51550000 *********************************************************************** 51600000 * * 51650000 * SUB ROUTINES FOR MAINSTREAM * 51700000 * * 51750000 *********************************************************************** 51800000 SPACE 2 51850000 * 51900000 * GET A SVCINFO BLOCK 51950000 * 52000000 S6A11010 EQU * 52050000 USING IKJEGSVB,SVCINFOB 52100000 L PARMREG0,S6ASVBLV GETMAIN, 36 BYTES IN SP255 52150000 STM SEGTABAD,TCOMTABB,WRKREGSV SAVE TEH REGS. 52200000 L WORKA,PSAAOLD R7= ADDR OF THE OLD ASCB. 52250000 GETMAIN RU,BRANCH=YES,LV=(0),SP=255 GET AN SVCINFO BLOCK 52300000 LA SVCINFOB,D0(,PARMREG1) ADDRESS OF GOTTEN CORE 52350000 LM SEGTABAD,TCOMTABB,WRKREGSV RESTORE TEH REGS. 52400000 XC SVBLDNAM(SVBLNKPT-SVBLDNAM+L'SVBLNKPT),SVBLDNAM LAST 52450000 * NEXT BLK ADDR IS ZERO 52500000 BR RETURN RETURN TO CALLER 52550000 DROP SVCINFOB 52600000 EJECT 52650000 * 52700000 * SEARCH SVCINFO BLOCK CHAIN FOR THE END OF THE CHAIN OR A 52750000 * DUPLICATE LOADNAME ON THE CHAIN. IF THE LOADNAME DOES NOT 52800000 * EXIST ON THE CHAIN OR THE DUPLICATE IS HUNG OFF OF A 52850000 * DIFFERENT TCB, SET UP TO ADD ANOTHER SVCINFO BLOCK TO THE 52900000 * CHAIN. IF A DUPLICATE EXISTS ON THE SAME TCB, SET UP TO 52950000 * OVERLAY THE OLD SVCINFO BLOCK. 53000000 * 53050000 USING IKJEGSVB,SVCINFOB 53100000 S6A21010 EQU * 53150000 L WORKA,WRKBLDE ADDR OF LOADNAME-BLDL ENTRY 53200000 SR PARMREG1,PARMREG1 CLEAR REGISTER 53250000 S6A21030 EQU * 53300000 CLC SVBLDNAM(L'SVBLDNAM),D0(WORKA) IS LOADNAME ON CHAIN 53350000 BE S6A21050 YES, GO INDICATE OVLY BLK 53400000 C PARMREG1,SVBLNKPT IS IT END OF CHAIN 53450000 BCR EQUAL,RETURN YES, GO RETURN TO CALLER 53500000 L SVCINFOB,SVBLNKPT NO, POINT TO NEXT BLK 53550000 B S6A21030 GO SEARCH NEXT BLOCK 53600000 S6A21050 EQU * 53650000 OI S6AFLAGS,S6AFOVLY YES, INDICATE OVLY-NO CHAIN 53700000 BR RETURN RETURN TO CALLER 53750000 DROP SVCINFOB 53800000 EJECT 53850000 * 53900000 * FILL IN SVCINFO BLOCK 53950000 * 54000000 S6A31010 EQU * 54050000 USING IKJEGSVB,SVCINFOB 54100000 L WORKA,WRKBLDE ADDR OF BLDL ENTRY 54150000 USING BLDLENTY,WORKA BASE FOR DESCRIPTIVE DSECT 54200000 MVC SVBLDNAM(L'SVBLDNAM),MNAME LOAD MODULE NAME 54250000 ST TCBPTR,SVBTCBPT ADDRESS OF LOADNAME'S TCB 54300000 MVC SVBTTR(L'SVBTTR),MBEGTTR TTR OF BEGINNING OF MEMBER 54350000 MVC SVBATTR1(L'SVBATTR1+L'SVBATTR2),MATTRIB ATTRIBUTES 54400000 * OF MEMBER 54450000 MVC SVBCNCAT(L'SVBCNCAT),MCONCAT CONCATENATION NO. OF PDS 54500000 MVC SVBDDNAM(L'SVBDDNAM),BLANKS BLANK DDNAME FIELD 54550000 DROP WORKA 54600000 USING IHADCB,DCBPTR 54650000 C DCBPTR,CVTLINK IS DCB USED, SYSTEM DCB 54700000 BE S6A31070 YES, GO CHECK FOR LINKLIB 54750000 OI SVBFLGS1,SVBDDNME INDICATE DDNAME AVAILABLE 54800000 L WORKA,TCBTIO ADDRESS OF TIOT FROM TCB 54850000 USING TIOENTRY,WORKA 54900000 LA WORKA,D0(,WORKA) CLEAR HIGH ORDER BYTE 54950000 AH WORKA,DCBTIOT ADDRESS OF DCB DDNAME ENTRY 55000000 MVC SVBDDNAM(L'SVBDDNAM),TIOEDDNM DDNAME FROM TIOT ENTRY 55050000 CLC SVBDDNAM(L'SVBDDNAM),BLANKS IS DATASET CONCATENATED 55100000 BNE S6A31090 NO, DDNAME OK, GET LOAD ADR 55150000 L WORKB,TCBTIO ADDRESS OF TIOT FROM TCB 55200000 DROP WORKA 55250000 USING IEFTIOT1,WORKB ADDRESSABILITY TO TIOT 55300000 LA WORKB,TIOENTRY ADDRESS OF FIRST ENTRY 55350000 DROP WORKB RELEASE ADDR'ABILITY TO TIOT 55400000 USING TIOENTRY,WORKB ESTABLISH ADDR'ABILITY TO DD ENTRY 55450000 S6A31030 EQU * 55500000 CR WORKA,WORKB IS THIS ENTRY DCB DD ENTRY 55550000 BE S6A31090 YES, GOT DDNAME, GO GET LA 55600000 CLC BLANKS(L8),TIOEDDNM IS TIOT ENTRY DDNAME BLANK 55650000 BE S6A31050 YES, GO POINT TO NEXT ENTRY 55700000 MVC SVBDDNAM(L'SVBDDNAM),TIOEDDNM NO, GET DDNAME FROM TIOT 55750000 S6A31050 EQU * 55800000 SR PARMREG1,PARMREG1 CLEAR REGISTER TO ZEROES 55850000 IC PARMREG1,TIOELNGH LENGTH OF THIS TIOT ENTRY 55900000 AR WORKB,PARMREG1 ADDRESS OF NEXT DD ENTRY 55950000 B S6A31030 GO CHECK FOR END OF LOOP 56000000 S6A31070 EQU * 56050000 XC SVBDDNAM(L'SVBDDNAM),SVBDDNAM CLEAR DDNAME TO ZEROES 56100000 CLI SVBCNCAT,N00 IS DATASET LINKLIB 56150000 BNE S6A31090 NO, CAN DO NOTHING, GO ON 56200000 OI SVBFLGS1,SVBLNKLB INDICATE DATASET IS LINKLIB 56250000 S6A31090 EQU * 56300000 L WORKA,WRKEXTL ADDR OF EXTENT LIST 56350000 USING XTLST,WORKA ADDR'ABILITY TO EXTLIST 56400000 L WORKB,XTLNRFAC NUMBER OF SCATTERED BLOCKS 56450000 SLL WORKB,N2 TIMES NO. BYTES IN A WORD 56500000 L WORKA,XTLMSBLA(WORKB) PTR TO ADDR OF FIRST BLOCK 56550000 DROP WORKA 56600000 ST WORKA,SVBEP LOADED ADDR TO SVCINFO BLK 56650000 BR RETURN RETURN TO CALLER 56700000 DROP WORKB,SVCINFOB,DCBPTR 56750000 EJECT 56800000 * 56850000 * IF NOT OVERLAYING A SVCINFO BLOCK, ADD NEW ONE TO CHAIN OR 56900000 * START THE CHAIN 56950000 * 57000000 S6A41010 EQU * 57050000 TM S6AFLAGS,S6AFOVLY DID WE OVLY A BLOCK 57100000 BCR ONES,RETURN YES, RETURN TO CALLER 57150000 TM S6AFLAGS,S6ATCBCH START CHAIN FROM TCB 57200000 BZ S6A41030 NO, GO ADD TO EXISTNG CHAIN 57250000 SR PARMREG1,PARMREG1 CLEAR REGISTER 57300000 ICM PARMREG1,8,TCBABF FLAG BYTE FROM TCBTRN FIELD @ZA01570 57350000 OR PARMREG1,SVCINFOB FLAGS PLUS HEAD OF CHAIN 57400000 ST PARMREG1,TCBTRN INTO TRN FIELD IN TCB 57450000 BR RETURN RETURN TO CALLER 57500000 S6A41030 EQU * 57550000 L WORKB,S6ASIBCH ADDR OF 0 NEXTBLK FOR CHAIN 57600000 ST SVCINFOB,D0(,WORKB) ADD NEW BLOCK TO CHAIN 57650000 BR RETURN RETURN TO CALLER 57700000 EJECT 57750000 *********************************************************************** 57800000 * * 57850000 * COMPARE STORAGE KEY IN TCB TO STORAGE KEY OF ADDRESS PASSED * 57900000 * IN WORKA * 57950000 * * 58000000 *********************************************************************** 58050000 SPACE 2 58100000 CHKSTKEY EQU * 58150000 SPACE 58200000 STM PARMREG1,RETURN,WRKREGSV SAVE REGS 1-14 58250000 LR PARMREG1,WORKA REG1 = ADDR TO BE CHECKED 58300000 SR DCBPTR,DCBPTR CLEAR REG 2 (SECOND ADDR OF RANGE) 58350000 L REG15,CVT0VL00 REG 15= ADDR OF VALIDITY CHECK ROUTINE 58400000 BALR RETURN,REG15 BRANCH TO VALIDITY CHECK ROUTINE 58450000 LM PARMREG1,RETURN,WRKREGSV RESTORE REGS 1-14 58500000 BNZ S6ALOCKA ERROR THEREFORE RETURN. 58550000 BR RETURN RETURN BACK TO CALLER 58600000 EJECT 58650000 *********************************************************************** 58700000 * * 58750000 * RELEASE THE LOCAL LOCK 58800000 * * 58850000 *********************************************************************** 58900000 SPACE 58950000 S6ALOCKA EQU * 59000000 LA WORKB,WRKREGSV R8= ADDR OF REG SAVE AREA @YM02260 59050000 STM TCOMTABB,WORKA,D0(WORKB) SAVE REGS ACROSS LOCK @YM02260 59100000 SPACE 59150000 S6ALOCK2 SETLOCK RELEASE,TYPE=LOCAL,RELATED=(LOCAL,IGC0006A(S6ALOCK2)) 59200000 LM TCOMTABB,WORKA,D0(WORKB) RESTORE THE REGS. @YM02260 59250000 B S6A05015 RETURN TO CALLER 59300000 EJECT 59350000 *********************************************************************** 59400000 * * 59450000 * THIS ROUTINE WILL PASS THE LOADNAME OF A LOAD MODULE LINK * 59500000 * EDITTED IN OVERLAY TO THE AT COMMAND WHEN THE OVERLAY * 59550000 * SUPERVISOR BRINGS A NEW SEGMENT INTO CORE * 59600000 * * 59650000 *********************************************************************** 59700000 SPACE 2 59750000 USING IKJEGSVQ,SVCINFOB 59800000 SR REG15,REG15 CLEAR RETURN CODE 59850000 S6A06010 EQU * 59900000 L SEGTABAD,RBGRS12 ADDRESS OF SEGMENT TABLE 59950000 LA SEGTABAD,D0(,SEGTABAD) ADDRESS OF SEGMENT TABLE 60000000 L R10,PSAAOLD ADDR OF THE NEW ASCB @ZA06226 60050000 L R10,ASCBASXB-ASCB(R10) ADDR OF THE ASXB @ZA06226 60100000 L R10,ASXBLWA-ASXB(R10) ADDR OF THE LWA @ZA06226 60150000 L R10,LWATEST-LWA(R10) ADDR OF SVCINFO BLOCK @ZA06226 60200000 ST SVCINFOB,TSTTRN HEAD OF SVCINFO BLOCK CHAIN @ZA06226 60250000 S6A06030 EQU * 60300000 LTR SVCINFOB,SVCINFOB IS THEIR A CHAIN 60350000 BZ S6ALOCKA NO, GO SET UP RETURN 60400000 C TCBPTR,SVQTCBPT THIS CHAIN FOR CURRENT TCB 60450000 BE S6A06050 YES, GO SEARCH CHAIN 60500000 L SVCINFOB,SVQLNKPT ADDR OF NEXT TCB CNTRL BLK 60550000 B S6A06030 GO CHECK FOR A CHAIN 60600000 S6A06050 EQU * 60650000 L SVCINFOB,SVQBLKPT PTR TO FIRST BLK ON CHAIN 60700000 DROP SVCINFOB 60750000 USING IKJEGSVB,SVCINFOB 60800000 S6A06070 EQU * 60850000 C SEGTABAD,SVBEP IS SEGTAB FOR THIS SVC BLK 60900000 BE S6A06110 YES, GO CHECK FOR OVLY 60950000 S6A06090 EQU * 61000000 C DCBPTR,SVBLNKPT IS THIS THE LAST BLOCK 61050000 BE S6ALOCKA YES, GO SET UP RETURN 61100000 L SVCINFOB,SVBLNKPT POINT TO NEXT SVCINFO BLK 61150000 B S6A06070 GO CHECK NEXT SVCINFO BLK 61200000 S6A06110 EQU * 61250000 TM SVBATTR1,SVBOVLY IS LOAD MODULE IN OVERLAY 61300000 BZ S6A06090 NO, GO BACK-CONTINUE SEARCH 61350000 B S6A03030 YES, GO PASS LOADNAME TO 61400000 * AT COMMAND 61450000 DROP SVCINFOB 61500000 EJECT 61550000 *********************************************************************** 61600000 * * 61650000 * THIS ROUTINE WILL SAVE THE SVC INFO IF TEST IS NOT RUNNING * 61700000 * * 61750000 *********************************************************************** 61800000 SPACE 2 61850000 USING IKJEGSVQ,SVCINFOB 61900000 S6A07010 EQU * 61950000 SPACE 62000000 BAL RETURN,GETPARMS OBTAIN PARMS FROM CONTENT SUPR @YM05036 62050000 SPACE 62100000 BAL RETURN,CHKPPRB CHECK OUT THE PP TYPE. 62150000 L SVCINFOB,TCBTRN TRN FIELD OF TCB CAN BE 62200000 * HEAD OF SVCINFO BLK CHAIN 62250000 * ZERO 62300000 LA SVCINFOB,D0(,SVCINFOB) CLEAR TRN FLAGS FIELD 62350000 LTR SVCINFOB,SVCINFOB IS IT FIRST TIME 62400000 BNZ S6A07070 NO, GO SET UP TO SEARCH 62450000 OI S6AFLAGS,S6ATCBCH INDICATE CHAIN FROM TCB 62500000 S6A07030 EQU * 62550000 BAL RETURN,S6A11010 GO GET AN SVCINFO BLOCK 62600000 S6A07050 EQU * 62650000 BAL RETURN,S6A31010 GO FILL IN GOTTEN SVC BLK 62700000 BAL RETURN,S6A41010 GO START CHAIN FROM TCBTRN 62750000 SR REG15,REG15 CLEAR RETURN CODE 62800000 B S6ALOCKA GO SET UP RETURN TO ISSUER 62850000 DROP SVCINFOB 62900000 USING IKJEGSVB,SVCINFOB 62950000 S6A07070 EQU * 63000000 BAL RETURN,S6A21010 GO SEARCH FOR DUP OR END 63050000 LR WORKA,SVCINFOB ADDRESS OF AREA TO CHANGE 63100000 BAL RETURN,CHKSTKEY GO CHECK STORAGE KEY 63150000 TM S6AFLAGS,S6AFOVLY ARE WE GOING TO OVLY A BLK 63200000 BO S6A07050 YES, GO SET UP TO OVLY BLK 63250000 LA WORKA,SVBLNKPT LAST 0 NEXTBLK ADDRESS 63300000 ST WORKA,S6ASIBCH SAVE FOR CHAINNING 63350000 B S6A07030 GO SET UP TO GET A SVC BLK 63400000 EJECT 63450000 *********************************************************************** 63500000 * THE SVC MUST VARIFY THAT THE PROGRAM IT IS SERVICING IS NOT * 63550000 * PRIVILDGED. (P.P. KEY NOT SUPERVISOR STATE, AND NOT AN SVRB) * 63600000 *********************************************************************** 63650000 SPACE 63700000 CHKPPRB EQU * 63750000 LR WORKB,SVRBPTR SAVE MY RB ADDR. 63800000 LTR DCBPTR,DCBPTR IS IT OVERLAY SUPR? 63850000 BZ CHKTCB YES IT IS OVERLAY SUPR. 63900000 L SVRBPTR,RBLINK GET THE ADDR OF PP RB. 63950000 TM RBCDFLGS,RBCDATCH CREATED BY ATTACH? 64000000 BO CHKTCB YES,GO VERIFY TCB KEY 64050000 L SVRBPTR,RBLINK GET THE ADDR OF PP RB. 64100000 TM RBSTAB1,RBFTP-RBFTIRB WHAT KIND OF RB IS IT(PRB OR IRB) 64150000 BNZ PPRBFAIL IT IS NOT A PRB OR IRB. 64200000 TM RBOPSW+N1,PSWBIT DETERMINE IF IN PP MODE 64250000 BZ PPRBFAIL NOT IN PP MODE. 64300000 TM RBOPSW+N1,PSWPKEYF IS THE PROTECT KEY ZWRO. 64350000 BZ PPRBFAIL NO IT IS KEY 0-7 64400000 LR SVRBPTR,WORKB RESTORE MY RB POINTER 64450000 BR RETURN ALL IS OK THEREFORE EXIT. 64500000 SPACE 64550000 PPRBFAIL EQU * IF TEST IS RUNNING INDICATE ERROR 64600000 * ELSE JUST RETURN DOING NOTHING. 64650000 LR SVRBPTR,WORKB RESTORE MY RB POINTER 64700000 TM TCBABF,TCBTCP IS TEST RUNNING. @YM02404 64750000 BZ S6ALOCKA EXIT WITHOUT ERROR MSG. @YM02404 64800000 LA WORKB,WRKREGSV R8= ADDR OF REG SAVE AREA @YM02260 64850000 STM TCOMTABB,WORKA,D0(WORKB) SAVE REGS ACROSS LOCK @YM02260 64900000 SPACE 64950000 S6ALOCK3 SETLOCK RELEASE,TYPE=LOCAL,RELATED=(LOCAL,IGC0006A(S6ALOCK3)) 65000000 LM TCOMTABB,WORKA,D0(WORKB) RESTORE THE REGS. @YM02260 65050000 L REG15,IOVCON R15= ADDR OF IO FOR MSG @ZA04126 65100000 MVC TSTIOPRM(IOPRMLN),IOPRM PLACE IO PARM LIST IN WORKAREA 65150000 MVI TSTIOPRM,MSGINDC PLACE MSG INDICATOR IN LIST 65200000 LA PARMREG1,TSTIOPRM R1= ADDR OF THE IO PARM LIST 65250000 L SOMESAVE,REGSAVE6 R13= ADDR OF WORKAREA FOR IO @YM07131 65300000 BALR 14,REG15 GO TO IO. @ZA04126 65350000 B S6A05015 EXIT IT AS ERROR WAS HANDLED. 65400000 CHKTCB TM TCBPKF,PSWPKEYF IS THIS SUPERVISOR KEY? @YM02404 65450000 BZ PPRBFAIL YES,ERROR EXIT @YM02404 65500000 TM TCBFLGS3,TCBFSM IS IT IN SUPR STATE @YM02404 65550000 BO PPRBFAIL YES THEREFORE HANDLE ERROR. @YM02404 65600000 LR SVRBPTR,WORKB RESTORE MY RB POINTER @YM02404 65650000 BR RETURN ALL IS OK THEREFORE EXIT. @YM02404 65700000 EJECT 65750000 ******** 65800000 * GET 12 BYTES OF SP255 STORAGE AND CHAIN THE SVCINFO BLOCKS 65850000 * FILLING IN THE TCB ADDR AND BLOCK PTR 65900000 ******** 65950000 SPACE 5 66000000 GETCHAIN EQU * 66050000 L R7,PSAAOLD GET ASCB ADDR @ZA06226 66100000 L R0,CHAINLEN 12 BYTES SP=255 @ZA06226 66150000 GETMAIN RU,LV=(0),BRANCH=YES,SP=255 GET THE STORAGE @ZA06226 66200000 XC N0(N12,R1),N0(R1) ZERO THE STORAGE @ZA06226 66250000 OC N4(N8,R1),S6ATCBPT FILL IN TCB AND BLOCK PTR @ZA06226 66300000 L R7,PSAAOLD GET ASCB ADDR @ZA06226 66350000 L R7,ASCBASXB-ASCB(R7) GET ASXB ADDR @ZA06226 66400000 L R7,ASXBLWA-ASXB(R7) GET LWA ADDR @ZA06226 66450000 MVC N0(4,R1),LWATEST-LWA(R7) PUSH DOWN THE CHAIN @ZA06226 66500000 ST R1,LWATEST-LWA(R7) DITTO @ZA06226 66550000 ST R1,TSTTRN PTR ALSO IN TCOMTAB @ZA06226 66600000 XC S6ATCBPT(L'S6ATCBPT),S6ATCBPT ZERO THIS FIELD @ZA06226 66650000 * TO PREVENT MNL FROM CHAINING @ZA06226 66700000 B S6A04010 GO TO MNL IF REQUIRED @ZA06226 66750000 EJECT 66800000 *********************************************************************** 66850000 * GET THE BLDL ENTRY AND EXTENT LIST FROM THE CALLERS SVRB 66900000 *********************************************************************** 66950000 SPACE 67000000 GETPARMS EQU * GET PARMS FROM CONTENT SUPR SVRB. 67050000 SPACE 67100000 L WORKA,RBLINK GET THE ADDR OF CALLERS RB 67150000 L WORKA,X74(WORKA) R7= CALLERS WORK AREA 67200000 USING WKAREA,WORKA ESTABLISH ADDR'ABILITY TO CALLERS AREA 67250000 LA PARMREG1,WKNAME ADDR OF THE BLDL NAME 67300000 ST PARMREG1,WRKBLDE PLACE THE ADDR INTO TEMP WORKAREA 67350000 L WORKA,WKCDADDR R7= ADDR OF THE CDE 67400000 DROP WORKA RELEASE ADDR'ABILITY TO CALLER AREA 67450000 USING CDENTRY,WORKA ADDR'ABILITY TO CDE 67500000 CDESERCH EQU * CDE SEARCH LOOP 67550000 TM CDATTR,CDMIN IS THE CDE A MINOR 67600000 L WORKA,CDXLMJP ADDR OF THE EXT LIST (OR MAJOR) 67650000 BO CDESERCH LOOP BACK FINDING MAJOR 67700000 ST WORKA,WRKEXTL SAVE ADDR OF THE EXTLIST.. 67750000 BR RETURN EXIT TO CALLER @YM05036 67800000 SPACE 67850000 DROP WORKA 67900000 EJECT 67950000 *********************************************************************** 68000000 * * 68050000 * WE HAVE TO DETERMINE WHAT TO DO WITH THE ESTAE FAILURE. * 68100000 * 1) IF TEST IS RUNNING END THE SESSION. * 68150000 * 2) IF TEST IS NOT RUNNING RETURN WITH 4. * 68200000 * * 68250000 *********************************************************************** 68300000 SPACE 68350000 ESTAFAIL DS 0H ESTAE FAILED. 68400000 SPACE 68450000 TM TCBABF,TCBTCP IS TEST RUNNING 68500000 BZ S6A08010 NO, RETURN TO CALLER WITH 4. 68550000 L TCOMTABB,TCBTRN GET ADDR OF TCOMTAB 68600000 USING TCOMTAB,TCOMTABB ADDRESSABILITY TO TCOMTAB 68650000 OI TSTFLGS4,TSTSVCAB INDICATE TO MNL TO TERMINATE 68700000 B S6ALOCKB POST MNL TO END TEST SESSION.. 68750000 S6A08010 DS 0H RETURN WITH 4. 68800000 LA REG15,D4 REGISTER 15 = 4.. 68850000 B S6ALOCKA RETURN. 68900000 EJECT 68950000 *********************************************************************** 69000000 * * 69050000 * THIS ROUTINE IS USED TO SYNCH TO IKJEGSTA FOR HANDLING ABENDS 69100000 * * 69150000 *********************************************************************** 69200000 SPACE 69250000 SPACE 69300000 S6AESTAE DS 0F START OF DUMMY STA 69350000 USING S6AESTAE,REG15 RE-ESTABLISH ADDR'ABILITY @YM04131 69400000 L TCBPTR,FLCCVT R4= ADDR OF CVT @YM04131 69450000 USING CVT,TCBPTR ADDR'ABILITY TO CVT @YM04131 69500000 L TCBPTR,CVTTCBP R4= ADDR OF TCB @YM04131 69550000 L TCBPTR,D4(,TCBPTR) R1= ADDR OF THE TCB @YM04131 69600000 USING TCB,TCBPTR ADDRABILITY TO TCB @YM04131 69650000 L TCOMTABB,TCBTRN R9= ADDR OF TCOMTAB 69700000 TM TCBABF,TCBTCP IS TEST RUNNING. 69750000 BZ ESTAERR NO TEST IS NOT IN CONTROL 69800000 USING TCOMTAB,TCOMTABB ADDR'ABILITY TO TCOMTAB 69850000 L REG15,STAEVCON R15= ADDR OF IKJEGSTA @ZA04126 69900000 LR R13,RETURN SAVE R14 AROUND BALR @ZA04126 69950000 * R13 IS NOT USED BY IKJEGSTA @ZA04126 70000000 BALR RETURN,REG15 TRANSFER CONTROL TO IKJEGSTA @ZA04126 70050000 LTR R1,R1 IS A WORK AREA AVAIL ?? @ZA04126 70100000 BZR R13 NO, JUST RETURN @ZA04126 70150000 USING SDWA,R1 YES-SET UP FOR RETRY @ZA11389 70200000 L R3,SDWAPARM GET W/A ADDRESS FOR RETRY @ZA11389 70250000 ST R3,SDWASR03 SAVE FOR RETRY RTN. @ZA11389 70300000 ST TCOMTABB,SDWASR09 SAVE PTR TO TCOMTAB @ZA11389 70350000 L TSVCBASE,N8(,R3) GET BASE REG=RTSVCBASE @ZA11389 70400000 ST TSVCBASE,SDWASR06 SAVE FOR RETRY ROUTINE @ZA11389 70450000 SETRP RETADDR=(PARMREG0),RECORD=YES,FRESDWA=YES,RC=4, X70500000 RETREGS=YES @ZA11389 70550000 BR R13 RETURN TO CALL @ZA04126 70600000 DROP REG15 RELAESE TEMP BASE. 70650000 SPACE 70700000 ESTAERR DS 0H SOMETHING IS A MESS PERCOLATE.. 70750000 SR REG15,REG15 CLEAR REG 15.. 70800000 BR RETURN EXIT TO CALLER 70850000 EJECT 70900000 *********************************************************************** 70950000 * * 71000000 * THIS ROUTINE IS THE RETRY ROUTINE OF IGC0006A * 71050000 * ON ENTRY ALL MY REGISTERS ARE VALID DUE TO SETRP. @ZA11389* 71100000 * * 71150000 *********************************************************************** 71200000 SPACE 71250000 S6ARETRY DS 0F THE START OF THE RETRY ROUTINE 71300000 SR REG15,REG15 CLEAR RETURN CODE 71350000 CLC SVCNQ(L'SVCNQ),WRKENQ IS THE DEQ IN EFFECT. 71400000 BE S6A05010 NO THEREFORE EXIT TO CALLER 71450000 B S6A05015 EXIT TO THE CALLER. 71500000 EJECT 71550000 *********************************************************************** 71600000 * * 71650000 * CONSTANTS * 71700000 * * 71750000 *********************************************************************** 71800000 SPACE 2 71850000 DS 0F 71900000 IOVCON DC V(IKJEGIO) ADDR OF MSG ISSUER FOR BALR @ZA04126 71950000 STAEVCON DC V(IKJEGSTA) ADDR OF ESTAE PROCESSOR @ZA04126 72000000 SVCNQ DC CL8'IKJTMPNM' THIS IS THE SVC (61, 97) ENQ LOCK@ZA07137 72050000 POSTCODE DC X'04000000' COMPLETION CODE FOR ECB 72100000 ADDRMASK DC X'00FFF800' AND FIELD FOR AREA ADDRESS 72150000 KEYMASK DC X'000000F0' AND FIELD FOR AREA KEY 72200000 S6ASVBLV DC AL1(0) GETMAIN PARMS FOR SVC BLK @ZA06226 72250000 DC AL3(36) GET 36 BYTES IN SP 255 72300000 CHAINLEN DC AL1(0) SUBPOOL NUMBER @ZA06226 72350000 DC AL3(12) 12 BYTES @ZA06226 72400000 BLANKS DC 8C' ' BLANKS FOR CLEARING WKAREAS 72450000 ENABLE DC X'FF' ENABLED SYSTEM MASK 72500000 MSGINDC EQU X'02' MSG INDICATOR FOR LIST FORM. 72550000 PSWBIT EQU X'01' PSW PP MODE BIT. 72600000 PSWPKEYF EQU X'80' PSW PP MODE KEYS. 72650000 SUPERZAP DC 50C'Z' SUPERZAP PATCH AREA 72700000 SPACE 72750000 S6ASPLST IKJEGSPL RTRY=S6ARETRY,ABNTB=STAETAB,MODNM=IGC0006A, @ZA11389*72800000 TNM=TEST-SVC @ZA11389 72850000 S6ASPLEN EQU *-S6ASPLST @ZA11389 72900000 SPACE 72950000 STAETAB DS 0F ABEND TABLE FOR IKJEGSTA 73000000 DC X'FF' NO ENTRIES IN TABLE 73050000 SPACE 3 73100000 * ISSUE THE LIST FORM OF THE ENQ.............. 73150000 SPACE 73200000 LISTENQF ENQ (LISTENQF,LISTENQF,E,8),ECB=LISTENQF,MF=L 73250000 LISTENQE EQU *-LISTENQF LENGTH OF LIST FORM OF ENQ 73300000 SPACE 3 73350000 * ISSUE THE LIST FORM OF THE DEQ.............. 73400000 SPACE 73450000 LISTDEQF DEQ (LISTDEQF,LISTDEQF,8),RET=HAVE,MF=L 73500000 LISTDEQE EQU *-LISTDEQF LENGTH OF LIST FORM OF DEQ 73550000 SPACE 73600000 IOPRM IKJEGSIO MSG,FIRST=M0053,SECOND=M0217,ID=S6A01,MF=(L) 73650000 IOPRMLN EQU *-IOPRM GET THE LENGTH OF PARM LIST 73700000 EJECT 73750000 *********************************************************************** 73800000 * * 73850000 * DSECTS * 73900000 * * 73950000 *********************************************************************** 74000000 SPACE 2 74050000 WORKPART DSECT , THIS DSECT DESCRIBES THE GENERAL SAVE AREA 74100000 * GETMAIN USED AS A WORK AREA 74150000 * 74200000 WRKSTART DS 0F START OF WORK AREA 74250000 * ***************************************************** @ZA11389 74300000 * * UNDER NO CIRCUMSTANCES MAY S6ASPL BE MOVED. * @ZA11389 74350000 * * IT'S POSITION MAKES IT POSSIBLE TO RE-INIT * @ZA11389 74400000 * * REGISTERS NEEDED BY ESTAE/RETRY ROUTINES * @ZA11389 74450000 * ***************************************************** @ZA11389 74500000 S6ASPL DS XL(S6ASPLEN) ESTAE PARAMETER LIST @ZA11389 74550000 WRKREGSV DS 18F REGISTER SAVE AREA FOR BRANCH ENTRIES 74600000 WRKESTAE DS 4F ESTAE WORK AREA 74650000 WRKENQ DS CL8 STORAGE AREA FOR THE ENQ CHARACTER STRING 74700000 WRKREGRT DS 1F SAVE RETURN ADDRESS 74750000 WRKEXTL DS 1F ADDR OF THE EXTLIST 74800000 WRKBLDE DS 1F ADDR OF THE BLD ENTRY 74850000 WRKFLGSV DS 1X FLAG SAVE AREA @YM04978 74900000 WRKSVRBS DS 3X SAVE AREA FOR PRIOR SVRB ADDRESS @ZA07138 74950000 * FROM ECBPP @ZA09259,@ZA10462 75000000 WRKECB DS 1F WAIT ECB FOR ENQ RESOURCE @YM07115 75050000 ORG WRKREGSV REESTABLISH TO TOP 75100000 WRKENQPR DS 1F PREFIX FOR ECB ADDRESS @YM07115 75150000 WRKENQWK DS 0F ENQ WORKAREA 75200000 WRKENQFG DS X FLAG FOR END OF LIST 75250000 WRKENQTP DS 2X TPYE INDICATOR 75300000 WRKENQRC DS X RETURN CODE FROM ENQ 75350000 ORG 75400000 WRKNQRNM DS CL8 RNAME FOR ENQ/DEQ @ZA07137 75450000 WRKLEN EQU *-WRKSTART LENGTH OF GENERAL WORKAREA @ZA11389 75500000 EJECT 75550000 IHASCVT 75600000 EJECT 75650000 IHAFETWK 75700000 EJECT 75750000 IHACDE 75800000 EJECT 75850000 IHAXTLST 75900000 EJECT 75950000 IHAPSA 76000000 EJECT 76050000 IKJRB 76100000 * IN MY SVRB AS USED AS A WORK AREA 76150000 * 76200000 ORG RBEXSAVE 76250000 S6ATCBPT DS A TCB ADDRESS FOR MAINLINE 76300000 S6ASIBPT DS A SVC BLK ADDR FOR MAINLINE 76350000 S6ASIBCH DS A ADDR OF 0 NEXTBLK IN CHAIN 76400000 S6ARETRN DS A RETURN ADDRESS 76450000 S6ADUMMY DS H HALF WORD OF SPACE 76500000 AREAKEY DS X STORAGE KEY OF AREA 76550000 S6AFLAGS DS X FLAGS FOR SVC PROCESSING 76600000 S6ATCBCH EQU B'10000000' CHAIN SVB FROM TCB. 76650000 S6AFOVLY EQU B'01000000' DUPLICATE SVB FOUND. 76700000 * B'00XXXXXX' RESERVED BITS. 76750000 S6ALEN EQU *-S6ATCBPT LENGTH OF SVRB WORKAREA 76800000 EJECT 76850000 IKJEGSVB 76900000 EJECT 76950000 IKJEGSVQ 77000000 EJECT 77050000 BLDLENTY DSECT , THIS DSECT DESCRIBES THE STANDARD PART OF THE 77100000 * DIRECTORY ENTRY AS SUPPLIED BY BLDL 77150000 * 77200000 MNAME DS D MEMBER NAME 77250000 MBEGTTR DS 3X TTR OF BEG OF MEMBER 77300000 MCONCAT DS X CONCATENATION NO. OF PDS 77350000 MLIBRARY DS X TYPE LIBRARY INDICATOR 77400000 * X'01' FOUND IN LINKLIB 77450000 MFILLER DS 9X OTHER INFO NOT PERTINET 77500000 MATTRIB DS 2X MEMBER ATTRIBUTES 77550000 EJECT 77600000 TCOMTAB 77650000 EJECT 77700000 TSTCWORK 77750000 EJECT 77800000 CVT DSECT=YES 77850000 EJECT 77900000 IKJTCB LIST=YES 77950000 IEZJSCB 78000000 IKJPSCB 78050000 EJECT 78100000 IHASDWA 78150000 EJECT 78200000 IHADCB DCBD DEVD=DA,DSORG=PO 78250000 EJECT 78300000 IEFTIOT1 DSECT 78350000 IEFTIOT1 78400000 EJECT 78450000 IKJEFLWA 78500000 EJECT 78550000 IHAASCB 78600000 EJECT 78650000 IHAASXB 78700000 END IGC0006A 78750000