         TITLE    'R T R O O T     D A T A'
*********************************************************************
*                           RESIDENT REAL-TIME MODULE
*
*
*
         DEF      RTROOT,UINTQ
RTROOT   EQU      %
*
*
*********************************************************************
*                                   S E C T I O N    I:
*
*                                     DATA DEFINITIONS
*********************************************************************
*
MONPROC  SET      1                 PICK-UP DCB DEFINITIONS
UTSPROC  SET      1                 PICK-UP X560 PROC
         SYSTEM   UTS
*        SYSTEM   RT:ICBTD          ICB TABLE DEFINITIONS
**********************************************************************
*        NOTE:  THE FOLLOWING SYMBOL DEFINITIONS APPEAR AlSO
*               IN THE MODULE 'RTNR'; ANY CHANGES TO THE ICB
*               TABLE MUST BE MADE IN BOTH MODULES*****************
***********************************************************************
*
         REF      Y06
*
D        EQU      1                 RESOLUTION DISPLACEMENT WITHIN TABLE
W        EQU      2                 WORD DISPLACEMENT WITHIN TABLE
*
*
ICBSTAT  EQU      0,0               HALFWORD
ICBLNK   EQU      0,0               WORD
ICBXPSD  EQU      1,1               WORD
ICBPSD1  EQU      1,2               DOUBLE-WORD
ICBPSD2  EQU      2,4               DOUBLE-WORD
ICBPRIO  EQU      24,6              BYTE
ICBINT   EQU      13,6              HALFWORD
ICBUN    EQU      28,7              BYTE
ICBDL    EQU      8,8               WORD
ICBPRI   EQU      32,8              BYTE
ICBDLFLG EQU      33,8              BYTE
ICBENTPSD0  EQU   9,9               WORD
ICBDLDATA   EQU   10,10             WORD
ICBICBADR   EQU   11,11             WORD
ICBGJPRI EQU      24,6              BYTE
ICBGUN   EQU      29,7              BYTE
ICBGJNME EQU      4,8               DOUBLE-WORD
ICBGJACN EQU      5,10              DOUBLE-WORD
ICBTUN   EQU      1,1               WORD
ICBCLK   EQU      2,2               WORD
ICBBLNK  EQU      4,4               WORD
ICBSYSEP EQU      3,3               WORD
*
ICBTYP1  EQU      0                 ICBSTATYP FOR TYPE-I ICB
ICBTYP2  EQU      1                 ICBSTATYP FOR TYPE-II ICB
ICBTYP3  EQU      2                 ICBSTATYP FOR TYPE-III ICB
*
STATAR   EQU      NB31TO0+X'1A'     ICBSTAT MASK:ARMED BIT RESET
STATAE   EQU      Y06                            ARMED AND ENABLED
STATA    EQU      BT31TO0+26                     ARMED
STATE    EQU      BT31TO0+27                     ENABLED
STATER   EQU      NB31TO0+X'1B'                  ENABLED BIT RESET
STATRIG  EQU      BT31TO0+28                     TRIGGERED
STATRIGR EQU      NB31TO0+X'1C'                  TRIGGERED BIT RESET
STATO    EQU      BT31TO0+29                     ONESHOT BIT
STATC    EQU      BT31TO0+31                     CLEAR BIT
*
STATYPSHFT    EQU -23               SHIFT-COUNT TO RIGHT-JUSTIFY STATYP
STATINTSHFT   EQU -25               SHIFT-COUNT TO RIGHT-JUSTIFY STATINT
*        END
**********************************************************************
         PAGE
         DEF      RTALTCP,RTWD,RTCHKPRIV,RTLOCICB,RTCNVTXT,RTICBTYP;
                 ,RTDCBCHK,RTDEVCHK,RTVTP,RTLCT;
                 ,RTINTRTN,RTCHKGUN,INTSTAT
*
*
*
         REF      INTLBSIZ,INTLB1,INTLB2,NINTS,ICB,ICBSIZE;
                 ,CALBAD,T:REG,T:TOTSZ,S:ACORE,S:RTCORE;
                 ,MONORG,JB:PRIV,E:ART,E:QFI,S:CUN,RTNRRTSEG;
                 ,TRAPEXIT,EXU:MASK,WAIT:MASK,IOWAIT:MASK,BLCKD:MASK;
                 ,UB:US,UH:FLG2,J:ICBHDR,RTICBHDR,MTRTN0;
                 ,UH:FLG,S:BADFLG,DCT3,DCT12,DCT13,DCT15,NEWQNW;
                 ,J:BASE,RTSTOPIO#,RTSTARTIO#,DCT1A,DCT1P,DCTSIZ;
                 ,J:DCBLL,JX:CMAP,MASKS,CHKBIT,CHKBIT1,INTSIM;
                 ,MAXG,SB:GJOBUN,S:GJOBTBL,S:GJOBACN,T:SSEM;
                 ,UB:ASP,UB:APR,UB:APO,UB:OV,UB:ACP,UB:DB,PB:LCT;
                 ,INTLB3,RTRESDF#,S:STL#,SL:RSVP;
                 ,M2,M3,M4,M7,YF,X1FFFE,YFFFF,XF1FFFFFF;
                 ,RTGJOBCON#,T:UTSXTS,RTCONNECT#,RTDISCON#,RTCLOCK#
         REF      Y2,Y6,YC,X3FFE00,CC3FAIL,RTRET1,RTRET2,DRIVEIO,DCT19
         REF      ENBSR4
         REF      UB:PRIOB
         REF      UB:PRIO
*
*
*                                   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       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*
C15LOW   EQU      X'1B'             L0WEST CAL1,5 FPT CODE, EXCEPT:
*                                   M:MASTER/M:SLAVE WHICH ARE HANDLED
*                                   IN ALTCP
C15HIGH  EQU      X'27'             HIGHEST CAL1,5 FPT CODE, EXCEPT:
*                                   M:EXU WHICH IS HANDLED IN ALTCP
         BOUND    8
RTCAL15CODES DATA C15LOW,C15HIGH
*
C19CS    EQU      -8                SHIFT COUNT TO RIGHT-JUSTIFY CODE
*
FPTF1    EQU      1                 ON/OFF BIT (M:HOLD)
FPTEA    EQU      BT31TO0+31        'EA' PRESENCE BIT (M:IOEX)
FPTTO    EQU      BT31TO0+30        'TO' PRESENCE BIT (M:IOEX)
FPTDCB   EQU      X'8000'           'DCB' PRESENCE BIT (M:IOEX)
*
DEV      EQU      1                 WA(DCBDEV)
*
STATEXU  EQU      X'80'             'EXECUTABLE' CODE (M:INTSTAT)
STATWAIT EQU      X'40'             'QFI' CODE (M:INTSTAT)
STATIOW  EQU      X'20'             'IO/WAIT' CODE (M:INTSTAT)
STATBLK  EQU      X'10'             'BLOCKED' CODE (M:INTSTAT)
STATNA   EQU      1                 'NOT ACTIVE' CODE (M:INTSTAT)
*
STATAETR EQU      XF1FFFFFF         'ARMD/ENBLD/TRGRD' BITS RESET
*
RTERR:BADCAL EQU  X'AE'
RTERR:QFI    DATA X'010000B8'
RTERR:INTRTN DATA X'020000B8'
RTERR:PARAM  DATA X'050000B8'
RTERR:IOEX1  DATA X'010000B9'
RTERR:IOEX2  DATA X'020000B9'
*
FLG:LIC  EQU      BT31TO0+12        UH:FLG2 MASK: LOCKED-IN-CORE BIT
FLG:LICR EQU      NB31TO0+12                      LIC BIT RESET
*
FLG:INH  EQU      BT31TO0+2         UH:FLG MASK: SOFTWARE INHIBIT BIT
FLG:INHR EQU      NB31TO0+2                      SOFTWARE INHIBIT-RESET
*
DOWND    EQU      X'20'             DCT3 FLAG - 'DEVICE DOWN'(PRE-EMPTED)
SIOREJECT     EQU BT31TO0+4         SIO REJECT BIT MASK OF DCT3
*
ALLOCAT:UN    EQU 2                 ALLOCAT'S USER #
RBBAT:UN      EQU 3                 RBBAT'S USER #
*
         TITLE    'RT USER-SERVICE SUBROUTINES'
*********************************************************************
*                                   S E C T I O N    II:
*
*                                        SUBROUTINES
*********************************************************************
*
RTWD     EQU      % **************************************************
*                 INTERRUPT CONTROL SUBROUTINE
*                                   BAL,R0
*                                   INPUT:  R3=EFFECTIVE ADR. OF WD
*                                              (X'1X00' WHERE X=WD-CODE)
*                                           R10=INT. ADR.
*                                   OUTPUT: NONE
*                                   WORK REGS:  R3,R13,R14
*
         LW,R13   R10               PICK UP INT. ADR.
         AI,R13   -X'40'            * DEVELOP *
         SLS,R13  -4                *  GROUP  *
         STS,R13  R3                *   CODE  *
         LW,R13   R10               PICK UP INT. ADR. AGAIN
         AND,R13  M4                MASK OFF LEVEL
         LI,R14   X'8000'           SET UP SHIFT INSTR. WITH R13 AS E.A.
         LCW,R13  R13
         AND,R13  M7                MASK OFF SHIFT COUNT
         S,R14    *R13              SHIFT IT
         WD,R14   *R3               **********************************
         B        *R0               RETURN
         PAGE
RTCHKPRIV  EQU    % **************************************************
*                          CHECK USER'S PRIVILEGE LEVEL (RT >= X'E0')
*                                   BAL,R0
*                                   INPUT:  NONE
*                                   OUTPUT: CC1=0 IF USER HAS RT PRIV.
*                                               1 IF NOT
*                                   WORK REG.:  R15
*
         LI,R15   X'E0'             MINIMUM REAL-TIME PRIVILEGE
         LCI      0                 SET NORMAL RETURN
         CB,R15   JB:PRIV           X'E0' : JB:PRIV
         BLE      CHK1              PRIV. OK
         LCI      8                 SET ABNORMAL RETURN
CHK1     B        *R0               RETURN
         PAGE
RTSETCC1 EQU      % **************************************************
*                 PASSES CC SETTING VIA R2 TO RTRETC
*
         LW,R2    BT31TO0+32
         B        RTRETC
         SPACE    5
RTSETCC2 EQU      % **************************************************
*                 PASSES CC SETTING VIA R2 TO RTRETC
*
         LW,R2    BT31TO0+31
         B        RTRETC
         SPACE    5
RTSETCC3 EQU      % ***************************************************
*                 PASSES CC SETTING VIA R2 TO RTRETC
*
         LW,R2    BT31TO0+30
         B        RTRETC
         SPACE    5
RTSETCC4 EQU      % *******************************************************
*                 PASSES CC SETTING VIA R2 TO RTRETC
*
         LW,R2    BT31TO0+29
         B        RTRETC
         SPACE    5
RTSETCC0 EQU      % **************************************************
*                 PASSES CC SETTING VIA R2 TO RTRETC
*
         LW,R3    BT31TO0+32
         STS,R3   S:BADFLG          SET 'RT-ACTIVITY' BIT
         LI,R2    0
RTRETC   EQU      % **************************************************
*                 STORES CONDITION CODE (PASSED IN R2) INTO USER PSD
*
         ENABLE                     **********************************
         LW,R3    YF                CC MASK
         LI,R5    -17               DISPL. BACK INTO TSTACK
         AW,R5    TSTACK
         AND,R5   X1FFFE            INSURE DOUBLE-WORD BOUND
         STS,R2   0,R5              SET CC'S
         B        TRAPEXIT          EXIT CAL1 PROCESSING
         PAGE
RTLOCICB EQU      % **************************************************
*                 LOCATE THE ICB ASSOCIATED WITH AN INT. ADR. OR TEXTLBL.
*                                   BAL,R0
*                                   INPUT:  R6=INT. ADR. OR TEXT LBL.
*                                   OUTPUT: R2=ICB ADR. (IF FOUND)
*                                           CC3/CC4=0 (IF NOT FOUND)
*                                   WORK REGS: R4,R5,R15 PLUS
*                                              R1 & R14 VIA RTCNVTXT
*
         CI,R6    X'8000'           IS IT A TEXT LBL?
         BAZ      LOCICB1           NO
         BAL,R15  RTCNVTXT          CONVERT TEXT LBL.TO INT.ADR.(VIA R6)
         BCR,3    *R0               NOT FOUND; RETURN WITH CC3/CC4=0
LOCICB1  LI,R15   NINTS             SET UP LOOP THROUGH ICB'S
         LI,R4    ICBINT(D)
         LI,R5    ICB
LOOP     LW,R2    ICBSTAT(W),R5     ACTIVE BIT SET (BIT 0)?
         BGEZ     LOCNA             NO
         CH,R6    *R5,R4            COMPARE INT. ADR. IN ICB
         BE       LOCATE            YES
LOCNA    AI,R5    ICBSIZE           INCREMENT TO NEXT ICB
         BDR,R15  LOOP
         LI,R2    0                 DIDN'T FIND IT
         B        *R0               ABNORMAL RETURN
LOCATE   LW,R2    R5                SET UP R2=ICB ADR. AND SET CC'S
         B        *R0               RETURN
         PAGE
RTCNVTXT EQU      % **************************************************
*                 CONVERT A TEXT LBL. TO AN INT. ADR.
*                                   BAL,R15
*                                   INPUT:  R6=TEXT LBL.
*                                   OUTPUT: R6=INT. ADR.(IF FOUND)
*                                           R14=DEFAULT EXEC PRIO
*                                               (ASSOCIATED WITH LABEL)
*                                           CC3/CC4=0 (IF NOT FOUND)
*                                   WORK REGS: R1
*
         OR,R6    YFFFF             SIGN-EXTEND THE TEXT LABEL
         LI,R1    INTLBSIZ-1        SYSGEN-DEFINED  SIZE OF TABLE
CNVL     CH,R6    INTLB1,R1         FIND TEXT LBL. IN TABLE
         BE       CNVOK             FOUND IT
         BDR,R1   CNVL
         LI,R6    0                 DIDN'T FIND IT
         B        *R15              ABNORMAL RETURN WITH R2=0
CNVOK    LH,R6    INTLB2,R1         PICK UP INT. ADR. FROM PARALLEL TABLE
         LB,R14   INTLB3,R1         PICK UP DEFAULT EXEC.PRIO.
         B        *R15              RETURN
         PAGE
RTICBTYP EQU      % **************************************************
*                 EXTRACTS ICBSTATYP FROM AN ICB
*                                   BAL,R12
*                                   INPUT:  R2=ICB ADR.
*                                   OUTPUT: R3=RIGHT-JUSTIFIED ICBSTATYP
*                                   WORK REGS: NONE
*
         LW,R3    ICBSTAT(W),R2     PICK UP ICBSTAT WORD
         SLS,R3   STATYPSHFT        RIGHT-JUSTIFY ICBSTATYP
         AND,R3   M2                MASK IT OFF
         B        *R12              RETURN
         PAGE
RTINTCONTROL  EQU % ******************************************
*                 INTERRUPT CONTROL SUBROUTINE
*                                   SET ICBSTAT
*                                   CONTROL INTERRUPT WITH WD INSTR.
*                                      (IF REAL INTERRUPT)
*                                   BAL,R15
*                                   INPUT:  R2=ICBADR
*                                           R6=WD-CODE
*                                   OUTPUT: NONE
*                                   WORK REGS:R0,R3,R6,R7,R10,R13,R14
*
         EXU      INTCONEXU1,R6     * SET UP *
         EXU      INTCONEXU2,R6     *ICBSTATINT*
INTCON3  LI,R7    ICBINT(D)
         LH,R10   *R2,R7            PICK UP INT. ADR. FROM ICB
         CI,R10   MONORG            IS IT REAL OR PSEUDO?
         BG       INTCON2           MUST BE PSEUDO
         SLS,R6   8                 SHIFT WD-CODE TO POSITION IN WD INSTR.
         LI,R3    X'1000'           SET UP EFFECTIVE ADR. OF WD
         LI,R7    X'0700'           WD-CODE MASK
         STS,R6   R3                SET CODE
         BAL,R0   RTWD              ISSUE WD INSTR.
         CI,R6    X'700'            TRIGGER REQUEST?
         BNE      *R15              NO
         LW,R7    ICBSTAT(W),R2
         CW,R7    STATA             IS INT. ARMED?
         BANZ     *R15              YES, THEN LEAVE 'TRIG' BIT SET
         B        INTCON6           RESET 'TRIG' BIT IN ICBSTAT
*
*
*
INTCONEXU1 EQU    %                 FPT-WD CODE
           B      *R15                 0
           LW,R7  STATAETR             1
           LW,R7  STATAE               2
           LW,R7  STATA                3
           LW,R7  STATE                4
           LW,R7  STATER               5
           B      *R15                 6
           LW,R7  STATRIG              7
*
*
*
INTCONEXU2 EQU    %                 FPT-WD CODE
           NOP                         0
           B      INTCONR              1
           STS,R7 ICBSTAT(W),R2        2
           B      INTCONAD             3
           STS,R7 ICBSTAT(W),R2        4
           B      INTCONR              5
           NOP                         6
           STS,R7 ICBSTAT(W),R2        7
*
INTCONAD STS,R7   ICBSTAT(W),R2     SET 'ARMED BIT IN ICBSTAT
         LW,R7    STATER            ICBSTAT MASK
INTCONR  AND,R7   ICBSTAT(W),R2     RESET  VARIOUS BITS IN ICBSTAT
         STW,R7   ICBSTAT(W),R2
         B        INTCON3           RETURN
*
*                                   SPECIAL PROCESSING FOR PSEUDO INTS.
*
INTCON2  LW,R7    ICBSTAT(W),R2
         CI,R6    7                 IS THE REQUEST 'TRIGGER'?
         BE       INTCON4           YES
         CI,R6    4                 IS THE REQUEST 'ENABLE'?
         BNE      *R15              NO
         CW,R7    STATRIG           IS THERE A TRIGGER PENDING?
         BANZ     INTCON5           YES
         B        *R15              RETURN
INTCON4  CW,R7    STATA            IS THE ICB ARMED?
         BANZ     INTCON5           YES
INTCON6  AND,R7   STATRIGR          RESET ICBSTAT TRIGGER BIT
         STW,R7   ICBSTAT(W),R2
         B        *R15              RETURN
INTCON5  CW,R7    STATE             IS THE ICB ENABLED?
         BAZ      *R15              NO
         LI,R6    ICBPSD1(D)
         XPSD,0   *R2,R6            'TRIGGER' THE PSEUDO INTERRUPT
         B        *R15
         PAGE
RTCHKGUN EQU      % ****************************************************
*                 VERIFIES THAT ICBGUN CONTAINS A VALID USER # FOR AN
*                 ACTIVE (OR SLEEPING) GHOST JOB.
*                                   BAL,R0
*                                   INPUT:  R2=ICB ADR.
*                                   OUTPUT: R5=GJOB USER # (IF ACTIVE)
*                                              0 IF NOT ACTIVE
*                                   WORK REGS:  R1,R3,R6,R7
*
         LI,R3    ICBGUN(D)
         LB,R5    *R2,R3            PICK UP GJOB USER #
         LI,R3    MAXG              SET UP LOOP THROUGH GJOB TABLES
LOOP1    CB,R5    SB:GJOBUN,R3      IS THIS THE ONE?
         BE       CHKG2             YES
CHKG1    BDR,R3   LOOP1             NO
         LI,R5    0                 SET UP 'NOT ACTIVE' RETURN
         B        *R0               RETURN
CHKG2    LI,R1    ICBGJNME(D)
         LD,R6    *R2,R1            PICK UP GJOB NAME
         CD,R6    S:GJOBTBL,R3      IS THIS IT?
         BNE      CHKG1             NO
         LI,R1    ICBGJACN(D)
         LD,R6    *R2,R1            PICK UP GJOB ACCOUNT
         CD,R6    S:GJOBACN,R3      IS THIS IT?
         BNE      CHKG1             NO
         B        *R0               RETURN WITH R5=GJOB USER #
         PAGE
RTCRASH  EQU      %
         SCREECH  X'41',1           FAILED TO FIND USER'S STATE
         PAGE
RTDCBCHK EQU      % ***************************************************
*                 VERIFIES DCB PASSED VIA M:STOPIO/STARTIO/IOEX
*                                   BAL,R5
*                                   INPUT:  R6=DCB ADR.
*                                   OUTPUT: CC'S = 0 (IF DCB IS OK)
*                                           R2=DCT INDEX
*                                           R6=DEVICE ADDRESS
*                                   WORK REGS:  R3
*
         LW,R2    R6                PICK UP DCB ADR.
         SLS,R2   -9                CONVERT TO PAGE #
         CLM,R2   J:DCBLL           IS IT A DCB?
         BCS,9    0,R5              NO
         LW,R2    FCD,R6            ASSUME IT'S OK
         CW,R2    BT31TO0+22        IS IT OPEN?
         BAZ      0,R5              NO
         AND,R2   MASKS+4           PICK UP DCBASN
         CI,R2    3                 IS IT DEVICE-TYPE?
         BNE      0,R5              NO
         LW,R2    DEV,R6
         AND,R2   MASKS+8           DCBDEV
         CI,R2    DCTSIZ            VALID DCT INDEX?
         BG       0,R5              NO
         LH,R6    DCT1P,R2          PICK UP DEVICE ADDRESS
         LCI      0
         B        0,R5              RETURN
         PAGE
RTDEVCHK EQU      % ***************************************************
*                 VERIFIES DEVICE ADR PASSED VIA M:STOPIO/STARTIO/IOEX
*                 IT ALSO CONVERTS TAURUS CLUSTER/UNIT/DEVICE ADDRESSES
*                 TO 'NDD' (SIGMA) FORMAT (IF NECESSARY)
*                                   BAL,R5
*                                   INPUT:  R6=DEVICE ADR.
*                                   OUTPUT: CC3/4=0 (IF DEV ADR IS OK)
*                                           R6=DEV ADR IN DCT1 FORMAT
*                                           R2=DCT INDEX
*                                   WORK REGS:  NONE
*
         LI,R2    DCTSIZ
NXTDCT   CH,R6    DCT1P,R2          IS THIS THE ONE
         BE       0,R5              YES-RETURN WITH CC3/4 = 0
         CH,R6    DCT1A,R2          NO-TRY ALTERNATE
         BE       0,R5              YES-RETURN WITH CC3/4 = 0
         BDR,R2   NXTDCT            LOOP
         B        0,R5              RETURN WITH CC3 OR CC4 SET
         PAGE
RTVTP    EQU      % ***************************************************
*                 CONVERTS A VIRTUAL ADR TO A PHYSICAL ADR
*                                   BAL,R3
*                                   INPUT:  R6=VIRTUAL ADR
*                                   OUTPUT: R6=PHYSICAL ADR
*                                   WORK REGS: R4,R5
*
         LW,R4    R6                USE R4 TO CONVERT TO VIRT PG #
         SLS,R4   -9
         LOAD,R4  JX:CMAP,R4        PICK UP PHYSICAL PG #
         SLS,R4   9                 CONVERT IT TO PG ADDRESS
         LW,R5    X3FFE00           PAGE MASK
         STS,R4   R6                CONVERT R6 TO A PHYSICAL ADR
         CI,R6    X'1FFFF'          IS PHY ADR < 128K?
         B        0,R3              LET CALLER DECIDE
         TITLE    'RT CAL1 SERVICE ENTRY POINTS'
*********************************************************************
*                                   S E C T I O N    III:
*
*                                    CAL1 ENTRY POINTS
*********************************************************************
*
RTALTCP  EQU      % **************************************************
*                 ENTER HERE ON ALL CAL1,5'S FROM ALTCP
*                 EXCEPT: M:EXU,M:MASTER,M:SLAVE (WHICH ARE HANDLED
*                         IN ALTCP)
*                                   R6=FPT(WORD 0)
*                                   R7=PTR. TO FPT(WORD 1)
*                                   R8=FPT CODE OF CAL
*                                   R11=RETURN ADR. (TRAPEXIT)
*
         CLM,R8   RTCAL15CODES      IS THIS A VALID FPT CODE?
         BCR,9    RTCALOK           YES
         LI,R14   RTERR:BADCAL
         B        CALBAD            ERROR EXIT
RTCALOK  LI,R1    C15TV-C15LOW      SET UP TRANSFER VECTOR
         EXU      *R8,R1            GO TO APPROPRIATE ROUTINE OR:
         LI,R2    RTNRRTSEG               LOAD OVERLAY SEGMENT
         B        T:OVERLAY                    *******
*
*
*
C15TV    EQU      %
         LI,R0    RTRESDF#          X'1B' RESDP PAGES CAL
         LI,R0    RTSTOPIO#         X'1C' M:STOPIO
         LI,R0    RTSTARTIO#        X'1D' M:STARTIO
         B        RTIOEX1           X'1E' M:IOEX (SIO)
         B        RTIOEX2           X'1F' M:IOEX (TIO/TDV/HIO)
         LI,R0    RTGJOBCON#        X'20' M:GJOBCON
         LI,R0    RTCONNECT#        X'21' M:CONNECT
         LI,R0    RTDISCON#         X'22' M:DISCONNECT
         B        RTINTCON          X'23' M:INTCON
         B        RTQFI             X'24' M:QFI
         B        RTHOLD            X'25' M:HOLD
         LI,R0    RTCLOCK#          X'26' M:CLOCK
         B        RTINTSTAT         X'27' M:INTSTAT
         PAGE
RTINTCON EQU      % **************************************************
*                 CAL1 ENTRY POINT FOR M:INTCON (ENTER FROM RTALTCP)
*                                   R6=FPT(WORD 0)
*                                   R7=PTR. TO FPT(WORD 1)
*                                   R11=RETURN ADR. (TRAPEXIT)
*
         BAL,R0   RTCHKPRIV         JB:PRIV >= X'E0'?
         BCS,8    RTSETCC1          NO
         LW,R6    R6                M:INHIBIT ?
         BEZ      INHIBIT           YES
         BAL,R0   RTLOCICB          RETURNS ICB ADR. IN R2
         BCR,3    RTSETCC2          NOT FOUND; ABNORMAL RETURN
         LW,R6    0,R7              PICK UP       WD-CODE FROM FPT
         AND,R6   M3                MASK IT
         DISABLE                    ***********************************
         LW,R15   ICBSTAT(W),R2     IS THE ICB STILL ACTIVE?
         BGEZ     RTSETCC2          NO; ABNORMAL RETURN TO USER
         BAL,R15  RTINTCONTROL      SET UP ICBSTAT; SET INTERRUPT STATE
         B        RTSETCC0          RETURN
*
*
*
INHIBIT  EQU      %                 M:INHIBIT (SOFTWARE INT. INHIBIT)
         LW,R4    S:CUN
         DISABLE                    ***********************************
         LH,R5    UH:FLG,R4
         LW,R6    0,R7              ON/OFF SPECIFIED ?
         BEZ      INHOFF            OFF
         OR,R5    FLG:INH           SET 'INHIBIT' BIT IN UH:FLG
INHRET   STH,R5   UH:FLG,R4         PUT IT AWAY
         B        RTSETCC0          RETURN TO USER
INHOFF   AND,R5   FLG:INHR          RESET 'INHIBIT' BIT IN UH:FLG
         B        INHRET
         PAGE
RTQFI    EQU      % **************************************************
*                 CAL1 ENTRY POINT FOR M:QFI (ENTER FROM RTALTCP)
*                                   R6=FPT(WORD 0)
*                                   R7=PTR. TO FPT(WORD 1)
*                                   R11=RETURN ADR. (TRAPEXIT)
*
         LW,R1    S:CUN             SET UP LOOP THROUGH ICB'S
         LI,R2    ICB
         LI,R4    ICBUN(D)
         LI,R5    ICBPRI(D)
         LI,R10   NINTS
LOOP2    LW,R9    ICBSTAT(W),R2     FIND AN ACTIVE ICB BELONGING TO USER
         BGEZ     QFINA             NOT ACTIVE IF BIT 0 IS RESET
         CB,R1    *R2,R4            BELONG TO THIS USER?
         BE       QFI1              YES
QFINA    AI,R2    ICBSIZE           INCREMENT TO NEXT ICB
         BDR,R10  LOOP2             GO LOOK AT NEXT ONE
         LW,R14   RTERR:QFI         DIDN'T FIND ONE
         B        CALBAD            ABORT USER
QFI1     BAL,R12  RTICBTYP          RETURNS ICBTYP IN R3
         CI,R3    ICBTYP2           IS IT A GJOB ICB?
         BE       QFIOK             NO NEED TO CHECK PRIORITY
         LB,R9    *R2,R5            ICBPRI
         CB,R9    UB:PRIOB,R1       ICBPRI <  UB:PRIOB?
         BG       QFINA             NO - GO CHECK NEXT ONE
QFIOK    LI,R2    0                 SET CONDITION CODE FOR EVENTUAL RET
         LW,R3    YF                CC MASK
         LI,R5    -17
         AW,R5    TSTACK            DEVELOP PSD ADR. IN TSTACK
         AND,R5   X1FFFE            MASK OFF ADR.
         STS,R2   0,R5              USER'S PSD IN TSTACK
         LW,R6    S:CUN
         DISABLE                    ************************************
         LH,R5    UH:FLG,R6
         AND,R5   FLG:INHR          RESET 'INHIBIT' BIT IN UH:FLG
         STH,R5   UH:FLG,R6         PUT IT AWAY
         ENABLE                     ***********************************
         LH,R6    UH:DL,R6          ANYTHING TO DO?
         BNEZ     *R11              YES; EXIT TO TRAPEXIT
         LI,R6    E:QFI             'QUEUE FOR INTERRUPT' EVENT
         BAL,R11  T:REG             REPORT EVENT & GIVE UP CONTROL
         B        TRAPEXIT          RETURN FOR INTERRUPT PROCESSING
         PAGE
RTINTSTAT  EQU    % **************************************************
*                 CAL1 ENTRY POINT FOR M:INTSTAT (ENTER FROM RTALTCP)
*                                   R6=FPT(WORD 0)
*                                   R7=PTR. TO FPT(WORD 1)
*                                   R11=RETURN ADR. (TRAPEXIT)
*
         BAL,R11  INTSTAT           MAKE IT CALLABLE EXTERNALLY
         LW,R3    TSTACK
         STW,R8   -7,R3             PUT R8 IN TSTACK FOR RET TO USER
         CI,R9    STATNA            WAS INT. NOT ACTIVE?
         BE       RTSETCC2          ABNORMAL RETURN
         B        RTSETCC0          NORMAL RETURN
*
*
*
INTSTAT  BAL,R0   RTLOCICB          RETURNS ICB ADR. IN R2
         BCS,3    INTSTAT2          FOUND IT
         LI,R8    0                 INITIALIZE R8
         LI,R9    STATNA            'NOT ACTIVE' CODE FOR R8 RETURN
         B        INTSTATX          EXIT
INTSTAT2 LW,R8    ICBSTAT(W),R2     PICK UP ICBSTAT WORD OF ICB
         SLS,R8   STATINTSHFT       RIGHT-JUSTIFY ICBSTATINT
         AND,R8   M3                MASK IT
         BAL,R12  RTICBTYP          DETERMINE ICB TYPE (RETURNED IN R3)
         CI,R3    ICBTYP2           IS IT TYPE-II (GHOST JOB)?
         BNE      INTSTAT3          NO
         BAL,R0   RTCHKGUN          RETURNS GJOB # IN R5
         LI,R3    2
         STB,R5   R8,R3             PUT IT AWAY
INTSTAT3 LI,R3    ICBUN(D)
         LB,R5    *R2,R3            PICK UP USER #
         LI,R1    1
         STB,R5   R8,R1             PUT IT AWAY
         DISABLE                    ***********************************
         LB,R5    UB:US,R5          PICK UP USER'S CURRENT STATE
         LI,R9    STATWAIT          INITIALIZE R9 WITH 'QFI' CODE
         LW,R5    X1,R5             PICK UP ONE-BIT MASK CORRESPONDING
*                                   TO USER'S STATE
         CW,R5    WAIT:MASK         IS THE STATE 'WAIT' OR 'QFI'?
         BANZ     INTSTATX          YES
         CW,R5    EXU:MASK          IS THE STATE 'EXECUTABLE'?
         BANZ     INTSTAT4          YES
         CW,R5    IOWAIT:MASK       IS THE STATE 'IO-WAIT'?
         BANZ     INTSTAT5          YES
         CW,R5    BLCKD:MASK        IS THE STATE 'BLOCKED'?
         BAZ      RTCRASH           *** SYSTEM ERROR ***
         LI,R9    STATBLK           'BLOCKED' CODE FOR R8 RETURN
         B        INTSTATX
INTSTAT4 LI,R9    STATEXU           'EXECUTABLE' CODE FOR R8 RETURN
         B        INTSTATX
INTSTAT5 LI,R9    STATIOW           'IO-WAIT' CODE FOR R8 RETURN
INTSTATX STB,R9   R8                PUT CODE AWAY
         ENABLE                     *************************************
         B        *R11              RETURN TO CALLER
         PAGE
RTINTRTN EQU      % **************************************************
*                 CAL1 ENTRY POINT FOR M:INTRTN (ENTER FROM ALTCP)
*
*                                   R4(BITS 22-23)=INT. CONTROL CODE
*                                                  FROM CAL1 INSTR.
*                                      WHERE:
*                                      -----------------
*                                        0     LEAVE
*                                        1     DISARM
*                                        2     ARM & ENABLE
*                                        3     ARM & DISABLE
*
*
         LW,R6    R4                PICK UP CODE BITS
         LI,R5    X'FFFF'
         DISABLE                    ************************************
         LW,R2    J:ICBHDR          HEAD OF ICB'S ASSOCIATED WITH USER'S
*                                   CURRENTLY ACTIVE INTERRUPTS
         AND,R2   R5                MASK OFF ADR. FIELD...DA(ICBDL)
         BEZ      INTRTNERR         THERE ISN'T ONE; ABORT USER
         SLS,R2   1                 CONVERT TO WA(ICBDL)
         AI,R2    -ICBDL(W)         R2=WA(ICB)
         LW,R4    ICBDL(W),R2       FIND NEXT ICB IN ACTIVE CHAIN
         STS,R4   J:ICBHDR          ICBDL  BECOMES HEAD;PRESERVE BIT 0
         LW,R3    S:CUN             GET CURRENT USER NUMBER
         LI,R5    ICBPRIO(D)        DISP TO OLD PRIORITY
         LB,R0    *R2,R5            GET IT FROM ICB
         STB,R0   UB:PRIOB,R3       STORE IT IN BASE PRIO
         STB,R0   UB:PRIO,R3        AND WORKING PRIO
         STW,R0   S:CUP             ANNOUNCE IT
         LW,R12   ICBSTAT(W),R2     PICK UP ICB STATUS
         AND,R12  NB31TO0+30        TURN OFF 'ON-DL' FLAG
         AND,R12  NB31TO0+28        TURN OFF 'TRIGGERED' BIT
         STW,R12  ICBSTAT(W),R2     PUT ICB STATUS BACK
         LH,R12   UH:FLG,R3
         AND,R12  FLG:INHR          RESET 'INHIBIT' BIT IN UH:FLG
         STH,R12  UH:FLG,R3         PUT IT AWAY
         LH,R12   UH:DL,R3          GET DO LIST
INTRTNB  LI,R5    X'FFF'            MASK FOR FLINK
         AND,R5   R12               GET POINTER
         BEZ      INTRTNA           NONE
         SLS,R5   1                 WORD ADDRESS
         LW,R12   0,R5              FLINK ON
         LH,R0    R12               GET TYPE
         AND,R0   M7                SCRUB
         CI,R0    2                 TEST FOR INTENTRY
         BNE      INTRTNB           NO
         LB,R0    R12               GET DO LIST PRIO
         CB,R0    UB:PRIOB,R3       COMPARE WITH CURRENT
         BG       INTRTNA           LESS, IGNORE IT
         AI,R5    -ICBPRI(W)        GET BASE OF DO LIST
         LI,R1    ICBPRIO(D)        DISP TO ICB OLD PRIO
         LB,R13   UB:PRIOB,R3       GET USERS CURRENT PRIO
         CB,R13   *R5,R1            CHECK FOR PREVIOUS SAVED PRIORITY
         BL       %+2               REMEMBER LOWEST PRIORITY(HIGHEST NUMBER)
         STB,R13  *R5,R1            SAVE IN TOP ICB
         STB,R0   UB:PRIO,R3        SET AS CURRENT
         STB,R0   UB:PRIOB,R3       FOR USER
         STW,R0   S:CUP             AND ANNOUNCE IT TO WORLD
INTRTNA  ENABLE                     ***********************************
         BAL,R12  RTICBTYP          RETURNS ICB-TYPE IN R3
         CI,R3    ICBTYP3           IS IT A CLOCK-TYPE ICB?
         BNE      INTRTN1           NO
         LW,R4    ICBSTAT(W),R2
         AND,R4   STATO             'ONESHOT' BIT IN ICBSTAT SET?
         BEZ      INTRTNX           NO;
         DISABLE                    ***********************************
         LW,R5    RTICBHDR          HEAD OF FREE ICB'S
         STW,R5   ICBLNK(W),R2      INITIALIZE ICBSTAT & ICBLNK
         STW,R2   RTICBHDR          FREED ICB BECOMES NEW HEAD OF CHAIN
         ENABLE                     ***********************************
         B        INTRTNX
INTRTN1  SLS,R6   C19CS             RIGHT-JUSTIFY WD-CODE FROM CAL1
         AND,R6   M2                MASK OFF LEGAL CODES
         CI,R6    1                 IS THE REQUEST 'DISARM'?
         BNE      INTRTN2           NO
         LI,R6    3                 ARM & DISABLE THE INT. FIRST
         BAL,R15  RTINTCONTROL      CLEAR INTERRUPT
         LI,R6    1                 NOW WE CAN DISARM IT
INTRTN2  BAL,R15  RTINTCONTROL      SET ICBSTAT;
INTRTNX  LI,R6    T:SSEM            SET UP RETURN ADR. FOR MTRTN0 ROUTINE
         B        MTRTN0            M:TRTN PROCESSING IN ALTCP
INTRTNERR  LW,R14 RTERR:INTRTN      ERROR CODE
         B        CALBAD            RETURN TO ALTCP TO ABORT USER
         PAGE
RTHOLD   EQU      % **************************************************
*                 CAL1 ENTRY POINT FOR M:HOLD (ENTER FROM RTALTCP)
*                                   R6=FPT(WORD 0)
*                                   R7=PTR. TO FPT(WORD 1)
*                                   R11=RETURN ADR. (TRAPEXIT)
*
         BAL,R0   RTCHKPRIV         JB:PRIV >= X'E0'?
         BCS,8    RTSETCC1          NO
         LW,R4    S:CUN             USER #
         DISABLE                    ***********************************
         LH,R7    UH:FLG2,R4
         CI,R6    FPTF1             'OFF' SPECIFIED?
         BAZ      HOLDON            NO
         CW,R7    FLG:LIC           'LOCKED-IN-CORE' BIT SET?
         BAZ      RTSETCC0          NO
         AND,R7   FLG:LICR          UH:FLG2 MASK: LIC BIT RESET
         STH,R7   UH:FLG2,R4        RESET UH:FLG2 BITS
         LI,R5    1                 SET 'DECREMENT' FLAG
         BAL,R7   RTLCT             DECREMENT PB:LCT
         BAL,R7   T:TOTSZ           RETURNS USER'S 'UNLOCKABLE' SIZE(R0)
         LCW,R0   R0
         AWM,R0   S:RTCORE          DECREMENT COUNTER
         B        RTSETCC0          RETURN TO USER
*
*
*
HOLDON   EQU      %
         CW,R7    FLG:LIC           'LOCKED-IN-CORE' BIT SET?
         BANZ     HOLD2             YES
         OR,R7    FLG:LIC           UH:FLG2 MASK: LIC BIT SET
         STH,R7   UH:FLG2,R4        TURN ON 'LOCKED IN CORE' BIT
         LW,R3    BT31TO0+32
         STS,R3   J:ICBHDR          SET RT-CAL1-ISSUED BIT
         LW,R3    BT31TO0+31
         STS,R3   S:BADFLG          SET 'RT-LOCK-CORE' BIT
         BAL,R7   T:TOTSZ           RETURNS USER'S 'LOCKABLE' SIZE(R0)
         LI,R5    0                 SET 'INCREMENT' FLAG
         BAL,R7   RTLCT             INCREMENT PB:LCT
         AWM,R0   S:RTCORE          REFLECT USER'S 'LOCKABLE' SIZE
HOLD2    LI,R4    ALLOCAT:UN        ALLY'S USER #
         BAL,R6   RTSIZE            SIZE HIM
         BCS,1    RTSETCC2          IF HE WON'T FIT
         LI,R4    RBBAT:UN          RBBAT'S USER #
         BAL,R6   RTSIZE            SIZE HIM
         BCS,1    RTSETCC2          IF HE WON'T FIT
         B        RTSETCC0          RETURN TO USER
*
*
*
RTLCT    EQU      %                 INCREMENT/DECREMENT PB:LCT FOR ALL
*                                   OF THE USER'S SHARED PROCEDURE
*                                          BAL,R7
*                                          INPUT:  R4=USER #
*                                                  R5=0(IMPLIES INCR.)
*                                                     1(IMPLIES DECR.)
*                                        WORK REGS: R1,R15
*
         LH,R15   UH:FLG,R4
         CI,R15   TIC               TEL IN CONTROL?
         BANZ     LCT1              YES
         CI,R15   DIC               DELTA IN CONTROL?
         BANZ     LCT2              YES
         LB,R1    UB:APR,R4
         EXU      MTBINST,R5        ACCOUNT FOR SHRD PROC ROOT
         LB,R1    UB:APO,R4
         EXU      MTBINST,R5        ACCOUNT FOR SHRD PROC OVERLY
         LB,R1    UB:ASP,R4         ANY SPECIAL SHRD PROCESSOR?
         BEZ      LCT2              NO...GO ACCOUNT FOR DELTA(MAYBE)
LCT3     EXU      MTBINST,R5        ACCOUNT FOR IT
         LB,R1    UB:OV,R4
         EXU      MTBINST,5         ACCOUNT FOR SHRD MON OVERLY
         B        0,R7              RETURN
LCT1     LB,R1    UB:ACP,R4         COMMAND PROCESSOR
         B        LCT3
LCT2     LB,R1    UB:DB,R4          DEBUGGER
         B        LCT3
*
*
MTBINST  MTB,1    PB:LCT,R1         COUNT IT UP
         MTB,-1   PB:LCT,R1         COUNT IT DOWN
*
*
*
         DEF      RTSIZE
RTSIZE   EQU      %                 OBTAINS USER'S SIZE AND DETERMINES
*                                   WHETHER HE WILL FIT IN AVAILABLE
*                                   'UNLOCKED' CORE MEMORY
*                                        BAL,R6
*                                        INPUT:  R4=USER #
*                                        OUTPUT: CC4=0 (IF USER FITS)
*                                                    1 (IF HE WON'T)
*                                        WORK REGS:  R15 THRU R7
*
         BAL,R7   T:TOTSZ           RETURNS USER'S SIZE IN R0
         LW,R2    S:ACORE
         SW,R2    S:RTCORE          YIELDS 'UNLOCKED' AVAILABLE CORE
         SW,R2    R0                AVAILABLE CORE-USER SIZE
         LW,R1    S:STL#
         SW,R1    SL:RSVP           ARE THERE ANY STOLEN PAGES AROUND?
         BLEZ     RTS1              NO
         AW,R2    R1                YES...ADD THEM IN
RTS1     LW,R2    R2                SET CC'S
         B        0,R6              RETURN
         PAGE
RTIOEX1  EQU      % ***************************************************
*                 CAL1 ENTRY POINT FOR M:IOEX(SIO)
*                 ENTER FROM RTALTCP
*                                   R6=FPT(WORD 0)
*                                   R7=PTR. TO FPT(WORD 1)
*                                   R11=RETURN ADR. (TRAPEXIT)
*
         BAL,R0   RTCHKPRIV         JB:PRIV >= X'E0'
         BCS,8    RTSETCC1          NO; ABNORMAL RETURN
         LW,R14   0,R7              FPT(WORD 1)
         BLZ      EX12              IF PRESENCE BIT IS OK
         LW,R14   RTERR:PARAM       'CLIST' IS MISSING
         B        CALBAD            ABORT USER
EX12     LI,R5    EX11              SET POSSIBLE RETURN FROM RTDEVCHK
         CI,R14   FPTDCB            'DEV' OR 'DCB' SPECIFIED?
         BAZ      RTDEVCHK          'DEV'- RETURNS VIA R5 WITH DCTX(R2)
         BAL,R5   RTDCBCHK          VALIDATE DCB-RETURNS DCTX IN R2
         BCS,15   RTSETCC3          BAD DCB; ABNORMAL RETURN
EX11     BCS,3    RTSETCC3          BAD DEVICE ADR; ABN RETURN
         LB,R5    DCT3,R2
         CI,R5    DOWND             IS DEVICE PRE-EMPTED?
         BAZ      RTSETCC1          NO
         LB,R5    DCT15,R2          DOES DEVICE BELONG TO THIS USER?
         BEZ      EX18              IF NO USER IS ASSOCIATED WITH DEVICE
         CW,R5    S:CUN
         BNE      RTSETCC1          NO
EX14     PUSH     R2                SAVE DCTX
         BAL,R2   CHKBIT1           RETURNS 'CLIST' ADR IN R12
         LW,R6    R12               CLIST ADR
         BAL,R3   RTVTP             RETURNS PHYSICAL ADR IN R6
         SLS,R6   -1                CONVET TO DA(CLIST)
         STW,R6   R13               SET UP FOR NEWQ
         OR,R13   BT31TO0+31        SET 'C' BIT OF IOQ8
         BAL,R2   CHKBIT            'EA' SPECIFIED?
         B        EX15              YES
         B        EX13              NO
EX15     LW,R6    R12
         BAL,R3   RTVTP             RETURNS PHYSICAL ADR IN R6
         BLE      EX19              PHY ADR < 128K
         BIF,X560 EXIT              CAN'T ALLOW EXECUTION ADR > 128K
EX19     LW,R2    *TSTACK           GET     DCTX
         PUSH     R7                SAVE CHKBIT REGISTER
         LW,R7    MASKS+22          MASK FOR STS
         STS,R6   DCT12,R2          SAVE 'EA' ADR; PRESERVE BIT 0
         PULL     R7
EX17     BAL,R2   CHKBIT            WAS 'TO' SPECIFIED
         B        EX16              YES
         LI,R12   0                 NO, DEFAULT IS ZERO
EX16     LW,R14   R12               SET UP FOR NEWQ
         LI,R0    0                 NO END-ACTION FROM REQCOM
         BAL,R2   CHKBIT            RETURNS 'PRI' IN R12
         B        EX1A              IF 'PRI' WAS SPECIFIED
         LW,R5    S:CUN
         LB,R5    UB:PRIO,R5        CURRENT EXECUTION PRIORITY
EX1B     PULL     R12               RESTORE DCTX TO R12
         STH,R5   R12               SET UP FOR NEWQ
         LI,R15   0                 SET UP FOR NEWQ
         BAL,R11  NEWQNW            ***********************************
         B        EXSC              BAD RETURN FROM NEWQ
         LW,R3    YC                SET 'RT-ACTIVITY' BIT &
         STS,R3   J:ICBHDR              'IOEX-ACTIVITY' BIT IN JIT
         B        RTSETCC0          RETURN TO USER
*
*
EXSC     SCREECH  X'41',X'10'
EX13     LW,R2    *TSTACK           GET DCTX
         LW,R12   DCT12,R2          WAS 'EA' ADDRESS SPECIFIED
*                                   AT TIME OF STOPIO REQUEST?
         BNEZ     EX17              YES; CONTINUE
EXIT     PULL     R2                NO; RESTORE STACK
         B        RTSETCC2          ABNORMAL RETURN
*
EX18     CW,R14   FPTEA             WAS 'EA' SPECIFIED?
         BAZ      RTSETCC2          NO; ABNORMAL RETURN
         LW,R5    S:CUN
         STB,R5   DCT15,R2          SINCE SYSCON DOESN'T SET DCT15
         B        EX14              CONTINUE
*
EX1A     LW,R5    R12               MOVE PRI TO R5
         B        EX1B              CONTINUE
         PAGE
RTIOEX2  EQU      % ***************************************************
*                 CAL1 ENTRY POINT FOR M:IOEX(TIO/TDV/HIO)
*                 ENTER FROM RTALTCP
*                                   R6=FPT(WORD 0)
*                                   R7=PTR. TO FPT(WORD 1)
*                                   R11=RETURN ADR.(TRAPEXIT)
*                 NOTE:  SINCE CONDITION CODES ARE USED TO REFLECT I/O
*                        INSTRUCTION STATUS, ANY ABNORMAL CONDITIONS ARE
*                        REPORTED TO THE USER VIA AN ABORT
*
         BAL,R0   RTCHKPRIV         JB:PRIV >= X'E0'
         BCR,8    EX21              YES
         LW,R14   RTERR:IOEX1       NO; ABORT USER
         B        CALBAD
EX21     LI,R5    EX22              SET UP POSSIBLE RETURN FROM RTDEVCHK
         LW,R4    0,R7              FPT(WORD 1)
         CI,R4    FPTDCB            'DEV' OR 'DCB' SPECIFIED?
         BAZ      RTDEVCHK          'DEV'; RETURNS VIA R5 WITH DCTX(R2)
         BAL,R5   RTDCBCHK          'DCB'-RET: DCTX(R2); DEV.ADR(R6)
         BCR,15   EX24              OK
EX23     LW,R14   RTERR:IOEX2       NO; ABORT USER
         B        CALBAD
EX22     BCS,3    EX23              RETURN HERE FROM RTDEVCHK
EX24     LB,R5    DCT3,R2
         CI,R5    DOWND             IS DEVICE PRE-EMPTED?
         BAZ      EX23              NO; ABORT USER
         LW,R5    S:CUN
         CB,R5    DCT15,R2          DOES IT BELONG TO THIS USER?
         BNE      EX23              NO; ABORT
         AND,R4   MASKS+2           MASK OFF CODE
         LCI      0
         EXU      IOINST,R4         EXECUTE INSTRUCTION
EX25     BCS,2    CC3FAIL
         STCF     R2                SAVE CONDITION CODES
         LW,R5    TSTACK
         STW,R8   -7,R5             SAVE R8 IN USER'S R8 IN STACK
         STW,R9   -6,R5             SAVE R9 IN USER'S R9 IN STACK
         AI,R5    -17               POINT TO PSD IN STACK
         AND,R5   X1FFFE            INSURE DBL-WD BOUND
         LW,R3    YF                CC MASK
         STS,R2   0,R5              PUT CC'S IN USER'S PSD
         LW,R3    YC                SET 'RT-ACTIVITY' BIT &
         STS,R3   J:ICBHDR              'IOEX-ACTIVITY' BIT IN JIT
         B        *R11              RETURN
*
*
*
IOINST   EQU      % ***************************************************
         TIO,R8   *R6
         TDV,R8   *R6
         B        EXHIO             HIO LOGIC REQUIRES IOQ MANIPULATION
*
*
*
EXHIO    EQU      %
         DISABLE                    *********************************
         HIO,R8   *R6
         BAL,R11  EX25              SAVE STATUS
         LI,R11   TRAPEXIT          SET RETURN ADR
         LB,R4    DCT15,R2          PRE-EMPTED DEVICE?
         BEZ      ENBSR4            NO, EXIT CAL1 PROCESSING
         LW,R4    DCT12,R2          INTERRUPT PENDING?
         BGEZ     ENBSR4            NO, EXIT CAL1 PROCESSING
         AND,R4   NB31TO0+32        YES...RESET 'INT PEND' FLAG
         STW,R4   DCT12,R2          PUT IT AWAY
         LW,R1    R2                SET UP R1(DCTX) FOR INTSIM(IOQ)
         LI,R5    HIORET            SET RETURN FROM INTSIM
         OR,R5    BT31TO0+32        SET FLAG IN LINK REGISTER
         B        INTSIM            SETS 'CLEANUP PENDING'
HIORET   BAL,R2   DRIVEIO           DO CLEANUP; RETURNS ENABLED
         B        TRAPEXIT          EXIT
         TITLE    'I O Q      S U B R O U T I N E S'
         DEF      RTIOSTRT
RTIOSTRT EQU      % ***************************************************
*                 IOQ COMES HERE AFTER SUCCESSFULLY ISSUING AN SIO
*                 RESULTING FROM AN IOEX (SIO) REQUEST
*                                   BAL,R7 (FROM IOSTRT)
*                                   INPUT:  R1=DCT INDEX
*                                   OUTPUT: R9 IS SET UP TO BE MODIFIED
*                                           AND STORED INTO DCT5 BY IOQ
*                                           UPON RETURN
*                                   WORK REGS:  R0
*
         STD,R12  DCT13,R1          SAVE SIO REGISTERS
         LW,R0    DCT12,R1
         OR,R0    BT31TO0+32        SET 'INTERRUPT PENDING' BIT
         STW,R0   DCT12,R1          PUT IT AWAY
         AI,R9    X'80'             SET-UP R9 AS DCT5
         B        0,R7              RETURN TO IOQ AT IOSTRT3
         PAGE
         DEF      RTINT
RTINT    EQU      % ***************************************************
*                 IOQ COMES HERE AT I/O INTERRUPT-TIME FOR IOEX REQUESTS
*                                   INPUT:  R6=END ACTION RECEIVER ADR
*                                           R7=DCT INDEX
*                                           R2=DEVICE ADDRESS
*                                           R3=AIO STATUS
*                                   RETURN IS TO RTRET1 OR RTRET2
*                                   DEPENDING UPON CHANNEL STATUS
*
         LCI      0
         TIO,R4   0,R2              TIO STATUS TO R4/R5
         BCS,2    CC3FAIL
         STCF     R4                CC'S TOO
         PUSH     11,R1
         BAL,R11  0,R6              GOTO USER'S END ACTION ADDRESS
         PULL     11,R1
         LC       R4                TIO STATUS ANY GOOD?
         BCS,8    RTRET2            NO...LEAVE CHANNEL BUSY
         AND,R5   Y6                CHECK TIO STATUS FOR DEVICE STATUS
         SLS,R5   4
         BCR,4    INT1              DEVICE/CHANNEL IS CLEAR
         BEV      RTRET2            DEVICE/CHANNEL IS BUSY
INT1     AND,R6   NB31TO0+32        RESET 'INT PEND' FLAG
         STW,R6   DCT12,R7          PUT IT BACK
         B        RTRET1            RETURN TO IOQ ... CLEAR CHANNEL
         PAGE
         DEF      RTCU
         REF      IOSCU
RTCU     EQU      % *************************************************
*                 IOQ COMES HERE AT I/O CLEANUP-TIME FOR IOEX REQUESTS
*                                   INPUT:  R1=DCT INDEX
*                                   OUTPUT: R12=HANDLER FLAGS (0)
*
         LB,R12   DCT3,R1           PICK UP FLAGS
         AND,R12  SIOREJECT         ABNORMAL CLEANUP?
         BEZ      IOSCU             NO
*                                   YES...GO TO USER'S END-ACTION ADR.
         PUSH     7,R13
         LW,R7    R1                DCT INDEX
         LI,R1    -1                'SIOREJECT' FLAG
         LB,R3    DCT19,R7          SIO CONDITION CODES AT FAILURE
         STB,R3   R3                POSITION THEM
         LD,R4    DCT13,R7          SIO STATUS REGS AT FAILURE
         LW,R6    DCT12,R7          USER'S END-ACTION ADR.
         BAL,R11  0,R6              GO TO HIM
         PULL     7,R13
         LI,R12   0                 HANDLER FLAG
         B        IOSCU             RETURN TO IOQ
         PAGE
         DEF      RTTO
RTTO     EQU      % **************************************************
*                 IOQ COMES HERE AFTER DETECTING A TIME-OUT FOR AN
*                 IOEX-TYPE OF REQUEST
*                                   INPUT:  R1=DCT INDEX
*                                           R6=USER'S EA ADDRESS
*                                   OUTPUT: (NOTHING)
*
         LI,R2    0                 SET 'TIME-OUT' FLAG
         LB,R3    DCT19,R1          PICK UP SIO CC'S
         STB,R3   R3                POSITION THEM
         LD,R4    DCT13,R1          SIO STATUS REGISTERS TO R4/R5
         PUSH     R1                SAVE DCTX
         PUSH     R11               SAVE RETURN
         LW,R7    R1                DCT INDEX TO R7
         LI,R1    0                 SET 'TIME-OUT' FLAG(#2)
         BAL,R11  0,R6              GO TO USER'S EA ROUTINE
         PULL     R11
         PULL     R1
         B        *R11              RETURN TO IOQ
         PAGE
*********************************************************************
*                                   S E C T I O N    IV:
*
*                               INTERRUPT PROCESSING ROUTINES
*********************************************************************
*
         PCC      0
         DEF      RT:GINT,RT:UINT,RT:INTENTRY
         REF      RT:GINTP,T:GJOB,T:SSE,RT:UINTP
         REF      YFF,UH:DL,XF0,S:CUP,S:RTIR
         REF      S:RTUN,T:RUE,J:TCB,ALTERR
         REF      24BM18,24BM14,T:PULLE
         REF      XFFF
M12      EQU      XFFF
         TITLE    'I N T E R R U P T      H A N D L E R'
*
*        INTERRUPT HANDLER FOR GHOST INITIATION
*
*        ENTRY IS MADE VIA AN XPSD WHICH POINTS AT THE
*        INTERRUPT CONTROL BLOCK(ICB) FOR THIS INTERRUPT.
*
*        INTERRUPTS WILL BE INHIBITED AT ENTRY
*
RT:GINT  EQU      %
         PUSH     6,13              SAVE SOME WORKING REGISTERS
         INT,1    RT:GINTP          GET POINTER TO ICB
         LD,0     *1                GET REAL PSD AT INTERRUPT
*                                   SINCE WE ARE HERE AS THE RESULT
*                                   OF TWO CONSECUTIVE XPSD EXECUTIONS
         BAL,2    T:SAVE            SAVE A STADARD ENVIRONMENT
         INT,1    RT:GINTP          RECONSTRUCT POINTER TO ICB
         AI,1     -ICBPSD1(W)       POINT TO BASE OF ICB
         INT,7    ICBINT(W),1       GET INTERRUPT ADDRESS
         CI,7     X'1000'           CHECK FOR PSEUDO INTERRUPT
         BGE      GINT1             YES
         LW,R10   R7                GET INTERRUPT ADDRESS
         LI,R3    X'1200'           ARM AND ENABLE (CLEAR)
         BAL,R0   RTWD              DO WRITE DIRECT
GINT1    LI,R2    ICBGJPRI(D)       POINT TO PRIORITY FOR GHOST
         LB,R15   *R1,R2            GET IT FOR GJOB START
         PUSH     R1                SAVE ICB ADDRESS
         LCI      2                 SET TO MOVE TWO WORDS
         LM,8     ICBGJACN(W),1     GET ACCOUNT
         LM,0     ICBGJNME(W),1     GET NAME FOR GHOST
         BAL,10   T:GJOB            INITIATE THAT GHOST
         PULL     R1                RESTORE ICB ADDRESS
         LI,R2    ICBGUN(D)         DISPLACEMENT TO USER NUMBER OF GHOST
         STB,R4   *R1,R2            SAVE USER NUMBER ASSIGNED
         B        T:SSE             GO SCHEDULE
*
         PAGE
*
*        USER ENTRY INTERRUPT HANDLER
*
*        DISABLED AT ENTRY
*
*
RT:UINT  PUSH     6,13              SAVE 13,14,15,0,1,2
         INT,1    RT:UINTP          GET ICB POINTER
         LD,0     *1                GET PSD
         BAL,2    T:SAVE            SAVE A STANDARD ENVIRONMENT
         INT,1    RT:UINTP          RESTORE ICB POINTER
         AI,1     -ICBPSD1(W)       POINT TO BASE OF ICB
         BAL,R11  UINTQ             QUEUE INTERRUPT FOR USER
*                                   AND REPORT TO SCHEDULER
         B        T:SSE             EXIT TO SWAPSCHEDULER
         PAGE
*
*        UINTQ - SUBROUTINE TO QUEUE 'DO' LIST ENTRY
*                FOR USER AND REPORT TO SCHEDULER.
*
*        R11 = LINK
*        R1 = BASE ADDRESS OF INTERRUPT CONTROL BLOCK (ICB)
*             (DESTROYED)
*
*        ALL OTHER REGISTERS VOLATILE
*
*        MUST BE CALLED DISABLED, ENABLES ON EXIT.
*
UINTQ    RES      0
         LI,2     ICBUN(D)          INDEX TO ASSOCIATED USER NUMBER
         LB,5     *1,2              GET USER NUMBER
UINT01   LW,8     ICBPRI(W),1       GET ICB PRIORITY
         LW,9     YFF               MASK FOR PRIO
         ANLZ,12  UINT01            WA OF ICB DO LIST BLOCK
         LC       *R1               CHECK FOR ALREADY ON DO LIST
         BCS,2    UINT8             YES...GET OUT SMARTLY
         SLS,12   -1                CONVERT TO DOUBLE WORD ADDRESS
         LH,2     UH:DL,5           GET USERS DO LIST ENTRY
         AND,2    M12               EXTRACT CHAIN POINTER
         BEZ      UINT4             NULL
         LW,3     2                 REMEMBER CURRENT ENTRY
         LD,6     0,2               GET HEADER OF FIRST BLOCK
         CS,8     6                 CHECK PRIORITY
         BL       UINT4             CHAIN AT HEAD
*
UINT1    AND,6    M12               MASK FLINK TO NEXT BLOCK
         BEZ      UINT2             AT END, QUEUE TO TAIL
         LW,2     6                 SAVE CURRENT ENTRY
         LD,6     0,6               FLINK
         CS,8     6                 CHECK PRIO
         BL       UINT2             THIS IS THE PLACE
         LW,3     2                 REMEMBER CURRENT ENTRY
         B        UINT1             KEEP GOING
*
UINT2    LI,13    X'FFF'            MASK FOR ACTIVE POINTER BITS
         LD,6     0,3               PICK UP FORWARD LINK FROM PREVIOUS
         SLS,3    1                 CONVERT TO WORD ADDRESS
         STS,12   0,3               MAKE PREVIOUS POINT TO US
         LI,7     X'FFF'            MASK
         STS,6    ICBPRI(W),1       AND MAKE US POINT TO FLINK
*
*
UINT3    LC       *1                GET CLEAR FLAG
         BCR,4    UINT6             EITHER: NO 'CLEAR' OR CLK-TYPE ICB
         LW,R10   ICBINT(W),R1      GET INTERRUPT ADDRESS
         CI,R10   X'F000'           CHECK FOR PSEUDO
         BANZ     UINT5             YES
         LI,R3    X'1200'           ARM AND ENABLE (CLEAR)
         BAL,R0   RTWD              DO WRITE DIRECT
UINT5    LB,4     *1                GET INTERRUPT STATUS
         AND,4    XF0               RESET
         AI,4     6                 SET ARM AND ENABLE
         STB,4    *1                RESTORE
*
UINT6    LB,0     8                 GET CURRENT INTERRUPT PRIO
         LI,R4    0                 ZAPPER FOR OLD PRIO
         CB,R0    UB:PRIOB,R5       CHECK FOR CURRENT USER PRIO
         BG       UINT65            LOWER
         LB,R4    UB:PRIOB,R5       GET OLD VALUE
         STB,R0   UB:PRIOB,R5       RAISE HIS PRIO
UINT65   LI,R6    ICBPRIO(D)        DISP TO OLD PRIO
         STB,R4   *R1,R6            SAVE OLD PRIO
         LW,R3    Y2                SET ON-DO-LIST FLAG
         STS,R3   ICBSTAT(W),R1     TO PREVENT CIRCULAR CHAINS
         CW,0     S:CUP             CHECK AGAINST CURRENT USER
         BG       UINT7             LOWER
         LI,9     0                 SET FLAG
         STW,9    S:RTIR            IN S:RTIR TO BYPASS QMIN
         STW,5    S:RTUN            AND REMEMBER REAL TIME USER
UINT7    ENABLE
         LI,6     E:ART             ADD REAL TIME TASK
         B        T:RUE             REPORT USER EVENT
*
*
UINT4    LH,2     UH:DL,5           GET DO LIST POINTER
         LI,3     X'FFF'            MASK FOR POINTER BITS
         STS,2    ICBPRI(W),1       REMEBER FLINK
         LS,2     12                GET NEW HEAD
         STH,2    UH:DL,5           STORE NEW HEAD
         B        UINT3
*
*
*
UINT8    LW,10    ICBINT(W),1       GET INT ADR
         CI,10    X'F000'           CHECK FOR PSEUDO
         BANZ     ENBSR4            IF PSEUDO
         CI,10    X'5A'             CHECK FOR CLOCK
         BE       ENBSR4            IF CLOCK
         LI,3     X'1200'
         BAL,0    RTWD              CLEAR THE INTERRUPT(ARM & ENABLE)
         B        ENBSR4            GET OUT
         PAGE
*
RT:INTENTRY EQU   %
*
*
*        ROUTINE TO PERFORM USER INTERRUPT ENTRY AT
*        RESCHEDULING.  ENTERED FROM DO LIST PROCESSING
*        IN SCHEDULER.  DO LIST BLOCK CONTAINS HIGHEST PRIORITY
*        INTERRUPT FOR USER.
*
*        R4 = USER NUMBER
*        R5 = DOUBLEWORD ADDRESS OF DO LIST BLOCK
*        R6 = HEADER WORD
*
*        NORMAL EXIT IS TO T:PULLE
*
*        ERROR EXIT TO ALTERR IF TCB STACK PROBLEM
*
         LW,R6    R5                R5=DA(ICBDL)
         SLS,R5    1                CONVERT TO WA(ICBDL)
         LI,R7    X'FFFF'           MASK
         AI,R5    -ICBDL(W)         POINT TO BASE OF ICB
         LW,R8    J:ICBHDR          GET HEAD OF CURRENT CHAIN
         LI,R9    X'FFFF'           MASK
         STS,R8   ICBDL(W),R5       POINT TO REST OF CHAIN
         STS,R6   J:ICBHDR          SET NEW HEAD (DA(ICBDL))
         LW,R1    J:TCB             GET USERS TCB POINTER
         BEZ      ALTERR            NONE
         BAL,R4   T:UTSXTS          MOVE ENVIRONMENT TO STACK
         B        ALTERR            SOME KIND OF PROBLEM
         LW,R5    J:ICBHDR          PICK UP DA(ICBDL) OF 1ST ICB
         SLS,R5   1                 CONVERT TO WA(ICBDL)
         AI,R5    -ICBDL(W)         POINT TO TOP OF ICB
         LW,R10   ICBENTPSD0(W),R5  GET PSD
         LW,R6    TSTACK
         CI,R6    1                 CHECK FOR ODD
         BAZ      %+2               NO
         AI,R6    1
         STW,R10  *24BM18,R6        SET NEW PSD
         INT,R11  ICBINT(W),R5      GET INTERRUPT
         LW,R2    J:TCB
         LW,R3    0,R2              GET TOP OF TCB STACK
         STW,R11  0,R3              REMEMBER ADDRESS OF CURRENT INT
         AI,R3    -18
         LW,R2    TSTACK
         STW,R3   *24BM14,R2        SET PSD POINTER
         B        T:PULLE           GO TO HIM
         PAGE
         END

