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