         SREF     CURPDA,FPDTTF
*        704759   SIGMA 5/7         BPM M:MTRAP
         SYSTEM   UTS
         DEF      TRAPC
TRAPC    EQU      %
*                                  MTRAP
         PAGE
*
*                        PROGRAM NAME - BATCH USER TRAP PROC'S.
*
*
*                        PROGRAMMER  - DOUGLAS W. HEYING
         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
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
*                 PARAMETERS TO DEFINE BATCH MONITOR.
*                 REFS FOR PARAMETERS OF MONITOR TABLES
         REF      TRAPFLGB,TRAPFLAG,USRENT,TCB
         PAGE
*                 DEFS AND REFS FOR OBJECT MODULE.
*
*                 DEFS.
         DEF      MSTRAP
*
*                 REFS TO GENERAL DATA.
*                 REFS TO STATIC DATA.
         REF      M7,M32,Y00FE,FF3FFFFF,Y003
         REF      Y01FE
         REF      TRAPEXIT
         REF      E:AP
         REF      PB:UC
         REF      S:CUN
         REF      SPDBASE
ABORT1   EQU      T:ABORTM
         REF      T:ABORTM
         REF      T:IACU
         REF      T:PAC,T:SSEM
         REF      T:REG
         REF      UB:ASP
         REF      UB:DB
         REF      UH:FLG
         REF      UH:FLG2
         REF      CJOB
         REF      J:TCB
         REF      J:EXTENT
         REF      CC1SET,CC0RST
         REF      Y2,Y008
         REF      MSTRAPXIT
         PAGE
*                 IMMEDIATE CONSTANTS USED BY MONITOR.
K2       EQU      2
K40      EQU      X'40'
K46      EQU      X'46'
K1FFFF   EQU      X'1FFFF'
KN7      EQU      -7
KN11     EQU      -17
KENTRY   EQU      5
         PAGE
*                 SIMULATE TRAP. USERS TEMP STACK SET AS FOLLOWS:
*                   0,1 = PSD.  2-17 = REG'S.  18 = TRAP LOC.
MSTRAP   EQU      %
         LW,R1    J:TCB             TCB ADDRESS
         LW,14    =X'020000A3'      ERROR IF ILLEGAL TRAP
         LW,1     0,1
         LW,1     0,1
         CI,R1    K40
         BL       ABORT1
         CI,R1    X'45'
         BG       CHKMORE                                               759
ALLOK    EQU      %                                                     759
         LW,1     0,1
         LI,6     MSTRAPXIT         RETURN TO MSTRAPXIT
         B        TMPTOSTK
CHKMORE  EQU      %                                                     759
         CI,R1    X'48'                                                 759
         BL       ABORT1                                                759
         CI,R1    X'4B'                                                 759
         BG       ABORT1                                                759
         B        ALLOK                                                 759
         SPACE    5
         REF      TMPTOSTK
         DEF      MXCON
*  M:XCON PROC.  EXIT ROUTINE ADDRESS SPECIFIED/MODOFIED
*RETURN PREV. ESTBLSHED EXIT CONTROL ADDRESS IN SR1
*   R6=CONTENTS OF WORD 0 OF FPT(IN THIS CASE THE ONLY ONE)
*
*        M:XCON   ADDRESS (,LAST)
*   NO INDIRECT ADDRESSING
*   ABSENCE OF ADDRESS OPTION  IMPLIES 0 (RESET)
MXCON    EQU      %
         LI,R2    0
         LI,R3    K1FFFF
         LS,R2    J:EXTENT
         LI,R1    KN7
         STW,R2   *TSTACK,R1
         LW,R1    J:EXTENT
         CW,R1    Y2                SEE IF CAN REPLACE J:EXTENT
         BANZ     REPLACE           YES;EXIT CON IN PROGRESS
         LW,R1    J:EXTENT
         CW,R1    Y008              SEE IF LAST PREV.SPEC.
         BANZ     CC1SET            YES;RTN TO CAL+1 WITH CC1 SET
*  M:XCON 0,LAST AND M:XCON 0   SHOULD BE DIFFERENTIATED
REPLACE  EQU      %
         LW,R7    Y008
         OR,R7    M17               PRODUCE X'0081FFFF'
         STS,R6   J:EXTENT
*  IF C.P. ASKING FOR EXIT CONTROL, REMEMBER IT
* OTHERWISE NO ACTION
         LB,R7    J:EXTENT
         LW,R1    S:CUN
         LH,R2    UH:FLG,R1
         CI,R2    TIC
         BAZ      NTIC
         LI,R2    X'10'
         OR,R2    R7
         B        %+3
NTIC     LI,R2    X'EF'
         AND,R2   R7
         STB,R2   J:EXTENT
         B        CC0RST            CLEAR CC BEFORE RTN TO CAL+1
         PAGE
         DEF      MINT
         REF      M17,Y8,INTENT
         REF      Y4
         REF      J:INTENT
*                   PROCESS M:INT. ADDRESS IN R6
MINT     LW,1     6
         AND,6    M17
         BEZ      INT05
         OR,6     Y8
         LW,4     S:CUN
         LH,3     UH:FLG,4
         CI,3     TIC
         BANZ     INT30
INT05    STW,6    J:INTENT
INT10    EQU      %
         SCS,14   -8                STACK PROBLEM
         LW,6     J:TCB             DOES HE HAVE A TCB
         BNEZ     INT20
         LW,6     TSTACK+5          USE USER R0 IS
         STW,6    J:TCB             TCB ADDRESS
INT20    DESTRUCT TRAPEXIT
*
INT30    CW,1     Y008
         BANZ     INT05             DONT SET CP'S BRK CONTROL
         OR,6     Y4                SET CP BREAK CONTROL
         B        INT05
         PAGE
         DEF      MSTIMER,MTTIMER
*                 PROCESS M:STIMER, ADDR,TYPE IN R6 - ADR OF VALUE IN R7
*                 PLIST AS FOLLOWS:
*                   STIMER - CODE =11 ,12-14=UNIT,15-31=EXIT ADR
*                            2ND WORD = COUNT  UNIT- 0=SEC,1=MIN,2=TUN
*                   TTIMER   CODE =12 ,23=CANCEL, 30-31 = UNIT
*
*
MSTIMER  EQU      %
         LI,R1    X'1FFFF'
         AND,R1   R6
         OR,R1    Y8
         SLS,R6   -17
         AND,R6   M2
         LW,D2    MPLRS,R6
         MW,D2    *R7
         STW,D2   UTIMER,R5
         STW,R1   TIMENT,R5
         DESTRUCT
M2       DATA     3
MPLRS    DATA     500,30000,1
         SPACE    5
MTTIMER  LW,R1    TIMENT,R5
         LW,R2    -1,R7
         CI,R2    X'100'
         BAZ      %+2
         LI,R1    0
         XW,R1    TIMENT,R5
         LW,D2    UTIMER,R5
         AND,R2   M2
         CW,R1    Y8
         BANZ     %+2
         LI,D2    0
         DW,D2    MPLRS,R2
         LI,R1    -7
         STW,D2   *TSTACK,R1
         DESTRUCT
         REF      TIMENT,UTIMER
         END

