         TITLE    'R T N R R T     D A T A'
*********************************************************************
*                       NON-RESIDENT REAL-TIME MODULE
*
*
*
         DEF      RTNR
RTNR     EQU      %
*
*
*********************************************************************
*                                   S E C T I O N    I:
*
*                                     DATA DEFINITIONS
*********************************************************************
*
UTSPROC  SET      1                 PICK-UP X560 PROC
         SYSTEM   UTS
         B        RTNRRTSEG:EP
*        SYSTEM   RT:ICBTD          ICB TABLE DEFINITIONS
**********************************************************************
*        NOTE:  THE FOLLOWING SYMBOL DEFINITIONS APPEAR ALSO
*               IN THE MODULE 'RTROOT'; 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
         REF      RTCNVTXT,RTWD,RTLOCICB,RTCHKPRIV,RTICBTYP,RTCHKGUN;
                 ,YF,X1FFFE,MASKS;
                 ,UH:FLG,S:BADFLG,RTLCT,T:TOTSZ,S:RTCORE;
                 ,UB:PRIO,UB:PRIOB,S:CUP;
                 ,S:CUN,SYSACCT,E:OFF,T:RUE,UH:FLG2,UH:DL;
                 ,MONORG,RMAOVSEG,T:MODPRTRT#,RTVTP,RTDEVCHK,RTDCBCHK;
                 ,AVRTBL,AVRTBLSIZ,AVRTBLNE,BATAPE,DCTSIZ,DCT5;
                 ,E:SL,U:MISC;
                 ,DCT2,DCT3,DCT4,DCT12,DCT15,DCT24,TB:FLGS,CIT3;
                  ,M24,PPTABLE,PPTABLSZ,PP:UPPH,MX:PPUT,M16,T:REG;
                 ,CALBAD,TINC,C:CTUN;
                 ,NINTS,ICB,ICBSIZE,RTICBHDR,RTICBCLKHDR,J:ICBHDR;
                 ,J:BASE,JB:PRIV,SL:GPRIO,SL:BPRIO,SL:OPRIO;
                 ,RT:UINTP,RT:GINTP,MAXG,S:GJOBTBL,S:GJOBACN,J:JIT
*
*
         SREF     COH:II,COH:IO,LCOC
*
*                                   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
*
FPTCAN   EQU      1                 M:CLOCK FPT 'CANCEL' BIT
FPTO     EQU      2                 M:CLOCK FPT 'ONESHOT' BIT
FPTM     EQU      4                 M:CLOCK/M:CONNECT FPT 'MASTER' BIT
FPTCLR   EQU      2                 M:CONNECT FPT 'CLEAR' BIT
FPTD     EQU      1                 M:CONNECT FPT 'DISABLE' BIT
FPTP2    EQU      BT31TO0+31        PRESENCE BIT
FPTP3    EQU      BT31TO0+30        PRESENCE BIT
FPTDCB   EQU      BT31TO0+16        M:STOPIO/STARTIO FPT 'DCB' P-BIT
FPTEA    EQU      X'4000'           M:STOPIO FPT 'EA' PRESENCE BIT
*
             BOUND   8
REAL:RANGE   DATA X'60',MONORG-1    RANGE OF REAL INT. ADRS.
         BOUND    8
PSEUDO:RANGE DATA X'1000',X'7FFF'   RANGE OF PSEUDO INTS.
*
         BOUND    8
PSD1DW   DATA     0,0
PSD2DW   :PSD     (IA,ICBXPSD(W)),(WK,1),INH
PSDMM    EQU      BT31TO0+23        PSD 'MAPPED' BIT
PSDMS    EQU      BT31TO0+24        PSD 'MASTER/SLAVE' BIT
*
STATINITAE   DATA X'86000000'       ICBSTAT: ACTIVE,A&E,TYPE-I
STATINITD   DATA  X'82000000'       ICBSTAT: ACTIVE,ARMD & DSBLD,TYPE-I
STATINITGJ   DATA X'86800000'       ICBSTAT: ACTIVE,A&E,TYPE-II
STATINITCLK  DATA X'87000000'       ICBSTAT: ACTIVE,A&E,TYPE-III
*
PRIODFLT EQU      X'F8'             DEFAULT EXECUTION PRIORITY
DLFLGDATA    DATA X'00820000'       DO-LIST FLAG DATA
RTMTW    MTW,0    0                 DUMMY INSTR. FOR INT. LOCS.
RTXPSD   XPSD,0   ICBPSD1(W)        INSTR. FOR INT. LOCATIONS WHEN INITIALIZED
CONXPSD  XPSD,0   RT:UINTP
GJOBXPSD XPSD,0   RT:GINTP
RTERR:SETUP  DATA X'040000B8'       ILLEGAL INT. ADR. OR TEXT LBL.
RTERR:MRP    DATA X'050000B8'       MISSING REQUIRED PARAMETER
RTERR:CLK    DATA X'060000B8'       NO TIMER UNITS SPECIFIED VIA CAL1
*
FLG:LIC  EQU      X'800'            UH:FLG2 MASK: 'LOCKED-IN-CORE' BIT
FLG:LICR EQU      NB31TO0+12                      LIC BIT RESET
*
FLG:INHR EQU      NB31TO0+2         UH:FLG MASK: SOFTWARE INHIBIT RESET
*
DLFLNK   EQU      1                 UH:DL FORWARD LINK (HALFWORD) DISPL.
*
DEVTYP   EQU      %                 TB:FLGS FOR NON-PRE-EMPTABLE DEVICE
         DATA,1   X'FF';            0 - NULL
                 ,X'30';            1 - NO
                 ,X'73';            2 - TY
                 ,X'C0';            3 - DC
                 ,X'3B'             4 - ME
#DEVTYP  EQU      BA(%)-BA(DEVTYP)-1       # ENTRIES IN TABLE
         BOUND    4
*
NOPARTD  EQU      1                 DCT24 FLG: DEVICE NOT PRE-EMPTABLE
PERDWND  EQU      2                 DCT24 FLG: DEVICE DOES NOT EXIST
DOWND    EQU      X'20'             DCT3 FLG: PRE-EMPTED DEVICE
BUSYBIT  EQU      X'80'             DCT5 FLG: DEVICE BUSY
*
         TITLE    'RT USER-SERVICE SUBROUTINES'
*********************************************************************
*                                   S E C T I O N    II:
*
*                                        SUBROUTINES
*********************************************************************
*
RTSETUP  EQU      % **************************************************
*                 COMMON SETUP LOGIC FOR M:CONNECT AND M:GJOBCON
*                                   BAL,R12
*                                   INPUT:  R6=FPT(WORD 0)
*                                           R7=PTR. TO FPT(WORD 1)
*                                           R11=RETURN ADR. (TRAPEXIT)
*                                   OUTPUT: R1=1 IF INT. IS REAL
*                                              2 IF INT. IS PSEUDO
*                                           R2=ICB ADR.
*                                           R7=PTR. TO FPT(WORD 2)
*                                           R8=FPT(WORD1)
*                                           R10=INT. ADR.
*                                           R11=RETURN ADR. (TRAPEXIT)
*                                           R14=DEFAULT EXEC PRIO
*                                               (IF INTLBL SPECIFIED
*                                                OR INT IS REAL)
*                                               0 (IF INT IS PSEUDO)
*
         BAL,R0   RTCHKPRIV         JB:PRIV >= X'E0'?
         BCS,8    RTSETCC1          NO
         LI,R14   0                 INITIALIZE EXEC PRIO
         CI,R6    X'8000'           SEE IF TEXT LBL.
         BAZ      SU2               NO
         BAL,R15  RTCNVTXT          CONVERT TEXT LBL.TO INT.ADR.VIA R6
*                                   R14 = DEFAULT EXECUTION PRIORITY
         BCR,3    RTERR1            IT DIDN'T CONVERT; ABORT USER
SU2      BAL,R0   RTCHKINT          RET. WITH R1=0 IF INVALID INTERRUPT
*                                                1 IF REAL INTERRUPT
*                                                2 IF PSEUDO INT.
         CI,R1    1                 WHAT KIND OF INTERRUPT?
         BL       RTERR1            IF INVALID
         BG       SU1               IF PSEUDO
         MTW,0    R14               IF REAL; EXEC PRIO DEFINED YET?
         BNEZ     SU1               YES
         LW,R14   R6                EXEC PRIO = INT ADR
         AI,R14   -X'4F'                               -X'4F' (SCALAR)
SU1      EQU      %
         LW,R10   R6                SAVE INT.    ADR. IN R10
         LW,R8    0,R7              CHECK FPT (WORD 1)
         BGEZ     RTERR2            MISSING REQUIRED PARAMETER
         DISABLE                    ***********************************
         BAL,R0   RTLOCICB          FIND ICB ASSOCIATED WITH INT. ADR.
         BCS,3    RTSETCC3          INT. IN USE; ABNORMAL RETURN
         BAL,R0   RTGETICB          GET AN AVAILABLE ICB (VIA R2)
         BCR,3    RTSETCC2          NONE AVAILABLE; ABNORMAL RETURN
         ENABLE                     ***********************************
         AI,R7    1                 INCREMENT FPT POINTER
RTSETJIT LW,R3    BT31TO0+32
         STS,R3   J:ICBHDR          SET HIGH-ORDER BIT TO INDICATE RT-CAL1
         B        *R12              RETURN
         PAGE
RTLOCLKICB  EQU   % **************************************************
*                 LOCATE A TYPE-III ICB (ASSOCIATED WITH THE CURRENT
*                 USER) GIVEN THE ENTRY ADDRESS OF THE ICB
*                                   BAL,R0
*                                   INPUT:  R6=ENTRY ADR.
*                                   OUTPUT: R2=ICB ADR. (IF FOUND)
*                                           CC3/CC4=0 (IF NOT FOUND)
*                                   WORK REGS: R1,R3,R5,R12,R13,R15
*
         LI,R15   NINTS             SET UP SEARCH LOOP
         LI,R1    ICBENTPSD0(D)
         LI,R2    ICB               ADR. OF FIRST ICB
LOOP     LW,R13   ICBSTAT(W),R2     IS ICB ACTIVE?
         BGEZ     LOCNA             NO: BIT 0 WOULD BE SET
         LW,R13   *R2,R1            PICK UP ICBENTPSD0
         AND,R13  MASKS+17          MASK OFF ADR.
         CW,R13   R6                DOES IT MATCH?
         BE       LOCATE            YES
LOCNA    AI,R2    ICBSIZE           INCREMENT TO NEXT ICB
         BDR,R15  LOOP              GO LOOK AT NEXT ICB
         LI,R2    0                 DIDN'T FIND IT
         B        *R0               RETURN TO CALLER
LOCATE   BAL,R12  RTICBTYP          DETERMINE ICBTYP (RETURNED VIA R3)
         CI,R3    ICBTYP3           IS IT TYPE-III?
         BNE      LOCNA             NO
         LI,R5    ICBUN(D)
         LB,R13   *R2,R5            ICBUN
         CW,R13   S:CUN             DOES IT BELONG TO THIS USER?
         BNE      LOCNA             NO
         LW,R2    R2                PASS ICB ADR. TO CALLER & SET CC'S
         B        *R0               RETURN
         PAGE
RTGETICB EQU      % ***************************************************
*                 OBTAIN AN AVAILABLE (FREE) ICB
*                                   BAL,R0 (DISABLED)
*                                   INPUT:  NONE
*                                   OUTPUT: R2=ICB ADR. (IF AVAILABLE)
*                                           CC3/CC4=0 (IF NONE ARE AVAILABLE)
*                                   WORK REGS: R15
*
         LW,R2    RTICBHDR          ARE THERE ANY ICB'S AVAILABLE?
         BEZ      *R0               NO; RETURN WITH CC3/CC4=0
         LW,R15   ICBLNK(W),R2      PICK UP NEXT ICB IN CHAIN
         AND,R15  MASKS+17          MASK OFF ADR. FIELD
         STW,R15  RTICBHDR          IT BECOMES HEAD OF CHAIN
         LW,R2    R2                SET CC'S FOR RETURN
         B        *R0               RETURN
         PAGE
RTERR1   EQU      %
         LW,R14   RTERR:SETUP
         B        RTERRX
RTERR2   EQU      %
         LW,R14   RTERR:MRP
         B        RTERRX
RTERR3   EQU      %
         LW,R14   RTERR:CLK
RTERRX   ENABLE                     ***********************************
         LI,R11   CALBAD            SET RETURN FROM T:SELFDESTRUCT
         B        T:SELFDESTRUCT
         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        T:SELFDESTRUCT    EXIT CAL PROCESSING THROUGH TRAPEXITT
         SPACE    5
RTCRASH  SCREECH  X'43',3           TRYING TO RELEASE SYSICB1 (CLOCK3)
         PAGE
RTCHKINT EQU      % **************************************************
*                 DETERMINES WHETHER AN INTERRUPT ADDRESS IS VALID
*                                   BAL,R0
*                                   INPUT:  R6=INT. ADR.
*                                   OUTPUT: R1=0 IF INT. IS NOT VALID
*                                              1 IF INT. IS REAL
*                                              2 IF INT. IF PSEUDO
*                                   WORK REGS: R4
*
         LI,R1    0                 SET UP ERROR RETURN
         CLM,R6   REAL:RANGE        IS IT REAL
         BCR,9    CHK1              YES
         CLM,R6   PSEUDO:RANGE      IS IT PSEUDO?
         BCR,9    CHK2              YES
         B        *R0               RETURN WITH R1=0
CHK1     LI,R4    COH:II            COC-LESS SYSTEM?
         BEZ      CHKOK             YES....INT IS OK
         LI,R4    0                 INITIALIZE INDEX REG.
CHKCOC   CH,R6    COH:II,R4         COC INPUT INT.?
         BE       CHKBAD            YES
         CH,R6    COH:IO,R4         COC OUTPUT INT.?
         BE       CHKBAD            YES
         AI,R4    1                 NEXT COC
         CI,R4    LCOC              LAST COC?
         BLE      CHKCOC            NO; GO BACK FOR NEXT ONE
         BIF,S9S7 CHKOK
         LW,R4    R6                SPECIAL S560 INTERRUPT ADR CHECK
         AND,R4   MASKS+4           MASK OFF INT LEVEL
         CI,R4    12                .XC THROUGH .XF ARE ILLEGAL ON X560
         BGE      CHKBAD
CHKOK    EQU      %
         LI,R1    1                 INT. ADR. IS REAL
CHKBAD   B        *R0               RETURN WITH R1=0/1
CHK2     LI,R1    2                 SET UP RETURN
         B        *R0               RETURN WITH R1=2
         PAGE
RTGETFPT EQU      % ***************************************************
*                 THIS ROUTINE WILL PICK UP THE WORD (IN THE FPT)
*                 POINTED TO BY R7, DETERMINE IF IT IS INDIRECT,
*                 AND IF SO, WHETHER IT IS AN ADDRESS OR A REGISTER,
*                 AND PASS THE EFFECTIVE VALUE BACK TO THE USER
*                                   BAL,R0
*                                   INPUT:  R7=POINTER TO WORD IN FPT
*                                   OUTPUT: R6=REQUESTED FPT VALUE
*                                   WORK REGS: NONE
*
         LW,R6    0,R7              PICK UP REQUESTED FPT WORD
         BGEZ     *R0               IF NOT INDIRECT, RETURN
         CI,R6    X'1FFF0'          IS IT A REGISTER?
         BANZ     GET1              NO
         AW,R6    J:BASE            ADD DISPLACEMENT ADR. IN TSTACK
GET1     LW,R6    0,R6              PICK UP INDIRECT ITEM
         B        *R0               RETURN
         TITLE    'RT CAL1 SERVICE ENTRY POINTS'
*********************************************************************
*                                   S E C T I O N    III:
*
*                                    CAL1 ENTRY POINTS
*********************************************************************
*
RTNRRTSEG:EP  EQU % ****************************************************
*                 ENTRY POINT FOR RTNRRTSEG OVERLAY
         AI,R0    TV                ADR. OF START OF TRANSFER VECTOR
         B        *R0               GO TO SERVICE ROUTINE
TV       EQU      %-1
         B        RTGJOBCON
         B        RTCONNECT
         B        RTDISCON
         B        RTCLOCK
         B        RTRNDWN
         B        RTSTOPIO
         B        RTSTARTIO
         B        RTRESDF
         PAGE
RTCONNECT  EQU    % **************************************************
*                 CAL1 ENTRY POINT FOR M:CONNECT (ENTER FROM RTALTCP)
*                                   R6=FPT(WORD 0)
*                                   R7=PTR. TO FPT(WORD 1)
*                                   R11=RETURN ADR. (TRAPEXIT)
*
         BAL,R12  RTSETUP           COMMON SETUP LOGIC
*                                   RETURN IF EVERYTHING'S OK WITH:
*                                      R1=1 IF INT. IS REAL
*                                         2 IF INT. IS PSEUDO
*                                      R2=ICB ADR.
*                                      R7=PTR. TO FPT(WORD 2)
*                                      R8=FPT(WORD 1)
*                                      R10=INT. ADR.
*                                      R11=RETURN ADR. (TRAPEXIT)
*                                      R14=DEFAULT EXEC. PRIO. (IF
*                                          INTLBL WAS SPECIFIED OR IF
*                                          INT. IS REAL)
*                                          0 (IF INT. IS PSEUDO)
*
         STW,R10  ICBINT(W),R2      INITIALIZE ICB(WORD 6)
         STW,R10  ICBDLDATA(W),R2   INITIALIZE ICB(WORD 10)
         BAL,R0   RTGETFPT          PICK UP NEXT WORD IN FPT
         OR,R6    PSDMM             SET 'MEMORY MAP' BIT
         CI,R8    FPTM              'MASTER' SPECIFIED?
         BANZ     CON7              YES
         OR,R6    PSDMS             SET 'SLAVE' BIT
CON7     STW,R6   ICBENTPSD0(W),R2  INITIALIZE ICB(WORD 9)
         LW,R6    R14               DEFAULT EXEC PRIO ALREADY SPECIFIED?
         BNEZ     CON1              YES
         LW,R6    SL:OPRIO          PICK UP DEFAULT ON-LINE PRIORITY
         LC       J:JIT             CHECK USER
         BCS,8    CON1              BRANCH IF ON-LINE
         BCS,4    CON3              BRANCH IF GHOST
         LW,R6    SL:BPRIO          PICK UP DEFAULT BATCH PRIORITY
         B        CON1
CON3     LW,R6    SL:GPRIO          PICK UP DEFAULT GHOST PRIORITY
CON1     CW,R8    FPTP2             CHECK PRESENCE BIT
         BAZ      CON5              NO PRIORITY IN FPT
         AI,R7    1                 INCREMENT FPT POINTER
         BAL,R0   RTGETFPT          PICK UP NEXT WORD IN FPT (VIA R6)
CON5     SLS,R6   24                LEFT-JUSTIFY AND ZERO REG.
         OR,R6    DLFLGDATA         SET DO-LIST FLAG
         STW,R6   ICBPRI(W),R2      INITIALIZE ICB(WORD 8)
         LW,R9    CONXPSD
         STW,R9   ICBXPSD(W),R2     INITIALIZE ICB(WORD 1)
         LD,R4    PSD1DW
         LI,R3    ICBPSD1(D)
         STD,R4   *R2,R3            INITIALIZE ICB(WORDS 2-3)
         LD,R4    PSD2DW
         AW,R4    R2                ICB ADR.
         LI,R3    ICBPSD2(D)
         STD,R4   *R2,R3            INITIALIZE ICB(WORDS 4-5)
         LW,R9    S:CUN
         SLS,R9   24                LEFT-JUSTIFY AND ZERO REG.
         STW,R9   ICBUN(W),R2       INITIALIZE ICB(WORD 7)
         STW,R2   ICBICBADR(W),R2   INITIALIZE ICB(WORD 11)
         LW,R9    STATINITD         SET UP R9 AS ICBSTAT
         LI,R3    X'1300'           SET UP ARM AND DISABLE WD INSTR.
         CI,R8    FPTD              DISABLE BIT SET IN FPT?
         BANZ     CON2              YES
         LI,R3    X'1200'           SET UP ARM AND ENABLE WD INSTR.
         LW,R9    STATINITAE        SET UP R9 AS ICBSTAT
CON2     CI,R8    FPTCLR            CHECK FPT(WORD 1)
         BAZ      CON4              'CLEAR' NOT SPECIFIED
         OR,R9    STATC             SET 'CLEAR' BIT IN R9
CON4     STW,R9   ICBSTAT(W),R2     INITIALIZE ICB(WORD 0)
         BDR,R1   RTSETCC0          BYPASS IF PSEUDO INT.
         LW,R1    RTXPSD            XPSD INSTRUCTION
         AW,R1    R2                ADD ICB ADR.
         STW,R1   *R10              PUT IT AWAY IN INT. LOC.
         BAL,R0   RTWD              ISSUE WD INSTR.
         B        RTSETCC0          NORMAL RETURN TO USER
           PAGE
RTGJOBCON  EQU    % **************************************************
*                 CAL1 ENTRY POINT FOR M:GJOBCON (ENTER FROM RTALTCP)
*                                   R6=FPT(WORD 0)
*                                   R7=PTR. TO FPT(WORD 1)
*                                   R11=RETURN ADR. (TRAPEXIT)
*
         BAL,R12  RTSETUP           COMMON SETUP LOGIC
*                                   RETURN IF EVERYTHING'S OK WITH:
*                                      R1=1 IF INT. IS REAL
*                                         2 IF INT. IS PSEUDO
*                                      R2=ICB ADR.
*                                      R7=PTR. TO FPT(WORD 2)
*                                      R8=FPT(WORD 1)
*                                      R10=INT. ADR.
*                                      R11=RETURN ADR. (TRAPEXIT)
*                                           R14=DEFAULT EXEC PRIO
*                                               (IF INTLBL SPECIFIED
*                                                OR INT IS REAL)
*                                               0 (IF INT IS PSEUDO)
*
         LW,R12   0,R7              PICK UP GJOB NAME FROM FPT(WORDS 2-3)
         LW,R13   1,R7              (MAY NOT BE DOUBLE-WORD BOUNDED)
         LI,R3    ICBGJNME(D)
         STD,R12  *R2,R3            INITIALIZE ICB(WORDS 8-9)
         AI,R7    2                 INCREMENT PLIST POINTER
         LD,R4    SYSACCT           PICK UP ':SYS'
         CW,R8    FPTP2             PRESENCE BIT FOR ACN.
         BAZ      GJCON2            IF NOT PRESENT
         LW,R4    0,R7              PICK UP GJACN
         LW,R5    1,R7                           FROM FPT
         AI,R7    2                 INCREMENT PLIST POINTER
GJCON2   LI,R3    ICBGJACN(D)
         STD,R4   *R2,R3            INITIALIZE ICB(WORDS 10-11)
         LI,R3    MAXG              SET UP LOOP THROUGH GJOB TABLES
LOOP3    CD,R12   S:GJOBTBL,R3      DOES THIS GJOB NAME EXIST?
         BE       GJCON6            YES
GJCON3   BDR,R3   LOOP3             GO TO NEXT
         B        GJCON5            GJOB DOESN'T ALREADY EXIST
GJCON6   CD,R4    S:GJOBACN,R3      DOES ACCOUNT MATCH?
         BNE      GJCON3            NO
*                                   GHOST JOB ALREADY EXISTS
         BAL,R12  DISC3             CHAIN ICB BACK INTO RTICBHDR
         B        RTSETCC4          ABNORMAL RET TO USER
*
GJCON5   LW,R4    R10               INT. ADR.
         LW,R6    R14               DEFAULT EXEC PRIO ALREADY SPECIFIED?
         BNEZ     GJCON7            YES
         LW,R6    SL:GPRIO          PICK UP DEFAULT PRIORITY
GJCON7   EQU      %
         CW,R8    FPTP3             PRESENCE BIT FOR PRIORITY
         BAZ      GJCON4            IF NOT PRESENT
         BAL,R0   RTGETFPT          PICK UP NEXT WORD IN FPT (VIA R6)
GJCON4   STB,R6   R4                R4=INT.  ADR. (RIGHT-JUSTIFIED)
         STW,R4   ICBINT(W),R2      INITIALIZE ICB(WORD 6)
         LW,R4    S:CUN
         SLS,R4   24                LEFT-JUSTIFY AND ZERO REG.
         STW,R4   ICBUN(W),R2       INITIALIZE ICB(WORD 7)
         LW,R4    GJOBXPSD
         STW,R4   ICBXPSD(W),R2     INITIALIZE ICB(WORD 1)
         LD,R4    PSD1DW
         LI,R3    ICBPSD1(D)
         STD,R4   *R2,R3            INITIALIZE ICB(WORDS 2-3)
         LD,R4    PSD2DW
         AW,R4    R2                ICB ADR.
         LI,R3    ICBPSD2(D)
         STD,R4   *R2,R3            INITIALIZE ICB(WORDS 4-5)
         LW,R4    STATINITGJ
         STW,R4   ICBSTAT(W),R2     INITIALIZE ICB(WORD 0)
         BDR,R1   RTSETCC0          BYPASS IF PSEUDO INT.
         LW,R1    RTXPSD            XPSD INSTRUCTION
         AW,R1    R2                ADD ICB ADR.
         STW,R1   *R10              PUT IT AWAY IN INT. LOC.
         LI,R3    X'1200'           SET UP ARM & ENABLE WD INSTR.
         BAL,R0   RTWD              ISSUE WD INSTR. (R10=INT.ADR.)
         B        RTSETCC0          NORMAL RETURN TO USER
         PAGE
RTRESDF  EQU      %
         AND,6    M24               GET RID OF FPT CODE
         CI,6     X'FF'             IS IT A VALID PAGE ADDRESS
         BANZ     RTSETCC1          NO
         SLS,6    -9                GET PAGE #
         LW,7     0,7               GET # OF PAGES
         LD,0     6
         SLS,1    16
         SLD,0    16                R0=PPTABLE ENTRY
         LI,5     PPTABLSZ          SEE IF ITS A RT MEMORY SEGMENT
RESDF1   CW,0     PPTABLE-1,5       DOES IT MATCH
         BNE      RESDF2            NO
         CI,5     1                 IS IT THE RESDF MEMORY SEGMENT
         BE       RTSETCC0          YES
         B        RTSETCC4          NO-DYNRESDF MEMORY SEGMENT
RESDF2   BDR,5    RESDF1            LOOK AT THE REST OF THE TABLE
* NOT A COMPLETE REAL-TIME MEMORY SEGMENT--MUST LOOK AT PAGE CHAIN
         LW,8     7                 # OF PAGES FOR BDR
         AW,7     6                 # OF PAGES + 1ST PAGE
         AI,7     -1                 -1 = LAST PAGE
         LW,3     PP:UPPH           ARE THERE ANY IN CHAIN
         BEZ      RTSETCC1          NO
RESDF3   CLR,6    3                 IS THIS A REAL-TIME PAGE
         BCR,6    RESDF5            YES
RESDF4   LOAD,3   MX:PPUT,3         GET NEXT IN CHAIN
         BNEZ     RESDF3            KEEP LOOKING
         AND,0    M16               ISOLATE # OF PAGES
         CW,0     8                 DID WE FIND ANY
         BE       RTSETCC1          NO
         B        RTSETCC2          FOUND SOME-NOT ALL
RESDF5   BDR,8    RESDF4            KEEP LOOKING TILL
         B        RTSETCC3           WE FIND THEM ALL
         PAGE
RTCLOCK  EQU      % ***************************************************
*                 CAL1 ENTRY POINT FOR M:CLOCK (ENTER FROM RTALTCP)
*                                   R6=FPT(WORD 0)
*                                   R7=PTR. TO FPT(WORD 1)
*                                   R11=RETURN ADR. (TRAPEXIT)
*
         LI,R0    X'80'
         CB,R0    JB:PRIV           PRIVILEGE OK?
         BG       RTSETCC3          NO
         LW,R8    0,R7              PICK UP FPT(WORD 1)
         CI,R8    FPTCAN            'CANCEL' SPECIFIED?
         BAZ      CLKGO             NO
         BAL,R0   RTLOCLKICB        LOCATE CLOCK (TYPE III) ICB
         BCR,3    RTSETCC2          NOT FOUND; ABNORMAL RET.
         BAL,R12  RTCLKOFF          TURN OFF THE INTERRUPT
         B        RTSETCC0          NORMAL RETURN TO USER
*
*
*
RTCLKOFF EQU      % ***************************************************
*                 THIS ROUTINE IS ALSO CALLED BY THE RUNDOWN LOGIC
*                                   BAL,R12
*                                   INPUT:  R2=ICB ADR.
*                                   OUTPUT: NONE
*                                   WORK REGS: R3,R4,R5,R6,R7
*
         DISABLE                    ***********************************
         LW,R5    ICBSTAT(W),R2     IS THE ICB STILL ACTIVE?
         BGEZ     *R12              NO; RETURN
         LW,R5    MASKS+17
         LI,R6    ICBLNK(D)
         LI,R7    ICBBLNK(D)
         LW,R4    *R2,R6            PICK UP FORWARD LINK
         AND,R4   MASKS+17          MASK ADDRESS FIELD
         LW,R3    *R2,R7            PICK UP BACK LINK
         BEZ      RTCRASH           MUST BE FIRST ONE IN CHAIN (ERROR)
         STS,R4   *R3,R6            NEW F-LINK FOR THIS GUY
         LW,R4    R4
         BEZ      CLK3              MUST BE LAST GUY IN CHAIN
         STW,R3   *R4,R7            NEW B-LINK FOR THIS GUY
         B        DISC3             GIVE BACK ICB; RET VIA R12
CLK3     STW,R3   RTICBCLKHDR+1     NEW CHAIN TAIL
         B        DISC3             GIVE BACK ICB; RET VIA R12
*
*
*
CLKGO    EQU      %                 SET UP A CLOCK REQUEST
         LW,R13   R6                SAVE ENTRY ADR.
         LW,R8    R8                PRESENCE BIT
         BGEZ     RTERR2            'TIMER UNITS' NOT SPECIFIED; ERROR
         AI,R7    1                 INCREMENT FPT POINTER
         BAL,R0   RTGETFPT          PICK UP NEXT WORD IN FPT
         LW,R14   R6                SAVE TIMER UNITS FOR LATER
         BEZ      RTERR3            CHECK FOR ZERO INTERVAL
         DISABLE                    ***********************************
         BAL,R0   RTGETICB          GET AN AVAILABLE ICB
         BCR,3    RTSETCC1          NONE AVAILABLE; ABNORMAL RETURN
         ENABLE                     ***********************************
         BAL,R12  RTSETJIT          SET HIGH-ORDER BIT OF J:ICBHDR
         LW,R6    R13               ENTRY ADR.
         OR,R6    PSDMM             SET 'MEMORY MAP' BIT
         BAL,R0   RTCHKPRIV         JB:PRIV >= X'E0'?
         BCS,8    CLK4              NO
         CI,R8    FPTM              'MASTER' SPECIFIED IN FPT?
         BANZ     CLK5              YES
CLK4     EQU      %
         OR,R6    PSDMS             SET 'SLAVE'  BIT
CLK5     STW,R6   ICBENTPSD0(W),R2  INITIALIZE ICB(WORD 9)
         LI,R4    0
         STW,R4   ICBSYSEP(W),R2    INITIALIZE ICB(WORD 3)
         STW,R4   5,R2              INITIALIZE ICB(WORD 5) UNUSED
         LI,R6    PRIODFLT          X'F8'=DEFAULT PRIORITY
         CW,R8    FPTP2             PRESENCE BIT
         BAZ      CLK7              'PRIORITY' NOT SPECIFIED
         BAL,R0   RTCHKPRIV         JB:PRIV >=X'E0'?
         BCS,8    CLK7              NO
         AI,R7    1                 INCREMENT FPT POINTER
         BAL,R0   RTGETFPT          PICK UP NEXT WORD IN FPT
CLK7     SLS,R6   24                LEFT-JUSTIFY & ZERO REG.
         OR,R6    DLFLGDATA         SET DO-LIST FLAG
         STW,R6   ICBPRI(W),R2      INITIALIZE ICB(WORD 8)
         LW,R4    S:CUN             CURRENT USER #
         SLS,R4   24                LEFT-JUSTIFY AND ZERO REG.
         STW,R4   ICBUN(W),R2       INITIALIZE ICB(WORD 7)
         LI,R4    X'5A'             CLOCK-3 INT. LOCATION
         STW,R4   ICBINT(W),R2      INITIALIZE ICB(WORD 6)
         STW,R2   ICBICBADR(W),R2   INITIALIZE ICB(WORD 11)
         LI,R4    1
         DISABLE                    ************************************
         LW,R5    RTICBCLKHDR,R4    TAIL OF CHAIN
         STW,R2   RTICBCLKHDR,R4    NEW TAIL OF CHAIN
         LW,R3    MASKS+17
         LI,R6    ICBLNK(D)
         LI,R1    ICBBLNK(D)
         STS,R2   *R5,R6            NEW F-LINK FOR OLD TAIL
         STW,R5   *R2,R1            B-LINK FOR NEW ICB
         LW,R4    STATINITCLK
         CI,R8    FPTO              'ONESHOT' SPECIFIED IN FPT?
         BAZ      CLK8              NO
         OR,R4    STATO
CLK8     STW,R4   ICBSTAT(W),R2     INITIALIZE ICB(WORD 0)
         STW,R14  ICBTUN(W),R2      INITIALIZE ICB(WORD 1) TIMER UNITS
         STW,R14  ICBCLK(W),R2      INITIALIZE ICB(WORD 2)
         STW,R14  ICBDLDATA(W),R2   INITIALIZE ICB(WORD 10)
         LW,R5    C:CTUN            CURRENT TIME-INTERVAL
         SW,R5    TINC              LESS WHAT HAS ALREADY EXPIRED
         CW,R14   TINC              REQUESTED INTRVL.:REMAINING INTRVL.
         BGE      CLK9              THIS IS THE EASY PATH
         AW,R5    R14               INCREMENT BY REQUESTED INTRVL.
         STW,R5   C:CTUN            THIS BECOMES THE NEW 'CURRENT' INTRVL.
         STW,R5   ICBCLK(W),R2      IT ALSO BECOMES THIS GUY'S INTRVL.
         STW,R14  TINC              REDUCE REMAINING TICS TO WHAT THIS
*                                   GUY REQUESTED
         B        RTSETCC0          EXIT
*
*
CLK9     AW,R14   R5                SET ICBCLK SO THAT IT WON'T GO
*                                   NEGATIVE WHEN C:CTUN IS SUBTRACTED
*                                   FROM IT
         STW,R14  ICBCLK(W),R2
         B        RTSETCC0          NORMAL RETURN TO USER
         PAGE
RTDISCON EQU      % **************************************************
*                 CAL1 ENTRY POINT FOR M:DISCONNECT (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
         BAL,R0   RTLOCICB          LOCATE CORRESPONDING ICB
         BCR,3    RTSETCC2          NOT FOUND; ABNORMAL RETURN
         LW,R4    S:CUN             CURRENT USER #
         LI,R5    ICBUN(D)
         CB,R4    *R2,R5            DOES ICB BELONG TO THIS USER?
         BNE      RTSETCC2          NO; ABNORMAL RETURN
         LW,R4    J:ICBHDR
DISC5    AND,R4   MASKS+16          ANY ACTIVE INTERRUPTS?
         BEZ      DISC1             NO
         LW,R6    R4                SAVE DA
         SLS,R4   1                 CONVERT TO WA
         AI,R4    -ICBDL(W)         BASE ADR. OF ICB
         CW,R4    R2                =?
         BE       RTSETCC3          ABN; CAN'T DISC ACTIVE INT'S ICB
         LD,R4    0,R6              PICK UP FWD LNK
         B        DISC5
DISC1    BAL,R12  RTICBTYP          DETERMINE ICB TYPE (RETURNED IN R3)
         BAL,R12  RTURNOFF          TURN OFF THE INTERRUPT
         B        RTSETCC0          NORMAL RETURN TO USER
*
*
*
RTURNOFF EQU      % ***************************************************
*                 THIS ROUTINE IS ALSO CALLED BY THE RUNDOWN LOGIC
*                                   BAL,R12
*                                   INPUT:  R2=ICB ADR.
*                                           R3=ICB TYPE
*                                   OUTPUT: NONE
*                                   WORK REGS: ALL EXCEPT R2,R8,R9 & R11
*
         LI,R5    ICBINT(D)
         LH,R6    *R2,R5            PICK UP INT. ADR.
         BAL,R0   RTCHKINT          RETURN WITH R1=1/2 (REAL/PSEUDO)
         BDR,R1   DISC2             IF PSEUDO INT.
         LW,R4    RTMTW
         STW,R4   0,R6              INITIALIZE INT. LOC.
         LW,R4    R3                SAVE ICBTYP
         LI,R3    X'1100'           SET UP FOR 'WD'
         LW,R10   R6                INT. ADR.
         BAL,R0   RTWD              DISARM LEVEL
         LW,R3    R4                RESTORE ICB-TYPE
DISC2    CI,R3    ICBTYP2           TYPE-II ICB?
         BNE      DISC3             NO
         BAL,R0   RTCHKGUN          RETURNS GJOB # IN R5
         CI,R5    0                 WAS THE GJOB ACTIVE?
         BE       DISC3             NO
         LI,R6    E:OFF
         PUSH     11,R2             SAVE REGS:  R2,R11,R12
         BAL,R11  T:RUE             PURGE GHOST JOB
         PULL     11,R2             RESTORE REGS: R2,R11,R12
DISC3    DISABLE                    ************************************
         LW,R4    RTICBHDR          CHAIN HEADER OF FREE ICB'S
         STW,R4   ICBLNK(W),R2      CHAIN THIS ICB INTO HEAD
         STW,R2   RTICBHDR          PUT THIS ICB IN HEAD
         LW,R7    S:CUN
         LH,R4    UH:DL,R7          IS THERE ANYTHING ON DO-LIST?
         AND,R4   MASKS+12          *
         BEZ      DISC4             NO
         LI,R6    0                 SET R6 AS BACK LINK
         AI,R2    ICBDL(W)          R2 POINTS TO DO-LIST WITHIN ICB
         SLS,R2   -1                CONVERT IT TO A DOUBLE-WORD ADR.
DLOOP    CW,R2    R4                MATCH?
         BE       DLACT             YES
         LW,R6    R4                SET BACK LINK FOR NEXT ONE (DA)
         LD,R4    0,R4              PICK UP FORWARD LINK (DA)
         AND,R4   MASKS+16          MASK OFF FORWARD LINK
         BNEZ     DLOOP             CONTINUE SEARCH
DISC4    ENABLE                     *********************************
         B        *R12              RETURN
*
*
*
DLACT    CI,R6    0                 IS THERE A BACK LINK
         BNE      DLACT1            YES
         LD,R8    0,R4              PICK UP FORWARD LINK (DA)
         LH,R10   UH:DL,R7          CURRENT HEAD OF CHAIN + FLAGS
         LW,R9    MASKS+12
         STS,R8   R10               NEW (DA) HEAD OF CHAIN
         STH,R10  UH:DL,R7          PUT IT AWAY
         B        DISC4             EXIT
DLACT1   SLS,R6   2                 CONVERT BACK LINK TO HALF-WORD ADR
         AI,R6    DLFLNK            ADD FRWRD-LNK DISPL.
         LD,R8    0,R4              PICK UP FORWARD LINK (DA)
         STH,R8   0,R6              NEW FORWARD LINK (DA)
         B        DISC4             EXIT
         PAGE
RTSTOPIO EQU      % ***************************************************
RTSTARTIO     EQU % ***************************************************
*                 CAL1 ENTRY POINTS FOR M:STOPIO/STARTIO
*                 ENTER FROM RTALTCP
*                                   R6=FPT(WORD 0)
*                                   R7=PTR. TO FPT (WORD 1)
*                                   R8=FPT CODE BYTE
*                                   R11=RETURN ADR.(TRAPEXIT)
*
         BAL,R0   RTCHKPRIV         JB:PRIV >= X'E0'?
         BCS,8    RTSETCC4          NO; ABNORMAL RETURN
         LI,R5    STP1
         LW,R15   0,R7              PICK UP FPT (WORD 1); FLAG WORD
         AND,R15  FPTDCB            'DEV' OR 'DCB' SPECIFIED
         BEZ      RTDEVCHK          'DEV'-RETURNS VIA R5 WITH DCTX(R2)
         BAL,R5   RTDCBCHK          'DCB'-RET: DCTX(R2);DEV.ADR(R6)
         BCS,15   RTSETCC3          BAD DCB; ABNORMAL RETURN
STP1     BCS,3    RTSETCC2          BAD DEVICE ADR; ABN. RETURN
         AI,R8    -X'1C'            STOPIO/STARTIO?
         BNEZ     STARTIO           STARTIO
*                                   STOPIO
         LB,R3    DCT4,R2           TYPE INDEX
         LB,R3    TB:FLGS,R3        DEVICE TYPE FLAGS
         LI,R5    #DEVTYP           # UN-PRE-EMPTABLE DEVICE TYPES
NXTYP    CB,R3    DEVTYP,R5         PRE-EMPTABLE?
         BE       RTSETCC3          NO
         BDR,R5   NXTYP             MAYBE
         LW,R5    R2                YES
         AI,R5    -BATAPE           DETERMINE AVR TABLE INDEX
         BLZ      STPOK             MUST BE 'DEVICE'
         CI,R5    AVRTBLSIZ
         BL       STP5              MUST BE 'TAPE'
         CI,R5    AVRTBLNE
         BGE      STPOK             MUST BE 'OTHER'
         LD,R8    AVRTBL,R5         MUST BE 'PACK'
         CI,R9    0                 PRIVATE PACK?
         BL       RTSETCC3          NO; ABNORMAL RETURN
STP5     CI,R15   0                 'DEV' SPECIFIED?
         BE       RTSETCC3          YES - ABNORMAL CONDITION
STPOK    EQU      %
         LB,R5    DCT24,R2
         CI,R5    NOPARTD+PERDWND   PRE-EMPTABLE?
         BANZ     RTSETCC3          NO
         LB,R5    DCT3,R2
         CI,R5    DOWND             ALREADY MARKED DOWN?
         BANZ     RTSETCC3          YES; ABNORMAL RETURN
*                                   NO
         PUSH     R6                SAVE DEVICE ADDRESS
         LI,R6    0                 INITIALIZE 'EA' ADDRESS
         LW,R8    0,R7              PICK-UP WORD 1 OF FPT
         CI,R8    FPTEA             'EA' SPECIFIED?
         BAZ      STP3              NO
         AI,R7    1                 POINT TO FPT(WORD 2)
         BAL,R0   RTGETFPT          RETURNS 'EA' ADR IN R6
         AI,R7    -1                RESTORE FPT POINTER FOR RMAOV
         BAL,R3   RTVTP             RETURNS PHYSICAL ADR IN R6
         BLE      STP3              IF EA ADR <128K
         BIF,S9   STP3              IF SIGMA 9
         PULL     R6                RESTORE STACK
         B        RTSETCC4          SINCE X560 CAN'T EXECUTE ABOVE 128K
STP3     STW,R6   J:BASE+4          SAVE 'EA' WHILE PRESERVING TSTACK
         PULL     R6                RESTORE DEVICE ADR
         CI,R15   0                 'DEV' OR 'DCB' SPECIFIED?
         BNE      STP4              'DCB'
         STW,R2   J:BASE+2          SAVE DCTX WHILE PRESERVING TSTACK
         STW,R11  J:BASE+3          SAVE RETURN WHILE PRESERVING TSTACK
         OVERLAY  RMAOVSEG,T:MODPRTRT# ********************************
*                                   REQUEST A DEVICE PARTITION
*                                   RETURNS WITH USER'S CC'S SET IN STK
*
         LW,R11   J:BASE+3          RESTORE RETURN
         LW,R1    TSTACK
         AI,R1    -17               POINT TO PSD IN STACK
         AND,R1   X1FFFE            BOUND 8
         LC       *R1               PICK UP CC'S
         BCS,12   T:SELFDESTRUCT    ABNORMAL RETURN FROM RMAOV
         LW,R2    J:BASE+2          RESTORE DCTX
         BAL,R3   STBSY             RETURNS DISABLED WHEN DEVICE IS FREE
STPXIT1  STB,R1   DCT15,R2          USER # TO DCT15
         LW,R1    J:BASE+4          PICK-UP 'EA' ADR (OR 0)
         STW,R1   DCT12,R2          PUT IT AWAY
         LW,R1    J:ICBHDR
         OR,R1    BT31TO0+31        SET 'STOPIO' ACTIVITY BIT
         STW,R1   J:ICBHDR          PUT IT AWAY
         B        RTSETCC0
*
*
*
STP4     EQU      %
         BAL,R3   STBSY             RETURNS DISABLED WHEN DEVICE IS FREE
         LB,R5    DCT3,R2
         OR,R5    L(DOWND)          SET 'PRE-EMPTED' BIT IN DCT3
         STB,R5   DCT3,R2
         LW,R5    BT31TO0+31
         STS,R5   DCT12,R2          SET 'DCB-ASSOCIATED' BIT
         B        STPXIT1           CONTINUE
*
*
*
STBSY    EQU      %                 CHECK IF DEVICE IS CURRENTLY BUSY
         DISABLE                    ***********************************
         LW,R1    S:CUN
         LB,R5    DCT5,R2
         CI,R5    BUSYBIT           IS IT BUSY?
         BAZ      0,R3              NO, RETURN DISABLED
*                                   YES
         ENABLE                     ***********************************
         PUSH     R2
         PUSH     R11
         LI,R5    2
         STW,R5   U:MISC,R1
         LI,R6    E:SL
         BAL,R11  T:REG             WAIT FOR 1+ SECONDS.......
         PULL     R11               *
         PULL     R2                *
         B        STBSY             THEN TRY AGAIN
         PAGE
STARTIO  EQU      % ***************************************************
*                 COME HERE AFTER EXECUTING COMMON STOPIO/STARTIO
*                 LOGIC ON M:STARTIO CAL1
*                                   R2=DCT INDEX
*                                   R6=DEVICE ADDRESS
*                                   R7=PTR. TO FPT (WORD 1)
*                                   R11=RETURN ADDRESS (TRAPEXIT)
*                                   R15=0 IF 'DEV' WAS SPECIFIED
*                                      >0 IF 'DCB' WAS SPECIFIED
*
         DISABLE                    ***********************************
         LB,R5    DCT3,R2
         CI,R5    DOWND             IS DEVICE PRE-EMPTED?       ?
         BAZ      RTSETCC3          NO; ABNORMAL RETURN
         LB,R4    DCT2,R2           CHANNEL INDEX
         LC       CIT3,R4           IS CHANNEL BUSY?
         BCS,12   RTSETCC1          YES; ABNORMAL RETURN
         LB,R3    DCT15,R2
         CW,R3    S:CUN             DOES DEVICE BELONG TO THIS USER?
         BNE      RTSETCC3          NO
         EOR,R5   L(DOWND)          RESET BIT
         STB,R5   DCT3,R2           PUT IT AWAY
         LI,R5    0
         STB,R5   DCT15,R2          ZERO DCT15
         ENABLE                     ***********************************
         MTW,0    R15               'DEV' OR 'DCB' SPECIFIED
         BNEZ     RTSETCC0          'DCB'
         STW,R11  J:BASE+3          SAVE RETURN
         OVERLAY  RMAOVSEG,T:MODPRTRT# ********************************
*                                   REQUEST A DEVICE RETURN
*                                   RETURNS WITH USER'S CC'S IN STK
*
         LW,R11   J:BASE+3          RESTORE RETURN
         LW,R1    TSTACK
         AI,R1    -17               POINT TO PSD IN STACK
         AND,R1   X1FFFE            BOUND 8
         LC       *R1               PICK UP CC'S
         BCR,8    T:SELFDESTRUCT    NORMAL RETURN
         SCREECH  X'41',X'11'       FAILED TO GIVE BACK DEVICE
         TITLE    'REAL-TIME RUNDOWN'
*********************************************************************
*                                   S E C T I O N    IV:
*
*                                 REAL-TIME RUNDOWN LOGIC
*********************************************************************
*
RTRNDWN    EQU    % **************************************************
*                 THIS ROUTINE IS CALLED AT JOB STEP TERMINATION IF THE
*                 USER HAS ISSUED ANY REAL-TIME CAL1'S (IE., IF BIT 0 OF
*                 J:ICBHDR IS SET)
*
         LW,R3    S:CUN             CURRENT USER #
         LI,R1    ICBUN(D)
         LI,R4    NINTS             SET UP LOOP THROUGH ICB'S
         LI,R2    ICB               ADR. OF 1ST SYSGEN-BUILT ICB
LOOP1    DISABLE                    ***********************************
         LW,R12   ICBSTAT(W),R2     ACTIVE BIT SET (BIT 0)?
         BGEZ     RNDNA             NO
         CB,R3    *R2,R1            DOES IT BELONG TO THIS USER (ICBUN)?
         BE       RNDICB            YES
RNDNA    ENABLE                     *************************************
         AI,R2    ICBSIZE           INCREMENT TO NEXT ICB
         BDR,R4   LOOP1
         LC       J:ICBHDR          ANY 'IOEX'   ACTIVITY?
         BCR,4    RND5              NO
         LI,R4    DCTSIZ            YES
LOOP4    DISABLE                    ***********************************
         LB,R12   DCT3,R4
         CI,R12   DOWND             IS THIS ONE PRE-EMPTED?
         BAZ      RND4              NO
         CB,R3    DCT15,R4          YES-DOES IT BELONG TO THIS USER?
         BE       RNDCT             YES
RND4     ENABLE                     ***********************************
         BDR,R4   LOOP4
RND5     EQU      %
         DISABLE                    ***********************************
         LH,R8    UH:FLG,R3
         AND,R8   FLG:INHR          RESET 'INHIBIT' BIT OF UH:FLG
         STH,R8   UH:FLG,R3         PUT IT AWAY
         LH,R7    UH:FLG2,R3        IS THE USER XITING 'LOCKED-IN-CORE'?
         CI,R7    FLG:LIC
         BAZ      RNDX              NO
         AND,R7   FLG:LICR          RESET THE 'LIC' BIT
         STH,R7   UH:FLG2,R3        AND PUT IT BACK
         LW,R7    BT31TO0+30
         STS,R7   S:BADFLG          SET 'LOCK-IN-CORE-RUNDOWN' BIT
         LI,R5    1                 SET 'DECREMENT' FLAG
         BAL,R7   RTLCT             DECREMENT PB:LCT
         BAL,R7   T:TOTSZ           RETURNS USER'S SIZE IN R0
         LCW,R0   R0
         AWM,R0   S:RTCORE          DECREMENT RTCORE ACCORDINGLY
         B        RNDXIT            RETURN TO STEPNR : NOTE THAT
*                                   J:ICBHDR IS STILL NON-ZERO
*
RNDX     LI,R2    0
         STW,R2   J:ICBHDR          RESET FLAG IN JIT
RNDXIT   ENABLE                     ************************************
         B        T:SELFDESTRUCT    RETURN TO STEPNR
*
*
*
RNDICB   PUSH     4,R1              SAVE 'LOOP1' REGISTERS
         BAL,R12  RTICBTYP          DETERMINE ICB TYPE (RETURNED IN R3)
         CI,R3    ICBTYP2           IS IT A GHOST-JOB ICB?
         BE       RND1              YES
         LI,R1    ICBPRIO(D)
         LB,R1    *R2,R1            PICK UP SAVED PRIO
         LW,R4    S:CUN
         CB,R1    UB:PRIOB,R4       IS IT LOWER THAN CURRENT PRIO?
         BLE      RND1              NO
         STB,R1   UB:PRIOB,R4       PUT LOWEST PRIO AWAY
         STB,R1   UB:PRIO,R4
         STW,R1   S:CUP
RND1     LI,R12   RNDRET            SET RETURN ADR.
         CI,R3    ICBTYP3           IS IT A CLOCK-TYPE?
         BE       RTCLKOFF          YES; DECHAIN ICB FROM RTICBCLKHDR
         B        RTURNOFF          TURN OFF THE INTERRUPT
*                                   RETURN VIA R12 TO RNDNA
*
RNDRET   PULL     4,R1              RESTORE 'LOOP1' REGISTERS
         B        RNDNA             GO BACK FOR MORE
*
*
*
RNDCT    EQU      %
         ENABLE                     **********************************
         LB,R2    DCT2,R4
         LC       CIT3,R2           IS CHANNEL BUSY?
         BCR,12   RND6              NO
         PUSH     9,R3              YES...SAVE R3,R4,R11
         LI,R4    2
         STW,R4   U:MISC,R3         WAIT FOR 1+ SECONDS
         LI,R6    E:SL
         BAL,R11  T:REG             ALLOW I/O TO RUNDOWN
         PULL     9,R3              RESTORE R3,R4,R11
         B        RNDCT             TRY AGAIN
RND6     DISABLE                    ***********************************
         LB,R8    DCT3,R4
         EOR,R8   L(DOWND)          RESET 'DOWN' BIT IN DCT3
         STB,R8   DCT3,R4
         LI,R8    0
         STB,R8   DCT15,R4          ZAP USER #
         INT,R8   DCT12,R4          IS THERE A DCB ASSOCIATED?
         BCS,4    RND4              YES
         ENABLE                     ***********************************
         PUSH     9,R3              SAVE 'LOOP4' REGISTERS
         LW,R7    BT31TO0+31        =WORD 1 OF STARTIO FPT
         STW,R7   J:BASE+2          SAVE IT
         LI,R7    J:BASE+2          POINT TO IT
         OVERLAY  RMAOVSEG,T:MODPRTRT# ********************************
         PULL     9,R3              RESTORE 'LOOP4' REGISTERS
         B        RND4              CONTINUE
         END      RTNRRTSEG:EP      START ADDRESS OF RTNRRTSEG OVERLAY

