TITLE 'IKJEGQFY' 00014002 *A65680 @ZA04118 00015003 * /* START OF SPECIFICATIONS **** 00016002 *02* PROCESSOR = ASSEMBLER 00018002 **** END OF SPECIFICATIONS ***/ 00018402 *********************************************************************** 00020002 * * 00030002 * STATUS * 00040002 * VERSION NO. 00, OS/VS2 RELEASE NO. 02 * 00050002 * * 00060002 * FUNCTION/OPERATION * 00070002 * THIS ROUTINE IS CALLED BY THE SUBCOMMAND PROCESSOR (OS TIME- * 00080002 * SHARING OPTION FOR MVT) TO SET AND RESET THE BASE ADDRESS USED TO* 00090002 * RESOLVE RELATIVE AND SYMBOLIC ADDRESSES. IT CAN ALSO ASSOCIATE * 00100002 * THE LOAD MODULE NAME AND CSECT NAME WITH THEIR CURRENT ADDRESS IN* 00110002 * THE REGION. * 00120002 * * 00130002 * ENTRY POINTS * 00140002 * IKJEGQFY - GOES TO PARSE TO EXAMINE THE SUBCOMMAND * 00150002 * * 00160002 * INPUT * 00170002 * ONE LINE OF INPUT FROM THE TERMINAL INTO THE INPUT BUFFER * 00180002 * * 00190002 * OUTPUT * 00200002 * 1. ERROR MESSAGES TO THE MESSAGE WRITER * 00210002 * 2. RETURN CODES * 00220002 * * 0 - SUCCESSFUL COMPLETION OR MODULE NOT FOUND * 00230002 * * 4 - QUALIFICATION TO A NEW TCB * 00240002 * * 8 - RETURN CODE TO HAVE PARSE ISSUE A 'REENTER' * 00250002 * * 12 - PARSE VALIDITY CHECK EXIT ERROR RETURN CODE * 00260002 * * 16 - AN ATTENTION HAS BEEN SCHEDULED * 00270002 * * 24 - ESTAE RETRY HAS INTERCEPTED AN ABEND * 00280002 * * 00290002 * EXTERNAL REFERENCES * 00300002 * IKJPARS - TO SCAN THE INPUT BUFFER FOR SYNTAX CHECKING OF * 00310002 * ADDRESSES AND KEYWORD IF SPECIFIED AND TO PROMPT THE USER * 00320002 * FOR VALID INPUT WHEN NECESSARY. AT ENTRY TO IKJPARS, REG * 00330002 * ONE POINTS TO A PARAMETER LIST WITH THE FOLLOWING FORMAT - * 00340002 * 00 - POINTER TO UPT * 00350002 * 04 - POINTER TO ECT * 00360002 * 08 - POINTER TO CP ECB * 00370002 * 12 - POINTER TO PARAMETER DESCRIPTOR LIST (PDL) * 00380002 * 16 - POINTER TO ANSWER PLACE * 00390002 * 20 - POINTER TO COMMAND BUFFER * 00400002 * 24 - POINTER TO USERWORK AREA (QUALIFY'S SAVE AREA) * 00410002 * * 00420002 * IKJEGCVT - CONVERTS AN ABSOLUTE ADDRESS, AN EXPRESSION, AN * 00430002 * INDIRECT ADDRESS, OR A FULLY QUALIFIED ADDRESS TO BINARY. * 00440002 * AT ENTRY REGISTER ONE CONTAINS THE COMPLEMENT OF THE PDL * 00450002 * ADDRESS TO INDICATE AN ADDRESS CONVERSION AND REGISTER ZERO * 00460002 * IS SET NEGATIVE TO INDICATE CONVERT TO BINARY. * 00470002 * * 00480002 * IKJEGI01 - OUTPUTS ERROR MESSAGES. AT ENTRY REGISTER ONE * 00490002 * CONTAINS THE ADDRESS OF THE LENGTH FIELD OF THE OUTPUT * 00500002 * BUFFER. * 00510002 * * 00520002 * IKJEGSYM - RESOLVES THE ENTRYNAME ADDRESS ASSOCIATED WITH * 00530002 * THE GIVEN LOADNAME. * 00540002 * * 00550002 * EXITS,NORMAL * 00560002 * RETURN VIA REGISTER 14 TO THE CALLER * 00570002 * * 00580002 * EXITS,ERROR * 00590002 * RETURN TO CALLER VIA REGISTER 14 * 00600002 * * 00610002 * TABLES/WORK AREAS * 00620002 * TCOMTAB * 00630002 * * PPTCB - UPDATED WHEN QUALIFICATION IS TO A NEW TCB * 00640002 * * PPRB - QUALIFICATION IS TO A NEW TCB * 00650002 * * PPLOAD - UPDATED FOR ALL QUALIFICATION * 00660002 * * TSTSYMBA - UPDATED FOR LOADNAME/LOADNAME.ENTRYNAME * 00670002 * * QUALIFICATION. * 00680002 * * TSTCURLD - UPDATED FOR QUALIFICATION TO A NEW LOADNAME * 00690002 * * TSTCURCT - UPDATED FOR QUALIFICATION TO A NEW ENTRYNAME * 00700002 * * 00710002 * WORKSP - QUALIFY WORKAREA * 00720002 * * 00730002 * ATTRIBUTES * 00740002 * REENTRANT * 00750002 * * 00760002 * CHARACTER CODE DEPENDENCY * 00770002 * THE OPERATION OF THIS MODULE DEPENDS UPON AN INTERNAL * 00780002 * REPRESENTATION OF THE EXTERNAL CHARACTER SET WHICH IS * 00790002 * EQUIVALENT TO THE ONE USED AT ASSEMBLY TIME. THE CODING HAS BEEN * 00800002 * ARRANGED SO THAT REDEFINITION OF 'CHARACTER' CONSTANTS, BY * 00810002 * REASSEMBLY, WILL RESULT IN A CORRECT MODULE FOR THE NEW * 00820002 * DEFINITIONS. * 00830002 * * 00840002 * NOTES * 00850002 * * 00860002 *********************************************************************** 00870002 EJECT 00880002 COPY IKJEGSIO OBTAIN CALLING MACROS 00882002 IKJEGQFY CSECT 00890002 ZERO EQU 0 PARAMETER REGISTER 00900002 PARAMREG EQU 1 PARAMETER REGISTER 00910002 WORKE EQU 2 EVEN WORK REGISTER 00920002 WORKO EQU 3 ODD WORK REGISTER 00930002 REG4 EQU 4 WORK REGISTERS 00940002 REG5 EQU 5 * 00950002 REG6 EQU 6 * 00960002 REG7 EQU 7 * 00970002 REG8 EQU 8 * 00980002 REG9 EQU 9 POINTER TO TCOMTAB 00990002 REG10 EQU 10 POINTER TO WORK AREA 01000002 R11 EQU 11 WORK REGISTER - POINTER TO PDL 01010002 BASEREG EQU 12 BASE FOR CSECT 01020002 SAVEREG EQU 13 SAVE AREA ADDRESS REG 01030002 RETREG EQU 14 ADDRESS OF RETURN POINT 01040002 ADDREG EQU 15 ADDRESS REGISTER 01050002 RETCODE EQU 15 RETURN CODE REGISTER 01060002 SPACE 01070002 * FIELD AND NUMBER EQUATES 01080002 ONE EQU 1 ONE 01090002 TWO EQU 2 NUMBER 2 01100002 THREE EQU 3 NO. 3 01110002 PARSCODE EQU 3 PARSE LINK FAILED CODE 01120002 FOUR EQU 4 FOUR 01130002 TCBADR EQU 4 DISPLACEMENT FOR CURRENT 01140002 * TCB ADDR 01150002 FIVE EQU 5 NO. 5 01160002 SIX EQU 6 SIX 01170002 EIGHT EQU 8 EIGHT 01180002 SYMCODE EQU 8 SYM LINK FAILED CODE 01190002 NINE EQU 9 NINE 01200002 TEN EQU 10 TEN 01210002 TWELVE EQU 12 NUMBER 12 01220002 N14 EQU 14 NUMBER 14 01230002 SIXTEEN EQU 16 SIXTEEN 01240002 TWENTY EQU 20 NO. 20 01250002 THIRTY2 EQU 32 OFFSET FOR MESSAGE 01260002 FORTY EQU 40 OFFSET 01270002 FIFTY6 EQU 56 NUMBER 56 01280002 FIFTY8 EQU 58 NUMBER 58 01290002 SIXTY EQU 60 NO. 60 01300002 OFFSET EQU 64 OFFSET INTO COMMON WORK AREA 01310002 SIXTY8 EQU 68 NUMBER 68 01320002 REG15 EQU 15 USED FOR REGISTER 15 01322002 REG2 EQU 2 USED FOR REGISTER 2 01322402 I0010 EQU 10 INSERT NUMBER 10 WITHIN I/O 01324002 I0040 EQU 40 INSERT NUMBER 40 WITHIN I/O 01326002 I0085 EQU 85 INSERT NUMBER 85 WITHIN I/O 01328002 M0026 EQU 26 MESSAGE NUMBER 26 WITHIN I/O 01328402 M0025 EQU 25 MESSAGE NUMBER 25 WITHIN I/O 01328802 M0227 EQU 227 MESSAGE NUMBER 227 WITHIN I/O 01329202 M0103 EQU 103 MESSAGE NUMBER 103 WITHIN I/O 01329602 M0296 EQU 296 MESSAGE NUMBER 296 WITHIN I/O 01329702 M0268 EQU 268 MESSAGE NUMBER 268 WITHIN I/O 01329802 M0226 EQU 226 MESSAGE NUMBER 226 WITHIN I/O 01329902 BADESTAE EQU 24 CODE FOR UNABLE TO ISSUE ESTAE 01333202 HEX03 EQU X'03' INDICATES FULLWORD BOUNDARY 01336702 REGTYPE EQU X'38' INDICATES REGISTER TYPE ADDR 01340002 LLCHAIN EQU 0 POINTER TO NEXT LLE 01360002 LLCDPTR EQU 4 POINTER TO CDE FROM LLE 01370002 CDATTRX EQU 0 ATTRIBUTES FOUND IN CDE 01380002 ZEROIT EQU X'00' ZERO 01390002 ZEROBYTE EQU X'00' BYTE OF ZEROES 01400002 HEX01 EQU X'01' MASK FOR TESTING P-BIT OF 01410002 * PSW'S AMWP FIELD 01420002 NOPRINT EQU X'20' NOPRINT SETTING 01430002 PRINT EQU X'DF' SETTING TO RESET SWITCH 01440002 ONBIT EQU X'80' INDICATES HIGH ORDER BIT ON 01450002 MINOR EQU X'04' MINOR CDE 01460002 HEXF0 EQU X'F0' MASK FOR PROTECTION KEY OF PSW 01470002 HEXFF EQU X'FF' STAE ADDR TABLE END INDICATOR 01480002 CDNAMEX EQU 8 MODULE OR ALIAS NAME 01490002 CDXL EQU 20 POINTER TO EXTENT LIST 01500002 XLCSECTS EQU 4 NUMBER OF CSECTS 01510002 BLANK EQU C' ' BLANK 01520002 L1 EQU 1 LENGTH OF 1 01540002 L3 EQU 3 LENGTH OF 3 01550002 L4 EQU 4 LENGTH OF 4 01560002 L6 EQU 6 LENGTH OF 6 01570002 L7 EQU 7 LENGTH OF 7 01580002 L8 EQU 8 LENGTH OF 8 01590002 SPACE 01600002 SAVE (14,12),,IKJEGQFY SAVE REGISTERS 01610002 LR BASEREG,ADDREG SET UP ADDRESSABILITY 01620002 USING IKJEGQFY,BASEREG * 01630002 USING TCOMTAB,REG9 SET UP ADDRESSABILITY TO 01640002 * COMMUNICATION WORK AREA 01650002 L REG5,REGSAVE2 GET POINTER TO MY SAVE AREA 01660002 ST SAVEREG,FOUR(ZERO,REG5) SAVE ADDR OF CALLER'S SAVE AREA 01670002 ST REG5,EIGHT(SAVEREG) SAVE ADDR OF MY SAVE AREA 01680002 LR SAVEREG,REG5 PUT ADDRESS OF MY SAVE AREA 01690002 * IN REGISTER 13 01700002 L REG10,WORKAREA GET ADDRESS OF COMMON WORK AREA 01710002 USING TSTCWORK,REG10 ESTABLISH ADDRESSABILITY TO 01720002 * WORK AREA 01730002 LA REG10,CWORKCMD R10=ADDRESS OF QUALIFY'S WORK 01740002 * AREA 01750002 DROP REG10 01760002 USING WORKSP,REG10 SET UP ADDRESSABILITY TO MY 01770002 * WORK AREA 01780002 SAVE (14,12) SAVE REGISTERS IN MY SAVE AREA 01790002 * IN CASE STAE EXIT GETS 01800002 * CONTROL 01810002 SPACE 01820002 MVC PPTCBSAV(FOUR),PPTCB SAVE CURRENT PPTCB 01830002 MVC PPRBSAV(FOUR),PPRB SAVE CURRENT RB PTR 01840002 SPACE 01850002 * 01860002 * ISSUE STAE FOR PARSE AND SYM LINK 01870002 * 01880002 SPACE 01920002 L REG4,TSTSTAE GET ADDR OF STAE EXIT 01940002 * ROUTINE 01950002 LA ADDREG,BLDMSG GET WKAREA ADDR 01960002 MVC ZERO(STAELEN,ADDREG),STAELIST MOVE STAE LIST 01970002 SPACE 01980002 ESTAE (4),CT,PARAM=IKJEGSPL,XCTL=NO,RECORD=YES,MF=(E,(15)) 01990002 SPACE 02000002 LTR RETCODE,RETCODE CHECK FOR A VALID RETURN 02010002 * CODE 02020002 SMTSTAE DS 0H SMT TEST LABEL FOR STAE MACRO 02030002 BZ SETUP YES... 02040002 STC REG15,TSTESTRC SAVE RETURN CODE FOR MAINLINE 02042002 LA REG15,BADESTAE SEND BACK RETURN CODE 24 02044002 B QFYRET RETURN TO CALLER 02046002 SPACE 02090002 * THIS SECTION PREPARES FOR PASSING CONTROL TO THE PARSE ROUTINE 02100002 SPACE 02110002 SETUP DS 0H SET UP FOR PARSE 02120002 DROP REG10 02130002 SPACE 02140002 USING PPLUPT,REG10 SET UP ADDRESSABILITY TO 02150002 * PARSE PARAMETER LIST 02160002 SPACE 02170002 MVC PPLUPT(FOUR),TSTUPT MOVE USER PROFILE TABLE INTO 02180002 * WORKAREA 02190002 MVC PPLECT(FOUR),TSTECT MOVE ENVIRONMENT CONTROL TABLE 02200002 MVC PPLECB(FOUR),TSTCPECB MOVE COMMAND PROCESSOR EVENT 02210002 * CONTROL BLOCK 02220002 MVC PPLPCL(FOUR),PCLISTA MOVE ADDR OF PARAMETER CONTROL 02230002 * LIST 02240002 LA REG4,TSTANSPL GET PTR TO ANSWER PLACE 02250002 ST REG4,PPLANS STORE IN WORKAREA 02260002 MVC PPLCBUF(FOUR),INBUF MOVE PTR TO COMMAND BUFFER 02270002 ST SAVEREG,PPLUWA SAVE PTR TO QUALIFY'S WORKAREA 02280002 DROP REG10 02290002 USING WORKSP,REG10 SET UP ADDRESSABILITY TO 02300002 * WORKAREA 02310002 LR PARAMREG,REG10 PUT ADDRESS OF PARAMETER LIST 02320002 * INTO REGISTER 1 02330002 LINK EP=IKJPARS,ERRET=LKFAIL1 GO TO PARSE ROUTINE 02340002 PARSBLOW DS 0H 02340402 B LINKOK1 IF CONTROL COMES HERE OK - GO 02342002 LKFAIL1 DS 0H 02344002 LR REG6,PARAMREG TRANSFER ABEND CODE 02346002 LR REG4,RETCODE TRANSFER RETURN CODE 02346402 XC TSTIOPRM,TSTIOPRM ZERO OUT PARM LIST 02348002 IKJEGSIO SVCERR,SVC=6,ABENDRG=(REG6),INST11=(NUM,I0040), CALL *02348402 RC=(REG4),ID=QFY26,MF=(E,TSTIOPRM) FOR ERROR MSG 02348802 CH RETCODE,H16 TEST FOR SUCCESSFUL IO CALL 02349202 BL QFYCCO BRANCH TO ZERO OUT RTN CODE 02349602 B QFYRET GO BACK WITH RETURN CODE 02349702 LINKOK1 DS 0H 02349802 SPACE 02350002 SMTPARS DS 0H SMT TEST LABEL FOR PARSE LINK 02360002 SPACE 02370002 LTR RETCODE,RETCODE DID PARSE COMPLETE SUCCESSFULLY 02390002 BNZ CHKCODE NO, FIND TYPE OF ERROR 02400002 L R11,TSTANSPL GET ADDRESS OF PDL 02410002 USING IKJPARMD,R11 GET ADDRESSABILITY TO PDL 02420002 LA R11,ADDR R11=ADDRESS OF ADDRESS PDE 02430002 DROP R11 02440002 USING IKJPARMA,R11 GET ADDRESSABILITY TO PDE 02450002 SPACE 02460002 CHECKADR DS 0H CHECK FOR ARGUMENT BEING LOAD- 02470002 * NAME OR ADDRESS 02480002 CLC PDEUSER(L4),NOBINARY IS ARGUMENT BINARY ADDRESS 02490002 BE CHKSYM NO, CHECK FOR SYMBOL.SYMBOL 02500002 L WORKE,PDEUSER PICK UP CONVERTED ADDRESS 02510002 LA WORKE,ZERO(ZERO,WORKE) CLEAR HIGH ORDER BYTE OF REG 02520002 ST WORKE,PPLOAD STORE ADDRESS IN FIELD OF 02530002 * TCOMTAB FOR CURRENTLY 02540002 * QUALIFIED BASE FOR RELATIVES 02550002 SPACE 02560002 DROP R11 DROP ADDRESS PDE BASE 02570002 L R11,TSTANSPL R11 = ADDRESS OF PDL 02580002 USING IKJPARMD,R11 GET ADDRESSABILITY TO PDL 02590002 SR REG4,REG4 CLEAR REG 02600002 CH REG4,TCBNAME WAS TCB SPECIFIED W/O LOADNM 02610002 SPACE 02620002 LA R11,ADDR SET R11 TO ADDR OF PDE 02630002 DROP R11 DROP PDL ADDRESSABILITY 02640002 USING IKJPARMA,R11 SET UP ADDRESSABILITY TO PDE 02650002 SPACE 02660002 BE SYMCHK TCB NOT SPECIFIED... 02670002 SPACE 02680002 TM PDEFLG1,ONBIT WAS ADDR FULLY QUALIFIED 02690002 BZ TCBINVAL NO, PUT OUT 'TCB INVALID' MSG 02700002 SPACE 02710002 LA REG4,M0026 GET MESSAGE NUMBER INTO REG 02720002 LA REG5,M0227 GET MESSAGE NUMBER INTO REG 02726002 B PUTMSG PRINT INFORMATION MSG 02730002 SPACE 02740002 TCBINVAL DS 0H 02752002 LA REG4,M0025 GET MESSAGE NUMBER INTO REG 02754002 SR REG5,REG5 INDICATE NO SECOND LEVEL 02756002 * INVALID' MSG 02760002 B PUTMSG PRINT ERROR MESSAGE 02770002 SPACE 02780002 SYMCHK TM PDEFLG3,ONBIT TEST FOR .CSECT.SYMBOL 02790002 BO QFYCCO YES...RETURN 02800002 SPACE 02810002 TM PDEFLG4,RELADDR TEST FOR RELATIVE ADDR 02820002 BO QFYCCO YES... 02830002 SPACE 02840002 ST WORKE,TSTSYMBA QUALIFICATION MUST BE 02850002 * .ENTRYNAME...SAVE NEW BASE 02860002 * FOR SYMBOLICS 02870002 MVI TSTCURCT,BLANK BLANK OUT CSECTNAME IN 02880002 MVC CSECTNM1(L7),TSTCURCT TCOMTAB 02890002 LA REG4,TSTCURCT GET FIELD ADDR 02900002 LH REG5,PDELEN2 AND LENGTH OF CSECT NAME 02910002 BCTR REG5,ZERO DECREMENT BY 1 FOR MOVE 02920002 L WORKO,PDECTNAM GET PTR TO NAME 02930002 EX REG5,EXMOVE MOVE CSECT NAME TO TCOMTAB 02940002 B QFYCCO GO TO WRAP UP ROUTINE 02950002 SPACE 02960002 CHKCODE DS 0H EXAMINE RETURN CODE FROM PARSE 02970002 STC RETCODE,CODESAVE SAVE RETURN CODE 02980002 LA REG5,RTNCODE GO TO PROPER BRANCH 02990002 RTNCODE B ZERO(RETCODE,REG5) IN BRANCH TABLE 03000002 SPACE 03010002 B RC04 RC=4 UNABLE TO PROMPT 03020002 B CODE16 RC=8 ATTN SCHEDULED 03030002 B NOPARSE RC=12 UNABLE TO PARSE 03040002 B NOCORE RC=16 NO CORE AVAILABLE 03050002 NOCONVRT DS 0H RC=20 CONVERT FAILED 03060002 SPACE 03070002 CLI CONVRTCD,SIXTEEN GET RETURN CODE SAVED 03080002 * FROM BAD CONVERT 03090002 BL QFYCCO IF 0,4,8, OR 12, SET RETURN 03100002 * CODE TO 0 FOR MAINLINE 03110002 SR RETCODE,RETCODE ZERO OUT HIGH ORDER BYTES 03120002 IC RETCODE,CONVRTCD PICK UP RETURN CODE FOR MNL 03134002 B QFYRET RETURN TO MAINLINE 03138002 SPACE 03180002 RC04 OI TSTFLGS4,TSTFLUSH INITILIAZE STACK FLUSH 03190002 * FOR MAINLINE 03200002 B QFYCCO RETURN TO MAINLINE 03210002 SPACE 03220002 NOCORE DS 0H STORAGE NOT AVAILABLE 03230002 LA REG4,M0103 GET MESSAGE NUMBER INTO REG 03260002 SR REG5,REG5 INDICATE NO SECOND LEVEL MSG 03262002 B PUTMSG BRANCH TO ISSUE MESSAGE 03264002 SPACE 03270002 CODE16 DS 0H SET RETURN CODE TO 16 FOR 03280002 * ATTENTION SCHEDULED 03290002 XR RETCODE,RETCODE CLEAR REGISTER 03300002 LA RETCODE,SIXTEEN(ZERO,RETCODE) SET RETURN CODE TO 16 03310002 * FOR ATTENTION SCHEDULED 03320002 B QFYRET GO TO WRAP UP PROCEDURE 03330002 SPACE 03340002 NOPARSE DS 0H UNABLE TO PARSE 03350002 XC TSTIOPRM,TSTIOPRM CLEAR PARM LIST FOR I/O CALL 03360002 IKJEGSIO MSG,FIRST=M0104,INST11=(NUM,I0010), CALL I/O *03370002 SECOND=M0277,ID=QFY26,MF=(E,TSTIOPRM) TO ISSUE ERR MSG 03380002 CH REG15,H16 TEST FOR SERIOUS ERROR 03400002 BL QFYCCO IF NOT CONTINUE 03410002 B QFYRET IF SERIOUS RTN TO MAINLINE 03420002 SPACE 03570002 PUTMSG DS 0H 03572002 XC TSTIOPRM,TSTIOPRM CLEAR PARM LIST FOR I/O CALL 03574002 IKJEGSIO MSG,FIRST=(REG4), CALL I/O *03576002 SECOND=(REG5),ID=QFY26,MF=(E,TSTIOPRM) TO ISSUE ERR MSG 03578002 CH REG15,H16 TEST FOR SERIOUS ERROR 03578802 BL QFYCCO IF NOT CONTINUE 03579202 B QFYRET IF SERIOUS RTN TO MAINLINE 03579602 CHKSYM DS 0H CHECK FOR SYMBOL.SYMBOL 03580002 TM PDEFLG2,ONBIT IS THERE AN ENTRYNAME 03590002 * PARAMETER IN THE PDE 03600002 BO MOVENM YES, ARGUMENT IS 03610002 * LOADNAME.CSECTNAME 03620002 ONLYSYM DS 0H FOUND PDE TO CONTAIN ONLY A 03630002 * SYMBOL 03640002 LM WORKE,WORKO,PDEADRPT PICK UP PTR TO SYMBOL AND FLAGS 03650002 STM WORKE,WORKO,PDELDNAM STORE IN LOADNAME ENTRIES OF 03660002 * PDE 03670002 MVI PDEADRPT,ZEROIT CLEAR OUT STRING FIELD 03680002 MVC STRING1(L7),PDEADRPT COMPLETE CLEARING FIELD 03690002 SPACE 03700002 MOVENM DS 0H MOVE LOADNAME TO TEST FIELD 03710002 MVI NEWLOAD,BLANK BLANK OUT NEWLOAD FIELD IN 03720002 MVC NEWLOAD1(L7),NEWLOAD THE WORK AREA 03730002 LH WORKE,PDELEN1 PICK UP LENGTH OF LOADNAME 03740002 L WORKO,PDELDNAM GET POINTER TO NAME 03750002 LA REG4,NEWLOAD GET ADDR OF WORK AREA FIELD 03760002 BCTR WORKE,ZERO DECREMENT LENGTH BY ONE 03770002 EX WORKE,EXMOVE MOVE NEW NAME TO WORK AREA 03780002 DROP R11 03790002 L R11,TSTANSPL R11=ADDRESS OF PDL 03800002 USING IKJPARMD,R11 GET ADDRESSABILITY TO PDL 03810002 SPACE 03820002 ISTCB DS 0H CHECK FOR TCB SPECIFIED 03830002 XR REG4,REG4 CLEAR REGISTER 03840002 CH REG4,TCBNAME WAS TCB PARAMETER GIVEN 03850002 BNE YESTCB YES, SET UP SEARCH FOR NAME 03860002 LA R11,ADDR R11=ADDRESS OF ADDRESS PDE 03870002 DROP R11 03880002 USING IKJPARMA,R11 GET ADDRESSABILITY TO PDE 03890002 MVI TCBFLG,TCBNOSP INDICATE TCB NOT SPECIFIED 03900002 EJECT 03910002 ***************************************************************** 03920002 * * 03930002 * THIS ROUTINE INITIALIZES A SEARCH FOR THE LOADNAME * 03940002 * THROUGH EACH TASK UNDER THE TEST TCB. * 03950002 * * 03960002 ***************************************************************** 03970002 SPACE 03980002 L WORKO,TSTTCB GET THE ADDR OF TEST'S TCB 03990002 * FROM TCOMTAB 04000002 USING TCB,WORKO SET UP ADDRESSABILITY TO TCB 04010002 SPACE 04020002 DAUGHTER L WORKE,D(WORKO) GET ADDR OF DAUGHTER TCB 04030002 LTR WORKE,WORKE IS THERE A DAUGHTER 04040002 BNZ SETSRCH YES...GO SEARCH FOR LOADNAME 04050002 SPACE 04060002 SISTER L WORKE,S(WORKO) GET ADDR OF SISTER TCB 04070002 LTR WORKE,WORKE IS THERE A SISTER 04080002 BNZ SETSRCH YES...SEARCH FOR LOADNAME 04090002 SPACE 04100002 MOTHER CLC M+ONE(THREE,WORKO),TSTTCB+ONE DOES MOTHER = TEST TCB 04110002 BE NOFIND YES...PUT OUT ' NO FIND' MSG 04120002 SPACE 04130002 L WORKO,M(WORKO) NO...GET ADDR OF MOTHER TCB 04140002 B SISTER SEARCH 'SISTER' CHAIN 04150002 SPACE 04160002 SETSRCH ST WORKE,TCBUSED SAVE TCB ADDRESS 04170002 DROP WORKO DROP ADDRESSABILITY TO 04180002 * TEST'S TCB 04190002 USING TCB,WORKE ADDRESSABILITY FOR TCB BEING 04200002 * USED 04210002 CLC TCBUSED+ONE(THREE),ONE(WORKE) IS THERE AN RB 04220002 BE NORB NO....(TCBRBP FIELD POINTS 04230002 * TO THE TCB ITSELF RATHER THAN 04240002 * TO AN RB) 04250002 SPACE 04260002 TM TCBFLGS5,TCBFC IS THIS TASK TERMINATED 04270002 BNO SEARCHRB NO...SEARCH THE RB CHAIN 04280002 * FOR THIS TCB 04290002 SPACE 04300002 NORB LR WORKO,WORKE INITIALIZE TO SEARCH FOR 04310002 B DAUGHTER THE NEXT LOWER TCB 04320002 EJECT 04330002 ********************************************************************* 04340002 * * 04350002 * THE SEARCH IS NOW BEGUN THROUGH RB'S AND LLE'S TO GET TO CDE'S AND* 04360002 * LOOK FOR MATCHING LOADNAME * 04370002 * * 04380002 ********************************************************************* 04390002 SPACE 04400002 SEARCHRB DS 0H BEGIN SEARCH OF RB CHAIN 04410002 L WORKO,TCBRBP GET PTR TO RB QUE 04420002 USING RBSECT,WORKO SET UP ADDRESSABILITY 04430002 SPACE 04440002 ISRBOK DS 0H CHECK FOR TYPE OF RB 04450002 TM RBSTAB1,RBFTP IS RB A PRB 04460002 BNZ NEXTRB NO, CHECK FOR NEXT RB 04470002 SPACE 04480002 GETCODE L REG4,RBCDE GET PTR TO CDE 04490002 BAL REG8,GETXL BRANCH TO EXAMINE CDE 04500002 SPACE 04510002 NEXTRB DS 0H SET UP FOR SEARCHING NEXT RB 04520002 L WORKO,RBLINK GET PTR TO NEXT RB 04530002 LA WORKO,ZERO(ZERO,WORKO) CLEAR HIGH ORDER BYTE 04540002 CLR WORKO,WORKE IS POINTER TO TCB 04550002 BE CHKLLE YES, BEGIN SEARCH THRU LOAD 04560002 * LIST 04570002 BNE ISRBOK NO, CHECK FOR TYPE OF RB 04580002 SPACE 04590002 DROP WORKO 04600002 SPACE 04610002 GETXL DS 0H LOOK FOR LOAD NAME 04620002 USING CDENTRY,REG4 SET UP ADDRESSABILITY 04622002 L REG5,CDXLMJP PICK UP XL POINTER 04630002 TESTNM DS 0H CHECK FOR NAME 04640002 CLC CDNAME,NEWLOAD DO LOADNAMES MATCH 04650002 BE CHKATTR YES, CHECK ATTRIBUTES 04660002 TM CDATTR,MINOR IS THIS A MINOR CDE 04670002 BO MINORCDE YES, MINOR CDE 04680002 BR REG8 NO, RETURN TO CALLER 04690002 SPACE 04700002 MINORCDE DS 0H 04710002 LR REG4,REG5 THIS IS A MINOR CDE 04720002 B GETXL CHECK LOADNAME IN MAJOR CDE 04730002 SPACE 04740002 CHKATTR DS 0H LOADNAMES MATCHED - FIND XL 04750002 TM CDATTR,MINOR IS THIS A MINOR CDE 04760002 BZ GOTOXL NO GO TO XL 04770002 DROP REG4 04770402 USING CDENTRY,REG5 SET UP ADDRESSABILITY 04772002 L REG5,CDXLMJP THIS IS A MINOR CDE, GET PTR 04780002 * TO XL 04790002 SPACE 04800002 GOTOXL DS 0H GET FIRST CSECT ADDRESS FROM XL 04810002 LA REG6,FOUR PUT A FOUR IN REG 04820002 DROP REG5 04822002 USING XTLST,REG5 SET UP ADDRESSABILITY 04824002 L REG7,XTLNRFAC PICK UP NUMBER CSECTS 04830002 DROP REG5 04832002 LA REG7,TWO(ZERO,REG7) ACCOUNT FOR PRECEEDING 8 BYTES 04840002 MR REG6,REG6 GET DISPLACEMENT INTO XL 04850002 * FOR ADDRESS OF FIRST CSECT 04860002 L REG7,ZERO(REG7,REG5) PICK UP ADDRESS OF FIRST CSECT 04870002 ST REG7,CSECTADR SAVE ADDRESS OF CSECT 04880002 B CHKCSECT CHECK FOR CSECT GIVEN 04890002 SPACE 04900002 CHKLLE DS 0H RB CHAIN EXHAUSTED WITHOUT A 04910002 * MATCH - BEGIN SEARCH THRU 04920002 * LLE'S 04930002 L REG4,TCBLLS GET PTR TO LOAD LIST 04940002 TESTREG LTR REG4,REG4 HAS A MODULE BEEN LOADED 04950002 BZ NOMATCH NO, UNSUCCESSFUL SEARCH 04960002 LR REG6,REG4 SAVE LOAD LIST ADDR 04970002 USING LLE,REG4 SET UP ADDRESSABILITY 04972002 L REG4,LLECDPT GET POINTER TO CDE 04980002 BAL REG8,GETXL BRANCH TO EXAMINE CDE 04990002 NEXTLLE DS 0H GET POINTER TO NEXT LLE 05000002 LR REG4,REG6 RESTORE LOAD LIST ADDR 05010002 L REG4,LLECHN PICK UP POINTER 05020002 B TESTREG CHECK FOR MODULE BEING LOADED 05030002 DROP REG4 05032002 SPACE 05040002 * THIS CODE IS ENTERED WHEN IT IS INITIALLY DETERMINED THAT A TCB 05050002 * ADDRESS WAS SPECIFIED. 05060002 SPACE 05070002 YESTCB DS 0H BEGIN PREPARATION TO SEARCH 05080002 * FROM SPECIFIED TCB THROUGH 05090002 * RB'S AND LLE'S TO CDE'S TO 05100002 * FIND MATCHING LOADNAME 05110002 MVI TCBFLG,TCBGIVEN SET SWITCH TO INDICATE TCB 05120002 * SPECIFIED 05130002 DROP R11 05140002 L R11,TSTANSPL R11=ADDRESS OF PDL 05150002 USING IKJPARMD,R11 GET ADDRESSABILITY TO PDL 05160002 LA R11,ADDRTCB R11=ADDRESS OF TCB PDE 05170002 DROP R11 05180002 USING IKJPARMA,R11 GET ADDRESSABILITY TO PDE 05190002 L WORKE,PDEUSER GET BINARY ADDRESS OF TCB 05200002 ST WORKE,TCBUSED SAVE TCB ADDRESS 05210002 LA WORKE,ZERO(ZERO,WORKE) ZERO HIGH ORDER BYTE 05212002 DROP R11 05220002 L R11,TSTANSPL R11=ADDRESS OF PDL 05230002 USING IKJPARMD,R11 GET ADDRESSABILITY TO PDL 05240002 LA R11,ADDR R11=ADDRESS OF ADDRESS PDE 05250002 DROP R11 05260002 USING IKJPARMA,R11 GET ADDRESSABILITY TO PDE 05270002 B SEARCHRB BEGIN SEARCH OF RB CHAIN 05280002 SPACE 05290002 * THIS CODE IS ENTERED WHEN A SEARCH THROUGH RB QUEUES AND LLE'S HAS 05300002 * FOUND NO MATCH IN LOADNAME FOR THE TCB SEARCHED 05310002 NOMATCH DS 0H HERE IT IS DETERMINED WHETHER 05320002 * MORE TCB'S CAN BE CHECKED 05330002 * FOR OR NOT 05340002 TM TCBFLG,TCBGIVEN WAS A TCB SPECIFIED BY THE 05350002 * USER 05360002 BO ERRCOND YES, PUT OUT ERROR MESSAGE 05370002 LR WORKO,WORKE GET ADDR OF NEXT LOWER TCB 05380002 B DAUGHTER GO THROUGH LOOP AGAIN 05390002 SPACE 05400002 ERRCOND DS 0H SET UP MESSAGE FOR MODULE NOT 05410002 * FOUND 05420002 SPACE 05510002 L WORKO,PDELDNAM GET POINTER TO LOADNAME 05520002 L REG5,OUTBUF GET ADDRESS OF OUTBUF IN REG 05530002 MVI ZERO(REG5),BLANK MOVE BLANK INTO FIRST BYTE 05532002 MVC ONE(OUTBUFRL,REG5),ZERO(REG5) BLANK OUT BUFFER 05534002 LA REG4,FOUR(REG5) ESTAB POINTER FOR TEXT MOVE 05540002 SPACE 05550002 LH REG6,PDELEN1 GET LENGTH OF LOADNAME 05560002 BCTR REG6,ZERO DECREMENT BY ONE FOR MOVE INSTR 05570002 EX REG6,EXMOVE MOVE LOADNAME TO FIRST LEVEL 05580002 * MESSAGE 05590002 SPACE 05600002 LA REG6,SIX(REG6) CALCULATE LENGTH OF INSERT 05830002 STH REG6,ZERO(REG5) STORE INTO INSERT 05832002 XC TSTIOPRM,TSTIOPRM CLEAR PARM LIST FOR I/O CALL 05834002 IKJEGSIO MSG,FIRST=M0024,INST11=(ADDR,(REG5)), CALL I/O *05836002 SECOND=M0222,INST21=(ADDR,(REG5)),ID=QFY26, TO ISSUE *05838002 MF=(E,TSTIOPRM) AN ERROR MSG 05838402 CH REG15,H16 TEST FOR SERIOUS ERROR 05838802 BL QFYCCO IF NOT CONTINUE 05839202 B QFYRET IF SERIOUS RTN TO MAINLINE 05839602 SPACE 05850002 NOFIND DS 0H SINCE LOADNAME COULD NOT BE 05860002 * FOUND TESTS ARE MADE TO SEE 05870002 * IF USER SPECIFIED LOADNAME. 05880002 * ENTRYNAME OR JUST SYMBOL 05890002 TM PDEFLG2,ONBIT WAS SYMBOL.SYMBOL INDICATED 05900002 BZ FIXPDE NO, CLEAN UP PDE 05910002 SPACE 05920002 LDCST DS 0H SET UP MESSAGE FOR UNABLE TO 05930002 * QUALIFY ARGUMENT AS 05940002 * LOADNAME.CSECTNAME 05950002 XC TSTIOPRM,TSTIOPRM CLEAR PARM LIST FOR I/O CALL 05960002 IKJEGSIO MSG,FIRST=M0024,INST11=(APDE,(R11)), CALL I/O *05970002 SECOND=M0223,ID=QFY26,MF=(E,TSTIOPRM) TO ISSUE ERR MSG 05980002 CH REG15,H16 TEST FOR SERIOUS ERROR 06000002 BL QFYCCO IF NOT CONTINUE 06010002 B QFYRET IF SERIOUS RTN TO MAINLINE 06020002 SPACE 06170002 CONVERT DS 0H THIS ROUTINE GIVES CONTROL TO 06180002 * CONVERT TO GET A BINARY ADDR 06190002 LCR PARAMREG,R11 PUT COMPLEMENT OF POINTER TO 06200002 * PDE INTO REG 1 TO INDICATE 06210002 * AN ADDRESS CONVERT NEEDED 06220002 XR ZERO,ZERO INDICATE THAT A BINARY CONVERT 06230002 * IS NEEDED 06240002 OI TSTFLGS3,NOPRINT SET SWITCH FOR IKJEGSYM NOT TO 06250002 * PRINT A MESSAGE IF AN ERROR 06260002 * OCCURS 06270002 L ADDREG,TSTCONVT GET ADDRESS OF CONVERT ROUTINE 06280002 BALR RETREG,ADDREG GO TO CONVERT ROUTINE 06290002 NI TSTFLGS3,PRINT RESET SWITCH 06300002 LTR RETCODE,RETCODE WAS CONVERT SUCCESSFUL 06310002 BNZ CHKATTN NO, CHECK FOR ATTENTION 06320002 * SCHEDULED 06330002 TM PDEUSER,ONBIT IS ADDRESS IN USERWORD 06340002 BZ SETPPLD YES...GO SET PPLOAD 06350002 SPACE 06360002 L WORKE,PDEUSER NO...MUST PICK UP PTR 06370002 * TO SI BLOCK 06380002 MVC PDEUSER(L4),ZERO(WORKE) MOVE ADDR INTO USER WORD 06390002 SPACE 06400002 SETPPLD DS 0H PUT CONVERTED ADDRESS INTO 06410002 * TCOMTAB 06420002 MVC PPLOAD(L4),PDEUSER SET NEW BASE FOR RELATIVES 06430002 B QFYRET RETURN 06440002 SPACE 06450002 CHKATTN DS 0H CHECK FOR ATTENTION SCHEDULED 06460002 STC RETCODE,CODESAVE STORE CODE 06470002 CLI CODESAVE,SIXTEEN WAS ATTENTION SCHEDULED 06480002 BE QFYRET YES, RETURN 06490002 L WORKO,PDEADRPT GET ADDRESS OF STRING 06540002 LH REG7,PDELEN3 GET LENGTH OF NAME 06550002 BCTR REG7,ZERO DECREMENT ONE FOR EX INSTR 06560002 L REG8,OUTBUF GET ADDR OF MSG BUFFER @ZA04118 06568003 LA REG4,FOUR(REG8) ESTAB POINTER FOR TEXT MOVE 06576002 EX REG7,EXMOVE MOVE LOADNAME OR SYMBOL INTO 06580002 * MESSAGE INSERT 06590002 LA REG7,FIVE(REG7) CALCULATE INSERT LENGTH 06600002 STH REG7,ZERO(REG8) STORE INTO INSERT HEADER 06610002 XC TSTIOPRM,TSTIOPRM CLEAR PARM LIST FOR I/O CALL 06620002 IKJEGSIO MSG,FIRST=M0024,INST11=(ADDR,(REG8)), CALL I/O *06630002 SECOND=M0224,ID=QFY26,MF=(E,TSTIOPRM) TO ISSUE ERR MSG 06640002 CH REG15,H16 TEST FOR SERIOUS ERROR 06660002 BL QFYCCO IF NOT CONTINUE 06670002 B QFYRET IF SERIOUS RTN TO MAINLINE 06680002 * TO QUALIFY AS LOADNAME 06710002 * NOR SYMBOL 06720002 SPACE 06730002 FIXPDE DS 0H ADJUSTMENTS MUST BE MADE FOR 06740002 * PDE 06750002 MVC PDEADRPT(L8),PDELDNAM MOVE SYMBOL INFORMATION BACK 06760002 * TO SYMBOL SLOT IN PDE 06770002 MVI PDELDNAM,ZERO CLEAR OUT LOADNAME SLOT 06780002 MVC LDNM1(L7),PDELDNAM 06790002 B CONVERT GO TO CONVERT TO RESOLVE 06800002 * ADDRESS 06810002 SPACE 06820002 CHKCSECT DS 0H THIS CODE IS ENTERED IF A MATCH 06830002 * WERE FOUND TO LOADNAME 06840002 C WORKE,PPTCB WAS LOADNAME FOUND ON A NEW 06850002 * TCB 06860002 BNE NEWTCB YES, NEW TCB GIVEN 06870002 MVI TCBUSED,NOTNEW SET HIGH ORDER BYTE EQUAL TO 06880002 * X'80' TO INDICATE LOADNAME 06890002 * FOUND ON OLD TCB 06900002 TSTENTRY TM PDEFLG2,ONBIT WAS ENTRYNAME SPECIFIED 06910002 BNO NOENTRY NO, SET UP TCOMTAB INFO 06920002 SPACE 06930002 * SET UP TO GO TO IKJEGSYM 06940002 LR PARAMREG,R11 PUT POINTER TO PDE IN REG1 06950002 MVI PDEADRPT,ZEROBYTE CLEAR STRING ADDRESS AREA 06960002 MVC STRING1(L6),PDEADRPT IN PDE 06970002 LA ADDREG,BLDMSG GET WKAREA ADDR 06980002 MVC ZERO(SYMLEN,ADDREG),SYMLIST MOVE SYM LIST 06990002 SPACE 07000002 LINK MF=(E,(1)),SF=(E,(15)),ERRET=LKFAIL2 RESOLVE SYMBOLS 07010002 B LINKOK2 IF CONTROL GETS HERE -OK 07012002 LKFAIL2 DS 0H 07014002 LR REG10,PARAMREG TRANSFER ABEND CODE 07016002 LR REG4,RETCODE TRANSFER RETURN CODE 07016402 XC TSTIOPRM,TSTIOPRM CLEAR PARM LIST 07016502 IKJEGSIO SVCERR,SVC=6,ABENDRG=(REG10),INST11=(NUM,I0085), CALL*07016802 RC=(REG4),ID=QFY26,MF=(E,TSTIOPRM) TO ISSUE ERROR MSG 07017202 CH RETCODE,H16 COMPARE RC FOR SERIOUS ERROR 07019202 BL QFYCCO CONTINUE INTO NORMAL EXIT 07019602 B QFYRET SERIOUS RETURN WITH RTN CODE 07019702 SPACE 07020002 SPACE 07030002 LINKOK2 DS 0H 07032002 SYMBLOW DS 0H 07040002 LTR RETCODE,RETCODE IS RETURN CODE ZERO 07050002 BNZ TESTCODE NO, CHECK FURTHER 07060002 MVI TSTCURCT,BLANK BLANK OUT CSECT NAME 07070002 MVC CSECTNM1(L7),TSTCURCT IN TCOMTAB 07080002 LA REG4,TSTCURCT GET ADDR OF FIELD 07090002 LH REG5,PDELEN2 GET LENGTH OF NAME 07100002 BCTR REG5,ZERO DECREMENT BY ONE 07110002 L WORKO,PDECTNAM GET POINTER TO NAME 07120002 EX REG5,EXMOVE MOVE CSECT NAME TO TCOMTAB 07130002 SPACE 07140002 L REG7,PDEUSER PICK UP ADDRESS RETURNED 07150002 S REG7,TSTWHR GET DISPLACEMENT OF CSECT 07160002 * FROM BEGIN OF LOAD MODULE 07170002 A REG7,CSECTADR ADD LOAD MODULE ADDR 07180002 * (FIRST CSECT ADDR) FOUND BY 07190002 * QUALIFY'S SEARCH 07200002 SPACE 07210002 SETTCOM DS 0H PUT LATEST INFO IN TCOMTAB 07220002 ST REG7,TSTSYMBA STORE NEW BASE ADDRESS IN 07230002 ST REG7,PPLOAD FIELDS OF TCOMTAB 07240002 LM REG6,REG7,NEWLOAD PICK UP NEW LOADNAME 07250002 STM REG6,REG7,TSTCURLD STORE IN QUALIFIED LOADNAME 07260002 * FIELD OF TCOMTAB 07270002 SPACE 07280002 ************************************************************** 07290002 * * 07300002 * THE FOLLOWING ROUTINE WILL INITIALIZE TO PRINT * 07310002 * A MESSAGE INDICATING THE TCB ADDRESS UNDER WHICH * 07320002 * QUALIFICATION HAS TAKEN PLACE. * 07330002 * * 07340002 ************************************************************** 07350002 SPACE 07360002 ST WORKE,TCBSAVE SAVE TCB ADDR 07370002 XC TSTIOPRM,TSTIOPRM ZERO OUT PARM AREA FOR I/O 07380002 IKJEGSIO MSG,FIRST=M0027,INST11=(REG,(WORKE)), CALL I/O FOR *07390002 ID=QFY26,MF=(E,TSTIOPRM) ERROR MESSAGE 07400002 CH RETCODE,H16 TEST FOR SERIOUS ERROR 07410002 BL CKTCB IF NOT CONTINUE WITH EXIT 07420002 B QFYRET RETURN FAST 07430002 SPACE 07432002 CKTCB DS 0H 07440002 OI TSTFLGS2,TSTQUAL TURN ON-QUALIFY STARTING TCB 07490002 OC TSTGO(FOUR),TSTGO TEST IF A NEW TCB WAS 07640002 * QUALIFIED 07650002 LA RETCODE,FOUR IF SO, SET RETURN CODE TO 4 07660002 BNZ QFYRET1 AND BRANCH 07670002 SPACE 07680002 QFYCCO DS 0H THIS IS A WRAP UP ROUTINE 07690002 NI TSTFLGS2,HEXFF-TSTQUAL TURN ON-QUALIFY STARTING TCB 07692002 XR RETCODE,RETCODE SET RETURN CODE TO ZERO 07700002 QFYRET DS 0H RETURN TO MAINLINE 07710002 MVC PPTCB(FOUR),PPTCBSAV RESTORE ORIGINAL PPTCB IN 07720002 * TCOMTAB 07730002 MVC PPRB(FOUR),PPRBSAV RESTORE ORIGINAL RB 07740002 QFYRET1 DS 0H EQUATE LABEL 07750002 LR REG2,REG15 TRANSFER RETURN CODE 07752002 ESTAE 0,OV REMOVE ESTAE 07754002 LR REG15,REG2 TRANSFER RETURN CODE 07756002 NI TSTFLGS4,HEXFF-TSTRERTN TURN OFF RETRY SW IF ON 07758002 SPACE 07760002 L SAVEREG,FOUR(ZERO,SAVEREG) RESTORE REG 13 07770002 RETURN (14,12),,RC=(15) RETURN TO CALLER - IKJEGMN1 07780002 SPACE 07790002 SPACE 07800002 NEWTCB DS 0H LOADNAME FOUND ON A NEW TCB 07810002 L REG4,PPRB GET CURRENT RB 07820002 L REG5,BREAKTAB GET PTR TO BREAK TABLE 07830002 * FROM TCOMTAB 07840002 USING BRKELEM,REG5 SET UP ADDRESSABILITY TO 07850002 * BREAK TABLE 07860002 SPACE 07870002 L REG6,TCBRBP GET PTR TO RB QUE 07880002 USING RBSECT,REG6 SET UP ADDRESSABILITY TO 07890002 * NEW RB 07900002 SPACE 07910002 LTR REG5,REG5 HAS A BREAKPOINT BEEN SET 07920002 BZ SETTCB NO, BRANCH 07930002 SPACE 07940002 SPACE 07950002 PRBTST LA REG6,ZERO(ZERO,REG6) CLEAR HIGH-ORDER BYTE 07960002 TM RBSTAB1,RBFTSIRB IS RB A PRB OR AN IRB 07970002 BZ RBTST YES... 07980002 SPACE 07990002 L REG6,RBLINK NO...BUMP TO NEXT RB 08000002 B PRBTST CHECK AGAIN 08010002 SPACE 08020002 RBTST TM RBOPSW+ONE,HEXF0 CHECK PSW FOR KEY 0 08030002 BZ NOQUAL KEY IS ZERO, NO QUALIFICATION 08040002 SPACE 08050002 TM RBOPSW+ONE,HEX01 CHECK P-BIT OF PSW'S AMWP 08060002 BZ NOQUAL P-BIT OFF INDICATES 08070002 * SUPERVISOR STATE...NO GOOD 08080002 SPACE 08090002 DROP REG6 08100002 USING RBSECT,REG4 SET UP ADDRESSABILITY TO 08110002 * OLD RB 08120002 SPACE 08130002 CHKBRK CLC RBOPSW+FIVE(THREE),BRKADDR+ONE COMPARE INSTR ADDR 08140002 * OF CURRENT RB'S PSW 08150002 * TO BRKADDR 08160002 BE MATCH BRANCH IF MATCH IS FOUND 08170002 SPACE 08180002 L REG5,BRKLINK GET BRKLINK ENTRY 08190002 LTR REG5,REG5 IS IT ZERO (END OF CHAIN) 08200002 BZ SETTCB YES...GO SET PPTCB 08210002 B CHKBRK NO...CHK NEXT BREAK ELEMENT 08220002 SPACE 08230002 MATCH LA REG5,BRKINST PTR TO BRKINSTR IN 08240002 * BREAK TABLE 08250002 L ZERO,PPTCB GET CUR TCB ADDR FROM TCOMTAB 08260002 IKJEGS9G OPSW,TCBADDR=(ZERO),VALUE=(REG5),MF=(E,TESTSVC) 08280002 CH RETCODE,H16 TEST FOR SERIOUS ERROR 08282002 BL SETTCB IF NOT CONTINUE WITH EXIT 08284002 B QFYRET RETURN FAST 08286002 SPACE 08290002 SETTCB L REG5,PPTCB GET CUR PROB PGM TCB ADDR 08300002 ST REG5,TCBUSED SAVE ADDRESS OF OLD TCB 08310002 LA WORKE,ZERO(ZERO,WORKE) CLEAR HIGH-ORDER BYTE 08320002 ST WORKE,PPTCB PUT THE NEW TCB ADDRESS IN 08330002 * TCOMTAB 08340002 SPACE 08350002 DROP REG4 08360002 USING RBSECT,REG6 ADDRESSABILITY TO NEW RB 08370002 SPACE 08380002 SETPRB LA ZERO,ZERO(REG6) GET ADDR OF NEW RB 08390002 ST ZERO,PPRB SAVE NEW RB ADDR 08400002 SPACE 08410002 L WORKO,RBCDE GET PTR TO CDE 08420002 LA WORKO,ZERO(WORKO) CLEAR HIGH BYTE 08430002 LTR WORKO,WORKO CHECK IF CDE ADDR IS ZERO 08440002 BNZ SETAQUAL IF NOT, CHANGE 'TSTAQUAL' 08450002 * IN TCOMTAB 08460002 SPACE 08470002 MVI TSTAQUAL,ZEROBYTE IF SO, SET FIRST BYTE OF 08480002 * TSTAQUAL TO ZERO 08490002 B SETTSTGO BRANCH TO SET 'TSTGO' IN 08500002 * TCOMTAB 08510002 SPACE 08520002 SETAQUAL DS 0H INITIALIZE TO REQUALIFY 08530002 MVC TSTAQUAL(TWELVE),CDNAMEX(WORKO) PUT LOADNAME AND 08540002 * ENTRY POINT ADDR INTO TSTAQUAL 08550002 SPACE 08560002 SETTSTGO MVC TSTGO(FOUR),RBOPSW+FOUR SAVE NEW RB'S PSW INSTR ADDR 08570002 SPACE 08580002 LA REG4,TSTGO+SIX REG1 = PTR TO SVC 08590002 IKJEGS9G OPSW,TCBADDR=(WORKE),VALUE=(REG4),MF=(E,TESTSVC) 08610002 CH RETCODE,H16 TEST FOR SERIOUS ERROR 08612002 BL CONT1 IF NOT CONTINUE WITH EXIT 08614002 B QFYRET RETURN FAST 08616002 SPACE 08620002 CONT1 DS 0H 08622002 L ZERO,PPRB REG0 = PTR TO NEW RB 08630002 MVC TSTGO+FOUR(ONE),RBWCF SAVE WAIT COUNT OF NEW RB 08640002 DROP REG6 08650002 * ORDER BYTE. 08660002 IKJEGS9G WCF,TCBADDR=(WORKE),MF=(E,TESTSVC) 08670002 CH RETCODE,H16 TEST FOR SERIOUS ERROR 08672002 BL TSTENTRY BRANCH TO TEST FOR ENTRY NAME 08674002 B QFYRET RETURN FAST 08676002 SPACE 08678002 NOQUAL DS 0H 08730002 XC TSTIOPRM,TSTIOPRM ZERO OUT PARM LIST 08740002 IKJEGSIO MSG,FIRST=M0107,INST11=(NUM,I0022), CALL I/O FOR *08750002 SECOND=M0225,ID=QFY26,MF=(E,TSTIOPRM) ERR MSG 08752002 CH RETCODE,H16 TEST FOR SERIOUS ERROR 08754002 BL QFYCCO NOT SERIOUS CONTINUE 08756002 B QFYRET RETURN TO MAINLINE 08758002 SPACE 08760002 NOENTRY DS 0H LOADNAME WAS FOUND BUT 08770002 * ENTRYNAME NOT SPECIFIED 08780002 MVI TSTCURCT,ZEROBYTE ZERO OUT FIELD IN TCOMTAB FOR 08790002 MVC CSECTNM1(L7),TSTCURCT CURRENTLY QUALIFIED CSECT 08800002 * NAME 08810002 B SETTCOM FINISH PUTTING INFO IN TCOMTAB 08820002 SPACE 08830002 TESTCODE DS 0H CHECK CODE ON RETURN FROM 08840002 * IKJEGSYM 08850002 CLI TCBUSED,NOTNEW WAS NEW TCB USED 08860002 BE STOREC NO, CHECK RETURN CODE 08870002 MVC PPTCB(L4),TCBUSED RESTORE PPTCB 08880002 SPACE 08890002 STOREC DS 0H CHECK RETURN CODE 08900002 STC RETCODE,CODESAVE SAVE CODE TO TEST 08910002 CLI CODESAVE,SIXTEEN WAS AN ATTENTION SCHEDULED 08920002 BE QFYRET YES, RETURN TO CALLER 08930002 B LDCST NO, PUT OUT MESSAGE FOR UNABLE 08940002 * TO QUALIFY LOADNAME. 08950002 * CSECTNAME 08960002 SPACE 08970002 EJECT 09100002 ******************************************************************** 09110002 * * 09120002 *THIS ROUTINE WILL BE ENTERED BY PARSE TO MAKE A VALIDITY CHECK ON * 09130002 * THE FIRST QUALIFY POSITIONAL PARAMTER. IF THE PARAMETER IS AN * 09140002 * EXPRESSION, AN INDIRECT ADDRESS, AN ABSOLUTE ADDRESS, OR A FULLY * 09150002 * QUALIFIED ADDRESS CONTROL IS GIVEN TO THE CONVERT ROUTINE TO CONVERT 09160002 * THE ADDRESS TO BINARY. * 09170002 * * 09180002 ******************************************************************** 09190002 SPACE 09200002 QFYVALCK DS 0H VALIDITY CHECK ROUTINE 09210002 SAVE (14,12),,QFYVALCK SAVE REGISTERS FROM PARSE 09220002 L REG5,FOUR(ZERO,PARAMREG) GET ADDRESS OF QUALIFY'S SAVE 09230002 * AREA 09240002 L BASEREG,SIXTY8(ZERO,REG5) SET UP ADDRESSABILITY WITH 09250002 * MAINLINE OF QUALIFY 09260002 L REG9,FIFTY6(ZERO,REG5) RESTORE REGISTER 9 WITH ADDR 09270002 * OF TCOMTAB 09280002 L REG10,SIXTY(ZERO,REG5) WORKAREA ADDRESSABILITY 09290002 SPACE 09300002 L REG6,REGSAVE3 GET ADDRESS OF SAVE AREA FOR 09310002 * THIS ROUTINE 09320002 ST SAVEREG,FOUR(ZERO,REG6) SAVE ADDRESS OF PARSE SAVE AREA 09330002 ST REG6,EIGHT(ZERO,SAVEREG) STORE ADDRESS OF NEW SAVE AREA 09340002 * IN PARSE SAVE AREA 09350002 LR SAVEREG,REG6 PUT ADDRESS OF NEW SAVE AREA 09360002 * IN REGISTER 13 09370002 SPACE 09380002 * BEGIN TESTS OF PARAMETER 09390002 XR REG4,REG4 CLEAR REGISTER FOR TEST 09392002 L R11,OUTBUF PICK UP ADDRESS OF OUTBUF 09394002 ST REG4,ZERO(R11) SET IN NO 2ND MSG DEFAULT VALUE 09396002 OI TSTFLGS4,TSTVALCK TURN ON THE VALIDITY CHECK SW 09398402 L R11,ZERO(ZERO,PARAMREG) PUT ADDRESS OF PDE IN REG 11 09400002 ST PARAMREG,PDESAVE SAVE PARSE PARAM LIST ADDR 09410002 CH REG4,PDEINDCT IS ADDRESS INDIRECT 09430002 BNE PREPCONV YES, SET UP FOR CONVERT ROUTINE 09440002 TM PDEFLG4,REGTYPE IS IT A REGISTER ADDRESS 09450002 BM REGMSG YES, PUT OUT MESSAGE FOR 09460002 * INVALID ADDRESS 09470002 CLI PDEFLG4,SYMADDR IS ADDRESS A SYMBOLIC 09480002 BNE WHATISIT NO, DETERMINE WHETHER OR NOT 09490002 * TO CONVERT 09500002 CLI PDESIGN,ZEROBYTE IS ADDRESS AN EXPRESSION 09510002 BNE PREPCONV YES, SET UP FOR CONVERT RTN 09520002 TM PDEFLG1,ONBIT IS ADDRESS FULLY QUALIFIED 09530002 BZ CHKCT NO, SET UP FOR RETURN TO PARSE 09540002 SPACE 09550002 PREPCONV DS 0H SET UP FOR CONVERT ROUTINE 09560002 LCR PARAMREG,R11 PUT TWO'S COMPLEMENT OF ADDR 09570002 * OF PDE IN REGISTER 1 TO 09580002 * INDICATE THAT THIS IS TO BE 09590002 * AN ADDRESS CONVERT 09600002 XR ZERO,ZERO INDICATE THAT A BINARY CONVERT 09610002 * IS DESIRED 09620002 L ADDREG,TSTCONVT GET ADDRESS OF CONVERT ROUTINE 09630002 BALR RETREG,ADDREG GO TO CONVERT ROUTINE 09640002 LTR RETCODE,RETCODE WAS CONVERT SUCCESSFUL 09650002 BNZ BADCONV NO...HAVE PARSE PUT OUT 09660002 * 'REENTER' 09670002 TM PDEUSER,ONBIT IS ADDRESS IN USERWORD 09680002 BZ GOBACK YES, RETURN TO PARSE 09690002 L WORKE,PDEUSER GET POINTER TO SI BLOCK 09700002 L WORKO,ZERO(ZERO,WORKE) PICK UP ADDR 09710002 ST WORKO,PDEUSER STORE IN USERWORD 09720002 B GOBACK RETURN TO PARSE 09730002 SPACE 09740002 CHKLENG DS 0H CHECK LENGTH OF SYMBOLIC 09750002 XR REG5,REG5 CLEAR REGISTER 09760002 LA REG5,L8(ZERO,REG5) PUT AN 8 IN REGISTER 09770002 CH REG5,PDELEN3 DOES SYMBOL EXCEED 8 BYTES 09780002 BL EXCEEDS YES, PUT OUT MESSAGE 09790002 BACK L REG4,NOBINARY PICK UP INDICATION FOR ADDRESS 09800002 * NOT CONVERTED TO BINARY 09810002 ST REG4,PDEUSER PLACE IN PDE 09820002 SPACE 09830002 GOBACK DS 0H RETURN 09840002 XR RETCODE,RETCODE SET RETURN CODE TO ZERO 09850002 NI TSTFLGS4,HEXFF-TSTVALCK TURN OFF THE VALIDITY CHECK SW 09852002 L SAVEREG,FOUR(ZERO,SAVEREG) RESTORE REG 13 09860002 RETURN (14,12),,RC=(15) RETURN TO PARSE 09870002 SPACE 09880002 CHKCT DS 0H TEST FOR CSECTNAME.SYMBOL 09890002 TM PDEFLG2,ONBIT CSECTNAME GIVEN 09900002 BZ CHKLENG NO, TEST LENGTH OF SYMBOLIC 09910002 B PREPCONV RESOLVE CSECTNAME ADDRESS 09920002 SPACE 09930002 WHATISIT EQU * DETERMINE WHETHER OR NOT TO 09940002 * CONVERT ADDRESS 09950002 TM PDEFLG1,ONBIT LOADNAME GIVEN 09960002 BZ PREPCONV NO, CONVERT ADDRESS 09970002 TM PDEFLG3,ONBIT FULLY QUALIFIED NAME GIVEN 09980002 BO PREPCONV YES, CONVERT ADDRESS 09990002 B BACK INPUT WAS LOADNAME.CSECTNAME 10000002 * RETURN TO IKJPARS WITH CODE 10010002 * OF ZERO 10020002 SPACE 10030002 EXCEEDS DS 0H PREPARE TO PUT OUT MESSAGE FOR 10040002 * LENGTH OF SYMBOL TOO GREAT 10050002 LA REG2,M0268 GET MESSAGE NUMBER INTO REG 10060002 B MSGOUT BRANCH TO PUT OUT MESSAGE 10070002 SPACE 10080002 REGMSG DS 0H 10090002 LA REG2,M0268 GET MESSAGE NUMBER INTO REG 10092002 SPACE 10100002 MSGOUT DS 0H 10110002 XC TSTIOPRM,TSTIOPRM CLEAR I/O PARM LIST 10120002 IKJEGSIO MSG,FIRST=M0101,INST11=(APDE,(R11)), CALL I/O FOR *10130002 SECOND=(REG2),ID=QFY26,MF=(E,TSTIOPRM) ERROR MESSAGE 10140002 CKRC DS 0H 10150002 LTR RETCODE,RETCODE WAS MESSAGE SUCCESSFULLY 10230002 * HANDLED 10240002 BNZ SAVECODE NO, SAVE RETURN CODE 10250002 B SETCODE8 HAVE PARSE PUT OUT 'REENTER' 10260002 EJECT 10590002 ******************************************************************** 10600002 * * 10610002 * THIS ROUTINE WILL BE ENTERED BY PARSE TO MAKE A VALIDITY CHECK * 10620002 * ON THE ADDRESS SPECIFIED FOR THE TCB KEYWORD. * 10630002 * * 10640002 ******************************************************************** 10650002 SPACE 2 10660002 QFYCHECK DS 0H 10670002 SAVE (14,12),,QFYCHECK SAVE REGISTERS FROM PARSE 10680002 L REG5,FOUR(ZERO,PARAMREG) GET ADDRESS OF QUALIFY'S 10690002 * SAVE AREA 10700002 L BASEREG,SIXTY8(ZERO,REG5) GET ADDRESSABILITY WITH 10710002 * MAINLINE OF QUALIFY 10720002 L REG9,FIFTY6(ZERO,REG5) RESTORE REG9 WITH ADDRESS OF 10730002 * TCOMTAB 10740002 L REG10,SIXTY(ZERO,REG5) WORKAREA ADDRESSABILITY 10750002 SPACE 10760002 L REG6,REGSAVE3 GET ADDRESS OF SAVE AREA FOR 10770002 * THIS ROUTINE 10780002 ST SAVEREG,FOUR(ZERO,REG6) SAVE ADDRESS OF PARSE SAVE AREA 10790002 ST REG6,EIGHT(ZERO,SAVEREG) STORE ADDRESS OF NEW SAVE AREA 10800002 * IN PARSE SAVE AREA 10810002 LR SAVEREG,REG6 PUT ADDRESS OF NEW SAVE AREA 10820002 * IN REGISTER 13 10830002 * GET TCB ADDRESS CONVERTED TO BINARY 10840002 XR ZERO,ZERO INDICATE BINARY CONVERT 10842002 L R11,OUTBUF PICK UP ADDRESS TO OUTBUF 10844002 ST ZERO,ZERO(R11) STORE NO MSG DEFAULT 10846002 OI TSTFLGS4,TSTVALCK TURN ON VALIDITY CHECK SW 10848002 L R11,ZERO(ZERO,PARAMREG) GET ADDR OF PDE 10850002 ST PARAMREG,PDESAVE SAVE PARSE PARAM LIST ADDR 10860002 LCR PARAMREG,R11 PUT COMPLEMENT OF ADDRESS OF 10870002 * PDE IN REGISTER TO INDICATE 10880002 * ADDRESS CONVERT 10890002 L ADDREG,TSTCONVT GET ADDRESS OF CONVERT ROUTINE 10910002 BALR RETREG,ADDREG GO TO CONVERT ADDR 10920002 LTR RETCODE,RETCODE WAS CONVERT SUCCESSFUL 10930002 BNZ BADCONV NO, SET ERROR CODE 10940002 L WORKO,PDEUSER 10950002 TM PDEUSER,ONBIT IS CONVERTED ADDR IN USER WORD 10960002 BZ NOSYM YES... 10970002 SPACE 10980002 L WORKO,ZERO(ZERO,WORKO) NO, GET ADDR FROM SI BLOCK 10990002 ST WORKO,PDEUSER AND SAVE 11000002 NOSYM DS 0H 11010002 LH WORKO,PDEINDCT GET INDIRECT ADDR COUNT 11020002 LTR WORKO,WORKO IS IT ZERO 11030002 BNZ FULLWORD NO...CHECK BOUNDARY 11040002 SPACE 11050002 TM PDEFLG4,REGTYPE IS THIS A REGISTER ADDR 11060002 BZ FULLWORD NO... 11070002 SPACE 11080002 B REGMSG SET UP FOR 'INVALID REGISTER 11090002 * ADDR' MSG 11100002 SPACE 11110002 FULLWORD TM PDEUSER3,HEX03 FULLWORD BOUNDARY 11120002 BZ CHKTCB YES...CHECK IF TCB EXISTS 11130002 * AT SPECIFIED ADDRESS 11140002 SPACE 11150002 XC TSTIOPRM,TSTIOPRM ZERO OUT PARM FIELD 11160002 IKJEGSIO MSG,FIRST=M0101,INST11=(APDE,(R11)), CALL I/O FOR *11162002 SECOND=M0280,INST21=(NUM,I0003), ERROR MSG *11164002 ID=QFY26,MF=(E,TSTIOPRM) TO USER 11166002 B CKRC CHECK RETURN CODE 11170002 SPACE 11180002 ***************************************************************** 11190002 * * 11200002 * THE FOLLOWING ROUTINE WILL CHECK WHETHER OR NOT A TCB * 11210002 * UNDER TEST ACTUALLY EXISTS AT THE SPECIFIED ADDRESS. * 11220002 * * 11230002 ***************************************************************** 11240002 SPACE 11250002 CHKTCB L REG7,PDEUSER GET SPECIFIED TCB ADDR 11260002 LA REG7,ZERO(ZERO,REG7) CLEAR HIGH BYTE AND SAVE 11270002 SPACE 11280002 L REG4,TSTTCB TEST'S TCB 11290002 LA REG8,ZERO(REG4) CLEAR HIGH BYTE AND SAVE 11300002 DAU L REG5,D(REG4) GET ADDR OF DAUGHTER TCB 11310002 LTR REG5,REG5 IS THERE A DAUGHTER 11320002 BNZ CHKADDR YES...CHECK IF VALID 11330002 SPACE 11340002 SIS L REG5,S(REG4) GET ADDR OF SISTER TCB 11350002 LTR REG5,REG5 IS THERE A SISTER 11360002 BNZ CHKADDR YES...CHECK IF VALID 11370002 SPACE 11380002 MOTH L REG4,M(REG4) GET ADDR OF MOTHER TCB 11390002 LA REG4,ZERO(REG4) CLEAR HIGH BYTE 11400002 CR REG4,REG8 DOES MOTHER = TEST TASK 11410002 BNE SIS NO...CHECK SISTER TASK 11420002 SPACE 11430002 LA REG2,M0226 GET MESSAGE NUMBER INTO REG 11440002 B MSGOUT MESSAGE 11450002 SPACE 11460002 CHKADDR LA REG5,ZERO(ZERO,REG5) CLEAR HIGH BYTE 11470002 CR REG5,REG7 DOES THIS TCB ADDR MATCH 11480002 * THE GIVEN TCB ADDR 11490002 BE RETPARSE YES...ADDR IS VALID, RETURN 11500002 * TO PARSE 11510002 SPACE 11520002 LR REG4,REG5 GET NEXT LOWER TCB IN CHAIN 11530002 B DAU LOOP UNTIL DONE 11540002 SPACE 11550002 ***************************************************************** 11560002 SPACE 2 11570002 RETPARSE DS 0H RETURN TO PARSE 11580002 NI TSTFLGS4,HEXFF-TSTVALCK TURN OFF VALIDITY CHECK BIT 11580102 L REG4,OUTBUF PICK UP ADDR OF SECOND LEV MSG 11580402 LH REG2,ZERO(REG4) PREPARE TO TEST FOR 2ND LEV 11581202 LTR REG2,REG2 TEST FOR ZERO MSG LENGTH 11581702 BZ NO2NDLEV BRANCH AROUND NEXT INSTRUCTION 11581902 L REG4,PDESAVE GET PARSE PARAM LIST ADDR 11582002 MVC EIGHT(FOUR,REG4),OUTBUF PUT ADDR OF SECOND LEVEL 11584002 * MSG IN PARSE PARAMETER LIST 11586002 NO2NDLEV DS 0H 11588002 L SAVEREG,FOUR(ZERO,SAVEREG) RESTORE REG 13 11590002 RETURN (14,12),,RC=(15) RETURN TO PARSE 11600002 SPACE 11610002 BADCONV DS 0H CONVERT RTN NOT SUCCESSFUL 11620002 SPACE 11660002 SAVECODE STC RETCODE,CONVRTCD SAVE RETURN CODE 11670002 CLI CONVRTCD,EIGHT COMPARE TO EIGHT 11680002 BNH SETCODE8 IF 4 OR 8, SET RETURN CODE 11690002 * TO 8 FOR PARSE 11700002 SPACE 11710002 LA RETCODE,TWELVE ELSE, SET RETURN CODE TO 12 11720002 * FOR PARSE 11730002 B RETPARSE RETURN TO PARSE 11740002 SPACE 11750002 SETCODE8 XR RETCODE,RETCODE CLEAR REGISTER 11760002 LA RETCODE,EIGHT(ZERO,RETCODE) RETURN CODE OF 8 FOR PARSE 11770002 * TO ISSUE 'REENTER' 11780002 B RETPARSE RETURN TO PARSE 11790002 EJECT 11800002 ************************************************************* 11810002 * * 11820002 * STAE RETRY ROUTINE * 11830002 * * 11840002 ************************************************************* 11850002 SPACE 2 11860002 RETRY DS 0H RETRY ADDR 11870002 L REG4,CVTPTR GET CVT ADDR 11880002 USING CVTDSECT,REG4 ADDRESSABILITY TO CVT 11890002 SPACE 11900002 L REG4,CVTTCBP GET ADDR OF CURRENT 11910002 L REG4,TCBADR(ZERO,REG4) TCB (TEST'S TCB) 11920002 DROP REG4 11930002 SPACE 11940002 USING TCB,REG4 ADDRESSABILITY TO TCB 11950002 L REG9,TCBTRN TCBTRN FIELD OF TEST'S TCB 11960002 OI TSTFLGS4,TSTRERTN TURN ON RETRY SW 11962002 * CONTAINS PTR TO TCOMTAB 11970002 SPACE 11980002 L SAVEREG,REGSAVE2 GET ADDR OF QUALIFY'S 11990002 * SAVEAREA 12000002 L BASEREG,SIXTY8(ZERO,SAVEREG) RE-ESTABLISH MODULE 12010002 * ADDRESSABILITY 12020002 SPACE 12030002 NOWORK LA RETCODE,TWENTY SET RETURN CODE TO 20 12100002 B QFYRET RETURN TO MAINLINE 12110002 EJECT 12120002 EXMOVE MVC ZERO(ZERO,REG4),ZERO(WORKO) MOVE INSTRUCTION TO BE 12130002 * EXECUTED 12140002 EJECT 12150002 ****************************************************************** 12160002 * * 12170002 * CONSTANTS * 12180002 * * 12190002 ****************************************************************** 12200002 * 12210002 SPACE 12220002 DS 0F ALIGNMENT 12230002 IKJEGSPL IKJEGSPL RTRY=RETRY,ABNTB=STATBL,MODNM=IKJEGQFY,TNM=QUALIFY 12230402 DS 0F ALIGNMENT 12230802 ZZZZZZZZ DC 52C'Z' TO BE USED FOR MAINTENANCE 12232002 NOEXP DC X'FF000000' SYMBOLIC OF NOT AN ADDRESS 12240002 * EXPRESSION 12250002 MASKUP DC X'FFFFFFFE' MASK FOR ROUNDING UP 12260002 NOBINARY DC X'FFFFFFFF' SYMBOLIC FOR ADDRESS NOT 12270002 * CONVERTED TO BINARY 12280002 ICCHNG DC X'08000000' IC CHANGE FLAG 12290002 WAITCNT DC X'01000000' FLAG TO TURN OFF WAIT CNT 12300002 TAB DC C'0123456789ABCDEF' TABLE FOR TCB ADDR TRANSLATE 12310002 PCLISTA DC V(IKJEGPCL) ADDRESS OF PCLIST CSECT 12320002 SPACE 12460002 RETRYADR DC AL3(RETRY) RETRY ROUTINE ADDR FOR STAE 12470002 SPACE 12480002 STAELIST ESTAE STAELIST,MF=L LIST FORM OF STAE 12490002 STAELEN EQU *-STAELIST LENGTH OF STAE LIST 12500002 SPACE 12510002 SPACE 12520002 SYMLIST LINK EP=IKJEGSYM,SF=L LIST FORM OF LINK 12530002 SMTSYM DS 0H SMT TEST LABEL FOR SYM LINK 12540002 SPACE 12550002 SYMLEN EQU *-SYMLIST LENGTH OF SYM LIST 12560002 SPACE 12570002 ZEROH DC H'0' HALFWORD OF ZERO 12580002 H16 DC H'16' FOR RETURN CODE TEST 12582002 SPACE 2 12590002 ***************************************************************** 12600002 * * 12610002 * STAE ADDRESS TABLE * 12620002 * * 12630002 ***************************************************************** 12640002 SPACE 2 12650002 STATBL DS 0H 12660002 DC AL1(99),AL3(PARSBLOW) PARSE LINK FAILED 12670002 DC AL1(99),AL3(SYMBLOW) SYM LINK FAILED 12680002 DC AL1(HEXFF) TABLE END 12690002 EJECT 12700002 DS 0F ALIGNMENT 14170002 IKJEGPCL IKJPARM DSECT=IKJPARMD 14180002 ADDR IKJPOSIT ADDRESS,PROMPT='ADDRESS',VALIDCK=QFYVALCK 14190002 TCBNAME IKJKEYWD 14200002 IKJNAME 'TCB',SUBFLD=TCBADDR 14210002 TCBADDR IKJSUBF 14220002 ADDRTCB IKJPOSIT ADDRESS,PROMPT='TCB ADDRESS',VALIDCK=QFYCHECK 14230002 IKJENDP 14240002 EJECT 14250002 TCOMTAB COMMUNICATIONS WORK AREA 14260002 CSECTNM1 EQU TSTCURCT+1 SECOND BYTE OF TSTCURCT 14270002 PPTCB1 EQU PPTCB+1 SECOND BYTE OF FIELD 14280002 EJECT 14290002 WORKSP DSECT WORK AREA DSECT 14300002 PARSPARM DS 0H PARAMETER LIST FOR PARSE 14310002 PTUPT DS A POINTER TO UPT 14320002 PTECT DS A POINTER TO ECT 14330002 PTCPECB DS A POINTER TO CP ECB 14340002 PTPCL DS A POINTER TO PCL 14350002 PTANSW DS A POINTER TO ANSWER PLACE 14360002 PTBUFF DS A POINTER TO COMMAND BUFFER 14370002 PTAREA DS A POINTER TO USER WORK AREA 14380002 NEWLOAD DS 2F LOADNAME GIVEN BY USER 14390002 NEWLOAD1 EQU NEWLOAD+1 SECOND BYTE OF NEWLOAD FIELD 14400002 PPRBSAV DS A SAVE AREA FOR PPRB 14410002 PPTCBSAV DS A SAVE AREA FOR PPTCB 14420002 TCBSAVE DS A SAVE AREA FOR QUALIFIED TCB 14430002 PDESAVE DS A PTR TO PARSE PARAMETER LIST 14440002 PROTKEY DS X PROTECTION KEY FOR TEST 14450002 TCBFLG DS X SWITCH FOR TCB 14460002 TCBGIVEN EQU X'80' TCB SPECIFIED 14470002 TCBNOSP EQU X'00' TCB NOT SPECIFIED 14480002 CODESAVE DS X RETURN CODE SAVED FOR TESTING 14490002 CONVRTCD DS X CONVERT RETURN CODE 14500002 DS 0F ALIGNMENT 14510002 CSECTADR DS A ADDRESS OF FIRST CSECT 14520002 TCBUSED DS A ADDRESS OF TCB USED 14530002 TESTSVC DS 3F PARM LIST FOR TEST SVC 14532002 BLDMSG DS 18C WORK AREA TO BUILD MESSAGE 14540002 BLDMSG1 EQU BLDMSG+1 SECOND BYTE 14550002 NEWADDR EQU X'00' INDICATES NEW TCB ADDR 14560002 NOTNEW EQU X'80' INDICATES TCB ADDR IN PPTCB 14570002 * IS THE ONE LOADNAME WAS 14580002 * FOUND ON 14590002 TCBUSED1 EQU TCBUSED+1 SECOND BYTE OF TCBUSED 14600002 EJECT 14610002 IKJPARMA 14620002 LDNM1 EQU PDELDNAM+1 SECOND BYTE OF LOADNAME SLOT 14630002 STRING1 EQU PDEADRPT+1 SECOND BYTE OF STRING 14640002 USEWRD EQU PDEUSER+1 SECOND BYTE OF USERWORD 14650002 PDEUSER3 EQU PDEUSER+3 FOURTH BYTE OF USER WORD 14660002 EJECT 14670002 TSTCWORK 14680002 EJECT 14690002 BRKELEM 14700002 EJECT 14710002 CVTDSECT DSECT 14720002 CVT 14730002 EJECT 14740002 IHACDE 14740402 IHAXTLST 14740802 IHALLE 14741202 EJECT 14742002 IKJTCB TCB DSECT 14750002 SPACE 14760002 S EQU TCBNTC-TCB SISTER TASK 14770002 M EQU TCBOTC-TCB MOTHER TASK 14780002 D EQU TCBLTC-TCB DAUGHTER TASK 14790002 EJECT 14800002 IKJRB RB DSECT 14810002 EJECT 14820002 IKJPPL PARSE PARAMETER LIST DSECT 14830002 END 14840002