ITS TITLE 'DMSITS (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * MODULE NAME - 00004000 * 00005000 * DMSITS (INTSVC) 00006000 * 00007000 * FUNCTION - 00008000 * 00009000 * HANDLE SVC INTERRUPTS. 00010000 * 00011000 * ATTRIBUTES - 00012000 * 00013000 * NUCLEUS RESIDENT, RE-ENTRANT 00014000 * 00015000 * ENTRY POINTS - 00016000 * 00017000 * DMSITS (OLD NAME: INTSVC) -- 'BALR' ENTRY TO INTSVC, 00018000 * TO AVOID CP OVERHEAD DUE TO SVC CALL. 00019000 * 00020000 * DMSITS1 (OLD NAME: SVCINT) -- ADDRESS POINTED TO BY THE CMS 00021000 * SVC NEW PSW. THIS POINT IS ENTERED WHENEVER AN SVC 00022000 * INTERRUPT OCCURS. 00023000 * 00024000 * DMSITSCR (OLD NAME: CMSRET) -- RETURN POINT TO WHICH THE 00025000 * 'CALLEE' OF A CMS SVC RETURNS WHEN FINISHED PROCESSING. 00026000 * 00027000 * DMSITSOF (OLD NAME: OSRET) -- RETURN POINT TO WHICH THE 00028000 * 'CALLEE' OF AN OS SVC CALL RETURNS WHEN FINISHED 00029000 * PROCESSING. 00030000 * 00031000 * DMSITSK -- SVC 'CALLEE' FOR THE DMSKEY MACRO. 00032000 * 00033000 * DMSITSXS -- SVC 'CALLEE' FOR THE DMSEXS MACRO. 00034000 * 00035000 * DMSITSR -- DMSITS RECOVERY AND RE-INITIALIZATION ROUTINE, 00036000 * CALLED BY DMSABN, THE ABEND RECOVERY ROUTINE. 00037000 * 00038000 * ENTRY CONDITIONS - 00039000 * 00040000 * ENTRY CONDITIONS DEPEND ON THE PARTICULAR SVC CALL, BUT THE 00041000 * FOLLOWING GENERAL CONDITIONS APPLY: 00042000 * 00043000 * SVC 202: REGISTER 1 POINTS TO A PLIST, THE FIRST EIGHT BYTES 00044000 * OF WHICH CONTAIN THE NAME OF THE ROUTINE BEING CALLED. 00045000 * 00046000 * SVC 203: THE SVC CALL IS FOLLOWED INLINE BY A HALFWORD CODE, 00047000 * WHOSE VALUE INDICATES THE ROUTINE BEING CALLED. 00048000 * 00049000 * OS MACRO SIMULATION SVC'S: EACH OS MACRO WILL SET UP THE 00050000 * REGISTERS PROPERLY. 00051000 * 00052000 * EXIT CONDITIONS - 00053000 * 00054000 * NORMAL - 00055000 * 00056000 * SVC 202: REGISTERS ARE UNCHANGED, EXCEPT FOR REGISTER 15, 00057000 * WHICH IS SET TO ZERO. 00058000 * 00059000 * SVC 203: REGISTERS ARE UNCHANGED (UNLESS 'R01' FLAG IS SET 00060000 * FOR THIS CODE IN DMSFNC TABLE), EXCEPT FOR REGISTER 15, 00061000 * WHICH IS SET TO ZERO. 00062000 * 00063000 * OS MACRO SIMULATION SVC'S: REGISTERS ARE UNCHANGED. HOWEVER, 00064000 * THE OS MACRO SIMULATION ROUTINE MAY MODIFY DMSITS'S SYSTEM 00065000 * SAVE AREA, SO THAT DIFFERENT VALUES WILL BE RETURN TO THE 00066000 * CALLER. 00067000 * 00068000 * ERROR - 00069000 * 00070000 * SVC 202: THE 'CALLEE' INDICATES, BY MEANS OF A NON-ZERO 00071000 * CODE IN REGISTER 15, THAT AN ERROR RETURN. THE 'CALLER' 00072000 * INDICATES, BY MEANS OF 'DC AL4(ADDRESS)' FOLLOWING THE 00073000 * SVC CALL INLINE, THAT HE WISHES TO CONTINUE PROCESSING WHEN 00074000 * SUCH AN ERROR RETURN IS MADE. IN THIS CASE, CONTROL IS 00075000 * PASSED TO THE SPECIFIED "ADDRESS", WITH THE ERROR CODE IN 00076000 * REGISTER 15. 00077000 * 00078000 * SVC 203: THE 'CALLEE' INDICATES, BY MEANS OF A NON-ZERO 00079000 * CODE IN REGISTER 15, THAT AN ERROR RETURN IS BEING MADE. 00080000 * THE 'CALLER' INDICATES, BY MEANS OF A NEGATIVE HALFWORD CODE, 00081000 * THAT HE WISHES TO CONTINUE PROCESSING WHEN SUCH AN ERROR 00082000 * RETURN IS MADE. IN THIS CASE, CONTROL IS PASSED TO THE 00083000 * INSTRUCTION FOLLOWING THE HALFWORD CODE, WITH THE ERROR 00084000 * RETURN IN REGISTER 15. 00085000 * 00086000 * NOTE: IN THE CASE OF SVC 202 OR 203, IF AN ERROR RETURN IS 00087000 * MADE BY THE CALLEE, AND THE CALLER HAS NOT INDICATED THAT 00088000 * HE WISHES TO CONTINUE PROCESSING WHEN AN ERROR OCCURS, 00089000 * THEN AN ERROR MESSAGE IS TYPED, AND CMS ABENDS. 00090000 * 00091000 * OS MACRO SIMULATION SVC'S: DMSITS DOES NOT RECOGNIZE ANY 00092000 * ERROR RETURNS IN THE CASE OF THESE SVC'S. HOWEVER, THE 00093000 * MACRO SIMULATION ROUTINE MAY, ITSELF, ABEND, IF NECESSARY. 00094000 * 00095000 * CALLS TO OTHER ROUTINES - 00096000 * 00097000 * DMSMOD -- TO 'LOADMOD' A COMMAND, IF NECESSARY. 00098000 * 00099000 * DMSERR (CALLED BY 'DMSERR' MACRO) -- TO TYPE OUT ERROR 00100000 * MESSAGES 00101000 * 00102000 * DMSFREB (CALLED BY 'DMSFREE' AND 'DMSFRET' MACROS) -- TO 00103000 * ALLOCATE AND RELEASE SAVE AREAS. 00104000 * 00105000 * DMSABNGO -- TO ABEND, WHEN PROCESSING CANNOT CONTINUE. 00106000 * 00107000 * SVC 'CALLEE' ROUTINES: MANY, MANY NUCLEUS ROUTINES AND 00108000 * COMMANDS CAN BE CALLED BY DMSITS, DEPENDING UPON THE TYPE 00109000 * OF SVC CALL. 00110000 * 00111000 * EXTERNAL REFERENCES - 00112000 * 00113000 * DMSINA (ABBREV) -- ABBREVIATION TABLE. 00114000 * 00115000 * DMSFNC -- TABLE OF NUCLEUS-RESIDENT ROUTINES WHICH MAY BE 00116000 * CALLED BY SVC 202. 00117000 * 00118000 * DMSFNC3 -- TABLE OF LEGAL CODES WHICH CAN BE USED IN 00119000 * CONJUNCTION WITH SVC 203. 00120000 * 00121000 * TRANSAR -- ADDRESS OF TRANSIENT AREA, TO WHICH CONTROL IS 00122000 * PASSED, WHEN A TRANSIENT AREA COMMAND IS INVOKED. 00123000 * 00124000 * DMSSVT -- ROUTINE TO DETERMINE WHICH, IF ANY, 00125000 * OS SVC SIMULATION IS TO BE PROCESSED. THIS ROUTINE 00126000 * MAY BE EITHER IN THE CMSSEG DCSS OR IN THE USER'S 00127000 * PROGRAM AREA AS CLOSE TO THE LOADER TABLES AS 00128000 * POSSIBLE. 00129000 * 00130000 * DMSABW -- DMSABN WORKSPACE -- PSW AND REGISTERS ARE SET UP 00131000 * BEFORE CONTROL IS PASSED TO DMSABNGO. 00132000 * 00133000 * TABLES / WORKAREAS - 00134000 * 00135000 * SVCSECT 00136000 * 00137000 * SYSTEM AND USER SAVE AREAS (SSAVE AND USAVE) 00138000 * 00139000 * ALSO, SEE UNDER 'EXTERNAL REFERENCES'. 00140000 * 00141000 * REGISTER USAGE - 00142000 * 00143000 * R2: POINTER TO PLIST FOR SVC 202 (COPIED FROM R1) 00144000 * R3: INTERNAL SUBROUTINE RETURN REGISTER 00145000 * R4: POINTER TO SYSTEM SAVE AREA 00146000 * R5: FIRST BASE REGISTER 00147000 * R6: SECOND BASE REGISTER 00148000 * R7: POINTER TO FVSECT 00149000 * R8: SCRATCH REGISTER 00150000 * R12: POINTER TO SVCSECT 00151000 * 00152000 * NOTES - 00153000 * 00154000 * NONE 00155000 * 00156000 * OPERATION - 00157000 * 00158000 * DMSITS -- WHEN CONTROL COMES HERE BY 'BALR' LINKAGE, THEN 00159000 * THE DOUBLE WORD RESERVED FOR THE SVC OLD PSW IS SET UP IN LOW 00160000 * CORE AS IF SVC 202 LINKAGE HAD OCCURRED, AND CONTROL DROPS 00161000 * THROUGH TO DMSITS1. 00162000 * 00163000 * DMSITS1 -- A SAVE AREA IS ALLOCATED, THE OLDPSW IS SAVED, 00164000 * AND ALL REGISTERS ARE SAVED. THE EXACT SVC TYPE IS 00165000 * DETERMINED, AND THE NAME OF THE APPROPRIATE NUCLEUS OR 00166000 * OR DISK-RESIDENT ROUTINE IS DETERMINED. (THE EXACT 00167000 * METHOD FOR DOING THIS IS DESCRIBED IN 'SVC HANDLING' SECTION 00168000 * OF THE CMS PROGRAM LOGIC MANUAL.) 00169000 * 00170000 * CONTROL IS PASSED TO THE 'CALLEE' ROUTINE. 00171000 * 00172000 * WHEN CONTROL RETURNS FROM THE APPROPRIATE 'CALLEE' ROUTINE, 00173000 * THEN REGISTERS ARE RESTORED TO THEIR VALUES WHEN THE ORIGINAL 00174000 * CALL WAS MADE (EXCEPT FOR REG 15 IN THE CASE OF CMS SVC 00175000 * CALLS). 00176000 * 00177000 * MODIFICATIONS TO THE ABOVE PROCEDURE MAY OCCUR. 00178000 * HERE ARE SOME OF THE WAYS THAT THAT CAN HAPPEN: 00179000 * 00180000 * IF A CALLEE FOR A CMS SVC GIVES AN ERROR RETURN, THE USER 00181000 * MUST BE EXPECTING ONE. IF HE IS NOT, THEN DMSITS CALLS 00182000 * DMSABN TO ABEND. 00183000 * 00184000 * IF SVCTRACE IS IN EFFECT, THEN DMSITS WILL CALL THE TRACE 00185000 * ROUTINE. 00186000 * 00187000 * 00188000 * DMSITSR -- RE-INITIALIZES THE SVC HANDLER WHEN ABEND RECOVERY 00189000 * OCCURS. THIS ROUTINE FREES ALL SAVE AREAS, AND INITIALIZES 00190000 * ALL POINTERS TO ZERO. 00191000 * 00192000 * DMSITSK -- THIS ROUTINE PERFORMS PROCESSING SPECIFIED BY THE 00193000 * 'DMSKEY' MACRO. IF 'NUCLEUS' IS SPECIFIED, THEN A KEY OF 00194000 * 0 IS INSERTED INTO THE OLDPSW. IF 'USER' IS SPECIFIED, THEN 00195000 * THEN A KEY OF X'E' IS INSERTED INTO THE OLDPSW. 00196000 * 00197000 * THERE IS A KEY STACK ASSOCIATED WITH EACH SYSTEM SAVE AREA, 00198000 * AND WHEN 'USER' OR 'NUCLEUS' ARE SPECIFIED, THEN THE OLD KEY 00199000 * IS SAVED IN THE KEY STACK. HOWEVER, THIS PROCESSING CAN 00200000 * BE AVOIDED BY SPECIFYING 'NOSTACK'. WHEN 'RESET' IS 00201000 * SPECIFIED, THEN THE TOP KEY FROM THE KEY STACK IS RE-INSERTED 00202000 * INTO THE OLDPSW. 00203000 * 00204000 * DMSITSXS -- PROCESSING ASSOCIATED WITH THE 'DMSEXS' MACRO. 00205000 * THE SPECIFIED INSTRUCTION IS EXECUTED WITH A ZERO PROTECTION 00206000 * KEY. 00207000 *. 00208000 EJECT 00209000 DMSITS CSECT P3071 00210000 REGEQU 00211000 SPACE 5 00212000 PR EQU R2 SVC 202 PLIST POINTER (COPIED *00213000 FROM R1) 00214000 RR EQU R3 INTERNAL SUBR RETURN REGISTER 00215000 SR EQU R4 INTSVC SAVE AREA POINTER 00216000 BR EQU R5 INTERNAL BASE REGISTER 00217000 BR2 EQU R6 SECOND BASE REGISTER 00218000 FVR EQU R7 POINTER TO FVSECT 00219000 XR EQU R8 SCRATCH REGISTER 00220000 SVCR EQU R12 MUST EQUAL R12; -> SVCSECT 00221000 SPACE 5 00222000 USING SVCSECT,SVCR 00223000 USING DMSITS,BR,BR2 BASE REGISTERS 00224000 USING NUCON,R0 00225000 USE SSAVE,SR 00226000 USING FVSECT,FVR 00227000 * THE FOLLOWING NAME CHANGES WERE MADE IN GOING FROM CMS-67 TO 00228000 * CMS-370. 00229000 SPACE 00230000 * OLD NAME NEW NAME 00231000 * -------------- --------------- 00232000 * INTSVC DMSITS 00233000 * SVCINT DMSITS1 00234000 * OSRET DMSITSOR 00235000 * CMSRET DMSITSCR 00236000 SPACE 5 00237000 ENTRY DMSITS,DMSITS1,DMSITSOR,DMSITSCR 00238000 ENTRY INTSVC,SVCINT,OSRET,CMSRET ***** REMOVE ****** 00239000 ENTRY DMSITSK DMSKEY ENTRY 00240000 ENTRY DMSITSXS DMSEXS ENTRY 00241000 ENTRY DMSITSR DMSITS RE-INITIALIZATION ROUTINE 00242000 * 'INTSVC' ENTERS HERE 00243000 INTSVC EQU * 00244000 ST R15,SVCOPSW+4 CONSTRUCT 2ND HALF OF "VIRTUAL" *00245000 OLD PSW 00246000 BALR R15,0 ESTABLISH ADDRESSABILITY 00247000 USING *,R15 00248000 MVC SVCOPSW(4),=AL1(0,MCKM,0,202) SET MACHINE CHECK BIT, AND*00249000 X'CA' = 202 INTERRUPT CODE 00250000 DROP R15 00251000 EJECT 00252000 * THE SVC NEW PSW CONTAINS THE ADDRESS OF SVCINT. 00253000 DMSITS1 EQU * 00254000 SVCINT EQU * 00255000 STM R11,R13,RET SAVE REGS IN LOW CORE 00256000 BALR R13,0 ESTABLISH ADDRESSABILITY 00257000 USING *,R13 00258000 SPACE 00259000 * THE FOLLOWING CODE IMPLEMENTS A BIT OF A KLUDGE. THERE ARE TIMES 00260000 * WHEN THIS ROUTINE (DMSITS) MUST OBTAIN A ZERO SYSTEM MASK AND A ZERO 00261000 * PROTECT KEY IN THE PSW. (IT WILL NEED THIS WHEN A RETURN IS MADE 00262000 * FROM THE ROUTINE CALLED BY INTSVC.) THE EASIEST WAY TO DO THIS IS 00263000 * TO DO AN SVC. THUS, THE FOLLOWING CODE CHECKS TO SEE IF THE SVC WAS 00264000 * ISSUED FROM THIS ROUTINE. IF IT WAS, THEN WE SIMPLY FIX UP THE SVC 00265000 * NEW PSW THE WAY WE WANT IT, AND RETURN TO THE POINT WHERE THE SVC 00266000 * WAS ISSUED. 00267000 CLI SVCOPSW+3,201 IS IT SVC 201? 00268000 BNE SVC2 DOESN'T COUNT IF NOT 00269000 CLC SVCOPSW+5(3),=AL3(DMSITS) CALLED BEFOR DMSITS? @VA13996 00270000 BL SVC2 GO IF SO -- CAN'T BE FROM DMSITS 00271000 CLC SVCOPSW+5(3),=AL3(ENDITS) CALLED AFTER DMSITS? @VA13996 00272000 BH SVC2 GO IF SO -- CAN'T BE FROM DMSITS 00273000 SPACE 00274000 * OTHERWISE, THE SVC WAS ISSUED IN DMSITS. 00275000 L R11,SVCOPSW+4 GET RETURN ADDRESS 00276000 BR R11 AND RETURN TO CALLER 00277000 SPACE 3 00278000 * OTHERWISE, THIS IS A GENUINE SVC CALL. 00279000 SVC2 EQU * 00280000 L SVCR,ASVCSECT POINT TO SVCSECT 00281000 USING SVCSECT,SVCR 00282000 STM R0,R15,EGPRS-SSAVE+NRMSAV SAVE REGISTERS 00283000 LM BR,BR2,=A(DMSITS,DMSITS+4096) SET BASE REGISTERS 00284000 DROP R13 AND DROP TEMPORARY ONE. 00285000 MVC EGPR11-SSAVE+NRMSAV(3*4),RET SAVE R11-R13 CORRECTLY 00286000 LA SR,NRMSAV POINT TO DEFAULT SAVEAREA 00287000 MVI TYPFLAG,TPFNS NO SAVE AREA ALLOCATED YET 00288000 SPACE 00289000 * MAINTAIN SVC COUNT 00290000 L XR,SVCOUNT GET CURRENT COUNT 00291000 LA XR,1(,XR) INCREMENT IT 00292000 ST XR,SVCOUNT 00293000 * THE FLAG ITSBIT IN UFDBUSY IS USED TO TEST FOR ILLEGAL RE-ENTRIES. 00297000 * IT IS USED MAINLY FOR SYSTEM DEBUGGING. 00298000 * DMSITS HAS TO MAKE SEVERAL CALLS TO OTHER ROUTINES (SUCH AS LOADMOD). 00299000 * IF THESE ROUTINES THEMSELVES DO AN SVC, THEN DMSITS'S SAVE AREA 00300000 * WILL BE CLOBBERED. SO WE TEST FOR THIS CONDITION, AND ABEND IF 00301000 * IT HAPPENS. 00302000 SPACE 00303000 * THE UFDBUSY BYTE OF FVS IS ALSO USED TO PREVENT A 'KX' FROM OCCURRING 00304000 * AT THE WRONG. AS LONG AS ANY BIT (SUCH AS ITSBIT) IS SET IN 00305000 * UFDBUSY, THEN A 'KX' WILL SIMPLY BE LEFT IN A PENDING STATUS. 00306000 L FVR,AFVS POINT TO FVSECT 00307000 TM UFDBUSY,ITSBIT ARE WE RE-ENTERING DMSITS? 00308000 BO ERREN YES -- BAD SYSTEM ERROR 00309000 OI UFDBUSY,ITSBIT TURN ON BIT 00310000 SPACE 00311000 MVI SFLAG,0 INITIALIZE SFLAG 00312000 SPACE 00313000 * FOR THE TIME BEING, WE USE THE 'NRMSAV' AREA IN SVCSECT AS A 00314000 * SUPER SAVE-AREA, CONTAINING ALL INFORMATION CONCERNING THIS SVC CALL. 00315000 * LATER, WE WILL CALL DMSFREE TO ALLOCATE A SAVE AREA SPACE JUST FOR 00316000 * THIS CALL, AND WE WILL COPY THE INFO FROM NRMSAV INTO THE NEW AREA. 00317000 LR PR,R1 COPY PLIST PTR (SVC 202 ONLY) 00318000 SPACE 00319000 * INCREMENT NESTED SVC DEPTH COUNTER 00320000 L XR,DEPTH GET LAST DEPTH 00321000 LA XR,1(,XR) INCREMENT IT 00322000 ST XR,DEPTH 00323000 CH XR,=AL2(MAXDEEP) EXCEED SYSTEM MAX? 00324000 BH ERDEEP ERROR IF SO 00325000 SPACE 00326000 ERDEEPRT EQU * RETURN HERE TO CONTINUE PROCESS 00327000 CLI SVCOPSW+3,202 IS THIS SVC 202? 00328000 BE SVC202 IF SO, GO HANDLE IT 00329000 CLI SVCOPSW+3,203 IS THIS SVC 203 00330000 BE SVC203 IF SO, GO HANDLE IT 00331000 B OSSVC OTHERWISE, IT'S AN OS SVC CALL. 00332000 SVC203 EQU * 00333000 SPACE 00334000 * IN THIS CASE, THE SVC IS FOLLOWED IN THE IN-LINE CODE BY A 00335000 * HALFWORD CODE WHICH INDICATES THE EXACT NATURE OF THE REQUEST. 00336000 L R15,SVCOPSW+4 GET ADDRESS OF HALFWORD CODE 00337000 LH XR,0(,R15) GET HALFWORD CODE 00338000 STH XR,NRMSAV+CODE-SSAVE AND SAVE IT IN SUPER SAVE AREA 00339000 AH R15,=H'2' POINT TO TRUE RETURN ADDRESS 00340000 ST R15,SVCOPSW+4 AND STORE IT IN SVC OLD PSW 00341000 SPACE 00342000 * THE HALFWORD CODE MAY BE EITHER POSITIVE OR NEGATIVE. A NEGATIVE 00343000 * CODE SPECIFIES THE SAME ROUTINE AS A POSITIVE CODE, BUT THERE IS 00344000 * THE FOLLOWING DIFFERENCE: IF THE CALLED ROUTINE GIVES AN ERROR 00345000 * RETURN (NON-ZERO REGISTER 15), THEN A POSITIVE CODE WILL CAUSE 00346000 * DMSITS TO ABEND, WHILE A NEGATIVE CODE WILL CAUSE DMSITS TO RETURN 00347000 * TO THE POINT WHERE THE SVC WAS INVOKED. 00348000 LTR XR,XR IS THE CODE NEGATIVE 00349000 BP *+8 SKIP IF POSITIVE 00350000 OI NRMSAV+TYPFLAG-SSAVE,TPFERT SET ERROR RETURN FLAG 00351000 LPR R15,XR GET ABSOLUTE VALUE OF CODE 00352000 SPACE 00353000 * THE ROUTINE NAME IS DETERMINED BY THE SECOND BYTE OF THE HALFWORD 00354000 * CODE. THIS LEAVES SEVEN BITS OF THE FIRST BYTE WHICH MAY BE USED 00355000 * TO PASS INFORMATION TO THE SVC ROUTINE BY THE CALLER. 00356000 N R15,=A(X'FF') GET ROUTINE CODE 00357000 BZ NO203 ZERO CODE IS ILLEGAL 00358000 L R14,=V(DMSFNC3) POINT TO SVC 203 FUNCTION TABLE 00359000 C R15,0(,R14) DOES THIS EXCEED MAXIMUM CODE? 00360000 BH NO203 ILLEGAL IF IT DOES 00361000 SPACE 00362000 * EACH ENTRY IN THE FUNCTION TABLE IS TWELVE BYTES LONG. THE 00363000 * FIRST EIGHT BYTES CONTAIN THE ROUTINE NAME OR MACRO NAME ASSOCIATED 00364000 * WITH THE SVC 203 CODE. THIS NAME CAN BE EITHER THE FILENAME OF A 00365000 * TRANSIENT MODULE, OR IT CAN BE USED SIMPLY FOR DEBUGGING PURPOSES, 00366000 * SUCH AS IN SVCTRACE. THE NINTH BYTE IS A FLAG BYTE, TO BE DESCRIBED. 00367000 * AND THE LAST THREE BYTES CONTAIN THE ADDRESS OF THE ROUTINE BEING 00368000 * CALLED, IF IT'S IN THE NUCLEUS. (IF THE ROUTINE IS TRANSIENT, THEN 00369000 * THIS ADDRESS IS ZERO.) 00370000 BCTR R15,0 COMPUTE LOCATION OF BLOCK 00371000 MH R15,=H'12' 00372000 LA XR,4(R14,R15) 00373000 SPACE 00374000 * XR NOW POINTS TO 12 BYTE CONTROL BLOCK DESCRIBED JUST ABOVE. 00375000 CLC CODE,MIN3 IS THIS CMSSVT 203? @V305665 00376000 BE OSSVC BRANCH IF YES @V305665 00377000 SPACE 00378000 * WE CHECK FLAG BYTE FOR TWO FLAGS. 00379000 * IF R01 IS SET, THEN THE VALUES OF REG 0 AND 1 RETURNED BY THE CALLEE 00380000 * SHOULD BE PASSED BACK TO THE CALLER. 00381000 * IF NSF IS SET, THEN THE CALLEE IS NOT GOING TO DO ANY SVC'S, AND SO 00382000 * THERE IS NO NEED TO ALLOCATE A NEW SAVE AREA. 00383000 TM FLAGS(XR),R01 R01 FLAG SET? 00384000 BZ *+8 SKIP IF NOT 00385000 OI NRMSAV-SSAVE+TYPFLAG,TPFR01 SET NRMSAV FLAG VALUE 00386000 SPACE 00387000 TM FLAGS(XR),NSF NO SAVE AREA FLAG SET? 00388000 BO *+8 SKIP IF SO 00389000 NI TYPFLAG,X'FF'-TPFNS WE WANT A REAL SAVE AREA IF NOT 00390000 SPACE 00391000 BAL RR,GETSAVE GET SAVE AREA AND INITIALIZE 00392000 SPACE 00393000 MVC ERRET,OLDPSW+4 SET ERROR RETURN ADDRESS 00394000 MVC NRMRET,OLDPSW+4 SET NORMAL RETURN ADDRESS 00395000 MVC CALLEE,NAME(XR) COPY ROUTINE/MACRO NAME 00396000 MVC CODE203,CODE PUT CODE INTO NUCON FOR CALLEE 00397000 L R15,ADDR(,XR) GET ADDRESS OF CALLEE 00398000 LA R15,0(,R15) CLEAR HIGH BYTE 00399000 LTR R15,R15 IS IT IN THE NUCLEUS? 00400000 BNZ NUC GO TO IT IF SO 00401000 L R15,EGPR15 GET USER SUPPLIED R15 @VM03048 00402000 LA R15,0(,R15) CLEAR HIGH BYTE @VM03048 00403000 CLC CODE,MIN16 IS THIS SPECIAL SVC 203 ? @VM03048 00404000 BE NUC GO TO IT IF SO @VM03048 00405000 SPACE 00406000 * IF IT IS NOT IN THE NUCLEUS, THEN WE USE THE ROUTINE NAME IN THE 00407000 * CONTROL BLOCK AS A NAME, AND PROCEED AS IN SVC 202. WE NOW 00408000 * PASS CONTROL TO THE SVC 203 ENTRY TO SVC 202 CODE. 00409000 B S2EN 00410000 SVC202 EQU * 00411000 NI TYPFLAG,X'FF'-TPFNS WE ARE ABOUT TO GET A SAVEAREA 00412000 L R1,SVCOPSW+4 GET SVC RETURN ADDRESS 00413000 SPACE 00414000 * IF THE SVC CALL IS FOLLOWED, IN LINE, BY A BYTE OF ZERO, THEN IT IS 00415000 * ASSUMED THAT THIS IS THE FIRST BYTE OF A CONSTANT OF THE FORM 00416000 * AL4(ADDRESS). THIS ADDRESS SPECIFIES WHERE CONTROL IS TO IF THERE 00417000 * IS AN ERROR RETURN FROM THE CALLED SVC ROUTINE. IF THE BYTE 00418000 * FOLLOWING IS NON-ZERO, THEN DMSITS WILL ABEND IF THERE IS AN ERROR 00419000 * RETURN. 00420000 * (AN ERROR RETURN IS INDICATED BY A NON-ZERO VALUE RETURNED IN REG 15 00421000 * FROM THE CALLED ROUTINE.) 00422000 ST R1,NRMRET-SSAVE+NRMSAV STORE NORMAL RETURN ADDRESS, *00423000 ASSUMING NO AL4(ADDRESS). 00424000 ST R1,ERRET ALSO STORE AS ERROR RETURN 00425000 CLI 0(R1),0 IS THE BYTE FOLLOWING A ZERO? 00426000 BNE S2A GO IF HE WANTS ABEND ON ERROR 00427000 OI TYPFLAG-SSAVE+NRMSAV,TPFERT SET ERROR RETURN FLAG 00428000 MVC ERRET-SSAVE+NRMSAV,0(R1) COP ERROR RETURN ADDRESS FROM *00429000 THE AL4(ADDRESS) 00430000 LA R1,4(,R1) SKIP OVER THE 4-BYTE CONSTANT 00431000 ST R1,NRMRET-SSAVE+NRMSAV AND STORE AS NORMAL RETURN ADDR 00432000 SPACE 00433000 S2A EQU * 00434000 SPACE 00435000 * IN THE CASE OF SVC 202, REGISTER 1 (WHICH HAS BEEN COPIED INTO 00436000 * REGISTER PR) POINTS TO A PLIST (PARAMETER LIST). THE FIRST EIGHT 00437000 * BYTES OF THIS PLIST CONTAIN THE NAME OF THE ROUTINE BEING CALLED. 00438000 * HOWEVER, IF THE FIRST BYTE OF THE ROUTINE NAME IS A DOT, THEN THE 00439000 * ROUTINE IS AN SVCTRACE OVERRIDE ROUTINE. 00440000 MVC CALLEE+NRMSAV-SSAVE,0(PR) COPY CALLEE NAME INTO SAVE 00441000 SPACE 00442000 BAL RR,GETSAVE ALLOCATE A SAVE AREA 00443000 MVC CALLEE,CALLEE-SSAVE+NRMSAV COPY CALLEE NAME INTO AREA 00444000 MVC NRMRET(8),NRMRET-SSAVE+NRMSAV COPY NRMRET AND ERRET 00445000 SPACE 00446000 * THE FOLLOWING IS THE ENTRY POINT TO SVC 202 CODE WHEN AN SVC 203 IS 00447000 * MADE, REQUIRING AN SVC 202 LOOKUP. 00448000 S2EN EQU * 00449000 LM R0,R1,CALLEE GET NAME OF CALLEE 00450000 BAL RR,CHKTRANS SEE IF IT'S IN TRANSIENT AREA 00451000 BE TRANS GO IF IT IS 00452000 BAL RR,SRCFNC SEARCH DMSFNC FUNCTION TABLE 00453000 LTR R15,R15 ANY LUCK? 00454000 BNZ NUC GO IF FOUND -- ADDR IN R15 00455000 STM R0,R1,DUMCOM FORM 'LOADMOD' PLIST 00456000 BAL RR,LODMODIT AND TRY TO LOADMOD THE ROUTINE 00457000 BZ LMOK GO IF LOADMOD IS OK 00458000 CH R15,=H'28' WAS 'FILE NOT FOUND'? P3065 00459000 BNE BADMOD BAD MODULE IF NOT P3065 00460000 L R15,=V(ABBREV) LOAD ADDR OF ABBREVIATION ROUT 00461000 LTR R15,R15 IS THERE SUCH A ROUTINE? 00462000 BZ GIVUP GIVE TRYING, IF THERE ISN'T 00463000 LM R0,R1,CALLEE LOAD NAME OF ROUTINE 00464000 BALR R14,R15 CALL ABBREVIATION ROUTINE 00465000 LTR R15,R15 WAS AN UN-ABBREVIATION FOUND? 00466000 BNZ GIVUP GIVE UP TRYING, IF NOT 00467000 BAL RR,CHKTRANS SEE IF NEW NAME IS IN TRANSIENT *00468000 AREA 00469000 BE TRANS GO IF IT IS 00470000 BAL RR,SRCFNC SEARCH DMSFNC FUNCTION TABLE FOR*00471000 NEW NAME 00472000 LTR R15,R15 WAS IT FOUND? 00473000 BNZ NUC GO IF IT WAS -- ADDR IN REG 15 00474000 STM R0,R1,DUMCOM STORE NAME IN LOADMOD PLIST 00475000 BAL RR,LODMODIT GO LOADMOD IT 00476000 BZ LMOK GO IF LOADMOD IS OK 00477000 CH R15,=H'28' WAS 'FILE NOT FOUND'? P3065 00478000 BNE BADMOD BAD MODULE IF NOT P3065 00479000 SPACE 3 00480000 * THE NAME PASSED IN THE PLIST CAN'T BE FOUND ANYWHERE. IN THIS CASE, 00481000 * WE GIVE THE USER A RETURN CODE OF -3. 00482000 GIVUP EQU * 00483000 LA R15,RETM3 GO TO 'RETM3' P3065 00484000 B NUC AS NUCLEUS ROUTINE P3065 00485000 SPACE 1 00486000 * COME HERE IF AN ERROR RETURN FROM 'LOADMOD' IS OTHER THAN 'FILE 00487000 * NOT FOUND.' WE DISTINGUISH GETWEEN TWO CASES: 1. WE ARE IN 00488000 * SUBSET MODE, AND THE MODULE GOES INTO THE USER AREA (LOADMOD 00489000 * ERROR CODE 32) AND 2. THE LOAD MODULE IS BAD (OTHER LOADMOD 00490000 * ERROR CODE). THE RETURN CODES WILL BE -2 AND -4, RESPECTIVELY, 00491000 * FOR THESE CASES| AND THIS WILL BE USED BYY DMSINT TO DETERMINE 00492000 * THE ERROR MESSAGE OR FURTHER ACTION TO BE TAKEN. 00493000 * 00494000 * ALSO: FOR ERROR CODE 40 FROM DMSMOD (DOS/OS "MISMATCH"), 00495000 * GIVE A RETURN CODE OF MINUS 5. 00496000 * 00497000 BADMOD EQU * P3065 00498000 LR XR,R15 SAVE LOADMOD RETURN CODE P3065 00499000 LA R15,RETM5 SET FOR -5 = DOS/OS MISMATCH @V305032 00500000 CH XR,=H'40' ERROR CODE = 40 ? @V305032 00501000 BE NUC YES (HANDLE AS NUCLEUS CALL). @V305032 00502000 LA R15,RETM2 SET FOR -2 = SUBSET ERROR @V305032 00503000 CH XR,=H'32' ERROR CODE = 32 ? @V305032 00504000 BE NUC YES (HANDLE AS NUCLEUS CALL). @V305032 00505000 LA R15,RETM4 SET -4 FOR OTHER LOADMOD ERRORS @V305032 00506000 B NUC AND HANDLE AS NUCLEUS CALL. @V305032 00507000 EJECT 00508000 * THE LOADMOD WAS SUCCESSFUL. GO START UP. 00509000 LMOK EQU * 00510000 LM R0,R1,DUMCOM LOAD NAME OF LOADMODED ROUTINE 00511000 BAL RR,CHKTRANS IS IT IN THE TRANSIENT AREA? 00512000 BE TRANS GO HANDLE IT THERE 00513000 SPACE 00514000 * OTHERWISE, THE PROGRAM IS IN THE USER PROGRAM AREA, BEGINNING AT 00515000 * X'20000'. 00516000 USER EQU * 00517000 OI TYPFLAG,TPFUSR SET 'USER ROUTINE' FLAG 00518000 TM PROTFLAG,PRFUSYS USER PROGRAM IS SYSTEM? 00519000 BZ *+8 SKIP IF IT IS NOT 00520000 OI SFLAG,SFSYS SET SYSTEM FLAG 00521000 L R15,STRTADDR LOAD R15 WITH STARTING ADDRESS 00522000 B START AND GO TO START UP 00523000 SPACE 2 00524000 * THE ROUTINE IS IN THE TRANSIENT AREA. 00525000 TRANS EQU * 00526000 OI TYPFLAG,TPFUSR SET 'USER ROUTINE' FLAG FOR *00527000 TRANSIENT AREA ROUTINE 00528000 OI SFLAG,SFTRN SET TRANSIENT FLAG 00529000 TM PROTFLAG,PRFTSYS IS SYSTEM FLAG SET? 00530000 BZ *+8 SKIP IF NOT 00531000 OI SFLAG,SFSYS SET SYSTEM FLAG 00532000 L R15,=V(TRANSAR) LOAD ADDRESS OF TRANSIEMT AREA 00533000 B START AND GO TO START UP 00534000 * COME HERE IF THE ROUTINE IS IN THE NUCLEUS. 00535000 NUC EQU * 00536000 OI SFLAG,SFSYS+SFNUC SET SYSTEM AND NUCLEUS FLAGS 00537000 SPACE 3 00538000 * COME HERE TO START UP THE SVC ROUTINE. THE ROUTINE IS IN CORE SOME- 00539000 * WHERE, WHETHER IN THE NUCLEUS, THE TRANSIENT AREA, OR THE USER AREA. 00540000 * REGISTER 15 CONTAINS THE ADDRESS TO WHICH WE'RE SUPPOSED TO TRANSFER 00541000 * CONTROL. ALL WE HAVE TO DO IS CONSTRUCT A PSW AND LOAD IT. 00542000 START EQU * 00543000 L R13,USAVEPTR 00544000 USING USAVE,R13 ADDRESS SAVE AREA @VA06029 00545000 XC USAVE(USAVESZ*8),USAVE CLEAR THE SAVE AREA @VA06029 00546000 DROP R13 FREE THE REGISTER @VA06029 00547000 ST R15,RET+4 USE LOWCORE AREA FOR CONSTRUCTON 00548000 MVC RET(2),=AL1(ON,0) SET SYSTEM MASK ON 00549000 TM SFLAG,SFTRN+SFNUC TRANSIENT OR NUCLEUS ROUTINE? 00550000 BZ *+8 SKIP IF NOT 00551000 MVI RET,OFF TURN OFF SYSTEM MASK 00552000 TM SFLAG,SFSYS SYSTEM FLAG ON? 00553000 BO *+8 SKIP IF YES 00554000 OI RET+1,USERKEY PROTECT NUCLEUS STORAGE IF NOT 00555000 TM PROTFLAG,PRFPOFF STORAGE PROTECTION ON? 00556000 BZ *+8 SKIP IF SO 00557000 NI RET+1,X'0F' RESTORE NUCLEUS KEY 00558000 TM OVSTAT,OVSON SVCTRACE IN EFFECT? 00559000 BZ *+12 SKIP IF NOT 00560000 LR XR,R15 SAVE R15 TEMPORARILY 00561000 BAL RR,BOVR CALL OVERRIDE ROUTINE 00562000 LR R15,XR RESTORE REG 15 00563000 LM R0,R1,EGPRS RESTORE CALLER'S R0 AND R1 00564000 LM R9,R10,CALLEE A SCREWY REQUIREMENT OF SOME *00565000 ROUTINES 00566000 LR R12,R15 EXTRA BASE REG FOR ROUTINES 00567000 LA R14,CMSRET RETURN ADDRESS PASSED TO CALLER 00568000 ST R14,ITS14 PASS IN REGISTER 14 00569000 ST R15,ITS15 WHAT TO PASS IN REG 15 00570000 LA R14,LPSW POINT TO LPSW ROUTINE 00571000 BR R14 GO TO IT 00572000 * CONTROL COMES HERE TO GIVE ONE OF THE SPECIAL DMSITS RETURN 00573000 * CODES, -2, -3 OR -4. 00574000 RETM2 EQU * P3065 00575000 OI MISFLAGS,NEGITS SET FLAG FOR INT @VA02241 00576000 LH R15,=H'-2' LOAD RETURN CODE -2 P3065 00577000 B CMSRET AND RETURN IT P3065 00578000 SPACE 1 00579000 RETM3 EQU * P3065 00580000 OI MISFLAGS,NEGITS SET FLAG FOR INT @VA02241 00581000 LH R15,=H'-3' LOAD RETURN CODE -3 P3065 00582000 B CMSRET AND RETURN IT P3065 00583000 SPACE 1 00584000 RETM4 EQU * P3065 00585000 OI MISFLAGS,NEGITS SET FLAG FOR INT @VA02241 00586000 LH R15,=H'-4' LOAD RETURN CODE -4 P3065 00587000 B CMSRET AND RETURN IT P3065 00588000 SPACE 00589000 RETM5 EQU * @V305032 00590000 OI MISFLAGS,NEGITS SET FLAG FOR INT @V305032 00591000 LH R15,=H'-5' LOAD RETURN CODE OF -5, @V305032 00592000 B CMSRET AND GO RETURN IT. @V305032 00593000 * CHECK TO SEE IF SPECIFIED NAME IS CURRENTLY LOADED INTO THE TRANSIENT 00594000 * AREA. 00595000 CHKTRANS EQU * 00596000 CL R0,LASTTMOD FIRST FOUR BYTES MATCH? 00597000 BCR 7,RR (BNE 0(RR)) ERROR RETURN IF NOT 00598000 CL R1,LASTTMOD+4 SECOND FOUR BYTES MATCH? 00599000 BR RR RETURN WITH COND CODE SET 00600000 EJECT 00601000 * SEARCH DMSFNC FUNCTION TABLE FOR NAME IN R0-R1 00602000 SRCFNC EQU * 00603000 LR R14,R0 COPY NAME 00604000 SRL R14,24 GET FIRST LETTER OF COMMAND 00605000 SH R14,=AL2(C'A') SUBTRACT LETTER A 00606000 BM SFER ERROR IF RESULT IS NEGATIVE 00607000 CH R14,=AL2(C'Z'-C'A') WAS IT GREATER THAN Z? 00608000 BH SFER ERROR IF IT WAS 00609000 AR R14,R14 MULTIPLY BY 2 00610000 L R15,=V(DMSFNC) POINT TO LETTER DISPLACEMENT TAB 00611000 LH XR,0(R14,R15) GET DISPLACEMENT OF FIRST TABLE *00612000 ENTRY FOR THIS LETTER 00613000 AR XR,R15 XR -> FIRST TABLE ENTRY 00614000 AH R15,2(R14,R15) R15 -> FIRST ENTRY FOR NEXT LET 00615000 LA R14,12 LENGTH OF TABLE ENTRY 00616000 SPACE 00617000 SFLOOP EQU * 00618000 CL R0,NAME(,XR) DO FIRST FOUR BYTES MATCH? 00619000 BNE SFBXLE THIS ISN'T IT IF NOT 00620000 CL R1,NAME+4(,XR) DO SECOND FOUR BYTES MATCH? 00621000 BE SFFND NAME FOUND IN THE TABLE 00622000 SPACE 00623000 SFBXLE EQU * 00624000 SPACE 00625000 * HERE'S WHAT THE FOLLOWING BXLE DOES (IN CASE YOU DON'T REMEMBER): 00626000 SPACE 00627000 * XR <- C(XR) + C(R14) = ADDRESS OF NEXT TABLE ENTRY 00628000 * IF C(XR) <= C(R15) -- I.E., IF WE HAVE NOT YET REACHED THE 00629000 * LAST ENTRY FOR THIS LETTER -- THEN GO TO LOOP BACK AGAIN 00630000 BXLE XR,R14,SFLOOP 00631000 SPACE 00632000 * COME HERE WHEN SEARCH HAS FAILED. 00633000 SFER EQU * 00634000 SR R15,R15 WE HAVE NO ADDRESS TO PASS BACK 00635000 BR RR RETURN TO CALLER 00636000 SPACE 00637000 * COME HERE IF THE NAME WAS FOUND. 00638000 SFFND EQU * 00639000 L R15,ADDR(,XR) GET BRANNCH ADDRESS 00640000 BR RR RETURN TO CALLER WITH ADDR IN *00641000 REGISTER 15 00642000 EJECT 00643000 * ALLOCATE A SAVE AREA FOR THE CALLED ROUTINE'S REGISTERS 00644000 GETSAVE EQU * 00645000 SR R1,R1 CLEAR REGISTER 1 @VA04752 00646000 LA SR,NRMSAV POINT TO DEFAULT SAVE AREA 00647000 TM TYPFLAG,TPFNS SAVE AREA ALLOCATION WANTED? 00648000 BO GETSAVEN GO IF NOT -- USE NRMSAV 00649000 L SR,CURRALOC GET ADDRESS OF PREV SAVE AREA 00650000 LTR SR,SR WAS THERE ANY? 00651000 BZ GETSAVEF SKIP TO ALLOCATE IF NOT 00652000 L SR,SSAVENXT POINT TO NEXT ONE 00653000 LTR SR,SR IS THERE A NEXT ONE ALREADY *00654000 ALLOCATED? 00655000 BNZ GETSAVEG GOT ONE IF SO 00656000 SPACE 00657000 * ALLOCATE A NEW SYSTEM SAVE AREA AND NEW USER SAVE AREA. 00658000 GETSAVEF EQU * 00659000 DMSFREE DWORDS=SSAVESZ,TYPCALL=BALR,TYPE=NUCLEUS, *00660000 ERR=FREEER 00661000 L SR,CURRALOC GET PREVIOUS SAVE AREA 00662000 LTR SR,SR IS THERE ANY? 00663000 BZ *+8 SKIP IF NOT 00664000 ST R1,SSAVENXT STORE NEXT POINTER 00665000 ST SR,SSAVEPRV-SSAVE(,R1) SET PREVIOUS PTR OF NEW CURRENT 00666000 LR SR,R1 POINT TO NEW SYSTEM SAVE AREA 00667000 SR R15,R15 ZERO A REGISTER @VA04752 00668000 ST R15,SSAVENXT AND ZERO NEXT POINTER @VA04752 00669000 ST R15,USAVEPTR AND SAVE AREA POINTER @VA04752 00670000 ST SR,LASTALOC SET LAST ALLOCATION PTR 00671000 SPACE 00672000 * COME HERE WHEN SAVE AREAS ARE ALLOCATED. 00673000 GETSAVEG EQU * 00674000 SPACE 00675000 * COPY SEVERAL FIELDS FROM NRMSAV 00676000 MVC SSAVE(4),NRMSAV COPY FIRST FOUR BYTES 00677000 MVC EGPRS(4*16),EGPRS-SSAVE+NRMSAV COPY ENTRY GPRS 00678000 ST SR,CURRALOC SET CURRENT ALLOCATION PTR 00679000 B GETSAVEC GO TO COMMON CODE 00680000 SPACE 00681000 * COME HERE IF SR -> NRMSAV, AND THIS IS TO BE THE SAVE AREA PASSED 00682000 * TO THE CALLED ROUTINE. (THIS WILL HAPPEN WITH OVERRIDE ROUTINES, AND 00683000 * WITH CERTAIN ROUTINES FOR SVC 203.) 00684000 GETSAVEN EQU * 00685000 LA R15,NRMUSAV NRMUSAV IS USER SAVE AREA 00686000 ST R15,USAVEPTR 00687000 MVC SSAVEPRV,CURRSAVE SET PREVIOUS SAVE AREA POINTER 00688000 SPACE 00689000 * COMMON SAVE AREA HANDLING CODE 00690000 GETSAVEC EQU * 00691000 MVC CHKWRD1,=C'ABCD' SET FIRST CHECK WORD 00692000 MVC CHKWRD2,=C'EFGH' SET THE SECOND 00693000 MVI KEYP,0 INITIALIZE KEY STACK 00694000 ST SR,CURRSAVE SAVE ADDRESS OF CURRENT SAVEAREA 00695000 STDM F0,F6,EFPRS SAVE FLOATING POINT REGISTERS 00696000 LTR R1,R1 WAS A SAVE AREA GOTTEN? @VA04752 00697000 BZ MOVPSW BRANCH IF NOT @VA04752 00698000 DMSFREE DWORDS=USAVESZ,TYPCALL=BALR,TYPE=USER, *00699000 ERR=FREEER ALLOCATE A USER SAVE AREA @VA04752 00700000 ST R1,USAVEPTR STORE SAVE AREA POINTER @VA04752 00701000 MOVPSW EQU * @VA04752 00702000 MVC OLDPSW,SVCOPSW COPY SVC OLD PSW INTO AREA 00703000 L R15,SVCOPSW+4 ADDRESS IN SVC OLD PSW 00704000 LA R15,0(,R15) CLEAR HIGH BYTE OF R15 00705000 TM SVCOPSW+4,X'80' EXECUTE (4-BYTE) INSTRCTN? @VM01537 00706000 BZ DECK2 NO, 2-BYTE SVC, BACK UP 2 @VM01537 00707000 BCTR R15,0 YES, DECREMENT ADDITIONAL @VM01537 00708000 BCTR R15,0 TWO BYTES @VM01537 00709000 DECK2 EQU * @VM01537 00710000 BCTR R15,0 DECREMENT BY TWO TO 00711000 BCTR R15,0 COMPUTE CALLER'S ADDRESS 00712000 ST R15,CALLER AND STORE IN SAVE AREA 00713000 BR RR 00714000 EJECT 00715000 * LODMODIT SUBROUTINE. R1 POINTS TO A LOADMOD SUBROUTINE. 00716000 LODMODIT EQU * 00717000 LA R1,MODLIST POINT TO LOADMOD "P-LIST" @V305032 00718000 * (WILL PUT IN HIGH-ORDER BYTE OF CALLER'S R1 SHORTLY) 00719000 SPACE 00720000 * WE GRAB A SAVE AREA IN SVCSECT, BECAUSE LOADMOD WILL DESTROY ALL 00721000 * OUR REGISTERS. 00722000 STM R0,R14,SVCSAVE 00723000 ICM R1,8,SVCSAVE+8 INSERT HIGH BYTE OF CALLER'S R1 @V305032 00724000 * (STILL AVAILABLE IN R2 & NOW IN SVCSAVE+8) 00725000 L R15,=V(DMSMOD) ADDRESS OF LOADMOD ROUTINE 00726000 SPACE 00727000 * AND IF THAT WEREN'T ENOUGH, WE MUST POINT TO A SAVE AREA, ANYWAY. 00728000 L R13,USAVEPTR 00729000 BALR R14,R15 CALL LOADMOD 00730000 SPACE 00731000 * CONDITION CODE IS SET ON RETURN FROM LOADMOD. IT SHOULD BE PRESERVED 00732000 * THROUGH EXIT FROM THIS SUBROUTINE. 00733000 L SVCR,ASVCSECT 00734000 LM R0,R14,SVCSAVE REGAIN REGISTERS 00735000 BR RR RETURN TO SUBROUTINE CALLER 00736000 * COME HERE IF THE SVC VALUE IS NOT 202 OR 203. THIS MEANS THAT IT 00737000 * IS AN OS SIMULATION SVC CALL. 00738000 OSSVC EQU * 00739000 NI TYPFLAG,X'FF'-TPFNS WE WILL WANT A REAL SAVEAREA 00740000 BAL RR,GETSAVE ALLOCATE A SAVE AREA 00741000 OI TYPFLAG,TPFSVO SET OS SVC FLAG 00742000 L XR,SVCOPSW+4 GET OLD PSW RETURN ADDR 00743000 LA XR,0(,XR) ZERO OUT HIGH BYTE 00744000 ST XR,ERRET THAT'S THE ERROR RETURN 00745000 ST XR,NRMRET AS WELL AS THE NORMAL RETURN 00746000 * AS CALLEE NAME, USE 'SVC NNN' IN EBCDIC. 00747000 SR XR,XR 00748000 IC XR,SVCOPSW+3 GET SVC NUMBER 00749000 CVD XR,TEMP02 CONVERT SVC NUMBER TO DECIMAL 00750000 MVC CALLEE,TEXT01 MOVE IN EDIT STRING 00751000 ED CALLEE+3(4),TEMP02+6 CONVERT TO CHARACTER STRING 00752000 SPACE 00753000 SPACE 1 00754000 * WE MUST NOW SEARCH FOR THE ROUTINE CORRESPONDING TO THE OS SVC. 00755000 * THERE ARE TWO TABLES WHICH MUST BE SEARCHED. FIRST, IF THE USER HAS 00756000 * SPECIFIED ANY SVC HANDLERS, THEN WE MUST SEARCH HIS TABLE. SECOND, 00757000 * IF THAT SEARCH FAILS, THEN WE MUST SEARCH THE SYSTEM TABLE OF OS 00758000 * SVC ROUTINES. 00759000 OSS0 LA R14,4 TABLE ENTRY SIZE @V305001 00760000 L R1,JFIRST POINT TO FIRST USER ENTRY 00761000 L R15,JLAST POINT TO LAST USER ENTRY 00762000 LTR R1,R1 ARE THERE ANY USER ENTRIES? 00763000 BZ OSSEARCH SKIP SEARCH IF NOT @V305665 00764000 BAL RR,OSSUB SEARCH THE TABLE 00765000 B UOSFOUND GO IF SEARCH WAS SUCCESSFUL 00766000 B OSSEARCH GO IF SEARCH WAS UNSUCCESSFUL@V305665 00767000 EJECT 00768000 * OSSUB SUBROUTINE. THIS SUBROUTINE SEARCHES A TABLE FOR THE GIVEN 00769000 * SVC NUMBER. 00770000 OSSUB EQU * 00771000 EX XR,OSCLI IS THIS THE CORRECT ENTRY 00772000 BCR 8,RR (BE 0(RR)) RETURN TO CALLER IF FOUND 00773000 BXLE R1,R14,OSSUB GO NEXT TABLE ENTRY, AND LOOP 00774000 B 4(,RR) ERROR RETURN TO CALLER 00775000 SPACE 00776000 OSCLI CLI 0(R1),*-* 00777000 EJECT 00778000 * COME HERE IF THE TABLE ENTRY FOR THE OS SVC HAS BEEN FOUND. 00779000 UOSFOUND EQU * 00780000 OI TYPFLAG,TPFUSR SET 'USER-ROUTINE' FLAG 00781000 L R15,0(,R1) GET TABLE ENTRY FOR SVC NUMBER 00782000 LA R14,0(,R15) CLEAR HIGH BYTE TO GET ADDRESS 00783000 B OSF2 @V305665 00784000 SPACE 2 00785000 * CHECK IF THE DOSSVC FLAG IS ON. IF ON, GET THE ADDRESS OF 00786000 * THE CMSDOS SEGMENT IN R15 AND GO TO COMMON OS/DOS CODE 00787000 * IF THE DCSS IS AVAILABLE, THEN USE IT. IF NOT, THEN GO 00788000 * CHECK FOR TEXT DECK FORMAT. 00789000 OSSEARCH EQU * @V305665 00790000 TM DOSFLAGS,DOSSVC IS DOS SVC FLAG ON @VA06031 00791000 BNO NOTDOS NO, HANDLE AS OS @VA06031 00792000 L R15,ADOSDCSS GET DOS SEGMENT ADDR @VA06031 00793000 B OSF2 BRANCH TO COMMON CODE @VA06031 00794000 NOTDOS EQU * @VA06031 00795000 SLL XR,THREEBYT SHIFT SVC NUMBER @V305665 00796000 TM DCSSFLAG,DCSSAVAL IS DCSS AVAILABLE? @V305665 00797000 BZ CHKMODUL BRANCH IF NOT @V305665 00798000 TM DCSSFLAG,DCSSLDED HAS IT BEEN LOADED? @V305665 00799000 BO OSF1 BRANCH IF YES @V305665 00800000 B LOADSYS OTHERWISE GO LOAD IT @V305665 00801000 CHKMODUL EQU * @V305665 00802000 L R15,AOSMODL GET ADDRESS OF MODULE @V305665 00803000 TM DCSSFLAG,DCSSVTLD HAS IT BEEN LOADED? @V305665 00804000 BO OSF11 BRANCH IF YES @V305665 00805000 B NOOS IF NOT, IT SHOULD HAVE BEEN @V305614 00806000 SPACE 1 00807000 * IF THE DCSS IS AVAILABLE, THEN ISSUE A LOADSYS FOR 00808000 * THE DCSS. 00809000 LOADSYS EQU * @V305665 00810000 L R1,ASYSNAMS POINT TO SYSNAMES TABLE @V305665 00811000 USING SYSNAMES,R1 @V305665 00812000 LA R1,CMSSEG GET ADDRESS OF NAMED SYSTEM @V305665 00813000 DROP R1 @V305665 00814000 SR R2,R2 CLEAR R2 @V305665 00815000 DC X'83120064' ISSUE LOADSYS DIAGNOSE @V305665 00816000 BNZ PAGERR BRANCH IF PAGING ERROR @V305665 00817000 ST R1,ACMSSEG SAVE LOADED ADDRESS @V305665 00818000 OI DCSSFLAG,DCSSLDED INDICATE LOADED @V305665 00819000 SPACE 2 00820000 OSF1 EQU * @V305665 00821000 L R15,ACMSSEG GET ADDRESS OF DCSS @V305665 00822000 L R15,0(,R15) GET ADDRESS OF SVT @V305665 00823000 OSF11 EQU * @V305665 00824000 AR R15,XR ADD SVC NUMBER @V305665 00825000 OI SFLAG,SFSYS SET SYSTEM FLAG @V305665 00826000 SPACE 00827000 * WHEN CONTROL REACHES THIS POINT, R15 CONTAINS THE SVC NUMBER IN THE 00828000 * HIGH BYTE OF REGISTER 15, AND THE LOW-ORDER BYTES CONTAIN THE ADDRESS 00829000 * OF THE ROUTINE TO BE BRANCHED, WHETHER IT IS IN THE TRANSIENT AREA, 00830000 * OR NUCLEUS RESIDENT. 00831000 OSF2 EQU * 00832000 XC ITSPSW(8),ITSPSW START WITH ZERO PSW 00833000 LR XR,R15 SAVE STARTING ADDR IN XR 00834000 LA R15,0(,R15) CLEAR HIGH-ORDER BYTE 00835000 ST R15,ITSPSW+4 AND STORE ADDR IN STARTUP PSW 00836000 TM TYPFLAG,TPFUSR IS THIS A 'USER' ROUTINE? 00837000 BZ OSF3 SKIP IF NOT 00838000 MVI ITSPSW,ON TURN ON SYSTEM MASK 00839000 TM PROTFLAG,PRFPOFF NUCLEUS PROTECTION TURNED OFF? 00840000 BO OSF3 SKIP IF IT WAS 00841000 OI ITSPSW+1,USERKEY TURN ON USER KEY 00842000 SPACE 00843000 OSF3 EQU * 00844000 TM OVSTAT,OVSON SVCTRACE IN EFFECT? 00845000 BZ *+8 SKIP IF NOT 00846000 BAL RR,BOVR CALL OVERRIDE ROUTINE 00847000 LR R12,XR R12 = BASE REGISTER FOR CALLEE 00848000 LA R14,OSRET POINT TO RETURN ADDRESS FOR USER 00849000 CLI SVCOPSW+3,S203 IS THIS AN SVC 203? @V305665 00850000 BNE NOSVC203 BRANCH IF NOT @V305665 00851000 LA R14,CMSRET SET RETURN ADDRESS @V305665 00852000 NOSVC203 EQU * @V305665 00853000 ST R14,ITS14 AND PASS THAT IN REG 14 00854000 MVC ITS15(4),EGPR15 PASS CALLER'S 15 IN REG 15 00855000 LA R14,LPSW POINT TO STARTUP ROUTINE 00856000 L R13,USAVEPTR POINT TO USER SAVE AREA 00857000 LM R0,R11,EGPRS RESTORE CALLER'S REG 0-11 00858000 BR R14 TRANSFER TO STARTUP ROUTINE 00859000 SPACE 00860000 * WE HAVE TRANSFERRED WITH THE REGISTERS AS FOLLOWS: 00861000 * R0-R11, R15 ARE THOSE OF THE CALLER 00862000 * R12 = AL1(SVC-NUMBER),AL3(ADDR OF CALLEE) 00863000 * R13 = ADDRESS OF USER SAVE AREA 00864000 * R14 = RETURN ADDRESS TO DMSITS 00865000 *********************************************************************** 00866000 * 00867000 * COMING BACK FROM OS SVC ROUTINE. 00868000 * 00869000 *********************************************************************** 00870000 * 00871000 DMSITSOR EQU * 00872000 OSRET EQU * 00873000 SPACE 00874000 * THE FOLLOWING SVC CALL WILL BE RECOGNIZED ABOVE AT THE DMSITS ENTRY 00875000 * AS BEING WITHIN THIS ROUTINE, AND WILL CAUSE THE PSW TO BE RESET 00876000 * TO HAVE SYSTEM MASK OFF, PROBLEM BIT OFF, AND ZERO STORAGE 00877000 * PROTECTION KEY. 00878000 * ALSO, AT RETURN, REGS 11-13 WILL BE AT LOCATION RET 00879000 SVC 201 00880000 BALR R13,0 ESTABLISH ADDRESSABILITY 00881000 USING *,R13 00882000 L SVCR,ASVCSECT NOTE SVCR = R12 00883000 STM R0,R15,RGPRS SAVE REGS IN SVCSECT 00884000 MVC RGPR11(4*3),RET COPY REGS FROM LOW CORE 00885000 LM BR,BR2,=A(DMSITS,DMSITS+4096) SET UP REAL BASE REGS 00886000 DROP R13 AND DROP THE TEMPORARY ONE 00887000 L SR,CURRSAVE GET THE CURRENT SAVE AREA 00888000 L FVR,AFVS POINT TO FVSECT 00889000 OI UFDBUSY,ITSBIT INDICATE SVC HANDLER IS BUSY 00890000 SPACE 00891000 * THE FIRST TWO WORDS OF SVCSAVE WILL CONTAIN THE PSW USED TO RETURN 00892000 * TO THE GUY WHO CALLED THE SVC IN THE FIRST PLACE. 00893000 MVC SVCSAVE(8),OLDPSW SET RETURN PSW 00894000 MVC RET(8),SVCSAVE COPY RETURN PSW INTO LOW CORE 00895000 TM PROTFLAG,PRFPOFF NUCLEUS PROTECTION TURNED OFF? 00896000 BZ OSCMSRET SKIP IF NOT @VA06037 00897000 NI RET+1,X'0F' FORCE PSW KEY TO 0 00898000 B OSCMSRET @VA06037 00899000 EJECT 00900000 * RETURN FROM SVC 202 OR SVC 203 00901000 DMSITSCR EQU * 00902000 CMSRET EQU * 00903000 SPACE 00904000 * SEE THE NOTE AT OSRET FOR THE MEANING OF THE FOLLOWING SVC 201. 00905000 SVC 201 GET ZERO PROTECT KEY 00906000 BALR R13,0 ESTABLISH ADDRESSABILITY 00907000 USING *,R13 00908000 L SVCR,ASVCSECT NOTE SVCR=R12 00909000 STM R0,R15,RGPRS STORE REGS IN SVCSECT 00910000 MVC RGPR11(4*3),RET COPY REGS FROM LOW CORE 00911000 LM BR,BR2,=A(DMSITS,DMSITS+4096) SET REAL BASE REGS 00912000 DROP R13 AND DROP THE TEMPORARY ONE 00913000 L SR,CURRSAVE POINT TO CURRENT SAVE AREA 00914000 L FVR,AFVS POINT TO FVSECT 00915000 OI UFDBUSY,ITSBIT INDICATE SVC HANDLER IS BUSY 00916000 SPACE 00917000 * IF THE R01 FLAG HAS BEEN SET IN THE SAVE AREA, THEN THIS 00918000 * SVC CALL CHANGES REGISTERS 0 AND 1 TO THE VALUES RETURNED BY THE 00919000 * CALLEE. 00920000 TM TYPFLAG,TPFR01 RETURN CALLEE'S R0-R1? 00921000 BZ *+8 SKIP IF NOT 00922000 STM R0,R1,EGPRS STORE IN RETURN AREA 00923000 SPACE 00924000 ST R15,EGPR15 STORE R15 IN RETURN AREA 00925000 SPACE 00926000 * THE FIRST TWO WORDS OF SVCSAVE WILL CONTAIN THE RETURN PSW. 00927000 * WE MUST SET THE ADDRESS FIELD, DEPENDING ON WHETHER THERE WAS 00928000 * AN ERROR OR NORMAL RETURN FROM THE SVC HANDLER. 00929000 MVC SVCSAVE(8),OLDPSW SET FIRST TO OLDPSW 00930000 MVC SVCSAVE+5(3),NRMRET+1 SET TO NORMAL RETURN ADDR 00931000 TM PROTFLAG,PRFPOFF NUCLEUS PROTECTION TURNED OFF? 00932000 BZ *+8 SKIP IF NOT 00933000 NI SVCSAVE+1,X'0F' FORCE PSW KEY TO ZERO 00934000 LTR R15,R15 BUT WAS THERE AN ERROR RETURN? 00935000 BZ CRN GO IF THERE WAS NOT 00936000 TM TYPFLAG,TPFERT WAS HE EXPECTING AN ERROR RET? 00937000 BNZ *+8 SKIP IF SO 00938000 BAL RR,UNEXERR NOPE -- DUMP HIM OFF 00939000 MVC SVCSAVE+5(3),ERRET+1 COPY ERROR RETURN TO PSW 00940000 SPACE 00941000 CRN EQU * 00942000 MVC RET(8),SVCSAVE COPY RETURN PSW TO LOW CORE 00943000 OSCMSRET EQU * @VA06037 00944000 TM OVSTAT,OVSON SVCTRACE IN EFFECT ? @VA06037 00945000 BZ *+8 SKIP IF NOT @VA06037 00946000 BAL RR,AOVR CALL OVERRIDE ROUTINE @VA06037 00947000 MVC GPRLOG(4*16),EGPRS MOVE REGS TO A SAFE PLACE @VA06037 00948000 BAL RR,UNSTACK UNSTACK SAVE AREA 00949000 SPACE 00950000 * FOR RETURN FROM A CMS SVC, WE SET REGS R0 THRU R14 TO THEIR VALUES 00951000 * AT ENTRY, BUT WE SET REG 15 TO THE VALUE RETURNED BY THE SVC HANDLER. 00952000 MVC ITS14(8),GPRLOG+4*14 COPY CORRECT REG 14 & 15 @VA06037 00953000 LA R14,LPSW POINT TO STARTUP ROUTINE @VA06037 00954000 LM R0,R13,GPRLOG RESTORE REGS 0-13 @VA06037 00955000 BR R14 BRANCH TO STARTUP ROUTINE 00956000 * UNSTACK SUBROUTINE -- UNSTACK A SAVE AREA 00957000 UNSTACK EQU * 00958000 SPACE 00959000 * FIRST, CHECK TO SEE IF THE SYSTEM SAVE AREA WAS CLOBBERED. 00960000 CLC CHKWRD1,=C'ABCD' 00961000 BNE ERCLOB 00962000 CLC CHKWRD2,=C'EFGH' 00963000 BNE ERCLOB 00964000 SPACE 00965000 * CHECK TO SEE WHETHER KEY STACK IS EMPTY 00966000 CLI KEYP,0 ANYTHING IN KEY STACK? 00967000 BNE KEYNR ERROR IF THERE IS 00968000 KEYNRRET EQU * 00969000 SPACE 00970000 L R1,DEPTH DECREMENT SVC DEPTH 00971000 BCTR R1,0 00972000 ST R1,DEPTH AND STORE NEW VALUE 00973000 LDM F0,F6,EFPRS RESTORE FLOAT REGS 00974000 TM TYPFLAG,TPFNS NO SAVE AREA ALLOCATED? 00975000 BO UNSTACKN GO HANDLE THIS CASE 00976000 SPACE 00977000 MVC CURRSAVE,SSAVEPRV COPY ADDR OF PREVIOUS SAVE AREA 00978000 MVC CURRALOC,CURRSAVE AND ALSO TO CURRENT ALLOC 00979000 LTR R1,R1 DOES DEPTH = 0? 00980000 BCR 7,RR (BNZ 0(RR)) RETURN IF NOT 00981000 SPACE 00982000 * OTHERWISE, FREE ALL SAVE AREAS 00983000 ST SR,CURRALOC SAVE SR TEMPORARILY 00984000 L SR,LASTALOC GET LAST ALLOCATED SAVE AREA 00985000 SPACE 00986000 * COME HERE TO FREE FIRST (NEXT) SAVE AREA. 00987000 UNSLOOP EQU * 00988000 L R1,USAVEPTR POINT TO USER SAVE AREA 00989000 LTR R1,R1 IS THERE A USER SAVE AREA? @VA04752 00990000 BZ NOUSR BRANCH IF NOT @VA04752 00991000 DMSFRET DWORDS=USAVESZ,LOC=(1),TYPCALL=BALR,ERR=ERCLOB 00992000 NOUSR EQU * @VA04752 00993000 LR R1,SR POINT TO SYSTEM SAVE AREA 00994000 L SR,SSAVEPRV SR -> PRECEDING AREA IN CHAIN 00995000 DMSFRET DWORDS=SSAVESZ,LOC=(1),ERR=ERCLOB,TYPCALL=BALR 00996000 LTR SR,SR IS THERE A PREVIOUS ONE? 00997000 BNZ UNSLOOP LOOP BACK IF THERE IS 00998000 L SR,CURRALOC RESET SR 00999000 SR R1,R1 01000000 ST R1,CURRALOC ZERO OUT CURRALOC 01001000 ST R1,CURRSAVE ZERO OUT CURRSAVE 01002000 ST R1,LASTALOC ZERO OUT LASTALOC 01003000 BR RR RETURN TO CALLER 01004000 SPACE 01005000 * SOME SVC CALLS USE 'NRMSAV' AS THE SAVE AREA TO SAVE TIME. 01006000 * COME HERE TO HANDLE THEM. 01007000 UNSTACKN EQU * 01008000 MVC CURRSAVE,CURRALOC COPY CURRENT ALLOCATION TO *01009000 CURRENT SAVE AREA 01010000 NI TYPFLAG,X'FF'-TPFNS TURN OFF FLAG 01011000 BR RR RETURN TO CALLER 01012000 * LPSW ROUTINE. WHEN CONTROL TRANSFERS HERE, THE FOLLOWING IS SET: 01013000 * ITSPSW CONTAINS THE PSW WHICH WE ARE ABOUT TO LOAD 01014000 * REGS 0-13 CONTAIN THE VALUES TO BE PASSED 01015000 * ITS14, ITS15 CONTAIN REGS 14-15 TO BE PASSED 01016000 * REG 14 CONTAINS ADDRESS OF 'LPSW' ROUTINE 01017000 SPACE 01018000 * NOTE: POINT OF CONFUSION: THE SYMBOL 'RET' AND 'ITSPSW' REFER TO 01019000 * THE SAME AREA OF LOW CORE. SOME DAY, SOMEONE SHOULD GO THROUGH 01020000 * AND REMOVE ALL REFERENCES TO 'RET'. 01021000 SPACE 01022000 LPSW EQU * 01023000 USING *,R14 01024000 L R15,ASVCSECT POINT TO SVCSECT 01025000 USING SVCSECT,R15 01026000 LH R15,SVCAB GET ABEND CODE, IF ANY 01027000 LTR R15,R15 ANY ABEND CODE? 01028000 BNZ LPSWAB GO ABEND, IF SO 01029000 L R15,CURRSAVE POINT TO CURRENT SAVE AREA 01030000 USING SSAVE,R15 01031000 LTR R15,R15 DO WE HAVE A CURRENT SAVE AREA? @VA12351 01031300 BZ LPSWHX NO - GO TEST KX @VA12351 01031600 TM TYPFLAG,TPFNS USING NORMAL SAVE AREA? 01032000 BO LPSWGO DON'T TEST 'KX' IF SO 01033000 LPSWHX EQU * @VA12351 01033300 DROP R15 @VA12351 01033600 L R15,AFVS POINT TO FVSECT 01034000 USING FVSECT,R15 01035000 NI KXFLAG,X'FF'-KXWSVC TURN OFF 'WAIT FOR SVC' FLAG, *01036000 IF IT'S ON 01037000 NI UFDBUSY,X'FF'-ITSBIT CLEAR DMSITS HOLD BIT 01038000 BNZ LPSWGO IF NON-ZERO, THEN NO 'KX' 01039000 CLI KXFLAG,KXWANT DO WE WANT A KX? 01040000 BNE LPSWGO GO IF NOT 01041000 SPACE 01042000 * OTHERWISE, WE HAVE A 'KX'. WE MUST ABEND, WITH CODE X'222'. 01043000 LA R15,X'222' ABEND CODE 01044000 TM TSOFLAGS,TSOATCNL WAS READ CANCELLED BY ATTN? @VA02650 01045000 BZ LPSWAB NO @VA02650 01046000 NI TSOFLAGS,255-TSOATCNL RESET READ CANCELLED FLAG @VA02650 01047000 SPACE 01048000 LPSWAB EQU * 01049000 STH R15,ITSPSW+2 STORE ABEND CODE INTO PSW 01050000 L R15,AFVS POINT TO FVSECT 01051000 USING FVSECT,R15 01052000 NI UFDBUSY,X'FF'-ITSBIT TURN OFF DMSITS BUSY BIT 01053000 L R15,=V(DMSABW) POINT TO DMSABN WORK AREA 01054000 USING ABWSECT,R15 01055000 MVC ABNPSW,ITSPSW COPY OVER PSW TO DMSABN AREA 01056000 STM R0,R13,ABNREGS STORE REGISTERS IN DMSABN AREA 01057000 MVC ABNREGS+4*R14(8),ITS14 SET REGS 14 AND 15 01058000 LH R0,ABNPSW+2 RECOVER ABEND CODE 01059000 L SVCR,ASVCSECT POINT TO SVCSECT 01060000 XC SVCAB,SVCAB TURN OFF ABEND CODE 01061000 L R15,=V(DMSABNGO) POINT TO DMSABN ENTRY 01062000 BR R15 AND GO THERE 01063000 SPACE 01064000 * START THE USER UP 01065000 LPSWGO EQU * 01066000 CLI SVCOPSW+3,201 V0211 01067000 BE NOSHORT V0211 01068000 CLC ITSPSW(2),=X'0000' V0211 01069000 LM R14,R15,ITS14 SET REGS 14 15 V0211 01070000 BCR 8,R12 V0211 01071000 NOSHORT LM R14,R15,ITS14 SET REGS V0211 01072000 LPSW ITSPSW LOAD STARTUP PSW 01073000 DROP R14,R15 01074000 SPACE 1 01075000 LTORG @V305665 01076000 DS 0H @V305665 01077000 * ROUTINE TO ABEND WHILE IN SVC ENTRY CODE. 01078000 EABEND EQU * 01079000 L R15,=V(DMSABW) POINT TO DMSABN WORK AREA 01080000 USING ABWSECT,R15 01081000 MVC ABNPSW,SVCOPSW COPY OLD PSW INTO WORK AREA 01082000 STH R0,ABNPSW+2 PUT ABEND CODE INTO PSW 01083000 MVC ABNREGS(4*16),EGPRS COPY ENTRY REGISTERS 01084000 LTR R4,R4 IS THERE A SYSTEM SAVE AREA? @VA04752 01085000 BZ NOSAVE BRANCH IF NOT @VA04752 01086000 LR XR,R0 SAVE ABEND CODE 01087000 BAL RR,UNSTACK UNSTACK SAVE AREA, IF ALLOCATED 01088000 LR R0,XR PUT ABEND CODE INTO R0 01089000 NOSAVE EQU * @VA04752 01090000 NI UFDBUSY,X'FF'-ITSBIT TURN OFF DMSITS BUSY BIT 01091000 L R15,=V(DMSABNGO) POINT TO DMSABN ENTRY 01092000 BR R15 AND GO THERE 01093000 DROP R15 01094000 * HANDLE 'BEFORE' OVERRIDES 01095000 BOVR EQU * 01096000 NI OVSTAT,X'FF'-OVSAFT TURN OFF 'AFTER' FLAG, FOR BEFOR 01097000 B OVRC GO TO COMMON CODE 01098000 SPACE 01099000 * HANDLE 'AFTER' OVERRIDES 01100000 AOVR EQU * 01101000 OI OVSTAT,OVSAFT TURN ON 'AFTER' FLAG 01102000 SPACE 2 01103000 * COMMON OVERRIDE HANDLING CODE 01104000 OVRC EQU * 01105000 L R15,ADMSOVS GET ADDRESS OF OVERRIDE SUBR 01106000 LTR R15,R15 IS THERE ANY? 01107000 BNZ OVRGO GO CALL ROUTINE IF NOT 01108000 NI OVSTAT,X'FF'-OVSON TURN OFF OVERRIDE FLAG 01109000 BR RR RETURN TO CALLER 01110000 SPACE 01111000 USING OVSECT,R15 01112000 SPACE 01113000 * NOTE -- OVSECT IS A MACRO DESCRIBING THE FIRST FEW WORDS OF THE 01114000 * DMSOVS ROUTINE. 01115000 OVRGO EQU * 01116000 MVC AERR,=V(DMSERR) PASS ADDRESS OF DMSERR 01117000 MVC AWAIT,=V(DMSCWT) PASS ADDRESS OF CONWAIT 01118000 BALR R14,R15 CALL OVERRIDE ROUTINE 01119000 DROP R15 01120000 BR RR RETURN TO CALLER 01121000 SPACE 01122000 * FOR 'JUMP' RETURN -- 4(R14) -- WE RELEASE THE OVERRIDE ROUTINE. 01123000 DC H'0' HALFWORD PAD 01124000 STM R0,R1,SVCSAVE+32 SAVE REGS 0-1 TEMPORARILY 01125000 L R1,ADMSOVS POINT TO OVERRIDE ROUTINE 01126000 USING OVSECT,R1 01127000 L R0,LENOVS GET LENGTH OF OVERRIDE ROUTINE 01128000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR RELEASE STORAGE 01129000 DROP R1 01130000 MVC ADMSOVS,=F'0' ZERO OUT THE ROUTINE POINTER 01131000 LM R0,R1,SVCSAVE+32 RESTORE REGS 0-1 01132000 BR RR RETURN TO CALLER 01133000 * DMSITS RE-INITIALIZATION ROUTINE. THIS ROUTINE IS CALLED BY 01134000 * DMSABN, THE ABEND RECOVERY ROUTINE, TO CLEAR ALL PENDING SVC CALLS 01135000 * SO THAT OPERATION OF CMS CAN CONTINUE WITH A CLEAN SLATE. 01136000 USING *,R15 01137000 DMSITSR EQU * 01138000 SPACE 01139000 * DMSABN WILL NOT ASSUME ANYTHING ABOUT THE REGISTERS WE RETURN. 01140000 * THUS, WE NEEDN'T SAVE THEM ANYWHERE. 01141000 LR XR,R14 SAVE RETURN REGISTER 01142000 LM BR,BR2,=A(DMSITS,DMSITS+4096) SET BASE REGS 01143000 DROP R15 01144000 L SVCR,ASVCSECT 01145000 NI SFLAG,X'FF'-SFREN TURN OFF RE-ENTRY FLAG 01146000 XC DEPTH,DEPTH ZERO OUT DEPTH FIELD 01147000 L SR,LASTALOC GET POINTER TO LAST ALLOCATED *01148000 SYSTEM SAVE AREA 01149000 XC CURRALOC,CURRALOC ZERO OUT POINTER 01150000 XC CURRSAVE,CURRSAVE NO MORE CURRENT SAVE AREA 01151000 XC NRMSAV(4),NRMSAV ZERO OUT FLAG BYTES IN NRMSAV 01152000 SPACE 01153000 * ZERO OUT USER-HANDLED SVC TABLE POINTERS 01154000 XC JNUMB,JNUMB 01155000 XC JFIRST,JFIRST 01156000 XC JLAST,JLAST 01157000 SPACE 01158000 * THE FOLLOWING LOOP RELEASES ALL THE SYSTEM SAVE AREAS. 01159000 * NOTE THAT THE CORRESPONDING USER SAVE AREAS WILL BE FREED 01160000 * AUTOMATICALLY WHEN DMSABN FREES ALL USER STORAGE. 01161000 RECLOOP EQU * 01162000 LTR R1,SR IS THERE A(NOTHER) SAVE AREA? 01163000 BZ RECRET GO IF NOT 01164000 L SR,SSAVEPRV SAVE POINTER TO PREVIOUS SAVE *01165000 AREA 01166000 DMSFRET DWORDS=SSAVESZ,LOC=(1),TYPCALL=BALR RELEASE THIS ONE 01167000 B RECLOOP LOOP BACK FOR NEXT 01168000 SPACE 01169000 RECRET EQU * 01170000 LR R14,XR RESTORE ADDR OF CALLER 01171000 BR R14 AND RETURN TO HIM 01172000 DMSITSK EQU * 01173000 * THE ONLY REGISTER WE HAVE TO SET IS: R12 = SVCR 01174000 L SVCR,ASVCSECT 01175000 SPACE 01176000 * WE MUST DECIDE WHICH 'DMSKEY' OPTION WAS SPECIFIED. 01177000 TM CODE203,KFN NUCLEUS? 01178000 BO KN GO IF YES 01179000 TM CODE203,KFR RESET? 01180000 BO KR 01181000 TM CODE203,KFU USER? 01182000 BO KU 01183000 TM CODE203,KFL LASTUSER? 01184000 BO KL 01185000 B NO203 GO TYPE ERROR MESSAGE 01186000 SPACE 3 01187000 * DMSKEY NUCLEUS 01188000 KN EQU * 01189000 TM CODE203,KFNS 'NOSTACK' SPECIFIED? 01190000 BO *+8 SKIP IF YES 01191000 BAL RR,KSTACK OTHERWISE, GO STACK CURRENT KEY 01192000 NI OLDPSW+1,X'0F' FORCE ZERO PROTECT KEY 01193000 SR R15,R15 ZERO RETURN CODE 01194000 B CMSRET RETURN TO CALLER 01195000 SPACE 3 01196000 * DMSKEY USER 01197000 KU EQU * 01198000 TM CODE203,KFNS 'NOSTACK' SPECIFIED? 01199000 BO *+8 SKIP IF YES 01200000 BAL RR,KSTACK OTHERWISE, GO STACK PROTECT KEY 01201000 NI OLDPSW+1,X'0F' ZERO OUT PSW KEY FIELD 01202000 OI OLDPSW+1,USERKEY INSERT USER KEY 01203000 SR R15,R15 ZERO RETURN CODE 01204000 B CMSRET RETURN TO CALLER 01205000 SPACE 3 01206000 * DMSKEY LASTUSER 01207000 KL EQU * 01208000 TM CODE203,KFNS 'NOSTACK' OPTION SPECIFIED? 01209000 BO *+8 SKIP IF YES 01210000 BAL RR,KSTACK OTHERWISE, GO STACK PROTECT KEY 01211000 LA R0,USERKEY DEFAULT VALUE OF KEY 01212000 L R1,CURRALOC POINT TO LAST ALLOCATED SAVEAREA 01213000 USE SSAVE,R1 USE R1 AS SSAVE POINTER 01214000 SPACE 01215000 * LOOP BACK HERE TO CHECK WHETHER NEXT SAVE AREA WAS FOR A 'USER' 01216000 * ROUTINE. 01217000 KLL EQU * 01218000 L R1,SSAVEPRV POINT TO PREVIOUS SAVE AREA 01219000 LTR R1,R1 WAS THERE ONE? 01220000 BZ KLF USE DEFAULT IF NOT 01221000 TM TYPFLAG,TPFUSR IS THIS A USER SAVE AREA 01222000 BZ KLL LOOP BACK IF NOT 01223000 SPACE 01224000 * OTHERWISE, WE HAVE FOUND THE LAST SVC CALL CALLED FROM A USER 01225000 * ROUTINE. WE LOOK AT THE PROTECT KEY IN THE OLDPSW OF THE FOLLOWING 01226000 * SSAVE AREA. 01227000 L R1,SSAVENXT POINT TO NEXT SAVE AREA 01228000 IC R0,OLDPSW+1 GET THE PROTECT KEY 01229000 SPACE 01230000 USE SSAVE,SR WE'RE THROUGH WITH R1 01231000 SPACE 01232000 * AT THIS POINT, R0 CONTAINS THE CORRECT PROTECT KEY. 01233000 KLF EQU * 01234000 NI OLDPSW+1,X'0F' ZERO OUT PROTECTION KEY 01235000 N R0,=AL1(0,0,0,X'F0') ZERO OUT SECOND NIBBLE 01236000 IC R1,OLDPSW+1 GET CORRECT SECOND NIBBLE 01237000 OR R0,R1 OR THE NIBBLES INTO A BYTE 01238000 STC R0,OLDPSW+1 AND STORE IN RETURN PSW 01239000 SR R15,R15 ZERO RETURN CODE 01240000 B CMSRET 01241000 SPACE 3 01242000 * DMSKEY RESET 01243000 KR EQU * 01244000 L R15,CURRALOC POINT TO LAST ALLOCATED SAVEAREA 01245000 USE SSAVE,R15 01246000 LTR R15,R15 ANY SAVE AREA ALLOCATED? 01247000 BZ KRR SIMPLY RETURN IF NOT 01248000 CLI KEYP,0 IS THE STACK EMPTY? 01249000 BE KEYUNDER UNDERFLOW IF IT IS 01250000 SLR R1,R1 01251000 IC R1,KEYP GET STACK SIZE 01252000 IC R0,KEYS(R1) GET TOP OF STACK 01253000 BCTR R1,0 DECREMENT STACK SIZE 01254000 STC R1,KEYP AND STORE 01255000 SPACE 01256000 USE SSAVE,SR USING SR AGAIN 01257000 STC R0,OLDPSW+1 RESET RETURN PSW 01258000 SPACE 01259000 * RETURN 01260000 KRR EQU * 01261000 SR R15,R15 ZERO RETURN CODE 01262000 B CMSRET RETURN TO CALLER 01263000 SPACE 3 01264000 * SUBROUTINE TO PUT ONE PSW KEY ONTO THE STACK. 01265000 KSTACK EQU * 01266000 L R1,CURRALOC GET LAST ALLOCATED SAVE AREA 01267000 USE SSAVE,R1 USE R1 TEMPORARILY 01268000 LTR R1,R1 ANY SAVE AREA ALLOCATED? 01269000 BCR 8,RR (BZ 0(,RR)) SIMPLY RETURN IF NOT 01270000 CLI KEYP,KEYMAX IS THE STACK FULL ALREADY? 01271000 BNL KEYOVER ERROR IF SO 01272000 SR XR,XR 01273000 IC XR,KEYP GET STACK DEPTH 01274000 LA XR,1(,XR) INCREMENT 01275000 STC XR,KEYP 01276000 IC R0,SVCOPSW+1 GET OLD VALUE OF KEY 01277000 STC R0,KEYS(XR) SAVE IN STACK 01278000 BR RR RETURN TO CALLER 01279000 USE SSAVE,SR 01280000 SPACE 3 01281000 * CODE203 FLAG VALUES ASSOCIATED WITH 'DMSKEY'. 01282000 KFN EQU X'01' DMSKEY NUCLEUS 01283000 KFR EQU X'02' DMSKEY RESET 01284000 KFU EQU X'04' DMSKEY USER 01285000 KFL EQU X'08' DMSKEY LASTUSER 01286000 KFNS EQU X'40' DMSKEY XXX,NOSTACK 01287000 SPACE 01288000 USERKEY EQU X'E0' VALUE OF USER STORAGE KEY 01289000 * DMSEXS MACRO ENTRY POINT 01290000 DMSITSXS EQU * 01291000 MVC RET(2),=H'0' FORM PSW AT LOCATION RET 01292000 ST R1,RET+4 STORE BRANCH ADDRESS IN PSW 01293000 LA R1,CMSRET WHERE USER IS TO RETURN 01294000 L R0,EGPR0 RESTORE USER'S REG 0 01295000 LM R2,R15,EGPR2 RESTORE USER'S REGS 2-15 01296000 LPSW RET GO EXECUTION THE INSTRUCTION 01297000 FREEER EQU * 01298000 DMSERR NUM=154,LET=T,TYPCALL=BALR, *01299000 SUB=(HEXA,SVCOPSW+4), *01300000 TEXT='SAVE AREA FOR SVC CALL FROM ...... CANNOT BE ALLOC*01301000 ATED' 01302000 LA R0,X'0F0' LOAD ABEND CODE INTO R0 01303000 LTR R4,R4 IS THERE A SYSTEM SAVE AREA? @VA04752 01304000 BZ EABEND BRANCH IF NOT @VA04752 01305000 OI TYPFLAG,TPFNS SAVE AREA NOT ALLOCATED 01306000 B EABEND GO ABEND 01307000 SPACE 5 01308000 PAGERR EQU * @V305665 01309000 DMSERR LET=S,NUM=143,TYPCALL=BALR, @V305665X01310000 TEXT='UNABLE TO LOAD SAVED SYSTEM OR LOAD MODULE' 01311000 LA R0,HEXF9 @V305666 01312000 B EABEND @V305665 01313000 SPACE 5 01314000 * UNSUPPORTED SVC CALL 01315000 NOOS EQU * 01316000 DMSERR NUM=098,LET=S,TYPCALL=BALR,TEXT='CMS OS SIMULATION NOT X01317000 AVAILABLE' @VM03024 01318000 LA R0,X'0F9' SET ABEND CODE @VM03024 01319000 B EABEND AND PREPARE TO ABEND @VM03024 01320000 SPACE 5 01321000 * UNSUPPORTED SVC 203 CODE 01322000 NO203 EQU * 01323000 LH XR,NRMSAV+CODE-SSAVE GET SVC 203 HALFWORD CODE 01324000 DMSERR NUM=134,LET=S,TYPCALL=BALR, *01325000 MF=(E,'SYS'), *01326000 TEXT='UNSUPPORTED SVC 203 CODE ....., CALLED FROM ......*01327000 ', *01328000 SUB=(DEC,(XR),HEXA,SVCOPSW+4) 01329000 LA R0,X'0F1' LOAD ABEND CODE 01330000 B EABEND GO ABEND HIM 01331000 SPACE 5 01332000 * MAXIMUM DEPTH OF SVC CALLS WAS EXCEEDED. 01333000 ERDEEP EQU * 01334000 DMSERR NUM=135,LET=S,TYPCALL=BALR, *01335000 MF=(E,'SYS'), *01336000 TEXT='MAXIMUM SVC DEPTH .... HAS BEEN EXCEEDED WITH CALL*01337000 AT ......', *01338000 SUB=(DEC,MAXDEEP,HEXA,SVCOPSW+4) 01339000 LA R0,X'0F2' LOAD ABEND CODE 01340000 STH R0,SVCAB STORE IN WORK AREA 01341000 B ERDEEPRT AND CONTINUE PROCESSING 01342000 SPACE 01343000 SPACE 5 01344000 * UNEXPECTED ERROR RETURN FROM SVC CALL. 01345000 UNEXERR EQU * 01346000 LR XR,R15 COPY OVER ERROR RETURN CODE 01347000 DMSERR NUM=122,LET=S,TYPCALL=BALR, *01348000 MF=(E,'SYS'), *01349000 TEXT='ERROR IN CALL TO ........ FROM ......, ERROR CODE *01350000 .......... (HEX ........)', *01351000 SUB=(CHARA,CALLEE,HEXA,CALLER, *01352000 DEC,(XR),HEX,(XR)) 01353000 CLC SVCAB,=H'0' ARE WE ALREADY ABENDING? 01354000 BCR 7,RR (BNE 0(RR)) DON'T CHANGE ABEND CODE IF SO 01355000 LA R0,X'0F3' LOAD ABEND CODE 01356000 STH R0,SVCAB STORE IN WORK AREA 01357000 BR RR CONTINUE PROCESSING 01358000 SPACE 5 01359000 * ILLEGAL RE-ENTRY INTO INTSVC 01360000 ERREN EQU * 01361000 DMSERR NUM=136,LET=T,TYPCALL=BALR, *01362000 HALT=YES, *01363000 SUB=(HEXA,SVCOPSW+4), *01364000 TEXT='SVC CALL FROM ...... ILLEGALLY RE-ENTERS INTSVC. R*01365000 E-IPL CMS' 01366000 B ERREN IF HE TRIES TO RESTART 01367000 SPACE 5 01368000 * SVC ROUTINE CLOBBERED SYSTEM SAVE AREA 01369000 ERCLOB EQU * 01370000 DMSERR NUM=137,LET=T,TYPCALL=BALR, *01371000 MF=(E,'SYS'), *01372000 HALT=YES, *01373000 SUB=(CHARA,CALLEE,HEXA,OLDPSW+4), *01374000 TEXT='CALL TO ........ FROM ...... DESTROYED SYSTEM SAVE*01375000 AREA. RE-IPL CMS.' 01376000 B ERCLOB IF HE TRIES TO RESTART 01377000 SPACE 3 01378000 KEYOVER EQU * 01379000 DMSERR NUM=138,LET=T,TYPCALL=BALR, *01380000 MF=(E,'SYS'), *01381000 TEXT='''DMSKEY'' CALL FROM ...... OVERFLOWS KEY STACK, W*01382000 ITH MAX DEPTH ......', *01383000 SUB=(HEXA,SVCOPSW+4,DEC,KEYMAX) 01384000 LA R0,X'0F4' LOAD ABEND CODE 01385000 B EABEND GO ABEND HIM 01386000 SPACE 3 01387000 KEYUNDER EQU * 01388000 DMSERR NUM=139,LET=T,TYPCALL=BALR, *01389000 MF=(E,'SYS'), *01390000 TEXT='''DMSKEY RESET'' FROM ...... UNDERFLOWS KEY STACK'*01391000 ,SUB=(HEXA,SVCOPSW+4) 01392000 LA R0,X'0F5' LOAD ABEND CODE 01393000 B EABEND GO ABEND HIM 01394000 SPACE 3 01395000 KEYNR EQU * 01396000 DMSERR NUM=140,LET=T,TYPCALL=BALR, *01397000 MF=(E,'SYS'), *01398000 TEXT='........ ROUTINE CALLED FROM ...... DID DMSKEY WIT*01399000 H NO RESET', *01400000 SUB=(CHARA,CALLEE,HEXA,CALLER) 01401000 LA R0,X'0F6' LOAD ABEND CODE 01402000 STH R0,SVCAB STORE IN WORK AREA 01403000 B KEYNRRET AND CONTINUE PROCESSING 01404000 ********************************************************************* 01405000 * 01406000 * CONSTANTS & EQUATES 01407000 * 01408000 ********************************************************************* 01409000 TEXT01 DC C'SVC',X'4020212040' (FOR EDITING OS-SVC CALLEE)@VA14550 01410000 * 01411000 * 01412000 S203 EQU 203 @V305665 01413000 HEXF9 EQU X'F9' @V305666 01414000 OFF EQU X'00' SYSTEM MASK OFF = NO INTERRUPTS 01415000 ON EQU X'FF' SYSTEM MASK ON = ALL INTERRUPTS 01416000 ADDR EQU 8 ADDRESS-VECTOR IN FUNCTAB 01417000 FLAGS EQU 8 FLAG BYTE 01418000 NSF EQU X'80' NO SAVE AREA FLAG 01419000 R01 EQU X'40' RETURN REG 0-1 TO CALLER 01420000 NAME EQU 0 8-BYTE NAME OF CALLED-ROUTINE 01421000 SPACE 01422000 * KEEP THESE IN ORDER 01423000 ITSPSW EQU 0 STARTUP PSW 01424000 ITS14 EQU 8 STARTUP REG 14 01425000 ITS15 EQU 12 STARTUP REG 15 01426000 SPACE 01427000 * SOMEONE MUST GO THROUGH THE CODE SOME DAY AND REMOVE ALL REFERENCES 01428000 * TO RET. IN ADDITION, THE THREE ABOVE SYMBOLS OUGHT TO GO ELSEWHERE 01429000 * IN NUCON. 01430000 RET EQU ITSPSW 01431000 SPACE 01432000 MAXDEEP EQU 20 MAXIMUM SVC DEPTH 01433000 THREEBYT EQU 24 @V305665 01434000 MIN3 DC H'-3' @V305665 01435000 MIN16 DC H'-16' SVC 203 CODE FOR SPECIAL CALL @VM03048 01436000 EJECT 01437000 LTORG 01438000 ENDITS EQU * 01439000 EJECT 01440000 SVCSECT GENERATE DSECT 01441000 OVSECT 01442000 FSTB @V305665 01443000 SYSNAMES @V305665 01444000 FVS 01445000 NUCON 01446000 SVCSAVE 01447000 EQUATES 01448000 SPACE 1 01449000 DMSABW 01450000 END 01451000