         TITLE    'TP QUEUE MANAGER***VERSION 7***APRIL 8, 1974***'
         SYSTEM   UTS
         SYSTEM   TP:TPO
         SYSTEM   LP:TPOQ
         PAGE
D00      SET      0                 CP-V VERSION
         REF      AVRTBLSIZ
         REF      AVRTBLNE
         REF      AVRTBL
         REF      AVRID
         REF      BATAPE
         REF      HGP
         REF      XFFFF
         REF      GETSNADR
         REF      TQGETBYTE,TQSETBYTE,TQGETHWORD,TQSETHWORD
         REF      TQGETWORD,TQSETWORD,TQLOADF,TQSTOREF
         REF      TQGETFIELD,TQSETFIELD,TQMOVEBS,TQCBYTE
         REF      RMB
         REF      Y00FE
         REF      YF
         REF      T:ABORTM
         REF      S:CUN
         REF      X1FFFE
         REF      X3FFE00
         REF      GMB
         REF      M17
         REF      CNMPROC0
         REF      CNMPROC1
         REF      CNMPROC2
         REF      CNMPROC3
         REF      CNMPROC4
         REF      CNMPROC9
         REF      ECBCHECK
         REF      ECBCHCK1
         REF      ECBPOST
         REF      E:UQA
         REF      T:RUE
         REF      JB:PRIV
         REF      TQCHAIN
         REF      TQCHAINC
         REF      TQDCHAIN
         REF      TQDCHAINA
         REF      TQDCHAINC
         REF      TQNEWQ
         REF      TQCHKBIT1,TQCHKBIT
         REF      UH:FLG2
         DEF      TQAUTH
         REF      JX:CMAP
         REF      GPWP
         REF      RPWP
         REF      FPWP
         REF      J:DCBLINK
         REF      SH:SYMT,SV:FTYM
         REF,2    JH:LDCF
         REF      J:ASSIGN
         DO       D00
         REF      SCREECH
         FIN
         GENREFS
CSTPGE   EQU      X3FFE00
         DO       QSIM=0
CSTMBS   EQU      BT31TO0+32
CSTMBR   EQU      NB31TO0+32
         ELSE
         REF      TTP
         REF      CSTMBS
         REF      CSTMBR
         DEF      TQSEARCH
         DEF      TQGET
         DEF      TQPUT
         DEF      TQSTATS
         FIN
*
         REF      TQ:AOK#
         REF      TQ:RTN#
         REF      TQ:NEWQ#
         REF      TQ:MOVE#
*
         DEF      TPQ2:
         REF      TQOV1SEG
TPQ2:    EQU      %
*
*
TESTTQ   SET      0
         PAGE
*
TQOVLY2  EQU      %
         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
*
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
         DO       TESTTQ
         B        TQUNLOCKA
         FIN
         LI,R5    QABN08            NOT REQUIRED PRIVILEGE
         B        TQENT06
TQUNLOCKA EQU     %
         BAL,R0   TQCKDCB           YES,PROCEED
         BEZ      TQENT05           DCB NOT IN DCBTAB,ABORT
         TBIT,R2  DCB#FCD,R6        CHECK FOR FILE OPEN
         BNEZ     TQENT14           YES, CONTINUE
         LI,R5    QABN09            NO, ABORT
         B        TQENT06
TQENT14  EQU      %
         LFIELD,R2 DCB#ASN,*R6      CHECK ASN = FILE
         CI,R2    DCB#FILE
         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
         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    %
         LW,R6    R2
         LI,R7    ALLBLOCK(I)-ALLCHAIN(I) R6 = BLOCK #, ALLOCATION MAP
         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
         CB,D3    Q:MIN(A)
         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
         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
         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
         LI,R1    1
         STB,R3   D3,R1             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,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
         LW,D3    D1                SET INDEX CONTROL BLOCK NUMBER
         LI,R5    CONTINXCONT(I)
         BAL,R0   TQSTOREF
*                                   GET A PAGE FOR THE ICB
         BAL,R0   TQGETCBLOCK
         BE       TQABN12F
         SADR,SR3      Q:INXCONTROL
         XW,SR3   R6
         LI,R5    ICBBLOCK(I)       SET BLOCK NUMBER
         BAL,R0   TQSTOREF
         XW,SR3   R6
         AI,D3    1                 SET NUMBER OF THE FIRST BLOCK
*                                   IN THE ALLOCATION MAP
         LI,R5    CONTFIRSTGDA(I)
         BAL,R0   TQSTOREF
         AI,D3    1
         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
         LCFI     12                FCN TO WRITE, IGNORE BACKUP
         BAL,R0   TQIOCHAIN
         PULL     R7
         CI,R5    0                 TEST I/O ERROR
         BE       TQUNLOCK2D1       NO, CONTINUE UNLOCK
         B        TQERROR           YES, QUIT
*
         PAGE
*                 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
         B        TQABN20           ABNORMAL RETURN
         SPACE    6
TQGETCHAIN EQU    %
         LI,R5    QCHAIN(I)
         BAL,R0   TQLOADF
         B        *R2
         PAGE
TQLOCK   EQU      %                 LOCK ACCESS TO QUEUE
         BAL,R0   TQCKDCB           VALIDITY CHECK DCB
         BCR,1    TQENT05
         TBIT,R3  DCB#FCD,R6        CHECK FOR FILE OPEN
         BEZ      TQENT05
         LW,R4    S:CUN
         L,R5,R1  Q:OWN             USER = QUEUEE OWNER
         CW,R4    R5
         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      %
         OR,D2    CSTMBS
TQLOCK1B EQU      %                 DON'T RETURN CORE PAGES ON PAUSE
         LCFI     12
         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)
         OR,R5    CSTMBS
         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,R6    SR1
         SLS,R6   16
         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
****************************************************************
*
*                 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
         DO       TESTTQ
         BEZ      TQRESTORE14
         FIN
         LW,D1    D3
         BAL,R0   TQGETCBLOCK
         BEZ      TQRESTORE14
         LW,SR2   D1
         B        TQRESTORE1
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   D3
         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
         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
         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...INITIATE I/O FOR A SERIES OF
*                 QUEUE BLOCKS. ALL BLOCKS OR BLOCKS OF A
*                 GIVEN TYPE.
*                 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     %
         BCR,8    TQIOCHAIN2        READ REQUEST
         BCS,4    TQIOCHAIN4        WRITE, IGNORE BACKUP
         TBIT,R2  Q:BACK            WRITE, BACKUP NOT WANTED
         BEZ      *R0               EXIT
         LI,D4    QWRITEIF          PUT WRITE UNDER CONTROL OF
*                                   WRITE REQUIRED FLAGS
         B        TQIOCHAIN6
TQIOCHAIN2 EQU    %
         LI,D4    QREAD             SET I/O OP TO READ
         B        TQIOCHAIN6
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
         CI,D4    QWRITEIF          TEST FOR CONDITIONAL WRITE
         BNE      TQIOCHAIN10
         LI,R5    CONTWRITE(I)      CHECK WRITE REQUIRED
         LW,D4    CONTWRITE(M)
         BAL,R0   TQGETFIELD
         BNEZ     TQIOCHAIN9A
         LI,D4    QWRITEIF
         B        TQIOCHAIN14
TQIOCHAIN9A EQU   %
         LI,SR3   QWRITE
         LI,D4    QWRITEIF
         B        TQIOCHAIN12
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
         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
         B        TQENT05           NO, ABORT THIS USER
*
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,SR3   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
         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   0                 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
         LI,R2    QABNCODE
         STB,R2   SR3
         LW,R6    R5
         SLS,R6   17
         LW,R7    Y00FE
         STS,R6   SR3
         CI,R5    0
         BL       %+2               ABORT EXIT
         STW,SR3  -13,R1
         LW,D3    SR3
         SCS,D3   8
         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
         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
         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
         OR,R5    CSTMBS
         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   3
         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
         XW,R6    SR2
         BAL,R1   TQDCHC
         STCF     R1
         LW,SR1   R6
         PULL     4,R4
         LW,R6    SR1
         XW,R6    SR2
         LC       R1
         BCS,1    TQXQLIST7
TQXQLIST10A EQU   %
         PUSH     SR2
         LW,SR1   R6                BASE QLIST
         LW,R7    D4
         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                DISPLACEMENT TO START
TQXQLIST14 EQU    %
         BAL,R0   TQGETHWORD
         LW,SR3   D4
         BAL,SR4  RPWP              RELEASE WORK PAGE
         AI,R5    2                 INCREMENT FOR NEXT PAGE
TQXQLIST16 EQU    %
         BDR,R2   TQXQLIST14
         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
         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
         OR,R5    CSTMBS
         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   %
         LCFI     8
         B        TQCALLMOVE
*
TQCALLMOVE10 EQU  %
         LCFI     10
TQCALLMOVE EQU    %
         STCF     R5
         PUSH     R0
         OVERLAY  TQOV1SEG,TQ:MOVE# TQMOVE
         B        TQPULLEXIT
*
         PAGE
*                                   INTERFACE TO CHAIN/DECHAIN
TQCH     EQU      %
         LI,R2    TQCHAIN
TQC1     EQU      %
         OR,R5    CSTMBS
         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
         OR,R5    CSTMBS
         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
TQERROR  EQU      %
         DO       QSIM
         B        SCREECH
         ELSE
         SCREECH  QSCREECH
         FIN
         END      TPQ2:
		 
