QREC
          IDENT  QREC1,FWA,QREC,01,00 
          ABS 
          SST 
          SYSCOM B1 
*COMMENT  QREC - QUEUE RECOVERY PROCESSOR.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  QREC - QUEUE RECOVERY PROCESSOR. 
          SPACE  4
***       QREC - QUEUE RECOVERY PROCESSOR.
*         D. A. COAPSTICK    74/09/16.
*         R. A. JAPS.        75/02/19.
          SPACE  4,4
***       *QREC* IS A QUEUE RECOVERY UTILITY PROGRAM THAT ACTIVATES OR
*         DEACTIVATES QUEUED FILES AND/OR PROVIDES A LIST OF RELATIVE 
*         INFORMATION PERTAINING TO INACTIVE QUEUES.
          SPACE  4
***       *QREC* MAY BE CALLED BY THE QUEUED FILE SUPERVISOR PROGRAM OR 
*         COMMAND.  *QREC* WILL ALSO BE CALLED BY A 
*         COMMAND CALL TO *QLIST*.  THE FOLLOWING PARAMETERS ARE
*         VALID FOR *QREC*. 
* 
*         MI=MACHINE ID.
*         FM=FAMILY NAME. 
*         DN=DEVICE NUMBER (FAMILY ENTRY MUST BE SPECIFIED).
*         FU=FAMILY NAME FOR USER INDEX REQUEUING.
*         UI=USER INDEX RANGE (E.G., UI=3-177). 
*         DA=REQUEUING DATE.  MAY BE A SINGLE ENTRY (DA=740916) OR A
*            RANGE ENTRY (DA=740911-740916) OR (DA=ALL).
*         FS=FILE SIZE RANGE (0-777777B). 
*            IF 777777B IS SPECIFIED, ALL SIZES LARGER ARE INCLUDED.
*         I  = ALTERNATE DIRECTIVE INPUT FILE. THIS IS A
*                COMMAND PARAMETER SPECIFYING WHAT FILE SHOULD
*                BE READ FOR INPUT DIRECTIVES.  THESE DIRECTIVES
*                CONSIST OF ANY LEGAL K-DISPLAY INPUT OR COMMANDS.
*                THESE DIRECTIVES WILL BE PROCESSED AFTER THE 
*                COMMAND DIRECTIVES BUT BEFORE ANY
*                K-DISPLAY INPUT IS ACCEPTED. 
*         JSN=JOB SEQUENCE NUMBER.  UP TO FIVE JSN-S. 
*         ID=BATCH ID RANGE.
*         LA = LOWER SECURITY ACCESS LEVEL. 
*         UA = UPPER SECURITY ACCESS LEVEL. 
*         TUI=DESTINATION USER INDEX RANGE FOR SELECTING FILES
*             IN THE REMOTE BATCH QUEUE (*TF* MUST BE SPECIFIED). 
*         TF=DESTINATION FAMILY FOR TERMINAL FOR SELECTING FILES
*            IN THE REMOTE BATCH QUEUE. 
*         FC=FORMS CODE.  MAY BE A SINGLE ENTRY (FC=F1), A LIST 
*            (FC=F1/F2/F3), OR A RANGE (FC=F1-F2) WHERE F1 IS 2 
*            CHARACTERS, ALL, OR NULL (SPECIFIED BY **).
*         L=LFN.  FILE TO RECEIVE OUTPUT. 
*         OP=XX.  REQUEUING OPTIONS.
*            RP - REQUEUE SPECIFIED FILES, PURGE OTHERS.
*            RI - REQUEUE SPECIFIED FILES, IGNORE OTHERS. 
*            PI - PURGE SPECIFIED FILES, IGNORE OTHERS. 
*            DI - DEQUEUE SPECIFIED FILES, IGNORE OTHERS. 
*         DS=DT.  SELECT FILE DESTINATION BY DISPOSITION TYPE.
*                FILE DESTINATION TYPES INCLUDE - 
*                BC - BATCH.
*                RB - REMOTE BATCH. 
*                DISPOSITION TYPES INCLUDE- 
*                SF  SPECIAL INSTALLATION DEFINED QUEUE FILES 
*                IN  INPUT
*                PU  PUNCH
*                PL  PLOT 
*                PR  PRINT - ANY PRINTER
*                P2  PRINT - 512 PRINTER
*                LR  PRINT - 580-12 PRINTER 
*                LS  PRINT - 580-16 PRINTER 
*                LT  PRINT - 580-20 PRINTER 
*                LX  PRINT - 5870 NIP 
*                LY  PRINT - 5970 NIP 
*                WT  WAIT 
*                PRINT  ALL PRINT TYPES 
*                ALL  ALL TYPES 
*                NONE  NO TYPES 
* 
*         DEFAULT VALUES DEFINED IN *QFSP*
          SPACE  4
**        ENTRY CONDITIONS. 
* 
*                *QREC* IS ENTERED VIA A *RJ* FROM *QFSP*.
* 
*         *TARA* = FWA OF THE PARAMETER TABLE.
*         *QFTA* = *QFTP* WORD FROM CENTRAL MEMORY RESIDENT.
*         *TDAA* = FWA OF DEVICE ACCESS LEVEL TABLE.
*         *TEQA* = MASS STORAGE EQUIPMENT TABLE.
*         *TMSA* = MASS STORAGE DESCRIPTION TABLE.
*         *FOTA* = FAMILY ORDINAL TABLE.
          SPACE  4
***       DAYFILE MESSAGES. 
* 
* 
*         * QFT THRESHOLD LIMIT.* = QFT HAS REACHED THE LIMIT 
*         ALLOCATED FOR QUEUED FILES. RETRY WHEN SYSTEM IS NOT AS BUSY. 
* 
*         * DNYY  FM AAAAAAA   NO IQFT FILE.* = NO IQFT 
*         FILE EXISTS FOR SPECIFIED DEVICE. 
* 
*         * DNYY  FM AAAAAAA   INCORRECT ACCESS LEVEL.* 
*         THE JOB DOING THE *QREC* IS NOT VALIDATED FOR THE 
*         ACCESS LEVELS OF THE DEVICE.
* 
*         * DNYY  FM AAAAAAA   IQFT INTERLOCKED.* = IQFT
*         FILE TRACK INTERLOCK SET. COULD MEAN IQFT 
*         IS CURRENTLY BEING USED BY ANOTHER UTILITY. RETRY AT A
*         LATER TIME. 
* 
*         * DNYY  FM AAAAAAA   FNT/QFT FULL.* = THE FNT OR QFT WAS
*         FILLED WHILE RECOVERING SPECIFIED DEVICE. 
*         RETRY WHEN SYSTEM IS NOT AS BUSY. 
* 
*         * DNYY  FM AAAAAAA   MS ERROR.* = MASS
*         STORAGE ERROR ON IQFT FILE THIS DEVICE. 
* 
*         * DNYY  FM AAAAAAA   IGNORED - ERROR IDLE.* = QUEUES ON 
*         THE SPECIFIED DEVICE WERE NOT PROCESSED BECAUSE THE DEVICE
*         HAD AN ERROR IDLE CONDITION.
* 
*         * DNYY  FM AAAAAAA   IGNORED - REMOVABLE.* = QUEUES ON
*         SPECIFIED DEVICE WERE NOT PROCESSED BECAUSE THE DEVICE IS 
*         REMOVABLE.
* 
*         * DNYY  FM AAAAAAA   IGNORED - UNAVAILABLE.* = QUEUES ON
*         SPECIFIED DEVICE WERE NOT PROCESSED BECAUSE THE DEVICE IS 
*         UNAVAILBLE. 
* 
*         * DNYY  FM AAAAAAA   UNDEFINED ERROR.*
* 
*         * FOT FULL - FILES IGNORED.* - SOME OF THE QUEUED FILES 
*         WERE NOT PROCESSED BECAUSE THERE WAS NO FOT ENTRY FOR THE 
*         CREATION AND/OR THE DESTINATION FAMILY AND THE FOT WAS
*         FULL (MESSAGE ISSUED BY *COMCVQF*). 
* 
*         * QREC/QLIST ABORTED.*
* 
*         * QUEUE STATUS INDEFINITE.* = REFLECTS QUEUE
*         STATUS IN EVENT OF ABNORMAL ABORT.
* 
*         * XXXX FILES ACTIVATED DNYY FM AAAAAAA.* = NUMBER 
*         OF QUEUED FILES ACTIVATED THIS DEVICE.
* 
*         * XXXX FILES DEQUEUED  DNYY FM AAAAAAA.* = NUMBER 
*         OF QUEUED FILES DEQUEUED THIS DEVICE. 
* 
*         * XXXX FILES IGNORED   DNYY FM AAAAAAA.* = NUMBER 
*         OF QUEUED FILES REMAINING INACTIVE THIS DEVICE. 
* 
*         * XXXX FILES PURGED    DNYY FM AAAAAAA.* = NUMBER 
*         OF QUEUED FILES PURGED THIS DEVICE. 
* 
*         * QUEUES UNRECOVERABLE THIS DEVICE.* = SOME OR ALL
*         QUEUE FILES LOST DUE TO A MASS STORAGE ERROR ON 
*         THE IQFT FILE (ACCOMPANIES MS ERROR MESSAGE). 
* 
*         * JSN      EQNNNN TRACK TTTT LENGTH ERROR.* = PHYSICAL EOI
*         AND LOGICAL EOI(TRT) ARE NOT IDENTICAL. 
* 
*         * NO INACTICE QUEUES PRESENT.* = NO INACTIVE WERE FOUND WHEN
*         PROCESSING A LIST COMMAND. (TO CONTROL POINT DAYFILE ONLY). 
* 
*         * FILE NAME CONFLICT.* = FILE TO RECEIVE OUTPUT CAN 
*         NOT BE NAMED *IQF*, OR *NIQFT*. 
          SPACE  4
**        COMMON DECKS. 
  
*CALL     COMCCMD 
*CALL     COMCMAC 
*CALL     COMSACC 
*CALL     COMSDSP 
*CALL     COMSJIO 
          LIST   X
*CALL     COMSIOQ 
*CALL     COMSQFS 
*CALL     COMSSFM 
          LIST   -X 
*CALL     COMSMLS 
*CALL     COMSSCD 
          TITLE  PROGRAM CONSTANTS. 
*         PROGRAM CONSTANTS.
  
 BUFL     EQU    1001B       BUFFER LENGTHS 
 LLIM     EQU    TPPA+PPPL   LINE LIMIT 
 PDFE     EQU    TPPA+PPPD   PRINT DENSITY FORMAT EFFECTOR
          TITLE  RESERVED LOCATIONS AND FETS. 
*         RESERVED LOCATIONS. 
  
          ORG    OVLA 
  
 FWA      BSS    0
  
*         INACTIVE QUEUED FILE ENTRY. (WORKING BUFFER). 
  
 IQFE     BSS    QFEWL
          SPACE  4
*         FETS. 
  
 IQ       BSS    0           OLD IQFT FILE
 "RFIQ"   RFILEB IBUF,BUFL,EPR,(FET=8)
  
 NIQ      BSS    0           NEW IQFT FILE
 "RFNI"   FILEB  NBUF,BUFL,(FET=9)
  
 O        BSS    0           OUTPUT FILE
 OUTPUT   FILEB  OBUF,BUFL,(FET=7)
  
 R        BSS    0           REACTIVATE FILE
 RECV     FILEB  RBUF,BUFL,(FET=8)
  
 P        BSS    0           PURGE FILE 
 PUR      FILEB  PBUF,BUFL,(FET=8)
 RPVB     SPACE  4,10 
*         REPRIEVE BLOCK. 
  
 RPVB     VFD    36/0,12/31B,12/0 
          VFD    30/0,30/ERR
          BSSZ   27B
          TITLE  MAIN LOOP. 
**        MAIN LOOP.
* 
*         ENTRY  PARAMETER BLOCK DEFINED IN *COMSQFS* (TARA)
*                MASS STORAGE TABLE (TEQA)
* 
*         EXIT   (X2) = K - DISPLAY ADDRESS.
*                (X5) = TERMINATING MESSAGE.
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6. 
*                A - 1, 2, 3, 4, 6. 
*                B - 1, 3.
* 
*         CALLS  CTF, PRS.
* 
*         MACROS MESSAGE, RECALL. 
  
  
*         RETURN FROM PROCESSORS. 
  
 QRE5     BX2    X2-X2       SET PRIMARY RIGHT SCREEN DISPLAY 
  
 QREC     SUBR               ENTRY/EXIT 
          SB1    1
          SA1    QFTS        QFT LENGTH 
          NZ     X1,QRE1     IF PRESET UNNECESSARY
          RJ     PRS         PRESET 
  
*         DETERMINE FUNCTIONAL ROUTINE. 
  
 QRE1     SA2    TARA+ARFC
          MX0    -12
          BX2    -X0*X2 
          SA3    X2+TFCN
          SX6    X3+         SAVE PROCESSOR ADDRESS 
          SA6    QREB 
          SX1    X3-PAG 
          ZR     X1,QRE4     IF PAGE OPTION 
  
*         SET OUTPUT FILE NAME. 
  
          RECALL O
          MX0    42 
          SA4    O           GET CURRENT FILENAME 
          BX6    X6-X6
          SA2    TARA+ARLL
          BX1    X4-X2
          BX4    X0*X1
          ZR     X4,QRE2     IF NO FILE NAME CHANGE 
          SA1    IQ          CHECK FOR FILE NAME CONFLICTS
          BX4    X1-X2
          BX4    X0*X4
          ZR     X4,QRE1.1   IF FILE NAME CONFLICT
          SA1    NIQ
          BX4    X1-X2
          BX4    X0*X4
          NZ     X4,QRE1.2   IF NO FILE NAME CONFLICT 
 QRE1.1   SX5    =C* FILE NAME CONFLICT.* 
          MESSAGE  X5 
          MX2    1           NO K - DISPLAY CHANGE
          JP     QRECX       RETURN 
  
 QRE1.2   SA6    LSTA        INITIALIZE LIST FLAGS
          SA6    GRDE 
 QRE2     SX1    3           SET FILENAME IN FET
          BX6    X1+X2
          SA6    A4 
  
*         DETERMINE IF REQUEUE/DEQUEUE FUNCTION.
  
          SX1    X3-GRD 
          NZ     X1,QRE4     IF NOT GO COMMAND PROCESSOR
  
*         SET PROPER PROCESSING ROUTINE.
  
          SA2    TARA+AROP   OPTION PARAMETER 
          SX3    DEIG 
          IX3    X2-X3
          ZR     X3,QRE3     IF DEQUEUE OPTION
          SX3    PGIG 
          IX2    X2-X3
          ZR     X2,QRE2.1   IF NOT REQUEUE 
          RJ     CTF         CREATE TABLE OF ACTIVE FAMILIES
          BX6    X6-X6       CLEAR FOT FULL FLAG
          SA6    FOTF 
 QRE2.1   SX3    B1 
 QRE3     SA3    X3+QREA
          BX6    X3 
          SA6    GRDA 
 QRE4     SA3    QREB 
          SB3    X3+
          JP     B3          JUMP TO PROCESSOR
  
*         FUNCTION TABLE. 
  
 TFCN     BSS    0
          LOC    0
          CON    GRD         GO COMMAND PROCESSOR 
          CON    PAG         PAGE K-DISPLAY PROCESSOR 
          CON    LST         LIST INACTIVE QUEUES PROCESSOR 
          CON    OUT         DISPOSE OUTPUT FILE PROCESSOR
          LOC    *O 
 TFCNL    EQU    *-TFCN 
  
  
 QREA     BSS    0
+         RJ     DEQ         DEQUEUE FILES
+         RJ     PIQ         PROCESS INACTIVE QUEUE FILES 
  
 QREB     CON    0           PROCESSOR ADDRESS
          TITLE  REQUEUE/DEQUEUE PROCESSOR. 
 GRD      SPACE  4,20 
**        GRD - REQUEUE AND DEQUEUE.
* 
*         *GRD* PERFORMS THE COMMON FUNCTIONS OF REQUEUING AND
*         DEQUEUING.
* 
*         EXIT   TO *QRE5*. 
*                (X5) = TERMINATING MESSAGE.
* 
*         USES   X - 2, 3, 5, 6, 7. 
*                A - 2, 3, 6, 7.
*                B - 0. 
* 
*         CALLS  DEQ, DND, EMG, IDM, PIQ, RAF.
* 
*         MACROS CLOCK, DATE, REPRIEVE, RETURN, REWIND, SETFS,
*                SKIPEI, WRITER.
  
  
 GRD      BSS    0
  
*         PRESET MULTIPLE EQUIPMENT INDEX.
  
          SX7    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          SA7    CEQP 
  
*         WRITE REPORT PAGE HEADER. 
  
          DATE   WPHC1       SET DATE IN HEADER 
          CLOCK  WPHC2       SET TIME IN HEADER 
          REWIND O
          SKIPEI O
          SX7    B1 
          SA7    LSTB        INITIALIZE LINE NUMBER 
          BX6    X6-X6
          SA7    WPHA        INITIALIZE PAGE COUNT
          SA6    WPHB        CLEAR LINE COUNT 
          SA7    PDFE+1      SET PRINT DENSITY FORMAT CONTROL FLAG
          SA6    NAQS        CLEAR NUMBER OF AVAILABLE QFT SLOTS
  
*         CLEAN UP FILES. 
  
 GRD2     SX3    IQ          RETURN ATTACHED FILE 
          RJ     RAF
          RETURN NIQ
          RETURN IQF
          REWIND NIQ
  
*         DETERMINE NEXT DEVICE.
  
 GRD3     RJ     DND         DETERMINE NEXT DEVICE
          ZR     X4,GRD6     IF END OF OPERATION
          SA3    X6+TMSA     CHECK ERROR IDLE STATUS
          BX7    X4 
          LX3    59-11
          SA7    GRDD        *TEQA* TABLE ENTRY 
          PL     X3,GRD4     IF NO ERROR IDLE ON DEVICE 
          SX5    EIDE*2000B  *IGNORED - ERROR IDLE.*
          RJ     EMG
          EQ     GRD3        DETERMINE NEXT DEVICE
  
 GRD4     REPRIEVE  RPVB,SET,237B  SET REPRIEVE PROCESSING
  
*         BEGIN QUEUE OPERATION.
  
 GRDA     RJ     PIQ         PROCESS IQFT FILE
*         RJ     DEQ         DEQUEUE
  
          REPRIEVE  RPVB,SET,0  CLEAR REPRIEVE PROCESSING 
  
          RJ     IDM         ISSUE DAYFILE MESSAGES.
  
*         DETERMINE IF END OF OPERATION.
  
          SA3    TARA+AROP
          SX2    X3-PGIG
          ZR     X2,GRD5     IF PURGE/IGNORE OPTION 
          SA2    NAQS        CHECK NUMBER OF AVAILABLE QFT SLOTS
          SX5    PIQA        * QFT THRESHOLD LIMIT.*
          PL     X2,GRD5     IF THRESHOLD NOT REACHED 
          BX6    X5          FLAG OPERATOR ACTION REQUIRED
          SA6    OPAM 
          EQ     GRD7        CONTINUE 
  
 GRD5     SA2    TARA+ARDN
          ZR     X2,GRD2     IF NO SPECIFIC DEVICE
 GRD6     SB0    0
          SX5    =C* QREC COMPLETE.                         * 
 GRD7     WRITER O           FLUSH OUTPUT BUFFER
          SX6    B1 
          SA6    GRDE        FLAG FILE WRITTEN
          BX7    X7-X7
          SA7    LSTA        CLEAR LIST FILE WRITTEN FLAG 
          SA3    TARA+ARFC
          PL     X3,QRE5     IF NOT COMMAND CALL
          SETFS  O,0
          JP     QRE5        RETURN - COMPLETE
  
  
  
 GRDD     BSS    1           *TEQA* TABLE ENTRY 
 GRDE     CON    0           *REQUEUE/DEQUEUE* FLAG 
  
          TITLE  RECOVER/DEQUEUE SUBROUTINES. 
 DEQ      SPACE  4,15 
**        DEQ - DEQUEUE DEVICE. 
* 
*         *DEQ* DEACTIVATES ALL QUEUES THAT MATCH THE PARAMETERS
*         FOR A SPECIFIC DEVICE.
* 
*         ENTRY  (X7) AND (GRDD) = *TEQA* TABLE ENTRY.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 3, 5, 6. 
* 
*         CALLS  ATT, CAF, CLD, DAL, EMG, RQT, SPF, VQE, WOF. 
* 
*         MACROS MOVE, QCALL,  READ, READW, RECALL, REWIND, 
*                SKIPEI, WRITER, WRITEW.
  
  
 DEQ10    RJ     EMG         ISSUE ERROR MESSAGES 
  
 DEQ      SUBR               ENTRY/EXIT 
          SX5    RDVE*2000B 
          LX7    59-1 
          NG     X7,DEQ10    IF REMOVABLE DEVICE
          LX7    59-0-59+1
          SX2    X2+7000B    SET ASSIGN-BY-ORDINAL FLAG 
          SX5    FNFE*2000B 
          PL     X7,DEQ10    IF NO IQFT FILE ON DEVICE
          SA2    CEQP        EST ORDINAL
          SX3    IQ          ATTACH IQFT FILE AS *IQ* 
          RJ     ATT
          NZ     X5,DEQ10    IF ERROR IN ATTACH 
          SKIPEI X3,R        POSITION FILE
  
*         DEQUEUING LOOP. 
  
          REWIND NIQ
          RJ     RQT         READ QFT INTO *RBUF* 
          SA2    QFTS 
          SB5    RBUF 
          SB6    X2+RBUF     END OF QFT 
          RECALL NIQ
  
*         BUILD CANDIDATE ENTRIES.
  
 DEQ3     SB5    B5+QFTE     ADDRESS OF QFT ENTRY 
          BX6    X6-X6       CLEAR RERUN FLAG 
          SA6    DEQA 
          LE     B6,B5,DEQ5  IF END OF QFT
          SA5    B5+         READ QFT ENTRY 
          MX0    -12         CLEAR LINKAGE FIELD
          BX1    X0*X5
          ZR     X1,DEQ3     IF EMPTY QFT SLOT
          LX5    59-1 
          NG     X5,DEQ3     IF ATTACHED TO A JOB 
          SX4    B1          SET CHECK FOR LID IN TABLE 
          SA3    B5+2        CHECK LOGICAL IDENTIFIER 
          RJ     CLD
          NZ     X3,DEQ3     IF NO MATCH
          SA1    TARA+AROP   SELECT ORIGIN TYPE ACCESS LEVEL CHECK
          SB2    B0+         PRESET NO ORIGIN TYPE CHECK
          SX1    X1-2 
          PL     X1,DEQ3.0   IF NOT REQUEUE 
          SB2    B1+         SET ORIGIN TYPE CHECK
 DEQ3.0   SA1    TARA+ARUA   SET ACCESS LEVEL LIMITS
          SA2    TARA+ARLA
          SA3    B5+INSQ     GET *INSQ* WORD OF QFT ENTRY 
          RJ     CAF         CHECK ACCESS LEVEL OF FILE 
          NZ     X1,DEQ3     IF FILE NOT SELECTED 
          SX1    B5+
          BX5    X1 
          RJ     VQE         VERIFY QFT ENTRY 
          SB5    X5+
          NZ     X1,DEQ3     IF ENTRY DOES NOT MATCH
          SA3    CEQP        CHECK EST ORDINAL
          BX1    X3-X2
          NZ     X1,DEQ3     IF NOT THIS EQUIPMENT
  
*         FILE MATCHES CRITERIA - CREATE PSEUDO IQFT ENTRY. 
  
          SA4    NIQ+2       IN POINTER 
          SX6    X4+QFEWL    ADVANCE IN POINTER 
          SA3    A4+2        LIMIT
          SX3    X3 
          IX2    X3-X6       LIMIT - (IN+QFEWL) 
          SB3    X2 
          LE     B3,DEQ4     IF NO ROOM IN BUFFER 
          SA6    A4 
          SX6    B5-RBUF     SET QFT ORDINAL IN ENTRY 
          SX1    QFTE 
          IX6    X6/X1
          SA6    X4+QFEWL-1 
          SB3    QFEWL-QFTE-1  NUMBER OF WORDS TO CLEAR 
          BX6    X6-X6
 DEQ3.1   SB3    B3-B1
          SA6    A6-B1
          NZ     B3,DEQ3.1   IF MORE WORDS TO CLEAR 
          MOVE   QFTE,B5,X4  MOVE QFT ENTRY TO *NBUF* 
          JP     DEQ3        LOOP FOR NEXT ENTRY
  
*         SET RERUN THIS DEVICE - NEW IQFT BUFFER FULL. 
  
 DEQ4     SX3    B6          SAVE (B5) AND (B6) 
          SX6    B5 
          LX6    18 
          BX6    X3+X6
          SA6    DEQA 
  
*         QFT ENTRYS PROCESSED - SET *QFM* PARAMETERS.
  
 DEQ5     SA1    NIQ
          RJ     SPF
  
*         *QFM* BUILDS IQFT ENTRIES FOR SELECTED FILES. 
  
          QCALL  DEQF,NIQ    DEQUEUE LIST 
  
*         COPY DEQUEUED ENTRIES TO IQFT.
  
          READ   NIQ,*
  
 DEQ6     READW  NIQ,IQFE,QFEWL 
          NZ     X1,DEQ7     IF END OF BUFFER 
          SA2    IQFE 
          ZR     X2,DEQ6     IF ENTRY NOT AVAILABLE 
          WRITEW IQ,IQFE,QFEWL
          SA5    IDMB 
          SA3    DEQC 
          SX7    X5+B1       INCREMENT COUNT
          SA7    A5 
          SX5    WPHG        SET FWA OF PAGE HEADER 
          RJ     WOF         WRITE OUTPUT FILE
  
          JP     DEQ6 
  
 DEQ7     SA5    IDMB 
          ZR     X5,DEQ8     IF NO FILES DEQUEUED 
          WRITER IQ,R 
 DEQ8     SA3    DEQA 
          SB6    X3 
          LX3    -18
          SB5    X3-QFTE
          NZ     X3,DEQ3     IF MORE QFT-S TO PROCESS THIS DEVICE 
  
*         RETURN EXISTING IQFT FILE/SET TRACK POINTER FOR NEW FILE. 
  
          QCALL  DTQF,IQ     DETACH IQFT FILE 
          BX6    X6-X6
          SA6    ATTA        CLEAR ATTACHED FLAG
          JP     DEQX        RETURN 
  
  
 DEQA     BSS    1           RERUN INDICATOR
 DEQB     BSS    1           RETURN/PURGE FUNCTION
 DEQC     DATA   H*DEQUEUED*
 PIQ      SPACE  4,20 
**        PIQ - PROCESS IQFT FILE.
* 
*         *PIQ* PERFORMS WHATEVER OPTION IS SELECTED ON THE IQFT
*         FILE FOR A PARTICULAR DEVICE. 
* 
*         ENTRY  (X7) = *TEQA* TABLE ENTRY. 
*                (CEQP) = EST ORDINAL.
* 
*         USES   X - ALL. 
*                A - 0, 1, 2, 3, 5, 6, 7. 
*                B - 3. 
* 
*         CALLS  ATT, CAF, CAS, CIN, CLD, CME, EMG, PLE, RFB, VIE.
* 
*         MACROS QCALL, READEI, READW, RECALL, REQUEST, REWIND
*                WRITER, WRITEW.
  
  
 PIQ12    RJ     EMG         ISSUE ERROR MESSAGES 
  
 PIQ      SUBR               ENTRY/EXIT 
          LX7    59-0 
          PL     X7,PIQX     IF NO IQFT FILE ON THIS DEVICE 
          LX7    59-1-59+0
          SX5    RDVE*2000B 
          NG     X7,PIQ12    IF REMOVABLE DEVICE
 PIQ1     RJ     CAS         CALCULATE NUMBER OF AVAILABLE QFT SLOTS
          SA1    NIQ+1       CREATE NEW IQFT FILE 
          SA2    CEQP        FORCE NEW IQFT FILE TO SAME DEVICE 
          SA3    TDAA+X2     GET ACCESS LEVEL 
          MX0    12 
          SX2    X2+7000B    SET ASSIGN-BY-ORDINAL FLAG 
          BX1    -X0*X1 
          LX2    48 
          BX6    X2+X1
          SX4    B1          SET SPECIAL PROCESSING FLAG
          LX4    39 
          BX6    X6+X4
          SA6    A1 
          RJ     DAL         DETERMINE VALID ACCESS LEVEL 
          SX5    NSEE*1S10   * INCORRECT ACCESS LEVEL.* 
          NG     X3,PIQ12    IF NO VALID ACCESS LEVEL 
          SA1    NIQ+4       SET ACCESS LEVEL 
          MX0    -3 
          LX3    36 
          LX0    36 
          BX1    X0*X1
          BX6    X1+X3
          SA6    A1 
          REQUEST NIQ,U      NEW IQFT FILE
  
*         ATTACH IQFT FILE. 
  
          SA2    CEQP        EST ORDINAL
          SX3    IQ          ATTACH AS *IQ* 
          RJ     ATT
          NZ     X5,PIQ12    IF ERROR ON ATTACH 
  
*         READ IQFT FILE. 
  
          READEI X3,R 
          RECALL P
          SA5    IDMC 
 PIQ2     ZR     X5,PIQ2.1   IF END OF IGNORED FILES
          READW  IQ,IQFE,QFEWL
          WRITEW NIQ,IQFE,QFEWL 
          SX5    X5-1 
          EQ     PIQ2        CHECK FOR MORE IGNORED FILES 
  
*         PROCESSING MAIN LOOP. 
  
 PIQ2.1   READW  IQ,IQFE,QFEWL
          RJ     CME         CHECK FOR MASS STORAGE ERROR 
          NZ     X5,PIQ8.1   IF MASS STORAGE ERROR
          NZ     X1,PIQ8.1   IF EOF/EOI 
          SA2    IQFE+8 
          PL     X2,PIQ3     IF NO LENGTH ERROR 
          RJ     PLE         PROCESS LENGTH ERROR 
          SX2    WIE         SET IGNORE OPTION
          JP     PIQ5 
  
*         VALIDATE IQFT ENTRY.
  
 PIQ3     SA3    IQFE+2      CHECK LOGICAL IDENTIFIER 
          SX4    B1+         SET CHECK FOR LID IN TABLE 
          RJ     CLD
          ZR     X3,PIQ3.1   IF MATCH 
          SX2    WIE         SET IGNORE OPTION
          EQ     PIQ5        PROCESS IGNORE OPTION
  
 PIQ3.1   SA1    TARA+AROP   SELECT ORIGIN TYPE ACCESS LEVEL CHECK
          SB2    B0+         PRESET NO ORIGIN TYPE CHECK
          SX1    X1-2 
          PL     X1,PIQ3.2   IF NOT REQUEUE 
          SB2    B1+         SET ORIGIN TYPE CHECK
 PIQ3.2   SA1    TARA+ARUA   SET ACCESS LEVEL LIMITS
          SA2    TARA+ARLA
          SA3    IQFE+INSQ   GET *INSQ* WORD OF QFT ENTRY 
          RJ     CAF         CHECK ACCESS LEVEL OF FILE 
          ZR     X1,PIQ3.3   IF FILE SELECTED 
          SX2    WIE
          EQ     PIQ5        IGNORE FILE
  
 PIQ3.3   SA3    TARA+AROP   GET OPTION 
          MX0    -12
          BX6    -X0*X3 
          SA6    PIQC        SAVE OPTION
          SX6    X6-PGIG     (X6) .EQ. 0 IF NOT REACTIVATE
          RJ     VIE
          PL     X1,PIQ4     IF NO FAMILY OPTION ERROR
          SX2    WIE         SET IGNORE OPTION
          JP     PIQ5        PROCESS IGNORE OPTION
  
 PIQ4     SA3    PIQC 
          LX3    1           MULTIPLY BY TWO
          IX1    X1+X3       INDEX INTO TABLE 
          SA2    X1+QDPT     PROCESSING ROUTINE 
 PIQ5     SA0    PIQ6        SET RETURN ADDRESS 
          SB3    X2+         PROCESSING ROUTINE 
          JP     B3          JUMP TO PROCESSING ROUTINE 
  
*         PROCESSING ROUTINES RETURN TO THIS POINT. 
  
 PIQ6     ZR     X1,PIQ2.1   IF PROCESS COMPLETED SATISFACTORILY
  
*         LAST ENTRY NOT PROCESSED - BUFFER FULL/QFT THRESHOLD LIMIT. 
  
          NG     X1,PIQ7     IF QFT THRESHOLD LIMIT REACHED 
  
*         SET RERUN THIS DEVICE.
  
          SX7    B1+
          SA7    PIQB 
  
 PIQ7     RJ     CIN         COPY REMAINING OLD IQFT TO NEW IQFT
  
*         REQUEUE FILES.
  
 PIQ8.1   SA1    IDMA        REACTIVATED COUNT
          ZR     X1,PIQ9     IF NO FILES TO REQUEUE 
          RJ     RFB         REQUEUE FILES
  
*         PURGE FILES.
  
 PIQ9     SA1    IDMD 
          ZR     X1,PIQ10    IF NO FILES PURGED 
          QCALL  RLLF,P      PURGE QUEUED FILES 
  
*         COMPLETE NEW IQFT FILE. 
  
 PIQ10    WRITER NIQ,R
          QCALL  STQF,NIQ    SET NEW IQFT IN MST
  
 PIQ11    REWIND P
          REWIND R
          SA5    PIQB 
          ZR     X5,PIQX     IF NO RERUN THIS DEVICE
  
          BX6    X6-X6       CLEAR RERUN FLAG 
          SA6    A5 
          JP     PIQ1 
  
 PIQA     DATA   C* QFT THRESHOLD LIMIT.           *
 PIQB     BSSZ   1           RERUN DEVICE FLAG
 PIQC     CON    0           OPTION 
  
*         QUEUE DISPOSITION PROCESSOR TABLE.
  
 QDPT     CON    REQ,PGQ     REQUEUE/PURGE
          CON    REQ,WIE     REQUEUE/IGNORE 
          CON    PGQ,WIE     PURGE/IGNORE 
          TITLE  LIST/PAGING PROCESSORS.
 LST      SPACE  4,15 
**        LST - LIST INACTIVE QUEUES. 
* 
*         *LST* PRODUCES A ONE RECORD OUTPUT FILE FOR EACH LIST 
*         COMMAND ENTERED.  THE OUTPUT RECORD IS READ BACK TO PRODUCE 
*         A RIGHT SCREEN K-DISPLAY.  THE OUTPUT FILE POSITION IS
*         MAINTAINED TO PROPERLY ALLOW FOR SCREEN PAGING. 
* 
*         EXIT   (X5) = TERMINATING MESSAGE.
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 2, 3, 6, 7. 
* 
*         CALLS  ATT, CLD, CME, DND, EMD, GKD, RAF, VIE, WOF. 
* 
*         MACROS BKSP, CLOCK, DATE, MESSAGE, READEI, READW, 
*                REPRIEVE, REWIND, SETFS, SKIPEI, WRITER. 
  
  
 LST      BSS    0
  
*         PRESET MULTIPLE EQUIPMENT INDEX.
  
          SX7    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          SX6    B1 
          SA7    CEQP 
          SA6    WPHA        PAGE COUNT 
          SA6    LSTB        LINE NUMBER
          SA6    PDFE+1      SET PRINT DENSITY FORMAT CONTROL FLAG
  
*         SET UP FILES. 
  
          REWIND O
          SKIPEI O
  
*         SET UP PAGE HEADER. 
  
 LST1     DATE   WPHC1       SET DATE IN HEADER 
          CLOCK  WPHC2       SET TIME IN HEADER 
          BX6    X6-X6       CLEAR LINE COUNT 
          SA6    WPHB 
          SA6    LSTA        CLEAR LIST FILE WRITTEN FLAG 
  
*         DETERMINE NEXT DEVICE TO PROCESS. 
  
 LST2     RJ     DND
          ZR     X4,LST6     IF END OF DEVICES
          BX7    X4 
          SA7    GRDD        *TEQA* TABLE ENTRY 
          LX7    59-0 
          NG     X7,LST3     IF QUEUES THIS DEVICE
          SA2    TARA+ARDN
          ZR     X2,LST2     IF NO SPECIFIC DEVICE
          SX5    =C* NO INACTIVE QUEUES ON DEVICE.   *
          JP     QRE5 
  
*         ATTACH IQFT FILE. 
  
 LST3     REPRIEVE  RPVB,SET,237B  SET REPRIEVE PROCESSING
          SA2    CEQP        EST ORDINAL
          SX3    IQ          ATTACH IQFT FILE 
          RJ     ATT
          NZ     X5,LST4.1   IF ERROR IN ATTACHING FILE 
          READEI X3,R        READ IQFT FILE 
  
*         PROCESSING LOOP.
  
 LST4     READW  IQ,IQFE,QFEWL
          RJ     CME         CHECK FOR MASS STORAGE ERROR 
          NZ     X5,LST5     IF MASS STORAGE ERROR
          NZ     X1,LST5     IF EOF/EOI 
  
*         VERIFY FILE AGAINST PARAMETERS. 
  
          SA3    IQFE+2      CHECK LOGICAL IDENTIFIER 
          SX4    B1+         SET CHECK FOR LID IN TABLE 
          RJ     CLD
          NZ     X3,LST4     IF NO MATCH
          SX6    B0+
          RJ     VIE
          NZ     X1,LST4     IF FILE DOES NOT MATCH 
  
*         WRITE OUTPUT FILE.
  
          SA3    WPHE        SET BLANK DISPOSITION CODE 
          SX5    WPHI        SET FWA OF PAGE HEADER 
          RJ     WOF         WRITE OUTPUT FILE
          SX7    B1+         SET LIST FILE WRITTEN FLAG 
          SA7    LSTA 
          JP     LST4 
  
*         PROCESS DEVICE COMPLETE.
  
 LST4.1   RJ     EMG         ISSUE ERROR MESSAGE
 LST5     SX3    IQ          RETURN FILE
          RJ     RAF
          REPRIEVE  RPVB,SET,0  CLEAR REPRIEVE PROCESSING 
          SA2    TARA+ARDN
          ZR     X2,LST2     IF NO SPECIFIC DEVICE
  
*         CLEAN UP OUTPUT FILE. 
  
 LST6     SA1    LSTA 
          NZ     X1,LST7     IF LIST WRITTEN
          SX5    =C* NO INACTIVE QUEUED FILES PRESENT.     *
          MESSAGE X5,3
          JP     QRE5 
  
 LST7     WRITER O
          SA3    TARA+ARFC
          PL     X3,LST8     IF NOT COMMAND CALL
          SETFS  O,0
          SX5    B0          NO MESSAGE FOR *QFSP*
          JP     QRE5 
  
*         SET UP K-DISPLAY. 
  
 LST8     BKSP   O
  
 LST9     READEI O,R
          BX6    X6-X6
          SA6    WPHB        RESET LINES/PAGE COUNT 
  
*         PRODUCE K- DISPLAY. 
  
          RJ     GKD         GENERATE K-DISPLAY 
          NZ     X5,QRECX    IF ERROR STATUS SET
          SX5    =C* LIST COMPLETE.                 * 
          JP     QRECX       RETURN 
  
 LSTA     CON    0           LIST FILE WRITTEN FLAG 
 LSTB     CON    0           LINE NUMBER
 PAG      SPACE  4,15 
**        PAG - PAGE RIGHT SCREEN K-DISPLAY.
* 
*         *PAG* ADVANCES THE RIGHT SCREEN K-DISPLAY.
* 
*         EXIT   (X5) = TERMINATING MESSAGE.
* 
*         USES   X - 2, 5, 6. 
*                A - 2, 6.
* 
*         CALLS  GKD. 
* 
*         MACROS BKSP, READEI.
  
  
 PAG      BSS    0
          SA2    LSTA 
          NZ     X2,PAG1     IF LAST RECORD PROPER FORMAT 
          SX5    =C* INCORRECT PAGING ATTEMPT.          * 
          JP     QRECX
  
*         REPOSITION OUTPUT FILE. 
  
 PAG1     SA2    GKDE 
          ZR     X2,PAG3     IF NOT END OF DISPLAY
  
          BKSP   O
  
 PAG2     READEI O,R
          BX6    X6-X6
          SA6    WPHB        PRESET LINES/PAGE COUNT
  
*         CREATE K-DISPLAY. 
  
 PAG3     RJ     GKD
          NZ     X5,QRECX    IF ERROR STATUS SET
          SX5    =C* PAGING COMPLETE.              *
          JP     QRECX       RETURN 
          TITLE  RELEASE PROCESSOR. 
 OUT      SPACE  4,15 
**        OUT - RELEASE OUTPUT FILE.
* 
*         *OUT* RELEASES THE OUTPUT FILE GENERATED BY THE *LIST*
*         COMMAND.
* 
*         EXIT   (X5) = APPROPRIATE COMPLETION MESSAGE. 
* 
*         USES   X - 2, 3, 5, 6, 7. 
*                A - 2, 3, 6, 7.
* 
*         CALLS  CBL. 
* 
*         MACROS ROUTE. 
  
  
 OUT      BSS    0           ENTRY
          SA2    LSTA        LIST FILE WRITTEN FLAG 
          SA3    GRDE        REQUEUE/DEQUEUE REPORT FLAG
          IX2    X3+X2
          ZR     X2,OUT1     IF NO FILE 
          BX6    X6-X6
          SA6    A2          CLEAR FLAGS
          SX7    -B1
          SA6    A3 
          SA7    A2+B1       LINE NUMBER
          RJ     CBL         CLEAR *DSP* PARAMETER BLOCK
          SA2    O           SET UP *DSP* PARAMETER BLOCK 
          MX6    42 
          BX6    X6*X2
          SA6    BLOCK
          SA2    OUTA        SET FLAG BITS
          BX6    X2 
          SA6    A6+B1
          ROUTE  BLOCK,RECALL 
          SX5    =C* OUTPUT FILE RELEASED.         *
          BX2    X2-X2
          JP     QRECX
  
 OUT1     SX5    =C* ERROR ON OUTPUT FILE.         *
          JP     QRECX       RETURN 
  
  
 OUTA     VFD    24/0,12/2HPR,6/0,18/FRDC 
          TITLE  UTILITY SUBROUTINES. 
 CME      SPACE  4,15 
**        CME - CHECK FOR MASS STORAGE ERROR. 
* 
*         ENTRY  (X1) = DATA TRANSFER STATUS. 
* 
*         EXIT   (X1) = UNCHANGED.
*                (X5) .NE. 0, IF MASS STORAGE ERROR.
* 
*         USES   X - 0, 1, 3, 5, 6. 
*                A - 1, 3, 6. 
* 
*         CALLS  EMG. 
* 
*         MACROS QCALL. 
  
  
 CME      SUBR               ENTRY/EXIT 
          SA3    IQ 
          MX0    -4 
          AX3    10 
          BX6    -X0*X3      ERROR STATUS BITS
          SX3    11B
          IX6    X3-X6
          BX5    X5-X5
          NZ     X6,CMEX     IF NOT MASS STORAGE ERROR
          BX6    X1          SAVE DATA TRANSFER STATUS
          SA6    CMEA 
          QCALL  PGQF,IQ     PURGE IQFT FILE
          SX5    RMSE*2000B 
          BX6    X6-X6       CLEAR FILE ATTACHED FLAG 
          SA6    ATTA 
          RJ     EMG
          MESSAGE  (=C* QUEUES UNRECOVERABLE THIS DEVICE.*) 
          SA1    CMEA        RESTORE DATA TRANSFER STATUS 
          EQ     CMEX        RETURN 
  
 CMEA     CON    0           DATA TRANSFER STATUS 
 CIN      SPACE  4,15 
**        CIN - COPY OLD IQFT TO NEW IQFT.
* 
*         *CIN* COPIES REMAINING ENTRIES ON THE OLD IQFT FILE TO THE
*         NEW IQFT FILE.
* 
*         ENTRY  (IDMC) = CURRENT COUNT OF INACTIVE QUEUES. 
* 
*         EXIT   (IDMC) = UPDATED COUNT OF INACTIVE QUEUES. 
* 
*         USES   X - 2, 3, 5, 7.
*                A - 2, 3, 7. 
* 
*         CALLS  CME, WOF.
* 
*         MACROS READW, WRITEW. 
  
  
 CIN      SUBR               ENTRY/EXIT 
          WRITEW NIQ,IQFE,QFEWL  LAST ENTRY NOT PROCESSED 
          EQ     CIN2        CHECK THRESHOLD LIMIT
  
*         COPY OLD IQFT FILE TO NEW IQFT. 
  
 CIN1     READW  IQ,IQFE,QFEWL
          RJ     CME
          NZ     X5,CINX     IF MASS STORAGE ERROR
          NZ     X1,CINX     IF EOF/EOI 
          WRITEW NIQ,IQFE,QFEWL 
  
*         DETERMINE IF PROCESSING THRESHOLD LIMIT.
  
 CIN2     SA3    NAQS 
          PL     X3,CIN1     IF NOT THRESHOLD LIMIT 
  
*         INCREMENT *IGNORED* COUNT.
  
          SA2    IDMC 
          SX7    X2+B1
          SA7    A2 
  
*         WRITE ENTRY TO OUTPUT FILE. 
  
          SA3    WIEA        *IGNORED*
          SX5    WPHG        SET FWA OF HEADER
          RJ     WOF
          EQ     CIN1        COPY NEXT ENTRY
 EMG      SPACE  4,20 
**        EMG - ERROR MESSAGE ISSUED. 
* 
*         *EMG* ISSUES AN APPROPRIATE ERROR MESSAGE.
* 
*         ENTRY  (X5) = ERROR STATUS BITS (10-13).
* 
*         EXIT   MESSAGE ISSUED.
*                (X1) = MESSAGE ADDRESS.
* 
*         USES   X - 0, 1, 2, 4, 5, 6.
*                A - 2, 5, 6. 
*                B - 2, 5.
* 
*         CALLS  COD, SFN.
* 
*         MACROS MESSAGE. 
  
  
 EMG      SUBR               ENTRY/EXIT 
          AX5    10          SET ERROR CODE 
          SB5    X5-1 
          MX0    -6 
          SA5    GRDD        FAMILY/DEVICE
          LX5    48 
          BX1    -X0*X5      CONVERT DEVICE NUMBER
          RJ     COD
          MX0    42 
          LX5    12 
          BX1    X0*X5       FAMILY 
          MX0    -12
          BX4    -X0*X6 
          SB2    B5-EMGAL 
          LE     B2,EMG1     IF LEGAL ERROR CODE
          SB5    EMGAL       UNDEFINED CODE 
 EMG1     SA5    EMGA+B5     SPACE FILL NAME
          RJ     SFN
          LX4    30 
          SA2    X5 
          LX0    30 
          SA6    X5+B1
          BX2    X0*X2       CLEAR OLD FAMILY 
          IX6    X2+X4
          SA6    A6-B1       DEVICE NUMBER
  
          MESSAGE X5
          BX1    X5 
          EQ     EMGX        RETURN 
  
  
*         TABLE OF ERROR MESSAGE ADDRESSES. 
  
 EMGA     BSS    0
          LOC    1
 FNFE     CON    EMGB        NO IQFT FILE 
 FAIE     CON    EMGC        IQFT INTERLOCKED 
 TASE     CON    0
 FTHE     CON    EMGD        FNT/QFT FULL 
 INSE     CON    0
 RMSE     CON    EMGE        MASS STORAGE ERROR 
 RRAE     CON    0
 NRAE     CON    0
 DUNE     CON    EMGI        IGNORED - UNAVAILABLE
 RDVE     CON    EMGF        IGNORED - REMOVABLE
          CON    0
 FTFE     CON    0
 EIDE     CON    EMGH        IGNORED - ERROR IDLE 
 DFNE     CON    0
 NSEE     CON    EMGAB       INCORRECT DEVICE ACCESS LEVEL
          LOC    *O 
 EMGAL    EQU    *-EMGA 
          CON    EMGZ        UNDEFINED ERROR
  
 EMGB     DATA   C* DNYY  FM AAAAAAA   NO IQFT FILE.* 
 EMGC     DATA   C* DNYY  FM AAAAAAA   IQFT INTERLOCKED.* 
 EMGD     DATA   C* DNYY  FM AAAAAAA   FNT/QFT FULL.* 
 EMGE     DATA   C* DNYY  FM AAAAAAA   MS ERROR.* 
 EMGF     DATA   C* DNYY  FM AAAAAAA   IGNORED - REMOVABLE.*
 EMGH     DATA   C* DNYY  FM AAAAAAA   IGNORED - ERROR IDLE.* 
 EMGI     DATA   C* DNYY  FM AAAAAAA   IGNORED - UNAVAILABLE.*
 EMGZ     DATA   C* DNYY  FM AAAAAAA   UNDEFINED ERROR.*
 EMGAB    DATA   C* DNYY  FM AAAAAAA   INCORRECT ACCESS LEVEL.* 
 ERR      SPACE  4,15 
**        ERR - ERROR EXIT PROCESSING.
* 
*         *ERR* RELEASES THE ATTACHED IQFT FILE AND ISSUES
*         APPROPRIATE MESSAGES INDICATING ABORT CONDITION.
* 
*         ENTRY  QREC ABORTED.
* 
*         USES   X - 3. 
* 
*         CALLS  RAF. 
* 
*         MACROS ABORT, MESSAGE.
  
  
 ERR      BSS    0
          SX3    IQ 
          RJ     RAF         RETURN ATTACHED FILE 
  
*         ISSUE MESSAGES. 
  
          MESSAGE (=C* QREC/QLIST ABORTED.*)
          MESSAGE (=C* QUEUE STATUS INDEFINITE.*) 
  
          ABORT 
 GKD      SPACE  4,15 
**        GKD - GENERATE K - DISPLAY. 
* 
*         *GKD* PRODUCES THE K-DISPLAY IN A SCRATCH BUFFER AND
*         RETURNS THE ADDRESS OF THE DISPLAY. 
* 
*         ENTRY  OUTPUT FILE APPROPRIATELY POSITIONED.
* 
*         EXIT   (X2) = DISPLAY ADDRESS.
*                (X5) = ERROR MESSAGE ADDRESS, IF APPLICABLE. 
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
* 
*         MACROS MOVE, READW, RECALL. 
  
  
 GKD      SUBR               ENTRY/EXIT 
          SA2    LSTA 
          NZ     X2,GKD1     IF FILE PRESENT
          SX5    =C* NO OUTPUT FILE PRESENT.        * 
          EQ     GKDX        RETURN 
  
 GKD1     RECALL O
  
*         SETUP DISPLAY HEADING.
  
          MOVE   WPHDL,WPHD,DBUF+1
          MOVE   WPHEL,WPHE,DBUF+1+WPHDL
          MOVE   WPHFL,WPHF,DBUF+1+WPHDL+WPHEL
  
          SX6    KMLL-8      NUMBER OF DISPLAY LINES PER PAGE 
          SA6    GKDA 
          SA3    WPHB 
          SX6    DBUF+WPHDL+WPHEL+WPHFL 
          SA6    A6+1        NEXT LINE ADDRESS
          NZ     X3,GKD4     IF NOT AT PAGE HEADING 
  
*         BYPASS PAGE HEADING.
  
 GKD2     READW  O,WPHC-1,WPHCL 
          NZ     X1,GKD6     IF EOF/EOI 
          SA1    LLIM        GET LINE LIMIT 
          SX7    X1-7 
          SA7    WPHB        LINES/PAGE COUNT 
  
*         PROCESS INDIVIDUAL LINES. 
  
 GKD4     READW  O,FQOA,FQOAL 
          NZ     X1,GKD6     IF EOF/EOI 
          BX6    X6-X6       SET END OF LINE
          SA6    FQOA+8 
          SA4    GKDB        INCREMENT NEXT LINE ADDRESS
          SX7    X4+FQOAL-2 
          SA7    A4+
          MOVE   FQOAL-2,FQOA+2,X4
  
*         DECREMENT PAGE COUNTS.
  
          SA5    WPHB 
          SA3    GKDA 
          SX7    X5-1 
          SX6    X3-1 
          SA7    A5 
          SA6    A3 
          NZ     X6,GKD5     IF NOT END OF DISPLAY PAGE 
          SA4    GKDB 
          MOVE   GKDCL,GKDC,X4  *MORE*
          BX6    X6-X6
          SA6    GKDE        CLEAR END OF DISPLAY INDICATOR 
          EQ     GKD7        SET EXIT CONDITIONS
  
 GKD5     NZ     X7,GKD4     IF NOT END OF OUTPUT PAGE
          EQ     GKD2        PROCESS NEXT LINE
  
*         END OF DISPLAY. 
  
 GKD6     SA4    GKDB 
          MOVE   GKDDL,GKDD,X4  *END OF DISPLAY.* 
          SX6    B1+
          SA6    GKDE        SET END OF DISPLAY INDICATOR 
  
*         SET EXIT CONDITIONS.
  
 GKD7     SA3    GKDF        ENSURE BLANK FILL ON *K-DISPLAY* 
          BX6    X3 
          BX5    X5-X5       CLEAR ERROR FLAG 
          SA6    FQOA 
          SX2    DBUF        SET DISPLAY ADDRESS
          EQ     GKDX        RETURN 
  
  
 GKDA     BSS    1           DISPLAY LINE COUNT 
 GKDB     BSS    1           NEXT LINE ADDRESS
  
 GKDC     DATA   C*  *
          DATA   C* MORE *
          CON    0           TERMINATE DISPLAY
 GKDCL    EQU    *-GKDC 
  
 GKDD     DATA   C*  *
          DATA   C* END OF DISPLAY.*
          CON    0           TERMINATE DISPLAY
 GKDDL    EQU    *-GKDD 
  
 GKDE     BSSZ   1           END OF DISPLAY FLAG
 GKDF     DATA   H* *        BLANK FILL FOR *K-DISPLAY* 
 IDM      SPACE  4,20 
**        IDM - ISSUE DAYFILE MESSAGES. 
* 
*         *IDM* FORMATS AND ISSUES MESSAGES APPLICABLE TO THE 
*         COMPLETED QUEUE OPERATION.
* 
*         ENTRY  (IDMA) = QUEUED FILES REACTIVATED COUNT. 
*                (IDMB) = QUEUED FILES DEQUEUED COUNT.
*                (IDMC) = QUEUED FILES IGNORED COUNT. 
*                (IDMD) = QUEUED FILES PURGED COUNT.
* 
*         EXIT   MESSAGES ISSUED. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 6, 7.
* 
*         CALLS  CDD, COD, SFN. 
* 
*         MACROS MESSAGE. 
  
  
 IDM      SUBR               ENTRY/EXIT 
  
*         ISSUE FILE COUNT MESSAGES.
  
          SB7    B0+
          SB6    TFCRL
 IDM1     SA1    B7+TFCR
          ZR     X1,IDM2     IF NO FILE COUNT 
          BX6    X6-X6
          SA6    A1          CLEAR FILE COUNT 
          RJ     CDD         CONVERT FILE COUNT 
          SA2    B7+TFCM
          LX6    30 
          SA5    X2 
          MX0    -30
          BX6    X0*X6
          SA4    GRDD 
          BX5    -X0*X5 
          MX0    42 
          IX6    X6+X5
          BX1    X0*X4       FAMILY NAME
          SA6    A5 
          RJ     SFN         SPACE FILL FAMILY NAME 
          MX0    48 
          SA2    A5+3 
          LX4    48 
          LX6    54 
          BX2    -X0*X2      CLEAR PREVIOUS FAMILY
          BX6    X0*X6
          MX0    -6 
          IX6    X6+X2       APPEND *.* 
          BX1    -X0*X4 
          SA6    A2+
          RJ     COD         CONVERT DEVICE NUMBER
          MX0    -12
          SA3    A6-B1
          BX6    -X0*X6      CLEAR SPACES 
          LX0    24 
          BX3    X0*X3       CLEAR OLD DEVICE NUMBER
          LX6    24 
          IX7    X6+X3
          SA7    A3 
  
          MESSAGE A5         ISSUE MESSAGE
  
 IDM2     SB7    B7+1 
          NE     B7,B6,IDM1  IF MESSAGES NOT COMPLETE 
          EQ     IDMX        RETURN 
  
 TFCR     BSS    0           FILE COUNT RESULT TABLE
 IDMA     BSS    1           REACTIVATED
 IDMB     BSS    1           INACTIVATED
 IDMC     BSS    1           LEFT INACTIVE
 IDMD     BSS    1           PURGED 
 TFCRL    EQU    *-TFCR 
  
 TFCM     BSS    0           FILE COUNT MESSAGE TABLE 
          CON    MSG1 
          CON    MSG2 
          CON    MSG3 
          CON    MSG4 
 TFCML    EQU    *-TFCM 
  
  
 MSG1     DATA   C* XXXX FILES ACTIVATED DNYY  FM AAAAAAA.* 
 MSG2     DATA   C* XXXX FILES DEQUEUED  DNYY  FM AAAAAAA.* 
 MSG3     DATA   C* XXXX FILES IGNORED   DNYY  FM AAAAAAA.* 
 MSG4     DATA   C* XXXX FILES PURGED    DNYY  FM AAAAAAA.* 
 PGQ      SPACE  4,20 
**        PGQ - PURGE QUEUED FILE.
* 
*         *PGQ* ENTERS THE IQFT ENTRY INTO THE LIST OF FILES TO BE
*         PURGED. 
* 
*         ENTRY  (IQFE - IQFE+15) = IQFT ENTRY. 
*                (IDMD) = CURRENT PURGED FILE COUNT.
*                (A0) = RETURN ADDRESS. 
* 
*         EXIT   (X1) .EQ. 0, IF ENTRY MADE.
*                (X1) .NE. 0, IF BUFFER FULL. 
*                (IDMD) INCREMENTED.
* 
*         USES   X - 1, 3, 5, 6.
*                A - 1, 3, 6. 
*                B - 6. 
* 
*         CALLS  EQB, WOF.
  
  
 PGQ      BSS    0
          SA1    P           SET FET ADDRESS
          RJ     EQB         ENTER IQFT ENTRY INTO BUFFER 
          NZ     X1,PGQ1     IF BUFFER FULL 
          SA3    IDMD        INCREMENT PURGED COUNT 
          SX6    X3+B1
          SA6    A3 
          SA3    PGQA        *PURGED* 
          SX5    WPHG        SET FWA OF HEADER
          RJ     WOF
          BX1    X1-X1
 PGQ1     SB6    A0          SET RETURN ADDRESS 
          JP     B6          RETURN 
  
 PGQA     DATA   H*PURGED*
 EQB      SPACE  4,15 
**        EQB - ENTER IQFT ENTRY INTO BUFFER. 
* 
*         ENTRY  (IQFE - IQFE+15) = IQFT ENTRY. 
*                (CEQP) = EST ORDINAL.
*                (A1) = ADDRESS OF FET. 
* 
*         EXIT   (X1) .EQ. 0, IF ENTRY MADE.
*                (X1) .GT. 0, IF BUFFER FULL. 
* 
*         USES   X - 0, 1, 2, 5, 6. 
*                A - 1, 2, 5, 6.
*                B - 3. 
* 
*         MACROS MOVE.
  
  
 EQB1     SX1    B1          SET ERROR CONDITION
  
 EQB      SUBR               ENTRY/EXIT 
          SA5    A1+2 
          SA2    A5+2 
          SX6    X5+QFEWL    ADVANCE IN 
          SX2    X2          LIMIT
          IX2    X2-X6
          SB3    X2 
          LE     B3,EQB1     IF BUFFER FULL 
          MX0    12          UPDATE EQUIPMENT FIELD IN IQFT 
          SA6    A5+         UPDATE IN
          SA1    IQFE+1 
          SA2    CEQP 
          BX1    -X0*X1      CLEAR OLD EST ORDINAL
          LX2    48 
          BX6    X1+X2
          SA6    A1 
          MOVE   QFEWL,IQFE,X5
          BX1    X1-X1
          EQ     EQBX        RETURN 
 REQ      SPACE  4,25 
**        REQ - REQUEUE FILE. 
* 
*         *REQ* ENTERS THE IQFT ENTRY INTO THE BUFFER FOR 
*         REQUEUING.
* 
*         ENTRY  (A0) = RETURN ADDRESS. 
*                (IQFE - IQFE+15) = IQFT ENTRY. 
*                (IDMA) = CURRENT REQUEUED COUNT. 
*                (NAQS) = AVAILABLE QFT SLOTS.
* 
*         EXIT   (X1) .EQ. 0, IF ENTRY MADE.
*                (X1) .LT. 0, IF THRESHOLD LIMIT REACHED. 
*                (X1) .GT. 0, IF BUFFER FULL. 
*                (IDMA) INCREMENTED.
*                (NAQS) DECREMENTED.
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 6, 7. 
*                B - 6. 
* 
*         CALLS  EQB, WOF.
* 
*         MACROS MESSAGE. 
  
  
 REQ      BSS    0
  
*         DECREMENT THRESHOLD COUNT.
  
          SA3    NAQS        NUMBER OF AVAILABLE QFT SLOTS
          SX7    X3-1 
          SA7    A3+
          PL     X7,REQ1     IF THRESHOLD NOT REACHED 
          MESSAGE PIQA       * QFT THRESHOLD LIMIT.*
          MX1    1           SET THRESHOLD LIMIT REACHED
          JP     REQ2        SET RETURN ADDRESS 
  
 REQ1     SA1    R           SET FET ADDRESS
          RJ     EQB         ENTER IQFT ENTRY INTO BUFFER 
          NZ     X1,REQ2     IF BUFFER FULL 
          SA2    IDMA        INCREMENT REACTIVATED COUNT
          SX6    X2+B1
          SA6    A2 
  
*         WRITE OUTPUT LINE.
  
          SA3    REQA        *ACTIVATED*
          SX5    WPHB        SET FWA OF PAGE HEADER 
          RJ     WOF
          BX1    X1-X1
 REQ2     SB6    A0          SET RETURN ADDRESS 
          JP     B6 
  
 REQA     DATA   H*ACTIVATED* 
 RFB      SPACE  4,15 
**        RFB - REQUEUE FILES IN BUFFER.
* 
*         *RFB* ISSUES THE APPROPRIATE REQUEST TO REQUEUE THOSE 
*         FILES THAT ARE IN THE BUFFER (RBUF).
* 
*         EXIT   (X5) = 0, IF REQUEUED SUCCESSFULLY.
*                FILES NOT REQUEUED ARE REPLACED IN *NBUF*. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 3, 5, 6, 7.
*                B - 2, 3, 4. 
* 
*         CALLS  EMG. 
* 
*         MACROS MOVE, QCALL, REWIND, WRITEW. 
  
  
 RFB2     SA3    R+6
          ZR     X3,RFB3     IF NO FILES IGNORED
          SA2    IDMA        DECREMENT NUMBER OF FILES ACTIVATED
          IX6    X2-X3
          SA6    A2 
          SA1    IDMC        INCREMENT NUMBER OF FILES IGNORED
          IX7    X1+X3
          SA7    A1 
 RFB3     REWIND R,R         REWIND POINTERS
  
 RFB      SUBR               ENTRY/EXIT 
          SA5    R
          SX0    36000B 
          BX6    -X0*X5      CLEAR ERRORS AND STATUS
          SA6    A5+
          BX7    X7-X7       CLEAR FILE IGNORE COUNT IN FET 
          SA7    R+6
          QCALL  RQLF,R      REQUEUE LIST 
  
          SA5    A5 
          BX5    X0*X5
          ZR     X5,RFB2     IF NO ERRORS 
          RJ     EMG         ISSUE ERROR MESSAGES 
  
*         BACK OUT UNREACTIVATED QUEUES.
  
          SA2    R+3         OUT POINTER
          SX6    X2          FIRST ENTRY NOT REQUEUED (SET BY *QFM*)
          SA3    A2-B1       IN 
          SA6    RFBA 
          BX7    X3 
          SA7    A6+B1
 RFB1     IX1    X6-X3
          PL     X1,RFB2     IF END OF BUFFER 
          MOVE   QFEWL,X6,IQFE
          WRITEW NIQ,IQFE,QFEWL 
  
*         ADJUST FILE COUNTS. 
  
          SA2    IDMA        DECREMENT REQUEUE FILE COUNT 
          SX7    X2-1 
          SA3    IDMC 
          SA7    A2 
          SX6    X3+B1       INCREMENT LEFT INACTIVE COUNT
          SA6    A3+
  
*         SEARCH FOR NEXT ENTRY NOT PROCESSED BY *QFM*. 
  
          SA1    RFBA 
          SX6    X1+QFEWL 
          SA3    A1+B1
          SA6    A1 
          EQ     RFB1        LOOP TO END OF BUFFER
  
  
 RFBA     BSS    1           CURRENT ENTRY IN REQUEUE BUFFER
          BSS    1           LWA RECOVERY BUFFER
 WIE      SPACE  4,20 
**        WIE - WRITE INACTIVE ENTRY TO NEW IQFT. 
* 
*         *WIE* WRITES THE IQFT ENTRY TO THE NEW IQFT FILE. 
* 
*         ENTRY  (IQFE - IQFE+15) = IQFT ENTRY. 
*                (IDMC) = IGNORED COUNT.
*                (A0) = RETURN ADDRESS. 
* 
*         EXIT   ENTRY WRITTEN TO *NIQ*.
*                (IDMC) INCREMENTED.
* 
*         USES   X - 1, 3, 5, 6.
*                A - 3, 6.
*                B - 6. 
* 
*         CALLS  WOF. 
* 
*         MACROS WRITEW.
  
  
 WIE      BSS    0
          SA3    IDMC        INCREMENT LEFT INACTIVE COUNT
          SX6    X3+B1
          SA6    A3 
  
          WRITEW NIQ,IQFE,QFEWL 
          SA3    WIEA        *IGNORED*
          SX5    WPHG        SET FWA OF PAGE HEADER 
          RJ     WOF
          SB6    A0          RESTORE RETURN ADDRESS 
          BX1    X1-X1
          JP     B6          RETURN 
  
 WIEA     DATA   H*IGNORED* 
 WPH      SPACE  4,20 
**        WPH - WRITE PAGE HEADER.
* 
*         *WPH* WRITES A NEW PAGE HEADER ON FILE *OUTPUT*.
* 
*         ENTRY  (X5) = ADDRESS OF PAGE HEADER. 
*                (WPHC1) = DATE.
*                (WPHC2) = TIME.
*                (PDFE+1) = SET IF PRINT DENSITY FORMAT EFFECTOR
*                           NOT YET WRITTEN.
* 
*         EXIT   PAGE HEADER WRITTEN. 
*                LINE COUNT RESET.
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 1, 6, 7. 
* 
*         CALLS  CDD. 
* 
*         MACROS RECALL, WRITEW.
  
  
 WPH      SUBR               ENTRY/EXIT 
          SA1    WPHA        INCREMENT PAGE NUMBER
          SX7    X1+B1
          SA7    A1 
          RJ     CDD
          MX0    36          SET PAGE NUMBER IN HEADER
          SA1    WPHC3
          BX1    X0*X1
          BX6    -X0*X6 
          BX6    X1+X6
          SA6    WPHC3
          RECALL O
          SA1    PDFE+1      GET PRINT DENSITY FORMAT CONTROL FLAG
          BX7    X7-X7
          SA7    A1 
          WRITEW O,A1-B1,X1  CONDITIONALLY WRITE FORMAT EFFECTOR
          WRITEW O,WPHH,WPHHL 
          SX2    WPHI 
          IX2    X5-X2
          NZ     X2,WPH1     IF REQUEUE REPORT
          WRITEW O,WPHI,WPHIL HEADER FOR *LIST* 
          EQ     WPH2        SKIP REQUEUE/DEQUEUE HEADER
  
 WPH1     WRITEW O,WPHG,WPHGL HEADER FOR REQUEUE/DEQUEUE
 WPH2     SA1    LLIM 
          SX7    X1-7        INITIALIZE LINE COUNT
          SA7    WPHB 
          EQ     WPHX        RETURN 
  
  
 WPHA     BSS    1           PAGE COUNT 
 WPHB     BSS    1           LINE/PAGE COUNT
  
 WPHH     BSS    0
 WPHC     DATA   C*1         QREC/QLIST PROCESSOR.          YY/MM/DD. HH
,.MM.SS.  PAGE      * 
 WPHC1    EQU    *-4         DATE 
 WPHC2    EQU    *-3         TIME 
 WPHC3    EQU    *-2         PAGE 
 WPHHL    EQU    *-WPHH 
  
 WPHI     DATA   H*0*        CARRIAGE CONTROL 
  
 WPHD     DATA   C*  *
          DATA   C*                       INACTIVE QUEUES LIST* 
          DATA   C*  *
 WPHDL    EQU    *-WPHD 
  
          DATA   H*  *       CARRIAGE CONTROL 
  
 WPHE     DATA   C*                                              LENGTH 
,ACCESS*
 WPHEL    EQU    *-WPHE 
  
          DATA   H*  *       CARRIAGE CONTROL 
 WPHF     DATA   C*   NUM  JSNS MID FAMILY  DN DT DS   DATE      (PRUS) 
,LEVEL  DISPOSITION*
          DATA   C*  *
 WPHCL    EQU    *-WPHC 
 WPHIL    EQU    *-WPHI 
          CON    0           TERMINATE DISPLAY
 WPHFL    EQU    *-WPHF 
  
 WPHG     DATA   H*0* 
          DATA   H*                              QUEUE DISPOSITION* 
          DATA   C*  *
          DATA   H*  *       CARRIAGE CONTROL 
  
          DATA   C*                                              LENGTH 
,ACCESS*
          DATA   H*  *       CARRIAGE RETURN
          DATA   C*   NUM  JSNS MID FAMILY  DN DT DS   DATE      (PRUS) 
,LEVEL  DISPOSITION*
          DATA   C*  *
 WPHGL    EQU    *-WPHG 
 WOF      SPACE  4,15 
**        WOF - WRITE OUTPUT FILE.
* 
*         *WOF* WRITES AN ENTRY TO THE OUTPUT 
*         REPORT FOR THE REQUEUE AND DEQUEUE ROUTINES.
* 
*         ENTRY  (X3) = DISPOSITION DESCRIPTOR. 
*                (X5) = FWA OF PAGE HEADER. 
* 
*         USES   X - 1, 2, 3, 6.
*                A - 1, 3, 6. 
*                B - 7. 
* 
*         CALLS  FQO, WPH.
* 
*         MACROS WRITEW.
  
  
 WOF      SUBR               ENTRY/EXIT 
          SA1    WPHB 
          NZ     X1,WOF1     IF NOT END OF PAGE 
          BX6    X3          SAVE DISPOSITION DESCRIPTOR
          SA6    WOFA 
          RJ     WPH         WRITE PAGE HEADER
          SA3    WOFA 
 WOF1     SB7    GRDD        ADDRESS OF FAMILY/DEVICE 
          SA1    LSTB        INCREMENT LINE NUMBER
          SX6    X1+B1
          SA6    A1 
          SX5    IQFE        SET IQFT ENTRY ADDRESS 
          RJ     FQO         FORMAT OUTPUT LINE 
          WRITEW O,B3,B2
          SA3    WPHB        DECREMENT LINE/PAGE COUNT
          SX6    X3-1 
          SA6    A3 
          EQ     WOFX        RETURN 
  
 WOFA     CON    0           SCRATCH
          TITLE  COMMON DECKS.
*         COMMON DECKS. 
  
*CALL     COMCCDD 
*CALL     COMCCIO 
*CALL     COMCCOD 
*CALL     COMCCPM 
*CALL     COMCEDT 
*CALL     COMCFQO 
*CALL     COMCIQP 
*CALL     COMCLFM 
*CALL     COMCMVE 
*CALL     COMCQFM 
*CALL     COMCQFP 
*CALL     COMCRDW 
*CALL     COMCSCB 
*CALL     COMCSFM 
*CALL     COMCSFN 
*CALL     COMCSYS 
*CALL     COMCVLC 
*CALL     COMCVQF 
*CALL     COMCZTB 
*CALL     COMCWTW 
          TITLE  BUFFERS. 
  
          USE    LITERALS 
  
*         BUFFERS.
  
 BLOCK    BSS    EPBL        *DSP* PARAMETER BLOCK
  
 DBUF     VFD    11/0,1/1,1/1,5/0,18/KTIA,24/0  K-DISPLAY BUFFER
 NBUF     EQU    DBUF+BUFL   NEW IQFT BUFFER
 TACF     EQU    NBUF+BUFL   TABLE OF ACTIVE FAMILIES 
 OBUF     EQU    TACF+ESMX+1 OUTPUT BUFFER
 IBUF     EQU    OBUF+BUFL   IQFT FILE BUFFER 
  
*         QFT READ INTO FIELD LENGTH STARTING AT *RBUF*.
  
 RBUF     EQU    IBUF+BUFL   RECOVERED FILES BUFFER 
 PBUF     EQU    RBUF+BUFL   PURGED FILES BUFFER
  
 BUFLL    EQU    PBUF+BUFL-DBUF  LENGTH OF BUFFERS
 BUFFL    EQU    *+BUFLL     END OF BUFFERS 
          TITLE  PRESET.
 PRS      SPACE  4,20 
**        PRS - PRESET. 
* 
*         PRESET ADJUSTS FIELD LENGTH, PERFORMS THRESHOLD 
*         CALCULATION FOR A GIVEN SIZE QFT, AND SETS UP A 
*         CONTROL WORD TO READ THE QFT. 
* 
*         ENTRY  (QFTA) = *QFTP* WORD IN CMR. 
* 
*         EXIT   (QFTS) = LENGTH OF QFT.
*                (QFTT) = QFT THRESHOLD.
*                (RQTA) = *RSB* CONTROL WORD FOR QFT READ.
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 2, 6, 7. 
* 
*         MACROS MEMORY.
  
  
 PRS      SUBR               ENTRY/EXIT 
          MEMORY CM,,R,BUFFL
  
*         SET QFT FWA AND LENGTH. 
  
          SA2    QFTA        *QFTP* WORD
          MX0    -24         GET FWA OF QFT 
          LX2    24 
          BX7    -X0*X2 
          LX2    12          GET MAXIMUM NUMBER OF QFT ENTRIES
          MX0    -12
          BX2    -X0*X2 
          SX3    QFTE 
          IX6    X2*X3       NUMBER OF ENTRIES * ENTRY LENGTH 
          SA6    QFTS        QFT LENGTH 
  
*         SET UP *RSB* CONTROL WORD TO READ QFT.
  
          SX4    100B        WORD COUNT 
          LX4    18 
          BX7    X4+X7       ADD ON QFT FWA 
          SX1    RBUF        BUFFER ADDRESS 
          LX7    18 
          BX7    X7+X1
          SA7    RQTA 
  
*         CALCULATE NUMBER OF RESERVED QFT ENTRIES. 
  
          SX3    SQTL        STATIC QFT THRESHOLD LIMIT 
          SX7    100
          IX3    X7-X3
          IX3    X2*X3       NUMBER OF QFT ENTRIES * 100-*SQTL* 
          IX6    X3/X7
          BX7    X7-X7       CLEAR LID TABLE FULL FLAG
          SA7    LTFL 
          SA6    QFTT 
          EQ     PRSX        RETURN 
          SPACE  4,10 
          ERRPL  *-RFL       IF DEFAULT FIELD LENGTH TOO SMALL
  
  
          END    QREC 
