*        704765   SIGMA 5/7         BPM M:ALTCP
         PCC      0
MONPROC  SET      1
UTSPROC  SET      1
         SYSTEM   UTS
         DEF      ALTCP
ALTCP    EQU      %
*
*                     ALTERNATE CAL PROCESSOR
*
CHKPT    SET      1                 TURN ON DEBUG/ASSOC-DISASSOC CALS
FRGRND   EQU      0
         PAGE
*                 SYMBOLIC REGISTER DEFINITIONS.
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8,SR1   EQU      8
R9,SR2   EQU      9
R10,SR3  EQU      10
R11,SR4  EQU      11
R12,D1   EQU      12
R13,D2   EQU      13
R14,D3   EQU      14
R15,D4   EQU      15
         PAGE
*                 PARAMETERS TO DEFINE BATCH MONITOR.
*                 DEFS AND REFS FOR OBJECT MODULE.
*
*                 DEFS.
         DEF      40TRAP
         DEF      CALCK
         DEF      OUT
         DEF      CC1SET
         DEF      CC0RST
         DEF      CC1RST
         DEF      CC2SET
         REF      S:RTCORE
         REF      PB:LCT
         REF      PB:PSZ
         REF      JB:PRIV
         REF      J:PLL
         REF      J:PUL
         REF      J:TCB
         REF      J:USENT
         REF      J:EXTENT
         REF      J:ALB
         REF      JB:STEPCC
         REF      SPDBASE
         REF      SPPBASE
         REF      S:CUN
         REF      T:ABORTM
         REF      T:ASSOCIATE#
         REF      T:CHTBL#
         REF      T:DISASSOCIATE#
         REF      T:EXIT
         REF      T:ERROR
         REF      STEPOVRSEG
         REF      T:FCP#,T:GCP#
         REF      T:FDP#,T:GDP#
         REF      T:FVP#,T:GVP#
         REF      T:GL#,T:SMP#
         REF      M24
         REF      T:INITJOB
         REF      T:PAC
         REF      T:RDERLOG#
         REF      T:SAD#
         REF      T:SAVEGET#
         REF      T:SSEM
         REF      RMAOVSEG
         REF      T:MODPRTRT#
         REF      T:MAP#
         REF      T:LOCK#
         REF      T:DOPEN#
         REF      T:DCLOSE#
         REF      T:BLIST#
         REF      M17
         DEF      CKLIMIT
        REF      T:UTSXTS
         REF      T:WAIT#
         REF      T:WTERLOG#
         REF      X1FFFE
         REF      T:IACU
         REF      LDLNKSEG
         REF      UH:FLG
         REF      T:ABORT
         REF      T:GDDL#
         REF      T:REG
         REF      PB:UC
         REF      UB:ASP
         REF      MSTIMER#
         REF      MTTIMER#
         REF      UB:DB
         REF      E:AP
         REF      RCVPSD
         REF      Y008
         REF      TEMP,MISOVSEG
         DEF      MSTRAPXIT
         REF      Y001,Y002,Y003,Y003E
         REF      T:ACCTEX
         REF      TRNC
         REF      M:XX
         REF      T:GBUF,T:RBUF
         REF      JBFBFP
         REF      XCONSETUP
         REF      TRAPPSD,ABORT,SCR61,YE
         REF      QUEUE,QUEUE1,NEWQ
*
*                 DEFS AND REFS FOR OBJECT MODULE.
*
*                 DEFS.
*
*                 REFS FOR CAL ROUTINES (MONITOR SERVICES)
          REF       DEBUGSEG
         REF      MSTRAP#
         REF      MTIME#,SEGLD#
         REF      MINT#
XFFDF    EQU      NB31TO0+6
XFFFE    EQU      NB31TO0+1
         REF      C:ETM,C:RT90,S:CUIS
         REF      TRAPEXIT
         REF      MXCON#
*                 REFS TO GENERAL DATA.
         REF      TRAPFLGB,JIT
         REF      M8,Y0001
         REF      Y4
         REF      Y004
         REF      MPPO
                  REF      J:DCBLINK
         REF      P:NAME,PB:LNK,T:PROCOV
                  REF      UB:APR
         REF      RTICBHDR,UH:FLG2
         SREF     RTALTCP,RTINTRTN
         DEF      RTCHK,RTERR
         DEF      MTRTN0
         PAGE
*        REAL-TIME DATA (CAL1,5)
*
SLAVECODE  EQU    7                 M:SLAVE FPT CODE
MASTERCODE EQU    8                 M:MASTER FPT CODE
         BOUND    8
MSCODES  DATA     SLAVECODE,MASTERCODE
OPCODES  EQU      X'10003'          MASK OF LEGAL EXU OPCODES
*
EXUCODE  EQU      X'28'             M:EXU FPT CODE
*
EXU:ERR1 DATA     X'010000B9'
EXU:ERR2 DATA     X'040000B9'
EXU:ERR3 DATA     X'050000B9'
*
         REF      XN2
Y01      EQU      BT31TO0+25
Y08      EQU      BT31TO0+28
*
RTERR    DATA     X'030000B8'       ABORT CODE: RESTRICTED MONITOR SERVICE
*                                   ATTEMPTED FOLLOWING M:HOLD CAL1
FLG:LIC  EQU      X'800'            UH:FLG2 MASK : LOCKED-IN-CORE BIT
TREEBAD  EQU      1
LIF      CNAME
         PROC
LF       LI,D4    AF(1)
         PEND
LI0      CNAME
         PROC
LF       LI,0     AF(1)
         PEND
         PAGE
CALCK    EQU      %
         AND,R6   M24
         CI,R3    HICAL
         BLE      C1TV,R3
*                 IF FALLS THROUGH, ABORT
C1TV     EQU      %
         B        BADCAL
         B        SCR7C             SCREECH .7C
         B        SCR7C             SCREECH .7C
         B        CAL13
         B        CAL14
         B        CAL15
         B        CAL16
         B        CAL17
         B        CAL18
HICAL    EQU      %-C1TV
*                 CAL1,9 PROCESSING
*
*                 INSTRUCTION FORMAT:
*
*                      GEN,8,4,3,1,8,8
*                          | | | | | |-- EXIT TYPE (IE., 1=M:EXIT ...)
*                          | | | | |---- STEP CC'S OR REAL-TIME INT.CODE
*                          | | | |------ PRESENCE BIT FOR CODES
*                          | | |-------- ALWAYS ZERO
*                          | |---------- 9 (IE., REG. FIELD)
*                          |------------ X'04' (IE., CAL1)
*
*                 R7 LOOKS AS FOLLOWS AT THIS POINT:
*
*                           GEN,15,1,16
*                                | |  |-- IF STEP CONDITION CODES WERE
*                                | |      SPECIFIED (IE., M:EXIT/ERR/
*                                | |      XXX):
*                                | |         ADR. WITHIN TSTACK WHICH
*                                | |         WHEN REDUCED BY THE CURRENT
*                                | |         VALUE AT TSTACK AND IN-
*                                | |         CREMENTED BY 15 WILL EQUAL
*                                | |         THE VALUE OF THE ADR. FIELD
*                                | |         +1 OF THE CAL1 (WHEW)
*                                | |      IF REAL TIME CODES WERE
*                                | |      SPECIFIED (IE., M:INTRTN):
*                                | |         THE IMAGE OF BITS 16-31 OF
*                                | |         THE CAL1 INSTRUCTION
*                                | |
*                                | |----- PRESENCE BIT:
*                                |           1  IF STEP CONDITION CODES
*                                |              OR REAL TIME CODES WERE
*                                |              SPECIFIED IN THE CAL1
*                                |           0  IF NOT SPECIFIED (THIS
*                                |              WOULD BE AN ERROR
*                                |              CONDITION FOR M:INTRTN
*                                |              SINCE THE PROC ALWAYS
*                                |              SETS THIS BIT
*                                |
*                                |------- ALWAYS ZERO
*
*
*
         LW,R4    R7                SAVE R7 FOR LATER USE
         CW,R7    Y0001             IS PRESENCE BIT SET?
         BANZ     CAL19MOD          YES; STEP CONDITION CODES OR REAL
*                                   TIME INTERRUPT CODES SPECIFIED
* TRY TO DIFFERENTIATE BETWEEN 1,2B,3B
         SW,R7    TSTACK
*        CAL1,9   EFFECTIVE ADDRESS DETERMINES THE ROUTINE
         AI,R7    15
         BLZ      SCCSTRP           NARROW DOWN LOOPHOLES
         INT,R7   R7
*
         CI,R7    16                POSSIBLE LOOP HOLES HERE
         BG       SCCSTRP
         CI,R7    0
         BE       SCCSTRP
         LW,R4    R7                SET UP FOR MTRTN
         CI,R7    NC19S+1
         BGE      C19TV
         EXU      C19TV-1,R7
MONOVLY  EQU      %
         LI,2     MISOVSEG
         B        T:OVERLAY
C19TV    EQU      %
         B        BADCAL
         B        EXITRAP
         B        ERRTRAP           M:ERR
         B        XXXTRAP           M:XXX
         LI0      MSTRAP#
         B        MTRTN
         B        CALMUL2           COOP SUPER CLOSE
         B        BADCAL            M:CLEAT
         B        BADCAL            M:TERM
         B        USERGO            M:EXEC
         B        BADCAL            M:INTRTN ILLEGAL WITH SCC BIT UNSET.
         B        MSTRUNC           M:STRUNC
NC19S    EQU      %-C19TV
         SPACE    2
INTRTN   EQU      %                 M:INTRTN (CAL1,9   X'A')
         LW,0     RTICBHDR          IS THIS A REAL TIME SYSTEM?
         BLZ      BADCAL            NO
         B        RTINTRTN          M:INTRTN ROUTINE IN RTROOT
         SPACE    2
USERGO   EQU      %                 M:EXEC (CAL1,9 9)
         LW,D1    J:RNST
         CW,D1    Y002              MUST BE A SHARED PROCESSOR.
         BAZ      BADCAL            ---> NOT.  ABORT.
         BAL,R3   T:ACCTEX          ACCUM PROC TIME; NEW QUANTUM.
         LW,D1    Y001
         LW,D2    Y003E
         STS,D1   J:RNST            Y001 MEANS USER NOT PROCESSOR.
         LW,R1    TSTACK
         LW,D1    SR1-15,R1         SR1 FROM USER IS
         LI,D2    X'1FFFF'           A NEW
         STS,D1   J:TCB             TCB ADDRESS.
         B        TRAPEXIT          ---> ALL DONE NOW.
         SPACE    2
MSTRUNC  EQU      %                 M:STRUNC (CAL1,9 X'B'
         LW,R7    J:DCBLINK
         BEZ      XXTRUNC           ---> NO DCBS.
DCBLOOP  LW,R3    1,R7              GET DCBNAME.
         BEZ      XXTRUNC           ---> NO MORE DCBS.
         SLS,R3   -10               # NAMEWORDS IN R3(0-15)
         AH,R7    R3                GET PAST NAME.
         LW,R6    2,R6              R6 = DCB ADDRESS.
         AI,R7    2
         BAL,R11  TRNC              M:TRUNC THE DCB.
         B        DCBLOOP           REPEAT.
XXTRUNC  EQU      %
         LI,R6    M:XX
         BAL,R11  TRNC              M:TRUNC M:XX.
*                 NOW DISCARD SPARE FPOOL BUFFERS.
         LI,R14   BUFF1             COPY THEM TO HERE BEFORE DELETING.
         LI,R5    0                 FLAG TO TELL T:RBUF TO FREE PP.
FBLOOP   LI,R7    JBFBFP
         MTB,0    J:JIT,R7          ANY BUFFERS IN FREEPOOL...
         BEZ      TRAPEXIT          ---> NO.  DONE.
         BAL,R2   T:GBUF            MAP THE FREE BUFFER, SO WE CAN
         BAL,R2   T:RBUF              RELEASE IT.
         B        FBLOOP            ---> REPEAT.
         SPACE    2
SCCSTRP  EQU      %
         LW,R7    R4                RESTORE R7 AS OF BEF.MANIPLTN
CAL19MOD EQU      %
         AI,R7    -1                GET BACK SCC & EXIT TYPE
         AND,R7   M8                EXAMINE TYPE
         CI,R7    10                IS THIS AN M:INTRTN (REAL TIME)?
         BE       INTRTN            YES
         CI,R7    0
         BE       BADCAL
         CI,R7    5                 HAVE TO TAKE OF M:TRTN
         BE       MTRTN
         CI,R7    3                 NO MOD. AS SUCH ON M:STRAP
         BG       BADCAL            AND SUPERCLOSE AS YET
*  NOTE:SET STCC IS ONLY VALID FOR M:EXIT,M:ERR,M:XXX
         LW,R1    R4
         AND,R1   Y0001
         BCR,2    C19TV,R7          BIT 15 NOT SET;GO EXIT
         SLS,R1   8
         STS,R1   J:EXTENT          STCC BIT SET IN JIT
         LI,R1    1
         SLS,R4   -8
         STB,R4   JB:STEPCC,R1      SET STCC CODE IN JIT
         B        C19TV,R7          NOW GO EXIT
         SPACE    10
EXITRAP  EQU      T:EXIT
         SPACE    2
ERRTRAP  EQU      %
         B        T:ERROR
         DO       FRGRND
         B        MERRF             FORE
         FIN
         SPACE    2
XXXTRAP  EQU      %
         B        T:ABORT
         DO       FRGRND
MERRF    EQU      %
MEXITF   EQU      %
         REF      EPEXITF,EXITFSEG
         OB       EPEXITF,EXITFSEG
         SPACE    3
         FIN
         SPACE    5
CAL13    CI,8     6
         BGE      BADCAL
         LW,0     8
         OVERLAY  DEBUGSEG
         B        TRAPEXIT
         BOUND    4
         SPACE    5
CAL14    EQU      %
         DO       CHKPT
         CI,8     NC14S
         BGE      BADCAL
*
         LI,1     C14TV
         EXU      *8,1
         B        MONOVLY
C14TV    EQU      %
         B        BADCAL            0
         B        BADCAL            1
         LI0      T:SAVEGET#        2
         LI0      T:SAVEGET#        3
         LI0      T:ASSOCIATE#      ASSOC LIB/DEBUG
         LI0      T:DISASSOCIATE#   DISASSOC SAME
         B        T:CLRERR          8='06'
NC14S    EQU      %-C14TV
         ELSE
         LI0      T:SAVEGET#
         CI,8     2
         BE       MONOVLY
         CI,8     3
         BE       MONOVLY
         B        BADCAL
         FIN
*
*
*
CAL15    EQU      %
         CI,8     EXUCODE           IS THIS M:EXU?
         BE       MEXU              YES
         CLM,8    MSCODES           M:MASTER/M:SLAVE?
         BCR,9    MSTRSLV           YES
         LW,0     RTICBHDR          IS THIS A REAL-TIME SYSTEM?
         BLZ      BADCAL            NO
         B        RTALTCP           CAL15 HANDLER IN RTROOT MODULE
*
MEXU     EQU      %                 M:EXU CAL1,5 RECEIVER
*
*        EXECUTE THE FOLLOWING PRIVILEGED INSTRUCTIONS:
*
*                 SIO = X'4C'
*                 TIO = X'4D'
*                 TDV = X'4E'
*                 HIO = X'4F'
*                 RD  = X'6C'
*                 WD  = X'6D'
*
*        CONDITION CODES RETURNED TO USER ARE THOSE OF THE EXECUTED
*        INSTRUCTION; HENCE, ANY ABNORMAL CONDITION IS REPORTED AS
*        AN ABORT (CODE = B9; SUBCODES, AS INDICATED)
*
*        R6 = ADDRESS OF INSTRUCTION TO BE EXECUTED
*        R11 CONTAINS RETURN ADDRESS (TRAPEXIT)
*
         LI,R0    X'C0'
         CB,R0    JB:PRIV           PRIVILEGE OK?
         BLE      EXUOK             YES
         LW,14    EXU:ERR1          NO; ABORT USER (B9/01)
         B        CALBAD
*
EXUOK    CI,R6    X'1FFF0'          CHECK FOR INSTRUCTION IN REGISTER
         BANZ     EXU15             NO
         AW,R6    J:BASE            CONVERT TO STACK ADR.
         B        EXU17             CONTINUE
EXU15    LW,R7    R6                GET INSTRUCTION ADR.
         SLS,R7   -9                CONVERT TO PAGE ADR.
         LW,9     11                SAVE R11
         BAL,11   T:IACU            CHECK PROTECTION
         STCF     R7                SAVE PROT
         LW,11    9                 RESTORE R11
         LC       R7                CCS=PROT TYPE
         BCR,2    EXU17             00 OR 01
         LW,14    EXU:ERR2          10 OR 11; ABORT USER (B9/04)
         B        CALBAD
EXU17    LB,R7    *R6               GET OPCODE
         AND,R7   M7                SCRUB INDIRECT BIT
         SLS,R7   -1                DIVIDE BY TWO
         AI,R7    -X'26'            SUBTRACT BASE VALUE
         BGEZ     EXU19             CHECK LEGAL OPCODES
EXU18    LW,14    EXU:ERR3          BAD OPCODE; ABORT USER (B9/05)
         B        CALBAD
EXU19    LW,9     X1,R7             CHECK FOR LEGAL OPCODES
         CI,9     OPCODES           MASK OF LEGAL OPCODES
         BAZ      EXU18             ILLEGAL OPCODE
         STW,R6   J:BASE+1          SAVE INSTRUCTION LOC
         LW,R2    TSTACK
         AI,R2    -15               POINT TO REGISTER 0 IN STACK
         STW,R2   J:BASE+3          SAVE POINTER TO REGISTERS
         AI,R2    -2                POINT TO PSD
         AND,R2   XN2                            IN STACK
         STW,R2   J:BASE+2          SAVE POINTER
         LCI      0                 RESTORE USER REGISTERS
         LM,0     *J:BASE+3             FROM STACK ENVIRONMENT
         LCF      *J:BASE+2         CC'S TOO
         EXU,0    *J:BASE+1         ***********************************
         STCF     *J:BASE+2         SAVE CC'S
         LCI      0                 PUT REGS BACK IN USER ENVIRONMENT
         STM,0    *J:BASE+3
         B        TRAPEXIT          RETURN TO USER VIA TRAPEXIT
*
MSTRSLV  EQU      %                 M:MASTER/M:SLAVE CAL1,5 RECEIVER
*
*        PLACE USER PROGRAM IN MASTER (PROTECTED ON SIGMA9/X560) MODE
*        OR RETURN TO SLAVE MODE
*
*        R8 = FPT CODE
*        R11 CONTAINS RETURN ADDRESS (TRAPEXIT)
*
         LI,R0    X'C0'             SECURITY CHECK
         CB,R0    JB:PRIV
         BG       CC1SET            NO
         AI,8     -SLAVECODE        R8=0 IF SLAVE;1 IF MASTER
         LW,R1    8                 MOVE TO INDEX REGISTER
         LW,9     Y008              MASK FOR SLAVE BIT
         LW,R2    TSTACK            FORM POINTER TO PSD
         AI,R2    -17
         AND,R2   XN2               POINT TO PSW1
         LW,8     Y008,R1           SET SLAVE BIT IF M:SLAVE
         STS,8    0,R2              MERGE IN PSD
         LW,8     Y004,R1           SET MODE ALTERED BIT(MASTER PROTECTED)
         BIF,S9S7 MS1               X560 CHECK REQUIRED FOR MA BIT
         SLD,8    -7                SHIFT IF X560
MS1      STS,8    1,R2              MERGE INTO PSD
         LW,9     Y1                SET WRITE KEY
         LW,8     Y08,R1
         STS,8    1,R2              INTO PSD
         B        CC0RST            RETURN
*
*
*
*        CAL1,6   UTS RELIALIBITY CALS
*
CAL16    EQU      %
         CI,8     NC16S             CHECK IF LEGAL CAL1,6
         BGE      BADCAL            BRANCH IF NO
*
         AI,8     C16TV
         LI,1     X'A0'             DIAGNOSTIC & RELIAVILITY PRIVILEGE
         CB,1     JB:PRIV           CHECK USERS PRIVILEGE LEVEL
         BG       CAL16Y
CAL16X   EQU      %
         EXU      *8
         LI,2     RMAOVSEG
         B        T:OVERLAY
*
CAL16Y   EQU      %
         LW,1     S:CUN
         LH,1     UH:FLG,1
         CI,1     TIC
         BANZ     CAL16X
*
         B        ERCC1             SET CC1 FOR ERROR
*
C16TV    EQU      %
         LI0      T:RDERLOG#        0 READ ERROR LOG
         LI0      T:WTERLOG#        1 WRITE ERROR LOG
         LI,0     T:MAP#            2 CONVERT ADDRESS, M:MAP
         LI,0     T:BLIST#          3 M:SIO, SANE ENTRY AS M:BLIST
         LI,0     T:LOCK#           4 M:LOCK
         LI,0     T:DOPEN#          5 DIAGNOSTIC OPEN
         B        T:INITJOB         6 INITIATE A GHOST JOB
         LI,0     T:DCLOSE#         7 DIAGNOSTIC CLOSE
         B        T:SYS             8
         LI,0     T:BLIST#          9 BUILD COMMAND LIST
         LI0      T:MODPRTRT#      10(A)PROCESS M:DMOD#,M:DPART,M:DRET
NC16S    EQU      %-C16TV
         PAGE
*****
*
*        THE REGISTER SETUP AT LOCATION CAL17 IS AS FOLLOWS:
*
*        (R6)=    DCB ADDRESS OR LINE ID ADDRESS
*        (R7)=    WA(FPT+1)
*        (SR1)=   FPT CODE
*        (SR4)=   WA(TRAPEXIT)
*
*****
         REF      T:GETID,TQOV1SEG,TQOV2SEG
         REF      CNMPROC0#,CNMPROC1#,CNMPROC2#,CNMPROC3#
         REF      CNMPROC4#,ECBCHECK,TQUEUE#
         SREF     TTP,QT
*
CAL17    EQU      %
         CI,SR1   C17TVEND          DO WE HAVE A LEGAL CODE
         BGE      BADCAL            GUESS NOT
         LI,R1    C17TV             GET TOP OF TRANSFER TABLE
         EXU      *SR1,R1           EXECUTE TABLE INSTRUCTION
         LI,R2    TQOV2SEG          ASSUME TQ2 OVERLAY IS NEEDED
         CI,SR1   TQOV2END          BUT CHECK ON THIS
         BL       %+2               B, IF RIGHT
         LI,R2    TQOV1SEG          ELSE, LOAD SEG# FOR TQ1 OVERLAY
         B        T:OVERLAY         AND GO TO IT
*
C17TV    EQU      %
         LI,R0    CNMPROC0#         X'00'  M:GETLINE
         LI,R0    CNMPROC1#         X'01'  M:RLSLINE
         LI,R0    CNMPROC2#         X'02'  M:BUFSTAT
         LI,R0    CNMPROC3#         X'03'  M:PURGE
         LI,R0    CNMPROC4#         X'04'  M:MDFLST
         B        ECBCHECK          X'05'  M:ECBCHECK
*
TQOV2END EQU      %-C17TV
         LI,R0    TQUEUE#           X'06'  M:QUEUE  UNLOCK
         LI,R0    TQUEUE#           X'07'  M:QUEUE  DEFINELIST
         LI,R0    TQUEUE#           X'08'  M:QUEUE  PUT
         LI,R0    TQUEUE#           X'09'  M:QUEUE  GET
         LI,R0    TQUEUE#           X'0A'  M:QUEUE  STATS
         LI,R0    TQUEUE#           X'0B'  M:QUEUE  PURGE
         LI,R0    TQUEUE#           X'0C'  M:QUEUE  LOCK
         B        T:GETID           X'0D'  M:GETID
*
C17TVEND EQU      %-C17TV
         PAGE
************************************************************************
*
*  CAL1,8 HANDLER
*
*  INPUT:
*     SR1         FPT CODE (RIGHT JUSTIFIED)
*
*  OUTPUT:
*     R0          OVERLAY TRANSFER VECTOR INDEX IF ROUTINE IS OVERLAYED
*
*  ENTRY POINTS:
*     CAL18
*
*  EXITS:
*     TO MONOVLY IF ROUTINE IS OVERLAYED
*     TO BADCAL IF FPT CODE IS INVALID
*     TO THE SPECIFIED ROUTINE IF NONE OF ABOVE.
*
*  REGISTERS DESTROYED:
*     R1
*
*  NOTE:
*     SR4 CONTAINS THE ADDRESS OF TRAPEXIT (WAS LOADED IN CALPROC).
*
************************************************************************
CAL18    CI,SR1   HICAL18           C/FPT CODE W/HIGHEST LEGAL CODE
         BLE      C18A              BLE; FPT CODE PROBABLY LEGAL
C18TV    B        BADCAL            X'00'  NON-EXISTENT
         B        MSEGLD            X'01'  M:SEGLD
         B        MLNK              X'02'  M:LINK
         B        MLNK              X'03'  M:LDTRC
         B        MMOVRTV
         B        MMOVRTV
         LI0      T:CHTBL#          X'06'  M:CT
         B        MMOVRTV
         B        MMOVRTV
         B        MMOVRTV
         B        MMOVRTV
         B        MMOVRTV
         B        MMOVRTV
         B        MMOVRTV
         LI0      MINT#             X'0E'  M:INT
         LI0      T:WAIT#           X'0F'  M:WAIT
         LI0      MTIME#            X'10'  M:TIME
         LI0      MSTIMER#          X'11'  M:STIMER
         LI0      MTTIMER#          X'12'  M:TTIMER
         B        T:SYSLOAD         X'13'  M:DISPLAY
         B        MTRAP             X'14'  M:TRAP
         B        RESOURCE          X'15'  SET RESOURCE
         B        RESOURCE          X'15'  SET RESOURCE
         B        RESOURCE          X'15'  SET RESOURCE
         B        RESOURCE          X'15'  SET RESOURCE
         LI0      MXCON#            X'19'  M:XCON
         B        CALMUL1           X'1A'  M:LDEV
         LI0      T:GDDL#           X'1B'  M:GDDL
HICAL18  EQU      %-C18TV-1         HIGHEST LEGAL FPT CODE FOR CAL1,8
*
C18A     LI,R1    C18TV             L/ADDRESS OF CAL1,8 TRANSFER VECTOR
         EXU      *SR1,R1           EXECUTE INSTRUCTION IN TV
         B        MONOVLY           B; R0 = MISOV (UCAL) OVERLAY TV INDEX
*
*
         REF      MULSEG
T:LDEV#  EQU      4
CCLOSE#  EQU      5
*
CALMUL1  LI,0     T:LDEV#
         LI,11    CC1RST
         B        %+2
CALMUL2  LI,0     CCLOSE#
         LI,2     MULSEG
         B        T:OVERLAY
         PAGE
         REF      J:RNST,J:ABC,J:TELFLGS
         REF      ERO
*
*        MM ENTRIES
*
*
MMOVRTV  LI,R1    C18TV2
         EXU      *SR1,R1           EXU OVERLAY MM TV
         LI,2     STEPOVRSEG        LOAD OVERLAY NUMBER.
         B        T:OVERLAY         ENTER IT
C18TV2   EQU      %-4
         LI0      T:GVP#            X'04' M:GVP
         LI0      T:FVP#            X'05' M:FVP
         B        BADCAL            SKIP M:CT CALS....
         LI0      T:SAD#            X'07' M:CVM
         LI0      T:GDP#            X'08' M:GP
         LI0      T:FDP#            X'09' M:FP
         LI0      T:SMP#            X'0A' M:SMPRT
         LI0      T:GL#             X'0B' M:GL
         LI0      T:GCP#            X'0C' M:GCP
         LI0      T:FCP#            X'0D' M:FCP
T:CLRERR EQU      %
         LW,4     S:CUN
         LH,4     UH:FLG,4
         CI,4     TIC               COMMAND PROCESSOR REQUEST
         BAZ      ERCC1             NOPE, ERROR HIM
         LI,2     0                 YES, CLEAR
         STB,2    J:RNST             THE RUN STATUS
         STB,2    J:ABC               THE ABORT CODE
         LI,3     X'1FFFF'          L/M17 MASK
         STS,2    J:JIT+ERO         CLEAR ERROR AND ERO FIELDS IN JIT
         LI,3     2                 AS WELL AS THE BREAK BIT
         STS,2    J:TELFLGS          IN J:TELFLGS
         B        OKOUT
*
*
SCR7C    SUA      X'7C'             SUA .7C
         PAGE
ERCC1    EQU      CC1SET
RESOURCE EQU      %
         REF      SV:RSIZ,SB:RTY,JB:MAX,JB:CUR,SH:RBCU,SH:RGCU,SH:ROCU
         REF      SH:RNM,XFFFF,J:JIT,J:BASE,S:MBSF,Y8
         LI,R1    SV:RSIZ           SIZE OF RAT TABLES
         CI,R6    X'C000'           TEXT RESOURCE NAME SPECIFIED
         BAZ      KRD5              NO-ASSUME DEVICE TYPE CODE
         LI,R7    X'FFFF'
KRD4     LH,R2    SH:RNM,R1
         CS,R6    R2                RESOURCE NAME FOUND IN RAT TABLE
         BE       KRD2              YES
         BDR,R1   KRD4
         B        CC3SET            ERROR-CANT FIND NAME
KRD5     CB,R6    SB:RTY,R1         DEVELOP RATX BY MATCH OF TYPE CODE
         BE       KRD2              RRTX
         BDR,R1   %-2
         B        CC3SET            ERROR-BAD TYPE  CODE
KRD2     LI,R2    SR1
         LW,SR1   *J:BASE,R2        GET USERS SR1-NUMBER TO RELEASE
         BL       CC1SET            DO NOT ALLOW NEG. SPECIFICATION
         LH,R2    SH:RNM,R1         RESOURCE NAME
         AND,R2   XFFFF
         LW,R3    SR1               SAVE NL
         CI,R2    'CO'              CORE RESOURCE
         BNE      KRD1              NO
         CI,SR1   1                 YES-EVEN NUMBER OF PAGES SPECIFIED
         BANZ     CC2SET            NO-ERROR
         SLS,R3   -1                K
KRD1     LB,R2    JB:MAX,R1         MAXIMUM PERMITTED THIS USER
         SW,R2    SR1               SUBTRACT NUMBER TO BE RELEASED
         BLZ      CC1SET            ERROR-RELEASED MORE THAN OWNED
         CB,R2    JB:CUR,R1         NUMBER CURRENTLY IN USE
         BL       CC1SET            ERROR-MAXIMUM EXCEEDED
         STB,R2   JB:MAX,R1         REDUCE NUMBER PERMITTED THIS JOB
         LC       J:JIT
         BCS,12   CC1RST            0=BATCH,1=GHOST,2=ONLINE
         LH,R2    SH:RBCU,R1        REDUCE NUMBER CURRENTLY ALLOCATED
         AND,R2   XFFFF
         SW,R2    R3
         STH,R2   SH:RBCU,R1
         MTW,1    S:MBSF            START THE MBS
OKOUT    EQU      %
CC0RST   EQU      %
CC1RST   EQU      %
         LI,12    0                 RESET CC1 & CC2
         B        OUT
CC3SET   LW,D1    Y2
         B        OUT
CC2SET   EQU      %
         LW,12    Y4
         B        OUT
CC1SET   LW,12    Y8
*
*  IN:  R12 CONTAINS CONDITION CODES IN FIRST 4 BITS
*
OUT      EQU      %
         LW,13    YE                RESET CC1,CC2,CC3
         LI,1     -17               L/WD FROM TOP OF TSTACK TO PSD
         AW,1     TSTACK            G/ADR OF PSD IN TSTACK
         AND,1    X1FFFE            BOUND 8
         STS,12   0,1               S/CC'S INTO PSD
         B        TRAPEXIT
*
*
         PAGE
         PAGE
         DEF      TMPTOSTK
MTRTN    RES      0
         LI,6     T:SSEM            RETURN
* UPON ENTRY FROM ALTCP,R4 HAS BEEN SET UP TO CONTAIN
*  INFO. AS TO WHETHER IT IS A XCON RETURN
*
         AND,R4   XFF00
         REF      XFF00
         BEZ      MTRTN0            NOT A XCON RETURN
         LB,R1    J:EXTENT
         CI,R1    X'20'             SEE IF XCON HAS BEEN IN PROG.
         BAZ      CC1SET            NO;RETURN TO CAL+1 WITH CC1 SET
         AND,R1   XFFDF
         STB,R1   J:EXTENT          RESET THE XIT-IN-PROG. BIT
         B        TMPTOSTK          GO MOVE TRAPPED ENVIR.TO TSTACK
MTRTN0   RES      0
         LW,1     S:CUN
         LH,3     UH:FLG,1
         CI,3     DIC
         BAZ      TMPTOSTK
         LI,5     SPDBASE           DEBUG STACK
         AI,3     -DIC              RESET DELTA IN CONTROL
         STH,3    UH:FLG,1
         LB,2     UB:ASP,1          CORE LIBRARY ASSSOC?
         BEZ      TMPTOSTK+1        NO
         AND,3    XFFFE             RESET READY TO RUN
         STH,3    UH:FLG,1
         LB,4     UB:DB,1
         MTB,-1   PB:UC,4           DEBUG DOWN
         LH,14    UH:FLG2,1
         CI,14    X'800'            LOCKED IN CORE
         BAZ      MTRTN0A           NO
         MTB,-1   PB:LCT,4          DECREMENT LOCK COUNT
         BG       MTRTN0A           STILL LOCKED
         LB,4     PB:PSZ,4          UNLOCKED, THEN
         LCW,4    4                 DECREMENT RTCORE
         AWM,4    S:RTCORE          BY PSZ
MTRTN0A  MTB,1    PB:UC,2           CORE LIBRARY UP
         LI,6     E:AP
         BAL,11   T:REG             GET THE LIBRARY
         CI,14    X'800'
         BAZ      MTRTN0B           NOT LOCKED
         MTB,0    PB:LCT,2
         BG       %+3               ALREADY ACCOUNTED FOR
         LB,14    PB:PSZ,2
         AWM,14   S:RTCORE          ADD IT IN
         MTB,1    PB:LCT,2          BUMP LCT
MTRTN0B  LI,6     T:SSEM
         B        TMPTOSTK+1
         SPACE    4
TMPTOSTK RES      0
         LW,5     J:TCB             USER TEMP STK
         LI,4     T:ABORTM
         LW,14    =X'010000A3'      ERROR CODE
         LW,3     5
         BAL,7    CHKPROT-1
         REF      CHKPROT
         INT,3    1,5
         AI,3     -21
         BLZ      T:ABORTM
         LW,3     0,5
         BAL,7    CHKPROT
         LW,3     0,5
         AI,3     -19
         AW,3     0,3
         BAL,7    CHKPROT
         LW,4     0,5
*MOVE ENVIRONMENT FROM USER'S STACK TO TSTACK
         LI,3     -9
         LD,8     *4,3              TRAP PSD
         LI,R3    -17
         AW,R3    TSTACK            PSD LOC IN TSTACK
         LD,10    *3
         LW,9     FF3FFFFF
         REF      FF3FFFFF
         LB,R7    JB:PRIV           CHECK PRIV
         CI,R7    X'C0'             PERMIT C0 USER TO
         BL       %+2               CONTROL SLAVE BIT IN PSD
         OR,9     Y008              SET MASK BIT FOR SLAVE BIT
         STS,8    10
         STD,10   *3
         LCI      8
         LM,7     -8,4
         STM,7    10,3
         LM,7     -16,4
         STM,7    2,3
         LW,7     -19,4             STACK BALANCE WORD
         AI,7     -20
         MSP,7    *5
         LW,7     1                 FOR MSTRAP
         LW,11    6                 RETURN
         B        T:PAC
         PAGE
*
MSTRAPXIT EQU     %
*EXIT ROUTINE FOR MSTRAP
         BAL,11   T:SELFDESTRUCT    ZAP MISOV
         LW,2     TSTACK
         AI,2     -17               POINT TO PSD
         LD,0     *2                GET IT
         WD,0     X'37'             DISABLE
         STD,0    *7                FAKE OUT ENTRY
         LW,3     2,7               GET HANDLER ADDRESS
         STW,3    TEMP              SAVE IT
         LI,4     -19
         MSP,4    TSTACK            EMPTY STACK
         LCI      0
         LM,0     2,2               LOAD REGISTERS
         B        *TEMP
*
40TRAP   EQU      %
         LI,2     MPPO+MPPO+1       SET INDEX
         STH,R1   JIT,R2            TRAP NUMBER AND CC
*
         LI,R7    X'FF'             MASK TO STORE TRAP CELL SUB CODE
         CW,0     Y004              WAS TRAPPING USER UNMAPPED...
         BAZ      ABORT             ---> YES. SCREECH.
         CW,0     Y008              WAS TRAPPING USER MASTER MODE...
         BANZ     TRAP10            ---> NO.
         LB,2     JB:PRIV           GET USER PRIV
         CI,2     X'C0'             CAN HE BE MASTER MODE
         BL       ABORT             NO, SCREECH
         AND,0    M17               SCRUB ADDRESS
         CI,0     X'A000'           CHECK FOR USER AREA
         BL       ABORT             NO, SCREECH
TRAP10   LW,4     S:CUN             R4 = CURRENT USER #.
         LH,15    UH:FLG,4          R15= FLAGS FOR THIS USER.
         CI,15    TIC+DIC+DELA      IS TEL IN CONTROL OR DELTA ASSOC.
         BAZ      TRAP40            ---> NO.
         CI,15    TIC               IS TEL IN CONTROL.
         BANZ     SCR61             ---> YES; SCREECH.
         CI,15    DIC               WAS DELTA IN CONTROL.
         BAZ      TRAP30            ---> NO.  GO TO DELTA.
*                                   YES.  SPECIAL CHECKS NEEDED.
         CB,6     Y4
         BNE      TRAP30
*
         LC       6                 CHECK TRAP TYPE-IF NOT MEM VIOL,
*                                   CANT BE PATCH TO PROCEDURE BY DELTA
         BCR,1    TRAP30             NORMAL TRAP
*
         LW,1     TSTACK            RELOAD USERS REGIDSTERS
         PSW,6    TSTACK
         LW,0     *0                GET INSTR CAUSING TRAP
         PSW,0    TSTACK
         LCI      0                  INSTRUCTION FOR ITS
         LM,0     -15,1
         ANLZ,7   *TSTACK           GET EFFECTIVE ADDRESS
         BCS,7    TRAP28
         BCR,8    TRAP28            NOT WORD ADDR,NOT DELTA PP PATCH
*
         SLS,7    -9                 FORM PAGE # OF EFFECTIVE ADR
         CW,7     J:PUL              CHECK PROCEDURE LIMITS
         BG       TRAP28            NOT PROCEEDURE
*
         CW,7     J:PLL
         BL       TRAP28            NOT PROCEEDURE
*
         BAL,11   T:IACU            GO-CHECK ACCESS ON PAGE
         BCS,2    TRAP28            NOT (01)
         BCR,1    TRAP28            NOT PROCEEDURE(01)
         LI,9     X'67'             IS TRAPPED
         SLS,9    24                 INSTRUCTION
         CS,9     *TSTACK             AN 'EXU'?
         BNE      TRAP21            NO.
         LW,7     *TSTACK           GET THE EXU INST
         LW,7     *7                GET THE EXU'D INST
         CS,9     7                 IF ALSO AN EXU,
         BE       TRAP28             TRAP HIM.
         PUSH     7                 SAVE EXU'D INST
         LW,1     TSTACK            RESTORE
         AI,1     -18                ALL
         LCFI     0                   REGISTERS.
         LM,0     0,1
         ANLZ,7   *TSTACK           ANLZ EXU'D INST
         STCF     1
         PULL     10                CLEAR THE STACK
         CW,1     Y1
         REF      Y1
         BANZ     TRAP21            IMMEDIATE IS OK
         SLS,1    -30
         SLS,7    -11,1             SHIFT TO PAGE #
         BAL,11   T:IACU            CHECK THE ACCESS
         BCR,2    TRAP21            00,01 (DATA,PROC) OK
         B        TRAP28            ANYTHING ELSE NOT.
TRAP21   RES      0
         LW,1     TSTACK
         AI,1     -17               ADDRESS OF USER REGISTERS
         LCI      0
         LM,0     *1                BRING UP ALL USER REGISTERS
         EXU      *TSTACK           EXECUTE DELTA STORE INTO USER PP
         STCF     *TSTACK           SAVE CONDITION CODES TEMP.
*
*  RESTORE REGISTERS WHICH MAY HAVE BEEN ALTERED
*  BY THE EXU OF THE USER-SUPPLIED INSTRUCTION
*
         LCI      0               THE FIRST ENVIORNMENT IS
         STM,0    TSTACK+5         THE USERS SO WE ARE SURE
         LCF      *TSTACK           OF MODIFYING IT DIRECTLY
         STCF     TSTACK+2           RATHER THAN CALCULATING IT
        SPACE   8
         BUMP     -2,1
*
         LW,1     S:CUN             * SET
         LH,2     UH:FLG,1          *     PROCEDURE
         OR,2     X10               SET PPSWAP
         STH,2    UH:FLG,1          *
         B        TRAPEXIT          GO BACK TO USER+1
*
TRAP28   RES      0
         PLW,1    TSTACK
         PLW,6    TSTACK
         LW,4     S:CUN             R4= USER# AND R15= FLAGS.
         LH,15    UH:FLG,4           (FOR DELTAGO).
*
TRAP30   LI,0     X'FF'             PREPARE TO GO TO DELTA:
         AND,0    6                 R0= TRAP ADDRESS (INTO DELTASTACK)
         LI,10    SPPBASE+X'C'      R10= DELTA ENTRY ADDRESS.
         LB,6     6
         STB,6    10                     ADD CC/FC FROM TRAP.
         B        DELTAGO         -----> GO TO DELTA.
         REF      DELTAGO
*
TRAP40   EQU      %                 TRAP WITH DELTA NOT ASSOCIATED.
         SLS,R3   TRAPFLGB
         CW,R3    J:USENT           DOES USER HAVE TRAP CONTROL...
         BANZ     STKTOTMP          ---> YES. GO TO USER CONTROL.
         LI,14    X'F'              NO. ABORT THE USER.
         AND,14   6                 GET TRAPLOC. (X FROM 4X IN R6).
         BEZ      TRAP40A           ---> TRAP 40.
         AI,14    4                 SUBCODE FOR TRAP4X IS X+4.
         B        TRAP40B
40SUBS   GEN,8,8,8,8  0,4,3,0       SUBCODES FOR TRAP 40:
         GEN,8,8,8,8  2,4,0,0         1=NEI  2=NEM  3=PI   4=MPV
         GEN,8,8,8,8  1,0,1,0         0=IMPOSSIBLE.
         GEN,8,8,8,8  0,0,0,0
TRAP40A  LB,7     6                 SUBCODE FOR TRAP40
         SLS,7    -4                DEPENDS ON TRAPCC.
         LB,14    40SUBS,7
TRAP40B  SCS,14   -8                GET ERROR SUBCODE IN 0-7.
         AI,14    X'A4'             ADD ERROR CODE IN 24-31.
         B        T:ABORTM        -----> GO ABORT USER.
*
STKTOTMP EQU      %                 TRAP WITH TRAP CONTROL IN USER.
         LI,1     X'1FFFF'
         AND,1    J:TCB             R1 => USER TCB.
         BNEZ     STKTOT10          ---> USER HAS A TCB.
         LI,1     X'1FFFF'
         AND,1    TSTACK+5          GET TCB FROM USER R0 IF NONE YET.
         STS,1    J:TCB
STKTOT10 LI,0     X'FF'
         AND,0    6                 R0 TO USERSTACK (TRAP ADDRESS).
         LW,10    J:USENT
         LB,6     6
         STB,6    10                GO TO J:USENT WITH CC SET BY TRAP.
         LW,11    L(X'FF01FFFF')
         LI,14    X'A3'             R14= ABORT CODE IF USERSTACK BAD.
         BAL,4    T:UTSXTS          COPY TSTACK TO USER STACK.
         B        T:ABORTM          ---> USER STACK IS BAD.
         LW,R1    J:ALB             PUT 560 ADDRESS OF LAST
         STW,R1   R7+2,R3           BRANCH REG. IN GO REG 7
         B        T:SSEM            SCHEDULE, PULL, & GO TO USER.
         SPACE    2
BADCAL   EQU      %                 ILLEGAL CAL1.
         LI,R14   X'AE'             R14 = ABORT CODE.
         DEF      CALBAD
CALBAD   EQU      %
         LI,3     X'80'
         SLS,3    TRAPFLGB
         CW,3     J:USENT
         BANZ     STKTOTMP
         B        T:ABORTM
         PAGE
*
*        GO TO LDLINK & LDTRC
*
MLNK     EQU      %
         BAL,R1   RTCHK             CHECK IF THIS USER IS A REAL-TIME
*                                   USER WHO HAS LOCKED HIMSELF IN CORE
*                                   THIS ROUTINE RETURNS S:CUN IN R4
         BCS,4    RTCHKERR          YES, HE IS; ABORT HIM
*  HONOUR EXIT CONTROL IF SPECIFIED
*
         LI,1     X'1FFFF'
         CW,1     J:EXTENT
         BAZ      MLNK1
         LB,1     J:EXTENT
         CI,1     X'20'             IF EXIT CONTROL IN PROG.
         BANZ     MLNK2             .DO THE LINK/LDTRC
         OR,1     X8
         STB,1    J:EXTENT
         B        XCONSETUP         GO TO EXIT CONTROL IN STEP
MLNK2    LI,2     0
         LI,3     X'1FFFF'
         STS,2    J:EXTENT          CLEAR EXIT CONTROL ADDRESS
MLNK1    RES      0
         OVERLAY  LDLNKSEG
         B        TRAPEXIT
         PAGE
MSEGLD   EQU      %
         BAL,R1   RTCHK             CHECK IF THIS USER IS A REAL-TIME
*                                   USER WHO HAS LOCKED HIMSELF IN CORE
*                                   THIS ROUTINE RETURNS S:CUN IN R4
         BCS,4    RTCHKERR          YES, HE IS; ABORT HIM
*
         PUSH     R7                FPT ADDRESS + 1   INTO STACK.
         PUSH     R6                ECB ADDRESS (OR 0)INTO STACK.
         LW,SR2   0,R7              SR2= ADDRESS OF SEGMENT NAME.
         BGEZ     SEGLD0            ---> GOT ADDRESS DIRECTLY.
         CI,SR2   X'1FFF0'          INDIRECT ADDRESS.
         BANZ     %+2               CONVERT REGISTER ADDRESS
         AW,SR2   J:BASE            INTO STACK ADDRESS.
         LW,SR2   *SR2              GO INDIRECT.
SEGLD0   CI,SR2   X'1FFF0'          CONVERT
         BANZ     %+2               REGISTER ADDRESS
         AW,SR2   J:BASE            INTO STACK ADDRESS.
         LB,4     UB:APR,4          IS IT A SHRD PROC
         BNEZ     SEGLD1
         LW,R6    J:DCBLINK         R6 => DCB NAME TABLE.
         OVERTO   MISOVSEG,SEGLD#
SEGLD1   EQU      %
         LB,4     PB:LNK,4          IS THE SHARED PROCESSOR OVERLAID..
         BEZ      MSEGLDEX          ---> NO. WE'RE FINISHED.
         LCI      2
         LM,0     *SR2              R0/R1 = SEGMENT NAME.
         LI,2     ' '               BLANK-PAD
         LB,3     0                 THE TEXTC NAME
NXTBLK   CI,3     7                 IN R0/R1.
         BGE      NOPAD             ---> ALL PADDED.
         AI,3     1                 (PAD IT TO ALLOW
         STB,2    0,3                SUCCESSFUL COMPARISON
         B        NXTBLK             WITH P:NAME ENTRIES.)
NOPAD    CD,0     P:NAME,4          IS THIS THE SEGMENT...
         BE       SEG30             ---> YES.  (R4= P: INDEX.)
         LB,4     PB:LNK,4          NO. KEEP LOOKING.
         BNEZ     NOPAD             ---> MORE OVERLAY SEGMENTS.
         LW,14    L(X'010000B1')    NO MORE OVERLAY SEGMENTS;
         B        T:ABORTM        -----> BAD NEWS.
*
SEG30    EQU      %
         BAL,1    T:PROCOV
MSEGLDEX PULL     6
         PULL     7
         B        TRAPEXIT
*
RTCHK    EQU      % ***************************************************
*                 THIS ROUTINE IS CALLED TO CHECK IF THE CURRENT USER
*                 IS A REAL-TIME USER WHO HAS LOCKED HIMSELF IN CORE.
*                                   BAL,R1
*                                   INPUT:  NONE
*                                   OUTPUT: R4=CURRENT USER #
*                                           CC2 SET IF ABOVE IS TRUE
*                                   WORK REGS: R1,R2
*
         LW,R4    S:CUN             CURRENT USER #
         LH,R2    UH:FLG2,R4
         CI,R2    FLG:LIC           REAL-TIME USER LOCKED IN CORE?
         B        0,R1
RTCHKERR EQU      %                 RETURN HERE IF ABOVE CONDITION EXISTS
*                                   WHEN RTCHK IS CALLED FROM WITHIN ALTCP
         LW,14    RTERR             ABORT CODE
         B        CALBAD
ALTCPSZ  EQU      %-ALTCP
         PAGE
T:SYSLOAD EQU     %
         LI,1     -10               POINT TO REG 5 INSTACK
         LW,8     C:ETM             EXECUTION TIME MULTIPLIER
         LW,9     C:RT90            90% RESPONSE TIME
         LW,10    S:CUIS            CURRENT USERS IN SYSTEM
         LCI      3
         STM,8    *TSTACK,1
         B        TRAPEXIT
         PAGE
CKLIMIT  EQU      %
         LI,1     0
         LW,2     J:JIT
         BEZ      CKLIMOK
         LW,2     S:CUN
         LH,2     UH:FLG,2
         CI,2     X'1000'
         BANZ     CKLIMOK
         AI,15    3
         SLS,15   -2
         AW,15    7
         AND,15   M17
         SLS,7    -9
         SLS,15   -9
CKLM1    BAL,11   T:IACU
         STCF,0   11
         CW,11    1
         BLE      %+2
         LW,1     11
         AI,7     1
         CW,7     15
         BLE   CKLM1         CHECK ALL PAGES
CKLIMOK  LC       1
         B        *0
         SREF     CURPDA,FPDTTF
         PAGE
*                 PARAMETERS TO DEFINE BATCH MONITOR.
*                 REFS FOR PARAMETERS OF MONITOR TABLES
         REF      TRAPFLAG,USRENT
*                 DEFS AND REFS FOR OBJECT MODULE.
*
*                 DEFS.
*
*                 REFS TO GENERAL DATA.
*                 REFS TO STATIC DATA.
         REF      M7,M32
         REF      Y01FE
         REF      CJOB
         REF      Y2
*                 IMMEDIATE CONSTANTS USED BY MONITOR.
K2       EQU      2
K1FFFF   EQU      X'1FFFF'
KN7      EQU      -7
KN11     EQU      -17
         PAGE
*                 M:TRAP PROC.  SET/RESET MASK/UNMASK, OR RESTORE
*                 OLD TRAP CONDITIONS. RETURN PREVIOUS SETTINGS IN
*                 SR1,SR2.
*
*                   R7 = PLIST + 1, R6 = FIRST PARAMETER.
*
*                   BYTE  0= RESET, 1= SET, 2= MASK, 3= UNMASK
*                   BIT  2=NAO, 3=UI, 4=PS, 5=FP, 6=DEC, 7=FX.
*                   BIT 0, WD 1 = 1 FOR RESTORE
*
MTRAP    LI,R1    KN11
         AW,R1    TSTACK
         LD,D3    *R1
         LW,D2    0,R7
         BLZ      RSTRTRAP
         LW,R4    USRENT,R5
         LI,R7    K1FFFF
         STS,R6   USRENT,R5
         LW,R2    TRAPFLAG,R5
         LH,R3    D3
         LH,D1    R2
         STH,D1   R3
         LI,R6    KN7
         LCI      K2
         STM,R3   *TSTACK,R6
*                 PREVIOUS TRAP CONDITIONS STORED INTO USER REGS SR1,SR2
         SLD,D1   8
         AND,D1   M7
         AI,D2    0                 CHK BAD CAL BIT
         BGE      MTRAP2            NO BRANCH
         OR,D1    X80               SET BAD CAL BIT
MTRAP2   EQU      %
         EOR,D1   M32
         SCS,D1   TRAPFLGB
         AND,R2   D1
         SLD,D1   8
         AND,D1   M7
         AI,D2    0
         BGE      MTRAP4            NO, BRANCH
         OR,D1    X80               SET BAD CAL BIT
MTRAP4   EQU      %
         SLS,D1   TRAPFLGB
         OR,R2    D1
         STW,R2   TRAPFLAG,R5
         LB,R4    CJOB              PRIORITY
         CI,R4    X'F0'             CHECK IF FRGD
         BGE      MTRAP6            NO, BRANCH
         LW,R4    CURPDA            YES, ADR OF FPDT ENTRY
         STW,R2   FPDTTF,R4
MTRAP6   EQU      %
*                 TRAPFLAG RESTORED WITH NEW SET AND RESET OPTIONS.
         LB,D1    D2
         SLS,D1   16
         SLD,D1   4
         AND,D1   Y003
         AND,D2   Y003
         EOR,D2   M32
         AND,D3   D2
         OR,D3    D1
MTRAPX   STD,D3   *R1
         SCS,14   -8
         LW,6     J:TCB
         BNEZ     TRAPEXIT
         LW,6     TSTACK+5
         STW,6    J:TCB
         B        TRAPEXIT
RSTRTRAP LW,D1    0,R6
         LW,R2    1,R6
         LI,R3    K1FFFF            RESTORE
         STS,R2   USRENT,R5                   USRENT
         LW,D2    Y01FE
         STS,D1   TRAPFLAG,R5                OLD FLAGS
         STH,D1   D1
         LW,D2    Y003
         STS,D1   D3                         DM,DM
         B        MTRAPX
         PAGE
*
*        M:SYS CAL PROCESSOR
*
T:SYS    LB,0     JB:PRIV
         CI,0     X'C0'
         BGE      SYS2              MUST HAVE 'C0' OR GREATER
         B        CC1SET            NO GO RETURN
SYS2     LW,7     TSTACK
         AI,7     -17               COMPUTE ADDR OF PSD IN STACK
         LI,0     0
         LW,1     Y008
         LD,2     *7                LOAD THE PSD
         STS,0    2                 SET MASTER MODE
         LI,3     0                  AND 0 WRITE KEY
         STD,2    *7                PUT THE MASTER PSD BACK
         LI,12    QUEUE
         LI,13    QUEUE1
         LI,14    NEWQ
         LCI      3                 STORE ADDRESSES OF I/O ROUTINES
         STM,12   10,7               IN USER REGS 8,9, AND 10
         B        CC0RST
         END

