         TITLE    'ENQO ENVIRONMENT'
         SYSTEM    UTS
ENQO     EQU      %
         DEF      ENQO
         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  1
QSTEPBIT EQU      4                 F3
         TITLE    'ENQ TRANSFER VECTOR'
         AI,R0    ENQTV
         CI,R0    BENQ
         BGE      %+2
         PULL     R2                ALL ENTRIES EXCEPT ENQ PASS R2
ENQTV    EQU      %
         B        *R0
         B        CHKQO
         B        CHKUO
         B        DEQUEUE
         B        ENQALL
         B        ENQOLD
         B        LNKQUE
         B        RELDWO
         B        RELQO
         B        SAJCK
         B        TEST
BENQ     B        ENQ
         REF      ENQ
ECBBIT   EQU      X'8000'
XECBBIT  EQU      16
ALLOCBIT EQU      X'4000'
XALLOCBIT EQU     15
NOWAITBIT EQU     X'2000'
SLEEPBIT EQU      X'1000'
XSLEEPBIT EQU     13
BLOCKBIT EQU      X'800'
XBLOCKBIT EQU     12
JOBBIT   EQU      QJOBBIT
SHAREBIT EQU      QSHAREBIT
UPGRADEBIT EQU    X'0100'
XUPGRADEBIT EQU   9
JIT:ENQ  EQU      X'100'
         TITLE    'ENQO PRIMARY ROUTINES'
*                    THE ENQERLG ROUTINE HAS SEVERAL ENTRY POINTS
*                     TO PERMIT DELETION OF VARIOUS TYPES OF ENTRIES
*                     THAT WERE ESTABLISHED PRIOR TO RUNNING OUT OF SPACE.
*                     AFTER SUCH HOUSEKEEPING, THE USER HAVING THE
*                     GREATEST NUMBER OF ENTRIES IN QT IS DETERMINED,
*                     AND THAT USER'S ID AND THE NUMBER OF ENTRIES
*                     IS ENTERRED INTO AN ERROR LOG ENTRY.
LNKQUE   PULL     R6
         BAL,SR2  REL1DW            RELEASE SQ DW
         B        CHKUO
*
RELDWO   PULL     R0
         AI,R0    0
         BEZ      %+2
         BAL,SR2  RELDW
         PULL     2,R6
         CI,R7    0
         BEZ      ENQERLG           Q ENTRY
*                                   S EnTRy
UNSQO    BAL,SR2  UNLINKSQ
*
CHKUO    BAL,SR4  CHKU
         B        ENQERLG
*
CHKQO    BAL,SR4  CHKQ
         SPACE    2
ENQERLG  EQU      %
*                   DETERMINES HI-USE USER AND BUILDS ERR:LOG ENTRY.
*                    RETURNS ERROR  5801 TO ENQERR
         INT,R1   QT                GET INDEX OF 1ST Q
         SD,SR1   SR1               INITIALIZE USER NO & COUNTER
ERLGNXQ  LD,D1    QT+2,R1           U HEAD
         LH,R4    D1
         BEZ      ERLG2             NO USERS
*
ERLG4    LW,R2    R1
         LD,D3    QT,R4             GET U ENTRY
         STB,D4   SR3               SAVE 'CONTINGENT' USER NO.
         LI,SR4   1                 INITIALIZE COUNT
ERLG1    LI,R5    X'FFFF'
         AND,R5   D3
         BEZ      ERLGNQU           GO FIND HIM IN ANOTHER Q
         AI,SR4   1
         LD,D3    QT,R5
         B        ERLG1
*
ERLGNQU  LD,D1    QT,R2
         LH,R2    D1
         BEZ      ERLG3             END Q'S-CHECK COUNTS
         LD,D3    QT+2,R2           U HEAD
ERLGNQ2  LH,R7    D3
         BEZ      ERLGNQU           NO USERS
         LD,D3    QT,R7
         CB,D4    SR3               SAME USER
         BNE      ERLGNQ2
         AI,SR4   1                 FOUND-START COUNTING
         B        ERLG1
*
ERLG3    CW,SR4   SR2
         BLE      %+2               NOT GREATER
         STD,SR3  SR1               NEW HI-SAVE IT
         LD,D3    QT,R4             FIND NEXT
         LH,R4    D3
         BNEZ     ERLG4             ANOTHER USER, THIS Q
ERLG2    LD,D1    QT,R1             TRY NEXT Q
         LH,R1    D1
         BNEZ     ERLGNXQ
*
*                                   NO MORE-DO REPORT
*
         LB,R1    SR1
         LH,R0    UH:FLG,R1
         REF      LPART
         CI,R0    BAT
         BAZ      ERLGID            NOT BATCH-USER NO IS USER ID
         LI,6     LPART+1
         CB,R1    PLB:USR,R6
         BE       %+3
         BDR,R6   %-2
         B        ERLGID
         LH,R1    PLH:SID,R6
ERLGID   STH,R1   SR2                   ID,COUNT
         LW,SR1   TIME                  TIME
         LW,R7    L(X'50'**24+3**16)    TYPE,SIZE
         LW,R6    TSTACK
         PUSH     3,R7
         AI,R6    1
         BAL,R5   ERRLOG
         REF      ERRLOG
         REF      UH:FLG,PLB:USR,PLH:SID,TIME
         LW,SR3   L(1**25+X'58')
*
TOENQERR LI,SR4   ENQERR
*
ENQDEST  EQU      %
         CI,SR4   X'8000'
         BG       *SR4              DIRECT RETURN IF ENQ IN OVERLAY
         DESTRUCT                   ELSE UNWIND
         REF      ENQERR,FINDQ,FINDS,FINDSQ
         PAGE
TEST     EQU      %
*                   PROCESSES THE  ENQUEUE-TEST CAL
         REF      ECBPOST,J:BASE
         LW,SR3   J:BASE+2          GET ECB ADDRESS TO CHECK
         BEZ      ERR4A00X          ECB ADDRESS IS ZERO-THATS A NONO
         LI,SR3   0
*
         BAL,SR4  FINDQ
         B        TESTOK            Q DOESNT EXIST-OK
         LW,R2    R6
*
         BAL,SR4  FINDS
         B        TESTU             S DOESNT EXIST-CHK BLOCK/LOCK
         LW,R3    R6
*
         BAL,SR4  FINDSQ
         B        TESTHA            NO SQ-SEE IF COULD BE ALLOC
         LW,R5    R6
         LD,D3    QT,R5             FOUND-DOES HE WANT UPGRADE
         LW,R1    J:BASE+1
         CI,D4    SHAREBIT
         BAZ      AABN3101          NO-ALREADY HAS EXCL
         CI,R1    QSHAREBIT
         BANZ     ABN3101           NO-ASKING SHARE
         CI,D4    ALLOCBIT          YES-IS HIS SH ALLOC
         BAZ      ABN3103           NOT ALLOC SO CANT UPGRADE
*
         LD,D1    QT,R3
         INT,R1   D1
         CW,R1    R5
         BNE      ABN3103           NOT AT HEAD OF S
         LH,R1    D3                NEXT SQ INDEX
         BEZ      TESTOK            NO OTHER
         LD,D1    QT,R1
         CI,D2    ALLOCBIT
         BAZ      TESTOK            OTHER NOT ALLOC
*
ABN3103  LW,SR3   X3103             06000031 IN ENQ
         REF      X3103
         B        TOENQERR
*
AABN3101 CI,R1    QSHAREBIT
         BAZ      ABN3101
         LW,SR3   L(2**25+X'31')
         B        ABNCKAL
*
ABN3101  LW,SR3   L(1**25+X'31')
ABNCKAL  EQU      %
         CI,D4    ALLOCBIT
         BAZ      TOENQERR          NOT ALLOC
*
TESTOK   EQU      %
         LW,D4    SR3
         LW,SR3   J:BASE+2
         BEZ      TESTOK1
         LW,SR1   S:CUN
         LW,SR2   Y8
         BAL,SR4  ECBPOST           POST ECB AS AVAILABLE
TESTOK1  EQU      %
         LW,SR3   D4
         BNEZ     TOENQERR
*
PAED     B        ENQ00
         REF      ENQ00
         REF      S:CUN,PULLALLEXIT,PULLEXIT
         SPACE    2
TESTHA   LD,D1    QT,R3             IS 1ST SQ ALLOC
         INT,R5   D1
         LD,D3    QT,R5
         CI,D4    ALLOCBIT
         BAZ      TESTU             NO-SO IS AVAILABLE IF NOT BLOCK/LOCK
         CI,D4    SHAREBIT          IS ALLOC-ARE BOTH SH
         BAZ      ABN3103           NO
         LW,R0    J:BASE+1
         CI,R0    QSHAREBIT
         BAZ      ABN3103           REQUEST NOT SH
         SPACE    2
TESTU    ANLZ,R6  UIX
         REF      UIX,FINDU
         BAL,SR4  FINDU
         B        TESTQL            USER NOT IN Q-GO CHK Q LOCK
         LD,D3    QT,R6             USER FOUND-TEST BLOCKED
         LW,D4    D4
         BL       ABN3103           USER BLOCKED
*
TESTQL1  CW,R3    X4000             IF QT INDEX, S WAS FOUND...SO OTHER
         BL       SR30                SNAMES NOT RELEVANT
         LB,D3    0,R3              IF NOT 'ALL' CHECK FOR 'ALL' S
         CI,D3    X'7F'                ELSE CHECK EVERY S
         BE       TESTALS
*
         BAL,R1   FINDALL           IF ALL SNAME EXISTS, THEN MUST
*                                     RETURN ABN AS HE IS BLOCKED
         B        SR30
         B        TESTHA            LOCKED
*
TESTQL   LD,D1    QT+2,R2           USER NOT IN Q..IF LOCKED-3103
         CI,D2    X'FFFF'
         BANZ     ABN3103
         B        TESTQL1
         SPACE    2
SR30     LI,SR3   0                 OK
         B        TESTOK
         SPACE    2
TESTALS  LW,R0    J:BASE+1          FOR 'ALL',ARE THERE SNAMES OTHER
         LD,D3    QT+2,R2           THAN NULL
TESTAL1  SCS,D3   16
TESTALN  LH,R1    D3
         BEZ      TESTOK            NO MORE TO CHECK..SO OK
         LD,D3    QT,R1
         CW,D4    Y4                IGNORE NULL
         BANZ     TESTALN
*                     OTHER SNAMES...IF TEST AND EVERYBODY SHARE, OK
         SCS,D3   16
         LH,R7    D3
         LD,D1    QT,R7             FIRST SQ IN S
         CI,D2    SHAREBIT
         BAZ      ABN3103
         CI,R0    QSHAREBIT
         BAZ      ABN3103
         B        TESTAL1           BOTH SHARE SO GO ON TO NEXT SNAME
ERR4A00X LI,SR4   ERR4A00
         B        ENQDEST
         REF      ERR4A00
         PAGE
DEQUEUE  EQU      %
*                   PROCESSES THE DEQUEUE CAL
         LB,R0    0,R2
         CI,R0    X'7F'
         BE       DEQALL            IS DEQUEUE 'ALL'
*
         BAL,SR4  FINDQ
         B        ERR3100           NO SUCH Q
         LW,R2    R6
         LB,R0    0,R3
         LI,SR4   PAED
         CI,R0    X'7E'             'ALL' OR 'RES'
         BGE      RELU              DEQUEUE THIS USER FROM Q AND EXIT
*
         BAL,SR4  FINDS
         B        ERR3100
         LW,R3    R6
         BAL,SR4  FINDSQ
*
         B        ERR3100
         LW,R5    R6
         ANLZ,R6  UIX
*
         BAL,SR4  FINDU
         B        ERR3100
         LW,R4    R6
         BAL,SR4  RELQ              RELEASE THIS ONE ENTRY
         B        PAED
*
ERR3100  LI,SR3   X'31'
         B        TOENQERR
         SPACE    3
DEQALL   LI,R0    0                 DEQUEUE ALL Q'S FOR THIS USER
         LI,R1    JIT:ENQ
         STS,R0   J:ABC             CLEAR ENQ FLAG
         LD,D3    QT
         SLS,D3   16                GET FIRST Q
DEQALLA  LH,R2    D3
         BEZ      PAED              DONE
         LD,D3    QT,R2
         STW,D3   J:BASE+3
         BAL,SR4  RELU
         LW,D3    J:BASE+3
         B        DEQALLA           DO NEXT Q
         SPACE    5
RELU     EQU      %
*                   UNLINKS AND RELEASES ALL ENTRIES FOR THE CURRENT
*                    USER IN THE DESIGNATED QUEUE. USES STANDARD REG
*                    SETUP AND LINK IS SR4. IF RES IS FLAGGED IN TSTACK
*                    FLAGS WORD, BIT 0, 'NULL' ENTRY IS NOT DEQUEVED.
         PUSH     SR4
RELULP   LD,D3    QT,R2
         LI,R6    X'FFFF'
         AND,R6   D3
         BEZ      PULLEXIT          Q NO LONGER EXISTS
         BAL,SR4  FINDU
         B        PULLEXIT          NO ENTRIES
         LW,R4    R6
         LW,R5    R4
*
RELUSKP  LW,R7    R5
RELU1    EQU      %                 SET UP NEXT,IF ANY
         LD,D3    QT,R7
         LI,R5    X'FFFF'
         AND,R5   D3
         BEZ      CHKU4             DONE
         CI,D4    ECBBIT
         BANZ     RELUSKP           SKIP ECB ENTRY
         LD,D3    QT,R5
         LW,R0    J:BASE+1          VLP CODE IN BYTE 2
         BG       RELU2
         LH,R1    D4                IS RES..CHK IF NULL
         LD,D1    QT,R1
         CW,D2    Y4
         BE       RELUSKP           YES IS NULL   SO SKIP IT
*
RELU2    EQU      %
         CI,R0    QJOBBIT
         BANZ     RELUYES           REQUEST WAS JOB
         CI,D4    JOBBIT
         BAZ      RELUYES           ENTRY NOT JOB
         CI,R0    QSTEPBIT          IF STEP FLAG(F3) ON,
         BAZ      RELUNO            RELEASE UNALLOC JOB ENTRIES
         CI,D4    ALLOCBIT
         BAZ      RELUYES
RELUNO   EQU      %
         LI,R1    JIT:ENQ           JOB ENTRY REMAINS-SO RESTORE FLAG
         STS,R1   J:ABC
         REF      J:ABC
         B        RELUSKP
*
RELUYES  EQU      %                 RELEASE THIS ENTRY
         LH,R3    D4
         BAL,SR4  RELQ
         XW,SR1   R2                CHECK FOR Q GONE
         CW,SR1   R2
         BNE      PULLEXIT
         B        RELULP
         PAGE
RELQ     EQU      %
*                   UNLINKS AND RELEASES THE CURRENT (R5) SQ ENTRY AND
*                    ANY HIGHER LEVEL (S,V,Q) ENTRIES MADE EMPTY BY THE
*                    DEQUEVE. ALSO HANDLES UNLOCKING/ALLOCATING MADE
*                    POSSIBLE BY THE DEQUEVE. USES STANDARD REGISTER
*                    SETUP AND LINKS ON SR4.
         BAL,SR2  UNLINKSQ          RELEASE CURRENT SQ
         LD,D3    QT,R3
         CW,D4    ALL               IS THIS THE 'ALL' SUBQUEUE
         BNE      RELQB
*                      IS 'ALL', IF UNALLOC, DECRMENT LOCK CTR
         LW,R1    R2
         SLS,R1   2
         AI,R1    7
         CI,SR1   ALLOCBIT          REDUCE LOCK CTR IF NOT ALLOC
         BANZ     %+2
         MTH,-1   QT,R1
*
         LI,SR2   RELQB
         MTH,0    QT,R1
         BEZ      UNLOK
*                                   IS S EMPTY
RELQB    EQU      %
         INT,R1   D3
         LW,R5    R1
         BNEZ     RELQE             NO
         LI,SR2   RELQD
RELS     EQU      %                 GENERAL ENTRY TO RELEASE S
         LW,R6    R3                YES-RELEASE S ENTRY
         ANLZ,R7  UIX
         B        UNLINKQUS
*
RELQE    LD,D1    QT,R5             NEW TOP OF S ALLOCATED
         CI,D2    ALLOCBIT
         BANZ     RELQU             YES
         CI,D2    BLOCKBIT          IS BLOCKED
         BANZ     RELQD             YES
*                     CAN ALLOCATE ONLY IF NO ALL, ALLOC OR
*                      BOTH SHARE
         BAL,R0   ALLALLO
         B        RELQE1            NO ALLOCATED ALL, SO GO ALLOC
         BAZ      RELQE1
         BAL,R0   SHASHA
         B        CHKU              NOT BOTH SHARE..SO QUIT
RELQE1   EQU      %
*
         LW,R6    R5
         BAL,SR2  ALLOC             NO-ALLOCATE IT
         LD,D1    QT,R5
         CI,D2    SHAREBIT
         BANZ     RELQF             SHARE
         SPACE    3
CHKU     EQU      %                 SPECIAL ENTRY TO RELQ TO DETECT AND
*                                     RELEASE EMPTY USER ENTRY, OR
*                                     EMPTY Q ENTRIES
         LW,SR1   R2                SAVE FOR RELU
         LD,D3    QT,R4             IS USER CHAIN EMPTY
         CI,D3    X'FFFF'
         BANZ     BISR4             NOT EMPTY-RETURN
         LW,R6    R4                EMPTY-RELEASE IT
         LW,R7    R2
         BAL,SR2  UNLINKQUS
         SPACE    3
CHKQ     EQU      %                 SPECIAL ENTRY TO RELQ TO DETECT AND
*                                    RELEASE EMPTY Q
         LD,D3    QT+2,R2
         AI,D3    0
         BNEZ     BISR4             NOT EMPTY-RETURN
         LW,R6    R2                EMPTY-RELEASE IT
         LI,R7    0
         BAL,SR2  UNLINKQUS
         B        *SR4
*
RELQU    EQU      %                 CHECK FOR UPGRADES
         CI,D2    UPGRADEBIT
         BAZ      CHKU              NOT UPGRADE
         LH,R1    D1
         LD,D3    QT,R1
         CI,D4    ALLOCBIT
         BANZ CHKU                  CANT UPGRADE..OTHER ALLOC
*                      IF ALL, CAN ALLOCATE ONLY IF NO OTHER ALLOCS
         LD,D3    QT,R3
         CW,D4    ALL
         BNE      RELQU1            NOT ALL, SO CHECK IF ALL EXISTS
*
RELQU4   EQU      %                 CHECK FOR ALLOC IN ANY OTHER S
         LH,R1    D3
         BEZ      RELQU2            OK-GO ALLOCATE UPGRADE
         LD,D3    QT,R1             NEXT S
         INT,R7   D3
         LD,D1    QT,R7
         CI,D2    ALLOCBIT
         BAZ      RELQU4            OK..CHECK NEXT
         B        CHKU
*                      IF AN ALLOCATED ALL ENTRY EXISTS, CAN'T UPGRADE
RELQU1   EQU      %
         BAL,R0   ALLALLO
         B        RELQU2
         BANZ     CHKU              CANT UPGRADE.. ALL ALLOC
*
RELQU2   EQU      %                 NOW RELEASE OLD ENTRY AND ALLOC NEW
         LD,D3    QT,R5             GET USER NO. IN D4
         BAL,R0   DOUP              GO DO UPDATE
         B        CHKU
*
RELQD    EQU      %                 ALLOCATE IN 'ALL' Q IF POSSIBLE
         LI,SR3   0
         BAL,R0   ALLALLO
         B        RELQD2            NO ALL..SET TO NEXT S & CHK S'S
         BANZ     RELQJ             AN ALL ALLOC..CHECK ALL UPGRADE
         LH,R6    D4
         LD,D3    QT,R6             SET UP FOR SEARCH OF Q
         LH,R6    D3                CHECK OTHER Q'S
         LW,R7    R1
*
RELQD1   EQU      %
         PUSH     4,R2
RELQD3   AI,R6    0
         BEZ      RELQG             OK-NO MORE Q'S
         LD,D3    QT,R6             NEXT S
         LH,R6    D3
         INT,R1   D3
         LD,D3    QT,R1             SQ
         CI,D4    BLOCKBIT
         BANZ     RELQD3            HE'S BLOCKED-SO LOOK AT NEXT S
         CI,D4    UPGRADEBIT
         BANZ     RELQK             DO IT
*
         BAL,R0   SHASHA
         B        RELQK1            NOT BOTH SHARE
         B        RELQD3            OK-LETS CHECK NEXT Q
*
RELQK    LW,R5    R1                SETUP FOR UPGRADE
         BAL,R0   DOUP
RELQK1   AI,SR3   1                 SET NO ALLS TO BE ALLOCATED
         B        RELQD3
RELQD2   LW,R6     R3
         AI,SR3   1
         B        RELQD1
         SPACE    2
CHKU4    PULL     SR4
         B        CHKU
         SPACE    2
RELQG    EQU      %
         PULL     4,R2
         LI,R0    0
         XW,R0    SR3
         BNEZ     CHKU
         LW,R6    R7
         BAL,SR2  ALLOC             ALLOCATE TOP OF 'ALL'
         LD,D1    QT,R5
         CI,D2    SHAREBIT
         BAZ      CHKU              NOT SHARE
RELQF    EQU      %                 ALLOCATE ADDITIONAL SHARES
         LH,R6    D1
         BEZ      CHKU              NO MORE
         LD,D1    QT,R6
         CI,D2    BLOCKBIT
         BANZ     CHKU              BLOCKED-ALL DONE
         CI,D2    SHAREBIT
         BAZ      CHKU              EXCL-ALL DONE
         BAL,SR2  ALLOC             CAN SHARE
         LD,D1    QT,R6
         B        RELQF             TRY NEXT
RELQO    BAL,SR4  RELQ
         LI,SR4   ERR3104
         B        ENQDEST
         REF      ERR3104,RELDW,REL1DW
*                      DO UPGRADE FOR ALL AND EXIT
RELQJ    EQU      %
         CI,D4    UPGRADEBIT
         BAZ      CHKU              NOT UPGRADE
         LW,R5    R1
         LH,R1    D3
         LD,D1    QT,R1
         CI,D2    ALLOCBIT
         BANZ     CHKU
         BAL,R0   DOUP
         B        CHKU
         SPACE    2
DOUP     EQU      %                 DO UPGRADE FOR SQ IN R5
         PUSH     R0
         STB,D4   R0                SAVE USER NO.
         PUSH     SR4
         ANLZ,R6  UIX               FIND USER ENTRY FOR UNLINKSQ
         BAL,SR4  FINDU+2
         NOP      0                 WILL ALWAYS FIND IT
         XW,R4    *TSTACK
         LW,SR4   R4
         LW,R4    R6
         LD,D3    QT,R5
         STB,D4   *TSTACK           SAVE THIS USER NO. IN TSTACK
         PUSH     D3                SAVE IX, NEST SQ THIS S
         BAL,SR2  UNLINKSQ
         PULL     D3
DOUP1    EQU      %
         LH,R6    D3                FIND NEXT SQ, THIS USER, THIS S
         LD,D3    QT,R6
         CB,D4    *TSTACK
         BNE      DOUP1
*
         BAL,SR2  ALLOC
         PULL     R4
         AND,R4   M24
         B PULLEXIT
         PAGE
UNLOK    EQU      %
*                   UNBLOCKS USERS AS THEY ARE ENCOUNTERED IN THE USER
*                    CHAIN, AND MAKES ENTRIES PENDING OR ALLOCATED.
         PUSH     14,R2             R2-D4
         LD,D1    QT+2,R2           FIND 1ST USER
UNLOKNXU LH,R4    D1
         BNEZ     UNLOK1
         PULL     14,R2             NO MORE USERS-DONE
         B        *SR2
UNLOK2   LD,D1    QT,R4
         B        UNLOKNXU
UNLOK1   LD,D1    QT,R4
         CW,D2    YFF
         BAZ      UNLOKMOR          NOT BLOCKED-SO CHECK FOR ALLOCABLES
         AND,D2   M24               CLEAR BLOCK
         REF      M24,YFF
         STD,D1   QT,R4
*
UNLOKMOR LI,R5    X'FFFF'
         CI,D2    ECBBIT
         BAZ      UNLOKM1
         AND,R5   D1                SKIP ECB ENTRY
         LD,D1    QT,R5
         LI,R5    X'FFFF'
UNLOKM1  EQU      %
         AND,R5   D1
         BEZ      UNLOK2            END CHAIN-DO NEXT USER
         LD,D3    QT,R5
         AND,D4   NB31TO0+XBLOCKBIT  CLR BLOCKED
         STD,D3   QT,R5
         REF      LINKSQ
*
UNLOKNB  EQU      %
         LH,R3    D4
         LD,D1    QT,R3             IS PRECEEDING ENTRY ALLOC & SHARE
         INT,R1   D1
         CW,R1    R5
         BE       UNLOKCA           AT HEAD OF S-CHECK FOR 'ALL'
         BAL,SR2  BLINK
         CI,D2    ALLOCBIT
         BAZ      UNLOKNS           NOT ALLOC-DONE WITH THIS ENTRY
         LD,D3    QT,R5             IS THIS SHARE
UNLOKSS  BAL,R0   SHASHA
         B        UNLOKNS           NOT SHARE/SHARE SO CAN'T ALLOCATE
UNLOKALO LW,R6    R5
         LD,D1    QT,R5             IF ALLOCATED, DON'T CALL ALLOC
         CI,D2    ALLOCBIT
         BANZ     UNLOKMOR
         BAL,SR2  ALLOC
UNLOKNS  EQU      %
         LD,D1    QT,R5
         B        UNLOKMOR
UNLOKCA  BAL,R0   ALLALLO
         B        UNLOKALO
         BAZ      UNLOKALO
         B        UNLOKSS           AN ALL ALLOCATED, CHK SHARE/SHARE
         PAGE
SAJCK    EQU      %
*                   CHECKS FOR A DEADLOCK. IF FOUND, UNLINKS THE CURRENT
*                    ENTRY AND RETURNS AN ERROR. OTHERWISE,RETURN IS TO
*                    ENQCW.
         PUSH     4,R2
         LI,SR3   0                 INITIALIZE ERROR FLAG
         LD,D3    QT,R4             FIND 1ST NON-ALLOC FOR THIS USER
         STB,D4   SR1               SAVE USER NO.
         B        SAJCKGO
SAJCK1   INT,R5   D3
SAJCKDNA LD,D3    QT,R5
         CI,D4    ALLOCBIT
         BANZ     SAJCK1                ALLOC-KEEP SEARCHING
         LH,R3    D4                GET S INDEX
         AND,R3   M14
         REF      M15,MASKS
M14      EQU      MASKS+14
         LD,D1    QT,R3
         LB,D2    D2
         LI,R0    0
         CI,D2    X'7F'
         BNE      %+2
         LW,R0    Y4
         REF      Y4
         SPACE 2
         BAL,SR4  DRPEBL
         LH,R3    D2
         AND,R3   M14
         STW,R3   J:BASE+4          SAVE FOR ALL SEARCH
SAJMAA1  LD,D1    QT,R3             GET START OF SQ CHAIN
         SLS,D1   16
SAJMA6   EQU      %
         AI,R0    0                 IS 'ALL' FLAG SET
         BE       SAJMAO            NO-IS OTHER
SAJMAA   BAL,SR2  SAJCKSQA          FIND NEXT ENTRY-'ALL' & GOTO SAJDA
         STW,SR3  J:BASE+4          CLEAR ALL BACK POINTER
         LD,D1    QT,R3             NOT FOUND TRY NEXT S
         LH,R3    D1
         BNEZ     SAJMAA1
         AI,SR4   X'20000'          CLEAR 'PICK' FLAG
         B        SAJNMA4           GO START WITH 'ALL' S
SAJNMA3  LD,D3    QT+2,R2           POINT TO FIRST S
         INT,R3   D3
SAJNMA   EQU      %                 FIND NON-ALLOC PEBBLE IN THIS Q,
         LD,D3    QT,R3             THIS USER
         SLS,D3   16
SAJNMA1  LH,R5    D3
         BEZ      SAJNMNS
         LD,D3    QT,R5
         LW,D4    D4
         BGE      SAJNMA1           NO PEBBLE
         CI,D4    ALLOCBIT
         BANZ     SAJNMA1           ALLOC-NOT YET
*                      CHECK FOR PRELIMINARY PASS
         AI,SR3   0
         BNEZ     SAJPK1            UNWINDING..SKIP PRE-PASS CHECK
         CI,SR4   X'1FFFF'
         BG       SAJPK1            REGULAR PASS
*                       IS FIND USER PASS
         STB,D4   SR4               SAVE USER NO. AND SET FLAG
         PULL     4,R2
         LD,D1    QT,R5
         B        SAJMA6
         SPACE    2
SAJPK1   EQU      %
         BAL,SR4  PKPEBL
         STB,D2   SR1
         AI,SR3   0
         BE       SAJMNA            TRY ANOTHER PATH
         B        SAJFAP
*
SAJNMNS  LD,D3    QT,R3             GET NEXT S
         LH,R3    D3
         BEZ      SAJNMA3           SKIPPED NUL..DO IT FROM TOP
         B        SAJNMA
SAJMAO2  SLS,D1   16
SAJMAO   BAL,SR2  SAJCKSQA          ORIGINALLY OTHER (NOT 'ALL')
         LD,D1    QT,R3
         LW,D3    R3
         LB,D2    D2
         CI,D2    X'7F'
         BNE      SAJMAO4           NOT ALL-PROCEED
         LW,R3    J:BASE+4          IF PRECEEDED BY ALL, FIND PREVIOUS
         BEZ      SAJMAO4
         CW,R3    D3
         BNE      SAJNMA
SAJMAO4  EQU      %
         BAL,R1   FINDALL
         B        SAJMAO2           FOUND ALL
*                                   NOT FOUND
SAJNMA2  LW,R3    D3
         AND,R3   M14
         B        SAJNMA
SAJDA    EQU      %
         SPACE    2
         BAL,SR4  DRPEBL
         STB,D2   SR1
         LW,D2    S:CUN
         CB,D2    SR1
         BNE      %+2
         BAL,SR3  SAJFAP2           BACK TO FIRST USER..DEADLOCK FOUND
SAJCKGO  EQU      %
         LD,D1    QT                FIND FIRST Q
         SLS,D1   16
SAJGNQ   LH,R2    D1                GET NEXT Q
         BEZ      SAJFAP
         LD,D1    QT+2,R2           FIND TOP THIS USER
SAJFTOU  LH,R4    D1
         BNEZ     SAJFTU
SAJGNQ1  LD,D1    QT,R2             CHECK NEXT Q
         B        SAJGNQ
SAJFTU   EQU      %
         LD,D1    QT,R4
         CB,D2    SR1
         BNE      SAJFTOU           NOT YET RIGHT USER
SAJMNA   LI,R5    X'FFFF'           THERE IT IS-MORE ALLOC     THIS USER
         CI,D2    ECBBIT
         BAZ      SAJMNA1
         AND,R5   D1
         LD,D1    QT,R5             SKIP ECB ENTRY
         LI,R5    X'FFFF'
SAJMNA1  AND,R5   D1
         BEZ      SAJGNQ1           NO MORE
         LD,D1    QT,R5
         CW,D2    L(ALLOCBIT+1**31)  ALLOC OR PEBBLE
         BANZ     SAJMNA
         CI,SR3   0                 NON-ALLOC-IS ERROR FLAG SET
         BEZ      SAJCKDNA           NO
         LD,D3    QT,R4
         STB,D4   SR1               USER NO. FOR COMPARE
SAJFAP   LD,D1    QT                FIND ALLOC IN ANY Q FOR THIS USER
         LI,R2    X'FFFF'
         AND,R2   D1                STARTING Q
SAJFAPGU LD,D1    QT+2,R2           U HEAD
SAJFPNXU  LH,R4   D1
         BEZ      SAJFAPNXQ         NOT IN THIS Q-TRY NEXT
         LD,D1    QT,R4             IS THIS U RIGHT
         CB,D2    SR1
         BNE      SAJFPNXU          GO CHECK ANOTHER U
SAJFAPSQ LI,R5    X'FFFF'           FIND AN ALLOC W/PEBBLE
         AND,R5   D1
         BEZ      SAJFAPNXQ         NOT FOUND-TRY ANOTHER Q
SAJFAP2  EQU      %
         LD,D1    QT,R5             IS THIS ALLOC & PEBBLE
         AI,D2    0
         BGE      SAJFAPSQ          NO PEBBLE
*                   FOUND IT - NOW PICK THE PEBBLE
         LH,R3    D2
         AND,R3   M14
         SPACE    2
         BAL,SR4  PKPEBL
         AND,SR4  M17
         REF      M17
         LD,D3    QT,R3
         STW,R3   J:BASE+4
         LB,R7    D4
         CI,R7    X'7F'
         BNE      SAJMA             NOT AN 'ALL' S
         AND,D4   M16               SAVE BACK POINTER
         STW,D4   J:BASE+4
         LW,D4    ALL               AND RESTORE QNAME
         STD,D3   QT,R3
SAJMA    EQU      %
         AI,SR3   0
         BNE      SAJNMA4           ERROR-CONT. PICKS
*                                    FIND PREVIOUS USER
         PUSH     4,R2              SAVE REGS FOR SPECIAL ENTRY
SAJNMA4  EQU      %
         LI,R1    SAJNMA
         AI,R0    0
         BNE      FINDALL           'ALL'.. SO GO FIND ALL
         LW,R3    J:BASE+4
         B        SAJNMA
         SPACE    2
FINDALL  EQU      %                 SETS R3 TO ALL S ENTRY
         LD,D1    QT+2,R2
         SLS,D1   16
FINDALL1 EQU      %
         LH,R3    D1
         BEZ      1,R1              NOT FOUND, RETURN SKIPPING
         LD,D1    QT,R3
         LB,D4    ALL
         CB,D4    D2
         BE       0,R1              FOUND, RETURN NORMAL
         CW,D2    Y4
         BANZ     FINDALL1          WAS NULL,CHECK NEXT S
         B        1,R1              NOT FOUND
*
SAJFAPNXQ LD,D1   QT,R2             Q HEAD-FIND NEXT Q
         LH,R2    D1
         BNEZ     SAJFAPGU
*                                   NOT FOUND-HEY THATS THE END OF THE
*                                    DEADLOCK CHECK
         PULL     4,R2
         LI,SR4   ENQCW
         AI,SR3   0
         BEZ      ENQDEST
*                 FALL INTO SAJERR
         REF      ENQCW
         SPACE    3
SAJERR   EQU      %
         LD,D1    QT,R3             IF ALL-MUST REDUCE LOCK CTR
         CW,D2    ALL
         BNE      SAJERR1
         LD,D1    QT+2,R2
         AI,D2    -1
         STD,D1   QT+2,R2
*
SAJERR1  EQU      %
         BAL,SR2  UNLINKSQ
         LD,D1    QT,R3             IF S EMPTY, DELETE IT
         ANLZ,R7  UIX
         LW,R6    R3
         LI,R1    X'FFFF'
         AND,R1   D1
         BNEZ     %+2
         BAL,SR2  UNLINKQUS
         BAL,SR4  CHKU              NOW DELETE EMPTY USER
         LI,SR3   X'58'
         B        TOENQERR
         SPACE    3
DRPEBL   EQU      %
*                   SETS A PATH MARKER IN THE HI-ORDER BIT OF QUVP OF
*                  THE CURRENT(R5) ENTRY. RETURN IS TO BAL+1.
*                  LINK IS SR4.
         LD,D1    QT,R5
         LW,D2    D2
         BL       BISR4             ALREADY SET-TAKE ERROR EXIT
         OR,D2    R0                'ALL' FLAG
DRPKX    EOR,D2   Y8                NOT SET-SO DROP A PEBBLE
         REF      Y8
         STD,D1   QT,R5
         STB,D2   SR4               SAVE USER NO. FOR SAJCKSQA
BISR4    B        *SR4
         SPACE    5
PKPEBL   EQU      %
*                   CLEARS THE PATH MARKER IN THE HI-ORDER BIT OF QUVP
*                  OF THE CURRENT(R5) ENTRY. RETURN IS TO BAL+1.
         LD,D1    QT,R5
         LW,R0    Y4
         AND,R0   D2
         EOR,D2   R0                CLR 'ALL' IF SET
         LW,D2    D2
         BGE      BISR4             ALREADY CLEAR
         B        DRPKX             GO FINISH
         SPACE    3
SAJCKSQA EQU      %
*                   SEARCHES THE CURRENT SQ FROM CURRENT LOCATION
*                   LOOKING FOR A DIFFERENT USER ENTRY.
*                  RETURN TO SAJDA IF FOUND,
*                  BAL+1 IF NOT. LINK ON SR2. D1 LH MUST
*                    CONTAIN POINTER TO NEXT ENTRY
         LH,R5    D1                NEXT ENTRY
         BNEZ     SJCKSQ1
SJCKSQ2  EQU      %
BISR2    B        *SR2
SJCKSQ1  LD,D1    QT,R5
         CI,D2    UPGRADEBIT
         BANZ     SJCKSQ4           SKIP END TEST IF UPGRADE ENTRY
         CB,D2    SR4
         BE       SJCKSQ2           THIS USER-END THIS S CHAIN
SJCKSQ4  EQU      %
         LH,R1    D2                IS CURRENT S
         CW,R1    R3
         BE       SJCKSQ3
         CW,D2    L(BLOCKBIT+1**31) NO-CHECK BLOCKED
         BANZ     SJCKSQ2             AND TREAT AS END S
SJCKSQ3  EQU      %
         LD,D3    QT,R3
         CW,D4    ALL
         BNE      SAJDA
*                   'ALL'...SAVE PREVIOUS PEBBLE POINTER
         OR,D4    J:BASE+4
         STD,D3   QT,R3
         B        SAJDA             FOUND
         PAGE
ENQOLD   EQU      %
         LW,R7    R6                R7=OLD
         LD,D1    QT,R7             ENTRY EXISTS-IS IT UPGRADE
         LD,D3    QT,R5             R5=NEW
         CI,D2    SHAREBIT
         BAZ      ENQDUP            NO-OLD IS EXCL
         CI,D4    SHAREBIT
         BANZ     ENQ3101           NO-NEW IS SHARE
         CI,D2    ALLOCBIT
         BAZ      ENQSW             NOT ALLOC
*
         LD,D3    QT,R3             ARE 2 OR MORE ALLOC
         INT,R1   D3
         LD,D3    QT,R1             1ST
         LH,R6    D3
         BEZ      ENQUP             ONLY 1 ENTRY
*
         LD,D3    QT,R6             2ND ENTRY
         CI,D4    ALLOCBIT
         BAZ      ENQUP             ONLY 1 ALLOC
ENQOLD2  EQU      %
         LD,D3    QT,R1
         CI,D4    ALLOCBIT
         BAZ      ENQOLD1
         CI,D4    UPGRADEBIT
         BANZ     SAJERR1           2 UPGRADES IN SAME S..NG
         LH,R1    D3
         BNEZ     ENQOLD2
*
*
ENQOLD1  OR,D2    BT31TO0+XUPGRADEBIT
         STD,D1   QT,R7
         LD,D3    QT,R3             FIND TOP OF PENDING
         SLS,D3   16
         LW,R6    R3
         CW,D4    ALL
         BNE      ENQTP
         BAL,SR4  LOCK              UPGRADE WARRANTS LOCK
ENQTP    LH,R1    D3
         BEZ      R6ENQLSQ          NO MORE ENTRIES
         LD,D3    QT,R1
         CI,D4    ALLOCBIT
         BAZ      R6ENQLSQ          FOUND
         LW,R6    R1
         B        ENQTP
*
ENQUP    EQU      %
         LD,D3    QT,R3
         CW,D4    ALL
         BE       ENQUPAL           IS 'ALL'
         BAL,R0   ALLALLO
         B        ENQSW2A           NO 'ALL'
         BANZ     ENQOLD1           IS ALLOC-SO CANT UPGRADE NOW
ENQSW2A  LD,D1    QT,R5
         OR,D2    BT31TO0+XALLOCBIT
         STD,D1   QT,R5             SET ALLOC IN NEW ENTRY
         LD,D3    QT,R7             RESTORE R3
         LH,R3    D4
ENQSW    LD,D3    QT,R3             FIND AND SAVE PRECEEDING INDEX
         SLS,D3   16                  FOR ENQLSQ
         LW,R6    R3
ENQSW2   LH,R1    D3
         CW,R1    R7                THIS POINT TO OLD
         BE       ENQSW1            YEH
         LW,R6    R1                NO-TRY NEXT
         LD,D3    QT,R1
         B        ENQSW2
*
ENQSW1   PUSH     R6
         XW,R7    R5
         BAL,SR2  UNLINKSQ
         XW,R7    R5
         SPACE    2
TOENQLSQ LI,SR4   ENQLSQ
         B        ENQDEST
         REF      ENQLSQ
         SPACE    2
ENQDUP   LW,SR3   L(2**25+X'31')
         CI,D4    SHAREBIT          BOTH EXCL
         BANZ     ENQDUPX     ')
         SPACE    2
ENQ3101  LW,SR3   L(1**25+X'31')
ENQDUPX  PUSH     SR3
         STW,D2   J:BASE+4
         BAL,SR2  UNLINKSQ
         LD,D3    QT,R3             UNLINK S IF EMPTY
         CI,D3    X'FFFF'
         BANZ     %+2               NOT EMPTY
         BAL,SR2  RELS
         PULL     SR3
         LW,D4    J:BASE+4
         B        ABNCKAL
R6ENQLSQ PUSH     R6
         B        TOENQLSQ
*
ENQUPAL  EQU      %
         BAL,R0   ANYALLO
         B        ENQSW2A           NO OTHERS ALLOC
         LD,D1    QT,R7
         LH,R3    D2                RESTORE R3
         B        ENQOLD1           OTHERS ALLOC..SO SET UPGRADE,ETC.
         SPACE    2
ANYALLO  EQU      %                 SEARCH FOR ANY ALLOC EXCEPT ALL/NULL
ANYALL2  LH,R3    D3
         BEZ      ALLALLX           NO MORE Q'S
         LD,D3    QT,R3
         STH,D3   D1                PREP TO SEARCH S FOR ALLOC
ANYALL1  LH,R1    D1
         BEZ      ANYALL2           NO MORE SQ'S, CHK NEXT S
         LD,D1    QT,R1
         CI,D2    ALLOCBIT
         BAZ      ANYALL1
         B        BIR01
         PAGE
ENQALL   EQU      %
         LD,D1    QT,R4             CHECK FOR SAJ IN USER
ENQNC1   LI,R1    X'FFFF'
         AND,R1   D1
         BEZ      ENQLQ             NO MORE SQ
         LD,D1    QT,R1
         LH,R7    D2
         BEZ      ENQNC1            NEW SQ HAS NO S POINTER
         LD,D3    QT,R7
         CW,D4    Y4
         BANZ     ENQNC1            NULL OR ALL
         LW,SR3   L(2**25+X'58')    'ALL' AND OTHERS (IGNORE 'NULL')
         LI,D2    0
         B        ENQDUPX
*
ENQLQ    EQU      %
         LD,R1    QT,R3             GET 1ST WORD OF DW
         AND,R1   M16
         BEZ      ENQSQC            NO ENTRIES-GO CHECK FOR OTHER S
         LD,D3    QT,R1             CHECK 1ST FOR ALLOC-SHARE
         CI,D4    ALLOCBIT
         BAZ      ENQEXD            NOT ALLOCATED-GO TO END
         LD,D1    QT,R5
*
         BAL,R0   SHASHA
         B        ENQEXD
         B        ENQALO            OK-GO SHARE
*
ENQSQC   LW,R1    R3                CHK FOR ANY ALLOCS EX/ALL,NULL
         LD,D3    QT,R5
ENQSQC1  LD,D1    QT,R1             GET S HEAD
         LH,R1    D1
         BEZ      ENQALOL           NO MORE S'S-OK TO ALLOC
         LD,R7    QT,R1             GET 1ST WORD OF DW
         AND,R7   M16
         BEZ      ENQSQC1           NEXT S
         LD,D1    QT,R7
         CI,D2    ALLOCBIT
         BAZ      ENQSQC1
         BAL,R0   SHASHA
         B        ENQPH
         B        ENQSQC1
*
ENQALOL  LD,D1    QT,R5
ENQALO   OR,D2    BT31TO0+XALLOCBIT
         STD,D1   QT,R5
*
ENQPH    LW,R6    R3
         BAL,SR4  LINKSQ            LINK IT IN
         CI,D4    ALLOCBIT          IF NOT ALLOC
         BANZ     %+2
         BAL,SR4  LOCK                LOCK Q
         LI,SR4   ENQDONE
         B        ENQDEST
         REF      ENQDONE,ENQEX
*
ENQEXD   BAL,SR4  LOCK
         LD,D1    QT,R1
         LI,SR4   ENQEX
         B        ENQDEST
         TITLE    'ENQO SUBROUTINES'
         PAGE
UNLINKQUS EQU     %
*                   UNLINKS A Q,U, OR S ENTRY AND RELEASES THE DW.
*                    ENTRY IS BAL,SR2 UNLINKQUS WITH R6=INDEX OF ENTRY
*                    TO UNLINK AND R7=INDEX OF ENTRY CONTAINING VERTICAL
*                    POINTER FOR CHAIN,I.E., 0 FOR Q, Q FOR U, U HEAD
*                    FOR S.
         PUSH     SR2
         LW,R1    R7
         LD,D3    QT,R7
         SCD,D3   16
ULKQUSA  LH,R0    D3
         CW,R0    R6                DOES THIS POINT TO OBJECT DW
         BE       ULKQUSB           YEH
         LW,R1    R0
         LD,D3    QT,R1
         B        ULKQUSA
*
ULKQUSB  EQU      %                 NOW UNLINKIT
         LD,D1    QT,R6
         LH,D1    D1
         STH,D1   D3                CHANGE LINK
         CW,R7    R1
         BNE      %+2
         SCD,D3   -16               IS HEAD-SO RESTORE POSTION
         STD,D3   QT,R1             NOW UNLINKED
         PUSH     R6
         CW,R6    R2                 SECONDARIES ARE RELEASED
         BNE      ULKQUSC
*
         AI,R6    1             IS Q-RELEASE U HEAD
         LW,SR1   R1                SAVE PRECEEDING Q INDEX IN SR1
         BAL,SR2  REL1DW
         LW,R6    *TSTACK
*
ULKQUSC  EQU      %                 NOW TAKE CARE OF QNAME ENTRIES
         LD,D1    QT,R6
         LW,R6    D2
         BGE      ULKQUSD           NO QNAMES
*
         CW,R7    R2
         BE       ULKQUSD           U ENTRY
*
         LB,R0    0,R6
         SLS,R0   -3                BYTES TO DW
         AI,R0    1
         SLS,R6   -3                BA TO DA
         SW,R6    L(DA(QT))
         AND,R6   M16
         REF      M16
         BAL,SR2  RELDW
*
ULKQUSD  EQU      %                 FINALLY-RELEASE BASIC ENTRY
         PULL     2,SR2
         LW,R6    SR3
         B        REL1DW            RELEASE DW & RETURN TO CALLER
         PAGE
UNLINKSQ EQU      %
*                   UNLINKS AN SQ ENTRY FROM THE S/U CHAINS,AND RELEASES
*                    THE DW,AND IF PRESENT, THE QECB DW
         LW,R6    R5                FORCE TO CURRENT SQ ENTRY
UNSQA    LD,D3    QT,R6             IF A QECB DW IS ASSOCIATED, RELEASE
         LW,SR1   D4                SAVE QQF FOR RELQ
         CI,D4    ALLOCBIT
         BANZ     UNSQA1            IS ALLOC
         CI,D4    X'F0000'
         BAZ      UNSQA1            NOT LINKED, SO NOT COUNTED
         MTW,-1   QT+1              REDUCE NON-ALLOC COUNT
UNSQA1   EQU      %
         CI,D4    ECBBIT              IT FIRST
         BAZ      UNSQB             NOPE
*
         EOR,D4   BT31TO0+XECBBIT   CLEAR IT
         LI,R1    X'FFFF'
         AND,R1   D3
         LD,D1    QT,R1             QECB
         LI,D2    X'FFFF'
         STS,D1   D3                BYPASS QECB IN U CHAIN
         STD,D3   QT,R6
         LW,SR3   R6
         PUSH     3,SR2
         LW,R6    R1
         BAL,SR2  REL1DW            RELEASE QECB DW
         PULL     3,SR2
         LW,R6    SR3
         LD,D3    QT,R6
*
UNSQB    EQU      %                 NO MORE QECB TO WORRY ABOUT
         LH,R1    D4
         BEZ      UNSQU             NO S CHAIN LINKS-PROCEED TO U CHAIN
         LD,D1    QT,R1             S HEAD
         LI,R0    X'FFFF'
         AND,R0   D1
         CW,R0    R6
         BNE      UNSQSC            GO ON DOWN CHAIN
         LH,D3    D3
         LI,D4    X'FFFF'
         STS,D3   D1                QQHP INTO QHVP-SQ UNLINKED F/S CHAIN
         STD,D1   QT,R1
         B        UNSQU
*
UNSQSC   EQU      %                 SEARCH S CHAIN FOR LINK TO THIS SQ
         LW,R1    R0
         LD,D1    QT,R1
         LH,R0    D1
         BEZ      UNSQU
         CW,R0    R6
         BNE      UNSQSC            NOT FOUND-KEEP SEARCHING
         LH,R0    D3
         STH,R0   D1
         STD,D1   QT,R1             QQHP TO QQHP-SQ UNLINKED
UNSQU    EQU      %                 UNLINK FROM U CHAIN
         LD,D1    QT,R4             U HEAD
         SCD,D1   16
         LD,D3    QT,R6
         CH,R6    D1
         BNE      UNSQU1            NOT 1ST ENTRY
         STH,D3   D1
         SCD,D1   -16
         STD,D1   QT,R4             UNLINKED FROM U HEAD
         B        UNSQR             GO RELEASE DW
*
UNSQU1   LH,R1    D1
         LD,D1    QT,R1
         LH,R0    D2                CLEAR UPGRADEBIT FOR SH ENTRY
         BEZ      UNSQU2            IGNORE-IS ECB ENTRY
         CH,R0    SR1                  IF PRESENT
         BNE      UNSQU2
         AND,D2   NB31TO0+XUPGRADEBIT
         STD,D1   QT,R1
*
UNSQU2   EQU      %
         SCD,D1   16
         CH,R6    D1
         BNE      UNSQU1            TRY NEXT
         STH,D3   D1                FOUND-NOW UNLINK
         SCD,D1   -16
         STD,D1   QT,R1
UNSQR    EQU      %
         B        REL1DW            RELEASE DW & RETURN TO CALLER
         PAGE
ALLOC    EQU      %
*                   SETS THE ALLOCATED FLAG IN THE SQ ENTRY AND EITHER
*                    WAKES THE SLEEPING USER, OR CALLS ECBPOST TO FLAG
*                    THE ECB THEN RELEASES THE ECB ENTRY.
*                    ENTRY IS BAL,9 ALLOC W/R6=INDEX OF SQ ENTRY
         LD,D3    QT,R6
         OR,D4    BT31TO0+XALLOCBIT  SET ALLOCATED
         MTW,-1   QT+1              REDUCE NON-ALLOC COUNT
         PUSH     10,R2
         LH,R7    D4
         LD,SR1   QT,R7             IF ALL, DECREMENT LOCK COUNT
         LB,SR2   SR2
         CI,SR2   X'7F'
         BNE      ALLOC1
         LW,R7    R2                DECREMENT LOCK COUNT
         SLS,R7   2
         AI,R7    3
         MTH,-1   QT+2,R7
*
ALLOC1   EQU      %
         CI,D4    SLEEPBIT
         BAZ      ALLOCECB
         EOR,D4   BT31TO0+XSLEEPBIT  IS ASLEEP SO WAKE UP-CLR SLEEP FLAG
         STD,D3   QT,R6
         LI,R5    X'FF'
         AND,R5   D4                USER NO.
         LI,R6    E:NQR             RESUME ENQ USER (WAKE)
         REF      E:NQR
         REF      T:RUE
         BAL,SR4  T:RUE             WAKE HIM UP
ALLOCZ   PULL     10,R2
         B        *SR2
         SPACE    2
ALLOCECB EQU      %
         CI,D4    ECBBIT
         BAZ      ALLOCZ
         LI,R6    X'FFFF'           GET ECB ENTRY
         AND,R6   D3                QECB INDEX TO R6 FOR RELDW
         LD,D1    QT,R6
         PUSH     D2                SAVE ECB ADDRESS FOR POST
         LI,D2    X'FFFF'
         STS,D1   D3                UNLINK QELB
         EOR,D4   BT31TO0+XECBBIT    AND CLEAR ECB FLAG
         LH,R1    D1
         STD,D3   QT,R1
         LI,SR1   X'FF'
         AND,SR1  D4
         BAL,SR2  REL1DW            RELEASE 1 DW
         PULL     SR3
         LI,SR2   0
         BAL,SR4  ECBPOST           POST ECB AND WAKE USER IF ASLEEP
         B        ALLOCZ
         SPACE    3
BLINK    EQU      %
*                 FINDS THE PRECEEDING ENTRY. OBJECT ENTRY INDEX IN R5
*                   AND STARTING POINT IN R1. LINK IS SR2,RETURN IN D1D2
         LD,D1    QT,R1
         LH,R7    D1
         CW,R7    R5
         BE       BISR2             FOUND
         LW,R1    R7
         B        BLINK
         REF      ALL
         SPACE    3
ALLALLO  EQU      %                 RETURN SKIPPING IF ANY   ALL ENTRY
*                    CC2 SET IF ALLOCATED-D3,D4 CONTAIN ENTRY IF
*                                     FOUND-LINK R0
         BAL,R1   FINDALL
         B        %+2
         B        *R0               NOT FOUND
*                                   FOUND ALL ENTRY
         LI,R1    X'FFFF'
         AND,R1   D1
         BEZ      ALLALLX           NO SQ ENTRIES
         AI,R0    1
         LD,D3    QT,R1
         CI,D4    ALLOCBIT
ALLALLX  B        *R0
         SPACE    3
SHASHA   EQU      %                 RETURN SKIPPING IF D2 & D4 HAVE
*                                     SHARE BIT SET
         CI,D2    SHAREBIT
         BAZ      SHASHAX
         CI,D4    SHAREBIT
         BAZ      SHASHAX
BIR01    AI,R0    1
SHASHAX  B        *R0
LOCK     EQU      %
*                 INCREMENTS THE LOCK COUNT FOR Q
*                   BAL,SR4 LOCK WITH R2=Q INDEX AND R3=S INDEX
         LW,R7    R2                GET U HEAD
         SLS,R7   1                 WORD INDEX
         MTW,1    QT+3,R7           INCREMENT LOCK COUNT FOR THIS Q
         B        *SR4
         END      ENQO

