TITLE 'IGC041 IDENTIFY COMMENTARY' 00100000 * /* START OF SPECIFICATIONS **** 00150002 * 00160002 *01* MODULE-NAME = IEAVID00 00170002 * 00192002 *02* CSECT-NAME = IGC041 00194002 * 00198002 *01* DESCRIPTIVE-NAME = IDENTIFY 00198402 * 00199202 *01* COPYRIGHT = NONE 00199602 * 00216602 *01* STATUS = Y02758 CHANGE LEVEL, VERSION 2 00226602 * 00230602 *01* FUNCTION = TWO FOLD 00232602 * A. TO IDENTIFY AN EMBEDED ENTRY TO THE SYSTEM 00232702 * 00232802 * SEARCHES THE CDE QUEUES(JPAQ AND LPAQ) FOR THE AREA FROM WHICH 00232902 * THE CURRENT RB'S PROGRAM MODULE COMES. IF THE IDENTIFIED NAME 00233002 * IS FOUND TO BE PREEXISTENT, AN EXCEPTION CODE IS RETURNED TO 00233802 * THE CALLER (SEE CPS FOR CODES). IF THE NAME IS NEW, THE 00234202 * EXTENT LIST OF THE CURRENT RB'S CDE IS USED TO DETERMINE 00234602 * WHETHER THE ENTRY POINT SPECIFIED AS THE SECOND OPERAND OF 00235002 * THE IDENTIFY MACRO FALLS WITHIN THE CURRENT MODULE. IF NOT, 00235402 * THE LOAD LIST (ORIGIN IS TCBLLS) OF THE CURRENT TASK IS 00235502 * SEARCHED USING THE CDE POINTER IN EACH LLE TO LOCATE AND 00236102 * EXAMINE ASSOCIATED EXTENT LISTS TO DETERMINE IF THE ENTRY 00238102 * POINT IS WITHIN ANY MODULE LOADED BY THE CURRENT TASK. IF 00238202 * THE ENTRY POINT CANNOT BE ASSOCIATED WITH A MODULE, AN 00238402 * EXCEPTION CODE IS RETURNED. 00238502 * 00238602 * B. TO IDENTIFY TO THE SYSTEM A SINGLE COPY MODULE LOADED 00238702 * IN SUBPOOL 0 00238802 * 00239102 * AN EXCEPTION CODE IS RETURNED IF 00239502 * 1. THE PARAMETER LIST HAS INVALID ENTRIES 00239902 * 2. THE ENTRY POINT NAME IS PREEXISTENT ON THE LPAQ OR THE 00240502 * CALLER'S JPAQ CDE QUEUES 00240602 * 3. THE ENTRY POINT IS NOT WITHIN THE MODULE'S EXTENTS. 00240702 * OTHERWISE A NEW CDE, FLAGGED NOT LOADABLE ONLY, IN 00241002 * SUBPOOL ZERO, AND EXTENT LIST BUILT AND A ZERO USE COUNT, IS 00241402 * QUEUED ON THE CALLER'S JPAQ. 00241502 * 00242002 *02* OPERATION = THIS MODULE IS PROTECTED BY AN FRR RECOVERY 00242302 * ROUTINE (FRRSVC41) WHICH VERIFIES THE APPROPRIATE CDE QUEUE 00242402 * AND CAUSES RETRY TO A ROUTINE WHICH WILL RETURN CONTROL TO 00242502 * THE CALLER WITH A RETURN CODE OF X'24' - UNEXPECTED SYSTEM 00242602 * ERROR, REQUEST NOT COMPLETED. 00242702 * 00243602 *01* NOTES = THE FOLLOWING IS A DESCRIPTION OF THE DEPENDENCIES, 00243802 * CONVENTIONS, AND FUNCTIONS OF IEAVID00 00243902 * 00244102 *02* DEPENDENCIES = THIS SVC ROUTINE MUST BE ENTERED WITH THE LOCAL 00244202 * LOCK 00245602 * 00270202 *03* CHARACTER-CODE-DEPENDENCIES = NONE 00270602 * 00271802 *02* RESTRICTIONS = NONE 00271902 * 00272102 *02* REGISTER-CONVENTIONS = THE REGISTER CONVENTIONS USED BY 00276702 * IEAVID00 ARE DESCRIBED UNDER THE TOPIC REGISTER EQUATES. 00277102 * 00281202 *02* PATCH-LABEL = ZAPSPACE (IN USE) 00281302 * 00288002 *01* MODULE-TYPE = MODULE 00290002 * 00290502 *02* PROCESSOR = ASSEMBLER 00290602 * 00322402 *02* MODULE-SIZE = 1000 BYTES 00326302 * 00334202 *02* ATTRIBUTES = PAGED-LPA, REENTERABLE, SUPERVISOR MODE, ENABLED, 00336202 * TYPE 3 SVC 00346202 * 00358702 *01* ENTRY-POINT = IGC041 00362102 * 00365402 *02* PURPOSE = MAIN ENTRY TO IDENTIFY FUNCTION 00365502 * 00369002 *02* LINKAGE = ENTERED FROM THE SVC INTERUP HANDLER 00371002 * 00372302 *02* INPUT = PSW IS ENABLED, IN SUPERVISOR STATE, KEY 0, AND 00372402 * AND HOLDS THE LOCAL LOCK ON ENTRY. 00376402 * REGISTERS- 00378402 * 0- ADDR OF SYMBOLIC NAME OR PARAMETER LIST. 00378502 * 1- ADDR OF ENTRY POINT OR ZERO. 00378602 * 3- CVT ADDR 00378702 * 4- CURRENT TCB 00378802 * 5- CURRENT RB 00378902 * 14-RETURN ADDRESS 00379002 * 2,6-13,15- IRRELEVANT. 00379402 * 00380902 *02* OUTPUT = NONE 00381302 * 00382102 *02* REGISTERS-SAVED = NONE - REGISTERS SAVED BY INTERRUPT HANDLER 00382502 * IN SVRB 00384502 * 00384802 *01* ENTRY-POINT = FRRSVC41 00386802 * 00388202 *02* PURPOSE = INSURE CDE QUEUES ARE NOT DAMAGED BY SYSTEM ERROR 00388302 * AND PREVENT ABEND IF POSSIBLE BY RETURNING TO A ROUTINE WHICH 00388402 * WILL SET A RETURN CODE OF X'24' 00388502 * 00389002 *02* LINKAGE = BRANCH ENTERED BY RTM1 WHEN ERROR IS DETECTED 00389102 * 00389502 *02* INPUT = REGISTERS ARE: 00390002 * R1 = ADDRESS OF SDWA 00392002 * R14 = RETURN ADDRESS 00392202 * 00392602 *02* OUTPUT = NONE 00394102 * 00395302 *02* REGISTERS-SAVED = NONE 00395702 * 00396502 *02* REGISTER-USAGE = SEE PROLOGUE BEFORE RECOVERY ROUTINE 00396602 * 00397002 *01* EXIT-NORMAL = IGC041 00399802 * 00402202 *02* CONDITIONS = RETURN TO CALLER VIA BRANCH TO EXIT PROLOGUE 00402802 * 00404202 *02* OUTPUT = PSW SAME AS UPON ENTRY 00406202 * REGISTERS ARE: 00416202 * R0-14 = UNCHANGED 00418202 * R15 = RETURN CODE 00418302 * 00418502 *02* RETURN-CODES = SEE PROLOGUE 00428502 * 00430102 *01* EXIT-NORMAL = FRRSVC41 00430202 * 00431302 *02* CONDITIONS = RETURN TO RTM1 VIA BR14 TO CAUSE RETRY IN 00431402 * IEAVID00 WHICH WILL IN TURN CAUSE THE CALLERS TO RECEIVE 00431502 * CONTROL WITH A RETURN CODE OF X'24' IN REGISTER 15 00431602 * 00431802 *02* OUTPUT = REGISTERS ARE: 00431902 * R0-13 = UNPREDICTABLE 00432002 * R14 = RETURN ADDRESS 00432102 * 00432702 *02* RETURN-CODES = SDWA CONTAINS THE FOLLOWING CODES: 00433002 * 0 - CONTINUE WITH TERMINATION 00433402 * 4 - RETRY AT ERROR EXIT IN IEAVID00 00433802 * 00434302 *01* EXIT-ERROR = NONE 00434402 * 00436402 *02* CONDITIONS = NONE 00436902 * 00437902 *02* OUTPUT = NONE 00438402 * 00441202 *02* RETURN-CODES = NONE 00441402 * 00447802 *01* EXTERNAL-REFERENCES = IEAQCDSR 00451202 * 00454002 *02* ROUTINES = GETMAIN - GET CDE 00454402 * EXIT PROLOGUE - TO RELINQUISH CONTROL 00454502 * 00458502 *02* DATA-AREAS = NO I/O IS DONE IN THIS MODULE, NO DATASETS OPENED 00460502 * OR CLOSED 00460602 * 00462202 *02* CONTROL-BLOCKS = AS FOLLOWS: 00462302 * EMBEDED ENTRY POINT FUNCTION 00462802 * CVT- 00463202 * CVTQLPAQ- NOT ALTERED 00463602 * TCB- 00464002 * TCBJSTCB- NOT ALTERED 00464102 * TCBJPA- NOT ALTERED 00464202 * TCBLLS- NOT ALTERED 00464302 * RB- 00464402 * RBLINK- NOT ALTERED 00464502 * RBSTAB- NOT ALTERED 00464602 * RBCDE - NOT ALTERED 00464702 * CDE- 00465102 * CDATTR- ALTERED 00465202 * CDNAME- NOT ALTERED 00465302 * CDCHAIN- ALTERED 00465402 * CDENTPT- ALTERED 00465602 * CDXLMJP- ALTERED 00466002 * LLE- 00466102 * LLCHAIN- NOT ALTERED 00466202 * LLCDPTR- NOT ALTERED 00466302 * EXTENT LIST- 00466402 * NOT ALTERED 00466502 * SUBPOOL ZERO MODULE FUNCTION 00466602 * CVT- 00466702 * CVTMZ00 00466802 * CVTLPAQ 00466902 * TCB- 00467002 * TCBMSS 00467102 * TCBPKF 00467202 * TCBJPAQ 00467302 * TCBJSTCB- ALTERED 00467702 * RB- 00468102 * RBSTAB 00468202 * RBCDE 00468602 * RBLINK 00468702 * CDE- 00468802 * CDATTR 00468902 * CDNAME 00469002 * CDCHAIN 00469102 * CDXLMJP 00469202 * NEW CDE IS BUILT 00469302 * 00469402 * EXTENT LIST- NEW ONE IS BUILT 00469502 * 00470002 *01* TABLES = MAJOR REQUEST INPUT PARAMETER LIST IS AS FOLLOWS: 00470102 * ******************************************* 00470202 * *0 ENTRY POINT ADDRESS * 00470302 * ****** ****** 00470402 * *4 ENTRY * 00470502 * *** POINT *** 00470602 * *8 NAME * 00470702 * ******* START OF EXTENT LIST ******* 00470802 * *12 LENGTH OF EXTENT LIST * 00470902 * ****** ****** 00471002 * *16 NUMBER OF EXTENTS * 00471102 * ***** ****** 00471202 * *20 LENGTH OF 1ST EXTENT * 00471302 * ****** ****** 00471402 * * * 00471502 * 00471602 * * * 00471702 * ****** ****** 00471802 * *'80'X * LENGTH OF LAST EXTENT * 00471902 * ****** ****** 00472002 * * ADDRESS OF 1ST EXTENT * 00472102 * ****** ****** 00472202 * * * 00472302 * 00472402 * * * 00472602 * ****** ****** 00473002 * * ADDRESS OF LAST EXTENT * 00473402 * ******************************************* 00473802 * 00474202 *01* MACROS = GETMAIN,SETFRR,TESTAUTH,SETRP,RECORD, 00474302 * CVT,IEZBITS,IHACDE,IHAFRRS,IHALLE,IHAPSA,IHARB, 00476202 * IHASDWA,IKJTCB,MODID,SETLOCK 00478202 * 00480202 *02* SERIALIZATION = THE LOCAL LOCK IS HELD ON ENTRY AND THE CMS 00480802 * LOCK IS OBTAINED AND FREED DURING LPA QUEUE SEARCH AND 00482402 * MANIPULATION 00484002 * 00485602 *01* CHANGE-ACTIVITY = Y02758 00487202 * OZ17842 - SEE NEAR LABEL RECRDLPA @ZA17842 00488003 * OZ20978 - NEAR LABEL LEGALEP CHANGE TO ONLY 00488203 * BUILD MAJOR ON JOB PACK QUEUE FOR 00488403 * MODULES LOADED BY NIP @ZA20978 00488603 * OZ28584 - CHECK THAT AN ADDRESS GIVEN FOR 00488803 * A NAME FOR A MINOR CDE IS NOT 00489103 * IN FETCH-PROTECT STORAGE @ZA28584 00489503 * OZ26744 - CHECK FOR RBCDE=0 IN CALLER'S 00489703 * PRB @ZA26744 00489903 * OZ26745 - CHECK IF CDE CONTAINS AN EXTENT 00490103 * LIST ADDRESS OR A MAJOR CDE 00490303 * ADDRESS @ZA26745 00490503 * OZ26742 - CHECK THAT AN ADDRESS GIVEN FOR 00490703 * A LIST FOR A MAJOR CDE IS NOT 00490803 * IN FETCH-PROTECTED STORAGE @ZA26742 00490903 * 00491003 * 00491103 *01* MESSAGES = IEA959I - SYSTEM ERROR REQUIRED LPA QUEUE TO BE 00491803 * TRUNCATED AND FIXED LPA MODULE CONTRIL MAY BE LOST 00492002 * IDENTIFY THAT MODULE (WHERE POSSIBLE).; 00493602 * 00495202 *01* ABEND-CODES = NONE 00496802 * 00498402 **** END OF SPECIFICATIONS ***/ 00500002 TITLE 'IGC041 IDENTIFY' 08760000 SPACE 2 08770002 */*IEAVID00: CHART IDENTIFY */ 08780002 */* HEADER 08790002 */* 08800002 */* 08802002 */* 08804002 */* SECTION 3.1.8.4 08806002 */* IDENTIFY 08808002 */* PAGE # */ 08808402 SPACE 2 08808802 */*IGC041: E ENTRY FROM SLIH */ 08809202 SPACE 2 08809602 IGC041 START 0 IDENTIFY SVC SERVICE 08810000 SPACE 2 08820002 */* P SET BASE IN REG 6 */ 08822002 SPACE 2 08830002 BALR BASEREG,N0 SET UP BASE ADDRESS 08850000 USING *,BASEREG REG 13 CONTAINS BASE ADDRESS 08900000 MODID BR=YES CSECT IDENTIFIER 08960002 USING PSA,0 ADDRESSABILITY TO PSA 09060002 SPACE 2 09070002 */* P REG 3= CVT ADR REG 4= TCB ADR REG 5= RB ADR REG 12= CD ENTRY*/ 09072002 SPACE 2 09080002 USING CVT,CVTREG REG 3 CONTAINS CVT ADDRESS 09100000 USING TCB,TCBREG REG 4 CONTAINS TCB ADDRESS 09150000 USING RBSECT,RBREG REG 5 CONTAINS RB ADDRESS 09200000 USING CDENTRY,CDEREG REG 12 CONTAINS CD ENTRY ADDRESS 09250002 SPACE 2 09252002 */* P SET FRR STACK */ 09252402 SPACE 2 09254002 LA R13,FRRSVC41 GET FRR ADDRESS 09260002 SETFRR A,FRRAD=(13),WRKREGS=(11,12),PARMAD=(10) 09300002 USING PARMAD,R10 @ZA26742 09310003 ST RBREG,PARMSVRB SAVE SVRB ADDRESS @ZA26742 09311003 ST BASEREG,PARMBASE PUT IDENTIFY BASE @ZA26742 09312003 MVI PARMFLAG,N0 CLEAR FLAG BYTE @ZA26742 09313003 DROP R10 @ZA26742 09314003 SPACE 2 09316102 */* P GET CALLER'S RB ADDRESS */ 09318102 SPACE 2 09320102 L RBREG,RBWCF LOAD ADDR OF NEXT RB ON CHAIN 09350000 SPACE 2 09400002 */* D (YES,YESPRB,NO,) RB A PRB? */ 09402002 SPACE 2 09410002 TM RBSTAB,RBPRBF IS RB A PRB I.E.=00XX XXXX 09450000 BZ YESPRB YES, CONTINUE 09500002 SPACE 2 09510002 */* P SET ERROR CODE = 16 IN REG 15 */ 09512002 SPACE 2 09520002 LA CODEREG,CODENPRB NO, LOAD RB-NOT-PRB CODE 09550000 SPACE 2 09560002 */* R RETURN VIA BR 14 */ 09562002 SPACE 2 09570002 B EXIT1 RETURN 09600002 SPACE 2 09610002 */*YESPRB: P GET ADDR OF CDE FOR MODULE ISSUING IDENTIFY */ 09614002 SPACE 2 09620002 YESPRB L CDEREG,RBCDFLGS LOAD ADDR CD ENTRY 09650000 LA CDEREG,0(,CDEREG) CLEAR HIGH ORDER BYTE @ZA26744 09660003 LTR CDEREG,CDEREG CDE ADDR ZERO? @ZA26744 09662003 BNZ CDMINTST BRANCH IF NOT @ZA26744 09664003 LA CODEREG,CODENGEP SET ERROR CODE @ZA26744 09666003 L R11,TCBLLS POINT TO FIRST LLE @ZA26744 09668003 LA R11,0(,R11) CLEAR HIGH ORDER BYTE @ZA26744 09670003 LTR R11,R11 IS THERE ONE? @ZA26744 09672003 BZ EXIT1 BR IF LOAD LIST EMPTY @ZA26744 09674003 USING LLE,R11 @ZA26744 09676003 L CDEREG,LLECDPT GET CDE FOR FIRST LLE @ZA26744 09678003 DROP R11 @ZA26744 09680003 SPACE 2 09682003 */* D (NO,TESTR1,YES,) CDE A MINOR? */ 09684003 SPACE 2 09686003 CDMINTST EQU * @ZA26744 09688003 TM CDATTR,CDMIN IS IDENTIFIER A MINOR 09700000 BZ TESTR1 NO, BRANCH AROUND LOADING MAJOR 09750000 SPACE 2 09760002 */* P GET ADDR OF MAJOR FROM MINOR */ 09762002 SPACE 2 09770002 L CDEREG,CDXLMJP YES, LOAD ADDR MAJOR ENTRY 09800000 SPACE 2 09810002 */*TESTR1: P GET IDENTIFY SVRB AND CLEAR EXTENDED SAVE AREA */ 09812002 SPACE 2 09820002 TESTR1 DS 0H TEST FOR AOS LOADER 09850002 L RBREG,TCBRBP GET IDENTIFY SVRB 09852002 XC RBEXSAVE(N20),RBEXSAVE CLEAR EXTENDED SAVE AREA 09854002 SPACE 2 09856002 */* P SET UP INPUT R9 = R0 R10 = R1 */ 09856402 SPACE 2 09858002 LR R13,R10 SAVE FRR PARM ADDRESS @ZA28584 09859003 LR PNREG,INREG1 PUT ENTRY POINT IN WORK REG 09860002 LR X2,INREG2 PUT NAME OR LIST IN WORKING REG 09870002 SPACE 2 09880002 */* D (YES,MAJORCDE,NO,) REQUEST TO CREATE A MAJOR? */ 09882002 SPACE 2 09890002 LTR INREG1,INREG1 IS MAJOR CDE REQUESTED 09900000 BZ MAJORCDE YES, BRANCH 09950000 SPACE 2 09960002 USING PARMAD,R13 @ZA26742 09960203 MVI PARMFLAG,PARMFTCH INDICATE FETCH PROTECT @ZA26742 09960303 MODESET EXTKEY=RBT234,WORKREG=2 GET INTO USER KEY @ZA28584 09960803 IC R2,N0(,R9) ADDRESS FIRST BYTE @ZA28584 09960903 IC R2,N7(,R9) ADDRESS LAST BYTE @ZA28584 09961003 MODESET EXTKEY=ZERO RETURN TO ZERO KEY @ZA28584 09961103 MVI PARMFLAG,N0 REMOVE FETCH INDICATOR @ZA26742 09961203 DROP R13 @ZA26742 09961403 SPACE 2 @ZA28584 09961803 */* S NOMIN:CHECK FOR DUP NAME */ 09962002 SPACE 2 09970002 BAL RETREG,NOMIN CHECK FOR DUP NAME 10000002 SPACE 2 10010002 */*USUAL: P GET ADDR OF LLE QUEUE HEADER IN TCB */ 10012002 SPACE 2 10020002 USUAL DS 0H RETURN IF NAME NOT FOUND 10050002 LA TLLSREG,TCBLLS LOAD TCBLLS ADDR 10100000 SPACE 2 10110002 */* S XLINST:CHECK IF EPA INVALID CDE */ 10112002 SPACE 2 10120002 BAL RETREG,XLINST CHECK ENTRY POINT PASSED 10150002 SPACE 2 10160002 */*LEGALEP: D (NO,GETCDE,YES,) MAJOR FROM AUTHORIZED LIBRARY? */ 10162002 SPACE 2 10170002 LEGALEP DS 0H RETURN IF GOOD ENTRY POINT 10180003 LA XLREG,N1 SET AUTH SWITCH @ZA20978 10187003 L ASCBREG,PSAAOLD GET ASCB ADDRESS FOR GETMAIN 10202002 TM CDATTR2,CDSYSLIB Q. MODULE FROM A SYSTEM LIBRARY 10210002 BZ GETCDE A. NO- GET APPROPRIATE CDE 10220002 SPACE 2 10222002 */* S TESTAUTH:TEST AUTH OF CALLER */ 10222402 SPACE 2 10224002 TESTAUTH KEY=YES,STATE=YES,FCTN=1,BRANCH=YES TEST AUTH. OF 10230002 * CALLER 10240002 SPACE 2 10240802 */* D (YES,GETCDE,NO,) IS CALLER AUTHORIZED? */ 10240902 SPACE 2 10241202 LTR CODEREG,CODEREG Q. CALLER AUTHORIZED 10242002 BZ GETCDE YES- GET APPROPRIATE CDE 10242402 SR XLREG,XLREG SET UNAUTH SWITCH @ZA20978 10244403 TM CDATTR,CDNIP MODULE LOADED BY NIP? @ZA20978 10246403 BZ GETLSQS NO THEN MINOR CDE @ZA20978 10248403 SPACE 2 10252402 */* S GETMAIN:GET CDE FOR LPA FROM LSQA (SP=255) */ 10254402 SPACE 2 10262402 * SPECIAL CODE FOR NON-AUTHORIZED CALLER'S WHO DO IDENTIFY TO 10292402 * AUTHORIZED LIBRARIES 10294402 SPACE 2 10294802 GETMAIN RU,SP=255,LV=CDESIZE,BRANCH=YES GET LSQA CDE 10296402 SPACE 2 10296502 */* P CLEAR GOTTEN AREA AND PUT EPA IN CDE */ 10297702 */* P NOTE: THERE IS NO XL FOR THIS MODULE */ 10298102 */* P NOTE: SYSTEM LIBRARY AND MODULE AUTHORIZATION TURNED OFF */ 10298502 SPACE 2 10299202 DROP CDEREG 10300402 USING CDENTRY,WKREG1 10301602 XC CDENTRY(CDESIZE),CDENTRY CLEAR GOTTEN AREA 10302802 ST X2,CDENTPT PUT SPECIFIED ENTRY IN CDE 10304002 SPACE 2 10304402 */* P PUT NAME IN MINOR */ 10304502 SPACE 2 10304802 MVC CDNAME(NAME),N0(PNREG) PUT GIVEN NAME IN CDE 10305202 SPACE 2 10305602 */* P SET USE COUNT = 0 */ @M7644 10305702 SPACE 2 10306002 SR WKREG2,WKREG2 SET UP FOR USE COUNT @M7644 10306402 STH WKREG2,CDUSE SET USE COUNT = 0 @M7644 10307202 SPACE 2 10308002 */* P COPY ATTRIBUTES FROM MAJOR */ 10308102 SPACE 2 10308202 MVC CDATTR(N1),CDATTR-CDENTRY(CDEREG) COPY IN ATTRIBUTES 10308802 NI CDATTR,MAX-CDNIP-CDNIC-CDMIN-CDNFN TURN OFF @M7644 10310002 * NECESSARY BITS 10310602 OI CDATTR,CDJPA AND TURN ON JPA BIT 10311202 TM CDATTR2-CDENTRY(CDEREG),CDOLY MAJOR IN OVERLAY 10321202 BZ CHAINCDE NO- DON'T SET IN MINOR 10323202 OI CDATTR2,CDOLY SET OVERLAY BIT 10329202 SPACE 2 10330802 */*CHAINCDE: P (,RETURN) CHAIN CDE TO TOP OF JPQ */ 10331202 SPACE 2 10332002 CHAINCDE L WKREG2,TCBJSTCB GET JOBSTEP TCB 10332402 LA WKREG2,TCBJPQ-TCB(WKREG2) GET JPQ FIELD 10333002 MVC CDCHAIN(N4),N0(WKREG2) CHAIN CDE TO TOP 10334902 ST WKREG1,N0(WKREG2) OF JPQ 10336802 B RETURN RETURN TO CALLER 10338702 DROP WKREG1 10340602 USING CDENTRY,CDEREG RESET ADDRESSING TO MAJOR 10342502 SPACE 2 10352502 */*GETCDE: D (NO,GETLSQS,YES,) MAJOR CDE IN LPAQ? */ 10354502 SPACE 2 10362502 GETCDE DS 0H DETERMINE TYPE OF CDE 10382502 TM CDATTR,CDNIP IS MAJOR ENTRY IN LPAQ 10432502 BZ GETLSQS NO - GET MINOR FROM LSQS 10482502 SPACE 2 10484502 */*S SETLOCK:GET CMS LOCK FOR LPA CHANGE */ 10484702 SPACE 2 10485502 STM R11,R12,RBEXSAVE+N4 SAVE VOLITAL REGS 10485702 SETLOCK OBTAIN,TYPE=CMS,MODE=UNCOND,RELATED=EXIT GET CMS 10485902 LM R11,R12,RBEXSAVE+N4 RESTORE VOLITAL REGS 10486102 SPACE 2 10486302 */* S (,CDESETUP) GETMAIN:GET CDE FOR LPA FROM SQA (SP=245) */ 10486502 SPACE 2 10486602 GETMAIN RU,SP=245,LV=CDESIZE,BRANCH=YES GET SQA CDE 10492502 B CDESETUP INITIALIZE CDE 10532502 SPACE 2 10542502 */*GETLSQS: S GETMAIN:GET CDE FROM LSQS (SP=255) */ 10544502 SPACE 2 10552502 GETLSQS GETMAIN RU,SP=255,LV=CDESIZE,BRANCH=YES GET LSQS CDE 10582502 SPACE 2 10592502 */*CDESETUP: P PUT EPA AND SET CDUSE IN MINOR TO 0 */ 10594502 SPACE 2 10602502 CDESETUP DS 0H 10632502 DROP CDEREG CHANGE CDE PTRS 10682502 USING CDENTRY,INREG2 CHANGE CD ENTRY REGISTER TEMP 10732502 XC CDENTRY(CDESIZE),CDENTRY CLEAR CDE AREA OBTAINED 10734502 ST X2,CDENTPT INITIALIZE CDENTPT 10742502 SPACE 2 10742902 */* P PUT MAJOR POINTER IN MINOR */ 10744502 SPACE 2 10746502 LA CDEREG,N0(CDEREG) ZERO HIGH BYTE OF MAJOR CDE ADDR 10752502 ST CDEREG,CDXLMJP INITIALIZE CDXLMJP 10754502 SPACE 2 10764502 */* P PUT NAME IN MINOR */ 10766502 SPACE 2 10774502 MVC CDNAME(NAME),N0(PNREG) STORE PROGNAMES 10800000 SPACE 2 10810002 */* P SET MINOR MIN,REN,SER,NLR */ 10812002 SPACE 2 10820002 MVI CDATTR,CDMIN+CDREN+CDSER+CDNLR SET FLAGS IN CDENTRY 10850000 SPACE 2 10860002 */* D (NO,NOTAPF,YES,) IS MAJOR CDE AUTHORIZED? */ 10862002 LTR XLREG,XLREG SHOULD AUTH BE COPIED @ZA20978 10864003 BZ NOTAPF NO USER WAS NOT AUTH @ZA20978 10866003 SPACE 2 10870002 TM CDATTR2-CDENTRY(CDEREG),CDAUTH CHECK AUTHORITY 10900000 BNO NOTAPF IF NOT AUTHORIZED SKIP BIT SET 10950000 SPACE 2 10960002 */* P SET AUTHORIZED BIT IN MINOR */ 10962002 SPACE 2 10970002 OI CDATTR2,CDAUTH SET AUTHORIZED MINOR 11000000 SPACE 2 11010002 */*NOTAPF: D (NO,CDMEADD,YES,) NIP ON IN MAJOR? */ 11012002 SPACE 2 11020002 NOTAPF EQU * APF CHECKING DONE 11050000 TM CDATTR-CDENTRY(CDEREG),CDNIP IS NIP ATTR OF MAJOR CDE. 11100000 BZ CDMEADD NO, DON'T SET ATTR IN MINOR 11150002 SPACE 2 11160002 */* P SET NIP BIT IN MINOR */ 11162002 SPACE 2 11170002 OI CDATTR,CDNIP SET NIP ATTR IN MINOR. 11200000 DROP INREG2 REESTABLISH BASE 11250000 USING CDENTRY,CDEREG TO CD MAJOR ENTRY 11300000 SPACE 2 11350002 */*CDMEADD: P POINT MINOR TO NEXT OFF MAJOR */ 11352002 SPACE 2 11360002 * CDMEADD INPUT = MAJOR CDE ADDR IN CDEREG, MINOR CDE ADDR IN INREG2 11450000 SPACE 1 11500000 CDMEADD MVC CDCHAIN-CDENTRY(N4,INREG2),CDCHAIN ADDR OF MAJ IN MIN. 11550002 SPACE 2 11560002 */* P POINT MAJOR TO MINOR */ 11562002 SPACE 2 11570002 ST INREG2,CDCHAIN CHAIN MINOR TO QUEUE 11600002 SPACE 2 11610002 */*RETURN: P (,EXIT1) SET RETURN CODE REG 15 = 0 */ 11612002 SPACE 2 11620002 RETURN EQU * NORMAL RETURN 11650000 SR CODEREG,CODEREG NORMAL COMPLETION CODE IS ZERO 11700000 B EXIT1 RETURN 11750002 TITLE 'IGC041 - IDENTIFY - AOS LOADER MAJOR CDE FUNCTION' 11836700 * THIS SECTION OF CODE IS USED BY AOS LOADER TO CREATE A MAJOR CDE. 11850000 SPACE 2 11860002 */*MAJORCDE: P SAVE PARM LIST ADDRESS */ 11860402 */* P SET RETURN CODE (R15) = 24 */ 11862002 SPACE 2 11870002 USING PARMAD,R13 @ZA26742 11900003 USING IDLIST,X2 @ZA26742 11902003 MAJORCDE DS 0H 11904003 OI PARMFLAG,PARMFTCH INDICATE FETCH PROTECT @ZA26742 11906003 * IF FRR ENTERED @ZA26742 11912003 MODESET EXTKEY=RBT234,WORKREG=2 GET IN CALLER KEY @ZA26742 11916003 IC R2,IDENTRY ADDRESS FIRST BYTE @ZA26742 11920003 LA R2,IDXLNTH POINT TO LENGTH OF LIST @ZA26742 11924003 LA R15,MAXLNTH INSERT X'FFF' IN R15 @ZA26742 11928003 LA R15,N1(,R15) INCREASE TO 1000 @ZA26742 11932003 L XLREG,IDXLNTH SAVE LENGTH OF LIST @ZA26742 11936003 * XLREG MUST BE PRSERVED @ZA26742 11936803 * THROUGH XLMULT8 @ZA26742 11937603 AR R2,XLREG ADD LENGTH OF LIST @ZA26742 11938403 BCTR R2,0 POINT TO LAST BYTE @ZA26742 11940003 CHKBYTE EQU * @ZA26742 11944003 IC R14,0(,R2) ADDRESS LAST BYTE @ZA26742 11948003 SR R2,R15 DECREASE BY A PAGE @ZA26742 11952003 CR R2,X2 CHECKED ALL OF LIST? @ZA26742 11956003 BH CHKBYTE BRANCH IF NOT @ZA26742 11960003 MODESET EXTKEY=ZERO GET BACK TO KEY ZERO @ZA26742 11964003 MVI PARMFLAG,N0 REMOVE FETCH PROT IND @ZA26742 11969003 SPACE 2 @ZA26742 11980003 SLL INREG2,N30 IS PARM LIST ON 12000000 LA CODEREG,ILIST SET RETURN CODE IN CASE OF ERROR 12010002 SPACE 2 12020002 */* D (NO,EXIT1,YES,) LIST ON FULL WORD BOUNDARY? */ 12022002 SPACE 2 12030002 LTR INREG2,INREG2 WORD BOUNDARY 12050000 BNZ EXIT1 NO, BRANCH 12100002 SPACE 2 12110002 */* D (NO,EXIT1,YES,) XL ADDRESS POSITIVE? */ 12112003 SPACE 2 12113003 LTR XLREG,XLREG IS EXTENT LENGTH POS? @ZA26742 12114003 BNP EXIT1 NO, RETURN @ZA26742 12115003 SPACE 2 12116003 */* P SET UP TO GET CDE AND XL IN LSQA */ 12117003 SPACE 2 12118003 LA WKREG1,CDESIZE GET SIZE OF CDE 12119003 AR WKREG1,XLREG ADD EXLIST LIST SIZE @ZA26742 12120003 L ASCBREG,PSAAOLD GET ASCB FOR GETMAIN 12121003 SPACE 2 12122003 */* S GETMAIN:GET CDE,XL FROM LSQA VIA BR */ 12123003 SPACE 2 12124003 GETMAIN RU,SP=255,LV=(INREG2),BRANCH=YES GET CDE, XL FROM LSQA 12125003 SPACE 2 @ZA26742 12126003 ST R1,PARMGETM SAVE AREA ADDRESS @ZA26742 12127003 STH XLREG,PARMGETL SAVE LENGTH OF XL @ZA26742 12128003 OI PARMFLAG,PARMGTMN INDICATE GETMAIN AREA @ZA26742 12129003 DROP R13 @ZA26742 12130003 DROP CDEREG CHANGE CDE BASE 12131003 DROP X2 @ZA26742 12132003 USING CDENTRY,X2 CHANGE CDE BASE @ZA26742 12133003 LR PNREG,X2 SAVE INPUT LIST TEMP @ZA26742 12134003 LR X2,WKREG1 GET ADDRESS OF CDE @ZA26742 12135003 LR WKREG1,PNREG GET ADDRESS OF INPUT @ZA26742 12136003 USING IDLIST,WKREG1 @ZA26742 12137003 SPACE 2 12138003 */* P CLEAR NEW CDE */ 12139003 */* P PUT ENTRY POINT NAME IN CDE */ 12140003 SPACE 2 12141003 XC CDENTRY(CDESIZE),CDENTRY CLEAR CDE M01967 12142003 MVC CDNAME(N8),IDNAME MOVE IN EP NAME @ZA26742 12143003 SPACE 2 12144003 */* P PUT ENTRY POINT ADDRESS IN CDE */ 12145003 SPACE 2 12146003 MVC CDENTPT(N4),IDENTRY MOVE IN EP ADDRESS @ZA26742 12147003 SPACE 2 12148003 */* P INITIALIZE XL FIELDS IN CDE */ 12149003 SPACE 2 12150003 USING XTLST,PNREG @ZA26742 12151003 LA PNREG,CDEEND LOCATE XTENT LIST AT END OF CDE 12152003 SPACE 2 12153003 */* P SET SPZ (SUBPOOL 0) AND XLE IN CDE */ 12154003 SPACE 2 12155003 ST PNREG,CDXLMJP STORE EXTENT LIST ADDR IN CDE 12156003 MVI CDATTR2,CDSPZ+CDXLE SET UP 2ND ATTRIBUTE FIELD 12157003 SPACE 2 12158003 */* P MOVE XL FROM PARM LIST TO XL IN CDE */ 12159003 SPACE 2 12160003 LR R15,XLREG GET LENGTH OF EXTENT @ZA26742 12161003 LR CVTREG,R15 PUT LENGTH IN R3 @ZA26742 12162003 LA WKREG2,CDEEND POINT TO START OF EXTNT @ZA26742 12163003 LA R14,IDXLNTH POINT TO EXTENT LIST @ZA26742 12164003 MVCL WKREG2,R14 MOVE LIST INTO SP 255 @ZA26742 12165003 L CVTREG,CVTPTR RESTORE CVT POINTER @ZA26742 12166003 SPACE 2 @ZA26742 12167003 */* D (NO,EXIT1,YES,) IS FIRST BYTE A CHARACTER? */ 12168003 SPACE 2 12169003 LA CODEREG,ILIST RESTORE ERROR CODE @ZA26742 12170003 L WKREG2,CDENTPT GET ENTRY POINT VALUE @ZA26742 12171003 LTR WKREG2,WKREG2 IS ENTRY POINT VALID? @ZA26742 12172003 BNP STXLREG BRANCH IF NOT @ZA26742 12173003 SPACE 2 12202002 */* P SET RETURN CODE (R15) = 28 */ 12202402 SPACE 2 12204002 LA CODEREG,IPARM SET PARM ERROR RETURN CODE 12210002 SPACE 2 @ZA26742 12220003 C XLREG,XTLLNTH CORRECT LENGTH? @ZA26742 12260003 BE XLMULT8 BRANCH IF YES @ZA26742 12300003 STXLREG EQU * @ZA26742 12340003 ST XLREG,XTLLNTH STORE LENGTH IN LIST @ZA26742 12380003 B EXITFREE BRANCH TO FREE ROUTINE @ZA26742 12420003 SPACE 2 12460003 */* D (NO,EXIT1,YES,) XL A MULTIPLE OF 8? */ 12500003 SPACE 2 12540003 XLMULT8 EQU * @ZA26742 12580003 SLL XLREG,N29 SHIFT OFF 29 BITS @ZA26742 12620003 LTR XLREG,XLREG DOUBLE WORD BOUNDARY? @ZA26742 12660003 BNZ EXITFREE NO, RETURN @ZA26742 12700003 SPACE 2 12740003 */* P GET NUMBER OF EXTENTS FROM XL IN PARM LIST */ 12780003 SPACE 2 12820003 L WKREG5,XTLNRFAC GET NUMBER OF EXTENTS @ZA26742 12860003 LTR XLREG,WKREG5 IS NUM OF EXTENTS ZERO? 12900003 BZ NAMETEST NO EXTENTS, TEST FOR DUP NAME 12940003 LR WKREG1,XLREG GET NUMBER OF EXTENTS @ZA26742 12980003 LA WKREG1,N1(,WKREG1) ADD ONE FOR HEADER @ZA26742 13020003 SLL WKREG1,N3 MULTIPLY BY 8 @ZA26742 13060003 C WKREG1,XTLLNTH ARE LENGTHS EQUAL? @ZA26742 13100003 BNE EXITFREE BRANCH IF NOT @ZA26742 13140003 SLL XLREG,N2 CAL. DISPL. TO EXTENT ADDR 13180003 LA WKREG1,XTLMSBLA(XLREG) LOCATE 1ST EXTENT ADDR @ZA26742 13220003 SPACE 2 13360002 */*CONTEST: P GET ADDRESS OF EXTENT */ 13362002 SPACE 2 13370002 CONTEST DS 0H GO TO TEST 13400002 L WKREG2,N0(WKREG1) LOCATE NEXT EXTENT 13450002 SPACE 2 13460002 */* D (NO,EXIT1,YES,) IS EXTENT ON DOUBLE WORD BOUNDARY? */ 13462002 SPACE 2 13470002 SLL WKREG2,N29 ON DOUBLE WORD 13550000 LTR WKREG2,WKREG2 BOUNDARY 13600000 BNZ EXITFREE NO @ZA26742 13650003 SPACE 2 13700002 */*NXEXT: P GET ADDRESS OF NEXT ADDR AND LENGTH LIST ENTRY */ 13710002 SPACE 2 13750002 NXEXT DS 0H TEST NEXT EXTENT 14000002 LA WKREG1,N4(WKREG1) LOCATE NEXT EXTENT ADDR 14050000 SPACE 2 14110002 */* P (GT 0,CONTEST,=0,) DECREMENT NO EXTENTS BY 1 */ 14112002 SPACE 2 14120002 BCT WKREG5,CONTEST HAS LAST EXTENT BEEN TESTED 14150002 SPACE 2 14160002 */*NAMETEST: P GET ADDRESS OF ENTRY POINT NAME IN R9 */ 14180002 SPACE 2 14190002 NAMETEST DS 0H TEST NAME PASSED 14200002 LA WKREG2,XTLLNTH SAVE ADDRESS OF LIST @ZA26742 14250003 DROP PNREG @ZA26742 14259003 LA PNREG,CDNAME POINT TO NAME @ZA26742 14268003 SPACE 2 14277003 */* S NOMIN:FIND CDE ON JPA ON LPA */ 14286003 SPACE 2 14295003 BAL RETREG,NOMINA IS THE NAME A DUPLICATE 14304003 SPACE 2 14313003 */* P GET ADDRESS OF EXTENT LIST */ 14322003 SPACE 2 14331003 LR XLREG,WKREG2 GET ADDRESS OF LIST @ZA26742 14340003 SPACE 2 14360002 */* P INDICATE NO LLEQ SEARCH */ 14362002 SPACE 2 14370002 LA TLLSREG,ZERO INDICATE ONLY ONE LIST TO TEST 14400000 SPACE 2 14410002 */* P SAVE ADDRESS OF PARM LIST */ 14412002 SPACE 2 14420002 LR SAVEREG,X2 SAVE INPUT PARM 14450002 SPACE 2 14460002 */* P GET ENTRY POINT ADDR FOR TEST */ 14462002 SPACE 2 14470002 L X2,CDENTPT POINT TO ENTRY POINT @ZA26742 14500003 SPACE 2 14512002 */* S CDEPTEST:IN EPA IN THIS EXTENT */ 14512402 SPACE 2 14514002 BAL RETREG,CDEPTEST IS ENTRY POINT IN EXTENT 14550002 SPACE 2 14560002 */* P RESTORE PARM LIST ADDRESS */ 14562002 SPACE 2 14570002 LR X2,SAVEREG RESET INPUT PARM 14600002 SPACE 2 14600402 */* P ENQUEUE CDE FIRST OFF JOBSTEP CDE QUE */ 15312002 SPACE 2 15320002 L PNREG,TCBJSTCB LOCATE JOB STEP TCB 15350000 DROP TCBREG CHANGE TCB ADDRESSING 15400000 USING TCB,PNREG CHANGE TCB ADDRESSING 15450000 MVC CDCHAIN+N1(N3),TCBJPQ+N1 MOVE LAST CDE INTO NEW CDE 15500002 ST X2,TCBJPQ QUEUE NEW CDE ON TCB @ZA26742 15550003 SPACE 2 15560002 */* P (,RETURN) SET CDE NLR */ 15562002 SPACE 2 15570002 MVI CDATTR,CDNLR SET 1ST ATTRIBUTE FIELD 15600002 B RETURN SET ZERO CODE AND RETURN 15650002 DROP PNREG SWITCH TCB BASE 15750000 USING TCB,TCBREG SWITCH TCB REG 15800000 DROP INREG2 CHANGE CDE ADDRESSING 15850000 USING CDENTRY,CDEREG RESET TO CDE REGISTER 15900000 TITLE 'IGC041 - IDENTIFY - SUBROUTINES' 15910000 * NOMIN SEARCHES THE JPAQ AND LPAQ FOR A DUPLICATE 16000002 * TO THE NAME PASSED ON ENTRY. IF A DUPLICATE NAME IS FOUND, AN 16050000 * ERROR CODE IS PASSED BACK TO THE USER. OTHERWISE RETURN IS TO 16100000 * ADDRESS IS REGISTER 7. 16150000 * REGISTER USAGE 16200000 * R0,1 - ALTERED 16250000 * R3,4 - CVT,TCB (INPUT) 16300000 * R6 - BASE REGISTER (INPUT) 16350002 * R8 - ALTERED 16400000 * R11,13- ALTERED 16500002 * R12 - SET TO NAME ADDRESS (OUTPUT) 16550000 * R14 - RETURN ADDRESS (INPUT) 16610002 * R15 - ALTERED 16650002 * OTHER REGISTERS NOT REFERENCED 16700000 SPACE 1 16750000 SPACE 2 16760002 */*NOMIN: E ENTRY NOMIN */ 16770002 */* P SET QUEUE POINTER (RB) TO JPQ OF JSTCB */ 16780002 */* P NOTE: CDE NAME HAS ALREADY BEEN PLACED IN REG 9 */ 16782002 SPACE 2 16790002 NOMIN EQU * @ZA26742 16800003 N RETREG,ZEROMASK CLEAR HIGH BIT @ZA26742 16806003 B NOMIN1 JOIN MAINLINE PROCESS @ZA26742 16812003 NOMINA EQU * @ZA26742 16818003 O RETREG,MINMASK INDICATE NOMINA ENTRY @ZA26742 16824003 NOMIN1 EQU * @ZA26742 16830003 L WKREG4,TCBJSTCB LOAD PTR TO JOB STEP TC @ZA26742 16836003 LA WKREG4,TCBJPQ-TCB(N0,WKREG4) LOAD PTR TO 1ST CDE. 16850002 LR SAVEREG,RETREG SAVE RETURN ADDRESS 16900002 SPACE 2 16950002 */* P GET ADDRESS OF IEAQCDSR FROM CVT */ 16952002 SPACE 2 16960002 L CODEREG,CVTQCDSR GET SEARCH ROUTINE ADDRESS 17000002 SPACE 2 17010002 */* S IEAQCDSR:SEARCH JPQ FOR MODULE */ 17012002 SPACE 2 17020002 BALR RETREG,CODEREG SEARCH CDE QUEUE 17050002 SPACE 2 17060002 */* D (YES,UNUSUAL,NO,) MODULE FOUND? */ 17062002 SPACE 2 17070002 B UNUSUAL IF FOUND,BRANCH 17100000 SPACE 2 17110002 */*SRCHLPA: S SETLOCK:GET CMS LOCK */ 17112002 SPACE 2 17120002 SRCHLPA EQU * LPAQ SEARCH 17150000 STM R11,R14,RBEXSAVE+N4 SAVE VOLITAL REGS 17152002 SETLOCK OBTAIN,TYPE=CMS,MODE=UNCOND,RELATED=BETWEEN-SRCHPLA 17160002 * UNUSUAL CMS LOCK REQUIRED FOR LPA 17170002 SPACE 2 17180002 */* P GET ADDRESS OF IEAQCDSR FROM CVT */ 17182002 SPACE 2 17190002 L WKREG4,CVTQLPAQ LOAD PTR TO FIRST CDE IN LPA 17200002 L CODEREG,CVTQCDSR GET SEARCH ROUTINE ADDRESS 17250002 SPACE 2 17260002 */* S IEAQCDSR:SEARCH LPA FOR MODULE */ 17262002 SPACE 2 17270002 BALR RETREG,CODEREG TRY LPA SEARCH 17300002 OI RBEXSAVE,NAMEFND SET DUPLICATE NAME INDICATOR 17350002 ST R11,RBEXSAVE+N4 SAVE CDE POINTER 17360002 SPACE 2 17370002 */* S SETLOCK: FREE CMS LOCK */ 17372002 SPACE 2 17380002 SETLOCK RELEASE,TYPE=CMS,RELATED=SRCHPLAP CMS NO LONGER NEEDED 17400002 LM R11,R14,RBEXSAVE+N4 RESTORE VOLITAL REGS 17450002 SPACE 2 17460002 */* D (YES,UNUSUAL,NO,) MODULE FOUND? */ 17462002 SPACE 2 17470002 TM RBEXSAVE,NAMEFND TEST IF NAME FOUND 17500002 BO UNUSUAL IF SO, BRANCH 17550002 SPACE 2 17560002 */* R RETURN VIA R14 */ 17562002 SPACE 2 17570002 LR RETREG,SAVEREG RESET RETURN REGISTER 17600002 BR RETREG RETURN TO CALLER SUCCESSFUL 17900002 SPACE 2 17910002 */*UNUSUAL: D (YES,UNNECODE,NO,) CDE A MINOR? */ 17912002 SPACE 2 17920002 UNUSUAL EQU * ERROR ON NAME SEARCH 17950000 TM CDATTR-CDENTRY(R11),CDMIN IS FOUND CDE A MINOR. 18000000 BO UNNECODE YES 18050000 SPACE 2 18060002 */* P (,EXIT1) SET RETURN CODE = 8 */ 18062002 SPACE 2 18070002 LA CODEREG,CODEANEQ NO, LOAD MULTIPLE-NAME CODE 18100000 LTR SAVEREG,SAVEREG ENTRY FROM NOMINA? @ZA26742 18110003 BM EXITFREE BRANCH IF YES @ZA26742 18120003 B EXIT1 RETURN 18150002 SPACE 2 18160002 */*UNNECODE: P SET RETURN CODE = 4 */ 18162002 SPACE 2 18170002 UNNECODE LA CODEREG,CODEUN LOAD UNNECESSARY-IDENTIFY CODE 18200000 SPACE 2 18210002 */* P GET EPA FROM MINOR CDE */ 18212002 SPACE 2 18220002 L WKREG2,CDENTPTZ(R11) LOAD ENTRY PT FROM FOUND CDE 18250000 SPACE 2 18260002 */* D (YES,EXIT1,NO,) ENTRY POINT ADDR MATCH? */ 18262002 SPACE 2 18270002 LA WKREG2,N0(WKREG2) ZERO HIGH ORDER BYTE 18300000 CR WKREG2,X2 ARE ENTRY POINTS EQUAL. 18350000 BE EXITTEST YES, CODE ALREADY LOADED. RETURN 18400003 SPACE 2 18410002 */* P SET RETURN CODE = 20 */ 18412002 SPACE 2 18420002 LA CODEREG,CODEBADM NO, LOAD BAD-MINOR CODE 18450000 EXITTEST EQU * @ZA26742 18450903 LTR SAVEREG,SAVEREG ENTRY FROM NOMINA? @ZA26742 18451803 BNM EXIT1 BRANCH IF NOT @ZA26742 18452703 EXITFREE EQU * @ZA26742 18453603 L ASCBREG,PSAAOLD GET ASCB FOR FREEMAIN @ZA26742 18454503 LA R1,CDESIZE GET SIZE OF CDE @ZA26742 18455403 A R1,CDESIZE(X2) ADD SIZE OF XL @ZA26742 18456303 LR WKREG2,CODEREG SAVE RETURN CODE @ZA26742 18457203 FREEMAIN RU,LV=(R1),A=(X2),SP=255,BRANCH=YES @ZA26742 18458103 LR CODEREG,WKREG2 RESTORE RETURN CODE @ZA26742 18459003 SPACE 2 18460002 */*EXIT1: S SETFRR:RESTORE STACK */ 18462002 SPACE 2 18470002 EXIT1 DS 0H RETURN 18500002 SETFRR D,WRKREGS=(3,4) FREE FRR 18500402 SPACE 2 18500802 */* P GET ADDRESS OF EXIT PROLOG IN R14 */ 18500902 SPACE 2 18501202 L CVTREG,CVTPTR GET POINTER TO CVT 18502002 L R14,CVTEXPRO GET ADDRESS OF EXIT PROLOG 18510002 SPACE 2 18512002 */* R RETURN VIA R14 */ 18514002 SPACE 2 18516002 BR R14 EXIT 18520002 EJECT 18550000 * FOR MINOR CDE, THIS ROUTINE CHECKS IF THE ENTRY POINT PASSED 18600000 * IS WITHIN THE BOUNDS OF THE MODULE WHICH ISSUED THE IDENTIFY 18650000 * OR WITHIN ANY MODULE ON THE LOAD LIST FOR ITS TASK. THE 18700000 * ROUTINE EITHER RETURNS SUCCESSFULLY, OR GIVES A ERROR CODE 18750000 * TO THE IDENTIFYING MODULE. 18800000 * FOR MAJOR CDE, THE INPUT IS PRESET FOR ONLY A SINGLE EXTENT 18850000 * LIST CHECK. THE LOAD LIST POINTER IS SET TO POINT TO A FULL 18900000 * WORD FIELD OF ZEROS, AND THE SUBROUTINE IS ENTERED AT 18950000 * CDEPTEST INSTEAD OF XLINST. 19000000 * 19050000 * REGISTER USAGE 19100000 * R2,4,5,7,8 - MODIFIED 19200002 * R6 - BASE 19210002 * R9 - TCBLLS ADDRESS (INPUT) 19250000 * R10 - ADDRESS OF ENTRY POINT (INPUT) 19300002 * R11 - MODIFIED 19350000 * R12 - MAJOR CDE ADDRESS (INPUT/OUTPUT) 19400002 * R14 - RETURN REGISTER (INPUT) 19450003 * OTHER REGISTERS NOT REFERENCED 19500000 SPACE 1 19550000 SPACE 2 19552002 */*XLINST: E XLINST/CDEPTEST ENTRY */ 19552402 */* P GET ADDRESS OF XL FOR MAJOR CDE */ 19552802 SPACE 2 19554002 USING LLE,TLLSREG TEMP USE TLLSREG FOR LLE 19560002 XLINST EQU * @ZA26745 19600003 L XLREG,CDXLMJP LOAD EXTENT LIST ADDR @ZA26745 19620003 LA XLREG,0(,XLREG) CLEAR HIGH ORDER BYTE @ZA26745 19640003 LTR XLREG,XLREG IS THERE AN ADDRESS? @ZA26745 19660003 BZ NGENTPT SKIP CDE IF ZERO @ZA26745 19680003 SPACE 1 19700003 * VALID ENTRY POINT TEST INPUT-EXTENT LIST IN XLREG,ENTPT IN X2 19720003 SPACE 2 19760002 */*CDEPTEST: P GET NUMBER OF EXTENTS FROM XL */ 19762002 SPACE 2 19770002 CDEPTEST L WKREG1,N4(XLREG) LOAD NUMBER OF BLOCKS 19800000 SPACE 2 19810002 */* P GET ADDRESS OF ADDRESS LIST */ 19812002 SPACE 2 19820002 LA WKREG5,N8(XLREG) LOAD ADDR OF LENGTH LIST 19850002 SPACE 2 19860002 */* P GET ADDR OF LENGTH LIST */ 19862002 SPACE 2 19870002 LR WKREG2,WKREG1 LOAD NO. BLOCKS INTO TEMP. REG 19900000 SLL WKREG2,N2 MULTIPLY BY FOUR 19950000 AR WKREG2,WKREG5 ADD LENGTH LIST ADDR TO GET ADDR 20000002 SPACE 2 20010002 */*EPCHECK: P GET ADDRESS OF THIS EXTENT */ 20012002 SPACE 2 20020002 EPCHECK L WKREG3,N0(WKREG2) LOAD ADDRESS (LOWER BOUND) 20050000 SPACE 2 20052002 */* D (YES,EPLAST,NO,) IS EP LT EXTENT LIST START? */ 20060002 SPACE 2 20070002 CR X2,WKREG3 IS ENTRY POINT BELOW LOWER BOUND 20100000 BL EPLAST YES 20150000 SPACE 2 20160002 */* P GET UPPER BOUND OF EXTENT LIST */ 20162002 SPACE 2 20170002 L WKREG4,N0(WKREG5) LOAD LENGTH OF NEXT SECTION 20200002 LA WKREG4,N0(WKREG4) ZERO HI ORDER FLAG 20250000 SPACE 2 20260002 */* D (YES,EPLAST,NO,) IS EP GT UPPER BOUND? */ 20262002 */* R RETURN VIA R15 */ 20264002 SPACE 2 20270002 AR WKREG3,WKREG4 COMPUTE UPPER BOUND 20300000 CR X2,WKREG3 IS ENTRY POINT ABOVE UPPER BOUND 20350000 BCR N4,RETREG NO, WITHIN BOUNDS- RETURN LEGAL 20400002 SPACE 2 20410002 */*EPLAST: P (=0,NGENTPT,GT 0,) DECREMENT NUMBER OF EXTENTS BY 1 */ 20412002 SPACE 2 20420002 EPLAST BCT WKREG1,EPNEXT IF LAST ENTRY NOT DONE GO EPNEXT 20450000 B NGENTPT OTHERWISE RETURN NOT LEGAL 20500000 SPACE 2 20510002 */*EPNEXT: P (,EPCHECK) GET ADDR OF NEXT ADDR AND LENGTH LIST ENTRY */ 20512002 SPACE 2 20520002 EPNEXT LA WKREG5,N4(WKREG5) INCREMENT TO NEXT LENGTH 20550002 LA WKREG2,N4(WKREG2) INCREMENT TO NEXT ADDRESS 20600000 B EPCHECK CONTINUE EPTEST 20650000 SPACE 2 20660002 */*NGENTPT: P GET ADDR OF FIRST/NEXT LLE OF CHAIN */ 20662002 SPACE 2 20670002 NGENTPT EQU * @ZA26742 20700003 LA WKREG1,ZERO POINT TO ADDRESS ZERO @ZA26742 20705003 CR WKREG1,TLLSREG ADDRESSES THE SAME? @ZA26742 20710003 BNE NGENTPT1 BRANCH IF NOT @ZA26742 20715003 LA CODEREG,CODENGEP SET ERROR CODE @ZA26742 20720003 LR X2,SAVEREG POINT TO GOTTEN AREA @ZA26742 20725003 B EXITFREE FREE AREA AND RETURN @ZA26742 20730003 NGENTPT1 EQU * @ZA26742 20735003 L TLLSREG,LLECHN LOAD 1ST LL ELEM FROM TCBLLS 20740003 * ** OR LLCHAIN FIELD 20750000 LA TLLSREG,N0(TLLSREG) ZERO HIGH ORDER BYTE 20800000 SPACE 2 20810002 */* D (NO,NOTZERO,YES,) IS ADDR = 0? */ 20812002 SPACE 2 20820002 LTR TLLSREG,TLLSREG IS TCBLLS OR LLCHAIN ZERO 20850000 SPACE 1 20900000 *NOTE* LLCHAINA MUST BE 0 OTHERWISE ABOVE INSTS CANNOT BE USED FOR THE 20950000 * DOUBLE-FOLD PURPOSE THEY NOW ARE. IT IS USED TO LOAD TCBLLS AND 21000000 * LL CHAIN PTR. 21050000 SPACE 1 21100000 BNE NOTZERO NO- PROCESS CDE/LLE ENTRIES 21150000 SPACE 2 21160002 */* P (,EXIT1) SET RETURN CODE (R15) = 12 */ 21162002 SPACE 2 21170002 LA CODEREG,CODENGEP LOAD ENTRY-PT-INVALID ERROR CODE 21200000 B EXIT1 RETURN 21250002 SPACE 2 21260002 */*NOTZERO: P GET ADDR OF CDE FROM LLE */ 21262002 SPACE 2 21270002 NOTZERO L CDEREG,LLECDPT LOAD ADDR CDE FROM LL ELEM 21300000 SPACE 2 21310002 */* D (NO,XLINST,YES,) IS CDE A MINOR? */ 21312002 SPACE 2 21320002 TM CDATTR,CDMIN IS IDENTIFIER A MINOR 21350000 BZ XLINST NO, GO TO CDEPTEST AND COLLECT 21400000 SPACE 2 21410002 */* P (,XLINST) GET ADDRESS OF MAJOR FROM MINOR */ 21412002 SPACE 2 21420002 L CDEREG,CDXLMJP YES,LOAD MAJOR CD ENTRY 21450000 B XLINST GO TO CDEPTEST DONT COLLECT $200 21500000 DROP TLLSREG STOP LLE ADDRESSABLITY 21550000 TITLE ' IGC041 - IDENTIFY - RETRY ENTRY' 21560002 * SVC41 RETRY ROUTINE 21580002 * CAUSES CONTROL TO BE RETURNED TO ISSUER OF SVC WITH REGISTER 21585002 * 15 CONTAINING X'24' - UNEXPECTED SYSTEM ERROR, REQUEST NOT 21590002 * COMPLETED. SUPPORT CODE FOR RECOVERY IS Y02753 Y02753 21592002 * INPUT - REG. 6 = BASE FOR MODULE IEAVID00 21592402 SVC41RTY DS 0H RETRY ROUTINE Y02753 21594002 LA CODEREG,CODSYSER PUT ERR CODE 24 IN REG 15 Y02753 21596002 B EXIT1 GO FREE FRR AND EXIT Y02753 21598002 EJECT 1 @ZA28584 21598203 * FETCH PROTECT RETRY ROUTINE @ZA28584 21598403 * CAUSES CONTROL TO BE RETURNED TO ISSUER OF SVC @ZA28584 21598603 * WITH REGISTER 15 CONTAINING X'28' - ADDRESS OF @ZA28584 21598803 * NAME IS FETCH PROTECTED @ZA28584 21599003 FETRTY EQU * @ZA28584 21599203 LA CODEREG,CODEFET PUT ERR CODE 28 IN 15 @ZA28584 21599403 B EXIT1 GO FREE FRR AND EXIT @ZA28584 21599603 EJECT 1 @ZA26742 21600003 * SVC41 RETRY ROUTINE @ZA26742 21600903 * CAUSES CONTROL TO BE RETURNED TO ISSUER FO SVC WITH @ZA26742 21601803 * REGISTER 15 CONTAINING X'24' - UNEXPECTED SYSTEM @ZA26742 21602703 * ERROR, REQUEST NOT COMPLETED. THIS ROUTINE ALSO @ZA26742 21603603 * FREES UP AREA THAT WAS ALLOCATED FOR THE CDE AND XL. @ZA26742 21604503 SVC41FRE EQU * @ZA26742 21605403 LA CODEREG,CODEFET PUT ERR CODE 24 IN REG @ZA26742 21606303 B EXITFREE GO FREE AREA AND FRR @ZA26742 21607203 TITLE 'IGC041 - FRR ROUTINE' 21608103 */* E FRRSVC41 */ 21610002 */* P SET UP ADDRESSABILITY */ 21620002 SPACE 2 21630002 FRRSVC41 DS 0H 21650002 BALR R6,N0 SET UP ADDRESSABILITY Y02753 21700002 USING *,R6 TELL ASSEMBLER Y02753 21750002 SPACE 2 21760002 */* P PSAVE CALLERS RETURN ADDRESS IN R10 */ 21762002 SPACE 2 21770002 LR R12,R14 SAVE RETURN ADDRESS @ZA26742 21800003 SPACE 2 21810002 */* P PUT SDWA ADDRESS IN WKREG (R8) */ 21812002 SPACE 2 21820002 LR SDWAREG,R1 PUT SDWA IN PROTECTED REG Y02753 21850002 USING SDWA,SDWAREG TELL ASSEMBLER Y02753 21900002 SPACE 2 21910002 */* L SETRP-- CAUSE ERROR TO BE RECORDED */ 21912002 SPACE 2 21920002 SETRP RECORD=YES,WKAREA=(SDWAREG),RECPARM=SVC41ERR SET UP FOR 21950002 * RECORDING Y02753 22000002 SPACE 2 22050002 */* P GET ABENDING ASID COMPARE FLAG FROM SDWA */ 22060002 */* D (YES,,NO,SVC41PRC) ABEND IN SAME MEMORY AS CURRENT? */ 22070002 SPACE 2 22100002 LH WKREG2,SDWAFMID GET ASID OF CURRENT Y02753 22300002 LTR WKREG2,WKREG2 TEST IF SAME ADDR. SPACE Y02753 22350002 BNZ SVC41PRC NO- RETURN TO CALLER Y02753 22400002 SPACE 2 @ZA28584 22401003 USING PARMAD,R1 @ZA26742 22402003 L R9,FETRET GET ADDRESS OF RETURN @ZA28584 22402603 L R1,SDWAPARM GET PARM ADDRESS @ZA26742 22403203 CLI PARMFLAG,PARMFTCH IS THIS FETCH PROTECT? @ZA26742 22403803 BE SVC41RP BRANCH IF YES @ZA28584 22405003 SPACE 2 22410002 */* P SET ENVIRONMENT REGISTERS 3=CVT, R=TCB, 5=RB, 7=ASCB */ 22412002 SPACE 2 22420002 L TCBREG,PSATOLD GET CURRENT TCB Y02753 22500002 L RBREG,N0(R8) GET PARM LIST ADDRESS Y02753 22510002 L RBREG,N0(RBREG) GET SVRB ADDR. FROM PARM. Y02753 22520002 L R7,PSAAOLD GET ASCB ADDRESS Y02753 22550002 L CVTREG,CVTPTR GET CVT POINTER @ZA26742 22560003 SPACE 2 @ZA26742 22560603 */* P GET ADDRESS OF REG SAVE AREA (16 WORDS) */ 22562002 */* S CDEQVER:VERIFY APPROPRIATE CDE QUEUE */ 22564002 SPACE 2 22570002 LA R13,SDWASRSV GET A REG. SAVE AREA Y02753 22600002 BAL R14,CDEQVER VERIFY PROPER CDE QUEUE Y02753 22650002 SPACE 2 22660002 */*SVC41PRC: P PUT IDENTIFY BASE ADDRESS IN SDWA RETRY REGS */ 22662002 SPACE 2 22670002 SVC41PRC DS 0H RETURN TO CALLER Y02753 22700002 L R1,SDWAPARM GET PARM LIST @ZA26742 22700403 L R9,PARMBASE GET IDENTIFY BASE ADDR @ZA26742 22701403 ST R9,SDWASR06 PUT IN RETRY REGS IN SDWA Y02753 22704002 SPACE 2 22706002 */* L SETRP-- CAUSE RETRY AT SVC41RET */ 22706402 SPACE 2 22708002 L R9,SVC41RET GET RETRY ADDRESS Y02753 22708402 TM PARMFLAG,PARMGTMN WAS AREA ALLOCATED? @ZA26742 22708503 BZ SVC41RP BRANCH IF NOT @ZA26742 22708603 L R9,FREERTY GET ADDRESS OF ROUTINE @ZA26742 22708703 L R10,PARMGETM GET ADDRESS OF AREA @ZA26742 22708803 ST R10,SDWASR10 SAVE IN SDWA RETRY REGS @ZA26742 22708903 LH WKREG1,PARMGETL GET LENGTH OF AREA @ZA26742 22709003 ST WKREG1,CDESIZE(,R10) STORE LENGTH IN XL @ZA26742 22709103 SVC41RP EQU * @ZA28584 22709203 SETRP RETADDR=(R9),RETREGS=YES,RC=4,WKAREA=(R8) Y02753 22710002 SPACE 2 22712002 */* P RESTORE CALLERS RETURN ADDRESS */ 22712402 */* R RETURN TO CALLER VIA BR14 */ 22712802 SPACE 2 22714002 LR R14,R12 RESTORE RETURN ADDRESS @ZA26742 22720003 BR R14 RETURN TO RTM Y02753 22727003 DROP R1 @ZA26742 22734003 EJECT 22750002 * CDE QUEUE VERIFY ROUTINE 22800002 * PURPOSE: TO DETERMINE IF THE JPQ OR THE LPA WAS BEING MODIFIED AT 22850002 * THE TIME OF THE ERROR AND VERIFY THE ELEMENTS ON THAT QUEUE 22900002 * ARE VALID. 22950002 * 23000002 * INPUT: 23050002 * R8 = ADDRESS OF SDWA 23100002 * R3-4,7 = ENVIRONMENT REGISTERS 23150002 * R13 = ADDRESS OF 16 WORD SAVE AREA 23200002 * R14 = RETURN ADDRESS 23250002 * R15 = ENTRY POINT 23300002 * 23350002 * OUTPUT: 23400002 * R0-2,8-9,11-12,15 - MODIFIED 23450002 * R3-5,7,10,13-14 - UNCHANGED 23500002 * 23550002 SPACE 1 23560002 */* E CDEQVER */ 23562002 */* P SAVE CALLERS REGISTERS 0-15 IN R13 SAVE AREA */ 23562402 */* P SET UP ADDRESSABILITY */ 23564002 SPACE 2 23570002 CDEQVER DS 0H VERIFIES CDE QUEUE Y02753 23600002 STM R0,R15,N0(R13) SAVE CALLERS REGS Y02753 23610002 BALR R6,N0 SET UP ADDRESSABILITY Y02753 23650002 USING *,R6 TELL ASSEMBLER Y02753 23700002 SPACE 2 23760002 */* L GETMAIN-- GET QUEUE VERIFY WORK AREA AND PARM LIST */ 23762002 SPACE 2 23770002 GETMAIN RC,BRANCH=YES,LV=QVRSIZE,SP=253 GET QV WKAREA Y02753 23800002 SPACE 2 23810002 */* D (NO,,YES,CDECHEK) GETMAIN SUCCESSFUL? */ 23812002 */* P (,CDEQEXIT) SET RETURN CODE IN REGISTER 15=0 */ 23814002 SPACE 2 23820002 LTR R15,R15 GETMAIN SUCCESSFUL? Y02753 23850002 BZ CDECHEK YES- INITIALIZE Y02753 23900002 SR R15,R15 SET 0 RETURN Y02753 23950002 B NOFREE GO TO RETURN CODE Y02753 24000002 SPACE 2 24010002 */*CDECHEK: P CLEAR PARAMENTER WORK AREA */ 24012002 SPACE 2 24020002 CDECHEK XC N0(QVPLSIZE,R1),N0(R1) CLEAR PARM AREA 24050002 USING QVPL,R1 SET ADDRESSING TO PARM AR Y02753 24100002 SPACE 2 24110002 */* P PUT CDE ELEMENT VERIFICATION ROUTINE ADDRESS IN QVPL */ 24112002 SPACE 2 24120002 L CVTREG,CVTPTR RESET CVT ADDRESS Y02753 24130002 LA WKREG2,CDEVER GET CDE ELEMENT VER. RTN. Y02753 24150002 ST WKREG2,QVPLEVR PUT IN PARM LIST Y02753 24200002 SPACE 2 24210002 */* P PUT ADDRESS OF SDWA VARIABLE RECORDING AREA IN QVPL */ 24212002 SPACE 2 24220002 LA WKREG2,SDWARA GET RECORD AREA ADDR. Y02753 24250002 ST WKREG2,QVPLODA SAVE IN PARM LIST. Y02753 24300002 SPACE 2 24310002 */* P PUT ADDRESS OF A WORKAREA FOR QUEUE VERIFIER IN QVPL */ 24312002 SPACE 2 24320002 LA WKREG2,QVPLSIZE(R1) CALCULATE ADDR. OF WKAREA Y02753 24350002 ST WKREG2,QVPLWKA STORE IN PARM LIST. Y02753 24400002 SPACE 2 24420002 */* P SAVE CALLERS REGSITER SAVE AREA ADDRESS */ 24430002 */* P GET A REGISTER SAVE AREA FOR QUEUE VERIFY ROUTINE */ 24440002 */* P PUT SDWA ADDRESS IN R0 */ 24442002 LR R10,R13 SAVE CALLERS REG SAVE Y02753 24450002 LA R13,QVPLSIZE+QVPLWASZ(R1) GET QV REG SAVE AREA Y02753 24500002 LR R0,R8 PUT SDWA ADDR. IN R0 Y02753 24550002 * Q.V. ROUTINE 24554002 SPACE 2 24560002 */* L (HELD,LPAVER,NO,) SETLOCK-- TEST IF CMS LOCK IS HELD */ 24562002 SPACE 2 24570002 SETLOCK TEST,TYPE=CMS,BRANCH=(HELD,LPAVER) LOCKS HELD Y02753 24600002 SPACE 2 24610002 */* P PUT JPQ ERROR LABEL IN RECORDING AREA */ 24612002 */* P INCREMENT AMOUNT USED COUNT BY MSG LENGTH (10 BYTES) */ 24614002 SPACE 2 24620002 LA WKREG2,SDWAVRA GET RECORDING AREA ADDR. Y02753 24650002 MVC N0(MSGLEN,WKREG2),JPQERR PUT MSG IN RECORDING ARE Y02753 24700002 LA WKREG2,MSGLEN GET LENGTH OF HEADER AND Y02753 24750002 STC WKREG2,SDWAURAL STORE IN USED COUNT Y02753 24800002 SPACE 2 24810002 */* P PUT ADDRESS OF JPQ HEADER (TCBJPQ FROM JSTCB) IN QVPL */ 24812002 SPACE 2 24820002 L WKREG2,TCBJSTCB GET JSTCB Y02753 24850002 LA WKREG2,TCBJPQ-TCB(WKREG2) GET JPQ ADDR. Y02753 24900002 ST WKREG2,QVPLHDR SAVE IN HEADER FIELD Y02753 24950002 SPACE 2 24960002 */* L IEAQVER-- VERIFY SINGLE THREADED/ HEADER ONLY QUEUE */ 24962002 SPACE 2 24970002 L R15,CVTQV1 GET ADDR. OF QUEUE VER RTN. Y02753 25000002 BALR R14,R15 GO TO QUEUE VER. RTN. Y02753 25050002 SPACE 2 25060402 */* P GET REASON CODE IN REGISTER WITHOUT INDICATORS */ 25060802 */* D (YES,CDEQEXIT,NO,) ANY ERRORS FOUND? */ 25061202 SPACE 2 25061702 SLL R15,N24 SHIFT REASON CODE Y02753 25061802 LTR R15,R15 ANY ERRORS Y02753 25061902 BNZ CDEQEXIT YES-CAUSE WTO BEFORE EXIT Y02753 25071402 SPACE 2 25073402 */* P (,CDEQEXIT) CLEAR USED PORTION OF RECORDING AREA IN SDWA */ 25081002 SPACE 2 25090502 SR WKREG2,WKREG2 CLEAR REG, PUT ZERO USED Y02753 25100002 STC WKREG2,SDWAURAL CNT IN SDWA RECORDING ARE Y02753 25150002 B CDEQEXIT RETURN TO CALLLER Y02753 25200002 SPACE 2 25210002 */*LPAVER: P PUT LPQ ERROR LABEL IN RECORDING AREA OF SDWA */ 25212002 SPACE 2 25220002 LPAVER LA WKREG2,SDWAVRA GET RECORDING AREA ADDR. Y02753 25250002 MVC N0(MSGLEN,WKREG2),LPQERR PUT MSG IN RECORDING AR Y02753 25300002 SPACE 2 25310002 */* P INCREMENT AMOUNT USED COUNT BY MSG LENGTH (10 BYTES) */ 25312002 SPACE 2 25320002 LA WKREG2,MSGLEN GET LENGTH OF HEADER AND Y02753 25350002 STC WKREG2,SDWAURAL STORE IN USED COUNT Y02753 25400002 SPACE 2 25410002 */* P PUT ADDRESS OF LPA QUEUE HEADER IN QVPL (IEAQLPAQ) */ 25420002 SPACE 2 25430002 L WKREG2,CVTQLPAQ GET LPA QUEUE HEADER Y02753 25450002 ST WKREG2,QVPLHDR SAVE IN PARM AREA Y02753 25452002 SPACE 2 25452402 */* L IEAVQVER-- VERIFY SINGLE THREADED/ HEADER ONLY QUEUE */ 25452502 SPACE 2 25452802 L R15,CVTQV1 GET ADDR. OF QUEUE RTN. Y02753 25454002 BALR R14,R15 QUEUE VER. RTN. Y02753 25456002 SPACE 2 25456402 */* P GET REASON CODE IN REGISTER WITHOUT INDICATORS */ 25456502 */* D (YES,RECRDLPA,NO,) ANY ERRORS FOUND? */ 25456602 */* P (,CDEQEXIT) ZERO COUNT USED IN RECORDING AREA IN SDWA */ 25456702 SPACE 2 25456802 SLL R15,N24 SHIFT REASON CODE Y02753 25458002 LTR R15,R15 ANY ERRORS Y02753 25458402 BNZ RECRDLPA YES-CAUSE WTO BEFORE EXIT Y02753 25458802 SR WKREG2,WKREG2 CLEAR REG, PUT ZERO USED Y02753 25459202 STC WKREG2,SDWAURAL CNT IN SDWA RECORDING ARE Y02753 25459602 B CDEQEXIT END Y02753 25459702 SPACE 2 25459802 */*RECRDLPA: P SAVE QVPL ADDRESS OVER RECORD INTERFACE */ 25462002 */* P GET REGISTER SAVE AREA FOR RECORD */ 25464002 */* L RECORD-- CAUSE ASYNCROUS WTO WITH MESSAGE IEA959I */ 25466002 */* P RESTORE QVPL ADDRESS INTO R1 */ 25466402 SPACE 2 25467302 RECRDLPA LR WKREG2,R1 SAVE QVPL ADDR. OVER REC. Y02753 25474902 LA R13,QVPLSIZE+QVPLWASZ(R1) REG SAVE AREA ADDRESS Y02753 25475903 * '(R1)' ADDED TO LINE FOR @ZA17842 25476903 RECORD TYPE=WTO,RCVRY=SETFRR,DATAADR=IEA959,LENGTH=MSGLNTH, *25482402 BUFFER=YES Y02753 25489902 LR R1,WKREG2 RESTORE QVPL AREA ADDRESS Y02753 25499902 SPACE 2 25501902 */*CDEQEXIT: L FREEMAIN-- FREE QUEUE VERIFIER WORK SPACE AND PARM LIST 25502302 */**/ 25502702 */* P RESTORE CALLERS REGISTER SAVE AREA ADDR. FROM R10 */ 25503102 */* P RESTORE CALLERS REGISTERS */ 25503502 */* R RETURN TO CALLER VIA BR14 */ 25503602 SPACE 2 25503902 CDEQEXIT FREEMAIN RC,LV=QVRSIZE,A=(1),BRANCH=YES FREE QVPL, ETC. Y02753 25509902 LR R13,R10 RESTORE CALLERS SAVE REGS Y02753 25519903 NOFREE EQU * @ZA26742 25524903 LM R0,R14,N0(R13) RESTORE CALLERS REGS Y02753 25529903 BR R14 RETURN TO CALLER Y02753 25539902 DROP R6 25543202 EJECT 25545202 * CDE ELEMENT VERIFICATION ROUTINE 25545602 * PURPOSE: TO VERIFY THAT THE ELEMENT PASSED AS INPUT IS A CDE 25546002 * 25546402 * INPUT: 25546502 * R0 = ADDRESS OF ELEMENT TO BE VERIFIED 25546602 * R1 = ADDRESS OF SDWA 25559902 * R14 = RETURN ADDRESS 25569902 * R15 = ENTRY POINT ADDRESS 25571902 * 25572302 * OUTPUT: 25572702 * R15 = RETURN CODE 25573102 * 0 = VALID 25573202 * 4 = INVALID (REMOVE ELEMENT) 25573302 * 8 = INVALID (TRUNCATE QUEUE) 25577702 * R0,1,8-13 = UNCHANGED 25579702 * R2-7 = UNPREDICTABLE 25581702 * 25582102 SPACE 1 25584302 */* E CDEVER */ 25584702 */* P SET UP ADDRESSABILITY */ 25585102 SPACE 2 25586302 CDEVER DS 0H CDE ELEMENT VERIFIER Y02753 25589002 BALR R6,N0 SET UP ADDRESSIBILITY Y02753 25591202 USING *,R6 TELL ASSEMBLER Y02753 25593402 SPACE 2 25595402 */* P SAVE CALLERS RETURN ADDRESS IN R7 */ 25603002 SPACE 2 25610702 LR R7,R14 SAVE CALLERS RETURN ADDR. Y02753 25618302 SPACE 2 25620302 */* P INITIALIZE FOR ADDR. VERIFY RTN. R0= ELEM SIZE, R1= SDWA, R2= 25620702 */*ELEMENT */ 25621102 SPACE 2 25622302 LR R2,R0 PUT SDWA IN USABLE REG Y02753 25625902 LA R0,CDESIZE GET SIZE OF ELEMENT Y02753 25633502 SPACE 2 25635502 */* L IEAVADVER-- VERIFY CDE ADDRESS */ 25635902 SPACE 2 25637502 L R3,CVTPTR GET ADDRESS OF CVT @Y04971 25638502 L R15,CVTADV GET ADDRESS VERIFIER RTN. Y02753 25641102 BALR R14,R15 GO TO ADDR. VER. RTN. Y02753 25651102 SPACE 2 25653102 */* D (YES,MINTST,NO,) ADDRESS VALID? */ 25653502 */* P (,CDEERET) SET RETURN CODE = 8 TO TRUNCATE QUEUE */ 25653902 SPACE 2 25655102 LTR R15,R15 ADDRESS VALID Y02753 25661102 BZ MINTST YES- CHECK ELEMENT Y02753 25671102 LA R15,N8 NO- TRUNCATE QUEUE Y02753 25681102 B CDEERET RETURN TO CALLER Y02753 25683102 USING CDENTRY,R2 ADDRESSING FOR CDE Y02753 25685102 SPACE 2 25685502 */*MINTST: P PUT SAME CDE ADDRESS IN WKREG 3 */ 25685602 */* D (NO,SPTST,YES,) CDE A MINOR? */ 25685702 SPACE 2 25685902 MINTST LR R3,R2 GET MAJOR IN REG 3 Y02753 25687102 TM CDATTR,CDMIN TEST MINOR CDE Y02753 25689102 BZ SPTST NO-GO TO NEXT TEST Y02753 25689502 SPACE 2 25689602 */* P GET MAJOR CDE ADDRESS FROM XTLST FIELD */ 25691602 */* D (YES,LPAQMOD,NO,) MODULE LOADED BY NIP */ 25693602 SPACE 2 25693702 L WKREG3,CDXLMJP GET MAJOR CDE Y02753 25695702 TM CDATTR,CDNIP TEST-MODULE LOADED BY NIP Y02753 25697702 BO LPAQMOD YES- SEARCH LPA ONLY Y02753 25699702 SPACE 2 25700102 */* P (,RUNQ) GET POINTER TO JPQ HEAD */ 25700202 SPACE 2 25700502 L TCBREG,PSATOLD GET CURRENT TCB Y02753 25701702 L TCBREG,TCBJSTCB GET JOBSTEP TCB Y02753 25703702 LA TCBREG,TCBJPQ GET JPQ FROM JSTCB Y02753 25705702 B RUNQ TEST FOR MODULE ON QUEUE Y02753 25707702 SPACE 2 25709702 */*LPAQMOD: P GET POINTER TO LPAQ HEAD */ 25710102 SPACE 2 25711702 LPAQMOD L R4,CVTPTR GET CVT ADDRESS Y02753 25717702 L R4,CVTQLPAQ-CVT(R4) GET LPA QUEUE HEADER Y02753 25719702 SPACE 2 25720102 */*RUNQ: D (YES,SPTST,NO,) CURRENT CDE= MAJOR CDE? */ 25720202 SPACE 2 25720502 RUNQ CR R3,R4 TEST CURRENT=MAJOR Y02753 25721702 BE SPTST IF EQUAL, DO NEXT TEST Y02753 25723702 SPACE 2 25723802 */* D (YES,ERRQRUN,NO,) CURRENT CDE=SUBJECT CDE? */ 25725502 SPACE 2 25727202 CR R2,R4 TEST CURRENT=SUBJECT CDE Y02753 25728902 BNE ERRQRUN IF NOT EQUAL-END WITH ERR Y02753 25730602 SPACE 2 25732002 */* P (,RUNQ) GET NEXT CDE ON QUEUE */ 25732402 SPACE 2 25733502 L R4,N0(R4) GET NEXT CDE Y02753 25733902 B RUNQ LOOP TO CHECK TOTAL QUEUE Y02753 25734002 SPACE 2 25735502 */*ERRQRUN: P (,CDEERET) SET RETURN CODE = 8 TO CAUSE TRUNCATION OF CDE 25737402 */* QUEUE */ 25739402 SPACE 2 25740302 ERRQRUN LA R15,N8 QUEUE TO BE TRUNCATED Y02753 25742202 B CDEERET RETURN TO CALLER Y02753 25744102 SPACE 2 25746402 */*SPTST: D (YES,CDEERET,NO,) MAJOR CDE LOADED BY OS LOADER */ 25746502 SPACE 2 25746802 SPTST TM CDATTR2-CDENTRY(R3),CDSPZ TEST MAJOR FOR SP0 Y02753 25747602 BO CDEERET IF SP0 RETURN TO CALLER Y02753 25747902 SPACE 2 25749702 */* P GET ADDRESS OF EXTENT LIST FROM MAJOR CDE */ 25750202 */* D (YES,CDEERET,NO,) FIRST 9 BYTES OF XTLST CORRECT? */ 25750602 SPACE 2 25751502 L R4,CDXLMJP-CDENTRY(R3) GET EXTENT LIST ADDR. Y02753 25755102 CLC N0(N9,R4),XLSTHEAD TEST FOR XTLST FORMAT Y02753 25756902 BE CDEERET IF XTLST RETURN TO CALLER Y02753 25758702 SPACE 2 25758802 */* P SET RETURN CODE= 8 TO CAUSE TRUNCATION OF CDE QUEUE */ 25759102 */* D (YES,CDEERET,NO,) REQUEST FOR A MAJOR? */ 25759502 SPACE 2 25759602 LA R15,N8 CAUSE QUE TO BE TRUNCATED Y02753 25759702 CR R2,R3 Q. REQUEST FOR MAJOR CDE Y02753 25760502 BE CDEERET YES- SKIP ZERO OF CHAIN Y02753 25760902 SPACE 2 25762102 */* P SET MAJOR AS LAST BY ZEROING CHAIN FIELD */ 25762902 */* P INDICATE NO EXTENT LIST AND SET ATTR. TO NON-REUS */ 25763702 SPACE 2 25764502 SR WKREG2,WKREG2 CLEAR REG FOR ZERO STORES Y02753 25765302 ST WKREG2,CDCHAIN-CDENTRY(R3) SET MAJOR AS LAST Y02753 25766102 ST WKREG2,CDXLMJP-CDENTRY(R3) SET XTLST PTR TO ZERO Y02753 25766902 STC WKREG2,CDATTR-CDENTRY(R3) SET MAJOR NON-REUS Y02753 25767702 SPACE 2 25768202 */*CDEERET: P RESTORE CALLERS RETURN REGISTER */ 25768302 */* R RETURN TO CALLER VIA BR14 */ 25768402 SPACE 2 25768602 CDEERET LR R14,R7 RESTORE CALLERS RET REG Y02753 25769502 BR R14 RETURN TO CALLER Y02753 25771302 DROP R2 RELEASE CDE 25773102 DROP R6 RELEASE BASE 25774902 SPACE 2 25776702 */* FOOTING 25778502 */* 25780302 */* */ 25782102 */*IEAVID00: END IDENTIFY */ 25783902 SPACE 2 25785702 TITLE 'IGC041 - IDENTIFY - CONSTANTS, EQUATES, AND MAPS' 25787502 *********************************************************************** 25789302 ZERO DC A(0) MASK FOR CLEARING FIELDS 25791102 XLSTHEAD DC F'16' LENGTH OF 16 Y02753 25841102 DC F'1' COUNT OF 1 BLOCK Y02753 25891102 DC X'80' END-OF-LIST INDICATOR Y02753 25941102 IEA959 WTO 'IEA959I ERROR CAUSED ACTIVE LPA TO BE TRUNCATED, MODUL*25943102 E CONTROL MAY BE LOST',MF=L,ROUTCDE=2,DESC=4 @M7603 25945102 MSGEND EQU * END OF MSG TO OPERATOR 25947102 MSGLNTH EQU MSGEND-IEA959 LENGTH OF TOTAL MSG AND CODES 25949102 SVC41ERR DC CL8'IEAVID00' MODULE NAME Y02753 25949502 DC CL8'IEAVID00' CSECT NAME Y02753 25949902 DC CL8'FRRSVC41' RECOVERY ROUTINE Y02753 25966602 SVC41RET DC A(SVC41RTY) RETRY ADDRESS FOR ERROR 25968602 FREERTY DC A(SVC41FRE) RETRY ADDRESS FOR @ZA26742 25972603 * FREEING AREA AFTER ERR @ZA26742 25973103 FETRET DC A(FETRTY) RETRY ADDRESS FOR FETCH @ZA28584 25973603 * PROTECT ERROR @ZA28584 25974103 MINMASK DC XL4'80000000' HIGH BIT MASK @ZA26742 25974603 ZEROMASK DC XL4'7FFFFFFF' ZERO HIGH BIT MASK @ZA26742 25975103 JPQERR DC CL10'JPQ ERROR ' ERROR LABEL 25976602 JPQEND EQU * 25978602 LPQERR DC CL10'LPA ERROR ' ERROR LABEL 25980602 LPAEND EQU * 25982602 ZAPSPACE DS 20F AREA FOR TEMPORARY FIXES 25983303 EJECT 26000000 ********************************************************************** 26050000 R0 EQU 0 CROSS REFERENCE EQUATE 26060002 INREG1 EQU R0 INPUT REG WITH ADDR OF PROGNAME 26100002 R1 EQU 1 CROSS REFERENCE EQUATE 26110002 INREG2 EQU R1 INPUT REG WITH ENTRY POINT 26150002 WKREG1 EQU R1 WORK REGISTER 26152002 R2 EQU 2 CROSS REFERENCE EQUATE 26160002 WKREG2 EQU R2 WORK REGISTER 26200002 R3 EQU 3 CROSS REFERENCE EQUATE 26210002 CVTREG EQU R3 INPUT REG WITH CVT ADDR 26250002 WKREG3 EQU R3 WORK RETISTER 26260002 R4 EQU 4 CROSS REFERENCE EQUATE 26270002 TCBREG EQU R4 INPUT REG WITH TCB ADDR 26300002 R5 EQU 5 CROSS REFERENCE EQUATE 26310002 RBREG EQU R5 INPUT REG WITH RB ADDR 26350002 R6 EQU 6 CROSS REFERENCE EQUATE 26400002 BASEREG EQU R6 BASE REG 26460002 R7 EQU 7 CROSS REFERENCE EQUATE 26470002 WKREG5 EQU R7 WORK REG 1 26500002 ASCBREG EQU R7 CONTAINS ASCB FOR GETMAIN 26510002 R8 EQU 8 CROSS REFERENCE EQUATE 26520002 WKREG4 EQU R8 WKREG 4 26550002 XLREG EQU R8 EXTENT LIST REGISTER (TEMP) 26560002 SDWAREG EQU R8 ADDRESS OF SDWA 26562002 R9 EQU 9 CROSS REFERENCE EQUATE 26570002 PNREG EQU R9 WORKING REG FOR INPUT REG 1 26610002 ROURETRG EQU R9 WORK REGISTER 26650002 R10 EQU 10 CROSS REFERENCE EQUATE 26660002 X2 EQU R10 CONTAINS INPUT IN REG 1 26670002 R11 EQU 11 CROSS REFERENCE EQUATE 26710002 TLLSREG EQU R11 TEMP. LLE POINTER 26760002 R12 EQU 12 CROSS REFERENCE EQUATE 26810002 CDEREG EQU R12 CD ENTRY ADDR 26950002 R13 EQU 13 CROSS REFERENCE EQUATE 27000002 SAVEREG EQU R13 SAVE AREA REGISTER 27010002 R14 EQU 14 CROSS REFERENCE EQUATE 27020002 RETREG EQU R14 RETURN REG 27050002 R15 EQU 15 CROSS REFERENCE EQUATE 27100002 CODEREG EQU R15 OUTPUT REG 27150002 EJECT 27200000 ******************************************************************** 27250000 CODEUN EQU X'04' UNNECESSARY-IDENTIFY CODE 27300000 CODEANEQ EQU X'08' MULTIPLE-NAME-FOUND - ERROR CODE 27350000 CODENGEP EQU X'0C' ENTRY-POINT-INVALID - ERROR CODE 27400000 CODENPRB EQU X'10' RB NOT PRB - ERROR CODE 27450000 CODEBADM EQU X'14' MINOR-FOUND,EP'S-NOT-EQ - ERROR CODE 27500000 ILIST EQU X'18' INVALID INPUT LIST - ERROR 27550000 IPARM EQU X'1C' INVALID INPUT PARM. - ERROR 27600000 CODSYSER EQU X'24' UNEXPECTED SYSTEM ERROR 27650002 CODEFET EQU X'28' FETCH-PROTECTED STORAGE @ZA28584 27670003 EJECT 27700000 N0 EQU 0 EQUATE FOR ZERO 27800000 N1 EQU 1 EQUATE FOR 1 27850000 N2 EQU 2 USED TO SHIFT IN MULTIPLY AOS 27900000 N3 EQU 3 EQUATE FOR 3 BYTES 27950000 N4 EQU 4 EQUATE FOR 4 BYTES 28050000 N7 EQU 7 3 BYTE MASK 28100000 N8 EQU 8 OFFSET INTO EXLIST 28200000 NAME EQU 8 MAX. LENGTH OF AOS NAMES 28250000 EQUAL EQU 8 USED TO TEST CONDITION CODES 28300000 N9 EQU 9 LENGTH OF BASE OF XTLST 28310002 MSGLEN EQU 10 LENGTH OF ERROR MESSAGES 28320002 N12 EQU 12 OFFSET IN XLIST 28350000 EXTLST EQU 12 OFFSET TO THE LENGTH OF LIST 28400000 EXTLSTB EQU EXTLST-1 OFFSET TO THE LENGTH OF LIST 28450000 N15 EQU 15 OFFSET INTO AOS LOADER LIST 28500000 N16 EQU 16 XLIST OFFSET 28550000 N20 EQU 20 XLIST OFFSET 28600000 N24 EQU 24 USED FOR 3 BYTE SHIFT 28610002 N29 EQU 29 PARM LIST OFFSET 28650000 N30 EQU 30 PARM LIST OFFSET 28700000 N256 EQU 256 LENGTH OF MAX. MOVE @ZA26742 28705003 REGSAVE EQU 72 LENGTH OF REGISTER SAVE AREA 28710002 HIBIT EQU X'80' CHECK ALPA CHAR 28750000 NAMEFND EQU X'80' NAME FOUND- DUPLICATE REQ. 28760002 MAX EQU X'FF' MAXIMUM VALUE FOR 1 BYTE 28770002 MAXLNTH EQU X'FFF' MAXIMUM VALUE FOR LA @ZA26742 28771003 EJECT @ZA26742 28772003 ************************************************************** @ZA26742 28773003 * DSECT FOR IDENTIFY LIST @ZA26742 28774003 ************************************************************** @ZA26742 28775003 SPACE 2 @ZA26742 28776003 IDLIST DSECT @ZA26742 28777003 IDENTRY DS F ENTRY POINT ADDRESS @ZA26742 28778003 IDNAME DS CL8 8-BYTE NAME @ZA26742 28779003 * @ZA26742 28780003 * THE FOLLOWING DESCRIBES EITHER A BLOCK LOAD OR A @ZA26742 28781003 * SCATTER LOAD EXTENT LIST. A BLOCK LOAD HAS BUT ONE @ZA26742 28782003 * EXTENT, A SCATTER LOAD COULD HAVE MULTIPLE EXTENTS. @ZA26742 28783003 * @ZA26742 28784003 IDXLNTH DS F LENGTH OF EXTENT LIST @ZA26742 28785003 * (X'10' FOR BLOCK LOAD) @ZA26742 28786003 IDXNUM DS F NUMBER OF EXTENTS @ZA26742 28787003 * (1 FOR BLOCK LOAD) @ZA26742 28788003 IDXTNT DS 0F START OF EXTENT LIST @ZA26742 28789003 * EACH WORD CONSISTS OF A FLAG BYTE AND A 3 BYTE EXTENT @ZA26742 28790003 * LENGTH - A X'80' IN THE FLAG BYTE INDICATES THE LAST @ZA26742 28791003 * EXTENT. A START ADDRESS FOR EACH EXTENT FOLLOWS THE @ZA26742 28792003 * LAST EXTENT LENGTH WORD. @ZA26742 28793003 EJECT 28800000 ************************************************************** @ZA26742 28800703 * DSECT FOR FRR PARAMETER @ZA26742 28801403 ************************************************************** @ZA26742 28802103 SPACE 2 @ZA26742 28802803 PARMAD DSECT @ZA26742 28803503 PARMSVRB DS F SVRB ADDRESS @ZA26742 28804203 PARMBASE DS F BASE ADDRESS OF ID00 @ZA26742 28804903 PARMGETM DS F GETMAIN AREA ADDRESS @ZA26742 28805603 PARMGETL DS H GETMAIN LENGTH @ZA26742 28806303 PARMFLAG DS B FLAG BYTE @ZA26742 28807003 PARMFTCH EQU X'04' FETCH PROTECT FLAG @ZA26742 28807703 PARMGTMN EQU X'02' INDICATE AREA ALLOC @ZA26742 28808403 EJECT 1 @ZA26742 28809103 ******************************************************************** 28810002 IHACDE 28820002 CDEEND EQU * END OF CDE MAP 28830002 CDENTPTZ EQU CDENTPT-CDENTRY EQUATE FOR ENTRY POINT 28840002 CDESIZE EQU CDEEND-CDENTRY SIZE OF CDE 28842002 EJECT 28846002 ******************************************************************** 28850000 CVT DSECT=YES,PREFIX=NO 28900000 EJECT 29050000 ********************************************************************* 29050402 IHAFRRS 29050802 EJECT 29051202 ******************************************************************** 29052002 IHALLE 29054002 EJECT 29056002 ******************************************************************** 29058002 IHAXTLST 29058103 EJECT 29058203 ******************************************************************** 29058303 IHAPSA 29058402 EJECT 29058802 ******************************************************************** 29060002 IHAQVPL 29062002 QVRSIZE EQU QVPLSIZE+QVPLWASZ+REGSAVE SIZE NEEDED FOR QV RTN. 29064002 ******************************************************************** 29068002 IHARB 29070002 RBPRBF EQU RBFTP TEST FOR PRB TYPE 29080002 EJECT 29090002 ********************************************************************* 29092002 IHASDWA 29094002 EJECT 29096002 ******************************************************************** 29100000 IKJTCB 29150000 END 30200000 CLR8291 DUPLICATE ENTRY FOR SEQUENCE # 004891 30250003 CLR8291 DUPLICATE ENTRY FOR SEQUENCE # 004894 30300003 CLR8291 DUPLICATE ENTRY FOR SEQUENCE # 004897 30350003