         DEF      ENQUE
ENQUE    EQU      %
         TITLE    'ENQ ENVIRONMENT'
         SYSTEM    UTS
GOOVER   CNAME
         PROC
LF       LI,0     AF(1)
         DO       OLCTR=0
OLAY     PUSH     R2
         LI,2     ENQSEG
         B        T:OVER
         ELSE
         B        OLAY
         FIN
OLCTR    SET      OLCTR+1
         PEND
OLCTR    SET      0
         SREF     QT
*
*
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
*
QJOBBIT  EQU      X'400'
QSHAREBIT EQU     X'200'
QNOWAITBIT EQU  X'1'
ECBBIT   EQU      X'8000'
XECBBIT  EQU      16
ALLOCBIT EQU      X'4000'
XALLOCBIT EQU     15
NOWAITBIT EQU     X'2000'
XNOWAITBIT EQU    14
SLEEPBIT EQU      X'1000'
XSLEEPBIT EQU     13
BLOCKBIT EQU      X'800'
XBLOCKBIT EQU     12
JOBBIT   EQU      QJOBBIT
SHAREBIT EQU      QSHAREBIT
UPGRADEBIT EQU    X'0100'
*
JIT:ENQ  EQU      X'100'
MAXNAME  EQU      31                MAX SIZE-QNAME OR SNAME
         TITLE    'ENQ MAIN PROGRAM'
ENQ      EQU      %
         LI,6     6                 SELF ADDRESSED DCB POINTER
*                                      FOR PULLALLEXIT
         DEF      ENQ
*                   ROUTINE TO RECEIVE ENTRY FROM CALPROC, ANALYZE FPT,
*                    AND TRANSFER TO PROCESSING ROUTINE
         BAL,R1   PUSHALL
         LW,R0    0,R7
         STW,R0   J:BASE+1          SAVE FLAGS
         STB,SR1  J:BASE+1
*                      STORE ERR/ABN ADDRESSES IN JIT
         BAL,R2   CHKBIT0
         STS,D1   J:JIT+ERO
         BAL,R2   CHKBIT
         STS,D1   J:JIT+ABO
         REF      CHKBIT0,CHKBIT,PUSHALL,PULLALLEXIT
         REF      J:JIT,ERO,ABO,J:BASE
         LI,D1    0
*                      SAVE DATA IN J:BASE FOR FUTURE REFERENCE
         BAL,R2   CHKBIT
         AND,D1   M17
         STW,D1   J:BASE+2          SAVE ECB ADDRESS
         AW,R7    R1
         AND,R7   M17
         REF      M17
         STW,R7   J:BASE+3          SAVE FPT ADDRESS
         LW,SR3   D1
         BEZ      ENQ1              NO ECB
         LW,R1    J:BASE+1
         CI,R1    QNOWAITBIT+2      NOWAIT OR TEST
         BAZ      ERR4ANL           YES...ERROR
         BAL,SR4  ECBINIT           INITIALIZE ECB
         REF      ECBINIT
ENQ1     EQU      %
         BAL,R0   LOCKQT            LOCK/WAIT FOR QT
*
         BAL,SR4  GETNP             HANDLE VLP
         B        ERR4A00           VLP NG
         LW,R7    J:BASE+1          CODE AND FLAGS
         CI,R7    2                 TEST (F2)
         BANZ     TESTO
         CW,R7    Y01
         REF      Y01,Y8
         BANZ     DEQUEUEO          FPT CODE WAS 9
*                                   THEN IT MUST BE AN ENQUEUE
         PAGE
ENQCAL   EQU      %
*                   PROCESS THE ENQUEUE CAL
         REF      JB:PRIV
         LB,R0    JB:PRIV
         CI,R0    X'A0'
         BGE      SETENQ            A0 PRIV IS OK FOR ENQ
         REF      SH:SYMT,SV:FTYM
         REF,2    JH:LDCF
         LI,R1    SV:FTYM           FIND BIT POSITION FOR ENQ
         LI,R0    X'F0000'+C'EQ'    C'EQ' WITH SIGN EXTENSION
ENQAUTH  EQU      %
         CH,R0    SH:SYMT,R1
         BE       ENQAUT1           BIT IN JH:LDCF SAME AS EQ HALF-WORD
         BDR,R1   ENQAUTH
         B        SETENQ            NO SPECIAL AUTHORIZATIONS FOR ENQ
ENQAUT1  EQU      %
         LI,R7    JH:LDCF
         LH,R0    0,R7
         SLS,R0   0,R1
         CI,R0    X'8000'
         BANZ     SETENQ            FLAG SET IS OK AUTHORIZATION
         LW,SR3   L(3**25+X'58')
         B        ENQERR
SETENQ   LI,R1    JIT:ENQ
         STS,R1   J:ABC             SET ENQUEUE USED
         REF      J:ABC
*
         BAL,SR4  FINDQ
         B        BUILDQ            Q DOESNT EXIST-SO GO BUILD IT
ENQCHKU  LW,R2    R6                S INDEX TO SREG(2)
         AI,R6    1                 U INDEX =S+1
*
         BAL,SR4  FINDU              FIND U ENTRY
         B        BUILDU            NOT FOUND-GO BUILD U ENTRY
ENQQU    LW,R4    R6                GET U ENTRY-SET U CHAIN INDEX-RH OF
         LW,R5    R4
ENQQUL   LD,D1    QT,R5              FIRST WORD IS NEXT ENTRY-EITHER WAY
         CI,D1    X'FFFF'
         BAZ      ENQQU1            FOUND END
         INT,R5   D1
         B        ENQQUL
*
ENQQU1   BAL,SR4  LINKQU            NOW GO BUILD USERS SQ & LINK TO U
*
         BAL,SR4  FINDS
         B        BUILDS
ENQCHKSQ LW,R3    R6
*
         BAL,SR4  FINDSQ
         B        ENQSQNF           NO OLD ENTRY-PROCEED TO SET UP
         GOOVER   ENQOLD#
         REF      ENQOLD#
         DEF      ENQLSQ
ENQSQNF  LD,D1    QT,R3             IF ALL, GO TO ENQO
         CW,D2    ALL
         BE       ENQNC
*                    HANDLE ENQUEUE, SNAME NOT 'ALL'
         LD,D1    QT,R4             IS USER BLOCKED
         LW,D2    D2
         BGE      ENQA              NO
*                    USER BLOCKED...LINK ACCORDING TO ORDER OF USERS
*                     FOR THIS QNAME
         PUSH     R6
         LD,D1    QT,R5
         OR,D2    BT31TO0+XBLOCKBIT
         STD,D1   QT,R5             SET BLOCKED
*                 SORT BLOCKED SQ ACCORDING TO U CHAIN
         LW,R6    R3                FIND FIRST BLOCKED SQ
         LD,D3    QT,R3
         SLS,D3   16
         LD,D1    QT+2,R2
ENQNAL1  STW,R6   *TSTACK
         LH,R6    D3
         BEZ      ENQLSQ            END CHAIN, NO BLOCKED
         LD,D3    QT,R6
         CI,D4    BLOCKBIT
         BAZ      ENQNAL1
         STB,D4   D4
*
ENQNAL2  LH,R1    D1                FIND U ENTRY
         LD,D1    QT,R1
         CW,R1    R4
         BE       ENQLSQ
         CB,D2    D4
         BNE      ENQNAL2
         B        ENQNAL1
*
ENQLSQ   EQU      %
         PULL     R6
         BAL,SR4  LINKSQ
         B        ENQDONE
         SPACE    2
BUILDS   CW,R3    M25               BUILD S ENTRY-CHK IF 'ALL' OR 'NULL'
         REF      MASKS
M25      EQU      MASKS+25
         BG       BUILDS1           NO
         LW,R6    R2
         AI,R6    1
         LD,D3    QT+2,R2           FIND START OF CHAIN
         LI,R1    X'FFFF'
         AND,R1   D3
         BEZ      BUILDS1           NO CHAIN
         LD,D1    QT,R1
         LB,D2    D2
         CI,D2    X'40'
         BAZ      BUILDS1           NOT SPECIAL CHAIN
         BNE      BUILDS1           NOT 'NULL' SO MUST BE 'ALL',CURRENT
*                                    NOT FOUND SO IT MUST BE 'NULL'
         LW,R6    R1                IS 'NULL', SO CURRENT MUST BE 'ALL'
*                                    WHICH GOES NEXT
BUILDS1  ANLZ,R7  UIX               CHAIN HEAD=U HEAD
         LW,SR1   R3                BA NAME
         BAL,SR4  BLDS
         B        ENQCHKSQ
         REF      CHKQO#
         SPACE    2
BUILDU   LW,R4    R6                SET POINTER FOR LINKING U
         BAL,SR2  GET1DW
         B        BUILDUNO          ERROR-UNWIND & EXIT
         LW,D4    S:CUN
         LD,D1    QT,R4
         LI,D3    0
         LD,SR1   QT+2,R2           IS Q LOCKED
         CI,SR2   X'FFFF'
         BAZ      %+2               NO
         OR,D4    Y8                YES-SET BLOCK FLAG
         STD,D3   QT,R6
         STH,R6   D1
         STD,D1   QT,R4             STORE LINKED ENTRY
         B        ENQQU
BUILDUNO GOOVER   CHKQO#            POSSIBLY RELEASE Q ENTRY
*                                     AND DO ERROR REPORT,ETC
         SPACE    2
BUILDQ   LW,SR1   R2                BUILD Q ENTRY
         LI,R7    0
         BAL,SR4  BLDQ
         B        ENQCHKU
         SPACE    2
ENQA     EQU      %                 PROCESS UNBLOCKED USER, NEW REQUEST
         LD,D1    QT,R3
         LD,D3    QT,R5
         LI,R1    X'FFFF'           JUST A NORMAL Q-ANY USERS IN IT
         AND,R1   D1
         BEZ      ENQALO            NO-GO ALLOCATE AND BE HAPPY
         LD,D1    QT,R1
         CI,D2    ALLOCBIT
         BAZ      ENQALO            ISNT ALLOCATED-SO WE CAN
*
         CI,D4    SHAREBIT          IS ALLOC-IS IT SH/SH
         BAZ      ENQEX1            NO-NEW IS EX
         CI,D2    SHAREBIT
         BAZ      ENQEX
*
ENQALO   EQU      %
         LD,D1    QT+2,R2           FIND ALL S, IF ANY
         INT,R7   D1
         LD,D1    QT,R7             FIRST S
         CW,D2    ALL
         BE       ENQA2             FOUND ALL
         LH,R7    D1                NO-COULD BE NEXT
         LD,D1    QT,R7
         CW,D2    ALL
         BNE      ENQALO1           NONE
*
ENQA2    EQU      %
         INT,R7   D1                GET FIRST SQ
         LD,D1    QT,R7
         CI,D2    ALLOCBIT          IS ALL ALLOC
         BAZ      ENQALO1           NO...SO TREAT AS IF NO ALL
*                        YES...SO CHECK AGAINST THE FIRST ALL ENTRY
         CI,D2    SHAREBIT
         BAZ      ENQEX2            ALL NOT SHARE
         CI,D4    SHAREBIT
         BAZ      ENQEX2            THIS NOT SHARE
*
ENQALO1  OR,D4    BT31TO0+XALLOCBIT
         STD,D3   QT,R5
         LW,R6    R3
*
ENQIN    BAL,SR4  LINKSQ            LINK IT IN
         B        ENQDONE
ENQEX2   LW,R6    R3                SETUP TO FIND PLACE TO MERGE SQ
         LD,D1    QT,R6
         SLS,D1   16                S HEAD TO LOOK LIKE SQ
         B        ENQEX3
ENQEX1   EQU      %                 FIND PENDING END AND LINK
         CI,D2    BLOCKBIT
         BANZ     ENQIN             NEXT IS BLOCKED-SO HAVE RIGHT INDEX
*
ENQEX    LW,R6    R1
         DEF      ENQEX
ENQEX3   EQU      %
         LH,R1    D1
         BEZ      ENQIN             END CHAIN-NO BLOCKED-OK
         LD,D1    QT,R1
         B        ENQEX1
*
*
ENQNC    GOOVER   ENQALL#
         REF      ENQALL#
         SPACE    3
         PAGE
ENQDONE  EQU      %
         DEF      ENQDONE
         INT,R1   QT+1              IF NON-ALLOC COUNT LESS 2,
         CI,R1    2                   SAJCK NOT NEEDED
         BL       ENQCW
         GOOVER   SAJCK#
         REF      SAJCK#
ENQCW    EQU      %
         DEF      ENQCW
         LD,D1    QT,R5
         CI,D2    ALLOCBIT
         BAZ      ENQDNNA           NOT ALLOCATED
*
         CI,D2    ECBBIT
         BAZ      ENQ00
*
*                                   RELEASE ECB ENTRY
         INT,R1   D1
         LD,D3    QT,R1
         LW,SR4   D4                SAVE ECB ADDRESS
         LI,D4    X'FFFF'
         STS,D3   D1                UNLINK ECB ENTRY
         EOR,D2   BT31TO0+XECBBIT
         STD,D1   QT,R5
         LW,R6    R1                RELEASE DW
         BAL,SR2  REL1DW
*                                   FLAG ECB COMPLETE
         LW,SR3   SR4               ECB ADDRESS
         LW,SR1   S:CUN
         LI,SR2   0                 CONDITION CODE
         BAL,SR4  ECBPOST
*
ENQ00    MTH,-1   QT+1              CLEAR QT LOCK
         DESTRUCT MSRWRTX
         REF      MSRWRTX,ECBPOST
         DEF      ENQ00
*
*
ENQDNNA  EQU      %                 NOT ALLOCATED-MUST WE DO SAJCK
         LD,D1    QT,R5
         CI,D2    NOWAITBIT
         BANZ     ABN3103           NOT ALLOC-SO GIVE ABN
*
         OR,D2    BT31TO0+XSLEEPBIT  SET SLEEP
         STD,D1   QT,R5
         MTH,-1   QT+1              CLEAR QT LOCK
         LI,R6    E:NQW             ENQUEUE WAIT
         LW,R0    R5
         SPACE    2
         BAL,SR4  T:REG
         LW,R5    R0
         LD,D1    QT,R5             CLEAR SLEEP BIT
         EOR,D2   BT31TO0+XSLEEPBIT
         STD,D1   QT,R5
         REF      E:NQW,T:REG
         BAL,R0   LOCKQT
*
         LH,R1    UH:DL,R6
         REF      UH:DL
         CI,R1    X'F000'
         BAZ      ENQCW
         GOOVER   RELQO#
         REF      RELQO#
*
ERR3104  LW,SR3   L(4**25+X'31')
         DEF      ERR3104
         B        ENQERR
ERR4ANL  EQU      %                 ERROR 4A..QT NOT LOCKED
         LI,SR3   X'4A'
         B        ENQERRX
*
ERR4A00  LI,SR3   X'4A'
         DEF      ERR4A00
         SPACE    2
ENQERR   EQU      %
         MTH,-1   QT+1              UNLOCK QT
         DEF      ENQERR
ENQERRX  EQU      %
         LI,R0    PULLALLEXIT
         PUSH     R0
         DESTRUCT RDERX
         REF      RDERX
*
DEQUEUEO GOOVER   DEQUEUE#
TESTO    GOOVER   TEST#
         REF      DEQUEUE#,TEST#,ENQSEG
*
ABN3103  LW,SR3   X3103
         B        ENQERR
         TITLE    'ENQ FIRST LEVEL SUBROUTINES'
FINDQ    EQU      %
         DEF      FINDQ,FINDS
*                   SEARCHES FOR THE QNAME WHOSE BA AND SIZE INCLUDING
*                    COUNT BYTE ARE IN R2. IF FOUND, RETURN IS TO BAL+2
*                    WITH R6=INDEX OF ENTRY. OTHERWISE, RETURN IS TO
*                    BAL+1 WITH R6=INDEX OF LAST Q ENTRY,OR ZERO IF NO
*                    Q ENTRIES. LINK IS SR4.
         LI,R6    0                 START AT BEGINNING
         STW,R2   J:BASE+4
FINDNAM  EQU      %                 COMMON CODE FOR FINDQ/FINDS SEARCH
         LD,D3    QT,R6             HEAD (ENTRY 0 OR U HEAD)
         STH,D3   D3
FINDNAML LH,R1    D3
         BEZ      BISR4             NOT FOUND
         LW,R6    R1
         LD,D3    QT,R6
         LW,D2    J:BASE+4          SUBJECT NAME BA AND COUNT
         LI,D1    D4*4              BA OF OBJECT NAME IN D4
         AI,D4    0
         BGEZ     %+2
         LW,D1    D4                D4 HAS BA OF OBJECT WHEN BIT 0 SET
         CBS,D1   0
         BNE      FINDNAML          NOT IT
         B        SR4X1             FOUND, SO SKIP
         PAGE
FINDS    EQU      %
*                   SEARCHES FOR THE SNAME WHOSE BA AND SIZE INCLUDING
*                    COUNT BYTE ARE IN R3. IF FOUND,RETURN IS TO BAL+2
*                    WITH R6=INDEX OF ENTRY. OTHERWISE,RETURN IS TO
*                    BAL+1 WITH R6=INDEX OF LAST S ENTRY, OR U HEAD IF
*                    NO S ENTRIES. LINK IS SR4.
         ANLZ,R6  UIX               SETUP FOR FINDNAM IS STARTING INDEX
         STW,R3   J:BASE+4           IN R6 AND SUBJECT BA-COUNT IN
         B        FINDNAM            TSTACK.
         SPACE    2
UIX      LD,0     2,R2              ANLZ OBJECT-COMPUTES U INDEX
         DEF      UIX
         PAGE
         DEF      FINDSQ,FINDU
FINDSQ,FINDU EQU  %
*            FINDSQ SEARCHES FOR THE SQ ENTRY FOR THE CURRENT USER IN
*                    THE SUB-QUEUE WHOSE S ENTRY INDEX IS IN R6. IF
*                    FOUND, RETURN IS TO BAL+2 WITH R6=INDEX OF THE SQ
*                    ENTRY. OTHERWISE, RETURN IS TO BAL+1 WITH R6= INDEX
*                    OF LAST SQ IN THE CHAIN, OR OF THE S ENTRY IF THERE
*                    ARE NO SQ ENTRIES. LINK IS SR4.
*            FINDU  SEARCHES FOR THE U ENTRY FOR THE CURRENT USER IN THE
*                    SAME MANNER EXCEPT ON ENTRY R6=INDEX OF THE U HEAD,
*                    AND ON RETURN R6=USERS U ENTRY INDEX, END OF U
*                    CHAIN, OR U HEAD.
         LW,R0    S:CUN
         STB,R0   R0                SETUP R0 FOR CB,D4 R0
         LD,D3    QT,R6             GET HEAD
         CW,R6    R3
         BNE      FINDUL            ITS U, NOT SQ
         STH,D3   D3
FINDUL   LH,R1    D3
         BEZ      BISR4             END CHAIN-NOT FOUND
         LW,R6    R1
         LD,D3    QT,R6
         CB,D4    R0                SAME USER
         BNE      FINDUL            NO-TRY NEXT
SR4X1    AI,SR4   1
BISR4    B        *SR4
         PAGE
GETNP    EQU      %
*                   VERIFIES THE VLP CODE AND SAVES IT IN THE FLAGS WORD
*                    OF TSTACK. SETS UP R2 AND R3 WITH BA AND COUNT+1
*                    OF QNAME AND SNAME. RETURN IS TO BAL+1 IF VLP IS NG
         LW,R7    J:BASE+3
         LB,R0    *R7               VLP CODE
         CI,R0    X'F8'
         BANZ     BISR4             UNUSED BITS SET
         CI,R0    1
         BAZ      BISR4             MUST BE ODD
         LI,R1    2
         STB,R0   J:BASE+1,R1       SAVE CODE
         AI,R7    1                 STEP TO DATA
*
         LI,R5    -2                TWO ITERATIONS OF ADDRESS HANDLING
GETNPL   LW,R1    R7
         LB,D2    *R1
         LW,D1    D2
         AI,D2    3
         SLS,D2   -2                R7 INCREMENT
         CI,D1    X'7F'
         BLE      GETNPB
*
         LI,D2    1                 INDIRECT-R7 INCREMENT=1
         LW,R1    0,R1
         LB,D1    *R1
GETNPB   CI,D1    X'40'             CHECK SPECIAL (40,7E,7F)
         BAZ      GETNPD
         LI,D2    1                 R7 INCREMENT
         LI,D4    QSHAREBIT
*                                   FORCE SHARE IF NULL
         AI,D1    -X'40'
         BEZ      GETNPC1           NULL-OK
         CI,D1    X'3E'
         BL       BISR4             ILLEGAL SPECIAL CODE
         BG       GETNPQA           ALL-OK
*
         LB,D4    J:BASE+1
         CI,D4    1
         BAZ      BISR4             RES ILLEGAL FOR ENQUEUE
         LW,D4    Y8                'RES' FLAG...RELU USES
GETNPC1  EQU      %
         CI,R5    -1
         BL       BISR4
         STS,D4   J:BASE+1          SHARE FOR NULL OR RES FLAG
GETNPC   LI,D1    0                 NAME LENGTH
GETNPD   AI,D1    1                 INCLUDE SIZE BYTE IN COUNT
         CI,D1    MAXNAME+1
         BG       BISR4             NAME IS TOO LONG
GETNPE   AW,R7    D2
         SLS,R1   2                 BA OF NAME
         STB,D1   R1
         STW,R1   R4,R5             CAREFUL-THATS INTO R2 OR R3
         BIR,R5   GETNPL
         B        SR4X1
*
GETNPQA  EQU      %                 IS 'ALL'..IF QNAME AND ENQUEUE
*                                      IS ERROR
         CI,R5    -2
         BNE      GETNPC
         LB,D4    J:BASE+1          IS QNAME
         CI,D4    1
         BANZ     GETNPC            OK..IS DEQ
         B        *SR4
         PAGE
LINKQU   EQU      %
*                 GETS A DW FROM THE POOL, BUILDS AN SQ ENTRY, AND LINKS
*                  IT TO THE END OF THE USERS CHAIN. ENTRY IS
*                  BAL,SR4 LINKQU WITH R5=INDEX OF END OF CHAIN AND R4=
*                  INDEX OF USERS U ENTRY. ALSO BUILDS QECB ENTRY, IF
*                  NEEDED. EXITS TO LNKQUE OR CHKUO IF INSUFFICIENT DW'S.
         BAL,SR2  GET1DW
         B        LINKQUCU          NO DW'S-ERROR
         LI,D3    0
         LW,D4    J:BASE+2          GET ECB ADDRESS
         BEZ      LINKQUNE
         STD,D3   QT,R6             SAVE PARTIAL QECB
         PUSH     R6
*
         BAL,SR2  GET1DW
         B        LINKQURDW         NO MORE, RELEASE 1ST DW & ERROR RET
         PULL     R1
         LD,D3    QT,R1
         STH,R6   D3                QUPP POINTS BACK
         STD,D3   QT,R1
*                    UIX IS AN OBJECT OF ANLZ TO SET IX FOR U HEAD
         SPACE    2
         LW,D3    R1                QUHP
         LI,D4    ECBBIT
LINKQUNE EQU      %                 NOW BUILD SQ-D3,D4 ARE INITIALIZED
         LW,R1    S:CUN
         OR,D4    R1                SET USER NO.
         LW,R0    J:BASE+1
         LI,R1    SHAREBIT+JOBBIT
         STS,R0   D4
         CI,R0    QNOWAITBIT
         BAZ      %+2
         OR,D4    BT31TO0+XNOWAITBIT
*
         STD,D3   QT,R6             SQ ENTRY READY
         LD,D3    QT,R5             LAST ENTRY IN CHAIN
         OR,D3     R6
         STD,D3   QT,R5
         LW,R5    R6
         B        *SR4
LINKQURDW EQU     %
         REF      LNKQUE#,RELDWO#
         GOOVER   LNKQUE#
LINKQUCU GOOVER   CHKUO#
         REF      CHKUO#
         PAGE
LINKSQ   EQU      %
         DEF      LINKSQ
*                   LINKS AN SQ ENTRY INTO AN S CHAIN.ENTRY-BAL,SR4
*                    LINKSQ WITH R5=INDEX OF THE SQ ENTRY AND R6=INDEX
*                    SHERE TO LINK AFTER IN S CHAIN.
         LD,D3    QT,R5
         CI,D4    ALLOCBIT
         BANZ     %+2
         MTW,1    QT+1              BUMP NON-ALLOC COUNT
         LD,D1    QT,R6
         CW,R6    R3
         BNE      %+2
         SCD,D1   16                IS S ENTRY-POSITION POINTER
         LH,R0    D1
         STH,R0   D3                QQHP-NEW
         STH,R5   D1                QQHP-OLD OR QHVP
         STH,R3   D4                QUVP
         CW,R6    R3
         BNE      %+2
         SCD,D1   -16               RESTORE S ENTRY
         STD,D1   QT,R6
         STD,D3   QT,R5
         B        *SR4
         PAGE
BUILDQS  EQU      %
*                   BUILDS AND LINKS IN A NAME ENTRY(Q OR S), INCLUDING
*                    QNAME IF NEEDED AND U IF Q ENTRY BAL,SR4 BUILDQS
*                    SR1=COUNT/BA(NAME),R6=LINK INDEX,R7=CHAIN HEAD.
*                  RETURN IS TO BAL+1 IF SUCCESSFUL, OTHERWISE TO
*                  RELDWO IN ENQO.
BLDQ     LI,R0    2                 ENTRY FOR Q ENTRY
         B        %+2
BLDS     LI,R0    1                 ENTRY FOR S ENTRY
         PUSH     2,R6              SAVE CHAIN HEAD AND LINK INDEX
*
         BAL,SR2  GETDW
         B        BLDQSX            COULDNT GET ANY
         LB,R0    SR1
         LW,D4    SR1
         SLS,D4   -2
         LW,D4    *D4
         CI,R0    1
         BNE      %+2               SPECIAL NAMES ONLY COUNT FIELD
         AND,D4   YFF               CLEAR LO ORDER BITS OF ALL
         REF      YFF
         CI,R0    4                 INCLUDES COUNT BYTE
         BLE      BLDQSA            NO EXTRA WORDS NEEDED
         PUSH     R6
         AI,R0    7
         SLS,R0   -3                BYTES TO DW
*
         BAL,SR2  GETDW             GET DW'S FOR QNAME
         B        BLDQSX1           GO RELEASE 1ST DW & RETURN ERROR
         LW,SR2   R6
         AI,SR2   DA(QT)
         SLS,SR2  3
         LW,D4    SR2
         OR,D4    Y8                INDIRECT FLAG
         LB,R0    SR1
         STB,R0   SR2
         MBS,SR1  0
         PULL     R6
*
BLDQSA   LI,D3    0                 STORE QNAME
         MTW,0    *TSTACK
         BNE      BLDQSB            NOT Q ENTRY
         SD,D1    D1                BLD   U HEAD
         STD,D1   QT+2,R6
         LI,D3    1
         AW,D3    R6
*
BLDQSB   EQU      %
         PULL     2,R0              NOW LINK IT IN
         XW,R1    R0
         LD,D1    QT,R1
         CW,R1    R0
         BNE      %+2
         SCD,D1   16                IS HEAD-MOVE VERT TO LH
         LH,SR1   D1
         STH,SR1  D3                MOVE POINTER
         STH,R6   D1                LINK IN
         CW,R1    R0
         BNE      %+2
         SCD,D1   -16               IS HEAD-RESTORE POSITIONS
         STD,D3   QT,R6
         STD,D1   QT,R1
         B        *SR4
*
*
BLDQSX1   LI,R6   -1                RELEASE DW & EXIT
         LW,D2    *TSTACK,R6
         LI,R6    1
         AI,D2    0
         BNE      %+2
         LI,R6    2
         XW,R6    *TSTACK
         B        BLDQSX2
*
BLDQSX   LI,R0 0
         PUSH     R0
BLDQSX2  GOOVER   RELDWO#
         TITLE    'ENQ SECOND LEVEL SUBROUTINES'
GET1DW   EQU      %
*                   GETS 1 DW (GETDW GETS N CONTIGUOUS DW WHERE R0=N)
*                    IF FOUND,RETURN IS TO BAL+2 WITH R6= DW INDEX OF
*                    1ST DW. OTHERWISE,RETURN IS TO BAL+1. LINK IS SR2.
         LI,0     1                 FOR 1 DW
GETDW    EQU      %
GTRLDW   PUSH     R0                SAVE NUMBER OF PAGES
         REF      E:SL,S:CUN,U:MISC
         LI,R6    0
GETDWL1  LW,R0    *TSTACK
         LW,R1    R6                SAVE IX FOR UNLINK
         LD,D3    QT,R6             GET HEAD OR PREVIOUS DW
         LH,R6    D3
         BEZ      GETDWNF           NOT FOUND
GETDWL2  BDR,R0   GETDWNX
         LD,D3    QT,R6             DONE-LINK OUT THE GOT DWS
         LH,R0    D3
         LD,D3    QT,R1
         LH,R6    D3                START OF RETRIEVED BLOCK
         STH,R0   D3
         STD,D3   QT,R1
         AI,SR2   1                 SUCCESS
GETDWNF  PULL     R0
         B        *SR2
GETDWNX  EQU      %                 NEED MORE-SEE IF ANOTHER CONTIGUOUS
         LD,D3    QT,R6
         AI,R6    1
         CH,R6    D3
         BE       GETDWL2           NEXT DW IS OK-CONTINUE
         BDR,R6   GETDWL1           NOT CONTIG-TRY THE NEXT BLOCK
         PAGE
REL1DW   EQU      %
         DEF      REL1DW,RELDW,ALL
*                   RELEASES 1 DW (RELDW RELEASES N CONTIGUOUS DW WHERE
*                    R0=N).RETURN IS TO BAL+1.LINK IS SR2,R6=DW INDEX
*                    OF 1ST DW.
         LI,0     1                 FOR 1 DW
RELDW    EQU      %
         LI,R1    0
RELDWS   LD,D3    QT,R1
         LH,SR3   D3                END OK TO INSERT
         BEZ      RELDWB
         CH,R6    D3
         BL       RELDWB
         LW,R1    SR3
         B        RELDWS
RELDWB   STH,R6   D3                LINK IN NEW DW
         STD,D3   QT,R1
         LW,R1    R6
         AI,R6    1
         SD,D3    D3                CLEAR D3-D4
         BDR,R0   RELDWB
         STH,SR3  D3
         STD,D3   QT,R1
         B        *SR2
         TITLE    'ENQ MISCELLANEOUS SUBROUTINES'
LOCKQT   EQU      %                 SETS QT LOCK AND ASSURES NO OTHER
*                                      CURRENT USER
         LW,R6    S:CUN
         MTH,1    QT+1
         LH,R1    QT+1
         CI,R1    1
         BE       *R0               ONLY USER...PROCEED
         MTH,-1   QT+1
         PUSH     16,R0             WAIT 2 TICKS
         STW,R1   U:MISC,R6
         LI,R6    E:SL
         BAL,SR4  T:REG
         PULL     16,R0
         B        LOCKQT
ALL      DATA     X'7F000000'
X3103    DATA     3**25+X'31'
         DEF      X3103
         END

