         PCC      0
*M*      ENQO     ENQUEUE/DEQUEUE SECONDARY PROCESSING MODULE.
*P*      NAME:    ENQO
*P*      PURPOSE: TO FINISH PROCESSING CERTAIN ENQUEUE AND ALL
*P*               DEQUEUE REQUESTS.
*P*      DESCRIPTION: THE ENQO MODULE RESIDES IN THE ENQSEG OVERLAY
*P*               AND CONTAINS THE TRANSFER VECTOR FOR THE OVERLAY.
*P*               THE FIRST TEN ENTRIES IN THE VECTOR ARE USED BY
*P*               THE ENQUE MODULE AND THE LAST ENTRY IS USED BY BOTH
*P*               CALPROC AND STEP:
*P*
*P*               ENTRY  NAME       DESCRIPTION
*P*                 1    CHKQO      ENQERLG ROUTINE ENTRY POINT
*P*                 2    CHKUO      ENQERLG ROUTINE ENTRY POINT
*P*                 3    DEQUEUE    PROCESS DEQUEUE REQUESTS
*P*                 4    ENQALL     PROCESS ENQUEUE REQUESTS FOR 'ALL'
*P*                 5    ENQOLD     PROCESS ENQUEUE UPGRADES
*P*                 6    LNKQUE     ENQERLG ROUTINE ENTRY POINT
*P*                 7    RELDWO     ENQERLG ROUTINE ENTRY POINT
*P*                 8    RELQO      ENTRY POINT TO RELQ SUBROUTINE
*P*                 9    SAJCK      DETECT POSSIBLE DEADLOCK CONDITIONS
*P*                10    TEST       PROCESS ENQUEUE/TEST REQUESTS
*P*                11    ENQ        ENQUE MODULE ENTRY POINT (USED WHEN
*P*                                 ENQUE IS IN THE ENQSEG OVERLAY)
*P*
*P*      REFERENCE: BATCH PROCESSING REFERENCE MANUAL.
         TITLE    'ENQO MODULE AND FUNCTION PREAMBLE'
         DEF      ENQO:             PATCHING DEF
ENQO:    RES
*
         SREF     QT                MONITOR RESIDENT QUEUE TABLE
*
         REF      ENQ               ENQ/DEQ COMMON ENTRY POINT.
         REF      ENQLSQ            ENTRY USED BY ENQOLD.
         REF      ENQEX             ENTRY USED BY ENQALL.
         REF      ENQDONE           ENTRY USED BY ENQALL.
         REF      ENQCW             ENTRY USED BY SAJCK.
         REF      ENQ00             ENTRY USED BY DEQUEUE AND TEST.
         REF      ABN3103           ENTRY USED BY TEST.
         REF      ENQERR            ENTRY USED BY VARIOUS ENQO ROUTINES.
         REF      FINDQ             SUBR USED BY TEST AND DEQUEUE.
         REF      FINDS             SUBR USED BY TEST AND DEQUEUE.
         REF      UIX               ANLZ REFERENCE USED BY ENQO.
         REF      FINDSQ            SUBR USED BY TEST AND DEQUEUE.
         REF      FINDU             SUBR USED BY VARIOUS ENQO ROUTINES.
         REF      FINDR0U           SUBROUTINE USED BY DOUP SUBROUTINE
         REF      LINKSQ            SUBR USED BY ENQALL.
         REF      REL1DW            SUBR USED BY VARIOUS ENQO ROUTINES.
         REF      RELDW             SUBR USED BY VARIOUS ENQO ROUTINES.
         REF      ALL               CONSTANT REFERENCED BY ENQO.
         REF      E:NQR
         REF      ECBPOST
         REF      ERRLOG
         REF      J:ABC
         REF      J:BASE
         REF      LPART
         REF      MASKS
         REF      M16
         REF      M17
         REF      M24
         REF      PLB:USR
         REF      PLH:SID
         REF      PULLEXIT
         REF      S:CUN
         REF      T:RUE
         REF      TIME
         REF      UH:FLG
         REF      YFF
         REF      Y4
         REF      X4000
         REF      Y8
         REF      NB31TO0           TABLE CONSTANTS
         REF      BT31TO0
         PAGE
UFLAGS   SET      1                 UH:FLG EQU'S
         SYSTEM   UTS
*
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
*
STEPFLAG EQU      4
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      X'400'
QJOBBIT  EQU      JOBBIT
SHAREBIT  EQU     X'200'
QSHAREBIT EQU     SHAREBIT
UPGRADEBIT EQU    X'0100'
XUPGRADEBIT EQU   9
JIT:ENQ  EQU      X'100'
M14      EQU      MASKS+14
         TITLE    'ENQO MODULE TRANSFER VECTOR'
*
*        ENTRY:
*
         BLOCK                      DONT ALLOW SLAVE CPU'S TO GET HERE
*
         AI,R0    ENQTV             CALC LOC OF VECTOR BRANCH
         CI,R0    BENQ              TEST WHETHER ENQ
         BGE      %+2               B, IF SO
         PULL     R2                CALPROC DOESNT PUSH R2
ENQTV    B        *R0               B INTO THE VECTOR (1-11)
         B        CHKQO             ENTRY 1
         B        CHKUO             ENTRY 2
         B        DEQUEUE           ENTRY 3
         B        ENQALL            ENTRY 4
         B        ENQOLD            ENTRY 5
         B        LNKQUE            ENTRY 6
         B        RELDWO            ENTRY 7
         B        RELQO             ENTRY 8
         B        SAJCK             ENTRY 9
         B        TEST              ENTRY 10
BENQ     B        ENQ               ENTRY 11 BY CALPROC WHEN ENQUE IS
*                                   IN THE ENQSEG OVERLAY WITH ENQO.
         TITLE    'ENQO PRIMARY ROUTINES'
*D*      NAME:    LNKQUE
*D*      CALL:    B     LNKQUE
*D*      INTERFACE: ENTERED FROM ENQCAL IN THE ENQUE MODULE.
*D*      INPUT:   TOP OF STACK CONTAINS INDEX OF ENTRY TO RELEASE
*D*      DESCRIPTION: THIS IS A PURGE ROUTINE THAT RELEASES A
*D*               DOUBLEWORD ACQUIRED FOR A QECB-ENTRY AND THEN
*D*               TRANSFERS CONTROL TO THE CHKUO ROUTINE.
LNKQUE   PULL     R6
         BAL,SR2  REL1DW            RELEASE SQ DW
         B        CHKUO
         PAGE
*D*      NAME:    RELDWO
*D*      CALL:    B     RELDWO
*D*      INTERFACE: ENTERED FROM BUILDQS SUBROUTINE IN THE ENQUE MODULE.
*D*      INPUT:   FOR PURGING AN S-ENTRY:
*D*               R2=INDEX OF Q-ENTRY
*D*               R4=INDEX OF U-ENTRY
*D*               R5=INDEX OF AN SQ-ENTRY LINKED ONLY TO U-CHAIN
*D*               FOR PURGING EITHER A Q-ENTRY OR AN S-ENTRY:
*D*               R6=INDEX OF FIRST DOUBLEWORD TO BE RELEASED
*D*               STACK=NUMBER OF DOUBLEWORDS TO BE RELEASED (0,1 OR 2)
*D*               STACK-1=INDEX OF QT-HEADER OR U-HEADER
*D*               STACK-2=INDEX OF ENTRY TO WHICH ENTRY
*D*                       WAS TO BE LINKED.
*D*      DESCRIPTION: THIS IS A PURGE ROUTINE THAT RELEASES DW'S IF
*D*               NECESSARY. THEN IF THE ORIGINAL ATTEMPT WAS TO BUILD
*D*               A Q-ENTRY, CONTROL IS TRANSFERRED TO THE ENQERLG
*D*               ROUTINE. OTHERWISE, THE SQ-ENTRY (WITH THE QECB-ENTRY,
*D*               IF ONE EXISTS) IS UNLINKED AND RELEASED. FINALLY,
*D*               CONTROL IS TRANSFERRED TO THE CHKUO ROUTINE.
RELDWO   EQU      %
         PULL     R0                GET NR OF DW'S
         AI,R0    0                 TEST THE COUNT
         BEZ      %+2               B, IF NONE TO RELEASE
         BAL,SR2  RELDW             ELSE RELEASE
         PULL     2,R6              GET ORIGINAL BUILDSQ PARAMS
         CI,R7    0                 TEST WHETHER TRIED TO BUILD Q-ENTRY
         BEZ      ENQERLG           B, IF SO
         BAL,SR2  UNLINKSQ          ELSE RELEASE SQ- AND QECB-ENTRIES
         PAGE
*D*      NAME:    CHKUO
*D*      CALL:    B     CHKUO
*D*      INTERFACE: ENTERED FROM THE ENQCAL ROUTINE IN THE ENQUE
*D*               MODULE AND BY LNKQUE AND RELDWO IN THIS MODULE.
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*               R4=INDEX OF U-ENTRY
*D*      DESCRIPTION: THIS IS A PURGE ROUTINE THAT RELEASES THE U-ENTRY
*D*               IF EMPTY, RELEASES THE Q-ENTRY/U-HEADER PAIR IF THE
*D*               U-HEADER IS EMPTY, AND THEN TRANSFERS CONTROL TO THE
*D*               ENQERLG ROUTINE IN ORDER TO ISSUE AN ERROR CODE.
CHKUO    BAL,SR4  CHKU
         B        ENQERLG
         PAGE
*D*      NAME:    RELQO
*D*      CALL:    B     RELQO
*D*      INTERFACE: ENTERED FROM THE ENQCW ROUTINE IN THE ENQUE MODULE.
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*               R3=INDEX OF S-ENTRY
*D*               R4=INDEX OF U-ENTRY
*D*               R5=INDEX OF SQ-ENTRY
*D*      DESCRIPTION: THIS ROUTINE RELEASES THE SQ-ENTRY AND
*D*               TRANSFERS CONTROL TO THE TOENQERR ROUTINE IN ORDER
*D*               TO ISSUE A 3104 ABNORMAL CODE.
RELQO    BAL,SR4  RELQ              RELEASE SQ-ENTRY, ETC.
*E*      ERROR: ABNORMAL CODE 31, SUBCODE 04.
*E*      DESCRIPTION: JOB IS ABORTED OR ERRORED BY OPERATOR, OR CTL-Y
*E*               OR BREAK CODE RECEIVED.
         LW,SR3   L(4**25+X'31')
         B        TOENQERR
         PAGE
*D*      NAME:    CHKQO
*D*      CALL:    B     CHKQO
*D*      INTERFACE: ENTERED FROM THE ENQCAL ROUTINE IN THE ENQUE MODULE
*D*               AND BY RELDWO IN THIS MODULE.
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*      DESCRIPTION: THIS ROUTINE RELEASES A Q-ENTRY/U-HEADER PAIR IF
*D*               THE QUEUE IS EMPTY AND THEN TRANSFERS CONTROL TO
*D*               ENQERLG.
CHKQO    BAL,SR4  CHKQ
         PAGE
*D*      NAME:    ENQERLG
*D*      CALL:    B     ENQERLG
*D*      INTERFACE: ENTERED BY CHKUO, RELDWO AND CHKQO.
*D*      DESCRIPTION: THIS ROUTINE EXAMINES THE QT-TABLE AND CALLS THE
*D*               ERRLOG SUBROUTINE IN ORDER TO ISSUE AN ERROR LOG
*D*               CODE 50 (ENQUEUE TABLE OVERFLOW) ENTRY. THE ERROR
*D*               LOG ENTRY IDENTIFIES THE USER WITH THE MOST SQ-ENTRIES
*D*               IN THE TABLE. CONTROL IS THEN TRANSFERRED TO TOENQERR
*D*               IN ORDER TO ISSUE A 5801 ERROR CODE.
ENQERLG  INT,R1   QT                GET INDEX OF 1ST Q-ENTRY
         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
         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
*E*      ERROR:   ERROR CODE 58, SUBCODE 01.
*E*      DESCRIPTION: THERE IS INSUFFICIENT SPACE IN THE MONITOR'S
*E*               ENQUEUE TABLE FOR THE ENQUEUE REQUEST.
         LW,SR3   L(1**25+X'58')
         PAGE
*D*      NAME:    TOENQERR
*D*      ENTRY:   ENQDEST
*D*      CALL:    BRANCH TO ENTRY POINT
*D*      INTERFACE: ENTERED BY TEST, DEQUEUE, ENQOLD, RELQO, ENQALL
*D*               AND SQERROR ROUTINES AND BY THE SAJCK SUBROUTINE.
*D*      INPUT:   FOR ENQDEST ENTRY POINT:
*D*               SR4=ADDRESS OF ROUTINE IN ENQUE MODULE
*D*               FOR TOENQERR ENTRY POINT:
*D*               SR3=ERROR CODE
*D*      DESCRIPTION: WHEN ENTERED VIA TOENQERR, SR4 IS SET TO
*D*               CONTAIN THE ADDRESS OF THE ENQERR ROUTINE IN THE
*D*               ENQUE MODULE. THEN, IF THE GIVEN ROUTINE RESIDES
*D*               IN THE SAME OVERLAY, CONTROL IS TRANSFERRED TO IT
*D*               DIRECTLY. OTHERWISE, A DESTRUCT ENTRY TO THE ROUTINE
*D*               IN THE ENQUE MODULE IS TAKEN.
TOENQERR LI,SR4   ENQERR            SET ENTRY ADDRESS
ENQDEST  CI,SR4   X'8000'           TEST WHETHER ADDRESS RESIDES HERE NOW
         BG       *SR4              DIRECT RETURN IF ENQ IN OVERLAY
         DESTRUCT                   ELSE UNWIND
         PAGE
*D*      NAME:    TEST
*D*      CALL:    B     TEST
*D*      INTERFACE: ENTERED FROM THE ENQ ROUTINE IN THE ENQUE MODULE.
*D*      INPUT:   R2, BITS 0-7 = COUNT+1 OF QNAME
*D*               R2, BITS 8-31 = BA(TEXTC OF QNAME)
*D*               R3, BITS 0-7 = COUNT+1 OF SNAME
*D*               R3, BITS 8-31 = BA(TEXTC OF SNAME)
*D*               J:BASE+1, BITS 16-23 = QUEUE CODE (1,3,5, OR 7)
*D*               J:BASE+2 = ADDRESS OF THE ECB
*D*      DESCRIPTION: LATER.
TEST     LI,SR3   0                 SET TEST CODE
         BAL,SR4  FINDQ             R2 CONTAINS SNAME INFO
         B        TESTOK            RETURN HERE IF NOT FOUND
         LW,R2    R6                ESTABLISH INDEX OF Q-ENTRY
         BAL,SR4  FINDS             R3 CONTAINS SNAME INFO
         B        TESTU             RETURN HERE IF NOT FOUND
         LW,R3    R6                ESTABLISH INDEX OF S-ENTRY
         BAL,SR4  FINDSQ            R3 AND R6 CONTAIN INDEX OF S-ENTRY
         B        TESTHA            RETURN HERE IF NOT FOUND
         LW,R5    R6                ESTABLISH INDEX OF SQ-ENTRY
         LD,D3    QT,R5             GET SQ-ENTRY
         LW,R1    J:BASE+1          GET QUEUE CODE
         CI,D4    SHAREBIT          TEST WHETHER SQ-ENTRY IS SHARE
         BAZ      AABN3101          B, IF NOT
         CI,R1    QSHAREBIT         TEST WHETHER THIS IS TEST UPGRADE
         BANZ     ABN3101           B, IF NOT
         CI,D4    ALLOCBIT          TEST WHETHER SQ-ENTRY IS ALLOCATED
         BAZ      TOABN3103         B, IF NOT
*
         LD,D1    QT,R3
         INT,R1   D1
         CW,R1    R5
         BNE      TOABN3103         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
*
TOABN3103 LI,SR4  ABN3103
         B        ENQDEST
*
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
* HERE IF ALLOCATION OR UPGRADE COULD HAVE OCCURRED.
TESTOK   LW,D4    SR3               SAVE TEST CODE
         LW,SR3   J:BASE+2          SET ADDRESS OF ECB
         LW,SR1   S:CUN             SET USER NUMBER
         LW,SR2   Y8                SET CONDITION CODE
         BAL,SR4  ECBPOST           POST ECB AVAILABLE
         LW,SR3   D4                RESTORE TEST CODE
         BNEZ     TOENQERR          B, IF ABNORMAL
         B        ENQ00             ELSE RETURN TO USER
* HERE IF Q- AND S-ENTRIES EXIST, BUT NO SQ-ENTRY FOR USER EXISTS.
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      TOABN3103         NO
         LW,R0    J:BASE+1
         CI,R0    QSHAREBIT
         BAZ      TOABN3103         REQUEST NOT SH
         SPACE    2
TESTU    ANLZ,R6  UIX
         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       TOABN3103         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     TOABN3103
         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      TOABN3103
         CI,R0    QSHAREBIT
         BAZ      TOABN3103
         B        TESTAL1           BOTH SHARE SO GO ON TO NEXT SNAME
         PAGE
*D*      NAME:    DEQUEUE
*D*      CALL:    B     DEQUEUE
*D*      INTERFACE: ENTERED FROM THE ENQ ROUTINE IN THE ENQUE MODULE.
*D*      INPUT:   R2, BITS 0-7 = COUNT+1 OF QNAME
*D*               R2, BITS 8-31 = BA(TEXTC OF QNAME)
*D*               R3, BITS 0-7 = COUNT+1 OF SNAME
*D*               R3, BITS 8-31 = BA(TEXTC OF SNAME)
*D*      DESCRIPTION: THIS ROUTINE RELEASES SQ-ENTRIES DEPENDING UPON
*D*               THE DEQUEUE OPTIONS GIVEN AND THE ORIGINAL OPTIONS
*D*               GIVEN WHEN THE ENQUEUE REQUEST WAS MADE. IF THE
*D*               DEQUEUE QNAME IS 'ALL', THE JIT:ENQ FLAG IS SET
*D*               OFF AND THE RELU SUBROUTINE IS CALLED TO PROCESS
*D*               EACH Q-ENTRY IN THE SYSTEM. IF QNAME IS NOT 'ALL'
*D*               BUT SNAME IS 'ALL', THE RELU SUBROUTINE IS CALLED
*D*               TO PROCESS THE GIVEN QUEUE. OTHERWISE, THE RELQ
*D*               SUBROUTINE IS CALLED TO RELEASE THE SPECIFIC
*D*               SQ-ENTRY. CONTROL IS THEN TRANSFERRED TO ENQ00
*D*               IN THE ENQUE MODULE TO RETURN CONTROL TO THE USER.
*D*               IF ANY REQUIRED QT-TABLE ENTRY IS NOT FOUND, CONTROL
*D*               IS TRANSFERRED TO TOENQERR IN ORDER TO ISSUE A
*D*               3100 ABNORMAL CODE.
DEQUEUE  LB,R0    0,R2              GET ASSUMED QNAME TEXTC COUNT
         CI,R0    X'7F'             TEST FOR 'ALL'
         BE       DEQALL            B, IF SO
         BAL,SR4  FINDQ             R2 CONTAINS QNAME INFO
         B        DEQ3100           RETURN HERE IF NOT FOUND
         LW,R2    R6                ESTABLISH INDEX OF Q-ENTRY
         LB,R0    0,R3              GET ASSUMED SNAME TEXTC COUNT
         LI,SR4   ENQ00             SET LINK FOR RELU
         CI,R0    X'7E'             TEST FOR 'ALL' OR 'RES'
         BGE      RELU              RELEASE USER FROM Q-ENTRY AND EXIT
         BAL,SR4  FINDS             R3 CONTAINS SNAME INFO
         B        DEQ3100           RETURN HERE IF NOT FOUND
         LW,R3    R6                ESTABLISH INDEX OF S-ENTRY
         BAL,SR4  FINDSQ            R3 AND R6 CONTAIN INDEX OF S-ENTRY
         B        DEQ3100           RETURN HERE IF NOT FOUND
         LW,R5    R6                ESTABLISH INDEX OF SQ-ENTRY
         ANLZ,R6  UIX               SET INDEX OF U-HEADER
         BAL,SR4  FINDU             FIND U-ENTRY OF S:CUN
         B        DEQ3100           WILL ALWAYS BE FOUND
         LW,R4    R6                ESTABLISH INDEX OF U-ENTRY
         BAL,SR4  RELQ              RELEASE THE SQ-ENTRY
         B        ENQ00             EXIT TO USER
* HERE TO DEQUEUE USER FROM ALL QUEUES.
DEQALL   LI,R0    0
         LI,R1    JIT:ENQ
         STS,R0   J:ABC             CLEAR ENQUEUE USED FLAG
         LD,D3    QT                GET QT-HEADER
         SLS,D3   16                ADJUST INDEX OF 1ST Q-ENTRY
DEQALLA  LH,R2    D3                GET INDEX OF NEXT Q-ENTRY
         BEZ      ENQ00             EXIT, IF NONE
         LD,D3    QT,R2             GET NEXT Q-ENTRY
         STW,D3   J:BASE+3          SAVE INDEX TO SUCCESSOR
         BAL,SR4  RELU              RELEASE USER FROM Q-ENTRY
         LW,D3    J:BASE+3          RESTORE INDEX TO SUCCESSOR
         B        DEQALLA           AND REPEAT FOR NEXT Q-ENTRY
*E*      ERROR:   ABNORMAL CODE 31, SUBCODE 00.
*E*      DESCRIPTION: DEQUEUE ATTEMPTED FOR RESOURCE/ELEMENT FOR
*E*               WHICH USER IS NOT QUEUED.
DEQ3100  LI,SR3   X'31'             SET ABN CODE
         B        TOENQERR          AND EXIT
         PAGE
*D*      NAME:    RELU
*D*      CALL:    BAL,SR4     RELU
*D*      INTERFACE: CALLED BY DEQUEUE.
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*               J:BASE+1, BIT 0 = 1 IF 'RES' WAS SPECIFIED
*D*               J:BASE+1, BITS 16-23 = QUEUE CODE (1,3,5, OR 7)
*D*               J:BASE+1, BITS 24-31 = FPT FLAGS
*D*      DESCRIPTION: GIVEN A Q-ENTRY, THIS SUBROUTINE PROCESSES EACH
*D*               SQ-ENTRY ON THE U-CHAIN FOR THE CURRENT USER. IF
*D*               THERE IS NO U-ENTRY FOR THE QUEUE, CONTROL IS
*D*               RETURNED. IF THE DEQUEUE 'RES' OPTION WAS SPECIFIED,
*D*               THE SQ-ENTRY FOR THE 'NULL' ELEMENT, IF IT IS PRESENT,
*D*               IS NOT RELEASED. IF THE DEQUEUE 'JOB' OPTION WAS
*D*               SPECIFIED, OR IF THE ENTRY HAD BEEN ENQUEUED WITH
*D*               THE 'STEP' OPTION, THE SQ-ENTRY IS RELEASED. BETWEEN
*D*               JOB STEPS, AN SQ-ENTRY STILL QUEUED WOULD BE RETAINED
*D*               EXCEPT THAT THE STEP PROCESSOR SIMULATES M:DEQ (ALL,
*D*               ALL,STEP) AND ALSO SETS F3 IN THE FLAG WORD. WHEN F3
*D*               IS ON AND THE SQ-ENTRY IS NOT ALLOCATED, IT IS
*D*               RELEASED; THUS ONLY ALLOCATED SQ-ENTRIES REMAIN
*D*               ACROSS JOB STEPS. AT JOB END, THE STEP PROCESSOR
*D*               SIMULATES M:DEQ (ALL,ALL,JOB). IF ANY SQ-ENTRY FOR
*D*               THE USER REMAINS QUEUED, THE JIT:ENQ FLAG IS SET ON.
*D*               WHEN ALL ELIGIBLE SQ-ENTRIES HAVE BEEN RELEASED OR
*D*               WHEN A RELEASED SQ-ENTRY CAUSES THE RELEASE OF A
*D*               Q-ENTRY OR OF A U-ENTRY, CONTROL IS RETURNED TO THE
*D*               CALLER.
RELU     PUSH     SR4               SAVE LINK
RELULP   LD,D3    QT,R2             GET Q-ENTRY
         LI,R6    X'FFFF'
         AND,R6   D3                GET INDEX OF U-HEADER
         BEZ      PULLEXIT          RETURN, IF NONE
         BAL,SR4  FINDU             FIND U-ENTRY FOR S:CUN
         B        PULLEXIT          RETURN HERE IF NOT FOUND
         LW,R4    R6                SET INDEX OF U-ENTRY
         LW,R5    R4                COPY INDEX OF U-ENTRY
RELUSKP  LW,R7    R5                GET INDEX OF CURRENT ENTRY
         LD,D3    QT,R7             GET CURRENT ENTRY
         LI,R5    X'FFFF'
         AND,R5   D3                SET INDEX OF NEXT SQ-ENTRY ON S-CHAIN
         BEZ      PULLEXIT          RETURN, IF NONE
         CI,D4    ECBBIT            TEST FOR QECB-ENTRY
         BANZ     RELUSKP           B, IF SO TO SKIP IT
         LD,D3    QT,R5             GET NEXT SQ-ENTRY
         LW,R0    J:BASE+1          TEST FOR 'RES' OPTION
         BGZ      RELU2             B, IF NOT
         LH,R1    D4                GET INDEX OF S-ENTRY
         LD,D1    QT,R1             GET S-ENTRY
         CW,D2    Y4                TEST FOR 'NULL' S-ENTRY
         BE       RELUSKP           B, IF SO TO SKIP IT
RELU2    CI,R0    QJOBBIT           TEST FOR 'JOB' OPTION
         BANZ     RELUREL           B, IF SO TO RELEASE
         CI,D4    JOBBIT            TEST WHETHER ENQUEUED WITH 'JOB'
         BAZ      RELUREL           B, IF ENQUEUED WITH 'STEP'
         CI,R0    STEPFLAG          TEST IF F3 IS ON
         BAZ      RELUNO            B, IF NOT TO KEEP
         CI,D4    ALLOCBIT          TEST WHETHER ALLOCATED
         BAZ      RELUREL           B, IF NOT TO RELEASE
RELUNO   LI,R1    JIT:ENQ
         STS,R1   J:ABC             SET ENQUEUE USED
         B        RELUSKP           AND TRY NEXT ONE
* HERE TO RELEASE AN SQ-ENTRY.
RELUREL  LH,R3    D4                SET INDEX OF S-ENTRY
         BAL,SR4  RELQ              RELEASE THE SQ-ENTRY
         CW,SR1   R2                TEST WHETHER Q-ENTRY WAS RELEASED
         BNE      PULLEXIT          RETURN, IF SO
         B        RELULP            ELSE TRY FOR ANOTHER SQ-ENTRY
         PAGE
*D*      NAME:    RELQ
*D*      CALL:    BAL,SR4     RELQ
*D*      INTERFACE: CALLED BY THE DEQUEUE AND RELQO ROUTINES AND BY
*D*               THE RELU SUBROUTINE.
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*               R3=INDEX OF S-ENTRY
*D*               R4=INDEX OF U-ENTRY
*D*               R5=INDEX OF SQ-ENTRY
*D*      DESCRIPTION: THIS SUBROUTINE RELEASES AN SQ-ENTRY. IF THE
*D*               RELEASED ENTRY WAS A PENDING 'ALL' REQUEST, THE
*D*               PENDING 'ALL' COUNT IN THE U-HEADER IS REDUCED BY
*D*               ONE. IF THE RELEASED SQ-ENTRY WAS AN 'ALL' REQUEST
*D*               AND THERE ARE NO 'ALL' REQUESTS STILL PENDING, THE
*D*               UNLOK SUBROUTINE IS CALLED.
*D*
*D*               IN ALL CASES, IF THE S-CHAIN IS EMPTY, THE UNLINKQUS
*D*               SUBROUTINE IS CALLED. ...
RELQ     BAL,SR2  UNLINKSQ          RELEASE SQ-ENTRY
         LD,D3    QT,R3             GET S-ENTRY
         CW,D4    ALL               TEST WHETHER 'ALL' WAS RELEASED
         BNE      RELQB             B, IF NOT
         LW,R1    R2                COPY INDEX OF Q-ENTRY
         SLS,R1   2                 CALC INDEX OF
         AI,R1    7                   THE PENDING ALL COUNT IN U-HEADER
         CI,SR1   ALLOCBIT          TEST WHETHER SQ-ENTRY WAS ALLOCATED
         BANZ     %+2               B, IF SO
         MTH,-1   QT,R1             ELSE DECR PENDING ALL COUNT
         MTH,0    QT,R1             TEST WHETHER ANY PENDING 'ALL'S
         BNEZ     RELQB             B, IF SO
*HERE IF NO PENDING 'ALL'S; UNBLOCK USERS AND ALLOCATE IF POSSIBLE.
         PUSH     14,R2             SAVE R2-D4
         LD,D1    QT+2,R2           GET U-HDR
UNLOK2   LH,R4    D1                GET INDEX OF NEXT U-ENTRY
         BEZ      UNLOK3            B, IF NONE
         LD,D1    QT,R4             GET NEXT U-ENTRY
         AND,D2   M24               CLEAR POSSIBLE BLOCKED FLAG
         STD,D1   QT,R4             RESTORE U-ENTRY
         B        UNLOK2            AND REPEAT
* HERE TO PROCESS EACH S-CHAIN.
UNLOK3   LD,D1    QT+2,R2           GET U-HDR
         SLS,D1   16                ADJUST INDEX OF S-ENTRY
UNLOK4   LH,R3    D1                GET INDEX OF NEXT S-ENTRY
         BEZ      UNLOK15           B, IF NONE
         LD,D3    QT,R3             GET NEXT S-ENTRY
         SLS,D3   16                ADJUST INDEX OF SQ-ENTRY
UNLOK6   LH,R5    D3                GET INDEX OF 1ST SQ-ENTRY
         BNEZ     UNLOK8            B, IF ONE EXISTS
UNLOK7   LD,D1    QT,R3             GET CURRENT S-ENTRY AGAIN
         B        UNLOK4            AND GO FOR NEXT S-ENTRY
UNLOK8   LD,D3    QT,R5             GET 1ST SQ-ENTRY
         CI,D4    ALLOCBIT          TEST WHETHER ALLOCATED
         BANZ     UNLOK12           B, IF SO
         AND,D4   NB31TO0+XBLOCKBIT CLEAR POSSIBLE BLOCKED FLAG
         STD,D3   QT,R5             RESTORE SQ-ENTRY
UNLOK9   BAL,R0   ALLALLO           TEST WHETHER ALLOCATED 'ALL' EXISTS
         B        UNLOK10           RETURN HERE IF NO 'ALL' AT ALL
         LD,D1    QT,R5             ELSE GET SQ-ENTRY AGAIN
         BAL,R0   SHASHA            TEST WHETHER BOTH ARE SHARE
         B        UNLOK11           RETURN HERE IF NOT BOTH SHARE
UNLOK10  LW,R6    R5                SET INDEX OF SQ-ENTRY TO ALLOCATE
         BAL,SR2  ALLOC             AND ALLOCATE IT
UNLOK11  LD,D3    QT,R5             GET THE SQ-ENTRY AGAIN
         LH,R3    D4                SET INDEX OF S-ENTRY
UNLOK12  LW,D2    D4                SAVE FLAGS OF THIS SQ-ENTRY
         LH,R5    D3                GET INDEX OF NEXT SQ-ENTRY
         BEZ      UNLOK7            B, IF NONE
         LD,D3    QT,R5             GET NEXT SQ-ENTRY
         CI,D4    ALLOCBIT          TEST WHETHER ALLOCATED
         BANZ     UNLOK12           B, IF SO TO SKIP
         AND,D4   NB31TO0+XBLOCKBIT CLEAR POSSIBLE BLOCKED FLAG
         STD,D3   QT,R5             RESTORE SQ-ENTRY
         CI,D2    ALLOCBIT          TEST WHETHER PREDECESSOR ALLOCATED
         BAZ      UNLOK12           B, IF NOT TO SKIP
         BAL,R0   SHASHA            TEST WHETHER BOTH ARE SHARE
         B        UNLOK12           RETURN HERE IF NOT TO SKIP
         B        UNLOK9            ELSE TRY TO ALLOCATE
UNLOK15  PULL     14,R2             RESTORE R2-D4
* HERE TO EXAMINE S-CHAIN
RELQB    INT,R1   D3                INDEX OF 1ST SQ-ENTRY IN S-CHAIN
         LW,R5    R1                TEST THE INDEX
         BNEZ     RELQE             B, IF S-CHAIN IS NOT EMPTY
         BAL,SR2  RELS              ELSE RELEASE S-ENTRY
         B        RELQD
RELQE    LD,D1    QT,R5             GET 1ST SQ-ENTRY ON S-CHAIN
         CI,D2    ALLOCBIT          TEST WHETHER ALLOCATED
         BANZ     RELQU             B, IF SO
         CI,D2    BLOCKBIT          TEST WHETHER BLOCKED
         BANZ     RELQD             B, IF SO
* HERE IF 1ST SQ-ENTRY ON S-CHAIN IS PENDING.
         BAL,R0   ALLALLO           TEST WHETHER 'ALL' EXISTS
         B        RELQE1            RETURN HERE, IF NOT
         BAZ      RELQE1            B, IF 'ALL' IS NOT ALLOCATED
         BAL,R0   SHASHA            TEST WHETHER BOTH ARE 'SHARE'
         B        CHKU              RETURN HERE, IF NOT
* HERE TO ALLOCATE 1ST SQ-ENTRY ON S-CHAIN.
RELQE1   LW,R6    R5                R6=INDEX OF SQ-ENTRY TO ALLOCATE
         BAL,SR2  ALLOC             AND ALLOCATE IT
         LD,D1    QT,R5             GET 1ST SQ-ENTRY
         CI,D2    SHAREBIT          TEST FOR 'SHARE'
         BANZ     RELQF             B, IF SO
         B        CHKU              ELSE ENTER CHKU
RELQU    CI,D2    UPGRADEBIT        TEST 1ST SQ-ENTRY FOR UPGRADE
         BAZ      CHKU              B, IF NOT
         LH,R1    D1                GET INDEX OF 2ND SQ-ENTRY
         LD,D3    QT,R1             GET 2ND SQ-ENTRY ON S-CHAIN
         CI,D4    ALLOCBIT          TEST WHETHER IT IS ALLOCATED
         BANZ     CHKU              B, IF SO
* HERE IF ONLY 1 SQ-ENTRY ON S-CHAIN IS ALLOCATED.
         LD,D3    QT,R3             GET S-ENTRY
         CW,D4    ALL               TEST WHETHER THIS IS ALLOCATED 'ALL'
         BE       RELQU4            B, IF SO
         BAL,R0   ALLALLO           TEST WHETHER 'ALL' EXISTS
         B        RELQU2            RETURN HERE, IF NOT
         BANZ     CHKU              B, IF 'ALL' IS ALLOCATED
* HERE TO ALLOCATE AN UPGRADE.
RELQU2   LD,D3    QT,R5             SET D4=USER NUMBER OF OLD SQ-ENTRY
         BAL,R0   DOUP              DO THE UPGRADE
         B        CHKU
* HERE FOR 1 ALLOCATED 'ALL'.
RELQU4   LH,R1    D3                GET INDEX TO NEXT S-ENTRY
         BEZ      RELQU2            B, IF NONE TO UPGRADE
         LD,D3    QT,R1             GET NEXT S-ENTRY
         INT,R7   D3                GET INDEX TO 1ST SQ-ENTRY ON S-CHAIN
         LD,D1    QT,R7             GET 1ST SQ-ENTRY ON S-CHAIN
         CI,D2    ALLOCBIT          TEST WHETHER ALLOCATED
         BAZ      RELQU4            B, IF NOT
         B        CHKU
* HERE TO ALLOCATE A PENDING 'ALL', IF POSSIBLE.
RELQD    LI,SR3   0                 SET SWITCH TO INDICATE NO UPGRADES
         BAL,R0   ALLALLO           TEST WHETHER 'ALL' EXISTS
         B        RELQD2            RETURN HERE, IF NOT
         BANZ     RELQJ             B, IF 'ALL' IS ALLOCATED
* HERE IF PENDING 'ALL' EXISTS.
         LH,R6    D4                GET INDEX OF 'ALL' S-ENTRY
         LD,D3    QT,R6             GET PENDING 'ALL' S-ENTRY
         LH,R6    D3                GET INDEX OF NEXT S-ENTRY
         LW,R7    R1                COPY INDEX OF 'ALL' SQ-ENTRY
* R2=INDEX OF Q-ENTRY
* R3=INDEX OF 'ALL' S-ENTRY
* R4=INDEX OF U-ENTRY
* R5=INDEX OF NEWEST SQ-ENTRY
RELQD1   PUSH     4,R2
RELQD3   AI,R6    0                 TEST INDEX OF NEXT S-ENTRY
         BEZ      RELQG             B, IF NONE
         LD,D3    QT,R6             GET NEXT S-ENTRY
         LH,R6    D3                GET INDEX OF NEXT S-ENTRY
         INT,R1   D3                GET INDEX OF 1ST SQ-ENTRY ON S-CHAIN
         LD,D3    QT,R1             GET 1ST SQ-ENTRY
         CI,D4    BLOCKBIT          TEST WHETHER BLOCKED
         BANZ     RELQD3            B, IF SO TO EXAMINE NEXT
         CI,D4    UPGRADEBIT        TEST FOR UPGRADE
         BANZ     RELQK             B, IF SO
         BAL,R0   SHASHA            TEST WHETHER BOTH ARE 'SHARE'
         B        RELQK1            RETURN HERE, IF NOT
         B        RELQD3            ELSE B, TO EXAMINE NEXT
* HERE TO ALLOCATE AN UPGRADE.
RELQK    LW,R5    R1                SET INDEX OF SQ-ENTRY
         LH,R1    D3                NEXT SQ-ENTRY INDEX -> R1
         LD,D3    QT,R1             NEXT SQ-ENTRY -> D3,D4
         CI,D4    ALLOCBIT          IS IT ALLOCATED?
         BANZ     RELQD3            YES -> DO NOT UPGRADE
         BAL,R0   DOUP              DO UPGRADE
RELQK1   AI,SR3   1                 SET SWITCH: 'ALL' NOT TO BE ALLOCATED
         B        RELQD3            AND REPEAT
* HERE FOR NO 'ALL' AT ALL.
RELQD2   LW,R6    R3                R6=INDEX OF 1ST S-ENTRY BEYOND 'NULL'
         AI,SR3   1                 SET SWITCH: 'ALL' NOT TO BE ALLOCATED
         B        RELQD1            AND BEGIN
* HERE TO TEST WHETHER PENDING 'ALL' CAN BE ALLOCATED.
RELQG    PULL     4,R2              RESTORE R2-R5
         LI,R0    0
         XW,R0    SR3               TEST WHETHER UPGRADES WERE DONE
         BNEZ     CHKU              B, IF SO
         LW,R6    R7                R6=INDEX OF 'ALL' SQ-ENTRY
         BAL,SR2  ALLOC             ALLOCATE THE 1ST PENDING 'ALL'
         LD,D1    QT,R6             GET THE ALLOCATED 'ALL' SQ-ENTRY
         CI,D2    SHAREBIT          TEST FOR SHARE
         BAZ      CHKU              B, IF NOT
* HERE TO ALLOCATE CONSECUTIVE PENDING SHARE REQUESTS.
RELQF    LH,R6    D1                GET INDEX OF NEXT SQ-ENTRY
         BEZ      CHKU              B, IF NONE
         LD,D1    QT,R6             GET NEXT SQ-ENTRY
         CI,D2    BLOCKBIT          TEST WHETHER BLOCKED
         BANZ     CHKU              B, IF SO
         CI,D2    SHAREBIT          TEST FOR 'SHARE'
         BAZ      CHKU              B, IF NOT
         BAL,SR2  ALLOC             ELSE GO ALLOCATE IT
         LD,D1    QT,R6             GET SQ-ENTRY AGAIN
         B        RELQF             AND TRY THE NEXT ONE
* HERE IF ALLOCATED 'ALL' EXISTS; DO UPGRADE IF NEEDED.
RELQJ    CI,D4    UPGRADEBIT        TEST FOR UPGRADE
         BAZ      CHKU              B, IF NOT
         LW,R5    R1                COPY INDEX OF 1ST 'ALL' SQ-ENTRY
         LH,R1    D3                GET INDEX OF 2ND 'ALL' SQ-ENTRY
         LD,D1    QT,R1             GET 2ND 'ALL' SQ-ENTRY ON S-CHAIN
         CI,D2    ALLOCBIT          TEST WHETHER ALLOCATED
         BANZ     CHKU              B, IF SO
         BAL,R0   DOUP              UPGRADE IT AND ENTER CHKU
         PAGE
*D*      NAME:    CHKU
*D*      CALL:    BAL,SR4     CHKU
*D*      INTERFACE: CALLED BY THE CHKUO ROUTINE AND ENTERED BY THE
*D*               RELQ SUBROUTINE.
*D*      INPUT:   R4=INDEX OF U-ENTRY
*D*      OUTPUT:  SR1=COPY OF INPUT R2
*D*      DESCRIPTION: THIS SUBROUTINE RELEASES THE U-ENTRY IF IT IS
*D*               EMPTY AND THEN ENTERS THE CHKQ SUBROUTINE. OTHERWISE
*D*               IT RETURNS CONTROL TO THE CALLER.
CHKU     LW,SR1   R2                COPY OF R2
         LD,D3    QT,R4             GET U-ENTRY
         CI,D3    X'FFFF'           TEST FOR EMPTY U-CHAIN
         BANZ     *SR4              RETURN, IF NOT EMPTY
         LW,R6    R4                R6=INDEX OF U-ENTRY
         LW,R7    R2                R7=INDEX OF Q-ENTRY
         BAL,SR2  UNLINKQUS         RELEASE THE U-ENTRY AND ENTER CHKQ
         PAGE
*D*      NAME:    CHKQ
*D*      CALL:    BAL,SR4     CHKQ
*D*      INTERFACE: CALLED BY THE CHKQO ROUTINE AND ENTERED BY THE
*D*               CHKU SUBROUTINE.
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*      OUTPUT:  IF Q-ENTRY IS NOT RELEASED:
*D*               R2=COPY OF THE INPUT R2
*D*               IF Q-ENTRY IS RELEASED:
*D*               R2=INDEX OF PREDECESSOR OF RELEASED Q-ENTRY
*D*      DESCRIPTION: IF THE U-HEADER HAS NO LINKS TO EITHER AN S-ENTRY
*D*               OR A U-ENTRY, THIS SUBROUTINE RELEASES THE Q-ENTRY/
*D*               U-HEADER PAIR BEFORE RETURNING CONTROL.
CHKQ     LD,D3    QT+2,R2           GET U-HDR
         AI,D3    0                 TEST WHETHER BOTH LINKS ARE EMPTY
         BNEZ     *SR4              RETURN, IF NOT EMPTY
         LW,R6    R2                R2=R6=INDEX OF Q-ENTRY
         LI,R7    0                 R7=INDEX OF QT-HDR
         BAL,SR2  UNLINKQUS         RELEASE Q-ENTRY/U-HDR
         B        *SR4              RETURN
         PAGE
*D*      NAME:    DOUP
*D*      CALL:    BAL,R0     DOUP
*D*      INTERFACE: CALLED BY RELQ SUBROUTINE
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*               R3=INDEX OF S-ENTRY
*D*               R4=INDEX OF U-ENTRY
*D*               R5=INDEX OF SQ-ENTRY TO BE UPGRADED
*D*               D4 CONTAINS USER NUMBER FOR SQ-ENTRY TO BE UPGRADED
*D*      DESCRIPTION: THIS SUBROUTINE UPGRADES AN ALLOCATED SQ-ENTRY
*D*               BY RELEASING IT AND THEN ALLOCATING THE FIRST
*D*               SQ-ENTRY ON THE S-CHAIN. THIS IS POSSIBLE BECAUSE
*D*               THE UPGRADE (EXCLUSIVE) SQ-ENTRY IS ALWAYS PLACED
*D*               FIRST IN THE PENDING GROUP ON THE S-CHAIN AND SINCE
*D*               THERE ARE CURRENTLY NO SQ-ENTRIES ALLOCATED OTHER
*D*               THAN THE ONE TO BE RELEASED, THE UPGRADE ONE IS
*D*               THE FIRST ONE ON THE S-CHAIN AFTER THE ALLOCATED
*D*               ONE IS RELEASED.
DOUP     PUSH     R0                SAVE LINK
         PUSH     SR4               SAVE SR4
         STB,D4   R0                SET USER NUMBER FOR FINDR0U SUBR
         ANLZ,R6  UIX               SET R6=INDEX OF U-HDR
         BAL,SR4  FINDR0U           RETURNS R6=INDEX OF U-ENTRY
         NOP      0                 WILL ALWAYS FIND THE U-ENTRY
         LW,SR4   *TSTACK           RESTORE SR4
         STW,R4   *TSTACK           SAVE INDEX OF ORIGINAL U-ENTRY
         LW,R4    R6                SET R4=INDEX OF OTHER U-ENTRY
         BAL,SR2  UNLINKSQ          RELEASE THE ALLOCATED SQ-ENTRY
         LH,R6    SR1               GET INDEX OF ITS S-ENTRY
         LD,D3    QT,R6             GET S-ENTRY OF RELEASED SQ-ENTRY
         LI,R6    X'FFFF'
         AND,R6   D3                GET INDEX OF 1ST SQ-ENTRY ON S-CHAIN
         BAL,SR2  ALLOC             ALLOCATE THE EXCL SQ-ENTRY
         PULL     R4                RESTORE INDEX OF ORIGINAL U-ENTRY
         B        PULLEXIT          PULL R0 AND RETURN
         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
         LD,D1    QT,R3
         LB,D2    D2
         LI,R0    0
         CI,D2    X'7F'
         BNE      %+2
         LW,R0    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
         MTB,0    SR4               IS USER# PRESENT
         BNE      SAJPK1            YES -> 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    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
         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
*
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
*  PICK UP ANY LEFTOVER PEBBLES
         LD,D3    QT                QT-HDR
         LI,R2    1                 HALFWORD INDEX
         LH,R1    D3,R2             Q-HDR INDEX
PKUPQ    LD,D3    QT,R1             Q-ENTRY
         LH,R1    D3,R2             U-HDR INDEX
         LD,D1    QT,R1             U-ENTRY
         LH,R1    D1,R2             S-HDR INDEX
PKUPS    LD,D1    QT,R1             S-ENTRY
         LH,R1    D1,R2             SQ-HDR INDEX
PKUPSQ   LD,R4    QT,R1             SQ-ENTRY
         AND,R5   NB31TO0+32        MASK OFF PEBBLE AND
         STD,R4   QT,R1             RESTORE SQ-ENTRY
         LH,R1    R4                NEXT SQ-ENTRY INDEX
         BNEZ     PKUPSQ
         LH,R1    D1                NEXT S-ENTRY INDEX
         BNEZ     PKUPS
         LH,R1    D3                NEXT Q-ENTRY INDEX
         BNEZ     PKUPQ
*
         PULL     4,R2
         LI,SR4   ENQCW
         AI,SR3   0
         BEZ      ENQDEST
         LD,D1    QT,R3             IF ALL-MUST REDUCE LOCK CTR
         CW,D2    ALL
         BNE      SQERROR           ERROR, IF NOT
         LD,D1    QT+2,R2
         AI,D2    -1
         STD,D1   QT+2,R2
         PAGE
*D*      NAME:    SQERROR
*D*      CALL:    B     SQERROR
*D*      INTERFACE: ENTERED BY SAJCK AND ENQOLD.
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*               R3=INDEX OF S-ENTRY
*D*               R4=INDEX OF U-ENTRY
*D*               R5=INDEX OF SQ-ENTRY
*D*      DESCRIPTION: THIS ROUTINE IS USED TO PURGE ENTRIES WHEN A
*D*               DEADLOCK CONDITION IS DETECTED. FIRST, THE SQ-ENTRY
*D*               IS RELEASED. IF THE S-CHAIN IS EMPTY, THE S-ENTRY
*D*               IS RELEASED. IF THE U-CHAIN IS EMPTY, THE U-ENTRY IS
*D*               RELEASED. IF THE U-HEADER HAS NO LINKS TO EITHER AN
*D*               S-ENTRY OR A U-ENTRY, THE Q-ENTRY/U-HEADER PAIR ARE
*D*               RELEASED. FINALLY, CONTROL IS TRANSFERRED TO THE
*D*               TOENQERR ROUTINE IN ORDER IS ISSUE A 5800 ERROR CODE.
SQERROR  BAL,SR2  UNLINKSQ          RELEASE THE SQ-ENTRY
         LD,D1    QT,R3             GET S ENTRY
         LI,R1    X'FFFF'
         AND,R1   D1                TEST FOR EXTANT SQ-ENTRY
         BNEZ     SQERR1            B, IF ONE EXISTS
         ANLZ,R7  UIX               R7=INDEX OF U-HDR
         LW,R6    R3                R6=INDEX OF S-ENTRY
         BAL,SR2  UNLINKQUS         RELEASE THE S-ENTRY
SQERR1   BAL,SR4  CHKU              RELEASE OTHERS, IF EMPTY
*E*      ERROR:   ERROR CODE 58, SUBCODE 00.
*E*      DESCRIPTION: REQUEST REJECTED BECAUSE IT LEADS TO A DEADLOCK.
         LI,SR3   X'58'
         B        TOENQERR
         PAGE
*D*      NAME:    DRPEBL
*D*      CALL:    BAL,SR4     DRPEBL
*D*      INTERFACE: CALLED BY SAJCK
*D*      INPUT:   R0='ALL' FLAG (BIT 1)
*D*               R5=INDEX OF SQ-ENTRY
*D*      OUTPUT:  SR4, BITS 0-7 = USER NUMBER OF THE GIVEN SQ-ENTRY
*D*      DESCRIPTION: THIS SUBROUTINE SETS A PATH MARKER IN THE GIVEN
*D*               SQ-ENTRY IF IT HAS NOT ALREADY BEEN MARKED. THE
*D*               PATH MARKER IS SET IN BIT 0 OF THE SECOND WORD OF
*D*               THE SQ-ENTRY AND THE 'ALL' FLAG IS COPIED INTO BIT 1.
DRPEBL   LD,D1    QT,R5             GET SQ-ENTRY
         LW,D2    D2                TEST WHETHER ALREADY MARKED
         BLZ      *SR4              RETURN, IF SO
         OR,D2    R0                COPY 'ALL' FLAG INTO SQ-ENTRY
DRPKX    EOR,D2   Y8                SET/RESET PATH MARKER IN SQ-ENTRY
         STD,D1   QT,R5             RESTORE SQ-ENTRY
         STB,D2   SR4               SET USER NUMBER IN LINK
         B        *SR4              RETURN
         PAGE
*D*      NAME:    PKPEBL
*D*      CALL:    BAL,SR4     PKPEBL
*D*      INTERFACE: CALLED BY SAJCK
*D*      INPUT:   R5=INDEX OF SQ-ENTRY
*D*      OUTPUT:  SR4, BITS 0-7 = USER NUMBER OF THE GIVEN SQ-ENTRY
*D*      DESCRIPTION: THIS SUBROUTINE CLEARS THE 'ALL' FLAG AND THE
*D*               PATH MARKER IN THE GIVEN SQ-ENTRY.
PKPEBL   LD,D1    QT,R5             GET SQ-ENTRY
         LW,R0    Y4
         AND,R0   D2                CONSTRUCT CLEARING BIT
         EOR,D2   R0                CLEAR 'ALL' FLAG IN SQ-ENTRY
         LW,D2    D2                TEST FOR MARKER PRESENCE
         BGEZ     *SR4              RETURN, IF NONE
         B        DRPKX             GO FINISH
         PAGE
*D*      NAME:    SAJCKSQA
*D*      CALL:    BAL,SR2     SAJCKSQA
*D*      INTERFACE: CALLED BY SAJCK
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
         BEZ      *SR2              RETURN, IF NONE
         LD,D1    QT,R5             GET SQ-ENTRY
         CI,D2    UPGRADEBIT
         BANZ     SJCKSQ4           SKIP END TEST IF UPGRADE ENTRY
         CB,D2    SR4
         BE       *SR2              RETURN, IF SO
SJCKSQ4  EQU      %
         LH,R1    D2                IS CURRENT S
         CW,R1    R3
         BE       SJCKSQ3
         CW,D2    L(BLOCKBIT+1**31) NO-CHECK BLOCKED
         BANZ     *SR2              RETURN, IF BLOCKED GROUP HERE
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
*D*      NAME:    ENQOLD
*D*      CALL:    B     ENQOLD
*D*      INTERFACE: ENTERED FROM THE ENQCAL ROUTINE IN THE ENQUE MODULE.
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*               R3=INDEX OF S-ENTRY
*D*               R4=INDEX OF U-ENTRY
*D*               R5=INDEX OF NEW SQ-ENTRY
*D*               R6=INDEX OF EXTANT SQ-ENTRY
*D*      DESCRIPTION: THE NEW SQ-ENTRY REPRESENTING A NON-UNIQUE
*D*               REQUEST FOR THIS USER IS IN THE U-CHAIN BUT IT HAS
*D*               NOT YET BEEN LINKED INTO THE S-CHAIN. IF THE OLD
*D*               REQUEST IS EXCLUSIVE AND THE NEW REQUEST IS SHARE,
*D*               CONTROL IS TRANSFERRED TO TO ENQDUPX IN ORDER TO
*D*               ISSUE A 3102 ABNORMAL CODE. IF THE OLD REQUEST IS
*D*               EXCLUSIVE AND THE NEW ONE IS ALSO EXCLUSIVE, OR IF
*D*               BOTH ARE SHARE, CONTROL IS TRANSFERRED TO ENQDUPX
*D*               IN ORDER TO ISSUE A 3101 ABNORMAL CODE.
*D*               IF THE OLD ONE IS 'SHARE' AND THE NEW ONE IS
*D*               'EXCLUSIVE', THEN THERE IS A POSSIBLE UPGRADE OF
*D*               THE OLD FROM SHARE TO EXCLUSIVE.
*D*
*D*               IF THE OLD ONE IS THE ONLY ALLOCATED ONE ON THE
*D*               S-CHAIN, IT IS A CANDIDATE FOR UPGRADE. OTHERWISE, IF
*D*               AN UPGRADE IS ALREADY PENDING AMONG THE 2 OR MORE
*D*               ALLOCATED SQ-ENTRIES, CONTROL IS TRANSFERRED TO
*D*               THE SQERROR ROUTINE.
*D*
*D*               IF THERE IS NO PENDING UPGRADE AMONG THE ALLOCATED
*D*               ENTRIES, OR IF THE ALLOCATED CANDIDATE IS NOT 'ALL'
*D*               BUT AN ALLOCATED 'ALL' ENTRY C0-EXISTS, OR IF THE
*D*               ALLOCATED CANDIDATE IS 'ALL' BUT AN ALLOCATED ENTRY
*D*               CO-EXISTS FOR ANY ELEMENT OF THE RESOURCE, THE OLD
*D*               ENTRY IS MARKED FOR PENDING UPGRADE. IF THE PENDING
*D*               UPGRADE IS FOR 'ALL', THE PENDING 'ALL' COUNT IS
*D*               INCREMENTED BEFORE CONTROL IS TRANSFERRED TO THE
*D*               ENQLSQ ROUTINE IN THE ENQUE MODULE IN ORDER TO
*D*               INSERT THE NEW SQ-ENTRY AT THE START OF THE PENDING
*D*               GROUP IN THE S-CHAIN.
*D*
*D*               IF THE ALLOCATED CANDIDATE IS NOT 'ALL' AND AN
*D*               ALLOCATED 'ALL' ENTRY DOES NOT EXIST, OR IF THE
*D*               ALLOCATED CANDIDATE IS 'ALL' AND IT IS THE ONLY ENTRY
*D*               ALLOCATED FOR THE RESOURCE, THE NEW ENTRY IS MARKED
*D*               ALLOCATED. IN THESE CASES, AND WHEN THE OLD
*D*               ENTRY IS NOT ALLOCATED, THE PREDECESSOR OF THE OLD
*D*               ENTRY IS DETERMINED, THE OLD SQ-ENTRY IS RELEASED,
*D*               AND CONTROL IS TRANSFERRED TO ENQLSQ IN THE ENQUE
*D*               MODULE IN ORDER TO LINK THE NEW SQ-ENTRY INTO THE
*D*               S-CHAIN IN ITS PLACE.
ENQOLD   LW,R7    R6                COPY INDEX OF OLD ENTRY
         LD,D1    QT,R7             GET OLD SQ-ENTRY
         LD,D3    QT,R5             GET NEW SQ-ENTRY
         CI,D2    SHAREBIT          TEST WHETHER OLD IS SHARE
         BANZ     ENQOLDS           B, IF SO
         LW,SR3   L(2**25+X'31')
         CI,D4    SHAREBIT          TEST WHETHER NEW IS SHARE
*E*      ERROR:   ABNORMAL CODE 31, SUBCODE 02.
*E*      DESCRIPTION: AN ENQUE SHARE REQUEST ON THE SAME RESOURCE/
*E*               ELEMENT ALREADY QUEUED FOR THE USER WAS ATTEMPTED.
         BANZ     ENQDUPX           B, IF SO
ENQ3101  LW,SR3   L(1**25+X'31')
*E*      ERROR:   ABNORMAL CODE 31, SUBCODE 01.
*E*      DESCRIPTION: DUPLICATE ENQUEUE ATTEMPTED.
         B        ENQDUPX
ENQOLDS  CI,D4    SHAREBIT          TEST WHETHER NEW IS SHARE
         BANZ     ENQ3101           B, IF SO
* POSSIBLE UPGRADE OF SHARE TO EXCLUSIVE.
         CI,D2    ALLOCBIT          TEST WHETHER OLD IS ALLOCATED
         BAZ      ENQSW             B, IF NOT
* HERE IF OLD SQ-ENTRY IS ALREADY ALLOCATED.
         LD,D3    QT,R3             GET S-ENTRY
         INT,R1   D3                GET INDEX OF 1ST SQ-ENTRY ON S-CHAIN
         LD,D3    QT,R1             GET 1ST SQ-ENTRY
         LH,R6    D3                GET INDEX TO 2ND SQ-ENTRY ON S-CHAIN
         BEZ      ENQUP             B, IF ONLY 1 ENTRY
* HERE IF AT LEAST 2 ENTRIES ON S-CHAIN.
         LD,D3    QT,R6             GET 2ND ENTRY
         CI,D4    ALLOCBIT          TEST WHETHER ALLOCATED
         BAZ      ENQUP             B, IF NOT
* HERE IF AT LEAST 2 ALLOCATED SQ-ENTRIES ON S-CHAIN.
ENQOLD2  LD,D3    QT,R1             GET NEXT SQ-ENTRY (STARTING FROM 1ST)
         CI,D4    ALLOCBIT          TEST WHETHER ALLOCATED
         BAZ      ENQOLD1           B, IF NOT
         CI,D4    UPGRADEBIT        TEST WHETHER UPGRADE ALREADY PENDING
         BANZ     SQERROR           ERROR, IF SO
         LH,R1    D3                GET INDEX OF NEXT SQ-ENTRY
         BNEZ     ENQOLD2           AND REPEAT
* HERE TO PROCESS A PENDING UPGRADE.
ENQOLD1  OR,D2    BT31TO0+XUPGRADEBIT SET UPGRADE FLAG IN OLD SQ-ENTRY
         STD,D1   QT,R7             RESTORE OLD SQ-ENTRY
         LD,D3    QT,R3             GET S-ENTRY
         SLS,D3   16                GET INDEX TO 1ST SQ-ENTRY
         CH,R7    D3                IS SQ-ENTRY BEING UPGRADED
         BE       ENQOLD1X          AT TOP OF CHAIN
         LH,R6    D3                NO -> PUT IT THERE
         LD,D3    QT,R6             RUN DOWN THE SQ-CHAIN
         CH,R7    D3                AND FIND THE ENTRY BEING UPGRADED
         BNE      %-3
         LH,SR4   D1                THEN LINK IT IN AT THE TOP
         STH,SR4  D3
         STD,D3   QT,R6
         LD,D3    QT,R3             GET S-ENTRY
         LI,R6    1
         LH,SR4   D3,R6
         STH,SR4  D1
         STD,D1   QT,R7
         STH,R7   D3,R6
         STD,D3   QT,R3             PUT AWAY RELINKED S-ENTRY
         SLS,D3   16                GET INDEX TO 1ST SQ-ENTRY
ENQOLD1X EQU      %
         LW,R6    R3                ESTABLISH POSITION IN S-CHAIN
         CW,D4    ALL               TEST WHETHER THIS IS 'ALL'
         BNE      ENQTP             B, IF NOT
         BAL,SR4  LOCK              ELSE, INCR PENDING 'ALL' COUNT
ENQTP    LH,R1    D3                GET INDEX OF NEXT SQ-ENTRY
         BEZ      ENQTP1            B, IF NONE
         LD,D3    QT,R1             GET NEXT SQ-ENTRY
         CI,D4    ALLOCBIT          TEST WHETHER ALLOCATED
         BANZ     ENQTP2            B,IF SO
ENQTP1   PUSH     R6                SET POSITION
         B        TOENQLSQ
ENQTP2   LW,R6    R1                ESTABLISH POSITION IN S-CHAIN
         B        ENQTP             AND CONTINUE SEARCH
* HERE IF OLD SQ-ENTRY IS THE ONLY ONE ALLOCATED ON THE S-CHAIN.
ENQUP    LD,D3    QT,R3             GET S-ENTRY
         CW,D4    ALL               TEST WHETHER THIS IS 'ALL'
         BE       ENQUPAL           B, IF SO
         BAL,R0   ALLALLO           TEST WHETHER 'ALL' EXISTS
         B        ENQSW2A           RETURN HERE IF NO 'ALL' EXISTS
         BANZ     ENDOLD3           B IF ALL IS ALLOCATED
ENQSW2A  LD,D1    QT,R5             GET NEW SQ-ENTRY
         OR,D2    BT31TO0+XALLOCBIT SET ALLOCATED FLAG
         STD,D1   QT,R5             RESTORE NEW SQ-ENTRY
         LD,D3    QT,R7             GET OLD SQ-ENTRY
         LH,R3    D4                RESET INDEX OF S-ENTRY
* HERE TO UPGRADE; FIND PREDECESSOR OF OLD SQ-ENTRY.
ENQSW    LD,D3    QT,R3             GET S-ENTRY
         SLS,D3   16                GET 1ST SQ INDEX
         LW,R6    R3                ESTABLISH PREDECESSOR INDEX
ENQSW2   LH,R1    D3                GET NEXT SQ INDEX
         CW,R1    R7                TEST FOR OBJECT INDEX
         BE       ENQSW1            B, IF MATCH
         LW,R6    R1                ESTABLISH PREDECESSOR INDEX
         LD,D3    QT,R1             GET SQ-ENTRY
         B        ENQSW2            AND TRY AGAIN
ENQSW1   PUSH     R6                SET INDEX OF PREDECESSOR OF NEW ENTRY
         XW,R7    R5                SET R5=INDEX OF OLD SQ-ENTRY
         BAL,SR2  UNLINKSQ          RELEASE OLD SQ-ENTRY
         XW,R7    R5                SET R5=INDEX OF NEW SQ-ENTRY
TOENQLSQ LI,SR4   ENQLSQ            ESTABLISH ADDRESS OF RETURN
         B        ENQDEST           AND RETURN TO IT
* HERE IF OLD ALLOCATED SQ-ENTRY IS 'ALL'.
ENQUPAL  LH,R3    D3                GET INDEX OF NEXT S-ENTRY
         BEZ      ENQSW2A           B, IF NONE
         LD,D3    QT,R3             GET NEXT S-ENTRY
         STH,D3   D1                ADJUST 1ST SQ INDEX TO LHW
         LH,R1    D1                GET INDEX OF 1ST SQ-ENTRY
         BEZ      ENQUPAL           B, IF NONE
         LD,D1    QT,R1             GET 1ST SQ-ENTRY
         CI,D2    ALLOCBIT          TEST WHETHER ALLOCATED
         BAZ      ENQUPAL           B, IF NOT
ENDOLD3  EQU      %                 RESTORE D1,D2 AND R3 BEFORE UPGRADE
         LD,D1    QT,R7             GET OLD SQ-ENTRY
         LH,R3    D2                RESET INDEX OF S-ENTRY
         B        ENQOLD1           GO TO SET PENDING UPGRADE
         PAGE
*D*      NAME:    ENQDUPX
*D*      CALL:    B     ENQDUPX
*D*      INTERFACE: ENTERED BY ENQOLD AND ENQALL
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*               R3=INDEX OF S-ENTRY
*D*               R4=INDEX OF U-ENTRY
*D*               R5=INDEX OF SQ-ENTRY
*D*               SR3=ERROR CODE
*D*               D2=RIGHTMOST WORD OF SQ-ENTRY
*D*      DESCRIPTION: THIS ROUTINE PURGES THE SQ-ENTRY AND IF
*D*               THE S-CHAIN IS EMPTY, THE S-ENTRY IS ALSO PURGED.
*D*               CONTROL IS THEN TRANSFERRED TO THE ABNCKAL ROUTINE.
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
         PAGE
*D*      NAME:    ENQALL
*D*      CALL:    B     ENQALL
*D*      INTERFACE: ENTERED FROM THE ENQCAL ROUTINE IN THE ENQUE MODULE.
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*               R3=INDEX OF S-ENTRY
*D*               R4=INDEX OF U-ENTRY
*D*               R5=INDEX OF SQ-ENTRY
*D*      DESCRIPTION: THE NEW SQ-ENTRY REPRESENTING THE UNIQUE 'ALL'
*D*               REQUEST FOR THIS USER IS IN THE U-CHAIN BUT IT HAS
*D*               NOT YET BEEN LINKED INTO THE S-CHAIN. IF THE USER
*D*               HAS ANY REQUEST OTHER THAN ONE FOR 'NULL' ON THE
*D*               U-CHAIN, CONTROL IS TRANSFERRED TO ENQDUPX IN
*D*               ORDER TO ISSUE A 5802 ERROR CODE.
*D*
*D*               IF AN EXTANT SQ-ENTRY IS ALREADY ALLOCATED ON THE
*D*               'ALL' S-CHAIN AND BOTH IT AND THE NEW ONE ARE 'SHARE'
*D*               THE NEW ONE IS MARKED ALLOCATED. BUT IF BOTH ARE NOT
*D*               'SHARE', OR IF THE EXTANT ONE IS NOT ALLOCATED, THE
*D*               PENDING 'ALL' COUNT IS INCREMENTED AND CONTROL IS
*D*               TRANSFERRED TO THE ENQEX ROUTINE IN THE ENQUE MODULE.
*D*               IF THE 'ALL' S-CHAIN IS EMPTY, AND THE FIRST SQ-ENTRY
*D*               ON EACH SUBSEQUENT S-CHAIN FOR THIS RESOURCE IS
*D*               EITHER NOT ALLOCATED, OR IT IS ALLOCATED AND BOTH
*D*               IT AND THE NEW ONE ARE 'SHARE', THE NEW ONE IS
*D*               MARKED ALLOCATED. BUT IF ANY OF THE EXTANT ONES ARE
*D*               ALLOCATED AND BOTH ARE NOT 'SHARE', THE PENDING 'ALL'
*D*               COUNT IS INCREMENTED. THEN THE NEW ALLOCATED OR
*D*               PENDING SQ-ENTRY IS LINKED INTO THE S-CHAIN BEFORE
*D*               CONTROL IS TRANSFERRED TO THE ENQDONE ROUTINE IN THE
*D*               ENQUE MODULE.
ENQALL   LD,D1    QT,R4             GET U-ENTRY
ENQNC1   INT,R1   D1                GET INDEX TO NEXT SQ-ENTRY ON U-CHAIN
         LD,D1    QT,R1             GET SQ-ENTRY
         LH,R7    D2                GET INDEX TO S-ENTRY
         BEZ      ENQLQ             B, IF THIS IS THE OBJECT SQ-ENTRY
         LD,D3    QT,R7             GET THE S-ENTRY
         CW,D4    Y4                TEST FOR 'NULL' (CAN'T BE EXTANT 'ALL')
         BANZ     ENQNC1            B, IF NULL TO SKIP IT
*E*      ERROR:   ERROR CODE 58, SUBCODE 02.
*E*      DESCRIPTION: ENQUEUE REQUEST FOR 'ALL' WITH ALREADY EXTANT
*E*               REQUESTS (OTHER THAN 'NULL').
         LW,SR3   L(2**25+X'58')
         LI,D2    0                 SET DUMMY RIGHTMOST SQ-ENTRY WORD
         B        ENQDUPX           GO TO ISSUE ERROR CODE AFTER PURGE
* HERE IF USER IS CLEAR.
ENQLQ    LD,R1    QT,R3             GET S-ENTRY
         AND,R1   M16               GET INDEX OF 1ST SQ-ENTRY ON S-CHAIN
         BEZ      ENQSQC            B, IF NONE
         LD,D3    QT,R1             GET 1ST SQ-ENTRY
         CI,D4    ALLOCBIT          TEST WHETHER ALLOCATED
         BAZ      ENQEXD            B, IF NOT
         LD,D1    QT,R5             GET THE 'ALL' SQ-ENTRY
         BAL,R0   SHASHA            TEST WHETHER BOTH ARE 'SHARE'
         B        ENQEXD            RETURN HERE IF NOT
         B        ENQALO            RETURN HERE IF SO
* HERE IF 'ALL' S-CHAIN IS EMPTY.
ENQSQC   LW,R1    R3                INDEX OF S-ENTRY
         LD,D3    QT,R5             GET 'ALL' SQ-ENTRY
ENQSQC1  LD,D1    QT,R1             GET S-ENTRY
         LH,R1    D1                GET INDEX OF NEXT S-ENTRY
         BEZ      ENQALOL           B, IF NONE TO ALLOCATE
         LD,R7    QT,R1             GET S-ENTRY
         AND,R7   M16               GET INDEX OF 1ST SQ-ENTRY ON S-CHAIN
         BEZ      ENQSQC1           B, IF NONE
         LD,D1    QT,R7             GET THE 1ST SQ-ENTRY
         CI,D2    ALLOCBIT          TEST WHETHER ALLOCATED
         BAZ      ENQSQC1           B, IF NOT
         BAL,R0   SHASHA            TEST WHETHER BOTH ARE 'SHARE'
         B        %+2               RETURN HERE IF NOT
         B        ENQSQC1           RETURN HERE IF SO
         BAL,SR4  LOCK              INCR PENDING 'ALL' COUNT IN U-HDR
         B        ENQPH             GO TO LINK IT
* HERE TO ALLOCATE THE 'ALL' SQ-ENTRY.
ENQALOL  LD,D1    QT,R5             GET SQ-ENTRY
ENQALO   OR,D2    BT31TO0+XALLOCBIT SET THE ALLOCATED FLAG
         STD,D1   QT,R5             RESTORE THE SQ-ENTRY
* HERE TO LINK SQ-ENTRY INTO S-CHAIN.
ENQPH    LW,R6    R3                SET INDEX OF PREDECESSOR S-ENTRY
         BAL,SR4  LINKSQ            LINK IT
         LI,SR4   ENQDONE           ESTABLISH RETURN ADDRESS
         B        ENQDEST           AND RETURN TO IT
* HERE TO PROCESS A NEW PENDING 'ALL' WITH NON-EMPTY S-CHAIN.
ENQEXD   BAL,SR4  LOCK              INCR PENDING 'ALL' COUNT IN U-HDR
         LD,D1    QT,R1             SET 1ST ALLOCATED SQ-ENTRY IN S-CHAIN
         LI,SR4   ENQEX             ESTABLISH RETURN ADDRESS
         B        ENQDEST           AND RETURN TO IT
         TITLE    'ENQO SUBROUTINES'
*D*      NAME:    RELS
*D*      CALL:    BAL,SR2     RELS
*D*      INTERFACE: CALLED BY ENQDUPX AND BY THE RELQ SUBROUTINE.
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*               R3=INDEX OF S-ENTRY
*D*      DESCRIPTION: THIS SUBROUTINE RELEASES AN S-ENTRY.
RELS     LW,R6    R3                R6=INDEX OF S-ENTRY
         ANLZ,R7  UIX               R7=INDEX OF U-HEADER
         B        UNLINKQUS         RELEASE S-ENTRY AND RETURN
         PAGE
*D*      NAME:    UNLINKQUS
*D*      CALL:    BAL,SR2     UNLINKQUS
*D*      INTERFACE: CALLED BY SQERROR AND BY THE RELQ SUBROUTINE.
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*               R6=INDEX OF ENTRY TO BE RELEASED (Q-,U, OR S-ENTRY)
*D*               R7=INDEX OF START OF CHAIN (QT-HDR,Q-ENTRY, OR U-HDR)
*D*      OUTPUT:  IF Q-ENTRY IS RELEASED:
*D*               SR1=INDEX OF PREDECESSOR OF RELEASED Q-ENTRY
*D*      DESCRIPTION: THIS SUBROUTINE UNLINKS A Q-ENTRY, U-ENTRY OR
*D*               AN S-ENTRY AND RELEASES THE ENTRY STORAGE.
UNLINKQUS PUSH    SR2               SAVE LINK
         LW,R1    R7                START OF CHAIN IS 1ST PREDECESSOR
         LD,D3    QT,R7             GET START OF CHAIN ENTRY
         SCD,D3   16                ADJUST 1ST INDEX TO LHW
ULKQUSA  LH,R0    D3                GET INDEX TO SUCCESSOR
         CW,R0    R6                TEST WHETHER SUCCESSOR IS OBJECT
         BE       ULKQUSB           B, IF SO
         LW,R1    R0                GET INDEX OF PREDECESSOR
         LD,D3    QT,R1             GET THE PREDECESSOR ENTRY
         B        ULKQUSA           AND TRY AGAIN
* HERE WHEN PREDECESSOR OF OBJECT ENTRY IS FOUND.
ULKQUSB  LD,D1    QT,R6             GET OBJECT ENTRY
         LH,D1    D1                GET INDEX TO OBJECT'S SUCCESSOR
         STH,D1   D3                UNLINK OBJECT
         CW,R7    R1                TEST FOR START OF CHAIN
         BNE      %+2               B, IF NOT
         SCD,D3   -16               ELSE ADJUST INDEX TO RHW
         STD,D3   QT,R1             RESTORE THE PREDECESSOR
         PUSH     R6                SAVE OBJECT INDEX
         CW,R6    R2                TEST WHETHER OBJECT IS Q-ENTRY
         BNE      ULKQUSC           B, IF NOT
* HERE TO RELEASE U-HEADER ASSOCIATED WITH A Q-ENTRY.
         AI,R6    1                 CALC INDEX OF U-HDR
         LW,SR1   R1                SET INDEX OF PREDECESSOR
         BAL,SR2  REL1DW            RELEASE U-HDR DW
         LW,R6    *TSTACK           GET OBJECT INDEX
* HERE TO PROCESS DW'S FOR INDIRECT TEXTC NAMES FOR Q- AND S-ENTRIES.
ULKQUSC  LD,D1    QT,R6             GET OBJECT ENTRY
         LW,R6    D2                TEST FOR INDIRECT TEXTC NAME DW'S
         BGE      ULKQUSD           B, IF NONE
         CW,R7    R2                TEST WHETHER PROCESSING U-ENTRY
         BE       ULKQUSD           B, IF SO
         LB,R0    0,R6              GET TEXTC COUNT
         SLS,R0   -3                CALC NUMBER OF DW'S TO
         AI,R0    1                   BE RELEASED
         SLS,R6   -3                CALC INDEX OF
         SW,R6    L(DA(QT))           1ST DW TO BE
         AND,R6   M16                 RELEASED
         BAL,SR2  RELDW             RELEASE THE TEXTC DW'S
* HERE TO RELEASE THE OBJECT ENTRY.
ULKQUSD  PULL     2,SR2             SR2=LINK; SR3=INDEX OF OBJECT ENTRY
         LW,R6    SR3               GET INDEX OF OBJECT ENTRY
         B        REL1DW            RELEASE OBJECT DW AND RETURN
         PAGE
*D*      NAME:    UNLINKSQ
*D*      CALL:    BAL,SR2     UNLINKSQ
*D*      INTERFACE: CALLED BY RELDWO, SQERROR AND ENQOLD AND BY THE
*D*               RELQ AND DOUP SUBROUTINES.
*D*      INPUT:   R4=INDEX OF U-ENTRY
*D*               R5=INDEX OF SQ-ENTRY
*D*      OUTPUT:  SR1=RIGHTMOST WORD OF RELEASED SQ-ENTRY
*D*      DESCRIPTION: UNLINKS AN SQ-ENTRY FROM BOTH THE U-CHAIN AND
*D*               THE S-CHAIN AND RELEASES THE ENTRY INCLUDING
*D*               THE QECB-ENTRY, IF ONE EXISTS.
UNLINKSQ LW,R6    R5                COPY INDEX OF SQ-ENTRY
         LD,D3    QT,R6             GET OBJECT SQ-ENTRY
         LW,SR1   D4                SAVE RIGHTMOST WORD FOR OUTPUT
         CI,D4    ALLOCBIT          TEST WHETHER ALLOCATED
         BANZ     UNSQA1            B, IF SO
         CI,D4    X'F0000'          TEST WHETHER LINKED TO S-ENTRY
         BAZ      UNSQA1            B, IF NOT
         LI,R1    1
         MTH,-1   QT+1,R1           ELSE DECR. PENDING ALL COUNT
UNSQA1   CI,D4    ECBBIT            TEST FOR PRESENCE OF QECB-ENTRY
         BAZ      UNSQB             B, IF NONE
* HERE TO RELEASE QECB-ENTRY
         INT,R1   D3                GET INDEX OF QECB-ENTRY
         LD,D1    QT,R1             GET THE QECB-ENTRY
         LI,D2    X'FFFF'           UNLINK THE QECB-ENTRY FROM
         STS,D1   D3                  THE OBJECT SQ-ENTRY
         STD,D3   QT,R6             RESTORE OBJECT SQ-ENTRY
         PUSH     R6                SAVE INDEX OF OBJECT SQ-ENTRY
         PUSH     SR2               SAVE SUBR LINK
         LW,R6    R1                INDEX OF UNLINKED QECB-ENTRY
         BAL,SR2  REL1DW            RELEASE THE DW
         PULL     SR2               RESTORE SUBR LINK
         PULL     R6                RESTORE INDEX OF OBJECT SQ-ENTRY
         LD,D3    QT,R6             GET OBJECT SQ-ENTRY
* HERE TO UNLINK SQ-ENTRY FROM THE S-CHAIN
UNSQB    LH,R1    D4                GET LINK TO S-ENTRY
         BEZ      UNSQU             B, IF NONE
         LD,D1    QT,R1             GET THE S-ENTRY
         LI,R0    X'FFFF'           EXTRACT THE INDEX OF
         AND,R0   D1                  THE 1ST SQ-ENTRY ON THE S-CHAIN
         CW,R0    R6                TEST WHETHER IT IS THE OBJECT
         BNE      UNSQSC            B, IF NOT
         LH,D3    D3                GET LINK TO OBJECTS SUCCESSOR
         LI,D4    X'FFFF'           UNLINK THE OBJECT SQ-ENTRY FROM
         STS,D3   D1                  THE S-CHAIN
         STD,D1   QT,R1             RESTORE THE S-ENTRY
         B        UNSQU             GO TO PROCESS U-CHAIN
UNSQSC   LW,R1    R0                GET INDEX TO NEXT SQ-ENTRY
         LD,D1    QT,R1             GET NEXT SQ-ENTRY
         LH,R0    D1                GET INDEX TO THE SUCCESSOR
         BEZ      UNSQU             B, IF NONE
         CW,R0    R6                TEST WHETHER SUCCESSOR IS THE OBJECT
         BNE      UNSQSC            B, IF NOT
         LH,R0    D3                GET INDEX TO OBJECT'S SUCCESSOR
         STH,R0   D1                LINK OBJECT'S PREDECESSOR TO SUCCESSOR
         STD,D1   QT,R1             RESTORE THE PREDECESSOR
* HERE TO UNLINK SQ-ENTRY FROM THE U-CHAIN
UNSQU    LD,D1    QT,R4             GET U-ENTRY
         SCD,D1   16                LEFT ADJUST SQ-INDEX
         LD,D3    QT,R6             GET OBJECT SQ-ENTRY
         CH,R6    D1                TEST WHETHER IT IS THE OBJECT
         BNE      UNSQU1            B, IF NOT THE 1ST SQ-ENTRY IN U-CHAIN
         STH,D3   D1                UNLINK OBJECT FROM THE U-CHAIN
         SCD,D1   -16               RIGHT ADJUST INDEX OF SQ-ENTRY
         STD,D1   QT,R4             RESTORE THE U-ENTRY
         B        UNSQR             GO TO RELEASE DW
UNSQU1   LH,R1    D1                GET INDEX TO NEXT SQ-ENTRY
         CI,D2    ECBBIT            TEST WHETHER NEXT IS QECB-ENTRY
         BANZ     UNSQU2            B, IF SO TO SKIP IT
         LD,D1    QT,R1             GET THE NEXT SQ-ENTRY
         LH,R0    D2                GET LINK TO S-ENTRY
         CH,R0    SR1               TEST FOR MATCH WITH OBJECT'S LINK
         BNE      UNSQU2            B, IF NOT
         AND,D2   NB31TO0+XUPGRADEBIT  ELSE ERASE UPGRADE FLAG
         STD,D1   QT,R1             RESTORE THIS SQ-ENTRY
UNSQU2   LD,D1    QT,R1             GET THE NEXT SQ-ENTRY
         SCD,D1   16                LEFT ADJUST INDEX TO SUCCESSOR
         CH,R6    D1                TEST WHETHER IT IS THE OBJECT
         BNE      UNSQU1            B, IF NOT
         STH,D3   D1                UNLINK OBJECT FROM THE U-CHAIN
         SCD,D1   -16               RIGHT ADJUST SQ-INDEX IN SQ-ENTRY
         STD,D1   QT,R1             RESTORE THE SQ-ENTRY
UNSQR    EQU      %
         B        REL1DW            RELEASE DW & RETURN TO CALLER
         PAGE
*D*      NAME:    ALLOC
*D*      CALL:    BAL,SR2     ALLOC
*D*      INTERFACE: CALLED BY THE RELQ, DOUP AND UNLOK SUBROUTINES.
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*               R6=INDEX OF SQ-ENTRY TO BE ALLOCATED
*D*      DESCRIPTION: THIS SUBROUTINE MARKS AN SQ-ENTRY AS ALLOCATED
*D*               AND DECREMENTS THE PENDING COUNT IN THE QT-HEADER.
*D*               IF THE ALLOCATION IS FOR 'ALL', THE PENDING 'ALL'
*D*               COUNT IN THE U-HEADER IS ALSO DECREMENTED. A USER
*D*               ASLEEP PENDING ALLOCATION IS AWAKENED BEFORE
*D*               CONTROL IS RETURNED. OTHERWISE, IF THE USER IS NOT
*D*               ASLEEP, THE ECB, IF ONE EXISTS, IS POSTED AND THE
*D*               QECB-ENTRY IS UNLINKED AND RELEASED BEFORE CONTROL
*D*               IS RETURNED.
ALLOC    LD,D3    QT,R6             GET SQ-ENTRY
         CI,D4    ALLOCBIT          IS IT ALREADY ALLOCATED
         BANZ     %+4               YES -> DO NOT DECR. PENDING COUNT
         OR,D4    BT31TO0+XALLOCBIT  SET ALLOCATED
         LI,R1    1
         MTH,-1   QT+1,R1           DECR. PENDING COUNT IN QT-HEADER
         PUSH     10,R2
         LH,R7    D4                GET INDEX OF S-ENTRY
         LD,SR1   QT,R7             GET THE S-ENTRY
         CW,SR2   ALL               TEST FOR 'ALL'
         BNE      ALLOC1            B, IF NOT
         LW,R7    R2                ELSE CALC THE
         SLS,R7   2                   HW INDEX OF
         AI,R7    3                   THE U-HEADER
         MTH,-1   QT+2,R7           AND DECREMENT PENDING ALL COUNT
ALLOC1   CI,D4    SLEEPBIT          TEST WHETHER ASLEEP PENDING ALLOC
         BAZ      ALLOCECB          B, IF NOT
         EOR,D4   BT31TO0+XSLEEPBIT CLEAR SLEEP
         STD,D3   QT,R6             RESTORE THE SQ-ENTRY
         LI,R5    X'FF'
         AND,R5   D4                EXTRACT THE USER NUMBER
         LI,R6    E:NQR             RESUME ENQ USER (WAKE)
         BAL,SR4  T:RUE             WAKE HIM UP
ALLOCZ   PULL     10,R2
         B        *SR2              RETURN
*USER NOT ASLEEP; CHECK FOR AN ECB.
ALLOCECB CI,D4    ECBBIT            TEST WHETHER ECB EXISTS
         BAZ      ALLOCZ            B, IF NOT TO RETURN
         LI,R6    X'FFFF'
         AND,R6   D3                GET INDEX OF QECB-ENTRY
         LD,D1    QT,R6             GET QECB-ENTRY
         PUSH     D2                SAVE ADDRESS OF ECB
         LI,D2    X'FFFF'
         STS,D1   D3                UNLINK QECB-ENTRY
         EOR,D4   BT31TO0+XECBBIT   CLEAR ECB FLAG
         LH,R1    D1                GET INDEX OF SQ-ENTRY
         STD,D3   QT,R1             RESTORE SQ-ENTRY
         LI,SR1   X'FF'
         AND,SR1  D4                EXTRACT THE USER NUMBER
         BAL,SR2  REL1DW            RELEASE QECB-ENTRY DW
         PULL     SR3               GET ADDRESS OF ECB
         LI,SR2   0
         BAL,SR4  ECBPOST           POST ECB AND WAKE USER IF ASLEEP
         B        ALLOCZ
         PAGE
*D*      NAME:    ALLALLO
*D*      CALL:    LOC     BAL,R0     ALLALLO
*D*               LOC+1   RETURN HERE IF UNSUCCESSFUL
*D*               LOC+2   RETURN HERE IF SUCCESSFUL
*D*      INTERFACE: CALLED BY ENQOLD AND BY RELQ AND UNLOK SUBROUTINES.
*D*      INPUT:   R2=INDEX OF U-HDR
*D*      OUTPUT:  FOR SUCCESSFUL RETURN:
*D*               R1=INDEX OF 'ALL' SQ-ENTRY
*D*               R3=INDEX OF 'ALL' S-ENTRY
*D*               D1,D2 CONTAIN THE 'ALL' S-ENTRY
*D*               D3,D4 CONTAIN THE 'ALL' SQ-ENTRY
*D*               CC2 IS SET IF 'ALL' S-ENTRY IS ALLOCATED
*D*      DESCRIPTION: THIS SUBROUTINE SEARCHES FOR AN 'ALL' S-ENTRY
*D*               FOR THE GIVEN RESOURCE. CONTROL IS RETURNED TO THE
*D*               LOCATION OF THE BAL PLUS 1 IF THERE IS NO 'ALL'
*D*               S-ENTRY. OTHERWISE, CONTROL IS RETURNED TO THE
*D*               LOCATION OF THE BAL PLUS 2.
ALLALLO  BAL,R1   FINDALL
         B        %+2               RETURN HERE IF 'ALL' S-ENTRY FOUND
         B        *R0               ELSE RETURN
         LI,R1    X'FFFF'
         AND,R1   D1                TEST WHETHER S-CHAIN IS NULL
         BEZ      *R0               RETURN, IF SO
         AI,R0    1                 ELSE INCR LINK
         LD,D3    QT,R1             GET THE 1ST SQ-ENTRY ON S-CHAIN
         CI,D4    ALLOCBIT          TEST WHETHER 'ALL' IS ALLOCATED
         B        *R0               RETURN
         PAGE
*D*      NAME:    FINDALL
*D*      CALL:    LOC     BAL,R1     FINDALL
*D*               LOC+1   RETURN HERE IF SUCCESSFUL
*D*               LOC+2   RETURN HERE IF NOT SUCCESSFUL
*D*      INTERFACE: CALLED BY THE TEST ROUTINE AND BY THE SAJCK AND
*D*               ALLALLO SUBROUTINES.
*D*      INPUT:   R2=INDEX OF U-HDR
*D*      OUTPUT:  R3=INDEX OF 'ALL' S-ENTRY
*D*               D1,D2 CONTAIN THE 'ALL' S-ENTRY
*D*      DESCRIPTION: THIS SUBROUTINE EXAMINES THE FIRST S-ENTRY, AND
*D*               IF NECESSARY, THE SECOND, FOR AN 'ALL' ENTRY. IF
*D*               FOUND, CONTROL IS RETURNED TO THE LOCATION OF THE
*D*               BAL PLUS 1, OTHERWISE, CONTROL IS RETURNED TO THE
*D*               LOCATION OF THE BAL PLUS 2.
FINDALL  LD,D1    QT+2,R2           GET U-HDR
         SLS,D1   16                ADJUST INDEX OF 1ST S-ENTRY
FINDALL1 LH,R3    D1                GET INDEX OF NEXT S-ENTRY
         BEZ      1,R1              RETURN, IF NONE
         LD,D1    QT,R3             GET S-ENTRY
         CW,D2    ALL               TEST FOR 'ALL'
         BE       *R1               RETURN, IF FOUND
         CW,D2    Y4                TEST FOR SPECIAL (IE. 'NULL')
         BANZ     FINDALL1          B, IF SO (SINCE 'NULL' PRECEDES 'ALL')
         B        1,R1              ELSE RETURN, IF NOT FOUND
         PAGE
*D*      NAME:    SHASHA
*D*      CALL:    LOC     BAL,R0     SHASHA
*D*               LOC+1   RETURN HERE IF NOT SUCCESSFUL
*D*               LOC+2   RETURN HERE IF SUCCESSFUL
*D*      INTERFACE: CALLED BY THE ENQALL ROUTINE AND BY THE RELQ AND
*D*               UNLOK SUBROUTINES.
*D*      INPUT:   D1,D2 CONTAIN AN SQ-ENTRY
*D*               D3,D4 CONTAIN AN SQ-ENTRY
*D*      DESCRIPTION: THIS SUBROUTINE RETURNS TO THE
*D*               LOCATION OF THE BAL PLUS 2 IF BOTH ENTRIES HAVE
*D*               THE SHARE FLAG SET ON. OTHERWISE, RETURN IS TO THE
*D*               LOCATION OF THE BAL PLUS 1.
SHASHA   CI,D2    SHAREBIT
         BAZ      *R0               RETURN, IF UNSUCCESSFUL...
         CI,D4    SHAREBIT
         BAZ      *R0               RETURN, IF UNSUCCESSFUL
         AI,R0    1
         B        *R0               RETURN, IF SUCCESSFUL
         PAGE
*D*      NAME:    LOCK
*D*      CALL:    BAL,SR4     LOCK
*D*      INTERFACE: CALLED BY ENQOLD AND ENQALL.
*D*      INPUT:   R2=INDEX OF Q-ENTRY
*D*      DESCRIPTION: THIS SUBROUTINE INCREMENTS THE PENDING 'ALL'
*D*               COUNT IN THE U-HEADER ASSOCIATED WITH THE GIVEN
*D*               Q-ENTRY. WHEN ONE OR MORE 'ALL' REQUESTS FOR A
*D*               RESOURCE ARE PENDING, ANY NEW USERS WILL BE MARKED
*D*               BLOCKED, BUT ANY NEW REQUESTS FOR A USER ALREADY
*D*               IN ALLOCATION OR ALREADY IN THE PENDING STATE WILL
*D*               NOT BE BLOCKED.
LOCK     LW,R7    R2                COPY INDEX OF Q-ENTRY
         SLS,R7   1                 CALC WD OFFSET OF Q-ENTRY
         MTW,1    QT+3,R7           INCR PENDING 'ALL' COUNT IN U-HDR
         B        *SR4              RETURN
         PAGE
         END

