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