****************************************************************
*M*      TPQ1     TP QUEUE MANAGER (PART 1)
****************************************************************
*P*
*P*      NAME:    TPQ1, TP QUEUE MANAGER (PART 1)
*P*
*P*      PURPOSE: TPQ1 IS A CP-V OVERLAY WHICH CONTAINS THE
*P*               TP SYSTEM QUEUE MANAGER.  IT PROCESSES THE
*P*               USER SERVICE CALS TO ACCOMPLISH QUEUE GET,
*P*               PUT, DEFINELIST, AND STATS REQUESTS.  IT
*P*               CALLS TPQ2 TO PERFORM LOCK, UNLOCK, AND
*P*               PURGE REQUESTS.
*P*
*P*      DESCRIPTION:  CHAIN HEADERS FOR THE HEAD AND TAIL OF THE
*P*               SYSTEM QUEUE AND QUEUE CONTROL TABLES ARE
*P*               MAINTAINED IN CORE.  THE ACCESSES TO SECONDARY
*P*               STORAGE ARE KEPT AT A MINIMUM (BY MAINTAINING
*P*               A PORTION OF THE QUEUE FILE IN PHYSICAL
*P*               WORK PAGES).  THIS METHOD PROVIDES THE REQUIRED
*P*               TRANSACTION PROCESSING THROUGHPUT.  QUEUE
*P*               CONTROL INFORMATION IS ALSO MAINTAINED IN CORE.
*P*
*P*               QUEUE ENTRIES ARE OPTIONALLY MARKED IN-PROGRESS
*P*               WHEN A QUEUE RETRIEVAL REQUEST IS ISSUED.  WHEN
*P*               A REPORT OR TRANSACTION IS COMPLETELY PROCESSED,
*P*               THE QUEUE MANAGER IS NOTIFIED AND THE TRANSACTION
*P*               IS DEQUEUED OR ITS STATUS IS UPDATED.  THIS
*P*               PROCESS MINIMIZES THE PROBABILITY OF LOSING
*P*               TRANSACTIONS OR REPORTS WHILE THE QUEUE IS INTACT,
*P*               AND FACILITATES FAST RECOVERY UPON RESTART.
*P*
*P*               THE SECONDARY STORAGE IMAGE OF A QUEUE BLOCK
*P*               IS OPTIONALLY UPDATED WHENEVER A CHANGE IS MADE
*P*               TO THE BLOCK (BASED ON AN UNLOCK PARAMETER).
*P*
*P*               THE TP QUEUE FILE (TPQUEUE.:SYS) IS A STANDARD
*P*               RANDOM FILE.  FOR TP OPERATIONS, IT IS ALLOCATED
*P*               AND OPENED BY THE TPG.  TO ACTIVATE USAGE OF THE
*P*               QUEUE, A QUEUE UNLOCK CAL MUST BE ISSUED.  TO
*P*               TERMINATE USAGE OF THE QUEUE, A QUEUE LOCK CAL
*P*               MUST BE ISSUED.
*P*
*P*               THE QUEUE MANAGER CALS ARE HONORED ONLY FOR
*P*               THE USERS DESIGNATED BY THE INSTALLATION AS
*P*               AUTHORIZED FOR TP.  UNAUTHORIZED USERS ARE
*P*               ABORTED.
*P*
*P*               TP FUNCTIONS:
*P*
*P*               UNLOCK -          MAKE THE QUEUE AVAILABLE.
*P*                                 INITIALIZE QUEUE CONTROL AND
*P*                                 INDEX BLOCKS.
*P*
*P*               PUT -             PLACE AN ENTRY INTO THE QUEUE
*P*                                 OR MODIFY THE STATUS OF AN ENTRY.
*P*
*P*               GET -             RETRIEVE AN ENTRY FROM THE QUEUE.
*P*
*P*               DEFINELIST -      ESTABLISH A LIST OF CRITERIA
*P*                                 FOR SUBSEQUENT GET REQUESTS.
*P*
*P*               STATS -           OBTAIN QUEUE STATUS DATA.
*P*
*P*               PURGE -           DELETE A GET LIST.
*P*
*P*               LOCK -            LOCK ACCESS TO THE QUEUE.
*P*                                 FLUSH THE IN-CORE QUEUE PAGES
*P*                                 TO THE QUEUE FILE.
*P*
         PCC      0
         TITLE    'TP QUEUE MANAGER***VERSION 8***MAY 20, 1975***'
DISCBPROC  SET    1
         SYSTEM   UTS
         SYSTEM   TP:TPO
         SYSTEM   LP:TPOQ
*
*   REFS TO ROUTINES IN TQROOT
*
         REF      TQCHAIN           ADD TO END OF CHAIN
         REF      TQCHAINC          ADD TO CHAIN BASED ON CRITERIA
         REF      TQCHKBIT1         INITIALIZE AND CHECK FPT BIT
         REF      TQCHKBIT          CHECK NEXT FPT BIT
         REF      TQDCHAIN          REMOVE FROM TOP OF CHAIN
         REF      TQDCHAINA         REMOVE SPECIFIED ELEMENT FROM CHAIN
         REF      TQDCHAINC         REMOVE FROM CHAIN BY CRITERIA
         REF      TQGETBYTE         GET BYTE FROM REAL PAGE
         REF      TQGETHWORD        GET HALFWORD FROM REAL PAGE
         REF      TQGETWORD         GET WORD FROM REAL PAGE
         REF      TQGETFIELD        GET FIELD FROM REAL PAGE
         REF      TQLOADF           GET ADDRESS FROM REAL PAGE
         REF      TQSETBYTE         STORE BYTE IN REAL PAGE
         REF      TQSETHWORD        STORE HALFWORD IN REAL PAGE
         REF      TQSETWORD         STORE WORD IN REAL PAGE
         REF      TQSETFIELD        STORE FIELD IN REAL PAGE
         REF      TQSTOREF          STORE ADDRESS IN REAL PAGE
         REF      TQCBYTE           COMPARE REAL BYTE STRINGS
         REF      TQMOVEBS          MOVE BYTE STRINGS IN REAL PAGES
         REF      TQMOVEBSZ         ZERO BYTE STRINGS IN REAL PAGES
         REF      TQHSKPICB         INITIALIZE AN ICB ENTRY
         REF      TQNEWQ            CALL NEWQ FOR QUEUE I/O
         REF      TQUEUEA           QUEUE I/O END ACTION ROUTINE
         REF      TQSETBLOCK        UPDATE QUEUE STATISTICS
*
*  REFS FOR CP-V MONITOR SERVICES
*
         REF      GMB               GET AN MPOOL BUFFER
         REF      ECBINIT           INITIALIZE USER ECB
         REF      ECBPOST           POST USER ECB
         REF      T:REG             REPORT EVENT AND GIVE UP
         REF      T:RUE             REPORT USER EVENT
         REF      T:SELFDESTRUCT    DESTROY OURSELVES
         REF      FNDHGP            FIND GIVEN HGP TABLE
         REF      GPWP              GET PHYSICAL WORK PAGE
         REF      APWP              ASSOCIATE PHYSICAL WORK PAGE
         REF      FPWP              FREE PHYSICAL WORK PAGE
*
*  REFS TO MONITOR TABLES
*
         REF      X80               QUEUED STATUS FLAG
         REF      X1FFFE            MASK TO FIND USER PSD IN STACK
         REF      X3FFE00           MASK FOR PAGE NUMBER
         REF      X0                CONSTANT OF ZEROES
         REF      Y00FE             MASK FOR ABNORMAL SUBCODE
         REF      YF                MASK FOR STORING COND. CODES
         REF      YC                FLAG BITS FOR TQSEARCH
         REF      Y4                FLAG BITS FOR TQSEARCH
         REF      Y2                FLAG BIT FOR TQVERIFY
         REF      YFFFF             HALFWORD MASK
         REF      M11               11-BIT MASK
         REF      E:QA              QUEUE FOR ACCESS EVENT
         REF      E:UQA             UNQUEUE FOR ACCESS EVENT
         REF      S:CUN             CURRENT USER NUMBER
         REF      UH:DL             DO LIST-INDICATES BRK-ERR-ABN-
*,*                                 OR CNTL-Y EVENT HAS OCCURRED
         REF      J:BASE            ADDR. OF USER REGISTERS
         REF      JB:PRIV           USER PRIVILEGE
         REF      J:ASSIGN          TP AUTHORIZATION FLAG IN BIT 9
         REF      JX:CMAP           USER REAL PAGES
         REF      DCT22             POINTER TO DISK DCT TABLES
         REF      DISCLIMS          LAST VALID SECTOR - 1
         REF      SECTOR#MASK       SECTOR MASK
*
         GENREFS
CSTPGE   EQU      X3FFE00           PAGE NUMBER MASK
CSTMBS   EQU      BT31TO0+32        BIT 0 (ON)
CSTMBR   EQU      NB31TO0+32        BIT 0 (OFF)
*
*  REFS FOR TPQ2 OVERLAY
*
         REF      TQOV2SEG          OVERLAY NAME
         REF      TQ:ABORT#         ENTRY TO ABORT USER
         REF      TQ:UNLOCK#        ENTRY FOR UNLOCK CALL
         REF      TQ:PURGE#         ENTRY FOR PURGE CALL
         REF      TQ:LOCK#          ENTRY FOR LOCK CALL
         REF      TQ:AUTH#          ENTRY FOR :FAUTH AUTHORIZATION
*,*                                 CHECK
*
         DEF      TPQ1:             XDELTA SYMBOL
TPQ1:    EQU      %
*
         PAGE
*
TQOVLY1  EQU      %
         AI,R0    OVLY              BRANCH TABLE ADDRESS
         B        *R0               ENTER OVERLAY
OVLY     EQU      %
         B        TQUEUE            ENTRY FOR M:QUEUE CAL PROCESSING
         B        TQRETURN2         POST ECB AND RETURN TO USER
         B        TQCALLNEWQ        READ OR WRITE QUEUE BLOCKS
         B        TQMOVLY           TQMOVE ENTRY
         PAGE
*DO*
*D*
*        NAME:    TQUEUE, SYSTEM QUEUE MANAGER CAL PROCESSING
*
*        CALL:    OVERLAY CALL FROM ALTCP
*
*        INPUT:   R5 = JIT ADDRESS
*                 R6 = WORD 0 OF THE FPT
*                 R7 = ADDRESS OF WORD 1 OF THE FPT
*                 SR1 = FPT CODE
*                 SR4 = MONITOR RETURN ADDRESS
*
*        OUTPUT:  CONDITION CODES = 0, SUCCESSFUL REQUEST
*                                 = 8, UNSUCCESSFUL REQUEST
*                                 = 4, ECB WAIT IS MEANINGFUL
*
*                 IF THE C. C. = 8, SR3 CONTAINS THE ABNORMAL CODE
*                                   IN BITS 0-14.
*
*                 IF THE C. C. = 4, THE ECB WILL BE POSTED WHEN THIS
*                                   REQUEST MAY BE RE-ISSUED.
*
*                 ECB COMPLETION CODES:
*
*                     X'02' = NORMAL RETURN (FOR A GET REQUEST, THE
*                             CAL MAY NOW BE REISSUED).
*
*                     X'01' = A QUEUE MESSAGE HAS BEEN PLACED IN THE
*                             USER'S BUFFER (POSTED ON GET REQUEST
*                             ONLY).
*
*                     X'0F' = ABNORMAL RETURN (THE ABNORMAL CODE IS
*                             CONTAINED IN REGISTER SR3).
*
*        DESCRIPTION:  TQUEUE MAKES THE INITIAL CHECKS FOR TP
*                 AUTHORIZATION, QUEUE UNLOCKED (I. E. OPEN FOR
*                 PROCESSING), OR QUEUE BUSY.  IF THE USER DOES NOT
*                 HAVE TP AUTHORIZATION, HE IS ABORTED.  FOR THE
*                 OTHER CASES, THE USER IS EITHER PLACED IN THE WAIT
*                 STATE UNTIL THE QUEUE BECOMES AVAILABLE (WAIT
*                 SPECIFIED), GIVEN THE ECB WAIT MEANINGFUL RETURN
*                 (THE ECB IS POSTED WHEN THE QUEUE BECOMES AVAIL-
*                 ABLE), OR GIVEN AN ABNORMAL CODE (NEITHER WAIT
*                 NOR ECB SPECIFIED).
*
*                 IF THE QUEUE IS AVAILABLE, IT IS SET BUSY, AND
*                 THE QUEUE MANAGER PASSES CONTROL TO THE SPECIFIC
*                 REQUEST LOGIC BASED ON THE FPT CODE.
*
*FIN*
*                 QUEUE MANAGER STANDARD SUBROUTINE VOLATILE
*                 REGISTERS:  R0-R5;D3-D4
*                 EXCEPTIONS NOTED AS REQUIRED
TQUEUE   EQU      %                 ENTRY FROM CAL PROCESSOR
         PUSH     SR4
         PUSH     7,R5              SAVE ENTRY REGS
         LW,R2    TSTACK
         PUSH     R2
         T,R3     TP                TEST IF VALID TP USER
         BNEZ     TQENT10           YES, PROCEED
*
*        CHECK AUTHORIZATION OF THIS USER
*
         OVERLAY  TQOV2SEG,TQ:AUTH# CHECK USER AUTHORIZATION
*
*
TQENT10  EQU      %
         LI,D2    -1                SET ACKNOWLEDGE WAIT OPTION
         CI,SR1   QUNLOCK           IS THIS AN UNLOCK REQUEST
         BNE      TQUEUE1           NO
         T,R2     Q:PAUSE
         BEZ      TQENT10A
         RESETI,R2  Q:PAUSE
TQENT1B  EQU      %
         L,SR1    Q:TID
         B        TQRETURN
TQENT10A EQU      %
*
         TBIT,R2  Q:LOCK            TEST QUEUE LOCKED
         BNEZ     TQENT1B           NO, GET TID AND RETURN
TQENT12  EQU      %
         MTBYTE,0,R2 Q:OWN          CHECK OWNER # ALREADY IN TTP
         BEZ      TQUNLOCK          NO, UNLOCK THE QUEUE
         LI,R4    QRTYPE            RESOURCE=QUEUE
         LI,R5    QABN01
*E*
*E*      ERROR:  BC01 TP SERVICE REQUESTED IS ILLEGAL FOR THIS USER
*E*      DESCRIPTION:  UNLOCK REQUEST WITH QUEUE UNLOCKED
*E*
         BAL,SR4  TQCKW#ECB         CHECK WAIT OR ECB OPTION
         B        TQENT12
TQUEUE1  EQU      %
         TBIT,R3  Q:LOCK            TEST FOR QUEUE UNLOCKED
         BNEZ     TQUEUE1B          YES, PROCEED
         CI,SR1   QLOCK             LOCKING A LOCKED QUEUE
         BNE      TQUEUE1A1
         LI,D2    0                 YES, IGNORE WAIT OPTION
TQUEUE1A1 EQU     %
         LI,R5    QABN11            NO, CHECK WAIT OR ECB
*E*
*E*      ERROR:  BC11 QUEUE LOCKED
*E*
TQUEUE1A EQU      %
         LI,R4    QRTYPE            RESOURCE=QUEUE
         BAL,SR4  TQCKW#ECB
*
*
TQUEUE1B EQU      %
         T,R3     Q:PAUSE
         BNEZ     TQUEUE1C
         L,R3     Q:USR             TEST FOR QUEUE IN USE BY ANOTHER USER
         BEZ      TQUEUE2           NO
         CW,R3    S:CUN             IS IT IN USE FOR CURRENT USER
         BE       TQUEUE2           YES, PROCEED
TQUEUE1C EQU      %
         LI,R5    QABN17            YES, CHECK WAIT OR ECB
*E*
*E*      ERROR:  BC17 QUEUE BUSY
*E*
         B        TQUEUE1A
*
TQUEUE2  EQU      %
         LW,R2    S:CUN
         TBIT,R3  Q:RCV             TEST RECOVERY MODE
         BEZ      TQUEUE2X1
         CBYTE,R2,R1 Q:OWN
         BNE      TQUEUE1C
TQUEUE2X1 EQU     %
         ST,R2    Q:USR             STORE USER # IN TTP
         RESETI,R2  Q:SR1           RESET RETURN PARAMETER
         LI,R2    -QFPTSET          ENTER FPT CODE SPECIFIC LOGIC
         AW,R2    SR1               VERIFY FPT CODE
*E*
*E*      ERROR:  BC01 TP SERVICE REQUESTED IS ILLEGAL FOR THIS USER
*E*      DESCRIPTION:  INVALID FPT CODE
*E*
         BLZ      TQENT05           ERROR
         CI,R2    QFPTMAX           CHECK MAX
         BG       TQENT05
         DO       QSIM=0
         PUSH     R6
         LI,R5    CFU#NOU(I)
         L,R6     Q:CFU             CHECK # USERS TO MAKE SURE FILE IS
*                                   STILL OPEN
         LW,D4    MASKS+CFU#NOU(M)
         SLS,D4   31-CFU#NOU(D)
         BAL,R0   TQGETFIELD
         BEZ      TQUEUE2B
         PULL     R6
         FIN
         CI,SR1   QGET              CHECK PTR IN REGISTER
         BE       TQUEUE2X2
         CI,SR1   QPURGE
         BE       TQUEUE2X2
         CI,R6    16
         BGE      TQUEUE2X2
         AW,R6    J:BASE            ADJUST PTR TO TSTACK AREA
TQUEUE2X2 EQU     %
         EXU      TQUEUE2A,R2       TO SPECIFIC REQUEST LOGIC
*
TQUEUE2A EQU      %
*
         B        TQDEFINE
         B        TQPUT
         B        TQGET
         B        TQSTATS
         B        TQPURGE1
         B        TQLOCK
TQUEUE2B EQU      %
         PULL     R6
         B        TQUEUE1A1
*
TQUNLOCK OVERTO   TQOV2SEG,TQ:UNLOCK#
TQPURGE1 OVERTO   TQOV2SEG,TQ:PURGE#
TQLOCK   OVERTO   TQOV2SEG,TQ:LOCK#
TQENT05  EQU      %                 USER ABORT INDICATED
         LI,R5    QABN01            SET ILLEGAL QUEUE REQUEST
TQENT06  EQU      %
         LW,R6    S:CUN             CURRENT USER
         LI,R4    QCCNO             CONDITION CODES
         OVERTO   TQOV2SEG,TQ:ABORT#   TRIGGER STEP ABORT...
*                                      NO RETURN FROM TQABORT
         PAGE
*************************************************************
*DO*
*D*
*        NAME:    TQDEFINE, DEFINE A USER'S GET LIST
*
*        INPUT:   R6 = LIST ADDRESS
*                 R7 = ADDRESS OF FPT WORD 1
*
*                 PROCEDURE SYNTAX:
*
*                    M:QUEUE  (*)LIST-ADDR,DEFINELIST,((OPTION))...
*
*                    OPTIONS FOR DEFINELIST ARE:
*
*                      LSIZE,(*)VALUE    SPECIFIES THE LIST SIZE
*
*                      WAIT              SPECIFIES THAT THE CALLER
*                                        WISHES TO WAIT FOR ACCESS
*                                        TO THE QUEUE BEFORE RE-
*                                        SUMING EXECUTION.
*
*                      ECB,(*)ADDRESS    SPECIFIES THE ADDRESS OF AN
*                                        ECB TO BE POSTED WHEN A QUEUE
*                                        EVENT OCCURS.
*
*
*                 FPT FORMAT:
*
*                         --------------------------------------
*                 WORD 0  |*| X'07'  |       | LIST ADDRESS    |
*                         --------------------------------------
*
*                         --------------------------------------
*                 WORD 1  |P1|P2|                       |F1|   |
*                         --------------------------------------
*
         PAGE
*                         OPTION ECB (P1)
*                         --------------------------------------
*                         |*|                |  ECB ADDRESS    |
*                         --------------------------------------
*
*                         OPTION LSIZE (P2)
*                         --------------------------------------
*                         |*|                |  LIST SIZE      |
*                         --------------------------------------
*
*                         F1 = 1 FOR WAIT OPTION
*
*                 GET LIST FORMAT:
*
*
*                         --------------------------------------
*                         | LENGTH | BYTE ADDR. OF CRITERION   |
*                         --------------------------------------
*                                          .
*                                          .
*                                          .
*                         --------------------------------------
*                         | LENGTH | BYTE ADDR. OF CRITERION   |
*                         --------------------------------------
*
*                         THE CRITERION IS GIVEN IN TEXT FORMAT
*                         WITH NAME SEGMENTS SEPARATED BY PERIODS
*                         AND IS FOLLOWED BY A FLAG BYTE.  AT
*                         LEAST ONE PERIOD MUST APPEAR IN THE
*                         NAME.
*
         PAGE
*                         FLAG BYTE:     01234567
*                                       ----------
*                                       |0DF00000|
*                                       ----------
*
*                                   WHERE  F = 1, IF FAILED ENTRIES
*                                                 ARE ACCEPTABLE.
*
*                                          D = 1, IF DESTRUCTIVE
*                                                 READOUT.
*
*                                          0 INDICATES NOT USED BY THE
*                                            QUEUE MANAGER.
*
*
*        OUTPUT:  SR1 = FOUR DIGIT HEXADECIMAL LIST ID
*
*
*        DESCRIPTION:  THE ADDRESS OF THE GET LIST AND ALL THE
*                 ADDRESSES WITHIN THE LIST ARE VALIDITY CHECKED.
*                 THE REAL PAGE(S) CONTAINING THE LIST AND THE
*                 CRITERIA NAME STRINGS ARE OBTAINED AND LOCKED
*                 IN MEMORY.  THE PAGE NUMBERS ARE STORED ALONG WITH
*                 THE USER ID INTO A QLIST ENTRY WITHIN THE PHYSICAL
*                 WORK PAGE CONTAINING QUEUE PROCESSING PARAMETERS.
*                 THE LIST IS THEN CHAINED ONTO THE INACTIVE GET
*                 LIST CHAIN.  IT WILL REMAIN ON THE INACTIVE CHAIN
*                 UNTIL A GET IS ISSUED SPECIFYING THIS LIST ID WHICH
*                 CANNOT BE IMMEDIATELY SATISFIED; OR UNTIL A QUEUE
*                 PURGE OF THE LIST IS REQUESTED BY THE USER OR BY
*                 JOB STEP TERMINATION.
*
*FIN*
*************************************************************
*                                   R6 = POINTER TO GET LIST
*                                   R7 = POINTER TO FPT WORD 1
*                                   D1 = PTR TO QLIST
TQDEFINE EQU      %
         AND,R6   CSTMAD
         BAL,R0   TQGETQLIST        GET CORE SPACE FOR A QLIST
         BAL,R0   TQGETMPOOL        GET AN MPOOL FOR QLIST IMAGE
TQDEFINE2 EQU     %
         LW,D2    D3
         PUSH     2,D1
         PUSH     2,R7
         PUSH     D3
         LW,R5    R6                VERIFY LIST POINTER ADDRESS
         BAL,R0   TQVERIFYR
         LW,SR1   SR3
         BAL,SR4  APWP              LOCK LIST PAGE
         CI,SR3   0
*E*
*E*      ERROR:  BC10 BAD MEMORY ADDRESS
*E*      DESCRIPTION:  ERROR RETURN FROM APWP TRYING TO LOCK THIS
*E*               PAGE IN MEMORY.
*E*
         BNE      TQABN10
         PULL     D3
         ST,SR1,R1 QLINX,*D3        RECORD PAGES IN QLIST
         LW,SR1   R6                KEEP VIRTUAL CORRESPONDENCE
         SLS,SR1  -9
         AND,SR1  MASKS+11
         ST,SR1,R1 QLINXV,*D3
         SBIT,R3,R1 QLLCP,*D3
         LI,R3    1
         ST,R3,R1 QLNCP,*D3
         SADR,R6,R1 QLGETLIST,*D3   SAVE LIST POINTER
         LW,R2    S:CUN
         ST,R2,R1 QLUSR,*D3         USER NUMBER
         LW,R5    D3
         PULL     2,R7
         BAL,R2   TQCHKBIT1
         B        %+1               IGNORE ECB
TQDEFINE4 EQU     %
         BAL,R2   TQCHKBIT          GET SIZE OF THE LIST
*E*
*E*      ERROR:  BC13 ERROR IN PRESENTED LIST FOR PUT,DEFINE OR STATS
*E*      DESCRIPTION:  DEFINELIST SIZE NOT SPECIFIED
*E*
         B        TQABN13           NOT GIVEN
         SHW,D3,R1 QLGETLISTSZ,*R5
         GET,SR1    Q:LID           ASSIGN A LIST ID
         ST,SR1,R1 QLID,*R5
         PULL     2,D1              D1 = PHYSICAL SPACE VIA COREALLOC
         LI,R3    QLISTLGTH*4       D2 = MPOOL
         BAL,R0   TQCALLMOVE12
         AND,R6   CSTMAP
         PUSH     D1
         PUSH     SR1
         AI,SR1   1
         ST,SR1    Q:LID            UPDATE LIST ID IN TTP
         L,R1,R3 QLGETLISTSZ,*D2
         BAL,R0   TQVERIFY          VERIFY LIST PTRS
         PULL     SR1               LIST ID
         PULL     D1
         LW,SR2   D1
         DO1      QLCHAIN(I)]=0
         AI,SR2   QLCHAIN(I)
         LI,R5    Q:DEF(A)          CHAIN ON INACTIVE GET LISTS
         BAL,R0   TQCHAIN
         B        TQRETURN
         SPACE    6
TQGETCHAIN EQU    %
         LI,R5    QCHAIN(I)
         BAL,R0   TQLOADF
         B        *R2
         PAGE
*DO*
*D*
*        NAME:    TQPUT, INSERT, DELETE, OR CHANGE THE STATUS OF
*                        QUEUE ENTRIES.
*
*        INPUT:   R6 = LIST ADDRESS
*                 R7 = ADDRESS OF FPT WORD 1
*
*                 PROCEDURE SYNTAX:
*
*                    M:QUEUE   (*)LIST-ADDR,PUT,((OPTION))...
*
*                    OPTIONS FOR PUT ARE:
*
*                      LSIZE,(*)VALUE     SPECIFIES THE LIST SIZE
*
*                      WAIT               SPECIFIES THAT THE CALLER
*                                         WISHES TO WAIT FOR ACCESS
*                                         TO THE QUEUE BEFORE RE-
*                                         SUMING EXECUTION.
*
*                      HIGH               SPECIFIES A HIGH PRIORITY
*                                         PUT REQUEST.
*
*                      ECB,(*)ADDRESS     SPECIFIES THE ADDRESS OF AN
*                                         ECB TO BE POSTED WHEN A QUEUE
*                                         EVENT OCCURS.
*
*
*                 FPT FORMAT:
*
*                         ---------------------------------------
*                 WORD 0  |*| X'08'  |       |  LIST ADDRESS    |
*                         ---------------------------------------
*
         PAGE
*                         ---------------------------------------
*                 WORD 1  |P1|P2|                     |F2|F1|   |
*                         ---------------------------------------
*
*                         OPTION ECB (P1)
*                         ---------------------------------------
*                         |*|                |  ECB ADDRESS     |
*                         ---------------------------------------
*
*                         OPTION LSIZE (P2)
*                         ---------------------------------------
*                         |*|                |  LIST SIZE       |
*                         ---------------------------------------
*
*                         F1 = 1 FOR WAIT OPTION
*
*                         F2 = 1 FOR HIGH PRIORITY PUT REQUEST
*
*
*                 PUT LIST FORMAT:
*
*
*                         ---------------------------------------
*                         | FLAGS | WORD ADDR OF PUT MESSAGE    |
*                         ---------------------------------------
*                                           .
*                                           .
*                                           .
*                         ---------------------------------------
*                         | FLAGS | WORD ADDR OF PUT MESSAGE    |
*                         ---------------------------------------
         PAGE
*
*                       FLAGS:  0 1 2 3 4 5 6 7
*                               Q X F P J J J J
*                               0 0 0 1 = DELETE IN-PROGRESS ENTRY
*                               0 1 0 1 = DELETE SPECIAL BYPASS ENTRY
*                               1 1 0 0 = INSERT SPECIAL BYPASS ENTRY
*                               1 0 0 0 = INSERT A NEW ENTRY
*                               1 0 1 1 = MARK AN ENTRY FAILED
*                               1 0 0 1 = MARK AN IN-PROGRESS ENTRY
*                                         AS NO LONGER IN-PROGRESS
*                               1 0 1 0 = INSERT A PRE-FAILED ENTRY
*                                         INTO THE QUEUE
*
*                                   X = SPECIAL BYPASS FLAG
*                                   J = JOURNALIZATION FLAGS (CARRIED
*                                       IN THE QUEUE BUT IGNORED BY
*                                       THE QUEUE MANAGER)
*                 PUT MESSAGE FORMAT:
*
*
*                         ---------------------------------------
*                 WORD 0  | STATUS |         |   RECORD LENGTH  |
*                         ---------------------------------------
*                                            .
*                                            .
*                         ---------------------------------------
*                 WORD 5  | TEXT LENGTH      |        |NAME LNG |
*                         ---------------------------------------
*
*                         ---------------------------------------
*                 WORD 6  |          ENTRY  NAME                |
*                         |             (TEXT)                  |
*                         |                                     |
*                         ---------------------------------------
         PAGE
*
*                         ---------------------------------------
*                 WORD 14 |          ENTRY  TEXT                |
*                         |             (TEXT)                  |
*                         |                                     |
*                         |                                     |
*                         .                                     .
*                         .                                     .
*                         |                                     |
*                         ---------------------------------------
*
*
*        OUTPUT:  ON AN ABNORMAL RETURN (COND. CODES = 8), SR1 = THE
*                 DISPLACEMENT WITHIN THE PUT LIST TO THE ERRONEOUS
*                 ENTRY.
*
*
*        DESCRIPTION:  THE QUEUE PUT PROCESS DETERMINES THE AVAILA-
*                 BILITY AND ACCESSIBILITY OF THE QUEUE FOR THE
*                 CALLING PROGRAM, AND VERIFIES THE ADDRESSES
*                 WITHIN THE PUT LIST.  IF CORE OR DISK SPACE IS
*                 NOT AVAILABLE, THE TASK MAY BE WAITED OR MAY
*                 RECEIVE NOTIFICATION OF 'SPACE AVAILABILITY' VIA
*                 THE ECB.  IF NEITHER WAIT OR ECB IS SPECIFIED,
*                 THE TASK IS GIVEN A 'SPACE NOT AVAILABLE' ABNORMAL.
*
*                 THE FLAGS IN THE PUT LIST PROVIDE OPTIONS TO
*
*                                   . DELETE AN EXISTING ENTRY
*                                   . ENTER A NEW ENTRY
*                                   . MARK AN EXISTING ENTRY FAILED
*                                   . MARK AN IN-PROGRESS ENTRY
*                                     AS NO LONGER IN PROGRESS
*
*                 THE INSERT PROCESS SEARCHES FOR AN INDEX BLOCK
*                 WITH SPACE AVAILABLE FOR THE KEY (OR ITS LOCATION
*                 IF ENTRIES ALREADY EXIST FOR THAT KEY); AND FOR
*                 A DATA BLOCK WITH SPACE AVAILABLE FOR THE TEXT.
*                 THE TEXT IS THEN INSERTED INTO THE QUEUE, AND THE
*                 INDEX IS EITHER INSERTED OR UPDATED TO REFLECT
*                 THE NEW ENTRY.  THE QUEUE CONTROL BLOCK STATISTICS
*                 ARE UPDATED TO REFLECT THE INSERTIONS.
*
*                 EACH TIME A PUT MESSAGE IS INSERTED IN THE QUEUE,
*                 THE ACTIVE GET LISTS ARE EXAMINED FOR A CRITERION
*                 WHICH MATCHES IT.  IF AN OUTSTANDING GET IS FOUND,
*                 THAT USER'S ECB IS POSTED SO THE GET MAY BE RE-
*                 ISSUED AT THE CONCLUSION OF THIS PUT REQUEST.
*
*                 THE PUT OPERATION IS COMPLETELY PROCESSED PRIOR
*                 TO THE RETURN TO THE CALLING PROGRAM.  IF BACKUP
*                 WAS SPECIFIED, ALL THE MODIFIED IN-CORE BLOCKS
*                 ARE WRITTEN TO THE QUEUE DISK FILE.
*
*
*FIN*
*
TQPUT    EQU      %
*                                   PUT OR CHANGE STATUS
         PUSH     2,R6
         TBIT,R2  QHIGH,R7          CHECK REQUEST PRIORITY
         BNEZ     TQPUT2            HIGH, PROCEED
         GET,SR2,R1 Q:SAT           SPECIFIED SATURATION %
         BEZ      TQPUT2            NONE
         GET,R6   Q:CONT            GET     CURRENT LEVEL
         LI,R5    CONTSATB(I)
         BAL,R0   TQGETBYTE
         CW,D4    SR2
*E*
*E*      ERROR:  BC07 QUEUE SATURATED
*E*      DESCRIPTION:  LOW PRIORITY PUT WITH QUEUE AT SATURATION
*E*               LEVEL
*E*
         BGE      TQABN07
TQPUT2   EQU      %
         PULL     2,R6              RETRIEVE & SAVE LIST, FPT PTRS
         BAL,R2   TQCHKBIT1         GET LIST SIZE
         B        %+1
         BAL,R2   TQCHKBIT
*E*
*E*      ERROR:  BC13 ERROR IN PRESENTED LIST FOR PUT,DEFINE OR STATS
*E*      DESCRIPTION:  PUT LIST SIZE NOT SPECIFIED
*E*
         B        TQABN13           SIZE ABSENT
         LW,R1    D3
         OR,R6    YC                INDICATE PUT FOR VERIFY
         LW,R5    R6
         BAL,R0   TQVERIFYR         VERIFY LIST POINTER
         PUSH     2,R6
         PUSH     R6
         PUSH     R1
         BAL,R0   TQVERIFY          VERIFY REMAINING PTRS & SPANNED PAGES
         PULL     R1
         PULL     R6
         LW,R2    R1                LIST SIZE
TQPUT4   EQU      %
         BAL,R0   TQGETMPOOL
         LW,R7    D3                MPOOL ADDRESS
         PUSH     R2
         PUSH     R6
         LCF      *R6               PUT TYPE
         STCF     R7
         LW,R6    *R6               MESSAGE PTR
         STW,R6   QPOOLLST(I),R7
         L,R2,R1  QPUTL,*R6
         BAL,R1   TQGETNIDA         GET LENGTH & DISPLACEMENT OF
*                                   NID SEGMENT
         LC       R7
         BCS,8    TQPUT8            INSERT OR ALTER STATUS REQUEST
*E*
*E*      ERROR:  BC13 ERROR IN PRESENTED LIST FOR PUT,DEFINE OR STATS
*E*      DESCRIPTION:  UNRECOGNIZED PUT FLAGS
*E*
         BCR,1    TQABN13           UNRECOGNIZABLE REQUEST
         BCS,4    TQALLOW           SPECIAL BYPASS REMOVAL FLAG
         BAL,R3   TQDELENT          DELETE REQUEST
*E*
*E*      ERROR:  BC14 ENTRY NOT FOUND FOR A QUEUE REQUEST REQUIRING
*E*               AN EXISTING ENTRY
*E*      DESCRIPTION:  PUT DELETE REQUEST FOR A NON-EXISTENT ENTRY
*E*
         BCS,1    TQABN14           DELETE FOR NON-EXISTING ENTRY
         LI,R4    2
         LCFI     1
         BAL,R0   TQSETBLOCK        DECREMENT # ENTRIES IN-PROGRESS
TQPUT6   EQU      %
         PULL     R6
         PULL     R2
         AI,R6    1                 STEP TO NEXT LIST ENTRY
         MTW,1    Q:SR1(A)          INCREMENT DISPLACEMENT
         BDR,R2   TQPUT4
         B        TQPUT26
TQPUT8   EQU      %
         BCR,1    TQPUT14           INSERT REQUEST
*                                   STATUS CHANGE REQUEST
         STCF     R6
         BAL,R3   TQFAILURE         MARK ENTRY FAILED OR NO LONGER
*                                   IN PROGRESS
         BCR,1    TQPUT6            GET NEXT LIST ENTRY
*E*
*E*      ERROR:  BC14 ENTRY NOT FOUND FOR A QUEUE REQUEST REQUIRING
*E*               AN EXISTING ENTRY
*E*      DESCRIPTION:  PUT FAILURE REQUEST FOR A NON-EXISTENT ENTRY
*E*
         B        TQABN14           ABNORMAL EXIT
TQPUT14  EQU      %
         LHW,SR3,R1 QPUTLT,*R6      # BYTES IN ENTRY TEXT
         STW,SR3     QPOOLLTCNT(I),R7 SAVE FOR MAP UPDATE
         AI,R2    1+3               ADD COUNT BYTE AND
         AND,R2   XFFFFFC           ROUND UP TO WD BOUNDARY
         AW,SR3   R2                ADD TO TEXT SIZE
         AI,SR3   2+QDATACSZ-1+7    ADD COUNT BYTES, CONTROL INFO AND
         SLS,SR3  -3                ROUND UP TO #DWS IN ENTRY
         STW,SR3  QPOOLPUTDW(I),R7
         CI,SR3   254
*E*
*E*      ERROR:  BC10 BAD MEMORY ADDRESS
*E*      DESCRIPTION:  TRANSACTION MESSAGE TOO LARGE
*E*
         BG       TQABN10           PUT MSG TOO LARGE
         LW,R3    R6
         LI,R4    0
         BAL,SR4  TQSEARCH          LOCATE KEY OR SPACE FOR THE KEY
         CI,R4    0
*E*
*E*      ERROR:  BC07 QUEUE SATURATED
*E*      DESCRIPTION:  NOT ENOUGH SPACE IN THE QUEUE FOR THIS KEY
*E*
         BE       TQABN07A          NO SPACE FOR KEY
         STW,SR1  QPOOLI(I),R7
         LW,R6    SR1               PTR TO INDEX BLOCK
         AND,R6   CSTPGE
         LI,R5    INDEXBLOCK(I)
         BAL,R0   TQLOADF
         STW,D3   QPOOLIBLK(I),R7
         LW,D2    SR1               SET MOVE PARAMETERS
         LW,D1    R7
         AI,D1    QPOOLIMAGEI(I)
         LI,R3    QINXCSZ*4         # BYTES TO MOVE
         BAL,R0   TQCALLMOVE12
         LW,R3    QPOOLPUTDW(I),R7
         LI,R4    1
         LI,D3    QDATANAV
         BAL,SR4  TQSCANCONTROL
*E*
*E*      ERROR:  BC07 QUEUE SATURATED
*E*      DESCRIPTION:  NOT ENOUGH SPACE IN THE QUEUE FOR THE TEXT
*E*
         BCS,8    TQABN07A          SPACE NOT AVAIL
         STW,SR1  QPOOLDMAP(I),R7
         STW,SR2  QPOOLDBLK(I),R7
         STW,R5   QPOOLMD(I),R7
         LW,R5    QPOOLDMAP(I),R7
         LW,R6    QPOOLMD(I),R7
         BAL,R0   TQGETHWORD        DISPLACEMENT WITHIN DATA BLOCK
*                                   TO ADD THE TEXT
         LW,R3    D4
         AND,R3   MASKS+8
         BNEZ     TQPUT18A
         LI,R3    QDATAENTSTD
         LI,D2    0
         B        TQPUT18B
TQPUT18A EQU      %
         LI,D2    -1
         AI,R3    QDATAENTSTD
TQPUT18B EQU      %
         SLS,R3   1
         ST,R3       QPOOLD,R7
         LI,R4    2
         BAL,SR4  TQFETCH           RETURNS DATA BLK ADDRESS IN SR1
         AW,SR1   QPOOLD(I),R7      FORM ENTRY BASE
         STW,SR1  QPOOLD(I),R7
         LW,R6    R7                MPOOL IMAGE FOR FORMING TEXT HDR
         AI,R6    QPOOLIMAGED(I)
         GET,R4   QPOOLENT,R7       INDEX BLOCK ENTRY NUMBER
         SBYTE,R4     DATAENTRY#R,*R6
         GET,R4   QPOOLIBLK,R7
         SADR,R4  DATAINDEXR,R6
         GET,R4   QPOOLNIDC,R7
         SBYTE,R4,R1 DATANAMECNTR,*R6 NID SIZE
         LB,R4    R7                SET ENTRY STATUS BYTE
         OR,R4    QFLAGQ(M)
         SBYTE,R4,R1 DATASTATUSR,*R6
         PUSH     R4
         LI,R3    QDATACSZ
         L,D1     QPOOLD,R7
         LW,D2    R6
         BAL,R0   TQCALLMOVE12
         LW,D1    D4
         L,D2     QPOOLLST,R7       GET MSG PTR FOR TEXT AND NAME
         AI,D2    QGETTEXT(I)
         SLS,D2   2
         AW,D2    QPOOLNIDD(I),R7
         LWORD,R3 QPOOLNIDC,R7
         BAL,R0   TQCALLMOVE9
         CI,R3    8
*E*
*E*      ERROR:  BC10 BAD MEMORY ADDRESS
*E*      DESCRIPTION:  TRANSACTION NAME DOES NOT HAVE TID APPENDED
*E*
         BLZ      TQABN10
         AW,R3    D2
         LI,R2    8
TQPUT18C EQU      %
         AI,R3    -1
         LB,D1    0,R3
         CI,D1    X'10'
         BANZ     %+2
         AI,D1    9
         SLD,D1   -4
         BDR,R2   TQPUT18C
         LW,SR3   D2                TID FOR CONTROL BLOCK 1
         LI,R3    2
         LW,R6    QPOOLLTCNT(I),R7  TEXT COUNT
         LI,D2    R6*4+2
         LW,D1    D4
         AI,D1    3
         AND,D1   XFFFFFC
         BAL,R0   TQCALLMOVE13
         LW,D1    D4                FOR MOVING TEXT BODY
         LW,D2    QPOOLLST(I),R7
         AI,D2    QPUTTXT(I)
         SLS,D2   2
         LW,R3    R6
         BAL,R0   TQCALLMOVE9
         LW,D3    QPOOLPUTDW(I),R7
         LI,R4    3
         L,R6     QPOOLMD,R7
         L,R5     QPOOLDMAP,R7
         BAL,R0   TQSETMAP
         LW,R6    QPOOLD(I),R7
         BAL,R1   TQSETWRITE        SET WRITE REQUIRED FLAG
         L,D3      QPOOLDBLK,R7     DATA BLOCK NUMBER
         LW,D4    CSTMAP
         LW,R6    R7
         AI,R6    QPOOLIMAGEI(I)    UPDATE TAIL TEXT BLOCK
*                                   MAP CONTENT IN D4,
         L,SR2    INDEXTTXTR,R6     DATA TAIL PTR
         BEZ      TQPUT20           1ST ENTRY THIS NAME
         PUSH     R6
         CW,SR2   QPOOLDBLK(I),R7
         BE       TQPUT19           IN SAME BLOCK
         LI,SR4   2                 BLOCK TYPE
         BAL,R0   TQSEARCHC         FETCH BACKWARD BLOCK
TQPUT19 EQU       %
         PUSH     SR3
         LI,SR3   0
         AND,SR1  CSTPGE
         BAL,R0   TQSEARCHD
         PULL     SR3
         CW,R6    QPOOLD(I),R7
         BNE      TQPUT19A          NOT THE CURRENT ENTRY
         CW,SR2   QPOOLDBLK(I),R7
         BE       TQPUT19A1         THIS IS THE CURRENT ENTRY, DOESNT
*                                   COUNT AS ONE WE WANT
TQPUT19A EQU      %
         LI,R5    DATAFLINKR(I)
         BAL,R0   TQLOADF
         BEZ      TQPUT19B
TQPUT19A1 EQU     %
         BAL,R0   TQSEARCHDP        CONTINUE SEARCH
         B        TQPUT19A
TQPUT19B EQU      %
         BAL,R1   TQSETWRITE        SET WRITE IN UPDATED DATA BLOCK
         LW,D3    QPOOLDBLK(I),R7
         BAL,R0   TQSTOREF
         PULL     R6
         B        TQPUT22
TQPUT20  EQU      %
         ST,D3    INDEXHTXTR,R6     ADD NEW ENTRY AS HEAD ALSO
TQPUT22  EQU      %
         ST,D3    INDEXTTXTR,R6     MAKE NEW TEXT TAIL
         GET,D3    INDEXCOUNTR,R6   INCREMENT COUNT
         AI,D3    1
         ST,D3    INDEXCOUNTR,R6
         LI,R3    QINXCSZ*4         MOVE KEY DATA FROM MPOOL TO INDEX
         LW,D2    R6
         GET,D1    QPOOLI,R7
         BAL,R0   TQCALLMOVE12
         LW,R6    D1
         LC       R7                GET STATUS
         BCR,4    TQPUT23           NOT BYPASS, CONTINUE
         LB,R1    JB:PRIV           GET USER PRIVILEGE
         CI,R1    QPRIV
*E*
*E*      ERROR:   BC13 ERROR IN PRESENTED LIST FOR PUT,DEFINE OR STATS
*E*      DESCRIPTION:  USER DOES NOT HAVE ENOUGH PRIVILEGE TO DO A
*E*               PUT-BYPASS OPERATION.
*E*
         BL       TQABN13           NOT A VALID BYPASS REQUEST
         LI,R5    INDEXBYPASSR(I)
         LW,D3    INDEXBYPASSR(M)   SET TRANSACTION BYPASS
         LW,D4    D3
         BAL,R0   TQSETFIELD
TQPUT23  EQU      %
         BAL,R1   TQSETWRITE        SET WRITE FLAG
         LI,R4    1
         LCFI     0                 UPDATE CONTROL BLOCK 1
         BAL,R0   TQSETBLOCK
*                                   SR3 = NEW TID
         LC       R7                SET FAILED CTR ALSO FOR PREFAILED
         BCR,2    TQPUT24
         LCFI     2
         BAL,R0   TQSETBLOCK
TQPUT24  EQU      %
         LI,R3    0                 CHECK ACTIVE GETS
         PULL     R4                STATUS BYTE
         OR,R4    YC                INDICATE COMPARE GETS TO THIS PUT
         BAL,SR4  TQSEARCH
         B        TQPUT6            SELECT NEXT ENTRY FROM PUT LIST
*
TQPUT26  EQU      %
         LI,D2    7
*        WRITE ALL TYPES, IF BACKUP
         BAL,R0   TQIOCHAIN
         B        TQRETURN
*
TQALLOW  EQU      %                 REMOVE SPECIAL BYPASS FLAG
         LB,R2    JB:PRIV           GET USER PRIVILEGE
         CI,R2    QPRIV
*E*
*E*      ERROR:   BC13 ERROR IN PRESENTED LIST FOR PUT,DEFINE OR STATS
*E*      DESCRIPTION:  USER DOES NOT HAVE ENOUGH PRIVILEGE TO DO A
*E*               PUT-REMOVE BYPASS OPERATION.
*E*
         BL       TQABN13           NOT A VALID BYPASS REQUEST
         LI,R4    X'C0'             BYPASS STATUS
         LW,R3    R6                LIST ADDRESS
         BAL,SR4  TQSEARCH
         CI,R4    0
*E*
*E*      ERROR:   BC14 ENTRY NOT FOUND FOR A QUEUE REQUEST REQUIRING
*E*                 AN EXISTING ENTRY
*E*      DESCRIPTION:  REMOVE BYPASS REQUEST FOR A NON-EXISTING ENTRY.
*E*
         BEZ      TQABN14
         PUSH     6,R6
         LW,R6    QPOOLI(I),R7      A(KEY DATA)
         LI,R5    INDEXBYPASSR(I)   TURN OFF BYPASS FLAG IN INDEX
         LW,D4    INDEXBYPASSR(M)
         LI,D3    0
         BAL,R0   TQSETFIELD
         PULL     6,R6
         BAL,R3   TQDELETE          DELETE THIS QUEUE ENTRY
         LI,R4    X'80'             SET NORMAL STATUS FOR WAKE UP
         PUSH     R4                AND DING WAITING USERS
         B        TQPUT24           CHECK ACTIVE GET LISTS
*
         PAGE
*DO*
*D*
*        NAME:    TQGET, RETRIEVE A QUEUE ENTRY ASSOCIATED WITH A
*                        SPECIFIED CRITERION OR LIST OF CRITERIA.
*
*        INPUT:   R6 = LIST ID (OUTPUT FROM DEFINELIST)
*                 R7 = ADDRESS OF FPT WORD 1
*
*                 PROCEDURE SYNTAX:
*
*                    M:QUEUE   (*)LIST-ID,GET,((OPTION))...
*
*                    OPTIONS FOR GET ARE:
*
*                      BUF,(*)ADDRESS     SPECIFIES THE BUFFER ADDRESS
*                                         FOR RETURNING A QUEUE ENTRY.
*
*                      BSIZE,(*)VALUE     SPECIFIES THE SIZE OF THE
*                                         AREA DEFINED BY THE BUF
*                                         OPTION.
*
*                      WAIT               SPECIFIES THAT THE CALLER
*                                         WISHES TO WAIT FOR ACCESS TO
*                                         THE QUEUE PRIOR TO RESUMING
*                                         EXECUTION.
*
*                      ECB,(*)ADDRESS     SPECIFIES THE ADDRESS OF AN
*                                         ECB TO BE POSTED WHEN A QUEUE
*                                         EVENT OCCURS.
*
*                      INDEX,(*)VALUE     SPECIFIES THE WORD DISPLACE-
*                                         MENT WITHIN THE GET LIST TO
*                                         BEGIN THE SEARCH FOR A
*                                         CRITERIA MATCH.
*
         PAGE
*
*                 FPT FORMAT:
*
*                         ------------------------------------------
*                 WORD 0  |*| X'09'  |          |  LIST ID         |
*                         ------------------------------------------
*
*                         ------------------------------------------
*                 WORD 1  |P1|P2|P3|P4|                    |F1|    |
*                         ------------------------------------------
*
*                         OPTION ECB (P1)
*                         ------------------------------------------
*                         |*|                   |  ECB ADDRESS     |
*                         ------------------------------------------
*
*                         OPTION INDEX (P2)
*                         ------------------------------------------
*                         |*|                   |   VALUE          |
*                         ------------------------------------------
*
*                         OPTION BUF (P3)
*                         ------------------------------------------
*                         |*|                   |  BUFFER ADDRESS  |
*                         ------------------------------------------
*
*                         OPTION BSIZE (P4)
*                         ------------------------------------------
*                         |*|                   |  BUFFER SIZE     |
*                         ------------------------------------------
*
*                         F1 = 1 FOR WAIT OPTION
*
         PAGE
*
*        OUTPUT:  SR1 = WORD DISPLACEMENT WITHIN THE DEFINED LIST
*                       TO THE CRITERION FOR WHICH AN ENTRY HAS BEEN
*                       PLACED IN THE USER'S BUFFER.
*
*                 THE FORMAT OF THE GET MESSAGE IS THE SAME AS THAT
*                 DESCRIBED FOR THE PUT MESSAGE, EXCEPT THAT THE
*                 STATUS OF THE ENTRY IS PLACED IN BYTE 0 OF WORD 0.
*
*                 GET MESSAGE STATUS BYTE:
*
*                   0 1 2 3 4 5 6 7
*                   Q X F X J J J J
*
*                   WHERE:
*
*                      Q = QUEUED (ALWAYS SET)
*                      F = FAILED ENTRY
*                      J = JOURNALIZATION INDICATORS
*                      X = THIS BIT IS IGNORED
*
*
*        DESCRIPTION:  THE QUEUE IS SEARCHED FOR A CRITERIA MATCH AND
*                 IF FOUND, THE ENTRY IS GIVEN TO THE CALLER.  IF A
*                 MATCH IS NOT FOUND AND ECB IS SPECIFIED, THE GET
*                 LIST IS PLACED ON THE ACTIVE CHAIN FOR PROCESSING
*                 AFTER A PUT OPERATION.  IN THIS CASE THE RETURN
*                 IS MADE WITH THE CONDITION CODES SET TO INDICATE
*                 THAT AN ECB WAIT IS MEANINGFUL.
*
*                 IF NO ECB IS SPECIFIED AND A MATCH IS NOT FOUND,
*                 A BC-14 ABNORMAL CODE IS RETURNED TO THE USER.  NOTE
*                 THAT SPECIFYING 'WAIT' ON A GET REQUEST DOES NOT
*                 WAIT A USER UNTIL AN ENTRY MATCHING THE CRITERIA
*                 HAS BEEN PUT IN THE QUEUE.  (SUCH AN ENTRY MAY
*                 NEVER APPEAR.)
*
*                 NON-DESTRUCTIVE READOUT IS THE NORMAL MODE OF QUEUE
*                 PROCESSING.  HOWEVER, AN OPTION IS PROVIDED (SEE
*                 THE DESCRIPTION UNDER DEFINELIST PROCESSING) TO
*                 ALLOW A TASK TO DELETE THE QUEUE ENTRY AT THE TIME
*                 IT IS RETRIEVED.  ANOTHER OPTION SPECIFIES WHETHER
*                 'FAILED' ENTRIES ARE ACCEPTABLE.  THE FORMAT OF THE
*                 GET LIST IS DESCRIBED UNDER DEFINELIST PROCESSING.
*
*                 NOTE ALSO THAT THE DEFINELIST (WHICH ASSIGNS THE
*                 LIST ID) MUST BE ISSUED PRIOR TO THE FIRST GET
*                 REQUEST.  ONCE A LIST HAS BEEN DEFINED, GET'S
*                 MAY BE ISSUED AGAINST THAT LIST UNTIL IT IS DELETED
*                 VIA A 'PURGE' REQUEST.
*
*FIN*
*
TQGET    EQU      %                 RETRIEVE AN ENTRY FROM THE QUEUE
         SLS,R6   16
         PUSH     2,R6
         LI,R4    5                 TO SELECT INACTIVE GET
         LI,R2    -1
         PUSH     R7
         LI,R7    QLID(I)/2-QLCHAIN(I)
         LW,SR3   R6                LIST ID IS CRITERIA
         LI,SR4   -1                FULL WORD MASK
         BAL,R1   TQDCHC            SCAN CHAIN FOR THE LIST
*E*
*E*      ERROR:  BC20 QUEUE GET OR PURGE FOR NON-EXISTENT LIST
*E*      DESCRIPTION:  GET REQUEST FOR A NON-EXISTENT LIST
*E*
         BCS,1    TQABN20
         LW,R6    SR2               PTR TO QLIST
         PULL     R7
         LW,R4    CSTMBS            INDICATE GET FUNCTION
         BAL,R2   TQCHKBIT1
         B        TQGET1            ECB NOT GIVEN
         PUSH     R1
         LW,SR3   D3
         LI,SR2   0
         BAL,SR4  ECBINIT
         CI,SR3   2
*E*
*E*      ERROR:  BC13 ERROR IN PRESENTED LIST FOR PUT,DEFINE OR STATS
*E*      DESCRIPTION:  ERRONEOUS ECB SPECIFIED FOR GET
*E*
         BANZ     TQABN13
         LI,R5    QLECB(I)          SAVE ECB IN QLIST
         BAL,R0   TQSTOREF
         PULL     R1
TQGET1   EQU      %
         BAL,R2   TQCHKBIT          GET INDEX IF GIVEN
         B        TQGET2
         ST,D3    Q:SR1             SET DISPLACEMENT
         SLS,D3   16
         OR,R4    D3                STORE INDEX FOR SEARCH
TQGET2   EQU      %
         BAL,R2   TQCHKBIT          CHECK BFR
*E*
*E*      ERROR:  BC13 ERROR IN PRESENTED LIST FOR PUT,DEFINE OR STATS
*E*      DESCRIPTION:  BUFFER ADDRESS NOT SPECIFIED ON GET REQUEST
*E*
         B        TQABN13           NOT GIVEN
         BAL,R0   TQCKBFR           VALIDITY CHECK USER'S BUFFER
         BAL,R0   TQGETMPOOL
         LW,R7    D3
         LW,SR1   R6
         LI,R3    0
         BAL,SR4  TQSEARCH          SEARCH QUEUE FOR A MATCH
         CI,R4    0
         BNE      TQGET8            MATCH FOUND
         PULL     2,R6
*E*
*E*      ERROR:  BC14 ENTRY NOT FOUND FOR A QUEUE REQUEST REQUIRING
*E*               AN EXISTING ENTRY
*E*      DESCRIPTION:  ENTRY NOT FOUND FOR A GET WITH NO ECB
*E*               SPECIFIED
*E*
         LI,R5    QABN14
         LI,R4    QRTYPE4
         LI,D2    0
         B        TQCKW#ECB         ABNORMAL OR ECB WAIT
*                                   MEANINGFUL...NO RETURN
         SPACE    6
*                                   R2 = LIST DISPLACEMENT TO MATCH
*                                   R4 = FLAG BYTE
TQGET8   EQU      %
         PUSH     R2
         ST,R2    Q:SR1             SET LIST DISPLACEMENT
         LW,R6    QPOOLD(I),R7      DATA BLOCK PTR
         BAL,R2   TQTXTSZ           GET TEXT SIZE
         SLS,R5   1                 BYTE DISPLACEMENT TO TEXT SIZE
         AI,R5    2
         STW,R5   QPOOLNAME(I),R7
         STW,D4   QPOOLLTCNT(I),R7
         LI,R5    DATANAMECNTR(I)   GET NID SIZE
         BAL,R0   TQGETBYTE
         LW,D3    D4
         STW,D3   QPOOLNIDC(I),R7
         LI,R5    DATASTATUSR(I)    GET ENTRY STATUS
         BAL,R0   TQGETBYTE
         LW,R4    D4
         PUSH     R6
         LW,R6    QPOOLI(I),R7
         LI,R5    INDEXNAMESZR(I)
         BAL,R0   TQGETBYTE
         AW,D3    D4
         AI,D3    1
         LW,R2    D3
         PULL     R6
         LI,R5    QGETL(I)
         STB,R2   *SR2,R5           SR2 = PTR TO USER'S BFR
         LW,R3    QPOOLLTCNT(I),R7  TEXT LENGTH
         LI,R5    QGETLT(I)
         STH,R3   *SR2,R5
         AI,R3    56                # FILLER BYTES
         LI,R5    QPUTGETSZ(I)
         SLS,SR3  2                 BFR SIZE
         CW,R3    SR3
*E*
*E*      ERROR:  BC10 BAD MEMORY ADDRESS
*E*      DESCRIPTION:  BUFFER SIZE TOO SMALL FOR TRANSACTION
*E*
         BG       TQABN10
         STH,R3   *SR2,R5
         STB,R4   *SR2              ENTRY STATUS BYTE
         LW,R3    QPOOLNIDD(I),R7   NID DISPLACEMENT WITHIN NAME
         LI,R5    QGETTEXT(I)
         SLS,R5   2                 BYTE DISPLACEMENT TO NAME
         AW,R5    R3
         AI,R5    -1
         LI,R0    C'.'              INSERT SEPARATOR
         STB,R0   *SR2,R5
         AI,R5    1
         LW,D1    SR2               BFR PTR
         SLS,D1   2
         AW,D1    R5                DESTINATION FOR NID
         LW,R3    QPOOLNIDC(I),R7   SIZE OF NID FIELD
         SW,R2    R3
         AI,R2    -1
         BLEZ     TQERROR
         LW,D2    R6                ENTRY PTR
         SLS,D2   2
         AI,D2    DATANIDR(I)
         BAL,R0   TQCALLMOVE5       NID TO USER'S BFR
         LI,D1    QPUTTXT(I)        WORD DISPLACEMENT TO TEXT
         AW,D1    SR2               DESTINATION ADDRESS
         SLS,D1   2
         LW,D2    R6
         SLS,D2   2
         AW,D2    QPOOLNAME(I),R7
         LW,R3    QPOOLLTCNT(I),R7
         BAL,R0   TQCALLMOVE5       TEXT STRING TO BUFFER
         LW,D2    R7                GET 1ST NAME SEGMENT
         AI,D2    QPOOLIMAGED(I)
         LI,D1    QGETTEXT(I)
         AW,D1    SR2
         LW,R3    R2
         BAL,R0   TQCALLMOVE4
         LW,R1    QPOOLPUTDW(I),R7  CRITERIA SELECTION BYTE
         CW,R1    QFLAGD(M)
         BANZ     TQGET12           DELETE ENTRY FROM QUEUE
*                                   SET ENTRY STATUS = IN PROGRESS
         LW,D3    QFLAGP(M)
         OR,D3    R4
         LI,R5    DATASTATUSR(I)
         BAL,R0   TQSETBYTE
         LI,R4    1                 SET UP TO INCREMENT IN PROGRESS CTR
         LCFI     1
         BAL,R0   TQSETBLOCK
         BAL,R1   TQSETWRITE
TQGET10  EQU      %
         PULL     SR1               LIST DISPLACEMENT OF MATCH
         PULL     2,R6
         LI,SR2   QECBCODE1
         LI,D2    7
*        WRITE ALL BLOCKS, IF BACKUP
         BAL,R0   TQIOCHAIN
         B        TQRETURN1
         SPACE    6
TQGET12  EQU      %                 DESTRUCTIVE GET, DELETE ENTRY
         BAL,R3   TQDELETE
         B        TQGET10
         PAGE
*DO*
*D*
*        NAME:    TQSTATS, OBTAIN QUEUE STATISTICAL DATA OR STATUS OF
*                          A SPECIFIC CRITERION.
*
*        INPUT:   R6 = LIST ADDRESS
*                 R7 = ADDRESS OF FPT WORD 1
*
*                 PROCEDURE SYNTAX:
*
*                    M:QUEUE   (*)LIST-ADDR,STATS,((OPTION))...
*
*                    OPTIONS FOR STATS ARE:
*
*                      BUF,(*)ADDRESS     SPECIFIES THE BUFFER ADDRESS
*                                         FOR THE QUEUE STATISTICAL
*                                         DATA.
*
*                      BSIZE,(*)VALUE     SPECIFIES THE SIZE OF THE
*                                         AREA DEFINED BY THE BUF
*                                         OPTION (MUST BE AT LEAST 14
*                                         WORDS FOR STATISTICS).
*
*                      ECB,(*)ADDRESS     SPECIFIES THE ADDRESS OF AN
*                                         ECB TO BE POSTED WHEN A QUEUE
*                                         EVENT OCCURS.
*
*                      WAIT               SPECIFIES THAT THE CALLER
*                                         WISHES TO WAIT FOR ACCESS TO
*                                         THE QUEUE PRIOR TO RESUMING
*                                         EXECUTION.
*
*                      COUNT              SPECIFIES THAT THE NUMBER OF
*                                         OCCURRENCES IN THE QUEUE OF
*                                         THE SPECIFIED CRITERION BE
*                                         RETURNED IN SR1.
         PAGE
*
*
*                 FPT FORMAT:
*
*                         ---------------------------------------
*                 WORD 0  |*| X'0A'  |         | LIST ADDRESS   |
*                         ---------------------------------------
*
*                         ---------------------------------------
*                 WORD 1  |P1|0|P2|P3|                |F2|F1|   |
*                         ---------------------------------------
*
*                         OPTION ECB (P1)
*                         ---------------------------------------
*                         |*|                  |  ECB ADDRESS   |
*                         ---------------------------------------
*
*                         OPTION BUF (P2)
*                         ---------------------------------------
*                         |*|                  | BUFFER ADDRESS |
*                         ---------------------------------------
*
*                         OPTION BSIZE (P3)
*                         ---------------------------------------
*                         |*|                  |  BUFFER SIZE   |
*                         ---------------------------------------
*
*                         F1 = 1 FOR WAIT OPTION
*
*                         F2 = 1 FOR COUNT OPTION
*
*
*                 STATS LIST FORMAT:
*
*                         ---------------------------------------
*                         | LENGTH | BYTE ADDRESS OF CRITERION  |
*                         ---------------------------------------
         PAGE
*
*                         THE FORMAT FOR THE 'STATS' LIST IS THE
*                         SAME AS THAT GIVEN FOR 'DEFINELIST', EXCEPT
*                         THAT THE LIST ALWAYS DEFINES A SINGLE ITEM.
*
*                 NOTES:  IF THE LIST ADDRESS IS ZERO, ONLY THE QUEUE
*                         STATISTICAL DATA IS RETURNED TO THE USER.
*
*                         IF NO BUFFER IS SPECIFIED, ONLY THE INFOR-
*                         MATION IN SR1 IS RETURNED TO THE USER.
*
*
*        OUTPUT:  SR1 = THE STATUS OF THE OLDEST QUEUE ENTRY MATCHING
*                       THE CRITERION AND, OPTIONALLY, THE COUNT OF
*                       THE ENTRIES QUEUED FOR THAT NAME.
*
*                       IF THE BUF OPTION IS SPECIFIED, THE QUEUE
*                       CONTEXT BLOCK (WORDS 4-17) ARE PLACED IN
*                       THE USER'S BUFFER.  SEE THE DESCRIPTION OF
*                       THIS INFORMATION UNDER THE TQCONT TABLE
*                       DEFINITION.
*
*
*        DESCRIPTION:  THE STATS REQUEST ALLOWS A USER TO OBTAIN A
*                 COPY OF THE STATISTICAL INFORMATION MAINTAINED IN
*                 THE QUEUE CONTROL BLOCK, TO QUERY THE STATUS OF A
*                 SPECIFIC QUEUE ENTRY, AND/OR TO DETERMINE THE NUMBER
*                 OF OCCURRENCES OF THE ENTRY WITHIN THE QUEUE.  THE
*                 QUEUE STATISTICS REQUEST SIMPLY COPIES THE QUEUE
*                 CONTROL BLOCK (WORDS 4-17) TO THE CALLER'S BUFFER.
*
*                 THE ENTRY STATUS REQUEST SEARCHES THE QUEUE FOR A
*                 CRITERION MATCH AND RETURNS THE STATUS BYTE OF THE
*                 OLDEST ENTRY MATCH ENCOUNTERED.  THE STATUS OF
*                 SUBSEQUENT OCCURRENCES OF THE ENTRY WITHIN THE QUEUE
*                 IS NOT REPORTED.  IF THE COUNT OPTION IS SPECIFIED,
*                 THE NUMBER OF ENTRIES QUEUED UNDER THE FIRST NAME
*                 SEGMENT OF THE SPECIFIED CRITERION IS ALSO REPORTED.
*
*FIN*
*
TQSTATS  EQU      %                 REPORT QUEUE STATUS
         CI,R6    0
         BE       TQSTATS6          SPECIFIC ENTRY NOT WANTED
*                                   VERIFY CRITERION PTR
         LI,R1    1
         OR,R6    Y2
         PUSH     R6
         BAL,R0   TQVERIFY
         PULL     R6
         LW,R4    YC
         LW,R3    R6
         LW,R3    *R3               CRITERION ADDRESS
         PUSH     R7
         BAL,R0   TQGETMPOOL
         LW,R7    D3
         LW,SR1   R3
         BAL,SR4  TQSEARCH
         LI,SR1   0
         CI,R4    0
         BNE      TQSTATS4
         PULL     R7
         B        TQSTATS6
TQSTATS4 EQU      %
         LW,R4    QPOOLNAME(I),R7   STATUS
         STB,R4   SR1
         LW,R6    QPOOLI(I),R7
         LI,R5    INDEXCOUNTR(I)
         LW,D4    INDEXCOUNTR(M)+MASKS
         BAL,R0   TQGETFIELD
         PULL     R7
         TBIT,R3  QCOUNT,R7
         BEZ      TQSTATS6
         OR,SR1   D3
TQSTATS6 EQU      %
         BAL,R2   TQCHKBIT1         QUEUE STATS REQUEST
         B        %+1
         SLS,D1   1                 POSITION TO NEXT BIT (P3)
         BAL,R2   TQCHKBIT
         B        TQRETURN
         BAL,R0   TQCKBFR           VALIDITY CHECK BUFFER
         GET,D2   Q:CONT            PTR TO CONTROL BLOCK 1
         AI,D2    4
         CI,SR3   QSTATSSZ          BUFFER SIZE
*E*
*E*      ERROR:  BC13 ERROR IN PRESENTED LIST FOR PUT,DEFINE OR STATS
*E*      DESCRIPTION:  BUFFER IS TOO SMALL FOR STATS REQUEST DATA
*E*
         BL       TQABN13
         LW,D1    SR2
         LI,R3    QSTATSSZ*4        # BYTES TO MOVE
         BAL,R0   TQCALLMOVE4       STATS TO USER
         B        TQRETURN
         SPACE    6
TQCKBFR  EQU      %                 VALIDITY CHECK BUFFER
         PUSH     R0
         LW,R5    D3
         BAL,R0   TQVERIFYR
         LW,SR2   D3
         BAL,R2   TQCHKBIT
*E*
*E*      ERROR:  BC13 ERROR IN PRESENTED LIST FOR PUT,DEFINE OR STATS
*E*      DESCRIPTION:  BUFFER SIZE IS NOT SPECIFIED
*E*
         B        TQABN13
         SCS,R5   9
         CI,D3    512
*E*
*E*      ERROR:  BC13 ERROR IN PRESENTED LIST FOR PUT,DEFINE OR STATS
*E*      DESCRIPTION:  INVALID BUFFER SIZE SPECIFIED
*E*
         BG       TQABN13
         AW,R5    D3
         AI,R5    -1
         BAL,R0   TQVERIFYR
         LW,SR3   D3                BUFFER SIZE
         B        TQPULLEXIT
         PAGE
****************************************************
*                                                  *
*         CHECK WAIT OR ECB OPTION                 *
*         R4 = RESOURCE TYPE                       *
*         R5 = ABNORMAL ASSOCIATED WITH EVENT      *
*         R7 = POINTER TO FPT WORD 1               *
*        D2 = 0, IGNORE WAIT OPTION                *
****************************************************
*                 ENTERED VIA  BAL,SR4 TQCKW#ECB
*                 VOLATILE REGISTERS: STANDARD
*
TQCKW#ECB EQU     %
         PUSH     9,R5
         CI,D2    0                 CHECK WAIT IGNORE
         BEZ      TQCKW#ECB1
         TBIT,R3  QWAIT,R7          CHECK WAIT OPTION
         BNEZ     TQCKW#ECB2        YES
TQCKW#ECB1 EQU    %
         BAL,R2   TQCHKBIT1         CHECK FOR ECB GIVEN
         B        TQCKW#ECB9        NO, EXIT
         LW,SR3   D3                SET UP FOR ECB INIT
         LI,SR2   0
         BAL,SR4  ECBINIT           ESTABLISH ECB
         CI,SR3   2
         BANZ     TQCKW#ECB9        ERROR IN ECB USAGE
         LW,SR3   D3                RESTORE ECB ADDRESS
         B        TQCKW#ECB3
TQCKW#ECB2 EQU    %
         LI,SR3   0                 IF WAIT, NO ECB TO POST
TQCKW#ECB3 EQU    %
         CI,R4    QRTYPE4           CHECK EVENT = PUT OCCURRENCE
         BE       TQCKW#ECB12       YES, R6 = PTR TO QLIST
TQCKW#ECB3A EQU   %
         LI,SR1   QUESLGTH
         BAL,SR4  TQCOREALLOC       RETURNS SPACE ADDRESS IN D1
         BCS,8    TQCKW#ECB10       NO SPACE FOR QUES TABLE
         LW,R6    D1                REAL QUES ADDRESS
         LW,D3    S:CUN
         LI,R5    QUESUSR(I)
         BAL,R0   TQSETBYTE
         LW,D4    QUESTYP(M)+MASKS
         LW,D3    R4                RESOURCE TYPE
         DO1      QUESTYP(D)<31
         SLD,D3   31-QUESTYP(D)
         LI,R5    QUESTYP(I)
         BAL,R0   TQSETFIELD
         LI,R5    QUESECB(I)
         LW,D3    SR3               ECB IF ANY
         BAL,R0   TQSTOREF
         PUSH     16,R0
         LI,SR3   QRTYPE            RESOURCE = QUEUE
         LI,R7    0
         BAL,R0   TQUQA             UNBLOCK OTHER USERS
         PULL     16,R0
         LI,R5    Q:QHEAD(A)        USER QUEUE CHAIN HDR
         LW,SR2   D1
         DO1      QUESCHAIN(I)]=0
         AI,SR2   QUESCHAIN(I)
         BAL,R1   TQCH              PLACE QUES ON USER CHAIN
         CI,D2    0
         BE       TQCKW#ECB6
         TBIT,R3  QWAIT,R7          TEST USER WAIT
         BEZ      TQCKW#ECB6        NO
         LW,R6    D1                REAL ADDRESS OF QUES
         LI,R5    QUESWAIT(I)
         LW,D4    QUESWAIT(M)
         LW,D3    D4
TQCKW#ECB4 EQU    %
         BAL,R0   TQSETFIELD
         BAL,SR4  TQRESETUSR        UNBLOCK QUEUE FOR OTHER USERS
         PUSH     R6
         LI,R6    E:QA              SLEEP USER
         BAL,SR4  T:REG
         DO       QSIM=0
         BAL,R0   TQEVENTCK
         ELSE
         B        TQABNORMAL
         FIN
         PULL     R6
         LI,R4    QRTYPE            SET RESOURCE=QUEUE
*                                   IN CASE WE MUST SLEEP USER AGAIN
         T,R2     Q:PAUSE           IS QUEUE IN PAUSE STATE
         BNEZ     TQCKW#ECB3A       YES, SLEEP USER
         L,R2     Q:USR             IS QUEUE IN USE
         BNEZ     TQCKW#ECB3A       YES, SLEEP USER
TQCKW#ECB5A EQU   %
         ST,R6    Q:USR
*
*
         PULL     9,R5
         B        *SR4              RE-TRY
*
*
TQCKW#ECB6 EQU    %
         LI,R4    QCCNO#ECB         SET ECB WAIT MEANINGFUL
         PULL     9,R5
         B        TQEXIT6
TQCKW#ECB9 EQU    %
         PULL     9,R5
         B        TQABNORMAL
*
TQCKW#ECB10 EQU   %
*E*
*E*      ERROR:  BC12 QUEUE PHYSICAL PAGE SPACE IS NOT AVAILABLE
*E*      DESCRIPTION:  NO PHYSICAL SPACE AVAILABLE FOR QUES BLOCK
*E*               TO SLEEP USER
*E*
         LI,R5    QABN12            SET ABNORMAL FOR NO SPACE
         B        TQABNORMAL
TQCKW#ECB12 EQU   %
         LI,R2    0
         LW,SR3   R6                LIST ID AS CRITERIA
         LI,SR4   -1                FULL WORD MASK
         LI,R7    QLID(I)/2-QLCHAIN(I)
         LI,R4    5                 INDEX FOR SELECTING INACTIVE
*                                   GET LIST CHAIN HDR
         BAL,R1   TQDCHC            DECHAIN THE QLIST
         LI,R4    4                 SELECT ACTIVE CHAIN
         BAL,R1   TQCHC             CHAIN THE QLIST
         LI,SR3   QRTYPE            RESOURCE=QUEUE
         LI,R7    0
         BAL,R0   TQUQA             UNLOCK OTHER USERS
         B        TQCKW#ECB6        SET ECB WAIT MEANINGFUL
         SPACE    5
TQEVENTCK EQU     %
*E*
*E*      ERROR:  BC02 EVENT NOT ASSOCIATED WITH THE QUEUE HAS OCCURRED
*E*      DESCRIPTION:  A BREAK, ABORT, ERROR, OR CONTROL-Y HAS
*E*               OCCURRED DURING A WAIT UPON A QUEUE EVENT.
*E*
         LI,R5    QABN02            INTERRUPT ABNORMAL CODE
         LI,R3    X'F000'           ABRT+ERR+BRK+CTL-Y
         LW,R2    S:CUN
         LH,R2    UH:DL,R2          MAY HAVE OCCURRED
         CW,R2    R3
         DO       QSIM=0
         BANZ     TQABNORMAL
         FIN
         B        *R0
         PAGE
*
*
TQBRANCH1 EQU     %
         BE       0                 BRANCH TESTS FOR TQDCHAINC
TQBRANCH2 EQU     %
         BGE      0
TQBRANCH3 EQU     %
         BL       0
         PAGE
TQCOREALLOC EQU   %
*                 ENTERED VIA  BAL,SR4  TQCOREALLOC
*                                   VOLATILE REGISTERS:
*                                   STANDARD
         PUSH     6,R6
         LI,R5    Q:TPPP(A)
         CI,SR1   0                 TEST ALLOCATE/DEALLOCATE
         BE       TQCORE50          RELEASE REQUEST
         BLZ      TQCOREERR
         GET,R7,R1 Q:PAGES          HAS A PAGE BEEN ALLOCATED
         LW,R1    *R5
         BNEZ     TQCORE2           YES
TQCORE1  EQU      %
         BAL,SR4  GPWP              NO,REQUEST ONE
         CI,SR3   0                 PAGE OBTAINED
         BEZ      TQCORE40          NO
         SLS,SR3  9                 FORM WORD ADDRESS
         LI,R3    2048              ZERO THE PAGE
         LW,D1    SR3
         BAL,R0   TQCALLMOVE10
         LW,SR2   SR3               PUT PAGE ON PHYSICAL CHAIN
         DO1      QCHAIN(I)]=0
         AI,SR2   QCHAIN(I)
         BAL,R0   TQCHAIN
         BCS,1    TQERROR
         LW,R6    SR3
         LI,D3    QPPUNIT(I)        SET LARGEST AVAIL. UNIT DATA
         LI,R5    QPPLAUD(I)
         BAL,R0   TQSETHWORD
         LI,D3    QPPNAV
         LI,R5    QPPLAU(I)
         BAL,R0   TQSETHWORD
         AI,R7    1                 INCREMENT # PAGES
         ST,R7,R1 Q:PAGES
         B        TQCORE8
TQCORE2  EQU      %
*                                   SCAN PAGE CHAIN FOR ONE
*                                   WITH LARGE ENOUGH UNIT
         LI,R2    -1                FLAG SEARCH ONLY FOR DECHAINC
         LW,SR3   SR1               ALLOCATION UNIT SIZE
         SLS,SR3  16                TO LEFT HALFWORD
         LI,SR4   -1                FULL WORD MASK
         PUSH     2,R7
         LI,R7    QPPSPACER(I)-QPPCHAIN(I)
         LW,SR1   TQBRANCH3
         BAL,R0   TQDCHAINC
         BCR,1    TQCORE5           PAGE LOCATED
*                                   CURRENTLY ALLOCATED PAGES
*                                   DO NOT HAVE THE SPACE, HAS
*                                   MAX BEEN REACHED
         PULL     2,R7
         GET,R2    Q:MAX
         CW,R7    R2
         BL       TQCORE1           NO, REQUEST ANOTHER
         B        TQCORE40          YES, MAKE NO SPACE EXIT
TQCORE5  EQU      %
         PULL     2,R7              RESTORE COUNT
TQCORE6  EQU      %
         LW,R6    SR2               SETUP TO SCAN SPACE UNITS
TQCORE8  EQU      %
         LI,R5    QPPUNIT(I)        POSITION TO 1ST UNIT
         LI,SR4   0
TQCORE9  EQU      %
         BAL,R0   TQGETWORD
         BLZ      TQCORE10          ALLOCATED UNIT
         BEZ      TQCORE9B          END OF PAGE..LOGICALLY
         CW,D4    SR1               THIS UNIT OK
         BL       TQCORE12          TOO SMALL, CHECK NEXT ONE
         BE       TQCORE9B          SAME, USE THIS ONE
*                                   LARGER, CAN ANOTHER UNIT BE
*                                   CREATED
         SW,D4    SR1
         CI,D4    4                 MINIMUM SIZE FOR DEVIDING
         BL       TQCORE9A          NO, USE AT PRESENT SIZE
         AW,R5    SR1               POSITION TO END OF THIS UNIT
         AI,R5    1                 FOR CONTROL WORD
         LW,D3    D4                SIZE FOR OVERFLOW UNIT
         AI,D3    -1
         BAL,R0   TQSETWORD
         SW,R5    SR1               REPOSITION TO UNIT NOW ALLOCATING
         AI,R5    -1
         B        TQCORE9B
*                                   IT'S TOO SMALL
TQCORE9A EQU      %
         AW,D4    SR1
         LW,D3    D4                SIZE REMAINS THE SAME
         B        TQCORE9C
TQCORE9B EQU      %
         LW,D3    SR1
TQCORE9C EQU      %
         OR,D3    QPPUNITA(M)       ALLOCATED FLAG
         BAL,R0   TQSETWORD
         AW,R5    R6                ADDRESS OF THE UNIT FOR CALLER
         LW,D1    R5
         AI,D1    1
*                                   UPDATE LARGEST AVAILABLE UNIT DATA
         LI,R4    0
         LI,SR2   0
         LI,SR3   0
         LI,R5    QPPUNIT(I)        POSITION TO FIRST UNIT
TQCORE9D EQU      %
         BAL,R0   TQGETWORD         GET UNIT CONTROL WD
         BEZ      TQCORE9J          LOGICAL END OF PAGE
         BLZ      TQCORE9L          ALLOCATED UNIT
         CW,D4    SR2               UNALLOCATED UNIT, IS IT LARGEST
*                                   FOUND SO FAR
         BLE      TQCORE9F          NO
         LW,SR4   R5                YES, REMEMBER IT'S SIZE AND
*                                   DISPLACEMENT
         LW,SR2   D4
TQCORE9F EQU      %
         AW,R5    D4                POSITION TO NEXT UNIT
         AI,R5    QPPUNITCSZ
         CI,R5    511
         BL       TQCORE9D          CHECK NEXT UNIT
TQCORE9G EQU      %
         LW,D3    SR2               SET LAU DATA
         LI,R5    QPPLAU(I)
         BAL,R0   TQSETHWORD
         LW,D3    SR4
         LI,R5    QPPLAUD(I)
         BAL,R0   TQSETHWORD
TQCORE9H EQU      %                 RETURN TO CALLER
         LI,R4    0
         B        TQCOREEXIT
TQCORE9J EQU      %
         LW,D3    R5                AND DISPLACEMENT TO E-O-P
         LW,SR3   R5
         SW,SR3   R3                *** NEW UPDATE
         AI,SR3   -QPPUNITCSZ
         LI,R5    QPPLAUD(I)        GET CURRENT LARGEST AVAIL UNIT
         BAL,R0   TQGETHWORD
         BAL,R0   TQSETHWORD
         LI,D3    QPPNAV            SET SIZE
         SW,D3    R4
         CW,SR3   D4
         BE       TQCORE9K
         CW,D4    SR2
         BL       TQCORE9G
TQCORE9K EQU      %
         LI,R5    QPPLAU(I)
         BAL,R0   TQSETHWORD
         B        TQCORE9H
TQCORE9L EQU      %
         AND,D4   QPPUNITSZ(M)+MASKS MASK ALLOCATED FLAG
         LW,R3    D4                ****NEW
         AW,R4    D4                *****NEW, CHANGED
         B        TQCORE9F          CHECK NEXT UNIT
TQCORE10 EQU      %
         AND,D4   QPPUNITSZ(M)+MASKS
         BEZ      TQERROR
TQCORE12 EQU      %
         AW,R5    D4
         AI,R5    1
         CI,R5    511
         BL       TQCORE9
         B        TQERROR
*
*
TQCORE40 EQU      %                 NO SPACE EXIT
         LW,R4    BT31TO0+32
TQCOREEXIT EQU    %
         PULL     6,R6
         LCF      R4
         B        *SR4
*
TQCOREERR EQU     %
         PULL     6,R6
         B        TQERROR
*
*
TQCORE50 EQU      %
*                                   SPACE RELEASE REQUEST
         LW,R6    D1                ADDRESS OF SPACE UNIT WD 1
         AND,R6   CSTPGE            GET BEGINNING OF PAGE
TQCORE51 EQU      %
         LI,R5    QPPUNIT(I)
         AND,D1   MASKS+9           GET DISPLACEMENT WITHIN THE
         AI,D1    -1
*                                   PAGE TO UNIT RELEASING
TQCORE52 EQU      %
*                                   POSITION TO UNIT PRECEDING THIS ONE
         CW,R5    D1
         BE       TQCORE54
         BAL,R0   TQGETWORD
         AND,D4   QPPUNITSZ(M)+MASKS
         LW,SR1   D4
         AI,SR1  QPPUNITCSZ
         AW,R5    SR1
         CI,R5    511
         BL       TQCORE52          CHECK NEXT UNIT
         B        TQERROR
TQCORE54 EQU      %
         LW,R4    R5
*                                   SAVE DISPLACEMENT TO RELEASE UNIT
         BAL,R0   TQGETWORD         GET SIZE OF THE UNIT
         AND,D4   QPPUNITSZ(M)+MASKS
         LW,D3    D4
         BAL,R0   TQSETWORD
         LW,R2    D4
         AI,R2    1
         CI,SR1   0      IF 1ST UNIT CHECK FORWARD UNIT ONLY
         BE       TQCORE56
         SW,R5    SR1
         BAL,R0   TQGETWORD    SEE IF BACKWARD UNIT IS FREE
         BLZ      TQCORE57
         LW,R4    R5
         AW,R2    D4                NOT ALLOCATED, CHANGE IT TO COMBINE
         LW,D3    R2
         LW,D4    QPPUNITSZ(M)+MASKS
         BAL,R0   TQSETFIELD
         AI,R2    1
TQCORE56 EQU      %
         LW,SR1   R2
         AW,R5    R2                LOOK AT FORWARD UNIT
         CI,R5    511
         BGE      TQCORE59
         BAL,R0   TQGETWORD
         BLZ      TQCORE59
         BNEZ     TQCORE58
         LI,SR1   QPPNAV+QPPUNIT(I)
         SW,SR1   R4
         CI,SR1   QPPNAV            CHECK FOR EMPTY PAGE FOR
*                                   POSSIBLE RETURN TO THE SYSTEM
         BNE      TQCORE59          NOT EMPTY
         GET,R7,R2 Q:PAGES          CHECK FOR MINIMUM ALLOCATED
         GET,R2    Q:MIN
         CW,R7    R2
         BE       TQCORE59          NOT ALLOWED TO FREE ONE
         LI,R5    Q:TPPP(A)         DECHAIN THE PAGE
         LW,SR2   R6
         BAL,R1   TQDCHFREE         DECHAIN AND RELEASE THE PAGE
         BCS,1    TQERROR
         B        TQCORE70
TQCORE57 EQU      %
         AW,R5    SR1
         B        TQCORE56
TQCORE58 EQU      %
         AW,SR1   D4
         AI,SR1   1
TQCORE59 EQU      %
         LW,R5    R4
         AI,SR1   -1
         LW,D3    SR1
         LW,D4    QPPUNITSZ(M)+MASKS
         BAL,R0   TQSETFIELD
*                                   ZERO RETURNED SPACE
         AW,R5    R6
         LW,D1    R5
         AI,D1    QPPUNITCSZ
         LW,R3    SR1
         SLS,R3   2
         BAL,R0   TQCALLMOVE10      MBSZ TO REAL MEMORY
TQCORE62 EQU      %
         LI,R5    QPPLAU(I)         UPDATE LAU CONTROL IF NEEDED
         BAL,R0   TQGETHWORD
         CW,D4    SR1
         BGE      TQCORE70
         LW,D3    SR1
         BAL,R0   TQSETHWORD
         LW,D3    R4
         LI,R5    QPPLAUD(I)
         BAL,R0   TQSETHWORD
TQCORE70 EQU      %
         LI,SR3   QRTYPE1
         LI,R7    0
         BAL,R0   TQUQA
         B        TQCORE9H
         PAGE
****************************************************
*        TQMOVE...MOVE ROUTINE, ENTERED VIA BAL,SR4 *
*                 CONDITION CODES INDICATE MOVE    *
*                 CC1 = 0,DESTINATION IS VIRTUAL   *
*                     = 1,DESTINATION IS REAL      *
*                 CC2 = 0,SOURCE IS VIRTUAL        *
*                     = 1,SOURCE IS REAL           *
*                 CC3 = 0, NORMAL MOVE             *
*                     = 1, SET DESTINATION BYTES TO*
*                                   ZERO           *
*                 CC4 = 0, WORD ADDRESSES          *
*                     = 0, BYTE ADDRESSES          *
*                 INPUT: R3 = # BYTES TO MOVE      *
*                                                  *
*                        D2 = SOURCE               *
*                        D1 = DESTINATION          *
*                 VOLATILE REGISTERS: STANDARD     *
* NOTE: THE QUEUE MGR DOES NOT ALLOCATE ACROSS PAGE*
*       BOUNDARIES                                 *
****************************************************
TQMOVE   EQU      %
*                                   MOVE BYTES TO/FROM PHYSICAL CORE
         STCF     R5                SAVE CC PARAMETERS
         PUSH     14,R0
         CI,R3    0
         BE       TQMOVEEXIT
         LCF      R5
         BCS,1    TQMOVE1
         SLS,D1   2
         SLS,D2   2
TQMOVE1  EQU      %
         LCF      R5
         BCR,8    TQMOVE4           VIRTUAL ADDRESS
         STW,D1   D4                TO MBS REGS
TQMOVE2  EQU      %
         LCF      R5                TEST MOVE TYPE
         BCR,2    TQMOVE3           NORMAL
         LW,R1    D4                TO ZERO MBS REGS
         LI,D3    0                 X0 USED AS SOURCE FOR ZEROS
         B        TQMOVE7
TQMOVE3  EQU      %
         BCR,4    TQMOVE6           SOURCE IS VIRTUAL
         STW,D2   D3                TO MBS REG
         B        TQMOVE7
TQMOVE4  EQU      %
         LW,R2    D1                CONVERT ADDRESS TO REAL
         BAL,R1   TQGETREAL
         STW,R2   D4
         B        TQMOVE2
TQMOVE6  EQU      %
         LW,R2    D2
         BAL,R1   TQGETREAL
         STW,R2   D3
TQMOVE7  EQU      %
         LI,R4    0                 CHECK FOR CROSSING A PAGE
*                                   BOUNDARY
         LW,R2    MASKS+11
         AND,R2   D4                CHECK DESTINATION BOUNDARIES
         AI,R2    -2048
         AW,R2    R3
         BLEZ     TQMOVE8           NOT CROSSING A BOUNDARY
         LW,R4    R2                KEEP OVERLAP COUNT
TQMOVE8  EQU      %
         LW,R2    D3                CHECK SOURCE
         BEZ      TQMOVE9           STORING ZEROS, NO SOURCE CHECK
         AND,R2   MASKS+11          GET START DISPLACEMENT
         AI,R2    -2048
         AW,R2    R3
         BLEZ     TQMOVE9           NOT CROSSING PAGES
         CW,R2    R4                COMPARE SOURCE OVERFLOW WITH
*                                   DESTINATION OVERFLOW
         BGE      TQMOVE10
TQMOVE9  EQU      %
         LW,R2    R4                DESTINATION OVERLAP COUNT OR ZERO
TQMOVE10 EQU      %
         SW,R3    R2                R3=COUNT WITHOUT XING A PAGE
*                                   R2 = RESIDUAL COUNT
         AW,D1    R3                EFFECTIVELY STEPS TO NEXT VIRTUAL
*                                   ADDRESS
         AW,D2    R3
TQMOVE10A EQU     %
         LI,R4    255               CHECK FOR MOVE > 255 BYTES
         CW,R3    R4
         BL       TQMOVE16
TQMOVE11 EQU      %
         SW,R3    R4                REDUCE COUNT BY 255
         LCF      R5                CHECK MOVE TYPE
         BCR,2    TQMOVE12          NORMAL
         STB,R4   R1                STORE ZERO REQUEST
         BAL,R0   TQMOVEBSZ         MBS, ZERO INSTRUCTION
         LW,D1    R1
         B        TQMOVE14
TQMOVE12 EQU      %
         STB,R4   D4                DESTINATION FOR NORMAL MOVE
         BAL,R0   TQMOVEBS          MBS INSTRUCTION
TQMOVE14 EQU      %
         CI,R3    0                 TEST FOR END LS OVERFLOW
         BNE      TQMOVE10A
         LW,R3    R2
         BGZ      TQMOVE1           PERFORM ADDITIONAL MOVE(S) FOR
*                                   RESIDUAL BYTES
TQMOVEEXIT EQU    %
         PULL     14,R0
         LCFI     0
         B        *SR4
TQMOVE16 EQU      %
         LW,R4    R3
         B        TQMOVE11
*
TQMOVEERR EQU     %
         PULL     14,R0
         LCFI     1
         B        *SR4
*
*
TQGETREAL EQU     %
         DO       QSIM
         B        *R1
         ELSE
         PUSH     R3
         AND,R2   MASKS+19
         SLD,R2   -11               SHIFT OFF DISPLACEMENT
         LOAD,R2  JX:CMAP,R2        GET PHYSICAL PAGE FROM MAP
         CI,R2    X'20'             CHECK FOR UNASSIGNED PAGE
         BE       TQMOVEERR
         SLD,R2   11                REALIGN FOR BYTE ADDRESS
         PULL     R3
         B        *R1
         FIN
         PAGE
****************************************************************
*                 TQGETBLOCKS...REQUEST AND INVOKE CHAINING FOR
*                 QUEUE BLOCKS. ENTERED VIA BAL,SR4  TQGETBLOCKS
*
*                                   R4 = 0, GET CONTROL PAGE
*                                      = 1, GET INDEX PAGE
*                                        2, GET DATA PAGE
*                                   VOLATILE REGISTERS:STANDARD + SR2
*                                   SR3 (VIA GPWP)
****************************************************************
TQGETBLOCKS EQU   %
         PUSH     4,R6
         PUSH     SR4
         LBYTE,R2 Q:MAX             CHECK FOR MAX PAGES
         BEZ      TQGETBLOCKS1
         CBYTE,R2,R1 Q:PAGES
         BG       TQGETBLOCKS1
         LI,SR3   0
         B        TQGETBLOCKS2
TQGETBLOCKS1 EQU  %
         BAL,SR4  GPWP              REQUEST A WORK PAGE
         CI,SR3   0
         BNE      TQGETBLOCKS4      GRANTED
TQGETBLOCKS2 EQU  %
         PULL     SR4
         PULL     4,R6
         B        *SR4
TQGETBLOCKS4 EQU  %
         SLS,SR3  9                 CONVERT PAGE TO WORD ADDRESS
*                                   ZERO THE BLOCK
         PUSH     16,R4
         LW,D1    SR3
         LI,R3    2048
         BAL,R0   TQCALLMOVE10
         PULL     16,R4
         LBYTE,R2,R1 Q:PAGES        INCREMENT # QUEUE PAGES
         AI,R2    1
         SBYTE,R2,R1 Q:PAGES
         LW,R6    SR3
         LW,D3    D1
         LI,R5    CONTBLOCK(I)
         BAL,R0   TQSTOREF
         PUSH     SR3               SAVE PAGE ADDRESS
         LW,SR2   SR3
         DO1      QCHAIN(I)]=0
         AI,SR2   QCHAIN(I)
         LI,R7    QBLOCK(I)-QCHAIN(I)           DISPLACEMENT
*                                   FROM LINK TO CRITERIA WORD
         LW,SR4   CSTMAP            CRITERIA MASK
         BAL,R1   TQCHC             CHAIN WITH CRITERIA
         PULL     SR3               RESTORE PAGE ADDRESS
         B        TQGETBLOCKS2
*
*
TQGETBLOCKS6 EQU  %
         LI,R5    Q:CONT(A)
         LI,R5    Q:INX(A)
         LI,R5    Q:DATA(A)
TQGETBLOCKS6A EQU %
         LI,R5    Q:TPPP(A)
         LI,R5    Q:GET(A)
         LI,R5    Q:DEF(A)
TQGETBLOCKS7 EQU  %
         LI,R7    CONTBLOCK(I)-CONTCHAIN(I)
         LI,R7    INDEXBLOCK(I)-INDEXCHAIN(I)
         LI,R7    DATABLOCK(I)-DATACHAIN(I)
         PAGE
****************************************************************
*                 TQREAD...INITIATE READ OF QUEUE BLOCKS
*                 ENTERED VIA BAL,R0  TQREAD
*                                   SR1 = BUFFER ADDRESS(REAL)
*                                   SR2 = BLOCK NUMBER
*                                   VOLATILE REGISTERS:
*                                   R3,SR2,SR3
****************************************************************
TQREAD   EQU      %
         PUSH     R0
TQREADIN EQU      %
         LI,SR3   QREAD             FUNCTION CODE
         PUSH     SR4
         BAL,SR4  TQCALLNEWQ        TO NEWQ
         PULL     SR4
TQPULLEXIT EQU    %
         PULL     R0
         B        *R0
         PAGE
****************************************************************
*                 TQWRITE...INITIATE WRITE OF QUEUE BLOCKS
*
*                 ENTERED VIA BAL,R0  TQWRITE
*                                   SR1 = BUFFER ADDRESS
*                                   VOLATILE REGISTERS:
*                                   R3,SR3,SR4
****************************************************************
TQWRITE EQU       %
         PUSH     R0
         PUSH     R6
         LI,SR3   QWRITE            WRITE FUNCTION CODE
         BAL,SR4  TQIO              SET UP FOR AND CALL CALLNEWQ
         CI,R5    0
         BNE      TQERROR
         PULL     R6
         B        TQPULLEXIT
         PAGE
*                 TQIOCHAIN...IF BACKUP IS SPECIFIED, WRITE OUT
*                 ALL QUEUE BLOCKS (OR BLOCKS OF A GIVEN TYPE)
*                 WHICH HAVE THE WRITE REQUIRED FLAG SET.
*                 CURRENT IMPLEMENTATION DOES 1 BLOCK AT
*                 A TIME, FUTURE ENHANCEMENT MAY CONSTRUCT
*                 A CHANNEL PROGRAM TO OPTIMIZE I/O REQUESTS
*
*                                   ENTERED VIA BAL,R0
*                                   VOLATILE REGISTERS:R2,R3,D4
TQIOCHAIN EQU     %
         TBIT,R2  Q:BACK            WRITE, BACKUP NOT WANTED
         BEZ      *R0               EXIT
TQIOCHAIN6 EQU    %
         PUSH     R0
         PUSH     9,R5
         LI,R7    0                 START CHECK WITH CONTROL BLOCKS
         LI,D1    1
TQIOCHAIN8 EQU    %
         CW,D1    D2                THIS TYPE REQUESTED
         BAZ      TQIOCHAIN16       NO, BYPASS
         EXU      TQGETBLOCKS6,R7   CHAIN HDR PTR TO R5
         LW,R6    *R5
TQIOCHAIN9 EQU    %
         BEZ      TQIOCHAIN16       END OF THE CHAIN
         LI,R5    CONTWRITE(I)      CHECK WRITE REQUIRED
         LW,D4    CONTWRITE(M)
         BAL,R0   TQGETFIELD
         BEZ      TQIOCHAIN14       NO WRITE NEEDED ON THIS BLOCK
TQIOCHAIN9A EQU   %
         LI,SR3   QWRITE
TQIOCHAIN12 EQU   %
         PUSH     D2
         LW,SR1   R6
         BAL,SR4  TQIO              SETUP FOR AND CALL CALLNEWQ
         PULL     D2
         CI,R5    0
         BNE      TQIOCHAIN18
TQIOCHAIN14 EQU   %
         LI,R5    CONTCHAIN(I)      ANY MORE BLOCKS OF THIS TYPE
         BAL,R0   TQLOADF
TQIOCHAIN15 EQU   %
         LW,R6    D3
         CI,R6    0
         B        TQIOCHAIN9
TQIOCHAIN16 EQU   %
         SLS,D1   1                 CHECK NEXT TYPE
         AI,R7    1
         CI,R7    3
         BL       TQIOCHAIN8
         PULL     9,R5
         LI,R5    0
         B        TQPULLEXIT
TQIOCHAIN18 EQU   %
         PULL     9,R5
         LI,R5    -1
         B        TQPULLEXIT
*
*
TQIO     EQU      %
*                                   VOLATILE REGISTERS:
*                                   R3,R5,SR2
         LI,R5    CONTBLOCK(I)      GET BLOCK NUMBER FROM THE
*                                   BLOCK FOR I/O
         PUSH     D4
         BAL,R0   TQLOADF
         LW,SR2   D3
         PUSH     SR4
         LW,D4    CONTWRITE(M)      TURN OFF WRITE REQUIRED FLAG
         LI,D3    0
         BAL,R0   TQSETFIELD
         BAL,SR4  TQCALLNEWQ        TO NEWQ
         PULL     SR4
         PULL     D4
         B        *SR4
         PAGE
*****************************************************************
*                                                               *
*                 TQCALLNEWQ.....Q MGR INTERFACE WITH NEWQ      *
*                                                               *
*                 MAY BE CALLED FROM ANOTHER OVERLAY            *
*                                                               *
*                 ENTERED VIA BAL,SR4                           *
*                 SR1 = BUFFER OR CHANNEL PROGRAM ADDRESS       *
*                 SR2 = BLOCK NUMBER                            *
*                 SR3 = FUNCTION CODE                           *
*                 D4 =  SEEK IF SR1 = C. P. AND D1 = DCTX       *
*                 VOLATILE REGISTERS: R0,R1,R2,R3               *
*                                                               *
*                                     D2,D3,D4                  *
*****************************************************************
TQCALLNEWQ EQU    %
         PUSH     SR4
         PUSH     8,R5
         AND,SR2  CSTMAP
         LI,D2    0
         DO       QSIM=0
         BAL,R0   TQIOSET           CONVERT BLOCK # TO RELATIVE SECTOR
         FIN
         LW,D4    R1                D.A. RETURNED IN R1
         LDCTX,D1 D4                DCT INDEX
         STB,SR3  D1                FUNCTION CODE
         LI,R3    2                 PRIORITY LEFT = 0, SET NRT
         LI,R2    QNRT
         STB,R2   D1,R3
         SLS,SR1  2                 BYTE ADDRESS
         OR,D2    SR1               BUFFER ADDRESS AND DC FLAGS
         LI,D3    QBLKSZ*4          SET BYTE COUNT
         LI,R0    TQUEUEA           ADDRESS OF QUEUE END-ACTION IN
*                                   TQROOT
         GET,R1    Q:USR            USER #, THIS I/O OPERATION
         LI,R5    X'FF'             INITIALIZE I/O COMPLETION CODE
         ST,R5    Q:CC
         BAL,R6   TQNEWQ
TQCALLQ10 EQU     %
         LI,R6    E:QA              WAIT FOR I/O COMPLETE
         BAL,SR4  T:REG
         L,R5     Q:CC
         CI,R5    X'FF'
         BE       TQCALLQ10         RE-SLEEP USER UNTIL I/O COMPLETES
*
         PULL     8,R5              RESTORE REGISTERS AND EXIT
         L,R5     Q:CC              CHECK COMPLETION CODE
         CI,R5    1
         BNE      TQCALLQ16
         LI,R5    0
TQCALLQ15 EQU     %
         PULL     SR4
         OBSR4
TQCALLQ16 EQU     %
         LI,R5    -1
         B        TQCALLQ15
         PAGE
*                                   TQIOSET....CONVERT QUEUE BLOCK
*                                   NUMBER TO RELATIVE SECTOR NUMBER
*                 ENTERED VIA BAL, R0  TQIOSET
*                 SR2 = BLOCK NUMBER
*                                   VOLATILE REGISTERS:
*                                   R1,R2,R3,R4,D4
TQIOSET  EQU      %
         PUSH     R0
         PUSH     8,R5
         GET,R7    Q:CFU            ADDRESS OF THE QUEUE CFU
         GET,D4    CFU#CDAM,R7      TOTAL FILE SIZE
         SW,D4    SR2
         BLEZ     TQERROR           OUTSIDE OF FILE LIMITS
         GET,SR1    CFU#FDA,R7      FDA FROM CFU
         LW,SR3   SR2
         SLS,SR3  1                 BLOCK TO RELATIVE SECTOR
         L,R1     Q:NSN             QUEUE ON PRIVATE PACK
         BNEZ     TQIOSET10         YES
TQIOSET5 EQU      %
         BAL,R3   FNDHGP            GET HGP FOR PUBLIC FILE
         BNEZ     TQIOSET20
         B        TQERROR
TQIOSET10 EQU     %                 PRIVATE FILE SET UP
         LI,R5    1                 FIRST VOLUME
         L,R6     Q:SN              ADDR OF HGPS FOR QUEUE FILE
TQIOSET12 EQU     %
         BAL,R0   TQGETWORD         GET HGP
         LW,R7    D4
         LI,R4    X'FF'
         AND,R4   1,R7              GRANULES/CYLINDER
         SLS,R4   1                 SECTORS/CYLINDER
         CI,SR1   SECTOR#MASK       FILE AT BEGINNING OF PACK
         BANZ     TQIOSET20         NO
         AW,SR1   R4                SKIP FIRST CYLINDER
TQIOSET20 EQU     %
         AI,R7    1                 WORD 1 OF HGP
         LH,R2    *R7               DCT INDEX FOR THIS DEVICE
         LB,R2    DCT22,R2          DISK SUBTYPE INDEX
         LW,D4    DISCLIMS,R2       # SECTORS ON DEVICE
         LI,R4    X'FF'
         AND,R4   0,R7              GRANULES/CYLINDER
         BEZ      TQIOSET20A        NOT CYLINDER ALLOCATED
         SLS,R4   1                 SECTORS/CYLINDER
         DW,D4    R4                CORRECT FOR PARTIAL CYLINDER
         MW,D4    R4
TQIOSET20A EQU    %
         LSECTA,R3  SR1             REL SECTOR OF START OF FILE
         LCW,R4   R3                NEGATIVE
         AW,R4    D4                COMPUTE SIZE OF DEVICE
         SW,SR3   R4                DECREMENT RELATIVE SECTOR
         BL       TQIOSET22         IN THIS DEVICE
TQIOSET21 EQU     %
         AI,SR1   X'10000'          INCREMENT TO NEXT DEVICE/VOLUME
*                                   RESET RELATIVE SECTOR
         AND,SR1  DCT%MASK%1
         L,R2     Q:NSN             PRIVATE PACK
         BEZ      TQIOSET5          NO, GET NEXT HGP
         AI,R5    1
         BDR,R1   TQIOSET12         NEXT PRIVATE HGP
         B        TQERROR
TQIOSET22 EQU     %
         AW,R3    SR3               COMPUTE REL SECTOR WITHIN
         AW,R3    R4                  FILE AND DEVICE
         STSECTA,R3,D4 SR1          STORE WITH DCT INDEX
TQIOSET30 EQU     %
         LW,R1    SR1
         PULL     8,R5
         B        TQPULLEXIT
         PAGE
*                 USER RETURN PROCESSING...THREE TYPES
*                 1) ABNORMAL
*                 2) NORMAL
*                 3) ABORT
         SPACE    6
*                 ABNORMAL EXIT PROCESSING
TQABN07A EQU      %
         PULL     2,SR1             RESTORE STACK LEVEL
TQABN07  EQU      %
         LI,R5    QABN07
         LI,R4    QRTYPE2
         LI,D2    -1                ACKNOWLEDGE WAIT OPTION
         PULL     2,R6              RESTORE LIST & FPT PTRS
         BAL,SR4  TQCKW#ECB
         T,R2     Q:LOCK            IS QUEUE LOCKED
*E*
*E*      ERROR:  BC11 QUEUE LOCKED
*E*      DESCRIPTION:  THE QUEUE WAS LOCKED WHILE THIS USER WAS
*E*               WAITING FOR A QUEUE EVENT.
*E*
         BNEZ     TQPUT             NO, RETRY THE REQUEST
TQABN11  LI,R5    QABN11
         B        TQABNORMAL
*
TQABN10  LI,R5    QABN10
         B        TQABNORMAL
*
TQABN13  EQU      %
         LI,R5    QABN13
         B        TQABNORMAL
TQABN14  EQU      %
         LI,R5    QABN14
         B        TQABNORMAL
TQABN16  EQU      %
         LI,R5    QABN16
         B        TQABNORMAL
TQABN20  EQU      %
         LI,R5    QABN20
TQABNORMAL EQU    %
         LI,SR2   QECBCODEF
         LI,R4    QCCNO
         L,SR1    Q:SR1             ABNORMAL RETURN PARAMETER
         B        TQRETURN2
*                                   NORMAL RETURN PROCESSING
TQRETURN EQU      %
         LI,SR2   QECBCODE2
TQRETURN1 EQU     %
         LI,R4    QCCYES
         LI,R5    0
*
*        ALL QUEUE CALS EXIT HERE FROM EITHER OVERLAY
*
TQRETURN2 EQU     %
         LI,D4    0
         LI,SR3   QRTYPE
         LI,R7    0                 FREE QUEUE
         PUSH     SR2
         BAL,R0   TQUQA
         PULL     D2
         BAL,R0   TQSETEXIT1
         BAL,R2   TQCHKBIT1         CHECK FOR ECB IN FPT
         B        TQEXIT
         LW,D4    D3                SAVE IT FOR POSTING
         LW,SR3   D3
         BAL,SR4  ECBINIT
         CI,SR3   2
         BAZ      TQEXIT
         LI,D4    0
*
*                 TQRETURN...NORMAL USER RETURN
TQEXIT   EQU      %
         CI,D4    0                 IS THERE AN ECB TO POST
         BE       TQEXIT2
         LW,R7    S:CUN             YES, POST IT
         LW,SR2   D2
         BAL,R0   TQECBPOST
TQEXIT2   EQU     %
         PULL     SR4
         B        T:SELFDESTRUCT
TQEXIT6  EQU      %
         LI,R5    0
         BAL,R0   TQSETEXIT1
         B        TQEXIT2
*
TQSETEXIT1 EQU    %
         PULL     1,R1
         CW,R1    TSTACK
         BNE      TQSETEXIT1
         LW,SR3   -5,R1             FPT WORD 0
         CI,R5    0
         BE       TQSETEXIT2
         LI,R2    QABNCODE
         STB,R2   SR3
         LW,R6    R5
         SLS,R6   17
         LW,R7    Y00FE
         STS,R6   SR3
         STW,SR3  -13,R1
TQSETEXIT2 EQU    %
         STW,SR1  -15,R1
         SCS,R4   -4
         LW,R5    YF
         AI,R1    -25
         AND,R1   X1FFFE
         STS,R4   0,R1
         PULL     7,R5
         BAL,SR4  TQRESETUSR        RESET Q:USR IF REQUIRED
         B        *R0
TQRESETUSR  EQU   %          RESET Q:USR IF NOT CUN;RETURNS S:CUN IN R6
         LW,R6    S:CUN
         C,R6     Q:USR
         BNE      *SR4
         RESETI,R1 Q:USR
         STW,R1   Q:SR1(A)          ZERO RETURN PARAMETER
         B        *SR4
         PAGE
*                                   TQUQA...UNBLOCK USERS WAITING
*                                   FOR QUEUE FACILITIES
*                                   R7 = USER NUMBER
*                                   SR3 = RESOURCE
*                 ENTERED VIA  BAL,R0 TQUQA
*                 VOLATILE REGISTERS:
*                                   R1,SR2,SR4,D1
TQUQA    EQU      %
         PUSH     R0
         PUSH     5,R4
TQUQA1   EQU      %
         GET,R6   Q:QHEAD           CHAIN HEADER, USER QUEUE
         LW,R4    R6
         BNEZ     TQUQA3
         B        TQUQAEXIT
TQUQA2   EQU      %
         LI,R5    QUESCHAIN(I)
         BAL,R2   TQGETCHAIN
         LW,R6    D3
         BEZ      TQUQAEXIT
TQUQA3   EQU      %
         CI,R7    0                 SPECIFIC USER REQUESTED
         BE       TQUQA4            NO
         LI,R5    QUESUSR(I)        BYTE INDEX TO USER #
         BAL,R0   TQGETBYTE
         CW,D4    R7                YES, IS THIS QUES HIS
         BNE      TQUQA2
TQUQA4   EQU      %
         CI,SR3   3                 IS THIS RESOURCE TYPE NOW AVAIL-
*                                   ABLE
         BE       TQUQA6            YES, SINCE REQUESTED ANY
         LW,D4    QUESTYP(M)+MASKS  CHECK SPECIFIC TYPE
         DO1      QUESTYP(D)<31
         SLS,D4   31-QUESTYP(D)     POSITION MASK
         LI,R5    QUESTYP(I)
         BAL,R0   TQGETFIELD
         DO1      QUESTYP(D)<31
         SLS,D3   QUESTYP(D)-31
         CW,D3    SR3
         BNE      TQUQA2            CHECK NEXT QUES
TQUQA6   EQU      %
         LI,R5    QUESUSR(I)
         BAL,R0   TQGETBYTE
         LW,R7    D4
         LI,R5    QUESECB(I)        POST ECB OR WAKEUP USER
         LI,R2    QUESWAIT(I)
         LW,D3    QUESWAIT(M)
         BAL,R0   TQWAKEPOST
TQUQA10  EQU      %
         LI,R5    Q:QHEAD(A)        DECHAIN QUES
         LW,SR2   R6
         BAL,R0   TQDCHAINA
         LI,SR1   0                 FREE QUES SPACE
         LW,D1    R6
         BAL,SR4  TQCOREALLOC
         B        TQUQA1
TQUQAEXIT EQU     %
         PULL     5,R4
        B         TQPULLEXIT
         PAGE
*
*
TQECBPOST EQU     %
*                                   VOLATILE REGISTERS: SR1,SR4
         PUSH     SR3
         LW,SR3   D4                VIRTUAL ADDRESS OF ECB
         LW,SR1   R7                USER #
         BAL,SR4  ECBPOST
         PULL     SR3
         B        *R0
         SPACE    6
TQWAKEPOST EQU    %
         PUSH     R0
         PUSH     2,SR1
         BAL,R0   TQGETWORD         GET ECB WORD
         BEZ      TQWAKEPOST2       NONE
         LI,SR2   QECBCODE2
         BAL,R0   TQECBPOST
TQWAKEPOST2 EQU   %
         PULL     2,SR1
         LW,R5    R2
         LW,D4    D3
         BAL,R0   TQGETFIELD
         BEZ      TQPULLEXIT
         LI,D3    0                 RE-SET WAITED FLAG
         BAL,R0   TQSETFIELD
         PUSH     4,R5
         LW,R5    R7
         LI,R6    E:UQA
         BAL,SR4  T:RUE
         PULL     4,R5
         B        TQPULLEXIT
         PAGE
TQVERIFY  EQU     %
*                                   R1 = LIST SIZE
         PUSH     R0
*                                   R6 = LIST PTR ,D1= QLIST IF ANY
         LW,SR1   R6                USED BY VERIFYP AS PROCESSING FLAG
         LW,SR4   R6                SAVE INITIAL PAGE OF THE LIST
         AW,SR4   R1
         AI,SR4   -1
         AND,SR4  CSTPGE
         SLS,SR4  -9
         LW,D2    R6                D2 = PTR TO GET OR PUT LIST
         LW,R6    D1                R6 = PTR TO QLIST (REAL)
         LI,R4    0
         AI,D2    -1                GET LIST ADDRESS-1
TQVERIFY8 EQU     %
         LW,R5    *D2,R1            SELECT CRITERION MESSAGE OR PTR
         LC       D2                CHECK FOR PUT
         BCS,4    TQVERIFY9
         SCS,R5   -2
TQVERIFY9 EQU     %
         AND,R5   MASKS+17
         CW,R4    R5                CHECK FOR SAME PAGE AS LAST PTR
         BE       TQVERIFY11        YES, DO NOT CHECK AGAIN
         BAL,R0   TQVERIFYR
         LW,R4    R5                SAVE FOR NEXT COMPARE
         BAL,R0   TQVERIFYL         VERIFY PAGE IN QLIST
*                                   DEFINE ADD IT, IF GET, ERROR
TQVERIFY11 EQU    %
         LW,R5    R1                CHECK FOR LIST SPANNING PAGES
         AW,R5    D2
         AND,R5   CSTPGE
         SLS,R5   -9
         CW,R5    SR4               SR4 = PREVIOUS VIRTUAL PAGE
         BE       TQVERIFY12        SAME
         LW,SR4   R5                DIFFERENT, CHECK LEGALITY
         SLS,R5   9
         BAL,R0   TQVERIFYR
TQVERIFY12 EQU    %
         LC       D2
         BCS,2    %+2
         BCS,4    TQVERIFY14
         LW,R5    *D2,R1
         LB,R5    R5
         CI,R5    QCRITERIONMAX     CHECK LIMIT
*E*
*E*      ERROR:  BC10 BAD MEMORY ADDRESS
*E*      DESCRIPTION:  CRITERIA SPECIFIED IS TOO LARGE
*E*
         BG       TQABN10
         AW,R5    *D2,R1            ADD LENGTH TO BYTE ADDRESS
         AND,R5   MASKS+19
         SLS,R5   -2
TQVERIFY13 EQU    %
         BAL,R0   TQVERIFYR
         LW,R4    R5                ENDING ADDRESS
         BAL,R0   TQVERIFYL         VERIFY PAGE IN QLIST
TQVERIFY13A EQU   %
         BDR,R1   TQVERIFY8         CHECK NEXT PTR
         B        TQPULLEXIT
TQVERIFY14 EQU    %
         LW,R5    *D2,R1            CHECK ENDING ADDRESS OF MSG
         LI,R2    QPUTGETSZ(I)
         LH,R2    *R5,R2
         CI,R2    2048
*E*
*E*      ERROR:  BC10 BAD MEMORY ADDRESS
*E*      DESCRIPTION:  SPECIFIED QUEUE MESSAGE IS TOO LARGE
*E*
         BG       TQABN10
         LI,R3    0
         SLD,R2   -2
         CI,R3    0
         BE       %+2
         AI,R2    1                 FOR WORD ADDRESS
         AW,R5    R2
         B        TQVERIFY13
         SPACE    6
TQVERIFYL EQU     %
         PUSH     R0
         LC       D2
         BCS,6    TQPULLEXIT
         BAL,R0   TQVERIFYP
         B        TQPULLEXIT
         PAGE
*                 TQVERIFYP...CHECK FOR PAGE NUMBERS IN
*                 QLIST. FOR A DEFINE ADD IT IF IT
*                 IS NOT THERE AND CALL ASSOCIATE WORK
*                 PAGE. FOR A GET, MAKE ERROR RETURN
*                                   ENTERED BAL,R0  TQVERIFYP
*                                   R4 = PAGE NUMBER (VIRTUAL)
*                                   R6 = PTR TO QLIST
*                                   SR3 = PAGE NUMBER(REAL)
*                                   SR1 = TYPE..DEFINE OR GET,ETC.
*                                         BIT 0 = 0,DEFINE; 1,OTHER
*                                         BIT 1 = 0,GET; 1,OTHER
*                                   VOLATILE REGISTERS: ,D3,D4
TQVERIFYP EQU     %
         PUSH     14,R0
         LW,SR2   R4
         LW,R4    R6
         LI,SR4   1                 OFFSET FOR PAGE CORRESPONDENCE
         LI,R5    QLNCP(I)          # PAGES IN THIS QLIST
         BAL,R0   TQGETBYTE
         BEZ      TQVERIFYPNO       NOT FOUND
         LW,R2    D4                # PAGES
         LI,R5    QLINX(I)
TQVERIFYP1 EQU    %
         LC       SR1               CHECK VIRTUAL VS REAL PAGE
         BCR,4    TQVERIFYP2        REAL
         AI,R5    1                 POSITION INDEX FOR VIRTUAL
         LW,SR3   SR2               VIRTUAL PAGE
         LI,SR4   -1                OFFSET FOR CORRESPONDENCE
TQVERIFYP2 EQU    %
         BAL,R0   TQGETHWORD
         CW,D4    SR3
         BE       TQVERIFYPYES      FOUND
         BDR,R2   TQVERIFYP6
         B        TQVERIFYP7
TQVERIFYP6 EQU    %
         AI,R5    2
         B        TQVERIFYP2        CHECK NEXT PAGE
TQVERIFYP7 EQU    %
         LI,R5    QLINXEXT(I)       IS THERE ANOTHER QLIST EXTENT
         BAL,R0   TQLOADF
         BEZ      TQVERIFYPNO       NO, NOT FOUND EXIT
         LW,R6    D3                PTR TO EXTENT
         LI,R5    QLNCP(I)          # PAGES IN QLIST
         BAL,R0   TQGETBYTE
         LW,R2    D4
         LI,R5    QLINXPEXT(I)      INDEX TO 1ST PAGE
         B        TQVERIFYP1        SEARCH THIS ONE FOR THE PAGE
*
TQVERIFYPYES EQU  %
         AW,R5    SR4               POSITION TO PAGE CORRESPONDENCE
         BAL,R0   TQGETHWORD        D4= CORRESPONDING REAL OR
*                                   VIRTUAL PAGE
         LI,D3    0                 SET FOUND PARAMETER
TQVERIFYPEXIT EQU %
         PULL     14,R0
         B        *R0
*
TQVERIFYPNO EQU   %
         CI,SR1   0                 NOT IN, SHOULD IT BE ADDED
         BGZ      TQVERIFYP8        YES
         LI,D3    1                 MAKE NOT FOUND RETURN
         B        TQVERIFYPEXIT
*
TQVERIFYP8 EQU    %
         LI,R5    QLNCP(I)          ADD PAGE TO QLIST
         BAL,R0   TQGETBYTE         CAN IT BE ADDED HERE
         CW,R4    R6
         BNE      TQVERIFYP10       IN AN EXTENT ALREADY
         LI,R5    QLINX(I)          SET FOR ACCESSING INITIAL QLIST
         CI,D4    QLINX1SZ
         B        TQVERIFYP12
TQVERIFYP10 EQU   %
         LI,R5    QLINXPEXT(I)      SET FOR ACCESSING AN EXTENT
         CI,D4    QLINX2SZ
TQVERIFYP12 EQU   %
         BGE      TQVERIFYP16       NEED AN EXTENT
         AI,D4    1
         CI,D4    1
         BE       TQVERIFYP14
         AW,R5    D4                INDEX TO ADD THE PAGE #
TQVERIFYP14 EQU   %
         LW,D3    SR3
         BAL,R0   TQSETHWORD
         AI,R5    1                 SET VIRTUAL CORRESPONDENCE
         LW,D3    SR2
         BAL,R0   TQSETHWORD
         PUSH     SR3               SAVE PAGE NUMBER
         BAL,SR4  APWP              LOCK THE PAGE
         CI,SR3   0
*E*
*E*      ERROR:  BC10 BAD MEMORY ADDRESS
*E*      DESCRIPTION:  ERROR RETURN FROM APWP TRYING TO LOCK THIS
*E*               PAGE IN MEMORY.
*E*
         BNE      TQABN10
         PULL     SR3
         LI,R5    QLNCP(I)
         LW,D3    D4
         BAL,R0   TQSETBYTE
         B        TQVERIFYPEXIT
TQVERIFYP16 EQU   %
         BAL,R0   TQGETQLIST        GET SPACE FOR QLIST EXTENT
         LI,R5    QLINXEXT(I)
         LW,D3    D1
         BAL,R0   TQSTOREF          SET LINK WORD
         LW,R6    D1
         LI,R5    QLINXPEXT(I)
         LI,D4    1
         B        TQVERIFYP14
         SPACE    6
TQVERIFYR EQU     %
*                                   VOLATILE REGISTERS:SR3
*                                   R5 SHIFTED FOR PAGE NUMBER
         AND,R5   MASKS+17
         CI,R5    16
         BGE      %+2
         AW,R5    J:BASE
         SCS,R5   -9
         DO       QSIM
         LW,SR3   R5
         AND,SR3  MASKS+8
         ELSE
         LOAD,SR3 JX:CMAP,R5
         CI,SR3   X'20'             CHECK UNASSIGNED PAGE
*E*
*E*      ERROR:  BC10 BAD MEMORY ADDRESS
*E*      DESCRIPTION:  ADDRESS SPECIFIED DOES NOT BELONG TO
*E*               THIS USER.
*E*
         BE       TQABN10           BAD, EXIT
         FIN
         B        *R0
         PAGE
*
TQGETMPOOL EQU    %
*                                   VOLATILE REGISTERS :STANDARD AND
*                                   SR4, D4 PRESERVED
         PUSH     4,D4
         LADR,D3  Q:MPOOL
         BNEZ     TQGETMPOOL2       MPOOL ALREADY ALLOCATED
         BAL,SR4  GMB
         BEZ      %-1
         SADR,D3  Q:MPOOL
TQGETMPOOL2 EQU   %
         LI,D4    0
         LI,R5    33
         STW,D4   *D3,R5
         BDR,R5   %-1
         STW,D4   *D3
         PULL     4,D4
         B        *R0
*
         PAGE
*
TQGETQLIST EQU    %
         PUSH     11,R0
TQGETQLIST2 EQU   %
         LI,SR1   QLISTLGTH
         BAL,SR4  TQCOREALLOC
         BCR,8    TQGETQLIST4
*E*
*E*      ERROR:  BC0A SPACE IS NOT AVAILABLE TO DEFINE A LIST
*E*
         LI,R5    QABN0A
         LI,R4    QRTYPE1
         LI,D2    -1                ACKNOWLEDGE WAIT OPTION
         BAL,SR4  TQCKW#ECB         WAIT USER OR INIT ECB
         TBIT,R3  Q:LOCK
         BNEZ     TQGETQLIST2       TRY AGAIN
*E*
*E*      ERROR:  BC11 QUEUE LOCKED
*E*      DESCRIPTION:  THE QUEUE WAS LOCKED WHILE THIS USER WAS
*E*               WAITING FOR A QUEUE EVENT.
*E*
         B        TQABN11           MAKE Q LOCKED EXIT
TQGETQLIST4 EQU   %
         PULL     11,R0
         B        *R0
         PAGE
TQSETWRITE EQU    %
         PUSH     R1
         LW,D3    QWRITEF(M)
         LW,D4    D3
         LI,R5    QWRITEF(I)
         AND,R6   CSTPGE
         BAL,R0   TQSETFIELD
         PULL     R1
         B        *R1
         SPACE    6
*
TQCALLMOVE4 EQU   %
         LCFI     4
         B        TQCALLMOVE
*
TQCALLMOVE5 EQU   %
         LCFI     5
TQCALLMOVE EQU    %
         STCF     R0
         PUSH     R0
         PUSH     R5
         LCF      R0
         BAL,SR4  TQMOVE
         BCS,1    TQERROR
         PULL     R5                RESTORE R5
         B        TQPULLEXIT
*
*        THIS ENTRY IS TO TQCALLMOVE FROM ANOTHER
*        OVERLAY.
*        CONDITION CODES ARE STORED IN R5 FOR TQMOVE
*        OTHER REGISTERS ARE THE SAME
*
TQMOVLY  EQU      %
         PUSH     SR4
         LCF      R5
         BAL,R0   TQCALLMOVE
         PULL     SR4
         OBSR4
TQCALLMOVE9 EQU   %
         LCFI     9
         B        TQCALLMOVE
*
TQCALLMOVE10 EQU  %
         LCFI     10
         B        TQCALLMOVE
*
TQCALLMOVE12 EQU  %
         LCFI     12
         B        TQCALLMOVE
*
TQCALLMOVE13 EQU  %
         LCFI     13
         B        TQCALLMOVE
         PAGE
TQFNDMAP EQU      %
*                                   ENTERED  BAL,R0, RETURNS
*                                   PTR TO MAP IN R6, DISPACEMENT
*                                   HALFWORD IN R5...ON ENTRY SR2
*                                   CONTAINS BLOCK NUMBER
         PUSH     R0
         AND,SR2  CSTMBR
         LW,R3    SR2
         LI,R5    CONTFIRSTGDA(I)
         L,R6     Q:CONT
         BAL,R0   TQLOADF
         SW,R3    D3
         LI,R2    0
         L,R6     Q:MAP
TQFNDMAP1 EQU     %
         LI,R5    ALLBLOCKNAV(I)    GET # BLOCKS THIS MAP SEGMENT
         BAL,R0   TQGETHWORD
         AW,R2    D4
         CW,SR2   R2
         BLE      TQFNDMAP2
         SW,R3    D4
         PUSH     R2
         AND,R6   CSTPGE
         BAL,R2   TQGETCHAIN
         PULL     R2
         LW,R6    D3
         BNEZ     TQFNDMAP1
         B        TQERROR
TQFNDMAP2 EQU     %
         LW,R5    R3
         AI,R5    ALLMAP(I)
         BAL,R0   TQGETHWORD        GET MAP CONTENT
         B        TQPULLEXIT
         PAGE
TQFETCH  EQU      %
*                                   ENTERED VIA BAL,SR4
*                                   SR2= BLOCK NUMBER
*                                   R4=  BLOCK TYPE
*                                   D2 ]= 0,CHAIN & READ BLOCK IF NEEDED
*                                   RETURNS CORE ADDRESS OF THE
*                                   BLOCK IN SR1
         PUSH     4,R4
         PUSH     2,SR3
         EXU      TQGETBLOCKS6,R4
         LI,R2    -1
         LW,SR3   SR2               BLOCK NUMBER IS CRITERIA
         LW,SR4   CSTMAP            CRITERIA MASK
         EXU      TQGETBLOCKS7,R4   SET DISPLACEMENT TO LINK WORD
         LW,SR1   TQBRANCH1
         LW,D1    SR2               SAVE BLOCK NUMBER
         BAL,R0   TQDCHAINC
         BCR,1    TQFETCH2          BLOCK IS IN CORE
*                                   GET SPACE TO READ THE BLOCK
         LW,SR2   D1                BLOCK NUMBER
         BAL,SR4  TQGETBLOCKS
         CI,SR3   0
         BE       TQFETCH4          NO MORE PAGES, MUST WRITE A
*                                   BLOCK TO FREE SPACE
         LW,SR1   SR3               BUFFER ADDRESS
         B        TQFETCH7
TQFETCH1 EQU      %
         LW,R6    SR1
         BAL,R2   TQGETCHAIN
         PUSH     D3
         BAL,R0   TQREAD            READ BLOCK
         GET,R5   Q:CC              I/O COMPLETION CODE
         CI,R5    1
*E*
*E*      ERROR:  BC16 I/O ERROR DURING A DATA BLOCK TRANSFER
*E*
         BNE      TQABN16
         LI,R5    CONTCHAIN(I)      ZERO CORE CHAINING WORD
         PULL     D3
         LW,R6    SR1
         BAL,R0   TQSTOREF          LEAVE CHAINED BIT ON
         B        TQFETCH3
TQFETCH2 EQU      %
         LW,SR1   SR2               ADDRESS OF THE BLOCK
         LW,SR2   D1                BLOCK NUMBER
TQFETCH3 EQU      %
         PULL     2,SR3
         PULL     4,R4
         B        *SR4
TQFETCH4 EQU      %
         PUSH     R4
         BAL,R0   TQRELFETCH        FIND A BLOCK TO RELEASE
         PULL     R4
         BAL,SR4  TQGETBLOCKS
         CI,SR3   0
         BE       TQFETCH4          RE-TRY
         LW,SR1   SR3
TQFETCH7 EQU      %
         CI,D2    0
         BNEZ     TQFETCH1          READ BLOCK INTO CORE
         B        TQFETCH3          BYPASS READ
         SPACE    6
TQRELFETCH EQU    %
         PUSH     R0
         LI,SR1   1                 LOOK FIRST FOR A BLOCK THAT
*                                   WE DO NOT HAVE TO WRITE OUT.
         LI,R4    2
         LW,R7    CSTPGE
TQRELFETCH2 EQU   %
         EXU      TQGETBLOCKS6,R4   CHAIN HEADER TO R5
         LW,R6    R5
TQRELFETCH2A EQU  %
         BAL,R2   TQGETCHAIN
         LW,R6    D3                FORWARD LINK
         BNEZ     TQRELFETCH4
         BDR,R4   TQRELFETCH2       TRY FOR AN INDEX BLOCK
         LI,R4    2                 NONE WITHOUT WRITE BIT SET
         AI,SR1   -1                TRY TO FIND ONE OF ANY KIND
         BGEZ     TQRELFETCH2       OR ELSE
         B        TQERROR           NOT ENOUGH CORE RESERVED
TQRELFETCH4 EQU   %
         GET,R3   Q:MPOOL
         CS,R6    QPOOLI(I),R3      BYPASS BLOCK IN USE
         BE       TQRELFETCH2A
         LI,R5    QWRITEF(I)
         LW,D4    QWRITEF(M)
         BAL,R0   TQGETFIELD
         BEZ      TQRELFETCH5
         CI,SR1   0                 KEEP SEARCHING FOR A BLOCK
         BG       TQRELFETCH2A      TO DISCARD
         LW,SR1   R6
         PUSH     16,R4
         BAL,R0   TQWRITE
         PULL     16,R4
TQRELFETCH5 EQU   %
         XW,R6    SR2               DECHAIN STOLEN BLOCK
         EXU      TQGETBLOCKS6,R4
         BAL,R0   TQDCHAINA
         BCS,1    TQERROR
         XW,R6    SR2
         LI,R1    TQPULLEXIT        SET RETURN FROM TQDCHFREE1
         PSW,R1   TSTACK
         B        TQDCHFREE1
         PAGE
TQSCANCONTROL EQU %
*                                   ENTRY: R3 = SIZE NEEDED; R4 =TYPE
*                                   D3=  MAX NAV
*                                   EXIT:R5 = MAP BASE;SR1= DISPLACEMENT
*                                   SCAN MAP FOR BLOCK OF A TYPE
*                                   WITH THE REQUIRED SPACE NEEDED
         PUSH     2,R6
         LW,SR1   D3
         L,R6     Q:CONT            PTR TO CONTROL BLOCK 1
         LI,R5    CONTFIRSTGDA(I)   GET # OF 1ST BLOCK IN MAP
         BAL,R0   TQLOADF
         LW,SR2   D3                SR2 = 1ST BLOCK # IN MAP
         LI,R5    CONTNAVGRANS(I)   GET FILE LIMIT
         BAL,R0   TQLOADF
         LW,D2    D3
         L,R6     Q:MAP             PTR TO ALLOCATION MAP
TQSMAP1  EQU      %
         LI,R5    ALLBLOCKNAV(I)    GET # ENTRIES THIS BLOCK OF THE MAP
         BAL,R0   TQGETHWORD
         LW,R7    D4
         LI,R5    ALLMAP(I)         HALFWORD INDEX TO 1ST ENTRY
TQSMAP2  EQU      %
         BAL,R0   TQGETHWORD
         BEZ      TQSMAP8           EMPTY SLOT
         CI,R3    0
         BEZ      TQSMAP9           NEED ENTIRE PAGE
         LW,R2    D4
         SLS,D4   ALLTM(D)-31       RIGHT-JUSTIFY TYPE
*                                   FLAG
         CW,D4    R4                REQUESTED TYPE
         BNE      TQSMAP4
         LW,D4    R2
         AND,D4   MASKS+8
TQSMAP3  EQU      %
         LW,R2    SR1               MAXNAV
         SW,R2    D4                MAXNAV-#ALLOCATED
         CW,R2    R3                ENOUGH LEFT FOR THIS REQUEST
         BL       TQSMAP4
         CI,R4    0
         BE       TQSMAP6
         L,R1     Q:MPOOL
         CW,SR2   QPOOLIMAGEI(I)+INDEXTTXTR(I),R1
         BE       TQSMAP6
         PUSH     11,R3             MAKE SURE CHAIN NOT LINKED
*                                   THROUGH BLOCK NOW ALLOCATING
         LW,R7    R1
         LI,D2    -1
         LI,R4    2
         BAL,SR4  TQFETCH
         LW,R6    SR1
         LI,SR3   1
         BAL,R0   TQSEARCHD
         LW,R0    SR3
         PULL     11,R3
         CI,R0    0
         BE       TQSMAP6
TQSMAP4  EQU      %
         AI,R5    1                 STEP TO NEXT MAP ENTRY
         AI,SR2   1                 STEP TO NEXT BLOCK NUMBER
         CW,SR2   D2                CHECK FILE LIMIT
         BGE      TQSMAP5           NO SPACE
         BDR,R7   TQSMAP2
         AND,R6   CSTPGE
         BAL,R2   TQGETCHAIN
         LW,R6    D3
         BNEZ     TQSMAP1           CONTINUE SEARCH
TQSMAP5  EQU      %
         LCFI     8
         B        TQSMAP7
*
TQSMAP6  EQU      %
         LW,SR1   R5
         LCFI     0
TQSMAP7  EQU      %
         STCF     SR1
         LW,R5    R6
         PULL     2,R6
         LCF      SR1
         B        *SR4
TQSMAP8  EQU      %
         LW,D3    R4
         SLS,D3   31-ALLTM(D)
         OR,D3    ALLAM(M)
         BAL,R0   TQSETHWORD
         PUSH     2,R5
         BAL,R1   TQSETWRITE        SET WRITE REQUIRED
         PULL     2,R5
         PULL     2,R0              GET BACK ENTRY TYPE
         PUSH     2,R0              TEMPORARILY
         CI,R0    0                 PUT TYPE REQUEST
         B        TQSMAP6
TQSMAP9  EQU      %                 CHECK IF PAGE IS EMPTY
         LW,R2    R4                REQUESTED TYPE
         SLS,R2   31-ALLTM(D)       POSITION
         OR,R2    ALLAM(M)
         CW,R2    D4                IS PAGE EMPTY
         BNE      TQSMAP4           NO, CHECK NEXT BLOCK
         B        TQSMAP8           USE THIS BLOCK
*
         PAGE
TQGETNID EQU      %                 ENTERED BAL,R0
*                                   ENTRY, R6 = PTR TO NAME
*                                   R2= LENGTH OF NAME
*                                   EXIT, R3 = NID BYTE DISPLACEMENT
*                                              FROM ENTRY START
*                                   R2= NID CHARACTER COUNT
         PUSH     R7
         LI,D4    QHASH             #SEGMENTS IN NAME HASH
         LI,R5    0                 BYTE DISPLACEMENT TO 1ST
*                                   CHARACTER IN THE NAME
         LI,R7    C'.'
TQGETNID1 EQU     %
         CB,R7    *R6,R5
         BE       TQGETNID2
TQGETNID1A EQU    %
         AI,R5    1
         BDR,R2   TQGETNID1         CHECK NEXT CHARACTER
*E*
*E*      ERROR:  BC13 ERROR IN PRESENTED LIST FOR PUT,DEFINE OR STATS
*E*      DESCRIPTION:  NO PERIOD WAS FOUND IN THE TRANSACTION
*E*               NAME SPECIFIED IN THE QUEUE MESSAGE.
*E*
         B        TQABN13
TQGETNID2 EQU     %
         AI,D4    -1
         BNEZ     TQGETNID1A        CONTINUE
         LW,R3    R5
         AI,R3    1
         AI,R2    -1
         PULL     R7
         STW,R3   QPOOLNIDD(I),R7
         STW,R2   QPOOLNIDC(I),R7
         B        *R0
         SPACE    6
TQGETNIDA EQU     %
         PUSH     R6
         AI,R6    QGETTEXT(I)
         BAL,R0   TQGETNID
         PULL     R6
         B        *R1
         PAGE
TQSETMAP EQU      %
*                                   UPDATE QUEUE ALLOCATION MAP
*                                   ENTERED  BAL,R0
*                                   R4 = TYPE, ALLOCATED FLAG
*                                   R5 = MAP HW DISPLACEMENT
*                                   R6 = MAP BASE ADDRESS
*                                   D3 = INCREMENT, + OR -
         PUSH     R0
         BAL,R0   TQGETHWORD
         AND,D4   MASKS+8
         AW,D3    D4
         BLEZ     TQSETMAP2
TQSETMAP1 EQU     %
         SLS,R4   31-ALLAM(D)
         OR,D3    R4
         BAL,R0   TQSETHWORD
         BAL,R1   TQSETWRITE        SET WRITE REQUIRED
         B        TQPULLEXIT
TQSETMAP2 EQU     %
         LI,D3    0
         B        TQSETMAP1
         PAGE
*****************************************************************
*                 TQSEARCH...ENTERED  BAL,SR4
*                 ALL REGISTERS EXCEPT EXIT PARAMETERS ARE NON- *
*                 VOLATILE.         ENTRY: R3 = 0 OR PTR TO PUT *
*                                               MESSAGE         *
*                                          R4 = SEARCH TYPE:   *
*                                               BIT 0 = 0,PUT   *
*                                                     ]=0,OTHER *
*                                               BIT 1 =0,QLIST QUEUE CHK*
*                                                      1,QLIST PUT MSG CHK*
*                                            = LIST INDEX IN 1-15
*                                             = ENTRY STATUS IN *
*                                               BYTE 3          *
*                                          R7 = PTR TO MPOOL   *
*                                         SR1 = 0 OR PTR TO QLIST
*                                                               *
*****************************************************************
TQSEARCH EQU      %
         PUSH     2,R6
         PUSH     7,SR2
         CI,R3    0                 SINGLE ENTRY SEARCH
         BE       TQSEARCH30        NO, LIST SEARCH
         LW,R6    R3                MESSAGE PTR
         CI,R4    0
         BGEZ     TQSEARCH1
         LB,R2    R6                GET LENGTH FROM CRIT PTR
         B        TQSEARCH2
TQSEARCH1 EQU     %
         AI,R6    QGETTEXT(I)       START OF ENTRY NAME
         SLS,R6   2
         LW,SR1   R6
         L,R2,R1 QPUTL,*R3          NAME LENGTH
TQSEARCH2 EQU     %
         STW,R2   QPOOLLCNT(I),R7   SAVE LENGTH
         BAL,R0   TQSEARCHHASH      FORM NAME HASH CODE
         B        TQSEARCH14        BLOCK # FOUND IN ICB HASH ENTRY
         CI,R3    0                 NAME NOT FOUND
         BE       TQSEARCH38        TO LIST SEARCH LOGIC
         CI,R4    0                 SINGLE SEARCH, IS PUT IN PROGRESS
         BE       TQSEARCH4         YES
TQSEARCHEXITNO EQU %                NO,MAKE NOT FOUND RETURN
         LI,R4    0
         B        TQSEARCHOUT
         SPACE    6
TQSEARCHXNO EQU %
         PULL     2,R5
         B        TQSEARCHEXITNO
TQSEARCH4 EQU     %                 PUT...NO ICB CHAIN
         PUSH     SR1
         PUSH     R5
         BAL,R0   TQSEARCHA         LOCATE AN UNALLOCATED BLOCK
*                                   R6 = PTR TO ICB
         B        TQSEARCHXNO
         PULL     R5
         LW,D3    SR2               BLOCK #, NEW BLOCK
         BAL,R0   TQSTOREF          SET BLOCK # INTO ICB
         BAL,R1   TQSETWRITE
         BAL,R0   TQSEARCHB         GET BUFFER FOR THE BLOCK
         LW,R6    SR1               PTR TO INDEX
         PULL     SR1               BA OF NAME
TQSEARCH5 EQU     %
         LI,R4    INDEXSLOT(I)      1ST SLOT IN NEW BLOCK
         AW,R6    R4                ENTRY BASE ADDRESS
         LI,R4    1
         STW,R4   QPOOLENT(I),R7
TQSEARCH9A EQU    %
         LI,R5    INDEXFR(I)
         LW,D3    INDEXFR(M)        SET SLOT IN USE
         LW,D4    D3
         BAL,R0   TQSETFIELD
         LW,D3    SR3               SR3 = SEGMENT SIZE FOR THE INDEX
         LW,R3    D3
         LI,R5    INDEXNAMESZR(I)
         BAL,R0   TQSETBYTE
         LW,D2    SR1               MOVE 1ST NAME SEGMENT TO
*                                   INDEX BLOCK
         LW,D1    R6                ADDRESS OF INDEX BLOCK
         AI,D1    INDEXNAMER(I)
         SLS,D1   2                 BYTE ADDRESSES
         AI,D1    1                 SKIP NAME COUNT BYTE
         BAL,R0   TQCALLMOVE9
         PUSH     R6
         AND,R6   CSTPGE
         LI,R5    INDEXKEYS(I)
         BAL,R0   TQGETHWORD
         AI,D4    1
         LW,D3    D4                RESTORE INCREMENTED
         BAL,R0   TQSETHWORD
         BAL,R0   TQFNDMAP          UPDATE INDEX BLOCK ALLOCATION MAP
         STW,R6   QPOOLMI(I),R7
         BAL,R0   TQGETHWORD
         AI,D4    1
         LW,D3    D4
         BAL,R0   TQSETHWORD
         PULL     R6
*                                   R4=  DISPLACEMENT TO KEY = ENTRY #
TQSEARCH10 EQU    %
         LW,SR1   R6                SR1 = ADDRESS OF THE INDEX BLOCK
*                                   OR INDEX ENTRY
         SPACE    6
TQSEARCHEXIT EQU  %
         LI,R4    1
TQSEARCHOUT EQU   %
         PULL     7,SR2
         PULL     2,R6
         B        *SR4
         SPACE    6
TQSEARCH14 EQU    %
*                                   HASH IN ICB
         LI,R5    0                 HSKP ENTRY # FOR EMPTY SLOT
*                                   ISOLATION SUBSEQUENT TO NAME SEARCH
         STW,R5   QPOOLENT(I),R7
         PUSH     R4                SAVE SEARCH CONTROL INFO
         CI,R4    0                 STATS REQUEST
         BGE      TQSEARCH15        NO
*                 FOR STATS SET UP NAME SEGMENT LENGTHS
         AI,R2    -1                SUBTRACT 1ST PERIOD
         STW,R2   QPOOLNIDC(I),R7   SECONDARY NAME SEG. LENGTH
         STW,SR3  QPOOLNIDD(I),R7   1ST NAME SEG. LENGTH
         MTW,1    QPOOLNIDD(I),R7   PLUS 1ST PERIOD
*
TQSEARCH15 EQU    %
         LI,R4    1
         PUSH     SR1               BA OF NAME
         LI,D2    1
         BAL,SR4  TQFETCH           FETCH INDEX BLOCK AT THE HEAD
         LW,R6    SR1
         PULL     SR1               BA OF NAME
         LI,R5    INDEXKEYS(I)      GET # KEYS IN BLOCK
         BAL,R0   TQGETHWORD
         LW,R3    D4
*                                   OF THIS ICB SLOT CHAIN
         LW,D1    R7                COMPUTE MPOOL SLOT FOR MOVING
*                                   NAMES FROM INDEX FOR COMPARES
         AI,D1    QPOOLIMAGEI(I)
         SLS,D1   2
         PUSH     R6                SAVE INDEX BLOCK PTR
         LI,R5    INDEXBLOCK(I)     SAVE INDEX BLOCK #
         BAL,R0   TQLOADF
         STW,D3   QPOOLIBLK(I),R7
         AI,R6    INDEXSLOT(I)      ADDRESS OF ENTRY START
TQSEARCH16 EQU    %
         LI,R5    INDEXFR(I)        IS THE KEY IN USE
         LW,D4    INDEXFR(M)
         BAL,R0   TQGETFIELD
         BNEZ     TQSEARCH17        YES, TRY TO COMPARE
         STW,R4   QPOOLENT(I),R7
         STW,R6   QPOOLI(I),R7
         AI,R3    1
         B        TQSEARCH18        CHECK NEXT KEY IN THE BLOCK
TQSEARCH17 EQU    %
         LW,R5    TSTACK
         AI,R5    -1
         LW,R5    *R5               GET SEARCH CONTROL WORD OUT OF STACK
         CI,R5    0                 IS IT A PUT TYPE REQUEST
         BGE      TQSEARCH17A       YES, DON'T TEST BYPASS BIT
         LI,R5    INDEXBYPASSR(I)
         LW,D4    INDEXBYPASSR(M)
         BAL,R0   TQGETFIELD
         BNEZ     TQSEARCH18        COMPARE NOT POSSIBLE
TQSEARCH17A EQU   %
         LI,R5    INDEXNAMER(I)*4
         BAL,R0   TQGETBYTE         GET KEY NAME SIZE
         CW,SR3   D4                COMPARE WITH SIZE UNDER SEARCH
         BNE      TQSEARCH18        COMPARE NOT POSSIBLE
         LW,D2    R6                MOVE NAME FROM INDEX TO MPOOL
         AI,D2    INDEXNAMER(I)
         SLS,D2   2
         AI,D2    1                 BYTE ADDRESS BEYOND SIZE BYTE
         PUSH     2,R3
         LW,R3    SR3               MOVE REAL TO VIRTUAL
         BAL,R0   TQCALLMOVE13      REAL TO REAL, BYTE ADDRESSING
         PULL     2,R3
         LW,D2    SR1
         STB,SR3  D2                SETUP FOR CBS
         CBS,D1   0                 COMPARE NAMES
         BCR,3    TQSEARCH26        MATCH FOUND
TQSEARCH18 EQU    %
         LW,SR4   R6
         L,R6     Q:CONT
         LI,R5    CONTKEYM(I)
         BAL,R0   TQGETBYTE
         AI,D4    QINXCSZ
         AW,SR4   D4
         LW,R6    SR4
         LW,R5    QPOOLENT(I),R7
         BNEZ     %+2
         STW,R6   QPOOLI(I),R7
         AI,R4    1                 STEP ENTRY NUMBER
         BDR,R3   TQSEARCH16
         PULL     R6
TQSEARCH18X EQU   %
         LI,R5    INDEXFLINK(I)     ALL KEYS CHECKED THIS BLOCK, IS
*                                   THERE A FORWARD BLOCK
         BAL,R0   TQLOADF
         BEZ      TQSEARCH18A
         LW,SR2   D3                FORWARD BLOCK IF ANY
         B        TQSEARCH15
         SPACE    6
TQSEARCH18A EQU   %
         PULL     R3
         CW,R3    YC
         BE       TQSEARCHEXITNO
         CI,R3    0
         BLZ      TQSEARCH38        MAKE NOT FOUND RETURN
         BNE      TQSEARCHEXITNO
         LW,R3    QPOOLENT(I),R7    PUT, WAS AN EMPTY KEY FOUND
         BEZ      TQSEARCH22        NO, ALLOCATE ANOTHER BLOCK
         CW,SR2   QPOOLIBLK(I),R7   WAS EMPTY SLOT IN LAST BLOCK SEARCHED
         BNE      TQSEARCH20        NO, FETCH BLOCK WITH SLOT
TQSEARCH19 EQU    %
         LW,R6    QPOOLI(I),R7
         B        TQSEARCH9A
         SPACE    6
TQSEARCH20 EQU    %
         LI,SR4   1
         LW,SR2   QPOOLIBLK(I),R7   FETCH BLOCK WITH EMPTY SLOT
         PUSH     SR1
         BAL,R0   TQSEARCHC         ADDRESS RETURNED IN R6
         PULL     SR1
         LW,R1    QPOOLI(I),R7
         AND,R1   MASKS+9
         AW,R6    R1
         B        TQSEARCH9A
         SPACE    6
TQSEARCH22 EQU    %
         LW,D4    R6
         SW,D4    QPOOLI(I),R7
         CI,D4    502
         BGE      %+3
         STW,R4   QPOOLENT(I),R7
         B        TQSEARCH19
         PUSH     SR2               ADDING NEW BLOCK, MUST FLINK/BLINK
         BAL,R0   TQSEARCHA         LOCATE AN EMPTY BLOCK
         B        TQSEARCH23
         LW,D3    SR2
         LI,R5    INDEXFLINK(I)
         BAL,R0   TQSTOREF          SET NEW BLOCK AS FLINK OF OLD BLOCK
         BAL,R1   TQSETWRITE        SET WRITE REQUIRED FLAG
         LI,SR4   1
         PUSH     SR1
         BAL,R0   TQSEARCHC         GET SPACE FOR NEW BLOCK
         PULL     SR1
         PULL     D3
         LI,R5    INDEXBLINK(I)
         BAL,R0   TQSTOREF
         B        TQSEARCH5
TQSEARCH23 EQU    %
         PULL     SR2
         B        TQSEARCHEXITNO
         SPACE    6
TQSEARCH26 EQU    %
*                                   NAME FOUND IN INDEX, IS THIS A
*                                   PUT REQUEST
         LW,R5    R4
         PULL     R3
         PULL     R4
*                                   DISCARD 6, RETRIEVE 4
         CI,R4    0
         BNE      TQSEARCH28
*                                   CONTINUE NID SEARCH IN DATABLOCK
         LW,R4    R5                INDEX ENTRY # = DISPLACEMENT IN BLOCK
         STW,R4   QPOOLENT(I),R7
         B        TQSEARCH10        MAKE FOUND RETURN
         PAGE
*                                   ENTRY NAME FOUND IN INDEX FOR
*                                   GET,DELETE,STATUS
TQSEARCH28 EQU    %
         PUSH     R4
         STW,R5   QPOOLENT(I),R7    SAVE INDEX ENTRY #
         STW,R6   QPOOLI(I),R7
*                                   SEARCH DATA BLOCK CHAIN THIS
*                                   NAME FOR NID MATCH
         LI,R5    INDEXHTXTR(I)     GET BLOCK # OF CHAIN HEAD
         BAL,R0   TQLOADF
         BEZ      TQERROR
         LW,SR2   D3
TQSEARCH28A EQU   %
         STW,SR2  QPOOLDBLK(I),R7
         LI,SR4   2
         PUSH     SR1
         BAL,R0   TQSEARCHC         FETCH THE DATA BLOCK
         LI,SR3   0
*                                   DATA BLOCK SEARCH ORDER:
*                                   1) INDEX BLK = BLK IN QPOOLIBLK
*                                   2) ENTRY # = QPOOLENT
*                                   3) FLAGS = R4 STATUS
*                                   4) NID = NID IN QPOOLIMAGED
*                                   YES TO ABOVE...ENTRY FOUND
*                                   NO, CHAINED TEXT CHECKED
         BAL,R0   TQSEARCHD         PERFORM TESTS 1 AND 2
*                                   RETURN IF TESTS SATISFIED
         PULL     SR1
TQSEARCH28A1 EQU  %
         LI,R5    DATASTATUSR(I)
         BAL,R0   TQGETBYTE         STATUS BYTE FROM DATA ENTRY
         STW,D4   QPOOLNAME(I),R7
         CW,R4    YC
         BE       TQSEARCH28A2
         LW,D3    R4                D4=ENTRY STATUS
         SLD,D3   -4                D3=USER FLAGS
         LI,R1    3
         CB,D4    D3,R1             IS ENTRY OF THIS STATUS DESIRED
         BE       TQSEARCH28A2      YES, CHECK NID
         AND,D3   =9                DISCARD FAILED AND DESTRUCTIVE
*                                   BITS FROM USER FLAG
         CB,D4    D3,R1             NOW IS STATUS GOOD
         BNE      TQSEARCH28H       NO
TQSEARCH28A2 EQU  %
         LW,D3    QPOOLNIDC(I),R7   NID NOT PART OF CRITERIA
         BEZ      TQSEARCH28C       ACCEPT THIS ENTRY AS A MATCH
         LI,R5    DATANAMECNTR(I)
         BAL,R0   TQGETBYTE         NID SIZE FROM D. B.
         CW,D4    QPOOLNIDC(I),R7
         BL       TQSEARCH28H       COMPARE NOT POSSIBLE
         LW,D4    R6                COMPUTE B . A. OF NID
         SLS,D4   2
         AI,D4    DATANAMECNTR(I)+1 ADD CONTROL BYTES+COUNT BYTE
         STB,D3   D4                NID SIZE
         LW,D3    R7                COMPUTE BA OF NAME IN MPOOL
         AI,D3    QPOOLIMAGED(I)
         SLS,D3   2
         AW,D3    QPOOLNIDD(I),R7
         CW,R4    YC
         BE       %+3
         CI,R4    0
         BLZ      TQSEARCH28B
         PUSH     7,D3
         LW,D1    D3
         LW,D2    SR1
         AW,D2    QPOOLNIDD(I),R7
         LB,R3    D4                NID SIZE TO MOVE
         BAL,R0   TQCALLMOVE9
         PULL     7,D3
TQSEARCH28B EQU   %
         BAL,R0   TQCBYTE           CBS UNMAPPED
         BCS,3    TQSEARCH28H       MISCOMPARE
         SPACE    6
TQSEARCH28C EQU   %                 ENTRY FOUND
         STW,SR2  QPOOLDBLK(I),R7   BLOCK #, DATA BLOCK
         STW,R6   QPOOLD(I),R7      PTR TO DATA BLOCK
         PULL     R4
         CI,R4    0
         BGE      TQSEARCH10        FOUND EXIT
         CW,R4    YC                CHECK FOR STATS
         BE       TQSEARCH10
         PULL     6,D2              LEVEL STACK, R2 = MATCH DISPLACEMENT
         LW,R2    D3
         SW,R2    D2
         AI,R2    1
         B        TQSEARCH10
         SPACE    6
TQSEARCH28H EQU   %
*                                   IS THERE ANOTHER TEXT STRING
*                                   FOR THIS KEY
         STW,SR2  QPOOLBLINKT(I),R7
         LW,R1    R6
         AND,R1   MASKS+9
         STW,R1   QPOOLBDISP(I),R7
         LI,R5    DATAFLINKR(I)
         BAL,R0   TQLOADF
         BEZ      TQSEARCH28I
         LW,SR2   D3
         CW,SR2   QPOOLDBLK(I),R7
         BNE      TQSEARCH28A
         BAL,R0   TQSEARCHDP
         B        TQSEARCH28A1
TQSEARCH28I EQU   %
         PULL     R4
         CI,R4    0
         BG       TQSEARCHEXITNO
         CW,R4    YC
         BE       TQSEARCHEXITNO
         B        TQSEARCH38
         SPACE    6
TQSEARCH30 EQU    %
*                                   START SEARCH BASED ON LIST
*                                   SR1= PTR TO QLIST
         CW,R4    Y4
         BAZ      TQSEARCH30A       SEARCH QUEUE CALL
         LW,SR1   Q:GET(A)          CHAIN HDR ACTIVE GETS FOR PUT
         BEZ      TQSEARCHEXIT
TQSEARCH30A EQU   %
         LW,R6    SR1
         LI,R5    QLGETLIST(I)
         BAL,R0   TQLOADF           GET V.W.A OF GET LIST
         LI,R5    QLGETLISTSZ(I)    LIST SIZE
         BAL,R0   TQGETHWORD
         LW,R2    D4
         LW,R3    D4
         LW,R5    R4
         SLS,R5   QGETINDEX(D)-31   RIGHT-JUSTIFY INDEX
         AND,R5   QGETINDEX(M)+MASKS
         AW,D3    R5                STARTING CRITERIA SEARCH POINT
         SW,R2    R5
*E*
*E*      ERROR:  BC13 ERROR IN PRESENTED LIST FOR PUT,DEFINE OR STATS
*E*      DESCRIPTION:  THE INDEX SPECIFIED IN THE GET IS BEYOND
*E*               THE RANGE OF THE DEFINED LIST.
*E*
         BLEZ     TQABN13           ABNORMALITY
         SLS,D3   2
         LI,R5    0
TQSEARCH31 EQU    %
         PUSH     4,R2
         LW,D4    D3
         BAL,R0   TQSEARCHE
         B        TQSEARCH42
         LW,R6    D2                REAL ADDRESS OF THE LIST
         SLS,R6   -2
         BAL,R0   TQGETWORD         CRITERION PTR
         PUSH     2,D3
         BAL,R0   TQSEARCHE         CONVERT PTR TO REAL
         B        TQSEARCH40
         LI,SR3   -1                FLAG FOR ONLY  1 MOVE
         LB,R3    D4                # BYTES IN CRITERION
         AND,D4   M11               BYTE DISPLACEMENT WITHIN THE PAGE
         AW,D4    R3
         CI,D4    X'800'            CHECK FOR PAGE BOUNDARY CROSSED
         BAZ      TQSEARCH32        NO
         AND,D4   M11               YES, TWO MOVES REQUIRED...SAVE
*                                   RESIDUAL COUNT FOR SECOND MOVE
         STW,D4   SR3
         SW,R3    SR3
TQSEARCH32 EQU    %
         LW,D1    R7                MOVE CRITERION NAME TO MPOOL
         AI,D1    QPOOLIMAGED(I)
         SLS,D1   2
         BAL,R0   TQCALLMOVE13
         CI,SR3   0                 IS A SECOND MOVE NEEDED
         BLZ      TQSEARCH36        IF SR3  IS LESS THAN ZERO ONLY 1
*                                   MOVE WAS NECESSARY
         LW,D1    D4
         PULL     D4
         PUSH     D4
         AW,D4    R3
         BAL,R0   TQSEARCHE         GET REAL ADD FOR NEXT MOVE
         B        TQSEARCH40
         LW,R3    SR3               COUNT
         BAL,R0   TQCALLMOVE13
TQSEARCH36 EQU    %
         LW,R5    D3                REAL ADDRESS OF FLAG BYTE
         LI,R6    0
         BAL,R0   TQGETBYTE
         CW,R4    Y4                GET REQUEST
         BAZ      TQSEARCH36A       YES, CHECK STATUS LATER
         OR,D4    X80               D4=USER FLAGS+QUEUED BIT
         LW,D3    R4                D3=ENTRY STATUS (FROM PUT)
         SLD,D3   -4
         LI,R1    3
         CB,D4    D3,R1             IS ENTRY OF STATUS DESIRED
         BE       TQSEARCH36A       YES, CONTINUE CHECK
         AND,D4   =9                DISCARD FAILED AND DESTRUCTIVE
*                                   BITS FROM USER STATUS
         CB,D4    D3,R1             NOW IS STATUS GOOD
         BE       TQSEARCH36A       YES
         PULL     2,D3              IF STATUS DOES NOT MATCH
         B        TQSEARCH38A       STEP TO NEXT LIST ENTRY
*
TQSEARCH36A EQU   %                 THIS ENTRY MAY BE A WINNER
         AND,R4   YFFFF
         OR,R4    D4                STATUS BYTE
         OR,R4    X80
         STW,R4   QPOOLPUTDW(I),R7  SAVE FLAG FOR DESTRUCTIVE GETS
         PULL     2,D3
         LW,R6    R7
         AI,R6    QPOOLIMAGED(I)
         LB,R2    D4
         PUSH     R2
         BAL,R0   TQGETNID
         PULL     R2
         SLS,R6   2
         CW,R4    Y4                CHECK PUT COMPARE REQUEST
         BAZ      TQSEARCH37        NO, NORMAL QUEUE SEARCH
*                                   COMPARE NAME FROM GET LIST
*                                   AGAINST PUT MESSAGE
         CW,R2    QPOOLLCNT(I),R7   COMPARE SIZES
         BG       TQSEARCH38A
         LW,D2    R7
         AI,D2    QPOOLIMAGED(I)    NAME FROM GET LIST
         LW,D1    QPOOLLST(I),R7
         AI,D1    QGETTEXT(I)       PUT NAME
         SLS,D1   2
         SLS,D2   2
         STB,R2   D2                CRITERION LENGTH
         CBS,D1   0
         BCS,3    TQSEARCH38A       GET NEXT GET NAME
         LW,R6    SR1               PTR TO QLIST
         PUSH     R7
         LI,R5    QLUSR(I)
         BAL,R0   TQGETBYTE
         LW,R7    D4
         LI,R5    QLECB(I)
         LI,R2    QLWAIT(I)
         LW,D3    QLWAIT(M)
         BAL,R0   TQWAKEPOST        WAKE USER OR POST ECB
         LI,R5    Q:GET(A)          DECHAIN QLIST FROM ACTIVE GET CHAIN
         LW,SR2   R6
         AND,SR2  CSTMAP
         BAL,R0   TQDCHAINA
         LI,R5    Q:DEF(A)          PLACE LIST ON INACTIVE CHAIN
         BAL,R1   TQCH
         PULL     R7
         PULL     4,R2
         B        TQSEARCH39        CHECK NEXT GET LIST
         SPACE    6
TQSEARCH37 EQU    %
         PUSH     D3
         PUSH     SR1
         LW,SR1   R6
         LI,R3    0
         B        TQSEARCH2
TQSEARCH38 EQU    %
         PULL     SR1               PTR TO QLIST
         PULL     D3                BYTE ADDRESS OF THE LIST
TQSEARCH38A EQU   %
         PULL     4,R2
         AI,D3    4                 STEP TO NEXT LIST ENTRY
         BDR,R2   TQSEARCH31        CHECK FOR AMATCH
         CW,R4    Y4                CHECK PUT FUNCTION
         BAZ      TQSEARCHEXITNO    NO, MAKE NOT FOUND RETURN
         LW,R6    SR1               PTR TO QLIST
TQSEARCH39 EQU    %
         BAL,R2   TQGETCHAIN        CHECK FOR MORE QLISTS
         BEZ      TQSEARCHEXIT
         LW,SR1   D3                NEXT QLIST
         B        TQSEARCH30A       CONTINUE COMPARES
TQSEARCH40 EQU    %
         PULL     2,D3
TQSEARCH42 EQU    %
         PULL     4,R2
         B        TQSEARCHEXITNO
         SPACE    6
TQSEARCHA EQU     %
*                                   GET AN UNALLOCATED QUEUE BLOCK
         PUSH     R0
         L,D3,R1  Q:INXNAV
         LI,R3    0
         LI,R4    0
         BAL,SR4  TQSCANCONTROL     SEARCH THE MAP
         BCR,8    TQSEARCHA2        BLOCK AVAILABLE
*E*
*E*      ERROR:  BC07 QUEUE SATURATED
*E*      DESCRIPTION:  KEY HASHES INTO A NEW ICB SLOT BUT NO
*E*               NEW INDEX BLOCK IS AVAILABLE.
*E*
         LI,R5    QABN07            NO SPACE ABN
         B        TQPULLEXIT
TQSEARCHA2 EQU    %
         LI,R4    1
         LCI      3
         BAL,R0   TQSETBLOCK
TQPULLEXIT1 EQU   %
         PULL     R0
         AI,R0    1
         B        *R0
         SPACE    6
TQSEARCHB EQU     %
         PUSH     R0
         LI,R4    1
         LI,D2    0
         BAL,SR4  TQFETCH
         B        TQPULLEXIT
         SPACE    6
TQSEARCHC EQU     %
*                                   FETCH,CHAIN,READ BLOCKS
         PUSH     R0
         PUSH     R4
         LW,R4    SR4               BLOCK TYPE
         LI,D2    1
         BAL,SR4  TQFETCH
         LW,R6    SR1
         PULL     R4
         B        TQPULLEXIT
         SPACE    6
TQSEARCHD EQU     %
         PUSH     R0
*                                   PERFORM SEARCH COMPARES:
*                                   INDEX BLK = QPOOLIBLK
*                                   ENTRY# = QPOOLENT
         BAL,R0   TQFNDMAP
         LW,R2    D4
         AND,R2   MASKS+9
         BEZ      TQSEARCHD5
         SLS,R2   1
         AI,R2    QDATAENTST
         LW,R6    SR1               PTR TO DATA BLOCK
         AI,R6    QDATAENTST        ENTRY START
TQSEARCHD2 EQU    %
         LI,R5    DATAINDEXR(I)
         BAL,R0   TQLOADF           INDEX BLOCK # IN TEXT ENTRY
         CW,D3    QPOOLIBLK(I),R7
         BNE      TQSEARCHD4
         LI,R5    DATAENTRY#R(I)
         BAL,R0   TQGETBYTE
         CW,D4    QPOOLENT(I),R7
         BE       TQPULLEXIT
TQSEARCHD4 EQU    %
         PUSH     R2
         BAL,R2   TQTXTSZ
*                                   D3=BYTE COUNT TO NXT ENTRY
         PULL     R2
         AI,D3    QDATACSZ-1+7      ADD CONTROL BYTES AND
         SLS,D3   -3                ROUND UP TO DW BOUNDARY
         SLS,D3   1                 BACK TO WORDS
         AW,R6    D3                COMPUTE START OF NEXT ENTRY
         LW,D3    R6
         LW,D4    MASKS+9
         CS,D3    R2                ARE WE AT THE END OF BLOCK
         BL       TQSEARCHD2        NO, CONTINUE COMPARE
TQSEARCHD5 EQU    %
         CI,SR3   0
         BE       TQERROR
         LI,SR3   0
         B        TQPULLEXIT
TQSEARCHDP EQU    %                 ENTRY PT FOR PUT CHAINING
         PUSH     R0
         B        TQSEARCHD4
         SPACE    6
TQTXTSZ  EQU      %
         LI,R5    DATANAMECNTR(I)
         BAL,R0   TQGETBYTE
         LW,D3    D4
         AW,R5    D4
         AI,D3    1+3               ADD COUNT BYTE AND
         AND,D3   XFFFFFC           ROUND UP TO WD BOUNDARY
         SLS,R5   -2
         AI,R5    1
         SLS,R5   1
         BAL,R0   TQGETHWORD
         AW,D3    D4
         AI,D3    2                 TEXT COUNT BYTES
         B        *R2
         SPACE    6
TQSEARCHE EQU     %                 CONVERT TO REAL ADDRESSES
*                                   USING REAL-VIRTUAL QLIST DATA
         PUSH     R0
         PUSH     R4
         PUSH     2,D3
         SCS,D4   -11               RIGHT-JUSTIFY PAGE NUMBER
         LW,R4    D4
         AND,R4   MASKS+8
         LW,R6    SR1               QLIST POINTER
         OR,SR1   YC                SET FLAG FOR VERIFYP
         BAL,R0   TQVERIFYP
         AND,SR1  CSTMAP            CLEAN OFF VERIFYP FLAGS
         CI,D3    0
         BNE      TQSEARCHE6        PAGE NOT IN QLIST
         LW,SR4   D4                D4=REAL PAGE NUMBER
         PULL     2,D3
         LI,R1    1
         LW,D2    D4
         SCS,D2   -11
         STH,SR4  D2,R1
         SCS,D2   11
         PULL     R4
         B        TQPULLEXIT1
TQSEARCHE6 EQU    %
         LI,R5    QLUSR(I)
         BAL,R0   TQGETBYTE
         LW,R6    D4
         PUSH     7,R7
         OVERLAY  TQOV2SEG,TQ:ABORT#   ABORT QUEUE USER
*                                   RETURN IF NOT THE CURRENT USER
*                                   OTHERWISE NOT
TQSEARCHRTN EQU   %
         PULL     7,R7
         PULL     2,D3
         PULL     R4
         B        TQPULLEXIT
         SPACE    6
TQSEARCHHASH EQU  %                 ENTERED  BAL,R0
*                                   FORM HASH FOR ICB CHECK
*                                   R6= BA (NAME), R2= NAME LENGTH
*                                   EXIT: R5= ICB INDEX, SR2= CONTENT
*                                   RETURN *RO, CHAIN PRESENT
*                                          *R0+1, CHAIN EMPTY
         PUSH     R0
         LD,D1    X0
         LW,R1    R6
         LI,D3    QHASH
         LI,D4    C'.'
TQHASH2  EQU      %
         CB,D4    0,R1              CHECK FOR PERIOD
         BE       TQHASH8
         LB,R5    0,R1
         AW,D2    R5
         SLS,D2   1
TQHASH4  EQU      %
         AI,R1    1                 COUNT SEGMENT
         BDR,R2   TQHASH2
TQHASH6  EQU      %
         LW,SR3   R1
         SW,SR3   R6
         LI,R5    CONTKEYM(I)       CHECK FOR 1ST NAME SEGMENT > KEYMAX
         L,R6     Q:CONT
         BAL,R0   TQGETBYTE
         SLS,D4   2
         AI,D4    -1                ADJUST FOR COUNT BYTE
         CW,D4    SR3
*E*
*E*      ERROR:  BC13 ERROR IN LIST PRESENTED FOR PUT,DEFINE OR STATS
*E*      DESCRIPTION:  GIVEN FIRST NAME SEGMENT IS LARGER THAN
*E*               KEYMAX.
*E*
         BL       TQABN13
         LI,R5    CONTNAVGRANS(I)
         BAL,R0   TQLOADF
         SLS,D3   -2                USE 1/4 FILE SIZE AS INDEX
*                                   BLOCK ALLOCATABLE
         BNEZ     %+2
         LI,D3    1
         LW,R1    D3                # ENTRIES IN ICB
         AND,R1   MASKS+8           256 MAXIMUM PRESENT
         DW,D1    R1                FORM HASH
         LW,R5    D1
         AI,R5    ICBHASH(I)        BIAS TO START
         L,R6     Q:INXCONTROL      PTR TO ICB
         BAL,R0   TQLOADF           GET ICB WORD THIS SLOT
         LW,SR2   D3
         BEZ      TQPULLEXIT1       EMPTY
         B        TQPULLEXIT
TQHASH8  EQU      %
         AI,D3    -1                DECREMENT HASH SEGMENT CTR
         BNEZ     TQHASH4           CONTINUE HASHING
         B        TQHASH6
         PAGE
*************************************************************
*                                   TQDELENT....DELETE AN   *
*                                   ENTRY FROM THE QUEUE.   *
*                                   ENTERED BAL,R3          *
*                                   R6 = POINTER TO MESSAGE *
*                                   VOLATILE REGISTERS:     *
*                                      STANDARD             *
*************************************************************
TQDELENT EQU      %
         PUSH     R3
         PUSH     6,R6
         LI,R4    X'90'
         LW,R3    R6
         BAL,SR4  TQSEARCH
         CI,R4    0
         BNE      TQDELENT2         ENTRY FOUND
TQDFEXIT EQU      %                 NOT FOUND RETURN
         LCFI     1
TQDFEXIT2 EQU     %
TQDELENTEXIT EQU  %
         STCF     R0
         PULL     6,R6
         PULL     R3
         LC       R0
         B        *R3
         SPACE    6
TQDELENT2 EQU     %
         LW,SR2   QPOOLDBLK(I),R7   BLOCK #, DATA BLOCK
         STW,SR1  QPOOLD(I),R7
         LW,R6    SR1
         LI,R5    DATASTATUSR(I)    GET ENTRY STATUS
         BAL,R0   TQGETBYTE
         CW,D4    QFLAGF(M)         CHECK FOR FAILED STATUS
         BAZ      TQDELENT2A        NOT FAILED, CONTINUE
         LI,R4    2
         LCFI     2
         BAL,R0   TQSETBLOCK        DECREMENT # FAILED ENTRIES
TQDELENT2A EQU    %
         LI,R5    DATAFLINKR(I)     SAVE FORWARD LINK
         BAL,R0   TQLOADF
         STW,D3   QPOOLFLINKT(I),R7
         BAL,R1   TQSETWRITE        SET WRITE REQUIRED
         LW,R6    SR1
         BAL,R2   TQTXTSZ           COMPUTE SIZE OF THE TEXT ENTRY
         AI,D3    QDATACSZ-1+7      ADD CONTROL BYTES AND
         SLS,D3   -3                ROUND UP TO THE #DWS IN ENTRY
         LW,SR3   D3
         STW,D3   QPOOLPUTDW(I),R7
         BAL,R0   TQFNDMAP          LOCATE ALLOCATION MAP FOR THE BLOCK
         STW,R5   QPOOLDMAP(I),R7
         STW,R6   QPOOLMD(I),R7
         AND,D4   ALLNAV(M)+MASKS
         LW,D3    QPOOLPUTDW(I),R7
         CW,D3    D4
         BE       TQDELENT4         ONLY ENTRY PACK NOT REQUIRED
         SLD,D3   1                 CHECK FOR BEING LAST ENTRY
         LW,R6    QPOOLD(I),R7
         AND,R6   CSTPGE
         LW,D2    QPOOLD(I),R7
         AW,D2    D3                ADDRESS OF ENTRY FOLLOWING
         AW,D4    R6
         AI,D4    2                 LOGICAL END OF BLOCK
         CW,D4    D2
         BE       TQDELENT4         MOVE NOT NEEDED
         LW,D1    QPOOLD(I),R7      MOVE DESTINATION ( OVER DELETED ENTRY)
         LW,R3    D4                COMPUTE MOVE SIZE TO MOVE UP ENTRIES
*                                   TO RE-PACK THE BLOCK
         SW,R3    D2
         SLS,R3   2                 NUMBER OF BYTES TO MOVE
         BAL,R0   TQCALLMOVE12
TQDELENT4 EQU     %
         LW,R5    QPOOLDMAP(I),R7
         LW,R6    QPOOLMD(I),R7
         LCW,D3   SR3
         LI,R4    3
         BAL,R0   TQSETMAP          DECREMENT NAV
         SPACE    6
*                                   UPDATE KEY DATA
         LW,R6    QPOOLI(I),R7
         LI,R5    INDEXCOUNTR(I)
         LW,D4    INDEXCOUNTR(M)+MASKS DECREMENT COUNT THIS KEY
         BAL,R0   TQGETFIELD
         AI,D3    -1
         BAL,R0   TQSETFIELD
         CI,D3    0
         BNEZ     TQDELENT10        NOT ONLY ENTRY THIS NAME
         LW,D4    INDEXFR(M)        INDICATE EMPTY KEY SLOT
         LI,D3    0
         DO1      INDEXFR(I)]=INDEXCOUNTR(I)
         LI,R5    INDEXFR(I)
         BAL,R0   TQSETFIELD
         LI,R5    INDEXTTXTR(I)     ZERO TAIL
         BAL,R0   TQSTOREF
         LW,R6    QPOOLI(I),R7      DECREMENT NAV IN THE BLOCK
         AND,R6   CSTPGE
         STW,R6   QPOOLI(I),R7
         LI,R5    INDEXKEYS(I)
         BAL,R0   TQGETHWORD
         AI,D4    -1
         LW,D3    D4
         BAL,R0   TQSETHWORD
         CI,D3    0
         BNEZ     TQDELENT5
*                                   UPDATE INDEX CHAIN
         LI,R5    INDEXBLINK(I)     IS THERE A BACK LINK
         BAL,R0   TQLOADF
         STW,D3   QPOOLBLINKI(I),R7
         BEZ      TQDELENT4A        NO
         LW,SR2   D3
         LI,R5    INDEXFLINK(I)
         BAL,R0   TQLOADF
         STW,D3   QPOOLFLINKI(I),R7
         LI,SR4   1
         BAL,R0   TQSEARCHC
         LI,R5    INDEXFLINK(I)     R6 = ADD OF THE BLOCK
         LW,D3    QPOOLFLINKI(I),R7
         BAL,R0   TQSTOREF
         BAL,R1   TQSETWRITE
         LW,R6    QPOOLI(I),R7
TQDELENT4A EQU    %
         LI,R5    INDEXFLINK(I)
         BAL,R0   TQLOADF
         STW,D3   QPOOLFLINKI(I),R7
         BEZ      TQDELENT4B
         LW,SR2   D3
         LI,SR4   1
         BAL,R0   TQSEARCHC
         LW,D3    QPOOLBLINKI(I),R7
         LI,R5    INDEXBLINK(I)
         BAL,R0   TQSTOREF
         BAL,R1   TQSETWRITE
         LW,R6    QPOOLI(I),R7
TQDELENT4B EQU    %
         LI,R4    2
         LCI      3
         BAL,R0   TQSETBLOCK
         LW,SR2   QPOOLIBLK(I),R7
         BAL,R0   TQHSKPICB         UPDATE HDR PTR IF NEEDED
TQDELENT5 EQU     %
         LW,SR2   QPOOLIBLK(I),R7
         BAL,R0   TQFNDMAP
         LI,D3    -1
         LI,R4    1
         BAL,R0   TQSETMAP
TQDELENT9 EQU     %
         LW,R6    QPOOLI(I),R7      SET WRITE REQUIRED ON INDEX BLOCK
         BAL,R1   TQSETWRITE
         LI,R4    2
         LCFI     0
         BAL,R0   TQSETBLOCK        DECREMENT # ENTRIES QUEUED
         LI,SR3   QRTYPE2
         LI,R7    0
         BAL,R0   TQUQA
         LCFI     0
         B        TQDELENTEXIT
         SPACE    6
TQDELENT10 EQU    %
*                                   UPDATE TEXT CHAIN IN INDEX KEY
         LW,R6    QPOOLI(I),R7
         LI,R5    INDEXHTXTR(I)     DEQUEUED ENTRY WAS AT HEAD OF CHAIN
         BAL,R0   TQLOADF
         CW,D3    QPOOLDBLK(I),R7
         BNE      TQDELENT11
         PUSH     2,R5
         LW,SR1   QPOOLD(I),R7      DATA BLOCK ENTRY ADDRESS
         AND,SR1  CSTPGE
         LI,SR3   1
         BAL,R0   TQSEARCHD
         CI,SR3   0
         BNE      TQDELENT11P
         PULL     2,R5
         LW,D3    QPOOLFLINKT(I),R7
         BAL,R0   TQSTOREF
TQDELENT11 EQU    %
         LI,R5    INDEXTTXTR(I)     CHECK TAIL
         BAL,R0   TQLOADF
         CW,D3    QPOOLDBLK(I),R7
         BNE      TQDELENT12
         PUSH     2,R5
         LW,SR1   QPOOLD(I),R7      DATA BLOCK ENTRY ADDRESS
         AND,SR1  CSTPGE
         LI,SR3   1
         BAL,R0   TQSEARCHD
         PULL     2,R5
         CI,SR3   0
         BNE      TQDELENT12
         LW,D3    QPOOLBLINKT(I),R7
         BEZ      TQDELENT9
         BAL,R0   TQSTOREF
TQDELENT12 EQU    %
         LW,SR2   QPOOLBLINKT(I),R7
         BEZ      TQDELENT9
         LI,R4    2                 FETCH BACK LINK
         LI,D2    -1
         BAL,SR4  TQFETCH
         AW,SR1   QPOOLBDISP(I),R7
         LW,R6    SR1
         LW,D3    QPOOLFLINKT(I),R7
         LI,R5    DATAFLINKR(I)
         BAL,R0   TQSTOREF
         BAL,R1   TQSETWRITE
         B        TQDELENT9
TQDELENT11P EQU   %
         PULL     2,R5
         B        TQDELENT11
TQDELETE EQU      %                 DELETE FOR DESTRUCTIVE GET
         PUSH     R3
         PUSH     6,R6
         B        TQDELENT2
         PAGE
**************************************************************
*                 TQFAILURE....MARK ENTRY AS FAILED OR NO    *
*                 LONGER IN PROGRESS.
*                 ENTERED  BAL,R3  TQFAILURE                 *
*                                   R6 = PTR TO MESSAGE      *
*                                        BYTE 0 = NEW STATUS *
*                                                 IN CC FIELD*
*                                   R7 = PTR TO MPOOL        *
*                                   VOLATILE REGISTERS:      *
*                                        STANDARD            *
**************************************************************
TQFAILURE EQU     %
         PUSH     R3
         PUSH     6,R6
         LW,R3    R6
         LI,R4    X'90'
         BAL,SR4  TQSEARCH
         CI,R4    0
         BEZ      TQDFEXIT          NOT FOUND RETURN
         LW,R6    SR1
         LI,R5    DATASTATUSR(I)
         BAL,R0   TQGETBYTE
         LW,SR1   D4
         LB,R1    R7
         OR,SR1   R1
         LW,D4    QFLAGP(M)
         LI,D3    0                 ALWAYS RESET IN PROGRESS FLAG
         STS,D3   SR1
         LW,D3    SR1
         BAL,R0   TQSETBYTE
         BAL,R1   TQSETWRITE
         LI,R4    2
         LCFI     1
         BAL,R0   TQSETBLOCK        DECREMENT # ENTRIES IN PROGRESS
         LC       R7
         BCR,2    TQFAILURE2
         LI,R4    1
         LCFI     2
         BAL,R0   TQSETBLOCK
TQFAILURE2 EQU    %
         LCFI     0
         B        TQDFEXIT2         RETURN
         PAGE
*                                   INTERFACE TO CHAIN/DECHAIN
TQCH     EQU      %
         LI,R2    TQCHAIN
TQC1     EQU      %
         BAL,R0   *R2
         BCS,1    TQERROR
         B        *R1
TQDCH    EQU      %
         LI,R2    TQDCHAIN
         B        TQC1
         SPACE    6
TQDCHFREE EQU     %
         PUSH     R1
         BAL,R1   TQDCH
TQDCHFREE1 EQU    %                 ENTRY PT FROM RELFETCH
         LW,SR3   R6
         SLS,SR3  -9
         BAL,SR4  FPWP
         CI,SR3   0
         BNE      TQERROR
         LBYTE,R2,R1 Q:PAGES
         AI,R2    -1
         SBYTE,R2,R1 Q:PAGES
         PULL     R1
         B        *R1
         SPACE    6
TQCHC    EQU      %                 R7 AND SR2 ALREADY SET
         LI,D4    TQCHAINC
         LW,SR1   TQBRANCH3
TQF      EQU      %
         EXU      TQGETBLOCKS6,R4
         PUSH     R6
         BAL,R0   *D4
         PULL     R6
         LCF      SR2
         B        *R1
TQDCHC   EQU      %                 R7 ALREADY SET
         LI,D4    TQDCHAINC
         LW,SR1   TQBRANCH1
         B        TQF
         PAGE
*S*************************************************************
*S*      SCREECH CODE: 34           CALLED FROM THROUGHOUT TPQ1
*S*      MESSAGE: TRANSACTION PROCESSING FAILURE
*S*
*S*      REMARKS: A TP FAILURE FROM SOME UNEXPECTED EVENT
*S*               CAUSES A SCREECH FOR TWO REASONS.  THE FIRST
*S*               IS THAT THE CURRENT USER MAY NOT BE THE
*S*               CAUSE OF THE PROBLEM, AND THEREFORE CANNOT
*S*               BE ABORTED TO SOLVE IT.  SECOND, BY SCREECHING
*S*               WE CAN INSURE THAT TRANSACTIONS IN-PROGRESS
*S*               CURRENTLY IN THE QUEUE CAN BE RETAINED AND
*S*               RECOVERED PROPERLY.
*S*************************************************************
TQERROR  EQU      %
         DO       QSIM
         B        SCREECH
         ELSE
         SCREECH  QSCREECH
         FIN
XFFFFFC  DATA     X'FFFFFC'
         END      TPQ1:

