*        D00 RJR  19:36 10/24/72.
*   ##            16:00  04/24/72  RJR  *
*        RJR      13:23 02/14/72
*        SAM  KEYS           1/11/71
         SYSTEM   UTS
         DEF      SYMSUBR
SYMSUBR  EQU      %
*
         DEF      CNTXTSET
         DEF      SAQNSERT
*SYMTABCK MOVED TO KEYIN
         REF      CBSIZE           * SIZE TO ZERO -- CNTXTSET
         REF      SCNCBT           * 4 WORD TEMP AREA -- QFP11NCB(CNTXT)
         REF      SNDDX
         REF      SQHD
         REF      SQTL
         REF      SQUE
         PAGE
*
*
*CONTEXT BLOCK PARAMETERS
*
SYMAQ    EQU      2
*
*                 SYMBOLIC REGISTER DEFINITIONS.
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R5       EQU      5
R6       EQU      6
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
*
*INSERT SYMBIONT INDEX IN SYMBIONT ACTIVATE QUEUE
*(R3)=SYMBIONT INDEX
*
SAQNSERT LI,R2    SYMAQ             SYMBIONT ACTIVATE QUEUE INDEX
*
*INSERT SYMBIONT INDEX IN SYMBIONT QUEUE
*(R2)=QUEUE INDEX
*(R3)=SYMBIONT INDEX
*
SQINSERT DISABLE                    PREVENT INTERRUPTS
         LB,R1    SQTL,R2           INDEX IN SYMBIONT QUEUE TAIL
         STB,R3   SQTL,R2           INSERT INDEX IN SYMBIONT QUEUE TAIL
         BNEZ     %+3               BRANCH IF NOT 1ST SYMB QUEUE ENTRY
         STB,R3   SQHD,R2           INSERT INDEX IN SYMBIONT QUEUE HEAD
         B        %+2               CONTINUE
         STB,R3   SQUE,R1           INSERT INEX IN SYMBIONT QUEUE CHAIN
         ENABLE                     ALLOW INTERRUPTS
         B        *SR4              EXIT
         PAGE
*ROUTINE TO CLEAR AND SETUP CONTEXT BLOCK FOR COOP AND SYMBIONTS
*(D3)=CONTEXT BLOCK ADDRESS
*
CNTXTSET EQU      %
         LI,R0    0                 ZERO CLEAR
         LI,R1    CBSIZE-1
         STW,R0   *D3,R1            CLEAR CONTEXT BLOCK WORD
         BDR,R1   %-1               LOOP TO CLEAR NEXT WORD
         B        *SR4              EXIT
          REF    SRET
         PAGE
*                 11=QRA
*                 9=SRA
*                 LOAD  3 TO Q FOR ACTIVATION
         DEF      QFACT
         DEF      QFACTP11
         DEF      QFCBP11
         SPACE 2
         DEF      QFP11NCB
         DEF      QFPD4CB
R4       EQU      4
QFPD4CB  EQU      %
         AI,R4    -2                PICK UP LAST 2 REGS
QFP11NCB EQU      %                 * NO GHOST COMM BUFFER
         LW,SR2   R4                *   RET FOR SRET
         LI,R4    SCNCBT+1          *************************
         LCI      2
         STM,D1   *SR3,R4           * IN THE CONTEXT BLOCK  *
         LI,R4    SCNCBT            * WHILE AWAITING A COMM *
         STW,SR2  *SR3,R4           * BUFF TO FREE.         *
         BAL,SR2  QFACTP11          ***RET IS FAKED TO HERE**
         LW,R1    SR3               * SO WE CAN RESTORE     *
         LCI      2
         LM,D1    SCNCBT+1,R1       * TO WHOEVER CALLED     *
         LW,SR2   SCNCBT,R1         *                       *
         B        *SR2              *************************
*
QFACTP11 PULL     11                Q FOR ACT PULL QRA
QFACT    LI,2     SYMAQ
QFACTP1  LB,3     *SR3
         STW,9    SRET,3
         B        SQINSERT          Q FOR ACT
         SPACE 2
* CORE ENTRY QUEUE  SRA=9,QRA=11(IN STACK),SR3 =CB
SYMCQ    EQU      1
QFCBP11  PULL     11                QRA TO 11
QFCB     LI,2     SYMCQ             CORE QUEUE
         B        QFACTP1
         SPACE    2
SYMDQ    EQU      0
         DEF      QFGP11
QFGP11   PULL     11                GET QRA
QFGP     LI,2     SYMDQ             GRANULE QUEUE INDEX
         B        QFACTP1           Q IT
*
         DEF      XTOBCD,IDTOBCD
*
*        ROOT ENDACTION ROUTINES USED BY DISPLAY
*
*        I        D2= # TO CONVERT, R6 = # OF BYTES
*        ENT      BAL,SR4
*        RET      +1 NORMAL         D3=ANSWER R J
IDTOBCD  PUSH     R6                # BYTES
         LI,R6    +4                *
XTOBCD2  LI,D3    0                 * CLEAR ACCUM
XTOBCD1  EQU      %                 *
         LI,D1    '0'**-4           * FOUR-AT-A-TIME
         SLD,D1   +4                *
         CI,D1    '9'               * IS NUM
         BLE      %+2               * YEP,
         AI,D1    'A'-(X'A'+'0')    * NOPE, CORR ALPH
         STB,D1   D3                * ANSWER
         SCS,D3   +8                * LO ORD R J
         BDR,R6   XTOBCD1           * * * *
         PULL     R6                *
         B        *SR4              *
         SPACE    2
*        D2 = # TO CONVERT, R6 = WIDTH
*
XTOBCD   EQU      %                 *
         PUSH     R6                * BALANCE STACK
         B        XTOBCD2           *
         PAGE
         DEF      JTYPEA
         REF      OB:BOPTX,Y01,NEWQ,RMB
*
*        USED BY KEYIN DISPLAY TO OC
*
*                 D2 = WA OF D BUF,D3 = BC
*        ENT      BAL,SR4
*        RET      +1 DOWN
*                 +2 NORMAL
*
OC       EQU      2                 *OC BOPT INDEX
*
JTYPEA   EQU      %                 EA ROUTINE DOES A RELBUF
JTYPE    SLS,D2   +2                * WA TO BA
         LI,R5    OC                * OC OP LABEL INDEX
         LB,D1    OB:BOPTX,R5       * DCTX OF OC
         AW,D1    Y01               * FC = 1
         BAL,R0   NEWQ              * DO IO
* END ACTION FOR TYPEA
         LW,D3    R6                *BUF FOR RMB
         B        RMB               * WHO RETS ON SR4
         PAGE
*        NXTSID   GET NEXT SYSTEM ID (SID)
*        I        NONE
*        ENT      BAL,SR4  NXTSID
*        RET      +1 NORMAL D1=SID
*
         DEF      NXTSID
         REF      SMUIS,S:USID
NXTSID   EQU      %                 *
         DISABLE                    * INHIBIT .
         LW,D1    S:USID            * LAST ALLOC SYSID
         AI,D1    +1                ** NAV SYSID
         CI,D1    '%*'              * (STAR FILES MUST
*                                   * BE BELOW LEGAL PRINTABLE)
         BL       %+2               * NO WRAP YET
         LI,D1    SMUIS+1           * WRAP AROUND
         STW,D1   S:USID            * UPDATE LAST ALLOC
         ENABLE                     * UNINHIBIT
         B        *SR4              * AND EXIT D1(R12)=SYSID.
SYMSUBRSZ EQU     %-SYMSUBR
         END

