***********************************************************
*M*      TPQ2     TP QUEUE MANAGER (PART 2)
***********************************************************
*P*
*P*      NAME:    TPQ2, TP QUEUE MANAGER (PART 2)
*P*
*P*      PURPOSE: TPQ2 CONTAINS THE LESS FREQUENTLY USED
*P*               PORTION OF THE QUEUE MANAGER.  THIS
*P*               INCLUDES PURGE, LOCK, AND UNLOCK
*P*               PROCESSING; THE TP AUTHORIZATION CHECK;
*P*               AND ABORT PROCESSING.
*P*
*P*      DESCRIPTION:  THIS QUEUE MANAGER SECTION IS
*P*               CALLED BY TPQ1 WHENEVER REQUIRED, AND RETURNS
*P*               THROUGH TPQ1.
*P*
*P*               TPQ2 USES ROUTINES IN TPQ1 TO SET UP AND
*P*               PERFORM QUEUE I/O AND TO ZERO PHYSICAL
*P*               PAGES.
*P*
*P*               TPQ2 FUNCTION USAGE:
*P*
*P*               UNLOCK -          CALLED AT THE BEGINNING OF A
*P*                                 TP SESSION BY THE TPG.
*P*
*P*               LOCK -            CALLED AT THE END OF A TP
*P*                                 SESSION OR DURING A JOURNAL
*P*                                 VOLUME SWITCH BY THE TPG.
*P*
*P*               AUTHORIZATION -   CALLED FOR A TP USER AT THE
*P*                                 TIME OF THE FIRST M:QUEUE CAL.
*P*
*P*               ABORT -           CALLED WHEN A TP USER IS BEING
*P*                                 ABORTED (I.E. NO RETURN TO THE
*P*                                 USER.
*P*
*P*               PURGE -           CALLED BY JOB STEP TERMINATION
*P*                                 TO CLEAN UP AFTER A TP USER.
*P*                                 CALLED BY A TP USER TO DISCARD
*P*                                 A CURRENTLY DEFINED GET LIST.
*P*
         PCC      0
         SYSTEM   UTS
         SYSTEM   TP:TPO
         SYSTEM   LP:TPOQ
         PAGE
*
*  REFS TO ROUTINES IN TQROOT
*
         REF      TQCHAIN           ADD TO END OF CHAIN
         REF      TQCHAINC          ADD TO CHAIN BASED ON CRITERIA
         REF      TQDCHAIN          REMOVE FROM TOP OF CHAIN
         REF      TQDCHAINA         REMOVE SPECIFIED ELEMENT FROM CHAIN
         REF      TQDCHAINC         REMOVE FROM CHAIN BASED ON CRITERIA
         REF      TQCHKBIT          INITIALIZE AND CHECK FPT BIT
         REF      TQCHKBIT1         CHECK NEXT FPT BIT
         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 BYTE STRINGS IN REAL PAGE
         REF      TQMOVEBS          MOVE BYTE STRINGS IN REAL PAGE
         REF      TQMOVEBSZ         ZERO BYTE STRINGS IN REAL PAGE
         REF      TQNEWQ            CALL NEWQ FOR QUEUE I/O
*
*  REFS TO MONITOR SERVICES
*
         REF      GETSNADR          GET QUEUE SERIAL NUMBERS
         REF      GMB               GET MPOOL BUFFER
         REF      RMB               RELEASE MPOOL BUFFER
         REF      GPWP              GET PHYSICAL WORK PAGE
         REF      RPWP              RELEASE PHYSICAL WORK PAGE
         REF      FPWP              FREE PHYSICAL WORK PAGE
         REF      ECBPOST           POST USER ECB
         REF      T:ABORTM          ABORT THIS USER
         REF      T:RUE             REPORT USER EVENT
*
*  REFS TO ROUTINES ALSO IN THIS OVERLAY
*
         REF      CNMPROC0          M:GETLINE
         REF      CNMPROC1          M:RLSLINE
         REF      CNMPROC2          M:BUFSTAT
         REF      CNMPROC3          M:PURGE
         REF      CNMPROC4          M:MDFLST
         REF      CNMPROC9          CONVERT LINE ID TO LN#/DCTX
         REF      ECBCHECK          M:CHECKECB
         REF      ECBCHCK1          INTERNAL CHECKECB CALL
*
*  REFS TO MONITOR TABLES AND CONSTANTS
*
         REF      AVRTBLSIZ         NUMBER OF TAPE ENTRIES
         REF      AVRTBLNE          TAPES PLUS PRIVATE PACKS
         REF      AVRTBL            AVR TABLES
         REF      AVRID             USER #/SERIAL ID
         REF      BATAPE            FIRST TAPE DCT INDEX
         REF      HGP               ALLOCATION TABLES
         REF      J:ASSIGN          TP AUTHORIZATION FLAG IN BIT 9
         REF      J:DCBLINK         ADDRESS OF DCB TABLE
         REF      JB:PRIV           USER PRIVILEGE
         REF,2    JH:LDCF           FEATURE AUTHORIZATION BITS
         REF      JX:CMAP           USER REAL PAGES
         REF      E:UQA             UNQUEUE FOR ACCESS EVENT
         REF      S:CUN             CURRENT USER NUMBER
         REF      UH:FLG2           BIT 23 = ACTIVE TP USER
         REF      SH:SYMT           AUTHORIZED RESOURCES TABLE
         REF      SV:FTYM           NUMBER OF AUTHORIZED RESOURCES
         REF      M17               ADDRESS MASK
         REF      XFFFF             HALFWORD MASK
         REF      X1FFFE            MASK TO FIND USER PSD IN STACK
         REF      X3FFE00           MASK FOR PAGE NUMBER
         REF      Y00FE             MASK FOR ERROR SUBCODE
         REF      YF                MASK TO STORE COND. CODES IN PSD
         GENREFS
CSTMBS   EQU      BT31TO0+32        BIT 0 (ON)
CSTMBR   EQU      NB31TO0+32        BIT 0 (OFF)
CSTPGE   EQU      X3FFE00           MASK FOR PAGE NUMBER
*
*  REFS FOR TPQ1 OVERLAY
*
         REF      TQ:RTN#           POST ECB AND RETURN TO USER
         REF      TQ:NEWQ#          PERFORM QUEUE I/O OPERATION
         REF      TQ:MOVE#          SET UP AND MOVE REAL BYTE STRINGS
         REF      TQOV1SEG          TPQ1 OVERLAY NAME
*
*  DEFS FOR THIS OVERLAY
*
         DEF      TQAUTH            TP AUTHORIZATION CHECK
         DEF      TPQ2:             XDELTA SYMBOL
TPQ2:    EQU      %
*
*
         PAGE
*
TQOVLY2  EQU      %
*----------------------*
         BLOCK                      TP CANT RUN ON SLAVE CPU'S
*----------------------*
         AI,R0    OVLY              BRANCH TABLE ADDRESS
         B        *R0               ENTER OVERLAY
OVLY     EQU      %
         B        TQABORT           ABORT QUEUE USER
         B        TQUNLOCK          UNLOCK THE QUEUE
         B        TQPURGE1          PURGE LIST OR ALL LISTS
         B        TQLOCK            LOCK THE QUEUE
         B        ECBCHCK1          INTERNAL CHECKECB CALL
         B        CNMPROC9          CONVERT EBCDIC LINE ID TO LN#/DCTX
         B        CNMPROC0          CAL1,7 0 M:GETLINE
         B        CNMPROC1          CAL1,7 1 M:RLSLINE
         B        CNMPROC2          CAL1,7 2 M:BUFSTAT
         B        CNMPROC3          CAL1,7 3 M:PURGE
         B        CNMPROC4          CAL1,7 4 M:MDFLST
         B        ECBCHECK          CAL1,7 5 M:CHECKECB
         B        TQAUTH            CHECK TP USER AUTHORITY
         PAGE
*DO*
*D*
*        NAME:    TQUNLOCK, UNLOCK THE QUEUE
*
*        CALL:    OVERTO FROM TPQ1 FOR 'UNLOCK' CAL PROCESSING
*
*        INPUT:   R6 = QUEUE DCB ADDRESS
*                 R7 = ADDRESS OF FPT WORD 1
*
*                 PROCEDURE SYNTAX:
*
*                    M:QUEUE   (*)DCB-ADDR,UNLOCK,((OPTION))...
*
*                    OPTIONS FOR UNLOCK ARE:
*
*                      OLD/NEW            SPECIFIES WHETHER THE QUEUE
*                                         IS A NEW OR EXISTING FILE.
*
*                      BACKUP             SPECIFIES WHETHER THE QUEUE
*                                         IS TO BE KEPT 'UP-TO-DATE'
*                                         ON SECONDARY STORAGE (I. E.
*                                         WHENEVER A QUEUE BLOCK IS
*                                         MODIFIED IN CORE, IT IS
*                                         TO BE WRITTEN TO DISK).
*
*                      QPAGES,(*)VALUE    SPECIFIES THE MAXIMUM NUMBER
*                                         OF CORE PAGES WHICH CAN BE
*                                         USED FOR QUEUE BLOCKS (THE
*                                         MINIMUM IS 4 PAGES).
*
*                      QSAT,(*)VALUE      SPECIFIES THE PERCENTAGE OF
*                                         THE QUEUE TO FILL WITH
*                                         TRANSACTIONS BEFORE ACCEPTING
*                                         HIGH PRIORITY PUT'S ONLY.
*
         PAGE
*                      KEYMAX,(*)VALUE    SPECIFIES THE MAXIMUM KEY
*                                         SIZE (FIRST NAME SEGMENT
*                                         SIZE) FOR ANY TRANCODE TO
*                                         BE QUEUED (1-13 MAY BE
*                                         SPECIFIED).
*
*                      RECOVER            SPECIFIES QUEUE IS TO BE
*                                         UNLOCKED FOR RECOVERY.
*
*                      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'06'  |        |  DCB ADDRESS    |
*                         ---------------------------------------
*
*                         ---------------------------------------
*                 WORD1   |P1|P2|P3|P4|         |F4|F3|F2|F1|   |
*                         ---------------------------------------
*
*                         OPTION ECB (P1)
*                         ---------------------------------------
*                         |*|                  |  ECB ADDRESS   |
*                         ---------------------------------------
         PAGE
*
*                         OPTION QPAGES (P2)
*                         ---------------------------------------
*                         |*|                  | # QUEUE PAGES  |
*                         ---------------------------------------
*
*                         OPTION KEYMAX (P3)
*                         ---------------------------------------
*                         |*|                  |  KEY SIZE      |
*                         ---------------------------------------
*
*                         OPTION QSAT (P4)
*                         ---------------------------------------
*                         |*|                  |  SATURATION %  |
*                         ---------------------------------------
*
*                         F1 = 1 FOR WAIT OPTION
*
*                         F2 = 1 FOR BACKUP OPTION
*
*                         F3 = 1 FOR NEW QUEUE FILE OPTION
*
*                         F4 = 1 FOR UNLOCK IN RECOVERY MODE OPTION
*
*        OUTPUT:  SR1 = THE CURRENT HIGHEST (UNASSIGNED) TID.
*
*
*        DESCRIPTION:  SINCE THE SYSTEM QUEUE IS A STANDARD RANDOM
*                 FILE, IT MUST BE OPENED BY THE QUEUE OWNER (THE
*                 TPG OR RECOVERY PROCESSORS) PRIOR TO THE UNLOCK
*                 REQUEST.  THE UNLOCK REQUEST ACTIVATES USAGE OF THE
*                 QUEUE.  ONCE THE QUEUE IS UNLOCKED, IT MUST BE
*                 LOCKED BY THE SAME USER (QUEUE OWNER) BEFORE
*                 ANOTHER UNLOCK REQUEST WILL BE HONORED.
         PAGE
*
*                 UNLOCK SAVES THE USER NUMBER OF THE JOB PERFORMING
*                 THE UNLOCK CAL AND A POINTER TO THE CFU FOR THE
*                 QUEUE FILE.  IF A NORMAL OPEN HAS NOT BEEN ISSUED
*                 PRIOR TO THE UNLOCK REQUEST, THE USER IS ABORTED.
*
*                 THE QUEUE UNLOCK PROCESS INCLUDES:
*
*                 .  ALLOCATING SPACE FOR THE QUEUE CONTROL BLOCK(S)
*                 .  RETRIEVING CONTROL BLOCK(S) FROM AN EXISTING
*                    QUEUE FILE
*                 .  INITIALIZING THE TP CONTROL TABLE, TTP
*
*                 THE SPACE IS ALLOCATED FOR THE QUEUE CONTROL BLOCK
*                 AND THE QUEUE ALLOCATION BLOCKS (IF ANY).  THESE
*                 BLOCKS ARE INITIALIZED FOR A NEW QUEUE FILE, OR
*                 READ IN FROM THE EXISTING FILE.
*
*                 BLOCK 0 OF THE QUEUE FILE CONTAINS THE QUEUE CONTEXT,
*                 THE FIRST ALLOCATION BLOCK (1ST 390 GRANULES OF THE
*                 QUEUE FILE), AND THE INDEX CONTROL BLOCK.  IF THE
*                 QUEUE FILE IS GREATER THAN 390 GRANULES, ADDITIONAL
*                 ALLOCATION BLOCKS ARE OBTAINED AS REQUIRED (EACH
*                 DEFINES 1012 GRANULES).
*
*                 PHYSICAL WORK PAGES ARE OBTAINED FOR THE QUEUE
*                 CONTEXT BLOCK AND THE ALLOCATION BLOCKS.  THE IN-
*                 CORE QUEUE PAGES ARE CHAINED TOGETHER THROUGH THE
*                 VARIOUS HEADERS IN THE TTP TABLE.
*
*FIN*
*
*
TQUNLOCK EQU      %
*                                   DCB ADDRESS IN R6
*                                   ADDRESS OF FPT WD 1 IN R7
         LB,R2    JB:PRIV           CHECK CALLER'S PRIVILEGE
         CI,R2    QPRIV             CHECK FOR X'C0'
         BGE      TQUNLOCKA
*E*
*E*      ERROR:  BC08 QUEUE LOCK/UNLOCK CALLER DOES NOT HAVE
*E*               THE REQUIRED PRIVILEGE
*E*
         LI,R5    QABN08            NOT REQUIRED PRIVILEGE
         B        TQENT06
TQUNLOCKA EQU     %
         BAL,R0   TQCKDCB           YES,PROCEED
*E*
*E*      ERROR:  BC01 TP SERVICE REQUESTED IS ILLEGAL FOR THIS USER
*E*      DESCRIPTION:  THE DCB SPECIFIED ON UNLOCK DOES NOT EXIST.
*E*
         BEZ      TQENT05           DCB NOT IN DCBTAB,ABORT
         TBIT,R2  DCB#FCD,R6        CHECK FOR FILE OPEN
         BNEZ     TQENT14           YES, CONTINUE
*E*
*E*      ERROR:  BC09 DCB NOT OPEN FOR A LOCK/UNLOCK REQUEST
*E*
         LI,R5    QABN09            NO, ABORT
         B        TQENT06
TQENT14  EQU      %
         LFIELD,R2 DCB#ASN,*R6      CHECK ASN = FILE
         CI,R2    DCB#FILE
*E*
*E*      ERROR:  BC01 TP SERVICE REQUESTED IS ILLEGAL FOR THIS USER
*E*      DESCRIPTION:  THE DCB SPECIFIED ON UNLOCK IS NOT A FILE DCB.
*E*
         BNE      TQENT05           NO, ABORT
         LW,R2    S:CUN             SET OWNER # AND USER # INTO
*                                   TTP TABLE
         ST,R2,R1 Q:OWN
         ST,R2    Q:USR
         LADR,R2  DCB#CFUA,R6       SAVE QUEUE CFU ADDRESS
         AND,R2   M17
         SADR,R2  Q:CFU
         TBIT,R2  DCB#PRIV,R6       CHECK FOR QUEUE ON PRIVATE STORAGE
         BNEZ     TQUNLOCK3         YES, GET SERIAL NUMBERS
TQUNLOCK1 EQU     %
         TBIT,R2  QNEW,R7           IS THE QUEUE A NEW FILE
         BNEZ     TQUNLOCK4         YES
*
         BAL,SR2  TQRESTORE         RESTORE QUEUE CONTROL BLOCKS
         BCS,1    TQUNLOCK2         RESTORE SUCCESSFUL IF BRANCH
*E*
*E*      ERROR:  BC03 ERROR RETURN FROM GET PHYSICAL WORK PAGE
*E*      DESCRIPTION:  NOT ENOUGH PHYSICAL PAGES ARE AVAILABLE TO
*E*               BUILD THE IN-CORE QUEUE.
*E*
         LI,R5    QABN03            CANNOT RESTORE, ABORT
         B        TQABNF
TQUNLOCK2 EQU     %
         GET,R6    Q:CONT           CONTROL BLOCK 1, AT HEAD OF CHAIN
         BEZ      TQERROR           MUST EXIST
         LI,R5    CONTCON(I)        INDEX TO MAP BIAS WD
         PUSH     2,R6
         BAL,R0   TQGETWORD         GET MAP BIAS WORD
         LW,R2    D4                MUST BE NON-ZERO
         BEZ      TQERROR
         BG       TQUNLOCK2A        MAP NOT IN BLK 1 IF BRANCH
         AND,R2   NB31TO0+32        DISCARD CONTCON
         AW,R6    R2                REAL ADDRESS OF ALLOCATION MAP
         LI,D1    QMIN1             MINIMUM # QUEUE PAGES
         B        TQUNLOCK2C        SETUP TTP
TQUNLOCK2A EQU    %
         LI,R5    Q:CONT(A)         CHAIN HEADER
         LW,SR3   R2                BLOCK NUMBER IS CRITERIA
         LW,SR4   CSTMAP            CRITERIA MASK
         LI,R7    ALLBLOCK(I)-ALLCHAIN(I)  R7=OFFSET TO BLOCK #
         LI,R4    0                 LOCATE THE BLOCK IN CORE
         LI,R2    -1                SET SEARCH FOR ONLY FOR DECHAINER
         BAL,R1   TQDCHC
         BCS,1    TQERROR           MAP BLOCK MISSING ..QUIT
         LI,D1    QMIN2             MINIMUM # QUEUE PAGES
         LW,R6    SR2               ADDRESS OF ALLOCATION MAP
TQUNLOCK2C EQU    %
         SADR,R6  Q:MAP
         LI,R5    ALLCHAIN(I)
TQUNLOCKC1 EQU    %
         BAL,R0   TQLOADF
         CI,D3    0
         BE       TQUNLOCK2D        MAP ENDS      IN THIS BLOCK
         AI,D1    1                 INCREMENT MINIMUM PAGES
         LW,R6    D3                ADDRESS OF LINKED MAP BLOCK
         B        TQUNLOCKC1        TEST FOR MORE BLOCKS
TQUNLOCK2D EQU    %
         SBYTE,D1,R5 Q:MIN          MINIMUM # IN-CORE BLOCKS + 1 PAGE
         PULL     2,R6
TQUNLOCK2D1 EQU   %
*                                   R6 = ADDRESS OF CONTROL BLOCK 1
*                                   R7 = ADDRESS OF FPT WD 1
         L,D3,R5  Q:OWN             OWNER # TO C.B. 1
         LI,R5    CONTUSR(I)
         BAL,R0   TQSETBYTE
         LW,D1    0,R7              MOVE FPT PARAMETERS TO TTP
         SLS,D1   1
         BAL,R2   TQCHKBIT1
         B        %+1               IGNORE ECB FOR INIT
         BAL,R2   TQCHKBIT
         B        TQUNLOCK2E        PARAMETER MISSING
         C,D3,R5  Q:MIN
*E*
*E*      ERROR:  BC01 TP SERVICE REQUESTED IS ILLEGAL FOR THIS USER
*E*      DESCRIPTION:  THE MAXIMUM NUMBER OF PAGES SPECIFIED ON
*E*               THE UNLOCK IS LESS THAN THE MINIMUM REQUIRED FOR
*E*               THIS QUEUE FILE.
*E*
         BL       TQENT05
         SBYTE,D3     Q:MAX         MAX # PAGES FOR QUEUE USAGE
TQUNLOCK2E EQU    %
         BAL,R2   TQCHKBIT
         B        TQUNLOCK2G
*                                   KEY MAX IGNORED FOR EXISTING QUEUE
         TBIT,R2  QNEW,R7
         BEZ      TQUNLOCK2G
         PUSH     R1
         LI,R5    CONTKEYM(I)       SET KEY MAX IN CONTROL BLOCK 1
         BAL,R0   TQSETBYTE
         LW,SR1   R6                WRITE CONTROL BLOCK 1
         BAL,R0   TQWRITE
         B        TQUNLOCK2H
TQUNLOCK2G EQU    %
         PUSH     R1
TQUNLOCK2H EQU    %
         LI,R5    CONTKEYM(I)
*                                   SET MAX KEYS IN AN INDEX BLOCK
         BAL,R0   TQGETBYTE         RETRIEVE KEY MAX
         LW,D3    D4
         AI,D3    QKEY
         LI,D2    QINXBSZ
         DW,D2    D3
         ST,D2,R1 Q:INXNAV
         PULL     R1
         BAL,R2   TQCHKBIT
         B        TQUNLOCK2I
         SBYTE,D3,R2  Q:SAT
TQUNLOCK2I EQU    %
         LI,R5    CONTHTID(I)       GET TID FOR CALLER
         BAL,R0   TQGETWORD
         LW,SR1   D4                SET TID FOR CALLER
         TBIT,R2  QRECOV,R7         TEST FOR CALLED BY RECOVERY
         BEZ      TQUNLOCK2K        NO
         SBIT,R3  Q:RCV             YES, SET TTP RECOVERY FLAG
TQUNLOCK2K EQU    %
         TBIT,R2  QBACKUP,R7
         BEZ      TQUNLOCKL
         SBIT,R3  Q:BACK
TQUNLOCKL EQU     %
         LI,R2    1                 RESET LIST ID CONTROL
         ST,R2    Q:LID
         SBIT,R3  Q:LOCK            SET QUEUE UNLOCKED FLAG
         B        TQRETURN          RETURN TO CALLER
*
TQUNLOCK3 EQU     %
         BAL,R0   GETSNADR          QUEUE ON PRIVATE STORAGE,
*                                   GET SERIAL NUMBERS
         ST,R2    Q:NSN             SAVE # SERIAL NUMBERS
         SLS,R2   1                 2 WDS/ SN FOR SAVING HGP POINTER
         LW,SR1   R2
         BAL,SR4  TQCOREALLOC       GET PHYSICAL SPACE FOR SNS
         BCR,8    TQUNLOCK3A        SPACE OBTAINED
*E*
*E*      ERROR:  BC12 QUEUE PHYSICAL PAGE SPACE IS NOT AVAILABLE
*E*      DESCRIPTION:  NOT ENOUGH SPACE TO STORE THE QUEUE SERIAL
*E*               NUMBERS FOR A QUEUE ON PRIVATE PACK.
*E*
         B        TQABN12           ABNORMAL EXIT
TQUNLOCK3A EQU    %
         SLS,SR1  1                 BYTES TO MOVE
         LW,R3    SR1               MOVE SNS TO PHYSICAL MEMORY
         PUSH     R6
         BAL,R0   TQCALLMOVE8
         GET,R5    Q:NSN            NUMBER OF VOLUMES
         AI,D2    -1                ADDRESS-1 OF SNS
         LW,SR1   D2
         LW,R6    D4                D4=BYTE ADDRESS FOLLOWING SNS
         SLS,R6   -2                TO WORD ADDRESS
         AI,R6    -1
         ST,R6    Q:SN              SAVE ADDRESS OF HGPS
TQUNLOCK3B EQU    %
         LI,R2    AVRTBLSIZ-1
TQUNLOCK3C EQU    %
         AI,R1    1                 SEARCH AVR TABLE FOR SN
         CI,R2    AVRTBLNE
         BGE      TQERROR           (POSSIBLE WAIT FOR MOUNT?)
         LD,SR3   AVRTBL,R2
         CW,SR3   *SR1,R5           IS THIS THE ONE
         BNE      TQUNLOCK3C        CHECK NEXT AVR TABLE
         GET,SR3,R4 Q:OWN           ID OF QUEUE OWNER
         CH,SR3   AVRID,R2
         BNE      TQERROR           SHOULD BELONG TO OWNER
         LI,D3    XFFFF
         AND,D3   SR4               ALLOCATION TABLE DISPLACEMENT
         AI,D3    HGP               ADDRESS OF HGP THIS VOLUME
         LW,SR3   R2                CHECK DCTX VALIDITY
         AI,SR3   BATAPE
         LI,R4    AVR#DCTX
         CB,SR3   *D3,R4
         BNE      TQERROR
         BAL,R0   TQSETWORD         STORE HGP ADDRESS IN QUEUE PAGE
         BDR,R5   TQUNLOCK3B        GET HGP FOR NEXT VOLUME
         PULL     R6
         B        TQUNLOCK1         CONTINUE UNLOCK PROCESS
TQUNLOCK4 EQU     %
*                                   NEW QUEUE UNLOCK REQUEST
         LI,D1    0                 BLOCK NUMBER
         BAL,R0   TQGETCBLOCK       GET A CONTROL BLOCK PGE
*E*
*E*      ERROR:  BC12 QUEUE PHYSICAL PAGE SPACE IS NOT AVAILABLE
*E*      DESCRIPTION:  COULD NOT GET ENOUGH PHYSICAL WORK PAGES FOR
*E*               THE IN-CORE QUEUE BLOCKS.
*E*
         BE       TQABN12F
         LHW,D3,R2 DCB#RSTORE,*R6   GET FILE SIZE
         TBIT,R3  DCB#EXTRND,R6     CHECK FOR RSTORE EXTENSION
         BEZ      TQUNLOCK4A        NO
         LBYTE,R3,R1 DCB#NLR,*R6    GET HIGH ORDER BITS
         STH,R3   D3                APPEND TO RSTORE
TQUNLOCK4A EQU    %
         LI,R5    CONTNAVGRANS(I)
         PUSH     R7
         LI,D1    0                 BLOCK NUMBER
         LW,R6    SR3               PTR TO CONTROL BLOCK 1,I.E.,BLOCK 0
         BAL,R0   TQSTOREF
         LW,D2    D3                SAVE FILE SIZE FOR MAP ALLOCATION
         LI,R5    QSATINC           COMPUTE SATURATION INCREMENT
         DW,R5    D3                QSATINC/# GRANULES
         BGZ      %+2
         LI,R5    1                 MAKE IT AT LEAST 1
         LW,D3    R5
         LI,R5    CONTSATINC(I)
         BAL,R0   TQSETWORD         SAVE SATINC IN CONTEXT BLOCK
         LI,R2    QBLK1AVAIL        CAN MAP START IN BLOCK 0
         CI,R2    QBLK1MIN
         BGE      TQUNLOCK4C        YES, IF BRANCH
         LI,D3    QBLKALL           BLOCK # FOR MAP BLOCK
         LI,D1    QBLKALL
         B        TQUNLOCK4D
TQUNLOCK4C EQU    %
         AI,D2    -2                SUBTRACT # CONTROL BLOCKS
         LI,D1    0                 BLOCK #, BLOCK 1
         LI,D3    QBLK1MAP          MAP BIAS WITHIN BLOCK 1
         OR,D3    CONTCON(M)        SET MAP PTR = BIAS FLAG
TQUNLOCK4D EQU    %
         LI,R5    CONTCON(I)
         BAL,R0   TQSETWORD         SET CONTCON AND CONTMAPBIAS
         CI,D1    0                 TEST MAP START IN BLK 1
         BE       TQUNLOCK4F        YES, IF BRANCH
         LI,R7    0                 COUNT HWS AS ALLOCATED
TQUNLOCK4E EQU    %
         BAL,R0   TQGETCBLOCK1      GET ANOTHER PAGE
*                                   CHAIN PAGE AND DISK CHAIN
         LW,R6    SR3
         B        TQUNLOCK4G
TQUNLOCK4F EQU    %
         AI,R6    QBLK1MAP
         LI,D3    QBLK1AVAIL
         LI,R7    QBLK1AVAIL
TQUNLOCK4G EQU    %
         LW,R2    R6
         ST,R2    Q:MAP             SET PTR TO ALLOCATION MAP
TQUNLOCK4H EQU   %
         LI,R5    ALLBLOCKNAV(I)
         BAL,R0   TQSETHWORD
         AI,D1    1                 INCREMENT BLOCK NUMBER
         CW,D2    R7                ENOUGH HWS ALLOCATED
         BLE      TQUNLOCK4I        YES
         SW,D2    D3                DECREMENT TOTAL SIZE
         BAL,R0   TQGETCBLOCK1      GET AND CHAIN ANOTHER PAGE
         LW,R6    SR3
         B        TQUNLOCK4H
TQUNLOCK4I EQU    %
*
         GET,R6    Q:CONT           ADDRESS OF BLOCK 1
         LI,D3    QBLK1INX          OFFSET TO ICB
         OR,D3    CONTCONI(M)       SET BIAS FLAG
         LI,R5    CONTINXCONT(I)
         BAL,R0   TQSETWORD
*                                   GET A PAGE FOR THE ICB
         LW,SR3   R6                ADDRESS OF BLOCK 1
         AI,SR3   QBLK1INX          PLUS BIAS TO ICB
         LW,D3    D1                SET CURRENT BLOCK NUMBER
         SADR,SR3      Q:INXCONTROL
*                                   IN THE ALLOCATION MAP
         LI,R5    CONTFIRSTGDA(I)
         BAL,R0   TQSTOREF
         AI,D3    3                 DATA+INDEX+DEFINELIST
         ST,D3,R5 Q:MIN             SET MIN PAGES
         LI,R5    CONTKEYM(I)       SET DEFAULT KEY MAX
         LI,D3    7
         BAL,R0   TQSETBYTE
         LI,D3    QINXBSZ/7         SET DEFAULT KEYS/BLOCK
         ST,D3,R1 Q:INXNAV
         LI,D2    1                 WRITE CONTROL BLOCKS
         BAL,R0   TQIOCHAIN
         PULL     R7
         CI,R5    0                 TEST I/O ERROR
         BE       TQUNLOCK2D1       NO, CONTINUE UNLOCK
         B        TQERROR           YES, QUIT
*
         PAGE
*DO*
*D*
*        NAME:    TQPURGE, DELETE A USER'S GET LIST(S) AND, IF CALLED
*                          FROM STPNR, HIS QUEUE CONTROL INFORMATION.
*
*        INPUT:   R6 = LIST ID (OF SPECIFIC LIST TO PURGE, OR ZERO
*                      TO PURGE ALL DEFINED LISTS)
*
*                 R7 = ADDRESS OF FPT WORD 1
*
*                 PROCEDURE SYNTAX:
*
*                    M:QUEUE   (*)LIST-ID,PURGE,((OPTION))...
*
*                    OPTIONS FOR PURGE ARE:
*
*                      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'0B'  |        |  LIST ID        |
*                         ---------------------------------------
*
*                         ---------------------------------------
*                 WORD 1  |P1|                           |F1|   |
*                         ---------------------------------------
         PAGE
*
*                         OPTION ECB (P1)
*                         ---------------------------------------
*                         |*|                 |  ECB ADDRESS    |
*                         ---------------------------------------
*
*                         F1 = 1 FOR WAIT OPTION
*
*        DESCRIPTION:  THE QUEUE PURGE IS APPLICABLE TO THE GET LIST
*                 SET UP BY A DEFINELIST REQUEST.  THE PURGE IS
*                 PROVIDED TO DISCARD A GET LIST WHEN THE USER WISHES
*                 TO CHANGE (OR DELETE) A LIST.  A PURGE OF ALL THE
*                 USER'S GET LISTS AND QUEUE CONTROL INFORMATION IS
*                 ISSUED DURING JOB STEP TERMINATION SO THAT NO
*                 LOCKED PAGES REMAIN AFTER JOB TERMINATION.
*
*                 IF CALLED BY A USER, THE PURGE PROCESS DECHAINS THE
*                 SPECIFIED GET LIST, RELEASES ALL THE PAGES LOCKED
*                 IN CORE FOR THE LIST AND ITS CRITERIA, AND DELETES
*                 THE QUEUE MANAGER WORK SPACE USED TO DEFINE THIS
*                 LIST.
*
*                 IF THE CALL IS DURING JOB STEP TERMINATION, ALL THE
*                 LISTS BELONGING TO THIS USER ARE PURGED.
*
*FIN*
*
*                 TQPURGE...DISCARD A GET LIST (QLIST)
*
TQPURGE1 EQU      %
         SLS,R6   16
         LW,R7    S:CUN
         C,R7,R3  Q:OWN             QUEUE OWNER ABORTING
         BNE      TQPURGE1A
         RESETI,R3  Q:PAUSE         IF YES, RESET LOCK, PAUSE
TQPURGE1A  EQU    %
         CI,R6    0                 SPECIFIC LIST ID
         BNE      TQPURGE2
*                 TERMINATE TP USER
         DISABLE
         LH,SR4   UH:FLG2,R7        RESET ACTIVE TP USER
         AND,SR4  NB31TO0+9          FLAG FOR TPG
         STH,SR4  UH:FLG2,R7          UH:FLG2 - X'100'
         ENABLE
         RESETI,R3  TP              RESET TP FLAG
         BAL,SR4  TQXUSR            DISCARD USER TABLES
         B        TQRETURN
TQPURGE2 EQU      %
         LW,SR2   R6                LISTID
         BAL,R0   TQXQLIST          DISCARD THE LIST
         CI,R4    0
         BNE      TQRETURN          LIST LOCATED AND FREED
*E*
*E*      ERROR:  BC20 QUEUE GET OR PURGE REQUEST FOR A NON-EXISTENT
*E*               GET LIST
*E*      DESCRIPTION:  PURGE REQUEST FOR A NON-EXISTENT LIST.
*E*
         B        TQABN20           ABNORMAL RETURN
         SPACE    6
TQGETCHAIN EQU    %
         LI,R5    QCHAIN(I)
         BAL,R0   TQLOADF
         B        *R2
         PAGE
*DO*
*D*
*        NAME:    TQLOCK, LOCK THE QUEUE
*
*        INPUT:   R6 = QUEUE DCB ADDRESS
*                 R7 = ADDRESS OF FPT WORD 1
*
*                 PROCEDURE SYNTAX:
*
*                    M:QUEUE   (*)DCB-ADDR,LOCK,((OPTION))...
*
*                    OPTIONS FOR LOCK ARE:
*
*                      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.
*
*                      PAUSE              SPECIFIES THAT THE QUEUE IS
*                                         ONLY TO BE LOCKED TEMPORARILY
*                                         AND THAT USERS SHOULD BE
*                                         BLOCKED ON THE 'QUEUE BUSY'
*                                         RATHER THAN THE 'QUEUE LOCK-
*                                         ED' ABNORMAL.  THE PAUSE
*                                         OPTION IS USED DURING A
*                                         COMMON JOURNAL VOLUME SWITCH.
         PAGE
*
*                 FPT FORMAT:
*
*                         ---------------------------------------
*                 WORD 0  |*|  X'0C'  |        | DCB ADDRESS    |
*                         ---------------------------------------
*
*                         ---------------------------------------
*                 WORD 1  |P1|                    |F5|   |F1|   |
*                         ---------------------------------------
*
*                         OPTION ECB (P1)
*                         ---------------------------------------
*                         |*|                  | ECB ADDRESS    |
*                         ---------------------------------------
*
*                         F1 = 1 FOR WAIT OPTION
*
*                         F5 = 1 FOR PAUSE OPTION
*
*
*        DESCRIPTION:  THE QUEUE LOCK FUNCTION ENSURES THAT THE
*                 CALLING PROGRAM IS THE QUEUE OWNER AND THEN LOCKS
*                 THE QUEUE FROM FURTHER ACCESS.  ALL IN-CORE QUEUE
*                 BLOCKS ARE WRITTEN TO DISK.  IF THE PAUSE OPTION
*                 WAS SPECIFIED, NO FURTHER PROCESSING IS DONE.
*
*                 IF THE PAUSE OPTION WAS NOT SPECIFIED, THE CORE
*                 ALLOCATED FOR THE IN-CORE QUEUE IS RELEASED, ALL
*                 OUTSTANDING ECB'S ARE POSTED WITH THE 'QUEUE
*                 LOCKED' CODE, AND THE TTP TABLE IS ZEROED.  IF AN
*                 MPOOL BUFFER IS IN USE, IT IS RETURNED TO THE
*                 SYSTEM.
*
*FIN*
*
TQLOCK   EQU      %                 LOCK ACCESS TO QUEUE
         BAL,R0   TQCKDCB           VALIDITY CHECK DCB
*E*
*E*      ERROR:  BC01 TP SERVICE REQUESTED IS ILLEGAL FOR THIS USER
*E*      DESCRIPTION:  THE DCB SPECIFIED ON LOCK DOES NOT EXIST.
*E*
         BCR,1    TQENT05
         TBIT,R3  DCB#FCD,R6        CHECK FOR FILE OPEN
         BNEZ     TQLOCK1           YES, CONTINUE
*E*
*E*      ERROR:  BC09 DCB NOT OPEN FOR A LOCK/UNLOCK REQUEST
*E*
         LI,R5    QABN09            NO, ABORT
         B        TQENT06
TQLOCK1  EQU      %
         LADR,R4  DCB#CFUA,R6       GET CFU ADDRESS OF TPQUEUE FILE
         AND,R4   M17               FROM THE M:QUEUE CALL DCB
         SADR,R4  Q:CFU             SAVE IT IN TTP TABLE ENTRY FOR IT
         LW,R4    S:CUN
         L,R5,R1  Q:OWN             USER = QUEUEE OWNER
         CW,R4    R5
*E*
*E*      ERROR:  BC01 TP SERVICE REQUESTED IS ILLEGAL FOR THIS USER
*E*      DESCRIPTION:  LOCK REQUEST FROM A USER WHO IS NOT THE
*E*               CURRENT OWNER OF THE QUEUE.
*E*
         BNE      TQENT05
         LW,R6    Q:CONT(A)
         L,D3     Q:TID
         LI,R5    CONTHTID(I)       HIGHEST TID
         BAL,R0   TQSETWORD
         LI,D2    7
         T,R1     QPAUSE,R7         TEST FPT FOR LOCK, PAUSE
         BEZ      TQLOCK1A          NO
         SETI,R7  Q:PAUSE
         B        TQLOCK1B
TQLOCK1A EQU      %
         RESETI,R7    Q:PAUSE       INSURE THAT Q:PAUSE IN TTP = 0
*                                   FOR A NON-PAUSE LOCK FPT
         OR,D2    CSTMBS
TQLOCK1B EQU      %                 DON'T RETURN CORE PAGES ON PAUSE
         BAL,R0   TQIOCHAIN
         T,R7     Q:PAUSE
         BNEZ     TQRETURN          FINISHED IF PAUSE
         LI,R7    0                 X ALL
         BAL,SR4  TQXUSR
         LW,R6    Q:TPPP(A)         FREE ALL PHYSICAL PAGES
TQLOCK2  EQU      %
         BEZ      TQLOCK4
         LW,SR3   R6
         BAL,R2   TQGETCHAIN
         SLS,SR3  -9
         BAL,SR4  FPWP
         LW,R6    D3
         B        TQLOCK2
TQLOCK4  EQU      %
*                                   RELEASE MPOOL
         GET,D3   Q:MPOOL
         BEZ      TQLOCK5           NONE
         BAL,SR4  RMB
TQLOCK5  EQU      %
         LI,R6    0
         LI,R2    Q:TTPSIZE         CLEAR THE TTP TABLE
         STW,R6   TTP-1,R2
         BDR,R2   %-1
         B        TQRETURN
         PAGE
*
TQCHBLK  EQU      %
*                                   ENTERED BAL,SR4 TQCHBLK
*                                   VOLATILE REGISTERS:
*                                   STANDARD
*                                   SET QUEUE BLOCK CORE AND DISKCHAINING
*                                   FIELDS
*                                   R6= PTR TO OLD BLOCK
*                                   SR3= PTR TO NEW BLOCK
*                                   D1= BLOCK #, NEW BLOCK
         PUSH     8,R6
         LW,D3    D1
         LI,R5    CONTGDACHAIN(I)
         BAL,R0   TQSTOREF          D1=BLOCK #,NEW BLK = FLINK
         AND,R6   CSTPGE            NEEDED FOR MAP START, BLK 1
         BAL,R0   TQSTOREF
         LI,R5    CONTBLOCK(I)
*                                   BLOCK NUMBER, OLD BLOCK
         BAL,R0   TQLOADF           FOR BLINK FIELD IN NEW BLOCK
         LW,R6    SR3               FOR INITIALIZING NEW BLOCK
         LI,R5    ALLBLINK(I)       SET BACK LINK TO PREVIOUS BLOCK
         BAL,R0   TQSTOREF
         PULL     8,R6
         B        *SR4
         PAGE
TQCKDCB  EQU      %
*                 ENTERED VIA  BAL,R0 TQCKDCB
*                 VOLATILE REGISTERS: R2,R3,R4
         LW,R2    J:DCBLINK         DCBTAB
         BEZ      *R0               BAD RETURN
TQCKDCB10 EQU     %
         LW,R4    *R2               GET TABLE END
TQCKDCB12 EQU     %
         AI,R2    1
         LB,R3    *R2               GET WHAT SHOULD BE TEXTC
         BEZ      TQCKDCB35
TQCKDCB20 EQU     %
         SLS,R3   -2                SKIP DCB NAME
         AI,R3    1
         AW,R2    R3
TQCKDCB35 EQU     %
         CW,R6    *R2               THIS THE QUEUE DCB
         BE       TQCKDCB60         YES
         CW,R2    R4                TEST FOR END THIS DCBTAB
         BNE      TQCKDCB12         NO
         LW,R2    *R2               TEST FOR ANOTHER
         BNEZ     TQCKDCB10         NO, ERROR EXIT
         B        *R0
TQCKDCB60 EQU     %
         LCFI     1                 SET GOOD RETURN
         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               SIZE UNIT TO SR3
         SLS,SR3  16                LEFT HALF
         LI,SR4   -1                CRITERIA 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
         CI,SR1   QPPNAV            IS PAGE EMPTY
         BE       TQCORE9H          YES, RETURN
         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
         CI,R3    255               ZERO ONLY 255 BYTES
         BLE      %+2               OR LESS
         LI,R3    255
         LW,R1    D1                WORD ADDRESS OF AREA TO ZERO
         SLS,R1   2                 TO BYTE ADDRESS
         STB,R3   R1                COUNT
         BAL,R0   TQMOVEBSZ         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
****************************************************************
*
*                 TQRESTORE...RESTORES QUEUE CONTROL AND INDEX *
*                 BLOCKS TO CORE. ENTERED VIA BAL,SR2  TQRESTORE
*                 VOLATILE REGISTERS:
*                                   STANDARD
****************************************************************
*
TQRESTORE EQU     %
         PUSH     8,R6
         LI,D1    0
         BAL,R0   TQGETCBLOCK       GET A PAGE
         LW,SR1   SR3
         BEZ      TQRESTORE14
         B        TQRESTORE16
TQRESTORE1 EQU    %
         LW,SR1   SR3
TQRESTORE2 EQU    %
         BAL,R0   TQREAD            READ QUEUE BLOCK 1
TQRESTORE4 EQU    %
         LW,R6    SR1
         LBYTE,R2 Q:CC              I/O COMPLETION CODE
         CI,R2    1
         BNE      TQRESTORE14
         LI,D3    0
         LI,R5    CONTCHAIN(I)
         BAL,R0   TQSTOREF
         LI,R5    CONTWRITE(I)
         LW,D4    CONTWRITE(M)
         OR,D4    CONTMOD(M)
         LI,D3    0
         BAL,R0   TQSETFIELD
         CI,D1    0
         BNE      TQRESTORE6
         LI,R5    CONTINXCONT(I)
         BAL,R0   TQLOADF
         AW,R6    D3                ADDRESS OF ICB
TQRESTORE6 EQU    %
         GET,R2    Q:INXCONTROL
         BNEZ     TQRESTORE8
         ST,R6    Q:INXCONTROL
         GET,R6   Q:CONT
TQRESTORE8 EQU    %
         LI,R5    CONTGDACHAIN(I)
         BAL,R0   TQGETWORD         GET FORWARD BLOCK NUMBER
         BEZ      TQRESTORE12       NO MORE
         LW,SR2   D4
         LW,D1    SR2               BLOCK NUMBER
         BAL,R0   TQGETCBLOCK       REQUEST ANOTHER PAGE
         BE       TQRESTORE14
         B        TQRESTORE1
TQRESTORE12 EQU   %
         PULL     8,R6              SUCCESSFUL EXIT
         LCFI     1
         B        *SR2
TQRESTORE14 EQU   %
         PULL     8,R6
         LCFI     0                 UNSUCCESSUL EXIT
         B        *SR2
TQRESTORE16 EQU   %
         BAL,R0   TQREAD1
         B        TQRESTORE4
         PAGE
TQGETCBLOCK EQU   %
         LI,R4    0
         PUSH     R0
         BAL,SR4  TQGETBLOCKS
         PULL     R0
         CI,SR3   0
         B        *R0
*
TQGETCBLOCK1 EQU  %
         PUSH     R0
         LI,R4    0
         BAL,SR4  TQGETBLOCKS
         CI,SR3   0
*E*
*E*      ERROR:  BC12 QUEUE PHYSICAL PAGE SPACE IS NOT AVAILABLE
*E*      DESCRIPTION:  COULD NOT GET ENOUGH PHYSICAL WORK PAGES FOR
*E*               THE IN-CORE QUEUE BLOCKS.
*E*
         BE       TQABN12F
         BAL,SR4  TQCHBLK
         LI,R7    QBLKALLNAV
         LI,D3    QBLKALLNAV
         B        TQPULLEXIT
         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
         LW,SR2   SR3
         LW,SR4   CSTMAP            CRITERIA MASK
         DO1      QCHAIN(I)]=0
         AI,SR2   QCHAIN(I)
         LI,R7    QBLOCK(I)-QCHAIN(I)           DISPLACEMENT
*                                   FROM LINK TO CRITERIA WORD
         BAL,R1   TQCHC             CHAIN WITH CRITERIA
         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
         B        TQREADIN
*
*                 TQREAD1...INITIATE READ OF CONTROL BLOCK 1
TQREAD1  EQU      %
         PUSH     R0
         LI,SR2   0                 BLOCK NUMBER
TQREADIN EQU      %
         LI,SR3   QREAD             FUNCTION CODE
         PUSH     SR4
         OVERLAY  TQOV1SEG,TQ:NEWQ# 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...WRITE OUT ALL QUEUE BLOCKS (OR BLOCKS
*                 OF A GIVEN TYPE).  IF THE BLOCK TYPE HAS THE HIGH
*                 ORDER BIT SET, DECHAIN AND FREE THE CORE PAGES.
*                 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     %
TQIOCHAIN4 EQU    %
         LI,D4    QWRITE            SET I/O OP TO WRITE
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
TQIOCHAIN10 EQU   %
         LW,SR3   D4                SET FCN CODE
TQIOCHAIN12 EQU   %
         PUSH     D2
         LW,SR1   R6
         BAL,SR4  TQIO              SETUP FOR AND CALL CALLNEWQ
         PULL     D2
         CI,R5    0
         BNE      TQIOCHAIN18
TQIOCHAIN14 EQU   %
         PUSH     D4
         LI,R5    0
         BAL,R0   TQLOADF
         CI,D2    0
         BGE      TQIOCHAIN15
         EXU      TQGETBLOCKS6,R7   CHAIN HDR
         BAL,R1   TQDCHFREE         FREE THE PAGE
TQIOCHAIN15 EQU   %
         LW,R6    D3
         PULL     D4
         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
         LW,D4    CONTWRITE(M)      TURN OFF WRITE REQUIRED FLAG
         LI,D3    0
         BAL,R0   TQSETFIELD
         PUSH     SR4
         OVERLAY  TQOV1SEG,TQ:NEWQ# TO NEWQ
         PULL     SR4
         PULL     D4
         B        *SR4
         PAGE
*                 CHECK TP USER AUTHORITY
*                 IF VALID, SET BIT 9 OF J:ASSIGN
*                 AND CONTINUE WITH QUEUE PROCESSIGN
*
TQAUTH   EQU      %
         PUSH     2,R2              SAVE REGISTERS
         LB,R2    JB:PRIV           GET PRIV LEVEL
         CI,R2    QPRIV
         BGE      TQAUTH3           USER HAS PRIVILEGE
         LI,R2    X'F0000'+'TP'     LOOK FOR 'TP'
         LI,R3    SV:FTYM           AS AUTHORIZABLE RESOURCE
TQAUTH1  EQU      %
         CH,R2    SH:SYMT,R3
         BNE      TQAUTH2           NOT FOUND YET
*
*                 'TP' IS A RESOURCE...IS THIS USER AUTHORIZED
*
         LI,R2    JH:LDCF           GET AUTHORIZATION HALFWORD
         LH,R2    0,R2              FROM JIT
         SLS,R2   0,R3              POSITION THIS BIT
         CI,R2    X'8000'           IS TP AUTHORIZED
         BANZ     TQAUTH3           YES
*                                   NO, ABORT THIS USER
*E*
*E*      ERROR:  BC01 TP SERVICE REQUESTED IS ILLEGAL FOR THIS USER
*E*      DESCRIPTION:  THIS USER DOES NOT HAVE THE AUTHORIZATION
*E*               TO USE THE TP RESOURCES.
*E*
         LI,D3    QABNCODE
         MTB,2    D3                SET UP 'BC01'
         B        T:ABORTM          AND ABORT
*
TQAUTH2  EQU      %
         BDR,R3   TQAUTH1           CONTINUE CHECKING
TQAUTH3  EQU      %                 TP ACCESS IS OK
         SETI,R2  TP                SET THE BIT IN J:ASSIGN
         LW,R2    S:CUN             SET ACTIVE TP USER
         DISABLE
         LH,R3    UH:FLG2,R2         FLAG FOR TPG
         OR,R3    BT31TO0+9           UH:FLG2 - X'100'
         STH,R3   UH:FLG2,R2
         ENABLE
         PULL     2,R2              RESTORE REGISTERS
         OBSR4                      AND RETURN
*
         PAGE
*                 USER RETURN PROCESSING...THREE TYPES
*                 1) ABNORMAL
*                 2) NORMAL
*                 3) ABORT
         SPACE    6
*                 ABNORMAL EXIT PROCESSING
TQENT05  EQU      %                 USER ABORT INDICATED
         LI,R5    QABN01            NO, SET ILLEGAL QUEUE REQUEST ABN
TQENT06  EQU      %
         LW,R6    S:CUN             CURRENT USER
         LI,R4    QCCNO             CONDITION CODE FOR USER
         B        TQABORT           TRIGGER STEP ABORT...NO RETURN FROM
*                                   TQABORT
*
TQABN12  EQU      %
         LI,R5    QABN12
TQABN    EQU      %
         B        TQABNORMAL
TQABN12F EQU      %
         LI,R5    QABN12
TQABNF   EQU      %
         PUSH     R5
         LBYTE,R4,R1 Q:PAGES        CHECK FOR PAGES TO RETURN TO
*                                   THE SYSTEM FOR ABORTIVE UNLOCK
         BEZ      TQABN12F8         NO, TO EXIT
         LI,R7    0
TQABN12F2 EQU     %
         EXU      TQGETBLOCKS6,R7   CHAIN HEADER PTR TO R5
TQABN12F4 EQU     %
         LW,R6    0,R5              HEAD OF CHAIN
         BEZ      TQABN12F6         EMPTY CHAIN
         BAL,R1   TQDCHFREE         DECHAIN AND RELEASE THE PAGE
         AI,R4    -1                DECREMENT #PAGES
         B        TQABN12F4         CONTINUE TO NEXT PAGE THIS TYPE
TQABN12F6 EQU     %
         AI,R7    1                 STEP TO NEXT TYPE
         BDR,R4   TQABN12F2         RUN DOWN NEXT CHAIN
TQABN12F8 EQU     %
         PULL     R5
         B        TQABN
TQABN20  EQU      %
         LI,R5    QABN20
TQABNORMAL EQU    %
         LI,SR2   QECBCODEF
         LI,R4    QCCNO
         L,SR1    Q:SR1             RETURN PARAMETER
         B        TQRETURN2
*                                   NORMAL RETURN PROCESSING
TQRETURN EQU      %
         LI,SR2   QECBCODE2
TQRETURN1 EQU     %
         LI,R4    QCCYES
         LI,R5    0
TQRETURN2 EQU     %
         OVERTO   TQOV1SEG,TQ:RTN#  ECB CHECK AND EXIT
*                 TQABORT...TRIGGER USER ABORT
*                                   ENTERED BAL,R0
*
*                                   VOLATILE REGISTERS: STANDARD
*                                   R6 = USER NUMBER
TQABORT  EQU      %
         LW,R2    S:CUN             CURRENT USER NUMBER
         CW,R2    R6                IS IT THE USER WE ARE ABORTING
         BE       TQABORT2          YES, CLEANUP
         LW,R7    R6
         LI,SR2   0
         BAL,R0   TQXQLIST
         OBSR4                      CONTINUE QUEUE PROCESSING
TQABORT2 EQU      %
         PUSH     4,R4              NO RETURN, EXIT IS TO SCHEDULER
         LW,R7    R6                USER # TO R7
         BAL,SR4  TQXUSR            DISCARD QLIST(S) THIS USER
         LI,R7    0                 UNQUEUE ALL USERS
         LI,SR3   QRTYPE            WAITING FOR QUEUE ACCESS
         BAL,R0   TQUQA
         PULL     4,R4
         OR,R5    CSTMBS
         BAL,R0   TQSETEXIT1
         B        T:ABORTM
*
TQSETEXIT1 EQU    %
         PULL     1,R1
         CW,R1    TSTACK
         BNE      TQSETEXIT1
         CI,R5    0
         BE       TQSETEXIT2
         BL       %+2               ABORT EXIT
         LW,SR3   -5,R1             GET FPT WORD 0
         LI,D3    QABNCODE          'BC' PORTION OF TP ERR MESSAGE
         STB,D3   SR3               SAVE IT IN SR3
         STB,R5   D3                SET UP SUBCODE AS REQUIRED FOR
*                                   STEP PROCESSOR
         LW,R6    R5
         SLS,R6   17
         LW,R7    Y00FE
         STS,R6   SR3
         CI,R5    0
         BL       %+2               ABORT EXIT
         STW,SR3  -13,R1
         STW,SR3  D2
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   QRTYPE3           IS THIS RESOURCE TYPE NOW AVAIL-
*                                   ABLE
         BE       TQUQA6            YES, SINCE REQUESTED ANY
         LW,D4    QUESTYP(M)+MASKS  CHECK SPECIFIC TYPE
         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
*
*
TQWAKEPOST EQU    %
         PUSH     R0
         PUSH     2,SR1
         BAL,R0   TQGETWORD         GET ECB WORD
         BEZ      TQWAKEPOST2       NONE
         LI,SR2   QECBCODE2
TQECBPOST EQU     %
*                                   VOLATILE REGISTERS: SR1,SR4
         PUSH     SR3
         LW,SR3   D4                VIRTUAL ADDRESS OF ECB
         LW,SR1   R7                USER #
         BAL,SR4  ECBPOST           POST ECB
         PULL     SR3
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
*
TQXUSR   EQU      %
*                                   R7 = USER NUMBER
*                                   VOLATILE REGISTERS: SR2, SR3
         PUSH     SR4
         LI,SR3   QRTYPE3           ANY RESOURCE
         BAL,R0   TQUQA             DISCARD USER FROM QUES CHAIN
         LI,SR2   0                 INDICATE ALL LISTS
         BAL,R0   TQXQLIST          DISCARD USER FROM QLIST
         PULL     SR4
         B        *SR4
         PAGE
TQXQLIST EQU      %
*                                   R7 = USER NUMBER
*                 SR2 = LIST ID
*                                   VOLATILE REGISTERS:STANDARD
         PUSH     R0
         PUSH     7,R7
         LI,R3    2
         LW,R4    R7
TQXQLIST2 EQU     %
         EXU      TQXQLISTS,R3
         BNEZ     TQXQLIST4
TQXQLIST3 EQU     %
         BDR,R3   TQXQLIST2
TQXQLIST3A EQU    %
         LI,R4    0
TQXQLISTEXIT EQU %
         PULL     7,R7
         B        TQPULLEXIT
TQXQLIST4 EQU     %
         CI,R4    0                 USER # GIVEN
         BE       TQXQLIST10        NO
TQXQLIST6 EQU     %
         LI,R5    QLUSR(I)          CHECK USER # IN QLIST
         BAL,R0   TQGETBYTE
         CW,D4    R4
         BE       TQXQLIST10        FOUND
TQXQLIST7 EQU     %
         LI,R5    QLCHAIN(I)
         BAL,R0   TQLOADF
         LW,R6    D3
         BNEZ     TQXQLIST4         YES, GO CHECK IT
         B        TQXQLIST3         NO,CHECK NEXT CHAIN
TQXQLIST10 EQU    %
         CI,SR2   0
         BE       TQXQLIST10A
         PUSH     4,R4
         LI,R7    QLID(I)/2-QLCHAIN(I)
         LI,R2    -1
         LW,R4    R3
         AI,R4    3
         LW,SR3   SR2               LIST ID IS CRITERIA
         LW,SR2   R6                A(QLIST) TO SR2
         LI,SR4   -1                FULL WORD MASK
         BAL,R1   TQDCHC
         STCF     R1
         PULL     4,R4
         LW,R6    SR3               R6=LID  SR2=A(QLIST)
         XW,R6    SR2
         LC       R1
         BCS,1    TQXQLIST7
TQXQLIST10A EQU   %
         PUSH     SR2
         LW,SR1   R6                BASE QLIST
         LW,R7    D4                R7 GETS USER #
         LI,D2    QLINX(I)          INDEX TO 1ST PAGE #
TQXQLIST12 EQU    %
         LI,R5    QLUSR(I)
         BAL,R0   TQGETBYTE
         LW,SR2   D4
TQXQLIST13 EQU    %
         LI,R5    QLNCP(I)          # PAGES THIS QLIST
         BAL,R0   TQGETBYTE
         LW,R2    D4
         LW,R5    D2             R5 GETS DISP TO 1ST REAL PAGE
TQXQLIST14 EQU    %
         BAL,R0   TQGETHWORD
         LW,SR3   D4
         BAL,SR4  RPWP              RELEASE WORK PAGE
         AI,R5    2              INCREMENT TO NEXT REAL PAGE
TQXQLIST16 EQU    %
         BDR,R2   TQXQLIST14        R2 INITIALLY CONTAINS # OF PAGES
*                                   THAT HAVE BEEN LOCKED FOR THE
*                                   DEFINELIST
         LI,R5    QLINXEXT(I)       CHECK QLIST EXTENT
         BAL,R0   TQLOADF
         BEZ      TQXQLIST30
         LW,R6    D3                RELEASE PAGES IN THE EXTENT
         LI,D2    QLINXPEXT(I)      INDEX TO 1ST PAGE
         B        TQXQLIST13
TQXQLISTS EQU     %-1
         GET,R6   Q:GETH
         GET,R6   Q:DEFH
*
TQXQLIST30 EQU    %
*                                   SR1 = BASE QLIST
TQXQLIST40 EQU    %
         PULL     SR2
         BAL,R0   TQRELQLIST
         CI,SR2   0                 SPECIFIC LIST ID RELEASED
         BE       TQXQLIST2
         LI,R4    1
         B        TQXQLISTEXIT
*
TQRELQLIST EQU    %
*                 VOLATILE REGISTERS: R5,R6,D1,D4
         PUSH     R0
         PUSH     2,SR1
         LW,R6    SR1            RESTORE PTR TO QLIST BASE
         LI,R5    QLUSR(I)
         BAL,R0   TQGETBYTE
         LW,R7    D4
         LI,R5    QLECB(I)
         LI,R2    QLWAIT(I)
         LW,D3    QLWAIT(M)
         CI,R3    2
         BE       %+2
         BAL,R0   TQWAKEPOST        POST ECB OR WAKE USER
         PUSH     2,R3
         EXU      TQGETBLOCKS6A,R3  CHAIN HDR TO R5
         LW,SR2   SR1
         BAL,R0   TQDCHAINA
         LW,R6    SR1
TQRELQLIST2 EQU   %
         LW,D1    R6
         LI,R5    QLINXEXT(I)
         BAL,R0   TQLOADF           GET EXTENT ADD IF ONE
         LW,R6    D3
         LI,SR1   0                 CORE RELEASE FLAG
         BAL,SR4  TQCOREALLOC
         CI,R6    0                 IS THERE AN EXTENT
         BNE      TQRELQLIST2       YES, RELEASE THE SPACE
         PULL     2,R3
         PULL     2,SR1
         B        TQPULLEXIT
         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
TQCALLMOVE8 EQU   %
         PUSH     R5                SAVE R5
         LCFI     8
         B        TQCALLMOVE
*
TQCALLMOVE10 EQU  %
         PUSH     R5                SAVE R5
         LCFI     10
TQCALLMOVE EQU    %
         STCF     R5
         PUSH     R0
         OVERLAY  TQOV1SEG,TQ:MOVE# TQMOVE
         PULL     R0                RESTORE R0
         PULL     R5                RESTORE R5
         B        *R0               AND RETURN
*
         PAGE
*                                   INTERFACE TO CHAIN/DECHAIN
TQDCH    EQU      %
         LI,R2    TQDCHAIN
         BAL,R0   *R2
         BCS,1    TQERROR
         B        *R1
         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 TPQ2
*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
         END      TPQ2:

