         PCC      0
         TITLE    'ENQUE MODULE AND FUNCTION PREAMBLE'
*M*      ENQUE    ENQUEUE/DEQUEUE PRIMARY PROCESSING MODULE.
*P*      NAME:    ENQUE
*P*      PURPOSE: TO PERFORM COMMON PROCESSING FOR ALL ENQUEUE AND
*P*               DEQUEUE REQUESTS AND TO COMPLETELY PROCESS CERTAIN
*P*               ENQUEUE REQUESTS.
*P*      DESCRIPTION: THERE ARE TWO MODULES FOR THE ENQ/DEQ FACILITY,
*P*               ENQUE AND ENQO. BOTH MODULES NORMALLY RESIDE IN THE
*P*               ENQSEG OVERLAY BUT ENQUE CAN BE MADE MONITOR ROOT
*P*               RESIDENT TO PROVIDE FASTER RESPONSE TO CERTAIN ENQUEUE
*P*               REQUESTS. ENQUE HAS THE ROUTINES THAT DECODE ALL
*P*               ENQ/DEQ CALS AND PROCESS NORMAL ENQUEUE REQUESTS.
*P*               THE ENQO MODULE CONTAINS THE ROUTINES TO PROCESS
*P*                 * SEVERAL TABLE OVERFLOW ERROR CONDITIONS (CHKQO,
*P*                   CHKUO, LNKQUE, RELDWO, AND RELQO)
*P*                 * ALL DEQUEUE REQUESTS (DEQUEUE)
*P*                 * ENQUEUE REQUESTS FOR 'ALL' (ENQALL)
*P*                 * ENQUEUE UPGRADES FROM SHARE TO EXCL (ENQOLD)
*P*                 * DETECTION OF DEADLOCK CONDITIONS (SAJCK)
*P*                 * ALL ENQUEUE/TEST REQUESTS (TEST)
*P*
*P*               THE QUEUE TABLE (QT) IS USED TO CONTROL ALL ENQ/DEQ
*P*               ACTIVITY. THE TABLE IS INCLUDED IN THE RESIDENT
*P*               MONITOR AS THE RESULT OF THE PASS2 :MON ENQ OPTION.
*P*               IT IS INITIALIZED AS A POOL OF DOUBLEWORD ENTRIES,
*P*               WHERE THE FIRST HALFWORD OF EACH ENTRY POINTS TO (I.E.
*P*               CONTAINS THE ENTRY NUMBER OF) THE NEXT ENTRY.
*P*
*P*               THE FIRST ENTRY IN THE QT IS A POOL HEADER THAT
*P*               INDICATES:
*P*                 * WHETHER THE QT TABLE IS LOCKED
*P*                 * THE NUMBER OF PENDING REQUESTS
*P*               AND POINTS:
*P*                 * TO THE FIRST FREE QT-ENTRY
*P*                 * TO THE FIRST ENTRY IN THE Q-CHAIN.
*P*
*P*               QT-HDR FIELD      BITS   DESCRIPTION
*P*                 QHHP            0-15   PTR TO 1ST FREE QT-ENTRY
*P*                 QHVP            16-31  PTR TO Q-CHAIN
*P*                 QHNAME(LHW)     32-47  QT LOCKED FLAG
*P*                 QHNAME(RHW)     48-63  PENDING REQUESTS COUNT
*P*
*P*               THERE IS ONE Q-CHAIN COMPOSED OF Q-ENTRIES. EACH
*P*               Q-ENTRY IDENTIFIES A RESOURCE NAME AND POINTS:
*P*                 * TO THE NEXT Q-ENTRY. THIS STRUCTURE CONNECTS
*P*                   ALL RESOURCES.
*P*                 * TO A (CONTIGUOUS) U-HEADER.
*P*               EACH U-HEADER CONTAINS THE NUMBER OF UNALLOCATED
*P*               'ALL' REQUESTS PENDING FOR THE GIVEN RESOURCE,
*P*               AND POINTS:
*P*                 * TO THE FIRST U-ENTRY FOR THE RESOURCE.
*P*                   THIS BEGINS THE CONNECTION OF ALL USERS REQUESTING
*P*                   A GIVEN RESOURCE.
*P*                 * TO THE FIRST S-ENTRY FOR THE RESOURCE.
*P*                   THIS BEGINS THE CONNECTION OF ALL ELEMENTS OF A
*P*                   GIVEN RESOURCE.
*P*
*P*               Q-CHAIN:  Q-ENTRY/U-HEADER
*P*
*P*               Q-ENTRY FIELD     BITS   DESCRIPTION
*P*                 QHHP            0-15   PTR TO NEXT Q-ENTRY
*P*                 QHVP            16-31  PTR TO U-HEADER
*P*                 QHNAME          32-63  RESOURCE IDENT (SEE NOTE 1.)
*P*
*P*               U-HDR FIELD       BITS   DESCRIPTION
*P*                 QHHP            0-15   PTR TO 1ST U-ENTRY
*P*                 QHVP            16-31  PTR TO 1ST S-ENTRY
*P*                 ...             32-47  NOT USED
*P*                 QHNAME(RHW)     48-63  PENDING ALL COUNT
*P*
*P*               NOTE 1. THE IDENTIFIER NAME IS REPRESENTED BY A TEXTC
*P*               STRING WHERE N DENOTES THE NUMBER OF CHARACTERS IN THE
*P*               NAME. WHEN N LIES BETWEEN 1 AND 3, THE STRING IS IN
*P*               QHNAME ITSELF; OTHERWISE, THE LEFTMOST BIT OF QHNAME
*P*               IS SET ON AND THE RIGHTMOST 17 BITS OF QHNAME CONTAIN
*P*               THE BYTE ADDRESS OF THE STRING, WHERE FLOOR((N+8)/8)
*P*               CONTIGUOUS POOL DOUBLEWORDS ARE ACQUIRED FOR THE NAME.
*P*
*P*               EACH U-ENTRY INDICATES:
*P*                 * THE USER NUMBER
*P*                 * WHETHER OR NOT THIS USER'S REQUESTS FOR THE GIVEN
*P*                   RESOURCE ARE BLOCKED
*P*               AND POINTS:
*P*                 * TO THE NEXT U-ENTRY. THIS STRUCTURE
*P*                   CONTINUES THE CONNECTION OF ALL USERS REQUESTING
*P*                   A GIVEN RESOURCE (STARTED BY U-HDR QHHP).
*P*                 * TO THE FIRST SQ-ENTRY IN THE U-CHAIN.
*P*                   THIS BEGINS THE CONNECTION OF ALL REQUESTS FOR
*P*                   A GIVEN USER OF A GIVEN RESOURCE.
*P*
*P*               U-ENTRY FIELD     BITS   DESCRIPTION
*P*                 QHHP            0-15   PTR TO NEXT U-ENTRY
*P*                 QHVP            16-31  PTR TO U-CHAIN
*P*                 QHNAME(LB)      32-39  BLOCKED FLAG
*P*                 ...             40-55  NOT USED
*P*                 QHNAME(RB)      56-63  USER NUMBER
*P*
*P*               EACH S-ENTRY IDENTIFIES AN ELEMENT NAME, AND POINTS:
*P*                 * TO THE NEXT S-ENTRY. THIS STRUCTURE
*P*                   CONTINUES THE CONNECTION OF ALL ELEMENTS OF A
*P*                   GIVEN RESOURCE (STARTED BY U-HDR QHVP).
*P*                 * TO THE FIRST SQ-ENTRY IN THE S-CHAIN.
*P*                   THIS BEGINS THE CONNECTION OF ALL REQUESTS FOR
*P*                   A GIVEN ELEMENT OF A GIVEN RESOURCE.
*P*
*P*               S-ENTRY FIELD     BITS   DESCRIPTION
*P*                 QHHP            0-15   PTR TO NEXT S-ENTRY
*P*                 QHVP            16-31  PTR TO S-CHAIN
*P*                 QHNAME          32-63  ELEMENT IDENT (SEE NOTE 2.)
*P*
*P*               NOTE 2. THE IDENTIFIER IS REPRESENTED BY A TEXTC
*P*               STRING WHEN IT IS AN ELEMENT NAME (SEE NOTE 1. ABOVE
*P*               FOR A DESCRIPTION OF THE POSSIBLE TEXTC FORMATS).
*P*               THE OPTIONS NULL AND ALL ARE REPRESENTED BY
*P*               X'40000000' AND X'7F000000', RESPECTIVELY.
*P*               A NULL ENTRY PRECEDES ANY OTHER ENTRY; AN ALL ENTRY
*P*               PRECEDES ANY OTHER ENTRY EXCEPT NULL.
*P*
*P*               EACH SQ-ENTRY IS THE INTERNAL REPRESENTATION OF A
*P*               UNIQUE ENQUEUE REQUEST IDENTIFIABLE BY
*P*               USER/ELEMENT/RESOURCE. EACH SQ-ENTRY APPEARS IN TWO
*P*               CHAINS, THE U-CHAIN AND THE S-CHAIN, AND POINTS:
*P*                 * TO THE NEXT SQ-ENTRY FOR THE SAME ELEMENT.
*P*                   THIS STRUCTURE, CALLED THE S-CHAIN, CONTINUES THE
*P*                   CONNECTION OF ALL REQUESTS FOR A GIVEN ELEMENT OF
*P*                   A GIVEN RESOURCE (STARTED BY S-ENTRY QHVP).
*P*                 * TO EITHER THE NEXT SQ-ENTRY FOR THE SAME
*P*                   USER OR TO AN INTERMEDIATE QECB-ENTRY WHICH, IN
*P*                   TURN, POINTS TO THE NEXT SQ-ENTRY. THUS, THE QUHP
*P*                   POINTER STRUCTURE, CALLED THE U-CHAIN, CONTINUES
*P*                   THE CONNECTION OF ALL REQUESTS FOR A GIVEN USER OF
*P*                   A GIVEN RESOURCE (STARTED BY U-ENTRY QHVP).
*P*                 * BACK TO THE S-ENTRY THAT IDENTIFIES THE
*P*                   ELEMENT NAMED FOR THIS REQUEST.
*P*               EACH SQ-ENTRY INDICATES:
*P*                 * THE CURRENT STATUS AND OPTIONS OF A REQUEST.
*P*                 * THE USER NUMBER
*P*
*P*               SQ-ENTRY FIELD    BITS   DESCRIPTION
*P*                 QQHP            0-15   PTR TO NEXT S-CHAIN SQ-ENTRY
*P*                 QUHP            16-31  PTR TO NEXT U-CHAIN SQ-ENTRY
*P*                                        OR, TO A QECB-ENTRY
*P*                 QUVP            32-47  PTR TO ORIGINAL S-ENTRY
*P*                 QQF             48-55  FLAGS (SEE NOTE 3.)
*P*                 QQUN            56-63  USER NUMBER
*P*
*P*               NOTE 3. THE ON STATUS OF THE QQF FLAGS ARE:
*P*                 BIT             DESCRIPTION
*P*                  0              QECB-ENTRY EXISTS
*P*                  1              REQUEST IS ALLOCATED
*P*                  2              NOWAIT OPTION
*P*                  3              ASLEEP PENDING ALLOCATION
*P*                  4              REQUEST IS BLOCKED (WHEN BOTH BITS
*P*                                 1 AND 4 ARE OFF, REQUEST IS PENDING)
*P*                  5              JOB OPTION
*P*                  6              SHARE OPTION
*P*                  7              UPGRADE IS PENDING
*P*
*P*               EACH QECB-ENTRY POINTS:
*P*                 * BACK TO THE SQ-ENTRY THAT POINTS TO IT.
*P*                 * TO THE NEXT SQ-ENTRY, AS DESCRIBED ABOVE.
*P*                 * TO AN ECB FOR THE REQUEST.
*P*
*P*               QECB-ENTRY FIELDS BITS   DESCRIPTION
*P*                 QUPP            0-15   PTR TO ORIGINAL SQ-ENTRY
*P*                 QUHP            16-31  PTR TO NEXT SQ-ENTRY IN THE
*P*                                        U-CHAIN
*P*                 ...             32-46  NOT USED
*P*                 QUEA            47-63  ADDRESS OF ECB
*P*
*P*               THE S-CHAIN IS GROUPED, WITH ALLOCATED SQ-ENTRIES
*P*               APPEARING FIRST, FOLLOWED BY PENDING SQ-ENTRIES,
*P*               THEN BY BLOCKED SQ-ENTRIES. WITHIN EACH OF THESE
*P*               GROUPS, THE ALLOCATED ENTRIES ARE IN INVERSE
*P*               CHRONOLOGICAL ORDER, THE PENDING ENTRIES ARE IN
*P*               CHRONOLOGICAL ORDER, AND THE BLOCKED ENTRIES ARE
*P*               IN THE SAME ORDER BY USER AS ARE THE U-ENTRIES.
*D*               THE ONLY EXCEPTION TO THE ORDER OF THE PENDING
*D*               GROUP OCCURS WHEN AN ALLOCATED ENTRY IS MARKED
*D*               FOR A PENDING UPGRADE. IN THIS CASE, THE ALLOCATED
*D*               SQ-ENTRY IS SHARE AND THE UPGRADE SQ-ENTRY IS FOR
*D*               EXCLUSIVE USE. THE NEW EXCLUSIVE SQ-ENTRY IS PLACED
*D*               AT THE BEGINNING OF THE PENDING GROUP (NOTE THAT IT
*D*               MAY BE ASSOCIATED WITH AN ECB). THUS, WHEN THE
*D*               UPGRADE CAN ACTUALLY BE ACCOMPLISHED, THE NEW ONE
*D*               IS THE SUCCESSOR OF THE ALLOCATED ONE.
*P*      REFERENCE: BATCH PROCESSING REFERENCE MANUAL.
         TITLE    'ENQUE MODULE ENVIRONMENT'
         DEF      ENQUE:            PATCHING DEF
ENQUE:   RES
         DEF      ENQ               ENQ/DEQ COMMON ENTRY POINT.
         DEF      ENQLSQ            ENTRY USED BY ENQOLD.
         DEF      ENQEX             ENTRY USED BY ENQALL.
         DEF      ENQDONE           ENTRY USED BY ENQALL.
         DEF      ENQCW             ENTRY USED BY SAJCK.
         DEF      ENQ00             ENTRY USED BY DEQUEUE AND TEST.
         DEF      ABN3103           ENTRY USED BY TEST.
         DEF      ENQERR            ENTRY USED BY VARIOUS ENQO ROUTINES.
         DEF      FINDQ             SUBR USED BY TEST AND DEQUEUE.
         DEF      FINDS             SUBR USED BY TEST AND DEQUEUE.
         DEF      UIX               ANLZ REFERENCE USED BY ENQO.
         DEF      FINDSQ            SUBR USED BY TEST AND DEQUEUE.
         DEF      FINDU             SUBR USED BY VARIOUS ENQO ROUTINES.
         DEF      FINDR0U           SUBR USED BY  DOUP SUBR IN ENQO.
         DEF      LINKSQ            SUBR USED BY ENQALL.
         DEF      REL1DW            SUBR USED BY VARIOUS ENQO ROUTINES.
         DEF      RELDW             SUBR USED BY VARIOUS ENQO ROUTINES.
         DEF      ALL               CONSTANT REFERENCED BY ENQO.
*
         SREF     QT                MONITOR RESIDENT QUEUE TABLE
         SREF     QTSZ              QUEUE TABLE SIZE
*
         REF      CHKBIT0           FPT SCAN INIT AND GET P1, IF ANY.
         REF      CHKBIT            GET NEXT FPT PARAM, IF ANY.
         REF      PUSHALL           SAVE REGISTER ENVIRONMENT IN TSTACK.
         REF      PULLALLEXIT       TSTACK CLEAN UP ROUTINE.
         REF      J:JIT             USER'S JIT.
         REF      ERO               OUTPUT BITS 15-31.
         REF      ABO               OUTPUT BITS 15-31.
         REF      J:BASE            TEMP STORAGE.
         REF      M17
         REF      ECBINIT           INITIALIZE ECB ROUTINE.
         REF      Y01
         REF      Y8
         REF      JB:PRIV           INPUT BYTE 0.
         REF      SH:SYMT           HW TABLE OF FEATURE TEXT IN TABLES.
         REF      SV:FTYM           NUMBER OF SH:SYMT ENTRIES.
         REF,2    JH:LDCF           AUTHORIZATION FLAGS, PARALLEL
*,*                                 TO SH:SYMT
         REF      J:ABC             OUTPUT BIT 23 IS ENQUEUE.
         REF      ENQOLD#           ROUTINE IN ENQO MODULE.
         REF      MASKS
         REF      BT31TO0
         REF      NB31TO0           MASKS
         REF      CHKQO#            ROUTINE IN ENQO MODULE.
         REF      ENQALL#           ROUTINE IN ENQO MODULE.
         REF      SAJCK#            ROUTINE IN ENQO MODULE.
         REF      MSRWRTX           ROUTINE IN IORT MODULE.
         REF      ECBPOST           POST ECB ROUTINE.
         REF      E:NQW             ENQUEUE WAIT EVENT FOR SCHEDULER.
         REF      T:REG             SCHEDULER SUBROUTINE.
         REF      T:OVER            TO ENQSEG
         REF      UH:DL             INPUT BITS 0-3 INDICATE TERMINATION.
         REF      RELQO#            ROUTINE IN ENQO MODULE.
         REF      RDERX             ROUTINE IN IORT MODULE.
         REF      DEQUEUE#          ROUTINE IN ENQO MODULE.
         REF      TEST#             ROUTINE IN ENQO MODULE.
         REF      ENQSEG            SEGMENT OVERLAY.
         REF      LNKQUE#           ROUTINE IN ENQO MODULE.
         REF      RELDWO#           ROUTINE IN ENQO MODULE.
         REF      CHKUO#            ROUTINE IN ENQO MODULE.
         REF      YFF
         REF      E:SL              BEGIN WAIT EVENT FOR SCHEDULER.
         REF      S:CUN             CURRENT USER NUMBER.
         REF      U:MISC            WAIT COUNT FOR SCHEDULER.
         PAGE
         SYSTEM    UTS
GOOVER   CNAME
         PROC
LF       LI,0     AF(1)
         DO       OLCTR=0
OLAY     PUSH     R2
         LI,2     ENQSEG
         B        T:OVER
         ELSE
         B        OLAY
         FIN
OLCTR    SET      OLCTR+1
         PEND
OLCTR    SET      0
*
*
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'
NOWAITFLAG EQU    1
TESTFLAG EQU      2
ECBBIT   EQU      X'8000'
XECBBIT  EQU      16
ALLOCBIT EQU      X'4000'
XALLOCBIT EQU     15
NOWAITBIT EQU     X'2000'
XNOWAITBIT EQU    14
SLEEPBIT EQU      X'1000'
XSLEEPBIT EQU     13
BLOCKBIT EQU      X'800'
XBLOCKBIT EQU     12
JOBBIT   EQU      QJOBBIT
SHAREBIT EQU      QSHAREBIT
UPGRADEBIT EQU    X'0100'
*
JIT:ENQ  EQU      X'100'
MAXNAME  EQU      31                MAX SIZE-QNAME OR SNAME
M25      EQU      MASKS+25
         TITLE    'ENQUE: MAIN PROGRAM'
*F*      NAME:    ENQ
*F*      PURPOSE: TO DECODE ENQ/DEQ FPT, ESTABLISH POINTERS, AND
*F*               TO TRANSFER CONTROL TO THE APPROPRIATE PROCESSING
*F*               ROUTINE.
*F*      DESCRIPTION: THIS IS THE COMMON RECEIVING ROUTINE TO PROCESS
*F*               ENQ/DEQ REQUESTS. AFTER INITIALIZATION AND SETUP
*F*               PROCESSING ARE DONE, CONTROL IS TRANSFERRED TO
*F*               A PROCESSING ROUTINE.
*D*      NAME:    ENQ
*D*      REGISTERS: COMPATIBLE WITH FILE MANAGEMENT CALS.
*D*      CALL:    VIA TRANSFER VECTOR IN ENQO MODULE WHEN ENQUE IS
*D*               IN THE ENQSEG OVERLAY, OR DIRECTLY WHEN ENQUE IS
*D*               IN THE MONITOR ROOT.
*D*      INTERFACE: ENTERED
*D*               1. BY CALPROC FOR M:ENQ AND M:DEQ CALS
*D*               2. WHEN JIT:ENQ IS ON, STEP SIMULATES:
*D*                 A. M:DEQ (ALL,ALL,STEP) AT STEP END
*D*                 B. M:DEQ (ALL,ALL,JOB) AT JOB END.
*D*      INPUT:   THE REGISTERS REQUIRED ARE:
*D*               R7=WA(FPT WORD 1)
*D*               R8=FPT CODE BYTE (8 OR 9)
*D*               R11=WA(IOSPRTN)
*D*      OUTPUT: THE ENQ ROUTINE PROVIDES THE FOLLOWING SETUP:
*D*               FIELD             BITS   DESCRIPTION
*D*               R2                0-7    COUNT+1 OF QNAME
*D*               R2                8-31   BA(TEXTC OF QNAME)
*D*               R3                0-7    COUNT+1 OF SNAME
*D*               R3                8-31   BA(TEXTC OF SNAME)
*D*               J:JIT+ERO         15-31  WA(ERROR ROUTINE)
*D*               J:JIT+ABO         15-31  WA(ABNORMAL ROUTINE)
*D*               J:BASE+1          0      SET ON IF RES
*D*               J:BASE+1          1-7    FPT CODE(8 OR 9)
*D*               J:BASE+1          8-15   NOT USED
*D*               J:BASE+1          16-23  QUEUE CODE(1,3,5 OR 7)
*D*               J:BASE+1          24-31  FPT FLAGS
*D*               J:BASE+2          15-31  WA(ECB) OR 0
*D*               J:BASE+3          15-31  WA(FPT QUEUE CODE WORD)
*D*      DESCRIPTION: ENQ FIRST CALLS PUSHALL IN IORT TO SET UP TSTACK
*D*               IN A FILE MANAGEMENT COMPATIBLE MANNER SO THAT
*D*               ENQ/DEQ CAN USE THE FILE MANAGEMENT EXIT ROUTINES.
*D*               THREE WORDS OF THE WORK AREA BEGINNING AT J:BASE+1
*D*               ARE USED TO STORE DATA FOR OTHER ROUTINES.
*D*               IF AN ECB IS PRESENT, ITS VALIDITY IS CHECKED AND
*D*               IT IS INITIALIZED. THE QUEUE CODE VLP PORTION OF
*D*               THE FPT IS THEN PROCESSED . IF AN FPT, VLP OR ECB
*D*               ERROR IS DETECTED, THE ENQERRX ROUTINE IS ENTERED IN
*D*               ORDER TO ABORT THE USER WITH ERROR CODE 4A00.
*D*               AFTER EXCLUSIVE ACCESS TO THE QT TABLE IS SECURED,
*D*               EXAMINATION OF THE REQUEST CONTINUES.
*D*
*D*               BASED ON FPT CODE AND FLAGS, ENQ THEN TRANSFERS
*D*               CONTROL TO THE ENQO MODULE FOR ALL DEQUEUE AND
*D*               ENQUEUE/TEST REQUESTS. FOR THE REMAINING ENQUEUE
*D*               REQUESTS, THE ENQCAL ROUTINE IN THIS MODULE IS
*D*               ENTERED.
ENQ      EQU      %
         LI,6     6                 SELF ADDRESSED DCB POINTER
*                                      FOR PULLALLEXIT
         BAL,R1   PUSHALL
         LW,R0    0,R7
         STW,R0   J:BASE+1          SAVE FLAGS
         STB,SR1  J:BASE+1
*                      STORE ERR/ABN ADDRESSES IN JIT
         BAL,R2   CHKBIT0
         STS,D1   J:JIT+ERO
         BAL,R2   CHKBIT
         STS,D1   J:JIT+ABO
         LI,D1    0
*                      SAVE DATA IN J:BASE FOR FUTURE REFERENCE
         BAL,R2   CHKBIT
         AND,D1   M17
         STW,D1   J:BASE+2          SAVE ECB ADDRESS
         AW,R7    R1
         AND,R7   M17
         STW,R7   J:BASE+3          SAVE FPT ADDRESS
         LW,R1    J:BASE+1          GET FLAGS
         LW,SR3   D1                GET ADDRESS OF ECB
         BEZ      ENQ1              B, IF NONE
         CI,R1    NOWAITFLAG+TESTFLAG TEST WHETHER ECB IS NEEDED
         BANZ     ENQ2              B, IF SO
*E*      ERROR:   ERROR CODE 4A, SUBCODE 00.
*E*      DESCRIPTION: A SUPERFLUOUS ECB IS PRESENT, OR A REQUIRED ECB
*E*               IS ABSENT.
ENQ05    LI,SR3   X'4A'
         B        ENQERRX           ERROR RETURN
ENQ1     CI,R1    NOWAITFLAG+TESTFLAG TEST WHETHER ECB IS NEEDED
         BANZ     ENQ05             B, IF SO
         B        ENQ25             NO ECB NEEDED
ENQ2     EQU      %
         BAL,SR4  ECBINIT           INITIALIZE ECB
         AI,SR3   0                 NON-ZERO IF ECB IN PROTECTED MEMORY
         BNEZ     ENQERRX           ERROR CODE 4A-05
ENQ25    BAL,SR4  GETNP             PROCESS FPT VLP ENTRY
*E*      ERROR:   ERROR CODE 4A, SUBCODE 00.
*E*      DESCRIPTION: BAD VLP ENTRY IN PARAMETER LIST.
         B        ENQ05             ERROR RETURN FOR BAD VLP
         BAL,R0   LOCKQT            WAIT FOR QT ACCESS AND SECURE IT
         LW,R7    J:BASE+1          CODE AND FLAGS
         CI,R7    2                 TEST (F2)
         BANZ     TESTO
         CW,R7    Y01
         BANZ     DEQUEUEO          FPT CODE WAS 9
         PAGE
*F*      NAME:    ENQCAL
*F*      PURPOSE: TO CONTINUE THE PROCESSING OF ENQUEUE REQUESTS.
*F*      DESCRIPTION: ENQUEUE AUTHORIZATION IS GUARANTEED AND
*F*               TABLE ENTRIES ARE BUILT IF THEY ARE NOT PRESENT. IF
*F*               THE REQUEST IS A POSSIBLE MODIFICATION OF AN EXISTENT
*F*               REQUEST, CONTROL IS TRANSFERRED TO ENQO FOR FURTHER
*F*               PROCESSING. CONTROL IS ALSO TRANSFERRED TO ENQO TO
*F*               PROCESS A REQUEST FOR ENQUEUE WITH SNAME=ALL. ANY
*F*               OTHER REQUEST FOR ENQUEUE IS PROCESSED IN THIS MODULE.
*D*      NAME:    ENQCAL
*D*      CALL:    TRANSFER OF CONTROL WITH THE SETUP PROVIDED BY ENQ.
*D*      INTERFACE: ENQ TRANSFERS CONTROL TO ENQCAL.
*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: THE ENQCAL ROUTINE PROCESSES A NON-TEST ENQUEUE
*D*               REQUEST. IF THE USER IS NOT AUTHORIZED FOR ENQ/DEQ,
*D*               CONTROL IS TRANSFERRED TO ENQERR TO ISSUE A 5803 ERROR.
*D*               THE JIT:ENQ FLAG IS SET AND THE APPROPRIATE Q, U, AND
*D*               S ENTRIES ARE FOUND, OR IF NOT PRESENT, THEY ARE
*D*               BUILT. IF THE SQ-ENTRY ALREADY EXISTS, CONTROL IS
*D*               TRANSFERRED TO ENQOLD IN THE ENQO MODULE. IF THE NEW
*D*               REQUEST IS FOR SNAME=ALL, CONTROL IS TRANSFERRED TO
*D*               ENQALL IN THE ENQO MODULE. AN SQ-ENTRY IS BUILT
*D*               AND LINKED INTO THE U-CHAIN.
*D*
*D*               IF, IN BUILDING ANY OF THE ABOVE ENTRIES, THE QT
*D*               POOL OF ENTRIES IS EXHAUSTED, ONE OF THE ENQERLG
*D*               ROUTINE ENTRY POINTS IN THE ENQO MODULE IS ENTERED
*D*               TO PROCESS A 5801 ERROR RETURN.
*D*
*D*               THE FINAL STEP IS TO LINK THE NEW SQ-ENTRY INTO THE
*D*               S-CHAIN FOR THE ELEMENT/RESOURCE. THE U-ENTRY IS
*D*               EXAMINED TO SEE WHETHER THIS USER IS ALREADY BLOCKED
*D*               OR NOT.
*D*
*D*               IF THE USER IS ALREADY MARKED BLOCKED, THE NEW SQ-
*D*               ENTRY IS ALSO MARKED BLOCKED AND THE CORRECT POSITION
*D*               FOR LINKING IT INTO THE S-CHAIN IS SOUGHT. THE S-CHAIN
*D*               IS RUN DOWN TO FIND THE START OF THE BLOCKED GROUP. IF
*D*               NO BLOCKED GROUP ALREADY EXISTS FOR THIS ELEMENT, THE
*D*               ENQLSQ ROUTINE IS ENTERED TO LINK THE NEW BLOCKED
*D*               SQ-ENTRY AT THE END OF THE S-CHAIN. WHEN THERE IS
*D*               A BLOCKED GROUP, THE NEW SQ-ENTRY MUST BE LINKED INTO
*D*               IT IN THE SAME RELATIVE POSITION AS THE ASSOCIATED U-
*D*               ENTRY APPEARS IN THE CHAIN STARTED BY THE U-HEADER FOR
*D*               THE RESOURCE. IN THIS WAY, ONCE A USER BECOMES
*D*               UNBLOCKED, ITS BLOCKED SQ-ENTRIES CAN BE ALLOCATED AT
*D*               ONCE, PREVENTING WHAT MIGHT OTHERWISE HAVE BEEN A
*D*               POSSIBLE DEADLOCK WITH A USER SUBSEQUENTLY UNBLOCKED
*D*               HAD THE BLOCKED GROUP REMAINED IN CHRONOLOGICAL ORDER.
*D*
*D*               IF THE USER IS NOT BLOCKED, A DETERMINATION MUST BE
*D*               MADE OF THE CURRENT STATUS OF THE PARTICULAR
*D*               RESOURCE/ELEMENT IN QUESTION, AS WELL AS THE STATUS OF
*D*               ANY 'ALL' ELEMENT REQUESTS, IN ORDER TO ESTABLISH
*D*               WHETHER THE NEW SQ-ENTRY MAY BE LINKED INTO THE
*D*               ALLOCATED OR INTO THE PENDING GROUP ON THE S-CHAIN.
*D*               FIRST, IF THERE ARE NO ENTRIES IN THE GIVEN S-CHAIN, OR
*D*               IF THERE IS NO ALLOCATED GROUP, THE NEW REQUEST IS
*D*               A CANDIDATE FOR ALLOCATION. IF AN ALLOCATED GROUP
*D*               EXISTS, AND EITHER THE NEW REQUEST OR THE EXTANT SQ-
*D*               ENTRY IS EXCLUSIVE, CONTROL IS TRANSFERRED TO THE
*D*               ENQEX ROUTINE. IF AN ALLOCATED SQ-ENTRY FOR 'ALL'
*D*               ELEMENTS OF A RESOURCE EXISTS, AND EITHER THE NEW
*D*               REQUEST OR THE EXTANT 'ALL' REQUEST IS EXCLUSIVE,
*D*               CONTROL IS TRANSFERRED TO THE ENQEXLH ROUTINE. IN
*D*               ALL OTHER CASES, THE NEW SQ-ENTRY IS MARKED ALLOCATED
*D*               AND CONTROL IS TRANSFERRED TO THE ENQIN ROUTINE.
ENQCAL   EQU      %
         LB,R0    JB:PRIV
         CI,R0    X'A0'
         BGE      SETENQ            A0 PRIV IS OK FOR ENQ
         LI,R1    SV:FTYM           FIND BIT POSITION FOR ENQ
         LI,R0    X'F0000'+C'EQ'    C'EQ' WITH SIGN EXTENSION
ENQAUTH  EQU      %
         CH,R0    SH:SYMT,R1
         BE       ENQAUT1           BIT IN JH:LDCF SAME AS EQ HALF-WORD
         BDR,R1   ENQAUTH
         B        SETENQ            NO SPECIAL AUTHORIZATIONS FOR ENQ
ENQAUT1  EQU      %
         LI,R7    JH:LDCF
         LH,R0    0,R7
         SLS,R0   0,R1
         CI,R0    X'8000'
         BANZ     SETENQ            FLAG SET IS OK AUTHORIZATION
*E*      ERROR:   ERROR CODE 58, SUBCODE 03.
*E*      DESCRIPTION: THE USER IS NOT AUTHORIZED TO USE THE ENQUEUE
*E*               SERVICE.
*E*      REGISTERS: N/A
         LW,SR3   L(3**25+X'58')
         B        ENQERR
SETENQ   LI,R1    JIT:ENQ
         STS,R1   J:ABC             SET ENQUEUE USED
*
         BAL,SR4  FINDQ             R2 CONTAINS QNAME INFO
         B        BUILDQ            RETURN HERE IF NOT FOUND
SETR2Q   LW,R2    R6                ESTABLISH INDEX OF Q-ENTRY
         AI,R6    1                 SET INDEX OF U-HDR FOR FINDU
         BAL,SR4  FINDU             S:CUN CONTAINS USER NUMBER
         B        BUILDU            RETURN HERE IF NOT FOUND
SETR4U   LW,R4    R6                ESTABLISH INDEX OF U-ENTRY
         LW,R5    R4                COPY INDEX OF U-ENTRY
ENQQUL   LD,D1    QT,R5             GET 1ST U-ENTRY OR NEXT SQ-ENTRY
         CI,D1    X'FFFF'           TEST FOR LAST ENTRY IN U-CHAIN
         BAZ      LINKQU            B, IF SO
         INT,R5   D1                INDEX OF NEXT SQ-ENTRY IN U-CHAIN
         B        ENQQUL            AND CONTINUE THE SEARCH
* HERE TO BUILD NEW SQ-ENTRY.
LINKQU   BAL,SR2  GET1DW            FOR AN SQ-ENTRY OR A QECB-ENTRY
         B        LINKQUCU          ERROR, IF NO DW'S AVAILABLE
         LI,D3    0                 SET LINKS TO 0
         LW,D4    J:BASE+2          TRY TO GET ECB ADDRESS
         BEZ      LINKQUNE          B, IF NONE
*
         STD,D3   QT,R6             SAVE PARTIAL QECB
         PUSH     R6                AND ITS INDEX
         BAL,SR2  GET1DW            FOR THE SQ-ENTRY NOW
         B        LINKQURDW         ERROR, MUST RELEASE PRIOR DW ALSO
         PULL     R1                GET INDEX OF QECB-ENTRY
         LD,D3    QT,R1             GET THE QECB ENTRY
         STH,R6   D3                QUPP PTR BACK TO SQ-ENTRY
         STD,D3   QT,R1             ESTABLISH NEW QECB-ENTRY
         LW,D3    R1                SET LINK TO THE QECB-ENTRY
         LI,D4    ECBBIT            SET THE QECB FLAG, TOO
*
LINKQUNE LW,R1    S:CUN             GET THE USER NR
         OR,D4    R1                SET IT
         LW,R0    J:BASE+1          GET STORED FPT FLAGS
         LI,R1    SHAREBIT+JOBBIT   SET MASK
         STS,R0   D4                SET SHARE AND JOB FLAGS, IF PRESENT
         CI,R0    NOWAITFLAG        TEST FOR NOWAIT OPTION
         BAZ      %+2               B, IF NOT
         OR,D4    BT31TO0+XNOWAITBIT  ELSE, SET NOWAIT FLAG
         STD,D3   QT,R6             ESTABLISH NEW SQ-ENTRY
         LD,D3    QT,R5             GET THE PREDECESSOR
         OR,D3    R6                INSERT LINK TO NEW SQ-ENTRY
         STD,D3   QT,R5             STORE THE PREDECESSOR
         LW,R5    R6                ESTABLISH INDEX OF SQ-ENTRY(U-CHAIN)
* HERE TO FIND WHETHER S-ENTRY IS EXTANT.
         BAL,SR4  FINDS             R3 CONTAINS SNAME INFO; R2=Q-ENTRY
         B        BUILDS            RETURN HERE IF NOT FOUND
SETR3S   LW,R3    R6                ESTABLISH INDEX OF S-ENTRY
* HERE TO FIND WHETHER SQ-ENTRY ALREADY EXISTS ON S-CHAIN FOR USER.
         BAL,SR4  FINDSQ            R3 AND R6 CONTAIN INDEX OF S-ENTRY
         B        ENQSQNF           RETURN HERE IF NOT FOUND
**************************************************************
         GOOVER   ENQOLD#           POSSIBLE UPGRADE          *
**************************************************************
LINKQUCU GOOVER   CHKUO#            PURGE EMPTY CHAINS        *
LINKQURDW GOOVER LNKQUE#            RLS 1 DW AND PURGE CHAINS *
**************************************************************
         PAGE
* PROCESS A NEW REQUEST
*
* R2=INDEX OF Q-ENTRY
* R3=INDEX OF S-ENTRY
* R4=INDEX OF U-ENTRY
* R5=INDEX OF SQ-ENTRY
* R6=INDEX OF THE LAST ENTRY IN THE S-CHAIN.
* AT THIS POINT, THE SQ-ENTRY IS LINKED ONLY INTO THE U-CHAIN.
ENQSQNF  LD,D1    QT,R3             GET S-ENTRY
         CW,D2    ALL               TEST WHETHER REQUEST IS FOR ALL
         BE       ENQALLO           B, IF SO (TO ENQO MODULE)
* HERE FOR ENQUEUE WITH SNAME NOT 'ALL'.
         LD,D1    QT,R4             GET U-ENTRY
         LW,D2    D2                TEST WHETHER THIS USER IS BLOCKED
         BGEZ     ENQA              B, IF NOT BLOCKED
* PROCESS A NEW BLOCKED REQUEST
*
         PUSH     R6                SAVE INDEX OF S-CHAIN LAST SQ-ENTRY
         LD,D1    QT,R5             GET NEW SQ-ENTRY
         OR,D2    BT31TO0+XBLOCKBIT
         STD,D1   QT,R5             SET BLOCKED
         LW,R6    R3                GET INDEX OF S-ENTRY
         LD,D3    QT,R3             GET S-ENTRY FOR THE ELEMENT
         SLS,D3   16                GET INDEX OF 1ST SQ-ENTRY ON S-CHAIN
         LD,D1    QT+2,R2           GET U-HEADER FOR THE RESOURCE
ENQNAL1  STW,R6   *TSTACK           ESTABLISH A POSITION IN THE S-CHAIN
         LH,R6    D3                INDEX TO NEXT SQ-ENTRY ON S-CHAIN
         BEZ      ENQLSQ            B, IF NONE LEFT
         LD,D3    QT,R6             GET THE OLD SQ-ENTRY
         CI,D4    BLOCKBIT          TEST IF THIS OLD SQ-ENTRY IS BLOCKED
         BAZ      ENQNAL1           B, IF NOT
         STB,D4   D4                KEEP USER NR OF OLD BLOCKED ENTRY
ENQNAL2  LH,R1    D1                GET INDEX TO NEXT U-ENTRY
         LD,D1    QT,R1             GET THE U-ENTRY
         CW,R1    R4                TEST FOR OBJECT U-ENTRY
         BE       ENQLSQ            B, IF SO TO INSERT NEW SQ-ENTRY
         CB,D2    D4                TEST WHETHER USER NUMBERS MATCH
         BE       ENQNAL1           B IF SO, TO GET NEXT BLOCKED USER
         B        ENQNAL2           ELSE TRY NEXT U-ENTRY
         PAGE
BUILDS   CW,R3    M25               TEST FOR COUNT FIELD GT 1
         BG       BUILDS1           B, IF SO (R6=INDEX OF LAST ENTRY)
         LW,R6    R2                GET INDEX OF Q-ENTRY
         AI,R6    1                 CALC INDEX OF THE U-HEADER
         LD,D3    QT+2,R2           GET U-HEADER
         LI,R1    X'FFFF'
         AND,R1   D3
         BEZ      BUILDS1           B, IF NO S-ENTRY AT ALL
* S-ENTRIES FOR NULL (X'40...') AND ALL (X'7F...') IN THAT ORDER,
* PRECEDE ALL OTHER S-ENTRIES.
         LD,D1    QT,R1             GET 1ST S-ENTRY
         LB,D2    D2                GET 1ST BYTE OF QHNAME FIELD
         CI,D2    X'40'             TEST FOR SPECIAL
         BAZ      BUILDS1           B, IF NOT SPECIAL
         BNE      BUILDS1           B, IF ALL (MUST FOLLOW IT WITH NULL)
         LW,R6    R1                IS NULL, MUST PRECEDE IT WITH ALL
BUILDS1  LW,SR1   R3                GET SNAME INFO
         ANLZ,R7  UIX               SET INDES OF U-HDR
         LI,R0    1                 SET NUMBER OF DW'S
         BAL,SR4  BUILDQS           RETURNS ONLY IF SUCCESSFUL
         B        SETR3S            NOW BACK TO MAIN FLOW
* HERE TO BUILD A U-ENTRY; R6 CONTAINS INDEX OF ...
BUILDU   LW,R4    R6                SET POINTER FOR LINKING U
         BAL,SR2  GET1DW
         B        BUILDUNO          ERROR-UNWIND & EXIT
         LW,D4    S:CUN             SET USER NR
         LI,D3    0                 SET LINKS TO 0
         LD,SR1   QT+2,R2           GET U-HEADER
         CI,SR2   X'FFFF'           TEST FOR ANY PENDING ALL'S
         BAZ      %+2               B, IF NONE
         OR,D4    Y8                ELSE BLOCK THIS USER
         STD,D3   QT,R6             ESTABLISH NEW U-ENTRY
         LD,D1    QT,R4             GET THE PREDECESSOR
         STH,R6   D1                ESTABLISH LINK TO NEW ENTRY
         STD,D1   QT,R4             STORE LINKED ENTRY
         B        SETR4U            NOW BACK TO MAIN FLOW
* HERE TO BUILD A Q-ENTRY; R6 CONTAINS INDEX OF LAST Q-ENTRY(OR QT-HDR)
BUILDQ   LW,SR1   R2                GET QNAME INFO
         LI,R7    0                 SET INDEX OF QT-HDR
         LI,R0    2                 SET NUMBER OF DW'S
         BAL,SR4  BUILDQS           RETURNS ONLY IF SUCCESSFUL
         B        SETR2Q            NOW BACK TO MAIN FLOW
         PAGE
* PROCESS A NEW UNBLOCKED REQUEST (SNAME NOT 'ALL').
*
ENQA     LD,D1    QT,R3             GET S-ENTRY
         LD,D3    QT,R5             GET SQ-ENTRY
         LI,R1    X'FFFF'           GET INDEX TO THE FIRST
         AND,R1   D1                  SQ-ENTRY IN THE S-CHAIN
         BEZ      ENQALO            B, IF NONE
         LD,D1    QT,R1             GET EXISTING SQ-ENTRY IN S-CHAIN
         CI,D2    ALLOCBIT          TEST WHETHER IT IS ALLOCATED
         BAZ      ENQALO            B, IF NOT ALLOCATED
* HERE WHEN AN ALLOCATED GROUP ALREADY EXISTS.
         CI,D4    SHAREBIT          TEST THE NEW REQUEST FOR SHARE
         BAZ      ENQEX             B, IF NEW IS EXCL
         CI,D2    SHAREBIT          TEST WHETHER ALLOCATED ONE IS SHARE
         BAZ      ENQEX             B, IF ALLOCATED IS EXCL
* HERE WITH THE NEW CANDIDATES FOR ALLOCATION.
ENQALO   LD,D1    QT+2,R2           GET U-HEADER
         INT,R7   D1                GET INDEX TO 1ST S-ENTRY
         LD,D1    QT,R7             GET 1ST S-ENTRY
         CW,D2    ALL               TEST FOR SNAME=ALL
         BE       ENQA2             B, IF SO
         LH,R7    D1                GET INDEX OF 2ND S-ENTRY
         LD,D1    QT,R7             GET 2ND S-ENTRY
         CW,D2    ALL               TEST FOR SNAME=ALL
         BNE      ENQALO1           B, IF NO 'ALL' AT ALL
* HERE WITH A NEW CANDIDATE AND EXISTING SNAME=ALL ENTRY.
ENQA2    INT,R7   D1                GET INDEX OF SQ-ENTRY FOR 'ALL'
         LD,D1    QT,R7             GET THE 'ALL' SQ-ENTRY IN S-CHAIN
         CI,D2    ALLOCBIT          TEST WHETHER 'ALL' IS ALLOCATED
         BAZ      ENQALO1           B, IF NOT
* HERE WITH A NEW CANDIDATE WITH SNAME=ALL ALREADY ALLOCATED.
         CI,D4    SHAREBIT          TEST THE NEW REQUEST FOR SHARE
         BAZ      ENQALLX           B, IF NEW IS EXCL
         CI,D2    SHAREBIT          TEST ALLOCATED 'ALL' FOR SHARE
         BAZ      ENQALLX           B, IF ALLOCATED 'ALL' IS EXCL
* HERE TO PERFORM THE ALLOCATION OF THE NEW REQUEST.
ENQALO1  OR,D4    BT31TO0+XALLOCBIT SET ALLOCATION FLAG
         STD,D3   QT,R5             RESTORE THE NEW SQ-ENTRY
         LW,R6    R3                ESTABLISH S-CHAIN INDEX AFTER WHICH
         B        ENQIN               TO INSERT THE SQ-ENTRY; GO TO LINK
* HERE WITH A NEW REQUEST AND AN ALREADY ALLOCATED ENTRY FOR
* SNAME=ALL, AT LEAST ONE OF WHICH IS EXCLUSIVE. HENCE, THE NEW REQUEST
* CAN NOT BE ALLOCATED.
ENQALLX  LW,R6    R3                ESTABLISH INDEX TO START OF S-CHAIN
         LD,D1    QT,R6             GET THE S-ENTRY
         STH,D1   D1                SHIFT LINK TO SQ-ENTRY TO LHW
         B        ENQEXLH           AND GO TO INSERT PENDING REQUEST
         SPACE    2
**************************************************************
BUILDUNO GOOVER   CHKQO#                                      *
DEQUEUEO GOOVER   DEQUEUE#                                    *
TESTO    GOOVER   TEST#                                       *
ENQALLO  GOOVER   ENQALL#                                     *
**************************************************************
         PAGE
*D*      NAME:    ENQEX
*D*      ENTRY:   ENQEXLH
*D*      CALL:    BRANCH TO ENTRY POINT
*D*      INTERFACE: ENTERED BY ENQCAL IN THIS MODULE AND BY ENQALL IN
*D*               THE ENQO MODULE.
*D*      INPUT:   FOR ENQEX ENTRY POINT:
*D*               R1=INDEX OF 1ST ALLOCATED SQ-ENTRY IN THE S-CHAIN
*D*               D1,D2=COPY OF 1ST ALLOCATED SQ-ENTRY IN THE S-CHAIN
*D*               FOR ENQEXLH ENTRY POINT:
*D*               R6=INDEX OF S-ENTRY
*D*               D1(LHW)=LINK TO 1ST SQ-ENTRY IN THE S-CHAIN
*D*               FOR EITHER ENTRY POINT:
*D*               R2=INDEX OF Q-ENTRY
*D*               R3=INDEX OF S-ENTRY
*D*               R4=INDEX OF U-ENTRY
*D*               R5=INDEX OF THE SQ-ENTRY TO BE LINKED INTO THE S-CHAIN
*D*      OUTPUT:  R6=INDEX OF THE ENTRY TO WHICH THE SQ-ENTRY IS TO
*D*                 BE LINKED.
*D*      DESCRIPTION: THIS ROUTINE SEARCHES THE S-CHAIN FOR THE POSITION
*D*               INTO WHICH AN UNBLOCKED SQ-ENTRY IS TO BE INSERTED AS
*D*               A PENDING REQUEST. THE ROUTINE IS ENTERED AT ENQEXLH
*D*               IN THE CASE OF AN EXCLUSIVE REQUEST WITH AN ALREADY
*D*               ALLOCATED ENTRY FOR SNAME=ALL OR OF A SHARE
*D*               REQUEST WITH AN ALREADY ALLOCATED EXCLUSIVE ENTRY FOR
*D*               SNAME=ALL. OTHERWISE, IT IS ENTERED AT ENQEX WHEN A
*D*               CONFLICT ARISES FOR THE GIVEN SNAME (I.E., AN
*D*               EXCLUSIVE REQUEST WITH AN ALREADY ALLOCATED REQUEST,
*D*               OR A SHARE REQUEST WITH AN ALREADY ALLOCATED EXCLUSIVE
*D*               REQUEST).
ENQEX    LW,R6    R1                INDEX OF S-CHAIN ENTRY JUST EXAMINED
ENQEXLH  LH,R1    D1                GET LINK TO NEXT SQ-ENTRY ON S-CHAIN
         BEZ      ENQIN             B, IF END OF CHAIN
         LD,D1    QT,R1             GET THE NEXT SQ-ENTRY ON S-CHAIN
         CI,D2    BLOCKBIT          TEST WHETHER ENTRY IS BLOCKED
         BANZ     ENQIN             B, IF SO (R6=PREVIOUS ENTRY INDEX)
         B        ENQEX             ELSE, TRY AGAIN
         PAGE
*D*      NAME:    ENQLSQ
*D*      ENTRY:   ENQIN
*D*      CALL:    BRANCH TO ENTRY POINT
*D*      INTERFACE: ENTERED BY ENQCAL AND ENQEX IN THIS MODULE
*D*               AND BY ENQOLD IN THE ENQO MODULE.
*D*      INPUT:   FOR ENQLSQ ENTRY POINT:
*D*               LAST STACK WORD CONTAINS VALUE DESCRIBED BY R6, BELOW
*D*               FOR ENQIN ENTRY POINT:
*D*               R6=INDEX OF ENTRY TO WHICH THE SQ-ENTRY IS
*D*                 TO BE LINKED.
*D*               FOR EITHER ENTRY POINT:
*D*               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 LINKED INTO THE S-CHAIN
*D*      DESCRIPTION: IF ENTERED AT ENQLSQ, THE ROUTINE PULLS THE
*D*               R6 INDEX. IT THEN LINKS THE SQ-ENTRY INTO THE
*D*               S-CHAIN AND TRANSFERS CONTROL TO ENQDONE.
ENQLSQ   PULL     R6
ENQIN    BAL,SR4  LINKSQ
         PAGE
*D*      NAME:    ENQDONE
*D*      CALL:    B ENQDONE
*D*      INTERFACE: ENTERED BY ENQLSQ IN THIS MODULE AND
*D*               BY ENQALL IN THE ENQO 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 ROUTINE TRANSFERS CONTROL TO THE SAJCK
*D*               ROUTINE IN THE ENQO MODULE WHEN THERE IS A
*D*               POSSIBILITY OF A DEADLOCK. OTHERWISE, CONTROL IS
*D*               TRANSFERRED TO THE ENQCW ROUTINE IN THIS MODULE.
ENQDONE  INT,R1   QT+1              GET NUMBER OF PENDING REQUESTS
         CI,R1    2                 TEST FOR NOT MORE THAN 1 PENDING
         BL       ENQCW             B, IF NO POSSIBILITY OF DEADLOCK
*************************************************************
         GOOVER   SAJCK#            DEADLOCK DETECTION       *
*************************************************************
         PAGE
*D*      NAME:    ENQCW
*D*      CALL:    B ENQCW
*D*      INTERFACE: ENTERED BY ENQDONE IN THIS MODULE AND BY SAJCK
*D*               IN THE ENQO MODULE.
*D*      INPUT:   R5=INDEX OF SQ-ENTRY
*D*      DESCRIPTION: IF THE SQ-ENTRY IS NOT ALLOCATED AND THE NOWAIT
*D*               OPTION WAS SPECIFIED, CONTROL IS TRANSFERRED TO
*D*               ABN3103; OTHERWISE WHEN NOWAIT WAS NOT SPECIFIED, THE
*D*               USER IS PUT TO SLEEP PENDING ALLOCATION VIA THE T:REG
*D*               SYSTEM ROUTINE. WHEN AWAKENED DUE TO AN EVENT OF
*D*               THE TYPE THAT REQUIRES TERMINATION OF EXECUTION, THE
*D*               RELQO ROUTINE IN THE ENQO MODULE IS ENTERED IN ORDER
*D*               TO PURGE AND EVENTUALLY CAUSE AN ABNORMAL 3104 CODE TO
*D*               BE ISSUED. BUT IF THE EVENT IS NOT A TERMINATION
*D*               ONE, THE ROUTINE BEGINS AGAIN FROM THE TOP.
*D*
*D*               WHEN THE SQ-ENTRY IS MARKED AS ALLOCATED, THE
*D*               ASSOCIATED ECB, IF ONE EXISTS, IS POSTED COMPLETE,
*D*               AND THE QECB-ENTRY IS DELINKED FROM THE SQ-ENTRY AND
*D*               RELEASED. CONTROL IS THEN TRANSFERRED TO ENQ00 TO EXIT.
ENQCW    LD,D1    QT,R5             GET SQ-ENTRY
         CI,D2    ALLOCBIT          TEST WHETHER ALLOCATED
         BAZ      ENQDNNA           B, IF NOT ALLOCATED
         CI,D2    ECBBIT            TEST FOR ECB PRESENCE
         BAZ      ENQ00             B, IF NONE TO EXIT
         INT,R1   D1                GET INDEX OF QECB-ENTRY
         LD,D3    QT,R1             GET QECB-ENTRY
         LW,SR4   D4                SAVE ECB ADDRESS
         LI,D4    X'FFFF'
         STS,D3   D1                UNLINK ECB ENTRY
         EOR,D2   BT31TO0+XECBBIT   TURN OFF ECB FLAG
         STD,D1   QT,R5             RESTORE SQ-ENTRY
         LW,R6    R1                RELEASE DW
         BAL,SR2  REL1DW
         LW,SR3   SR4               ECB ADDRESS
         LW,SR1   S:CUN
         LI,SR2   0                 CONDITION CODE
         BAL,SR4  ECBPOST           POST ECB COMPLETE
         B        ENQ00             GO TO EXIT
*
ENQDNNA  EQU      %                 HERE WHEN SQ-ENTRY IS NOT ALLOCATED
         CI,D2    NOWAITBIT
         BANZ     ABN3103           NOT ALLOC-SO GIVE ABN
*
         OR,D2    BT31TO0+XSLEEPBIT  SET SLEEP
         STD,D1   QT,R5
         LI,R0    0
         STH,R0   QT+1              UNLOCK QT
         LW,R0    R5                SAVE INDEX OF SQ-ENTRY
         LI,R6    E:NQW             SET ENQUEUE WAIT EVENT
         BAL,SR4  T:REG             REPORT EVENT AND GIVE UP CONTROL
* AWAKE NOW
         LW,R5    R0                INDEX OF SQ-ENTRY
         LD,D1    QT,R5             GET SQ-ENTRY
         AND,D2   NB31TO0+XSLEEPBIT CLEAR SLEEP
         STD,D1   QT,R5
         BAL,R0   LOCKQT            RETURNS R6=USER NUMBER
         LH,R1    UH:DL,R6          TEST WHETHER JOB IS TO BE ABORTED,
         CI,R1    X'F000'           ERRORED, OR IF CTL-Y OR BRK RECEIVED
         BAZ      ENQCW             B, IF NOT
*                                   ELSE PURGE USER AND ISSUE ABN 3104:
**************************************************************
         GOOVER   RELQO#                                      *
**************************************************************
         PAGE
*D*      NAME:    ABN3103
*D*      CALL:    B ABN3103
*D*      INTERFACE: ENTERED BY THE ENQCW ROUTINE AND BY THE TEST
*D*               ROUTINE IN THE ENQO MODULE.
*D*      OUTPUT:  SR3=X'06000031'
*D*      DESCRIPTION: THE OUTPUT REGISTER IS LOADED AND CONTROL IS
*D*               TRANSFERRED TO THE ENQERR ROUTINE.
ABN3103  EQU      %
*E*      ERROR:   ABNORMAL CODE 31, SUBCODE 03.
*E*      DESCRIPTION: THE REQUESTED RESOURCE/ELEMENT IS NOT PRESENTLY
*E*               AVAILABLE. THIS ABNORMAL CAN OCCUR ONLY FOR AN
*E*               ENQUEUE/TEST REQUEST OR AN ENQUEUE/NOWAIT REQUEST.
*E*               IF IT IS A NOWAIT REQUEST, THE REQUEST HAS BEEN QUEUED
*E*               FOR THE RESOURCE/ELEMENT. IN BOTH CASES, THE ECB IS
*E*               SET TO ZERO.
         LW,SR3   L(3**25+X'31')
         PAGE
*D*      NAME:    ENQERR
*D*      ENTRY:   ENQERRX
*D*      CALL:    BRANCH TO ENTRY POINT
*D*      INTERFACE: ENTERED BY ENQ, ENQCAL, ENQDONE AND ABN3103 IN
*D*               THIS MODULE, AND BY TEST, ENQOLD, DEQUEUE AND RELQO
*D*               IN THE ENQO MODULE (VIA THE DESTRUCT MECHANISM
*D*               OR DIRECTLY WHEN ENQUE IS IN THE OVERLAY).
*D*      INPUT:   SR3, BITS 0-6 CONTAIN THE SUBCODE
*D*               SR3, BITS 24-31 CONTAIN THE CODE
*D*      OUTPUT:  QT LOCKED FLAG=0
*D*               R6=WA(DUMMY DCB)
*D*               TSTACK=WA(PULLALLEXIT)
*D*      DESCRIPTION: WHEN THE ENQERR ENTRY POINT IS ENTERED, THE
*D*               QT TABLE IS UNLOCKED. IN ALL CASES, THE ADDRESS
*D*               OF THE PULLALLEXIT ROUTINE IS PUSHED INTO THE
*D*               STACK AND REGISTER 6 IS SET UP WITH A DUMMY DCB
*D*               ADDRESS. THEN, IN ORDER TO ABORT THE USER WITH THE
*D*               ERROR CODE IN SR3, A DESTRUCT ENTRY TO RDERX IN
*D*               THE IORT MODULE IS TAKEN.
         SPACE    2
ENQERR   EQU      %
         LI,R0    0
         STH,R0   QT+1              UNLOCK QT
ENQERRX  EQU      %
         LI,R0    PULLALLEXIT
         PUSH     R0
         LI,6     6                 SET DUMMY DCB ADDRESS FOR IORT
**************************************************************
         DESTRUCT RDERX             ERROR EXIT VIA IORT       *
**************************************************************
         PAGE
*D*      NAME:    ENQ00
*D*      CALL:    B    ENQ00
*D*      INTERFACE: ENTERED BY ENQCW IN THIS MODULE AND BY THE TEST
*D*               AND DEQUEUE ROUTINES IN THE ENQO MODULE.
*D*      DESCRIPTION: THE QT TABLE IS UNLOCKED. A DESTRUCT ENTRY TO
*D*               MSRWRTX IN THE IORT MODULE IS TAKEN IN ORDER TO
*D*               COMPLETE THE NORMAL RETURN TO THE USER.
*D*      NAME:    ENQ00
ENQ00    LI,R0    0
         STH,R0   QT+1              UNLOCK QT
**************************************************************
         DESTRUCT MSRWRTX           NORMAL EXIT - FAST PATH   *
**************************************************************
         TITLE    'ENQUE: 1ST LEVEL SUBROUTINES'
*D*      NAME:    FINDQ
*D*      REGISTERS: R1, D1-D4 ARE VOLATILE.
*D*      CALL:    LOC     BAL,SR4     FINDQ
*D*               LOC+1   RETURN HERE FOR NOT FOUND CONDITION
*D*               LOC+2   RETURN HERE FOR FOUND CONDITION
*D*      INTERFACE: CALLED BY ENQCAL IN THIS MODULE AND BY THE TEST
*D*               AND DEQUEUE ROUTINES IN THE ENQO MODULE.
*D*      INPUT:   R2 AS SET UP BY ENQ IN THIS MODULE.
*D*      OUTPUT:  R6=INDEX OF THE FOUND Q-ENTRY OR INDEX OF THE LAST
*D*               Q-ENTRY IN THE CHAIN (OR IF NONE, OF THE QT-HEADER).
*D*      DESCRIPTION: THE FINDQ SUBROUTINE SEARCHES FOR A Q-ENTRY IN
*D*               THE QT TABLE WHOSE RESOURCE IDENTIFIER MATCHES THE
*D*               ONE IDENTIFIED BY REGISTER 2. IF A MATCH IS FOUND,
*D*               RETURN IS TO THE BAL LOCATION PLUS 2 WITH R6=INDEX
*D*               OF THE MATCHING Q-ENTRY. OTHERWISE, RETURN IS TO THE
*D*               BAL LOCATION PLUS 1 WITH R6=INDEX OF THE LAST Q-ENTRY
*D*               OR OF THE QT-HEADER WHEN THERE ARE NO Q-ENTRIES.
FINDQ    LI,R6    0                 SET INDEX OF QT-HEADER
         STW,R2   J:BASE+4          SET PARAMETER WITH QNAME INFO
* THE FOLLOWING IS COMMON CODE FOR THE FINDQ AND FINDS SUBROUTINES.
FINDNAM  LD,D3    QT,R6             GET QT-HEADER/U-HEADER
         STH,D3   D3                SHIFT LINK TO LHW
FINDNAML LH,R1    D3                GET LINK TO NEXT ENTRY
         BEZ      *SR4              B, IF NOT FOUND CONDITION
         LW,R6    R1                ESTABLISH R6 RESULT
         LD,D3    QT,R6             GET THE Q-ENTRY/S-ENTRY
         LW,D2    J:BASE+4          GET TARGET INFORMATION
         LI,D1    D4**2             ASSUME SOURCE NAME IS IN D4 ITSELF
         AI,D4    0                 TEST WHETHER SOURCE IS THERE
         BGEZ     %+2               B, IF SO
         LW,D1    D4                ELSE D4 HAS BA OF SOURCE
         CBS,D1   0                 TEST FOR A NAME MATCH
         BNE      FINDNAML          B, IF NOT A MATCH TO TRY NEXT ONE
         B        SR4X1             RETURN IF FOUND CONDITION
         PAGE
*D*      NAME:    FINDS
*D*      REGISTERS: R1, D1-D4 ARE VOLATILE.
*D*      CALL:    LOC     BAL,SR4     FINDS
*D*               LOC+1   RETURN HERE FOR NOT FOUND CONDITION
*D*               LOC+2   RETURN HERE FOR FOUND CONDITION
*D*      INTERFACE: CALLED BY ENQCAL IN THIS MODULE AND BY TEST AND
*D*               AND DEQUEUE IN THE ENQO MODULE.
*D*      INPUT:   R2=INDEX OF A Q-ENTRY FOR THE RESOURCE
*D*               R3 AS SET UP BY ENQ IN THIS MODULE
*D*      OUTPUT:  R6=INDEX OF THE FOUND S-ENTRY OR INDEX OF THE LAST
*D*               S-ENTRY IN THE CHAIN (OR IF NONE, OF THE U-HEADER).
*D*      DESCRIPTION: THIS SUBROUTINE SEARCHES FOR AN S-ENTRY IN THE
*D*               QT TABLE WHOSE ELEMENT IDENTIFICATION MATCHES THE
*D*               ONE IDENTIFIED BY REGISTER 3. IF A MATCH IS FOUND,
*D*               RETURN IS TO THE BAL LOCATION PLUS 2 WITH R6=INDEX
*D*               OF THE MATCHING S-ENTRY. OTHERWISE, RETURN IS TO THE
*D*               BAL LOCATION PLUS 1 WITH R6=INDEX OF THE LAST S-ENTRY
*D*               OR OF THE U-HEADER WHEN THERE ARE NO Q-ENTRIES.
FINDS    ANLZ,R6  UIX               COMPUTE INDEX OF U-HEADER
         STW,R3   J:BASE+4          SET PARAMETER WITH SNAME INFO
         B        FINDNAM           AND GO TO COMMON CODE
         PAGE
*D*      NAME:    FINDU
*D*      ENTRY:   FINDSQ
*D*      ENTRY:   FINDR0U
*D*      CALL:    LOC     BAL,SR4     ENTRY-POINT-NAME
*D*               LOC+1   RETURN HERE FOR NOT FOUND CONDITION
*D*               LOC+2   RETURN HERE FOR FOUND CONDITION
*D*      INTERFACE: CALLED BY ENQCAL IN THIS MODULE AND BY THE TEST AND
*D*               DEQUEUE ROUTINES AND THE RELU AND DOUP SUBROUTINES
*D*               IN THE ENQO MODULE.
*D*      INPUT:   FOR THE FINDSQ ENTRY POINT:
*D*               R3=INDEX OF S-ENTRY
*D*               FOR THE FINDR0U ENTRY POINT:
*D*               R0=USER NUMBER
*D*               FOR ALL ENTRY POINTS:
*D*               R6=INDEX OF U-HDR/S-ENTRY
*D*      OUTPUT:  R6=INDEX OF THE FOUND U-ENTRY/SQ-ENTRY OR INDEX OF
*D*               THE LAST ENTRY IN THE CHAIN OF U-ENTRIES/S-CHAIN.
*D*      DESCRIPTION: WHEN ENTRY IS NOT VIA THE FINDR0U ENTRY POINT,
*D*               THE USER NUMBER IN S:CUN IS ESTABLISHED AS THE
*D*               SEARCH ARGUMENT. THIS SUBROUTINE SEARCHES FOR A
*D*               MATCHING USER NUMBER IN THE CHAIN OF U-ENTRIES OR
*D*               IN THE S-CHAIN. IF A MATCH IS FOUND, RETURN IS TO
*D*               THE BAL LOCATION PLUS 2 WITH R6=INDEX OF THE FOUND
*D*               ENTRY. OTHERWISE, RETURN IS TO THE BAL LOCATION PLUS 1
*D*               WITH R6=INDEX OF THE LAST U-ENTRY/SQ-ENTRY (OR THE
*D*               U-HDR/S-ENTRY IF NO U-ENTRIES/SQ-ENTRIES EXIST) FOR
*D*               FINDU(FINDR0U) AND FINDSQ, RESPECTIVELY.
FINDSQ,FINDU EQU  %
         LW,R0    S:CUN
         STB,R0   R0                SETUP R0 FOR CB,D4 R0
FINDR0U  LD,D3    QT,R6             GET U-HEADER OR S-ENTRY
         CW,R6    R3                TEST WHETHER FINDSQ OR FINDU
         BNE      FINDUL            B, IF FINDU
         STH,D3   D3                SHIFT SQ INDEX OF S-ENTRY TO LHW
FINDUL   LH,R1    D3                GET LINK TO U-ENTRY OR SQ-ENTRY
         BEZ      *SR4              B NOT FOUND, IF END OF CHAIN
         LW,R6    R1                ESTABLISH R6
         LD,D3    QT,R6             AND GET THE ENTRY
         CB,D4    R0                SAME USER
         BNE      FINDUL            NO-TRY NEXT
SR4X1    AI,SR4   1
BISR4    B        *SR4
         PAGE
*D*      NAME:    GETNP
*D*      CALL:    LOC     BAL,SR4     GETNP
*D*               LOC+1   RETURN HERE FOR ERROR CONDITION
*D*               LOC+2   HERE FOR NORMAL RETURN
*D*      INTERFACE: ENTERED BY THE ENQ ROUTINE IN THIS MODULE.
*D*      INPUT:   USER'S FPT
*D*               J:BASE+1
*D*               J:BASE+3
*D*      OUTPUT:  THIS SUBROUTINE PROVIDES THE FOLLOWING:
*D*               FIELD             BITS   DESCRIPTION
*D*               R2                0-7    COUNT+1 OF QNAME
*D*               R2                8-31   BA(QNAME)
*D*               R3                0-7    COUNT+1 OF SNAME
*D*               R3                8-31   BA(SNAME)
*D*               J:BASE+1          0      SET ON IF RES
*D*               J:BASE+1          1-15   NOT ALTERED
*D*               J:BASE+1          16-23  QUEUE CODE(1,3,5 OR 7)
*D*      DESCRIPTION: GETNP VERIFIES THE QUEUE CODE IN THE FPT.
*D*               REGISTERS 2 AND 3 ARE SET UP WITH THE COUNT AND
*D*               BYTE ADDRESS OF THE QNAME AND SNAME, RESPECTIVELY.
*D*               THE COUNT IS N+1, WHERE N DENOTES THE NUMBER OF
*D*               CHARACTERS IN THE NAME. BUT FOR THE SPECIAL NAMES
*D*               ALL, RES, AND NULL, WHICH ARE ENCODED TO X'7F',X'7E',
*D*               AND X'40', RESPECTIVELY, THE COUNT IS SIMPLY 1.
*D*               THE SHARE OPTION IS FORCED FOR SNAME=NULL IN
*D*               THE SAVED QUEUE CODE. ALSO, A DEQUEUE SNAME=RES
*D*               IS DENOTED BY THE LEFTMOST BIT OF J:BASE+1.
GETNP    EQU      %
         LW,R7    J:BASE+3
         LB,R0    *R7               GET QUEUE CODE OF VLP CONTROL WD
         CI,R0    X'F8'
         BANZ     *SR4              ERROR, IF GREATER THAN 7
         CI,R0    1
         BAZ      *SR4              ERROR, IF CODE IS EVEN
         LI,R1    2
         STB,R0   J:BASE+1,R1       SAVE CODE
         AI,R7    1                 STEP TO DATA
*
         LI,R5    -2                TWO ITERATIONS OF ADDRESS HANDLING
GETNPL   LW,R1    R7
         LB,D2    *R1
         LW,D1    D2
         AI,D2    4                 ASSUME ITS A TEXTC COUNT, CALC THE
         SLS,D2   -2                R7 INCREMENT
         CI,D1    X'7F'             BUT FIRST CHECK FOR INDIRECTNESS
         BLE      GETNPB
*
         LI,D2    1                 INDIRECT-R7 INCREMENT=1
         LW,R1    0,R1
         LB,D1    *R1
GETNPB   CI,D1    X'40'             CHECK SPECIAL (40,7E,7F)
         BAZ      GETNPD            B, IF NOT SPECIAL
         LI,D2    1                 R7 INCREMENT
         LI,D4    QSHAREBIT         PREPARE TO FORCE SHARE, IF NULL
         AI,D1    -X'40'            TEST FOR NULL
         BEZ      GETNPC1           B, IF SO
         CI,D1    X'3E'
         BL       *SR4              ERROR, IF NOT X'3E' OR X'3F'
         BG       GETNPQA           ALL-OK
*
         LB,D4    J:BASE+1          HERE FOR RES
         CI,D4    1                 TEST FOR ENQUEUE
         BAZ      *SR4              ERROR, IF SO
         LW,D4    Y8                'RES' FLAG...RELU USES
GETNPC1  CI,R5    -1                HERE FOR NULL OR RES, TEST FOR ENQ
         BL       *SR4              ERROR, IF SO
         STS,D4   J:BASE+1          SHARE FOR NULL OR RES FLAG
GETNPC   LI,D1    0                 NAME LENGTH
GETNPD   AI,D1    1                 INCLUDE SIZE BYTE IN COUNT
         CI,D1    MAXNAME+1
         BG       *SR4              ERROR, NAME IS TOO LONG
GETNPE   AW,R7    D2
         SLS,R1   2                 BA OF NAME
         STB,D1   R1
         STW,R1   4,R5              CAREFUL-THATS INTO R2, THEN R3
         BIR,R5   GETNPL
         B        SR4X1
*
GETNPQA  CI,R5    -2                HERE FOR ALL, TEST FOR QNAME
         BNE      GETNPC            B, IF NOT
         LB,D4    J:BASE+1          IS QNAME
         CI,D4    1                 TEST FOR DEQUEUE
         BANZ     GETNPC            B, IF SO
         B        *SR4              ERROR, IF ENQ QNAME=ALL
         PAGE
*D*      NAME:    LINKSQ
*D*      CALL:    BAL,SR4     LINKSQ
*D*      INTERFACE: CALLED BY ENQLSQ IN THIS MODULE AND BY ENQALL IN
*D*               THE ENQO MODULE.
*D*      INPUT:   R3=INDEX OF THE S-ENTRY FOR THE S-CHAIN
*D*               R5=INDEX OF THE SQ-ENTRY TO BE LINKED INTO S-CHAIN
*D*               R6=INDEX OF PREDECESSOR ENTRY OF THE NEW SQ-ENTRY
*D*      DESCRIPTION: THIS SUBROUTINE LINKS AN SQ-ENTRY INTO AN S-CHAIN.
LINKSQ   LD,D3    QT,R5             GET SQ-ENTRY
         CI,D4    ALLOCBIT          TEST WHETHER ALLOCATED
         BANZ     %+2               B, IF SO
         LI,R1    1
         MTH,1    QT+1,R1           ELSE BUMP PENDING REQUESTS COUNT
         LD,D1    QT,R6             GET PREDECESSOR
         CW,R6    R3                TEST WHETHER PREDECESSOR IS S-ENTRY
         BNE      %+2               B, IF NOT
         SCD,D1   16                ELSE ADJUST S-CHAIN LINK TO LHW
         LH,R0    D1                GET PREDECESSOR'S S-CHAIN LINK
         STH,R0   D3                INTO THE NEW SQ-ENTRY
         STH,R5   D1                SET PREDECESSOR'S LINK TO NEW ENTRY
         STH,R3   D4                SET NEW ENTRY'S LINK TO THE S-ENTRY
         CW,R6    R3                TEST WHETHER PREDECESSOR IS S-ENTRY
         BNE      %+2               B, IF NOT
         SCD,D1   -16               ELSE READJUST TO PROPER FORMAT
         STD,D1   QT,R6             RESTORE THE PREDECESSOR ENTRY
         STD,D3   QT,R5             RESTORE THE NEWLY LINKED QT-ENTRY
         B        *SR4              AND RETURN.
         PAGE
*D*      NAME:    BUILDQS
*D*      CALL:    BAL,SR4     BUILDQS
*D*      INTERFACE: CALLED BY ENQCAL IN THIS MODULE.
*D*      INPUT:   FOR BUILDING A Q-ENTRY:
*D*               R0=2
*D*               R7=INDEX OF QT-HDR
*D*               FOR BUILDING AN S-ENTRY:
*D*               R0=1
*D*               R2=INDEX OF Q-ENTRY (NOTE 1.)
*D*               R4=INDEX OF U-ENTRY (NOTE 1.)
*D*               R5=INDEX OF SQ-ENTRY LINKED TO U-CHAIN (NOTE 1.)
*D*               R7=INDEX OF U-HDR
*D*               FOR BUILDING EITHER KIND OF ENTRY:
*D*               SR1, BITS 0-7 = COUNT+1 OF NAME
*D*               SR1, BITS 8-31 = BA(TEXTC OF NAME)
*D*               NOTE 1. THESE REGISTERS ARE REQUIRED IN ORDER TO
*D*               PURGE ENTRIES IN CASE OF AN ERROR CONDITION.
*D*      OUTPUT:  R6=INDEX OF THE NEW Q-ENTRY OR S-ENTRY
*D*      DESCRIPTION: THIS SUBROUTINE BUILDS EITHER A Q-ENTRY OR AN
*D*               S-ENTRY AND LINKS IT TO ITS PREDECESSOR. FOR A
*D*               Q-ENTRY, A CONTIGUOUS U-HEADER IS SET TO ZERO
*D*               AND LINKED TO THE Q-ENTRY.
*D*
*D*               FIRST, REGISTERS R6 AND R7 ARE PUSHED AND THE GETDW
*D*               SUBROUTINE IS USED TO ACQUIRE N CONTIGUOUS FREE
*D*               QT-ENTRIES AS DENOTED BY R0. THEN THE QHNAME FIELD
*D*               IS BUILT FOR SMALL NAMES AND THE SPECIAL NAMES. IF
*D*               THE INDIRECT FORM FOR A LONG NAME IS NEEDED, THE
*D*               GETDW SUBROUTINE IS INVOKED AGAIN AND THE NAME
*D*               PRECEDED BY ITS COUNT FIELD (WHICH INCLUDES ITSELF),
*D*               IS MOVED TO THE ACQUIRED DOUBLEWORDS.
*D*
*D*               FOR A Q-ENTRY, THE SECOND DOUBLEWORD, WHICH IS THE
*D*               U-HEADER, IS SET TO ZERO AND ITS INDEX IS PUT
*D*               INTO THE QHVP FIELD BEING BUILT IN THE REGISTERS.
*D*
*D*               FINALLY, THE PARAMETER REGISTERS ARE PULLED, AND THE
*D*               PREDECESSOR ENTRIES ARE LINKED TO THE NEW
*D*               ENTRIES.
BUILDQS  EQU      %
         PUSH     2,R6              SAVE TWO INDICES
         BAL,SR2  GETDW             SUBR USES R0=COUNT
         B        BLDQSX            COULDNT GET ANY
         LB,R0    SR1
         LW,D4    SR1
         SLS,D4   -2
         LW,D4    *D4               GET 1ST WD OF NAME OR SPECIAL
         CI,R0    1                 TEST FOR SPECIAL
         BNE      %+2               B, IF NOT
         AND,D4   YFF               RETAIN ONLY BYTE 0
         CI,R0    4                 TEST FOR SHORT NAME (UP TO 3)
         BLE      BLDQSA            NO EXTRA WORDS NEEDED
         PUSH     R6                SAVE INDEX OF 1ST DW
         AI,R0    7                 CALC THE NUMBER OF
         SLS,R0   -3                  DW'S NEEDED FOR THE NAME
         BAL,SR2  GETDW             GET (R0) DW'S FOR QNAME/SNAME
         B        BLDQSX1           GO RELEASE 1ST DW & RETURN ERROR
         LW,SR2   R6
         AI,SR2   DA(QT)
         SLS,SR2  3                 CALC BA OF TARGET DW'S
         LW,D4    SR2
         OR,D4    Y8                INDIRECT FLAG
         LB,R0    SR1
         STB,R0   SR2
         MBS,SR1  0
         PULL     R6
BLDQSA   LI,D3    0                 ASSUME S-ENTRY
         MTW,0    *TSTACK           TEST FOR Q-ENTRY
         BNEZ     BLDQSB            B, IF NOT
         SD,D1    D1                BLD   U HEAD
         STD,D1   QT+2,R6
         LI,D3    1
         AW,D3    R6                CALC INDEX OF CONTIG U-HEADER
BLDQSB   PULL     2,R0              R0=LAST INDEX; R1=HEADER INDEX
         XW,R1    R0
         LD,D1    QT,R1
         CW,R1    R0                TEST WHETHER LAST IS A HEADER
         BNE      %+2               B, IF ITS AN ENTRY, NOT A HDR
         SCD,D1   16                IS HEAD-MOVE VERT TO LH
         LH,SR1   D1
         STH,SR1  D3                UPDATE THE LINK
         STH,R6   D1                LINK IN
         CW,R1    R0
         BNE      %+2
         SCD,D1   -16               IS HEAD-RESTORE POSITIONS
         STD,D3   QT,R6             STORE DATA INTO NEW Q-ENTRY/S-ENTRY
         STD,D1   QT,R1             AND RESTORE ITS PREDECESSOR
         B        *SR4
*
*
BLDQSX1   LI,R6   -1                RELEASE DW & EXIT
         LW,D2    *TSTACK,R6        GET THE HEADER INDEX
         LI,R6    1                 ASSUME RELEASE OF 1 DW
         AI,D2    0                 TEST FOR QT-HEADER INDEX
         BNEZ     %+2               B, IF NOT
         LI,R6    2                 MUST RELEASE 2 DW'S
         XW,R6    *TSTACK           INSERT DW COUNT FOR RELDWO
         B        BLDQSX2
*
BLDQSX   LI,R0 0
         PUSH     R0
**************************************************************
BLDQSX2  GOOVER   RELDWO#                                       *
**************************************************************
         TITLE    'ENQUE: 2ND LEVEL SUBROUTINES'
*D*      NAME:    GET1DW
*D*      CALL:    LOC     BAL,SR2     GET1DW
*D*               LOC+1   RETURN HERE IF REQUEST NOT FILLED
*D*               LOC+2   HERE FOR NORMAL RETURN
*D*      INTERFACE: CALLED BY ENQCAL FOR A U-ENTRY, AND BY LINKQU
*D*               FOR AN SQ-ENTRY AND POSSIBLY FOR A QECB-ENTRY.
*D*      INPUT:   R6=INDEX OF ENTRY TO WHICH THE NEW ENTRY IS
*D*               TO BE LINKED.
*D*      OUTPUT:  SEE GETDW OUTPUT.
*D*      DESCRIPTION: THIS SUBROUTINE LOADS R0 WITH 1 AND TRANSFERS
*D*               CONTROL TO GETDW.
GET1DW   LI,R0    1                 FOR 1 DW
         SPACE    5
*D*      NAME:    GETDW
*D*      CALL:    LOC     BAL,SR2     GETDW
*D*               LOC+1   RETURN HERE IF REQUEST NOT FILLED
*D*               LOC+2   HERE FOR NORMAL RETURN
*D*      INTERFACE: CALLED BY BUILDQS FOR
*D*               * 2 ENTRIES (Q-ENTRY/U-HEADER)
*D*               * 1 ENTRY (S-ENTRY)
*D*               * FLOOR((N+8)/8) ENTRIES (TEXTC NAME WHERE N
*D*                 DENOTES THE NUMBER OF CHARACTERS IN THE NAME)
*D*               AND ENTERED DIRECTLY BY THE GET1DW SUBROUTINE.
*D*      INPUT:   R0=NUMBER OF CONTIGUOUS NEW QT-ENTRIES NEEDED
*D*               R6=INDEX OF ENTRY TO WHICH THE FIRST NEW ENTRY IS
*D*                  TO BE LINKED.
*D*      OUTPUT:  R6=INDEX OF FIRST NEW ENTRY.
*D*      DESCRIPTION: STARTING WITH THE QT-HEADER, THIS SUBROUTINE
*D*               ATTEMPTS TO SECURE A BLOCK OF N CONTIGUOUS ENTRIES
*D*               AND IF SUCCESSFUL, RETURNS TO THE LOCATION OF THE
*D*               BAL PLUS 2 WITH R6=INDEX OF THE FIRST NEW ENTRY.
*D*               OTHERWISE, RETURN IS TO THE BAL LOCATION PLUS 1.
*D*      ERRORS:
*D*               IF AN INVALID INDEX IS DETECTED, WE SCREECH 37-00.
*
GETDW    PUSH     R0                SAVE NR OF ENTRIES NEEDED
         LI,R6    0                 SET INDEX OF QT-HEADER
GETDWL1  LW,R0    *TSTACK
         LW,R1    R6                SAVE IX FOR UNLINK
         LD,D3    QT,R6             GET HEAD OR PREVIOUS DW
         LH,R6    D3
         BEZ      GETDWNF           NOT FOUND
GETDWL2  BDR,R0   GETDWNX
         CI,R6    0                 IS THE ENDING INDEX LEGAL??
         BLE      ENQSC00           B/NOPE.
         CI,R6    QTSZ
         BG       ENQSC00           IF NOT VALID, SC 37-00
         LD,D3    QT,R6             DONE-LINK OUT THE GOT DWS
         LH,R0    D3
         LD,D3    QT,R1
         LH,R6    D3                START OF RETRIEVED BLOCK
         STH,R0   D3
         STD,D3   QT,R1
         AI,SR2   1                 SUCCESS
GETDWNF  PULL     R0
         B        *SR2
GETDWNX  EQU      %                 NEED MORE-SEE IF ANOTHER CONTIGUOUS
         LD,D3    QT,R6
         AI,R6    1
         CH,R6    D3
         BE       GETDWL2           NEXT DW IS OK-CONTINUE
         LH,R6    D3                NOT CONTIG, SO TRY IT NOW.
         B        GETDWL1           GO START AGAIN
         PAGE
*D*      NAME:    REL1DW
*D*      CALL:    BAL,SR2     REL1DW
*D*      INTERFACE: CALLED BY ENQCW IN THIS MODULE AND BY VARIOUS
*D*               ROUTINES IN THE ENQO MODULE.
*D*      INPUT:   R6=INDEX OF QT ENTRY TO BE RETURNED TO THE POOL.
*D*      DESCRIPTION: THIS SUBROUTINE LOADS R0 WITH 1 AND TRANSFERS
*D*               CONTROL TO RELDW.
REL1DW   LI,R0    1                 FOR 1 DW
         SPACE    5
*D*      NAME:    RELDW
*D*      REGISTERS: R0,R1,SR3,D3,D4 ARE VOLATILE.
*D*      CALL:    BAL,SR2     RELDW
*D*      INTERFACE: CALLED BY VARIOUS ROUTINES IN THE ENQO MODULE
*D*               AND ENTERED DIRECTLY BY THE REL1DW SUBROUTINE.
*D*      DATA:    QT TABLE.
*D*      INPUT:   R0=NUMBER OF CONTIGUOUS QT ENTRIES TO BE RELEASED
*D*               R6=INDEX OF FIRST QT ENTRY TO BE RETURNED TO THE POOL
*D*      DESCRIPTION: THIS SUBROUTINE RETURNS A BLOCK OF N CONTIGUOUS
*D*               ENTRIES TO THE QT TABLE FREE ENTRY POOL.
*D*      ERRORS:
*D*               IF R6=0 OR R6>QTSZ, AN INVALID REQUEST, AND WE WILL
*D*               GENERATE A SC-37-00.
*
RELDW    LI,R1    0                 SET INDEX OF QT-HEADER
         CI,R6    0
         BLE      ENQSC00           SC 37-00 IF TRYING TO FREE QT HEAD..
         CI,R6    QTSZ              ALSO MUST BE LEGAL INDEX
         BG       ENQSC00           OR WE WILL COMPLAIN....
RELDWS   LD,D3    QT,R1             GET HEADER OR NEXT QT-ENTRY
         LH,SR3   D3                GET INDEX TO NEXT ENTRY
         BEZ      RELDWB            B, IF AT THE END
         CH,R6    D3                TEST WHETHER TO INSERT HERE
         BL       RELDWB            B, IF SO
         LW,R1    SR3               ELSE ESTABLISH NEXT INDEX
         B        RELDWS            AND TRY AGAIN
RELDWB   STH,R6   D3                LINK IN NEW DW
         STD,D3   QT,R1
         LW,R1    R6
         AI,R6    1
         SD,D3    D3                CLEAR D3-D4
         BDR,R0   RELDWB
         STH,SR3  D3
         STD,D3   QT,R1
         B        *SR2
         TITLE    'ENQ MISCELLANEOUS SUBROUTINES'
*D*      NAME:    LOCKQT
*D*      CALL:    BAL,R0     LOCKQT
*D*      INTERFACE: CALLED BY ENQ AND BY ENQCW IN THIS MODULE
*D*      OUTPUT:  QT LOCKED FLAG=1
*D*               R6=CURRENT USER NUMBER
*D*      DESCRIPTION: THIS SUBROUTINE GUARANTEES THAT THE CURRENT USER
*D*               CAN PROCEED TO PROCESS THE QT TABLE.
LOCKQT   EQU      %
         LW,R6    S:CUN             CURRENT USER NUMBER
         MTH,1    QT+1              INCREMENT THE QT LOCKED FLAG
         LH,R1    QT+1
         CI,R1    1                 TEST WHETHER THIS USER CAN PROCEED
         BE       *R0               EXIT, IF SO
         MTH,-1   QT+1              ELSE DECR THE QT LOCKED FLAG
         STW,R1   U:MISC,R6         SET USER TO SLEEP 2 TICKS
         LI,R6    E:SL              SET SLEEP EVENT
         BAL,SR4  T:REG             REPORT EVENT AND GIVE UP CONTROL
         B        LOCKQT            NOW TRY AGAIN
*
*S*      SCREECH CODE: 37-00
*S*      REPORTED BY: ENQO/ENQUE
*S*      MESSAGE: QUEUE TABLE CHAIN ERROR
*S*      REGISTERS:  DEPEND ON ORIGINATING ROUTINE IN ENQO/ENQUE
*S*      REMARKS: CALLED WHEN AN INCONSITENCY, SUCH AS A BAD INDEX
*S*               IS DISCOVERED IN THE QT AREA.
*
ENQSC00  SCREECH  37,00             MIGHT AS WELL CALL IT A DAY....
         TITLE    'ENQUEUE/DEQUEUE CONSTANTS'
UIX      LD,0     2,R2              ANLZ OBJECT-COMPUTES U-HEADER INDEX
ALL      DATA     X'7F000000'
         END

