         TITLE    '****TQ ROOT SEGMENT***'
         SYSTEM   UTS
         SYSTEM   TP:TPO
         SYSTEM   LP:TPOQ
         DO       QSIM
         REF      TTP
         FIN
         REF      E:UQA
         REF      X0
         REF      MTIME#
         REF      T:RUE
         REF      MISOVSEG
         DEF      TQCHAIN
         DEF      TQCHAINC
         DEF      TQDCHAIN
         DEF      TQDCHAINA
         DEF      TQDCHAINC
         DEF      TQUEUEA
         DEF      TQIOREJECT
         DEF      TQMOVEBSZ
         DEF      TQSETBLOCK
         REF      J:DCBLINK
         DEF      T:GETID
         DEF      TQHSKPICB
         DEF      TQNEWQ
         REF      NEWQ
         REF      J:JIT
         REF      Y008
         REF      CC1SET,CC1RST
         DEF      TQGETBYTE,TQSETBYTE,TQSETHWORD,TQGETHWORD
         DEF      TQGETWORD,TQSETWORD,TQLOADF,TQSTOREF
         DEF      TQGETFIELD,TQSETFIELD,TQMOVEBS,TQCBYTE
         DEF      TQCHKBIT1,TQCHKBIT
         DEF      TQMAP,TQUNMAP,TQRETURN
         REF      TQRPSD
         REF      TQVPSD
         REF      J:ASSIGN
         REF      JX:CMAP
         REF      J:BASE
*
CSTMBR   EQU      MASKS+31
CSTMBS   EQU      BT31TO0+32
*
         GENREFS
TESTTQROOT SET    1
         TITLE    'TQCHAIN....FORWARD  CHAINING,END OF CHAIN'
****************************************************
*                                                  *
*             ADDS AN  ELEMENT TO THE TAIL OF A    *
*              FORWARD CHAIN...                    *
*              ENTERED VIA BAL,R0  TQCHAIN         *
*              INPUT: R5 = CHAIN HEADER            *
*                     R9 = ADDRESS OF LINK WORD    *
*                     R5, BIT 0 = 1, CHAIN REAL    *
*                               = 0, CHAIN VIRTUAL *
*                                                  *
*              OUTPUT: CC 4 = 0, SUCCESSFUL CHAIN  *
*                           = 1, ALREADY CHAINED   *
*                        R9, BYTE 0 MODIFIED       *
*                            BYTES 1-3 UNCHANGED   *
****************************************************
*
TQCHAIN  EQU      %
         PUSH     2,R0
         BAL,R0   TQCHAINCOM        FRONTEND LOGIC
         LW,D3    1,R5              TAIL OF CHAIN LINK WD PTR
         BEZ      TQCHAIN8          EMPTY CHAIN
         STW,R9   *D3               STORE PTR TO CHAINING
*                                    WORD INTO CURRENT TAIL
         STS,D4   *D3               SET CHAINED BIT
TQCHAIN6 EQU      %
         STW,R9   1,R5              NEW ELEMENT AS TAIL OF CHAIN
         STW,D4   *R9               ZERO FOR TAIL OF CHAIN LINK & CHAINED BIT
         B        TQCHAINYES
TQCHAIN8 EQU      %                 EMPTY CHAIN
         STW,R9   *R5               STORE ELEMENT AS CHAIN HEAD
*                                   AND CHAIN TAIL
         B        TQCHAIN6
TQCHAINCOM EQU    %                 COMMON ENTRY FOR CHAINING
         PUSH     4,D1
         LW,D1    J:JIT             SAVE ENTRY MODE
         CI,R5    0                 CHECK FOR CHAINING
*                                   IN REAL
         BLZ      TQCHAINR          YES
         BAL,R1   TQMAP             CHAIN IN VIRTUAL
         B        TQCHAINCOM2
TQCHAINR EQU      %
         BAL,R1   TQUNMAP           CHAIN IN REAL
TQCHAINCOM2 EQU   %
         LW,R1    D1
         AND,R5   CSTMBR            MASK CHAIN HEADER
         LW,D4    *R9               TEST FOR ALREADY CHAINED
         BL       TQCHAINNO         YES
         LW,D4    CSTMBS
         B        *R0
*
TQCHAINYES EQU    %
         LCFI     0                 SUCCESSFUL EXIT
         B        TQCHAINEXIT
*
TQCHAINNO EQU     %
         LCI      1                 UNSUCCESSFUL EXIT
TQCHAINEXIT EQU   %
         STCF     R9
         CI,R1    0                 EXIT IN ENTRY MODE
         BE       TQCHAINEXIT2
         BAL,R1   TQMAP             CALLED IN VIRTUAL
TQCHAINEXIT1 EQU  %
         PULL     4,D1
         PULL     2,R0
         LCF      R9
         B        *R0
TQCHAINEXIT2 EQU  %
         BAL,R1   TQUNMAP           CALLED IN REAL
         B        TQCHAINEXIT1
         TITLE    'TQCHAINC...CHAINING WITH CRITERIA'
*************************************************************
*                                                           *
*                 ADDS AN ELEMENT TO A CHAIN PRECEDING      *
*                 A SPECIFIED ELEMENT BASED ON CONDITIONAL  *
*                 CRITERIA TEST SPECIFIED BY THE CALLER     *
*                   IF A MATCH IS NOT FOUND, THE ELEMENT    *
*                   IS PLACED ON THE TAIL OF THE CHAIN      *
*                   ENTERED VIA  BAL,R0   TQCHAINC          *
*                 INPUT: R5 = CHAIN HEADER                  *
*                        R7 = DISPLACEMENT OF CRITERION WORD*
*                             FROM LINK WORD                *
*                        R8 = CONDITIONAL BRANCH INSTRUC-   *
*                             TION FOR CRITERION TEST       *
*                        R9 = ADDRESS OF THE LINK WORD      *
*                           R5, BIT 0 = 1, CHAIN REAL       *
*                                     = 0, CHAIN VIRTUAL    *
*                                                           *
*                 OUTPUT: CC 4 = 0, SUCCESSFUL CHAINING     *
*                              = 1, UNSUCCESSFUL            *
*                 R4,R6,R9 MODIFIED                          *
*************************************************************
*
TQCHAINC EQU      %
         PUSH     2,R0
         BAL,R0   TQCHAINCOM        FRONT END LOGIC
         LW,D1    *R5               LOOK AT CHAIN HEADER
         BEZ      TQCHAIN8          EMPTY CHAIN
         LW,D2    CSTMBR            SET UP MASKS
         LW,D4    CSTMBR
         LW,R6    R9
         LW,R9    CSTMBS
         AI,R8    TQCHAINC6         ADDRESS FOR CONDITIONAL
*                                   BRANCH SATISFACTION
         LW,D3    R5
         LW,R4    *R6,R7            CRITERIA WORD IN NEW ELEMENT
TQCHAINC2 EQU     %
         CW,R4    *D1,R7            COMPARE WITH CRITERIA WORD OF
*                                   CHAINED ELEMENT
         EXU      R8                EXECUTE CONDITIONAL BRANCH
         LS,D1    *D1               NOT SATISFIED, CHECK NEXT
*                                   ELEMENT ON THE CHAIN
         BEZ      TQCHAINC4         REACHED END OF THE CHAIN
         LS,D3    *D3               KEEP TRACK OF THIS ELEMENT
         B        TQCHAINC2         TEST NEXT ELEMENT
*
TQCHAINC4 EQU     %
*                                   END OF CHAIN, NO MATCH
*                                   CHAIN ELEMENT TO TAIL OF CHAIN
         LW,D1    *D3               D1 = ADDRESS OF LINK WORD OF
*                                   PREVIOUSTAIL
         STW,R6   *D1               ADD NEW ELEMENT TO TAIL
         STS,R9   *D1               CSET CHAINED BIT,PREVIOUS TAIL
         STW,R9   *R6               LINK=0,SET CHAINED
         STW,R6   1,R5              NEW ELEMENT TO CHAIN TAIL
         B        TQCHAINYES        SUCCESSFUL RETURN
*
TQCHAINC6 EQU     %
         LW,R7    CSTMBR            MATCH FOUND,CHAIN NEW ELEMENT
*                                   PRECEDING THE MATCH
         STS,R6   *D3
         STW,D1   *R6               SET LINK IN NEW ELEMENT
         STS,R9   *R6               SET CHAINED BIT
         B        TQCHAINYES        SUCCESSFUL RETURN
         TITLE    'TQDCHAIN..DECHAIN ELEMENT FROM TOP OF CHAIN'
***************************************************************
*                                                             *
*                 DECHAINS ENTRIES FROM THE TOP OF A          *
*                 STANDARD FORWARD CHAIN...                   *
*                 ENTERED VIA   BAL,R0  TQDCHAIN              *
*                 INPUT: R5 = ADDRESS OF CHAIN HEADER         *
*                        R5, BIT 0 = 1, DECHAIN REAL          *
*                                  = 0, DECHAIN VIRTUAL       *
*                 OUTPUT: R9 = ADDRESS OF DECHAINED ELEMENT'S *
*                                   LINK WORD                 *
*                         CC 4 = 0, SUCCESSFUL DECHAINING     *
*                              = 1, UNSUCCESSFUL DECHAIN      *
***************************************************************
*
TQDCHAIN EQU      %
         PUSH     2,R0
         BAL,R0   TQDCHAINCOM       FRONT END LOGIC
         LW,R9    *R5               TEST FOR EMPTY CHAIN
         LS,D1    *R9               TEST IF ONLY ONE ENTRY CHAINED
         BNEZ     TQDCHAIN2         NO
         STW,D1   1,R5              YES, ZERO TAIL IN HEADER
TQDCHAIN2 EQU     %
         STW,D1   *R5               STORE EITHER ZERO OR ADDRESS
*                                   OF 2ND ELEMENT AS NEW HEAD
         B        TQDCHAINA8
*
*
TQDCHAINCOM EQU   %                 COMMON DECHAINING LOGIC
         PUSH     4,D1
         LW,D1    J:JIT
         CI,R5    0                 TEST FOR DECHAINING REAL OR VIRTUAL
         BLZ      TQDCHAINR
         MAP
         B        TQDCHAINCOM2
TQDCHAINR EQU     %
         UNMAP
TQDCHAINCOM2 EQU  %
         LW,R1    D1
         AND,R5   CSTMBR
         LW,D2    CSTMBR
         LW,D1    *R5               CHECK FOR ALREADY DECHAINED
         BEZ      TQCHAINNO         YES, UNSUCCESSFUL EXIT
         B        *R0
         TITLE    'TQDCHAINA...DECHAIN SPECIFIED ELEMENT'
**************************************************************
*                                                            *
*                 DECHAINS SPECIFIED ELEMENT FROM A          *
*                 STANDARD FORWARD CHAIN                     *
*                 INPUT: R5 = ADDRESS OF CHAIN HEADER        *
*                        R9 = ADDRESS OF LINK WORD OF ELEMENT*
*                                   TO DECHAIN               *
*                 OUTPUT: CC 4 = 0, SUCCESSFUL  DECHAINING   *
*                              = 1, UNSUCCESSFUL DECHAINING  *
*                                   R9, BYTE 0 MODIFIED      *
*                                      BYTE 1-3 UNCHANGED    *
**************************************************************
*
TQDCHAINA EQU     %
         PUSH     2,R0
         BAL,R0   TQDCHAINCOM       COMMON DECHAINING LOGIC
         LW,D3    R5                CHAIN HEADER
TQDCHAINA2 EQU    %
         CW,D1    R9                COMPARE WITH LINK TO DECHAIN
         BE       TQDCHAINA4        FOUND
         LW,D3    D1                KEEP ELEMENT POINTING TO ONE
*                                   UNDER TEST
         LS,D1    *D1               GET TO NEXT ELEMENT ON THE CHAIN
         BNEZ     TQDCHAINA2        SEE IF THIS IS THE ONE
*                                   REACHED END OF THE CHAIN
         B        TQCHAINNO            UNSUCCESSFUL EXIT
TQDCHAINA4 EQU    %
         LS,D1    *D1               GET LINK FROM MATCHING ELEMENT
         STS,D1   *D3               STORE AS NEW LINK TO REMOVE
*                                   THIS ELEMENT FROM THE CHAIN OR
*                                   AS NEW HEAD IN THE HEADER
         BNEZ     TQDCHAINA8        TEST FOR ELEMENT WAS TAIL OF CHAIN
         CW,D3    R5                YES, WAS IT THE ONLY ENTRY
         BNE      TQDCHAINA6        NO, IF BRANCH
         STW,D1   1,R5              YES, ZERO TAIL IN HEADER
         B        TQDCHAINA8
TQDCHAINA6 EQU    %
         STW,D3   1,R5              STORE PRECEDING ENTRY AS NEW TAIL OF CHAIN
TQDCHAINA8 EQU    %
         STW,D1   *R9               RESET CHAINED BIT IN DECHAINED ELEMENT
         B        TQCHAINYES
         TITLE    'TQDCHAINC...DECHAINING WITH CRITERIA'
**************************************************************
*                                                            *
*                 DECHAIN ENTRIES BASED ON CRITERIA FROM     *
*                 A STANDARD FORWARD CHAIN...                *
*                 ENTERED VIA  BAL,R0  TQDCHAINC             *
*                 INPUT: R2= -1,SEARCH FOR LINK WITHOUT      *
*                            DECHAINING                      *
*                        R5 = ADDRESS OF CHAIN HEADER        *
*                        R6 = CRITERIA                       *
*                        R7 = DISPLACEMENT OF CRITERIA FROM  *
*                                   LINK WORD                *
*                        R8 = BRANCH INSTRUCTION             *
*                             R5, BIT 0 = 1, DECHAIN REAL    *
*                                       = 0, DECHAIN VIRTUAL *
*                 OUTPUT: R9 = ADDRESS OF DECHAINED LINK     *
*                         CC 4 = 0, SUCCESSFUL DECHAINING    *
*                              = 1, UNSUCCESSFUL DECHAINING  *
**************************************************************
*
TQDCHAINC EQU     %
         PUSH     2,R0
         BAL,R0   TQDCHAINCOM       COMMON DECHAINING LOGIC
         LW,D3    R5                ADDRESS OF CHAIN HEADER
         LW,D4    CSTMBR
         AI,R8    TQDCHAINC6        COMPLETE SATISFIED BRANCH INSTRUCTION
TQDCHAINC2 EQU    %
         CW,R6    *D1,R7            COMPARE FOR MATCH TEST
         EXU      R8
         LS,D1    *D1               NO, KEEP LOOKING
         BEZ      TQCHAINNO         REACHED END OF CHAIN
         LS,D3    *D3               KEEP TRACK OF PRECEDING ELEMENT
         B        TQDCHAINC2        CHECK NEXT ENTRY
TQDCHAINC6 EQU    %
         LW,R9    D1                ADD OF ENTRY LINKED TO MATCHING ONE
         CI,R2    -1                CHECK FOR SEARCHING ONLY
         BE       TQCHAINYES        YES, EXIT WITH LINK POINTER
         LW,D1    *D1               LINK WORD IN ELEMENT DECHAINING
         STS,D1   *D3               LINK FORWARD ELEMENT TO PRECEDING
*                                   ELEMENT TO CLOSE THE CHAIN
         AND,D1   CSTMBR            RESET CHAINED BIT
         BNEZ     TQDCHAINA8        BRANCH IF NOT LAST ELEMENT CHAINED
         CW,D3    R5                IS IT AT THE HEAD OF THE CHAIN
         BNE      TQDCHAINA6        BRANCH IF NOT
         STW,D1   1,R5              ZERO TAIL OF HEADER
         B        TQDCHAINA8
         TITLE    'QUEUE I/O END-ACTION AND MISCELLANEOUS FCNS'
         PAGE
*****************************************************************
*                                                               *
*                 T Q U E U E A                                *
*                                   QUEUE I/O END-ACTION        *
*                                                               *
*****************************************************************
TQUEUEA  EQU      %
         PUSH     SR4               SAVE RETURN
         LW,R5    D3                EAI = USER NUMBER
         LB,R2    D1                TYC
         ST,R2    Q:CC              INTO TTP TABLE
         LI,R6    E:UQA             RE-AWAKEN USER
         BAL,SR4  T:RUE
         PULL     SR4
         B        *SR4
*
*
TQIOREJECT EQU    %
*                                   PROVIDE FOR UNIMPLEMENTED DEV DOWN
         SCREECH  QSCREECH
         PAGE
TQMOVEBSZ EQU     %                 SET BYTE  STRING TO ZERO
         LW,SR4   R1
         UNMAP
         LW,R1    SR4
         MBS,0    BA(X0)
         STCF     R0
         LW,SR4   R1
         MAP
         LW,R1    SR4
         LC       R0
         B        *R0
         PAGE
TQSETBLOCK EQU    %                 MAINTAIN STATS IN CONTROL BLOCK 1
         STCF     R0
         PUSH     16,R0
         LW,R6    Q:CONT(A)         PTR TO CONTROL BLOCK 1
         UNMAP
         LB,R7    R0
         SLS,R7   -4
         EXU      TQSETBLOCKE,R7
         LW,SR1   *R6,R5
         CI,R4    1
         BANZ     TQSETBLOCK2
         AI,SR1   -1
         B        TQSETBLOCK4
TQSETBLOCK2 EQU   %
         AI,SR1   1
TQSETBLOCK4 EQU   %
         STW,SR1  *R6,R5
         CI,R7    0
         BNE      TQSETBLOCKEXIT
         LI,R1    QSATINC
         LI,R5    CONTSAT(I)
         LW,SR2   *R6,R5
         CI,R4    1
         BANZ     TQSETBLOCK5
         SW,SR2   R1
         B        TQSETBLOCK5A
TQSETBLOCK5 EQU   %
         AW,SR2   R1
TQSETBLOCK5A EQU  %
         STW,SR2  *R6,R5
         LI,5     CONTMAX(I)        UPDATE MAX ENTRIES
         LW,SR4   *R6,R5
         CW,SR1   SR4
         BL       TQSETBLOCK7
         STW,SR1  *R6,R5
**********GET TIME OF DAY
         MAP
         PUSH     R6
         PUSH     SR3
         PUSH     8,SR1             FORMAT STACK FOR TIM OUTPUT
         LI,R6    0                 4-WD BLK NOT NEEDED
         LI,R7    SR1               ADDRESS OF FPT WD 1
         OR,R7    Y008              TUN FLAG
         DO       QSIM=0
         LI,R0    MTIME#
         LI,R2    MISOVSEG
         BAL,SR4  T:OVERLAY
         FIN
         PULL     8,SR1             RESTORE STACK, SR1 & SR2 = TIME
*                                   FOR QUEUE PURPOSES
         PULL     SR3               TID
         PULL     R6
         UNMAP
         LI,R5    CONTMAXTIME(I)
         STW,SR1  *R6,R5
         AI,R5    1
         STW,SR2  *R6,R5
TQSETBLOCK7 EQU   %
         LI,R5    CONTTID(I)
         LW,SR1   *R6,R5
         LI,SR2   -1
         CS,SR1   SR3
         BGE      TQSETBLOCKEXIT
         STW,SR3  *R6,R5
TQSETBLOCKEXIT EQU %
         LW,SR1   QWRITEF(M)
         LW,SR2   SR1
         LI,R5    QWRITEF(I)
         STS,SR1  *R6,R5
TQROOTEXIT EQU    %
         MAP
         PULL     16,R0
         B        *R0
TQSETBLOCKE EQU   %
         LI,R5    CONTENTRIES(I)
         LI,R5    CONTPROC(I)
         LI,R5    CONTFAILED(I)
         LI,R5    CONTINDEXES(I)
         SPACE    3
*
*                 SPECIAL MAP/UNMAP TO RETAIN CURRENT
*                 DISABLE/ENABLE STATUS OF CALLING PROGRAM
*
TQMAP    EQU      %
         XPSD,0   TQVPSD            VIRTUAL
TQUNMAP  EQU      %
         XPSD,0   TQRPSD            REAL
TQRETURN B        0,R1
*
         PAGE
TQNEWQ   EQU      %
         LW,R5    R1                SAVE EAI
         UNMAP                      UNMAPPED I/O
         LW,R1    R5
         BAL,SR4  NEWQ
         DO       QSIM
         B        %+1
         ELSE
         B        TQIOREJECT
         FIN
         MAP
         B        *R6
         PAGE
TQHSKPICB EQU     %
         PUSH     16,R0             HSKP INDEX CONTROL BLOCK
         UNMAP
         LI,R2    QICBENTS          # ENTRIES IN ICB
         LI,R5    ICBHASH(I)
         L,R6     Q:INXCONTROL
TQHICB1  EQU      %
         LW,R3    *R6,R5
         CW,R3    SR2               SR2= BLOCK # NEWLY EMPTIED BLOCK
         BNE      TQHICB4
         LW,R3    QPOOLFLINKI(I),R7 BLOCK'S FORWARD LINK
         STW,R3   *R6,R5
         B        TQSETBLOCKEXIT    SET WRITE REQUIRED AND EXIT
TQHICB4  EQU      %
         AI,R5    1                 STEP TO NEXT ENTRY
         BDR,R2   TQHICB1
         B        TQROOTEXIT        RELEASED BLOCK NOT CHAIN HEADER
         SPACE    6
T:GETID  EQU      %
         DISABLE
         LWORD,R3 Q:TID
*                                   R3= NEXT TRAN ID
         BEZ      TGETIDZ           IF IT IS VALID (NON-ZERO),
         MTWORD,1 Q:TID             INCREMENT IT.
TGETIDZ  EQU      %
         ENABLE
         LW,R2    TSTACK            RETURN ID OR ZERO
         STW,R3   -15+SR1,R2        TO CALLER'S SR1.
         AI,R3    0                 IF TID VALID,
         BNEZ     CC1RST            RETURN WITH CC1=0,
         B        CC1SET            ELSE WITH CC1 = 1.
         PAGE
*                                   REAL MEMORY ACCESSING LOGIC
TQGETBYTE EQU     %
         UNMAP
         LB,D4    *R6,R5
         B        TQSET#GET
TQSETBYTE EQU     %
         UNMAP
         STB,D3   *R6,R5
         B        TQSET#GET1
TQSETHWORD EQU    %
         UNMAP
         STH,D3   *R6,R5
         B        TQSET#GET1
TQGETHWORD EQU    %
         UNMAP
         LH,D4    *R6,R5
         B        TQSET#GET
TQGETWORD EQU     %
         UNMAP
         LW,D4    *R6,R5
         B        TQSET#GET
TQSETWORD EQU     %
         UNMAP
         STW,D3   *R6,R5
         B        TQSET#GET1
TQLOADF  EQU      %
         LW,D4    CSTMAP
         B        TQGETFIELD
TQSTOREF EQU      %
         LW,D4    CSTMAP
         B        TQSETFIELD
TQGETFIELD EQU    %
         UNMAP
         LI,D3    0
         LS,D3    *R6,R5
         B        TQSET#GET
TQSETFIELD EQU    %
         UNMAP
         STS,D3   *R6,R5
         B        TQSET#GET1
TQMOVEBS EQU      %
         UNMAP
         MBS,D3   0
         B        TQSET#GET
TQCBYTE  EQU      %
         UNMAP
         CBS,D3   0
TQSET#GET EQU     %
         STCF     R0
TQSET#GET1 EQU    %
         MAP
         LC       R0
         B        *R0
         PAGE
TQCHKBIT1 EQU     %                 GET OPTIONAL FPT PARAMETERS
*                 ENTERED VIA  BAL,R2  TQCHKBIT1,TQCHKBIT
*                 VOLATILE REGISTERS: R1,D1,D3
         LW,D1    0,R7
         LI,R1    X'80001'
TQCHKBIT EQU      %
         SLS,D1   1
         BEV      0,R2              NOT PRESENT , RETURN IN LINE
         LW,D3    *R7,R1            GET PARAMETER
         BGEZ     TQCHKBIT2
         CI,D3    X'1FFF0'          INDIRECT, CHECK FOR REGISTER
         BANZ     %+2               NO
         AW,D3    J:BASE            TSTACK REGISTER ADDRESS
         LW,D3    *D3
TQCHKBIT2 EQU     %
         BIR,R1   1,R2              RETURN TO CALL+2
         END

