QDUMP 
          IDENT  QDUMP1,OVLA,QDUMP,01,00
          ABS 
          SST 
          SYSCOM B1 
*COMMENT  QDUMP - QUEUE DUMP PROCESSOR. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  QDUMP - QUEUE DUMP PROCESSOR.
          SPACE  4
***       QDUMP - QUEUE DUMP PROCESSOR. 
*         A. J. BEEKMAN.     76/03/11.
          SPACE  4
***       *QDUMP* IS A UTILITY PROGRAM THAT DUMPS SELECTED QUEUE
*         FILES FROM A SINGLE DEVICE, A FAMILY, OR ALL DEVICES TO 
*         A SPECIFIED DUMP FILE, EITHER MAGNETIC TAPE OR MASS 
*         STORAGE, AND PROVIDES A LIST OF ALL FILES DUMPED WITH 
*         INFORMATION RELATIVE TO EACH. 
          SPACE  4
***       *QDUMP* MAY BE CALLED FROM THE CONSOLE BY THE QUEUED FILE 
*         SUPERVISOR PROGRAM (X.QFSP.) OR BY COMMAND.  AFTER
*         DUMPING QUEUED FILES, THE FILES THAT HAVE BEEN DUMPED MAY 
*         BE PURGED USING THE QUEUE UTILITY *QREC* WITH THE SAME *K*
*         DISPLAY SELECTION PARAMETER VALUES.  TO PURGE INACTIVE FILES, 
*         USE THE *PI* (PURGE AND IGNORE) OPTION.  TO PURGE ACTIVE
*         FILES, USE THE *DI* (DEACTIVATE AND IGNORE) OPTION, FOLLOWED
*         BY THE *PI* OPTION.  THE COMMAND FORMAT FOR 
*         *QDUMP* IS -
* 
*         QDUMP(P1=A1,P2=A2,...,PN=AN)
* 
*         WHERE P1 - PN ARE ANY OF THE FOLLOWING VALID PARAMETERS - 
* 
*         MI = MACHINE ID.
* 
*         FM = FAMILY NAME TO DUMP FROM.
* 
*         DN = DEVICE NUMBER (FAMILY MUST BE SPECIFIED FIRST).
* 
*                THE FM AND DN PARAMETERS ARE USED TO DESCRIBE THE
*                FAMILY AND DEVICE OR SET OF FAMILIES OR DEVICES FROM 
*                WHICH THE QUEUED FILES SHOULD BE DUMPED.  FM MAY BE
*                *ALL*, IN WHICH CASE DN MUST ALSO BE *ALL*.
* 
*         FU = FAMILY NAME FOR USER INDEX.
* 
*         UI = USER INDEX RANGE (0 - 377777B).
* 
*                THE FU AND UI PARAMETERS DESCRIBE THE FAMILY AND USER
*                INDICIES OF THE QUEUED FILES WHICH ARE TO BE DUMPED. 
* 
*         DA = DUMP DATE RANGE.  FORM IS YYMMDD WHERE YY IS THE 
*              YEAR, MM THE MONTH, AND DD THE DAY.  IT CAN ALSO BE
*              SPECIFIED AS ALL (DA=ALL) WHICH WILL SELECT ALL DATES. 
* 
*         FS = FILE SIZE RANGE IN PRUS (0-777777B). 
*              IF 777777B IS SPECIFIED, ALL SIZES LARGER ARE INCLUDED.
* 
*         JSN = JOB SEQUENCE NUMBERS OF FILES TO DUMP.  UP TO 5 
*               ALLOWED.  IF PREVIOUSLY ENTERED, THE JSN WILL BE
*               CLEARED.
* 
*         ID = ID RANGE OF BATCH AND SYSTEM ORIGIN FILES TO DUMP
*              (0 - 77B). 
* 
*         LA = LOWER SECURITY ACCESS LEVEL (1-7 CHARACTERS).
* 
*         UA = UPPER SECURITY ACCESS LEVEL (1-7 CHARACTERS).
* 
*         TUI= DESTINATION TUI OF REMOTE BATCH ORIGIN FILES TO DUMP.
*              TUI=0 IMPLIES DUMP ALL REMOTE BATCH FILES. 
* 
*         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 **). 
* 
*         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. 
* 
*         L  = FILE NAME TO RECEIVE OUTPUT. 
* 
*         FN = FILE NAME OF DUMP FILE.
* 
*         NF = NUMBER OF MEDIA FILES TO SKIP. 
* 
*         TP = TYPE OF FILES TO DUMP.  (A - ACTIVE, I - INACTIVE, 
*              ALL).
* 
*         DS = DT.  SELECT FILE DESTINATION BY DISPOSITION TYPE.
*              MAY BE ENTERED MORE THAN ONCE.  OPTION WILL BE CLEARED 
*              IF PREVIOUSLY SELECTED.
*                DS MAY BE -
*                     BC - BATCH. 
*                     RB - REMOTE BATCH.
*                DT MAY BE -
*                     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.
* 
*         PO = PROCESSING OPTIONS WHERE OPTIONS ARE DEFINED AS
*              THE FOLLOWING -
*                N - IF SPECIFIED, ONLY COMMAND DIRECTIVES
*                    WILL BE PROCESSED.  K-DISPLAY IS AVAILABLE 
*                    FOR MONITORING THE UTILITY PROGRESS, BUT NO
*                    K-DISPLAY INPUT IS ALLOWED.  THE N PARAMETER 
*                    IS IMPLIED ON ALL NON-SYSTEM ORIGIN JOBS.
*                E - IF SPECIFIED, ERRORED FILE PROCESSING STATUS 
*                    WILL BE TOGGLED. 
*                F - IF SPECIFIED, ON ACTIVATE REQUESTS ENTRIES WILL
*                    BE MADE IN THE FOT FOR THE INACTIVE FAMILIES 
*                    AND THE FILES WILL BE QUEUED.  DEFAULT IS TO 
*                    IGNORE THOSE FILES.
*                R - IF SPECIFIED, THE DUMP FILE WILL BE
*                    REWOUND WHEN THE *GO* COMMAND IS ENTERED.
* 
*         DEFAULT VALUES DEFINED IN *QFSP*. 
* 
* 
*         *K* DISPLAY COMMANDS AVAILABLE TO *QDUMP* ARE - 
* 
*         GO. - PROCEED WITH PROCESSING.
*         STOP. - TERMINATE INPUT, END RUN. 
*         RESET. - RESET PARAMETERS TO DEFAULT VALUES.
*         OUT. - RELEASE FILE SPECIFIED BY L PARAMETER TO PRINTER.
*         REWIND. - REWIND DUMP FILE WHEN *GO* COMMAND ENTERED. 
*         ERROR. - TOGGLE STATUS OF ERRORED FILE PROCESSING.  IF
*                  SET, ERRORED FILES WILL BE DUMPED.  DEFAULT IS SET.
*         FAMILY. - IF SPECIFIED, ON ACTIVATE REQUESTS ENTRIES
*                   WILL BE MADE IN THE FOT FOR THE INACTIVE FAMILIES 
*                   AND THE FILES WILL BE QUEUED.  DEFAULT IS TO
*                   IGNORE THOSE FILES. 
          SPACE  4
**        ENTRY CONDITIONS. 
* 
*         *QDUMP* IS ENTERED VIA RETURN JUMP FROM *QFSP*. 
* 
*         *TARA* = FWA OF THE PARAMETER TABLE.
*         *TDAA* = FWA OF DEVICE ACCESS LEVEL TABLE.
*         *TEQA* = FWA OF THE MASS STORAGE EQUIPMENT TABLE. 
*         *QFTA* = *QFTP* WORD FROM CENTRAL MEMORY RESIDENT.
*         *FOTA* = FAMILY ORDINAL TABLE.
          SPACE  4
***       DAYFILE MESSAGES. 
* 
*         THE FOLLOWING MESSAGES ARE ISSUED TO THE DAYFILE AND
*         THE *K* DISPLAY UNLESS NOTED OTHERWISE. 
* 
* 
*         * ACCESS LEVEL LIMITS OUT OF RANGE.*  AS NO ACCESS LEVELS 
*         WERE SELECTED WITH THE *LA* AND *UA* PARAMETERS, THE SYSTEM 
*         LIMITS WERE USED.  MASS STORAGE DEVICES WERE FOUND WHICH
*         HAVE ACCESS LEVELS OUTSIDE THE SYSTEM LIMITS. 
*         USE THE *LA* AND *UA* PARAMETERS TO IGNORE THESE DEVICES
*         AND RETRY.
* 
*         * BAD DUMP FILE.* = THE SPECIFIED DUMP FILE CANNOT BE 
*         WRITTEN TO.  REQUEST ANOTHER DUMP FILE. 
* 
*         * ERRORED FILE PARTIALLY DUMPED - FILENAM.* = AFTER 
*         ENCOUNTERING AN UNRECOVERABLE READ ERROR ON FILE FILENAM WITH 
*         ERRORED FILE DUMPING NOT SET, THE BACKSPACE ON THE DUMP FILE
*         HIT BEGINNING OF TAPE REEL, LEAVING FILE FILENAM PARTIALLY
*         DUMPED ON THE PREVIOUS REEL.  THIS FILE WILL NOT BE LOADED
*         IF ERRORED FILE LOADING IS NOT SET. 
* 
*         * FILE NAME CONFLICT - FILE XXXXXXX.* = THE SPECIFIED 
*         OUTPUT OR DUMP FILE NAME CONFLICTS WITH A NAME ALREADY
*         IN USE.  CHANGE THE FILE NAME AND RETRY.
* 
*         * JSN      EQNNNN TRACK TTTT LENGTH ERROR.* = THE QUEUE 
*         FILE ON THE SPECIFIED EQUIPMENT AND TRACK WAS 
*         DETECTED AS HAVING A LENGTH ERROR AT RECOVERY TIME. 
*         CONTACT AN ANALYST AND BRING THIS TO HIS ATTENTION. 
*         (DAYFILE ONLY). 
* 
*         * INCORRECT DUMP REQUESTED.* = DEVICE SPECIFIED IS NOT MASS 
*         STORAGE.
*         ENTER THE CORRECT PARAMETERS AND RETRY OPERATION. 
* 
*         * IQFT FILE ERROR DN XX FAMILY AAAAAAA.* = AN ERROR HAS 
*         BEEN ENCOUNTERED ATTACHING OR READING THE IQFT.  THE
*         MESSAGE FOLLOWING THIS MESSAGE IN THE DAYFILE DESCRIBES 
*         THE ERROR.  (DAYFILE ONLY). 
* 
*         * QDUMP ABORTED.* = AN ERROR HAS BEEN DETECTED WHICH
*         IS NOT PROCESSED BY QDUMP ERROR PROCESSING.  ATTEMPTS 
*         HAVE BEEN MADE TO REMEDY THE SITUATION, BUT DISCRETION
*         SHOULD BE USED IN CONTINUED USE OF QDUMP.  IN ANY 
*         CASE, AN ANALYST SHOULD BE CONTACTED.  CHECK THE
*         DAYFILE FOR THE ERROR THAT CAUSED THE ABORT.
* 
*         * QUEUE STATUS INDEFINITE.* = QDUMP HAS NOT BEEN ABLE TO
*         FINISH THE CLEAN UP AFTER AN ERROR OR AN ERROR EXIT.  THE 
*         STATUS OF IQFTS AND QUEUED FILES IS UNKNOWN.  A LEVEL 
*         ZERO DEADSTART IS RECOMMENDED TO CLEAN UP THE IQFT FILES. 
* 
*         * QUEUES UNRECOVERABLE THIS DEVICE.* = THE IQFT FILE
*         ON THE SPECIFIED DEVICE CANNOT BE READ PROPERLY.  AN
*         ANALYST SHOULD BE CONTACTED.  (DAYFILE ONLY). 
* 
*         * TAPE ERROR - GO,JSN./DROP,JSN.* = THE DUMP HAS ENCOUNTERED
*         A WRITE ERROR ON TAPE.  ENTER GO,JSN. TO CONTINUE, OR 
*         DROP,JSN. TO END THE DUMP.  (LINE 2 OF CONTROL POINT AREA 
*         ONLY).
* 
*         * XXXX FILES IGNORED   DNYY  FM AAAAAAA.* = NUMBER OF 
*         QUEUED FILE IGNORED THIS DEVICE ON THIS OPERATION.
* 
*         * XXXX FILES DUMPED(A) DNYY  FM AAAAAAA.* = NUMBER OF 
*         ACTIVE QUEUED FILES DUMPED AND LEFT ACTIVE THIS DEVICE. 
* 
*         * XXXX FILES DUMPED(I) DNYY  FM AAAAAAA.* = NUMBER OF 
*         INACTIVE QUEUED FILES DUMPED AND LEFT INACTIVE THIS 
*         DEVICE. 
* 
* 
*         THE FOLLOWING DAYFILE MESSAGES ARE ISSUED WHEN *CIO*
*         ERRORS ARE DETECTED.
* 
*         / *CIO* ERROR./ 
*         * ADDRESS ERROR.* 
*         * DEVICE STATUS ERROR.* 
*         * 6681 FUNCTION REJECT ERROR.*
*         * DEVICE RESERVED.* 
*         * DEVICE NOT READY.*
*         * TRACK LIMIT.* 
* 
* 
*         THE FOLLOWING DAYFILE MESSAGES ARE ISSUED WHEN *QFM*
*         ERRORS ARE DETECTED.
* 
*         / *QFM* ERROR./ 
*         * FILE NOT FOUND.*
*         * FILE ALREADY INTERLOCKED.*
*         * DEVICE UNAVAILABLE.*
*         * QFT/LOCAL FNT FULL.*
          SPACE  4
***       *K* DISPLAY OPERATOR MESSAGES.
* 
*         * NO OUTPUT FILE EXISTS.* = NO OUTPUT FILE HAS BEEN 
*         CREATED PREVIOUS TO ENTERING THE *OUT* COMMAND. 
* 
*         * OUTPUT FILE RELEASED.* = OUTPUT FILE RELEASED TO PRINTER. 
* 
*         * QDUMP COMPLETE.* = THE SPECIFIED OPERATION HAS BEEN 
*         COMPLETED.
          SPACE  4,10 
***       OUTPUT FILE ERROR MESSAGES. 
* 
*         *DUPLICATE FILE NAME - FILE IGNORED*
*         *READ ERROR - FILE DUMPED*
*         *READ ERROR - FILE IGNORED* 
*         *SYSTEM SECTOR ERROR - FILE IGNORED*
*         *TRACK LIMIT - FILE IGNORED*
          SPACE  4
*         COMMON DECKS. 
  
*CALL     COMCMAC 
*CALL     COMCCMD 
*CALL     COMSACC 
*CALL     COMSJIO 
*CALL     COMSDSP 
          LIST   X
*CALL     COMSIOQ 
*CALL     COMSQFS 
*CALL     COMSSFM 
          LIST   -X 
*CALL     COMSMLS 
*CALL     COMSSSE 
*CALL     COMSSSJ 
 SCLASS   SPACE  4,15 
**        SCLASS - DEFINE SERVICE CLASS TABLE.
* 
*         SCLASS NM,MN,DF,ST,TX 
* 
*         ENTRY  *NM* = SERVICE CLASS NAME. 
*                *MN* = TWO CHARACTER MNEMONIC. 
*                *DF* = DAYFILE MESSAGE CHARACTER.
*                *ST* = SHORT TEXT FOR *QFTLIST*. 
*                *TX* = TEXT OF SERVICE CLASS NAME FOR BANNER PAGE. 
* 
*         NOTE - THE CALL TO *COMSSCD* MUST FOLLOW THE DEFINITION OF
*                THIS MACRO.
  
  
          PURGMAC  SCLASS 
  
 SCLASS   MACRO  NM,MN,DF,ST,TX 
 .SCL     RMT 
 NM       VFD    12/0,12/2R_MN,36/0  TX 
 .SCL     RMT 
 SCLASS   ENDM
  
  
 SCL$     EQU    0           ONLY PROCESS CLASSES WITH JCB-S
*CALL     COMSSCD 
          TITLE  ASSEMBLY CONSTANTS.
****      ASSEMBLY CONSTANTS. 
  
 BUFL     EQU    1001B       FET CIRCULAR BUFFER LENGTH 
 QBUFL    EQU    2041B       QUEUED FILE BUFFER LENGTH
 SBUFL    EQU    201B        SYSTEM INFORMATION BUFFER
 DBUFL    EQU    20041B      DUMP FILE BUFFER LENGTH
 EBUFL    EQU    4           END OF VOLUME BUFFER LENGTH
 IBUFL    EQU    1001B       IQFT BUFFER LENGTH 
 WBUFL    EQU    10110B      WORKING BUFFER LENGTH
 DBLL     EQU    1000B       DUMP BLOCK LENGTH
 EOFC     EQU    2000B       EOF CONTROL WORD CODE
 EORC     EQU    1000B       EOR CONTROL WORD CODE
 FNEL     EQU    2           FNT ENTRY LENGTH 
 LNUM     EQU    TPPA+PPLN   LINE NUMBER
 PDFE     EQU    TPPA+PPPD   PRINT DENSITY FORMAT EFFECTOR
****
          TITLE  RESERVED LOCATIONS AND FETS. 
*         RESERVED LOCATIONS. 
  
          ORG    OVLA 
  
 QNUM     CON    1           QUEUE FILE NUMBER
 PNUM     CON    1           PAGE NUMBER
 LIST     CON    0           OUTPUT PRESENT FLAG
 RECF     CON    0           LIST ANOTHER RECORD FLAG 
 DBLS     CON    0           DUMP BLOCK LOGICAL SIZE
 DBSL     CON    0           DUMP BUFFER SEGMENT LIMIT
 DFBS     CON    0           DUMP FILE BLOCK SIZE 
 DSPB     CON    0           TYPE OF FILES TO DUMP
 DPCT     CON    0           COUNT OF QUEUE FILES DUMPED
 IGCT     CON    0           COUNT OF QUEUE FILES IGNORED 
 QCWI     CON    0           QDUMP CONTROL WORD BUFFER INDEX
 ALFG     CON    0           ACCESS LEVELS SPECIFIED FLAG 
 MSFG     CON    -1          MASS STORAGE DUMP FILE FLAG
          SPACE  4
*         FETS. 
  
 O        BSS    0           OUTPUT FILE
 OUTPUT   FILEB  OBUF,BUFL,(FET=7)
  
 Q        BSS    0           QUEUE FILE 
 QNAME    FILEB  QBUF,QBUFL,EPR,(FET=13)
  
 S        BSS    0           SYSTEM AND EOI SECTORS 
 SSEOI    FILEB  SBUF,SBUFL,EPR,(FET=8) 
  
 D        BSS    0           DUMP FILE
 QFILES   FILEB  DBUF,DBUFL,EPR,LBL 
  
 DE       BSS    0           END OF VOLUME CONTROL WORDS
 EQFILES  FILEB  EBUF,EBUFL 
  
 IQ       BSS    0           OLD IQFT FILE
 "RFIQ"   FILEB  IBUF,IBUFL,EPR,(FET=8) 
  
 T        BSS    0           TEMPORARY IQFT ENTRY BUFFER
 TEMP     FILEB  TBUF,BUFL,EPR,(FET=9)
 QDUMP    TITLE  MAIN ROUTINE.
**        QDUMP - MAIN ROUTINE. 
* 
*         CALL PRESET IF NECESSARY, DETERMINE WHETHER *GO* OR 
*         *OUT* HAS BEEN SPECIFIED, CALL THE ROUTINES TO PROCESS
*         THE FUNCTION, THEN CLEAN UP FOR THE RETURN TO *QFSP*. 
* 
*         ENTRY  (QFTS) = 0 IF INITIAL CALL TO *QDUMP* FROM *QFSP*. 
*                       .NE. 0 ON ALL FOLLOWING CALLS.
* 
*         USES   X - ALL. 
*                A - 1, 2, 4, 6, 7. 
*                B - 1. 
* 
*         CALLS  CAL, CID, OFN, OUT, PRS, RAF, WDH. 
* 
*         MACROS ABORT, MEMORY, RETURN, SETFS, WRITER.
  
  
 QDUMP    SUBR               ENTRY/EXIT 
          SB1    1
          SA1    QFTS        QFT LENGTH 
          SX6    B0+         PRESET FLAGS 
          SA6    RECF 
          SA6    DQFB 
          SA6    ERRA 
          NZ     X1,QDU1     IF PRESET UNNECESSARY
          RJ     PRS         PRESET 
 QDU1     RJ     OFN         SET OUTPUT FILE NAMES
          NZ     X5,QDU3     IF FILE NAME CONFLICT
  
*         DETERMINE FUNCTION. 
  
          SA2    TARA+ARFC   CHECK FUNCTION 
          MX0    -12
          BX3    -X0*X2 
          ZR     X3,QDU2     IF *GO* COMMAND
  
*         PROCESS *OUT* COMMAND.
  
          RJ     OUT         DISPOSE OUTPUT FILE
          BX2    X2-X2       SET NO *K* DISPLAY BUFFER
          EQ     QDUMPX      RETURN 
  
*         PROCESS *GO* COMMAND. 
  
 QDU2     SA1    TARA+ARTP   SET TYPE OF FILES TO DUMP
          MX0    -12
          BX6    -X0*X1 
          SA6    DSPB 
          RJ     CAL         CHECK ACCESS LEVLES
          NZ     X5,QDU3     IF ERROR 
          RJ     CID         CHECK FOR INCORRECT DEVICES
          NZ     X5,QDU3     IF ERROR 
          RJ     WDH         WRITE DUMP FILE HEADER 
          NZ     X5,QDU3     IF ERROR 
          RJ     DQF         DUMP QUEUED FILES
          NZ     X5,QDU3     IF ERROR 
          SX5    MES1        *QDUMP COMPLETE.*
  
*         RETURN LOCAL FILES. 
  
 QDU3     RETURN Q,R
          RETURN S,R
          SETFS  O,0
          SA1    RECF 
          ZR     X1,QDU4     IF NO NEW OUTPUT RECORD
          WRITER O           FLUSH BUFFER 
  
*         RESET FIELD LENGTH. 
  
 QDU4     SX7    IBUF+IBUFL  RESET POINTERS 
          SA4    IQ+4        RESET *LIMIT*
          MX0    42 
          BX6    X0*X4
          BX7    X6+X7
          SA7    A4+
          SX0    X5          SAVE MESSAGE ADDRESS 
          MEMORY CM,,R,BUFFL RESET ORIGINAL FIELD LENGTH
  
*         EXIT TO *QFSP*. 
  
          SX3    IQ          RETURN ATTACHED IQFT FILE
          RJ     RAF
          SA1    ERRB 
          NZ     X1,QDU5     IF *PO=N* SPECIFIED AND ABORT SET
          SX5    X0 
          BX2    X2-X2       SET NO *K* DISPLAY BUFFER
          EQ     QDUMPX      RETURN 
  
 QDU5     ABORT 
          TITLE  PRIMARY SUBROUTINES. 
 CAL      SPACE  4,25 
**        CAL - CHECK ACCESS LEVELS.
* 
*         IF NO ACCESS LEVELS WERE SELECTED, THE LOWEST AND HIGHEST 
*         ACCESS LEVELS OF ALL MASS STORAGE DEVICES ARE USED.  IF 
*         THESE LIMITS ARE NOT WITHIN THE SYSTEM LIMITS, AN ERROR 
*         IS RETURNED.
* 
*         ENTRY  (DVLA) = LOWER ACCESS LEVEL LIMIT OF ALL MASS
*                         STORAGE DEVICES.
*                (DVUA) = UPPER ACCESS LEVEL LIMIT OF ALL MASS
*                         STORAGE DEVICES.
* 
*         EXIT   (ALFG) = -1, IF ACCESS LEVELS FROM ARGUMENT TABLE
*                         TO BE USED. 
*                (X5) = 0.
* 
*         ERROR  (X5) = K-DISPLAY MESSAGE ADDRESS.
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 3, 6.
* 
*         CALLS  GAD. 
* 
*         MACROS MESSAGE. 
  
  
 CAL3     SX6    -B1         USE ACCESS LEVELS FROM ARGUMENT TABLE
          SA6    ALFG 
 CAL4     BX5    X5-X5       SET NO ERROR 
  
 CAL      SUBR               ENTRY/EXIT 
          SA1    TARA+ARLA
          PL     X1,CAL3     IF ACCESS LEVELS SELECTED
          SA2    SECA        GET SYSTEM ACCESS LEVELS 
          MX0    -3 
          LX2    12 
          BX1    -X0*X2 
          ZR     X1,CAL4     IF UNSECURE SYSTEM 
          SA3    TARA+ARFM
          ZR     X3,CAL1     IF NO FAMILY NAME SELECTED 
          RJ     GAD         GET ACCESS LEVELS FOR DEVICES
 CAL1     LX2    6
          MX0    -3 
          BX7    -X0*X2      GET LOWER SYSTEM LIMIT 
          LX2    6
          BX6    -X0*X2      GET UPPER SYSTEM LIMIT 
          SA1    DVLA        GET DEVICE ACCESS LIMITS 
          SA2    DVUA 
          IX1    X1-X7
          IX2    X6-X2
          NG     X1,CAL2     IF LOWER LIMIT OUTSIDE SYSTEM LIMITS 
          PL     X2,CAL4     IF UPPER LIMIT WITHIN SYSTEM LIMITS
 CAL2     SX5    MES12       SET ERROR
          MESSAGE  X5        * ACCESS LEVEL LIMITS OUT OF RANGE.* 
          SA1    TARA+ARFC
          PL     X1,CALX     IF *PO=N* NOT SPECIFIED
          SX6    B1+         SET ABORT FLAG 
          SX5    MES2        * QDUMP ABORTED.*
          SA6    ERRB 
          MESSAGE  X5 
          EQ     CALX        RETURN 
 CID      SPACE  4,20 
**        CID - CHECK FOR INCORRECT DEVICES.
* 
*         THE ERROR MESSAGE *INCORRECT DUMP REQUESTED* IS ISSUED
*         IF THE DEVICE SPECIFIED IS NOT MASS STORAGE.
* 
*         EXIT   (X5) = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
*                     = 0 IF NO ERROR.
*                (CEQP) = EST ORDINAL.
* 
*         USES   X - 5, 6.
*                A - 6. 
* 
*         CALLS  DND. 
* 
*         MACROS MESSAGE. 
  
  
 CID1     SX5    MES3        *INCORRECT DUMP REQUESTED.*
          MESSAGE X5
  
 CID      SUBR               ENTRY/EXIT 
  
*         DETERMINE FIRST EQUIPMENT TO DUMP FROM. 
  
          SX6    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          SA6    CEQP 
          RJ     DND         DETERMINE FIRST EQUIPMENT
          ZR     X4,CID1     IF DEVICE NOT IN TABLE (NON-MASS STORAGE)
          BX5    X5-X5
          EQ     CIDX        RETURN 
 DQF      SPACE  4,20 
**        DQF - DUMP QUEUED FILES.
* 
*         PRESET OUTPUT AND CALL ROUTINES TO PROCESS THE DUMPING
*         OF THE QUEUED FILES, PROCESSING THE FILES ONE DEVICE
*         AT A TIME, THEN CLOSE THE DUMP SESSION WITH AN EOF. 
* 
*         ENTRY  (DSPB) = 0, DUMP INACTIVE QUEUE FILES. 
*                       = 1, DUMP ACTIVE QUEUE FILES. 
*                       = 2, DUMP ALL QUEUE FILES.
*                (DFBS) = DUMP FILE BLOCK SIZE. 
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
* 
*         USES   X - 0, 1, 3, 5, 6, 7.
*                A - 0, 1, 3, 6, 7. 
*                B - 6. 
* 
*         CALLS  CER, DND, EPR, IDM, PQF. 
* 
*         MACROS CLOCK, DATE, EREXIT, MEMORY, WRITE, WRITECW, WRITEW. 
  
  
 DQF2     NZ     X4,DQF1     IF NOT END OF DEVICES
  
*         CLOSE OUTPUT FILE.
  
 DQF3     SA1    DFBS        SET EOF CONTROL WORDS IN BUFFER
          LX1    36 
          BX6    X1 
          SA6    DQFA 
          SX6    B1+         SET NO QUEUED FILE ATTACHED FLAG 
          SA6    DQFB 
          SA0    D
          WRITEW A0,DQFA,2
          RJ     CER         CHECK FOR ERROR
          NZ     X5,DQF5     IF ERROR 
 DQF4     SA0    D           FLUSH BUFFER 
          WRITECW A0,R
          RJ     CER         CHECK FOR ERROR
          ZR     X5,DQFX     IF NO ERROR
 DQF5     SX7    X5-11B 
          NZ     X7,DQF6     IF NOT SPECIAL MASS STORAGE ERROR
          SA3    A0+6        GET ERROR CODE 
          MX0    -9 
          BX5    -X0*X3 
          SX5    X5+11B      BIAS ERROR CODE
 DQF6     SB6    TCEP        SET ERROR TABLE ADDRESS
          RJ     EPR         PROCESS ERROR
          ZR     X5,DQF4     IF RECOVERED FROM WRITE PARITY ERROR 
  
 DQF      SUBR               ENTRY/EXIT 
  
*         SET UP OUTPUT HEADER AND PARAMETERS.
  
          DATE   BOHA1       SET DATE IN HEADER 
          CLOCK  BOHA2       SET TIME IN HEADER 
          WRITE  O,*         PRESET WRITE FUNCTION
          SX6    B1+         SET QUEUE FILE AND PAGE NUMBERS
          SA6    QNUM 
          SA6    PNUM 
          SA6    PDFE+1      SET PRINT DENSITY FORMAT CONTROL FLAG
          SX7    99999       FORCE PAGE EJECT 
          SA7    LNUM 
  
*         PROCESS DUMPING OF QUEUE FILES. 
  
          SX6    B0          PRESET NUMBER OF FILES DUMPED AND IGNORED
          SA6    DPCT 
          SX0    B0          SET INITIAL CALL FOR ACTIVE FILES
          SA6    IGCT 
 DQF1     EREXIT ERR         SET ERROR EXIT 
          RJ     PQF         PROCESS QUEUE FILES
          SA0    X5          SAVE ERROR 
          EREXIT 0           CLEAR ERROR EXIT 
          RJ     IDM         ISSUE DAYFILE MESSAGES 
          SX5    A0+
          NZ     X5,DQFX     IF ERROR 
  
*         CHECK FOR MORE DEVICES TO PROCESS.
  
          RJ     DND         DETERMINE NEXT DEVICE
          SA1    DSPB 
          ZR     X1,DQF2     IF DUMPING INACTIVE FILES
          SB6    RBUF+QFTE   SET QFT BUFFER ADDRESS 
          SX0    B1+         SET NON-INITIAL CALL 
          NZ     X4,DQF1     IF NOT END OF DEVICES
          SA1    DSPB 
          SX5    X1-1 
          ZR     X5,DQF3     IF DUMP ONLY ACTIVE FILES
  
*         SET UP FOR INACTIVE FILE DUMP.
  
          BX6    X6-X6       SET INACTIVE FILE DUMP 
          SA6    A1 
          MEMORY CM,,R,BUFFL RESET FIELD LENGTH 
          SX6    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          SA6    CEQP 
          RJ     DND
          EQ     DQF1        PROCESS INACTIVE QUEUE FILES 
  
 DQFA     VFD    24/0,36/0   EOF CONTROL WORDS
          VFD    12/17B,48/0
 DQFB     CON    0           QUEUED FILE ATTACHED FLAG
 OFN      SPACE  4,20 
**        OFN - SET OUTPUT AND DUMP FILE NAMES. 
* 
*         SET UP THE OUTPUT AND DUMP FILE FETS.  ISSUE AN ERROR 
*         MESSAGE IF EITHER FILE NAME SPECIFIED IS QNAME, SS, 
*         IQF, TEMP OR ANY OTHER NAME CURRENTLY EXISTING IN 
*         ANOTHER FET.
* 
*         EXIT   (LIST) = 0 IF OUTPUT FILE NAME CHANGED.
*                (X5) = 0 IF NO FILE NAME CONFLICT. 
*                     = ADDRESS OF *K* DISPLAY MESSAGE IF CONFLICT. 
* 
*         USES   X - ALL. 
*                A - 0, 1, 2, 3, 6, 7.
* 
*         CALLS  SFN. 
* 
*         MACROS MESSAGE, RECALL. 
  
  
*         ISSUE MESSAGE.
  
 OFN5     BX1    X3          SPACE FILL FILE NAME 
          RJ     SFN
          LX6    18          SET FILE NAME IN MESSAGE 
          MX0    -18
          SA1    MES4+2 
          BX7    -X0*X6 
          BX1    X0*X1
          BX7    X7+X1
          SA7    A1 
          SA2    A1+B1
          MX0    24 
          BX6    X0*X6
          BX2    -X0*X2 
          BX7    X6+X2
          SA7    A2 
          SX5    MES4        *FILE NAME CONFLICT - FILE XXXXXXX.* 
          MESSAGE X5
  
 OFN      SUBR               ENTRY/EXIT 
          RECALL D
  
*         CHECK OUTPUT FILE NAME FOR CONFLICTS. 
  
          SA0    O           OUTPUT FILE
          SA1    A0 
          SX5    B1          SET FLAG 
          SA2    D           DUMP FILE
          SA3    TARA+ARLL   SPECIFIED OUTPUT FILE NAME 
  
*         COMPARE CURRENT AND SPECIFIED NAMES.
  
 OFN1     MX0    42 
          BX2    X2-X3
          BX4    X1-X3
          BX2    X0*X2
          BX1    X0*X4
          ZR     X2,OFN5     IF FILE NAME CONFLICT
          BX6    X6-X6       INITIALIZE LIST FLAG FOR OUTPUT FILE 
          ZR     X1,OFN4     IF NO FILE NAME CHANGE 
          ZR     X5,OFN2     IF DUMP FILE BEING CHECKED 
          SA6    LIST 
  
*         CHECK FOR FILE NAME CONFLICTS.
  
 OFN2     SA1    IQ          OLD IQFT FILE
          SA2    T           TEMPORARY FILE 
 OFN3     BX1    X0*X1
          BX2    X0*X2
          BX1    X1-X3
          BX2    X2-X3
          ZR     X1,OFN5     IF FILE NAME CONFLICT
          ZR     X2,OFN5     IF CONFLICT
          NZ     X6,OFN4     IF ALL NAMES CHECKED 
          SA1    S           SYSTEM SECTOR
          SA2    Q           QUEUE FILE 
          SX6    B1+
          EQ     OFN3 
  
*         SET FILE NAME IN FET. 
  
 OFN4     SX1    3
          BX6    X3+X1
          SA6    A0 
          SA6    DE          SET END OF VOLUME CONTROL WORD FET 
          ZR     X5,OFNX     IF BOTH NAMES CHECKED
  
*         CHECK DUMP FILE NAME FOR CONFLICTS. 
  
          SA0    D           DUMP FILE
          SA1    A0 
          BX5    X5-X5       CLEAR FLAG 
          SA2    O           OUTPUT FILE
          SA3    TARA+ARFN   SPECIFIED DUMP FILE NAME 
          EQ     OFN1 
 OUT      SPACE  4,20 
**        OUT - RELEASE OUTPUT FILE TO PRINTER. 
* 
*         RELEASE THE OUTPUT FILE, IF ONE EXISTS, TO THE PRINTER
*         AND ISSUE AN INFORMATIVE MESSAGE AS TO WHETHER OR NOT 
*         ONE WAS RELEASED. 
* 
*         ENTRY  (LIST) .NE. 0 IF OUTPUT FILE WRITTEN.
* 
*         EXIT   (LIST) = 0.
*                (X5) = *K* DISPLAY MESSAGE ADDRESS.
* 
*         USES   X - 2, 5, 6. 
*                A - 2, 6.
* 
*         CALLS  CBL. 
* 
*         MACROS ROUTE. 
  
  
 OUT1     SX5    MES6        *NO OUTPUT FILE EXISTS.* 
  
 OUT      SUBR               ENTRY/EXIT 
          SA2    LIST        CHECK IF OUTPUT EXISTS 
          ZR     X2,OUT1     IF NO OUTPUT FILE
  
*         RELEASE OUTPUT FILE.
  
          RJ     CBL         CLEAR ROUTE BLOCK
          SA2    O           SET UP *DSP* PARAMETER BLOCK 
          MX6    42 
          BX6    X6*X2
          SA6    BLOCK
          SA2    OUTA        SET FLAGS
          BX6    X2 
          SA6    A6+B1
          ROUTE  BLOCK,RECALL 
          BX6    X6-X6       CLEAR OUTPUT FLAG
          SA6    LIST 
          SX5    MES7        *OUTPUT FILE RELEASED.*
          EQ     OUTX 
  
  
 OUTA     VFD    24/0,12/2HPR,6/0,18/FRDC 
 WDH      SPACE  4,20 
**        WDH - WRITE DUMP FILE HEADER BLOCK. 
* 
*         REWIND THE ATTACHED DUMP FILE IF SPECIFIED THEN SKIP
*         THE NUMBER OF FILES SPECIFIED, AND WRITE A FOUR WORD
*         DUMP HEADER TO THE DUMP FILE CONTAINING THE DATE, 
*         TIME, AND DUMP FILE DESCRIPTION.
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     .NE. 0 IF ERROR WRITING HEADER TO DUMP FILE.
*                (DFBS) = DUMP FILE BLOCK SIZE. 
*                (ERRB) .NE. 0 IF *PO=N* SPECIFIED AND ERROR
*                              ENCOUNTERED. 
*                (MSFG) = 0, IF MASS STORAGE DUMP FILE. 
*                DUMP FILE POSITIONED.
* 
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 0, 1, 2, 6, 7. 
* 
*         CALLS  BEC, CER, SFN, WBD.
* 
*         MACROS CLOCK, DATE, MESSAGE, OPEN, REWIND, SETFS, SKIPFF, 
*                WRITECW. 
  
  
 WDH      SUBR               ENTRY/EXIT 
          SA1    TARA+ARFC
          LX1    59-58
          PL     X1,WDH1     IF NO REWIND SPECIFIED 
          REWIND D,R
 WDH1     SA1    TARA+ARNF
          ZR     X1,WDH2     IF NO FILES TO SKIP
          SA2    D
          SX3    17B         SET LEVEL *17B* IN FET 
          LX3    14 
          MX0    -4 
          LX0    14 
          BX2    X0*X2
          BX6    X3+X2
          SA6    A2 
          SKIPFF D,X1,R 
 WDH2     SETFS  D,0
          OPEN   X2,ALTERNR,R 
          WRITECW X2,*       PRESET WRITE FUNCTION
  
*         BUILD HEADER BLOCK DATA.
  
          SA1    D           SET DUMP FILE NAME IN DUMP CONTROL WORD
          MX0    42 
          BX1    X0*X1
          SA2    WDHA 
          BX7    X1+X2       BUILD HEADER BLOCK 
          SA7    WBUF+1 
          RJ     SFN         SPACE FILL NAME
          SA6    A7+B1
          SA2    WDHB        BLANK FILL NEXT WORD 
          BX6    X2 
          SA6    A6+B1
          DATE   WBUF+4 
          CLOCK  WBUF+5 
  
*         BUILD CONTROL WORDS.
  
          SA1    D+4         BUILD EXTERNAL CONTROL WORD
          AX1    18 
          SX6    X1          SET BLOCK SIZE OF DUMP FILE
          SA6    DFBS 
          SX1    5
          SA2    D+1
          NG     X2,WDH3     IF NOT ALLOCATABLE DEVICE
          SX6    B0+         SET MASS STORAGE DUMP FILE FLAG
          SA6    MSFG 
          SX6    DBLL 
 WDH3     SA6    DBLS        DUMP BLOCK LOGICAL SIZE
          RJ     BEC
  
*         WRITE HEADER BLOCK TO DUMP FILE.
  
          RJ     WBD         WRITE BLOCK
          SA0    D
          WRITECW A0,R
          RJ     CER         CHECK FOR ERROR
          ZR     X5,WDHX     IF NO ERROR
          SX5    MES8        *BAD DUMP FILE.* 
          MESSAGE X5
          SA1    TARA+ARFC
          PL     X1,WDHX     IF *PO=N* NOT SPECIFIED
          SA6    ERRB        SET ABORT FLAG 
          SX5    MES2        *QDUMP ABORTED.* 
          MESSAGE X5
          EQ     WDHX 
  
 WDHA     VFD    42/0,3/6,6/0,9/4  DUMP HEADER CONTROL WORD 
 WDHB     DATA   10H
 AQF      TITLE  SECONDARY SUBROUTINES. 
**        AQF - ATTACH QUEUE FILE AND READ SYSTEM INFORMATION.
* 
*         SEARCH THE IQFT BUFFER UNTIL THE NEXT ENTRY THAT MEETS
*         THE REQUIREMENTS SPECIFIED IN THE FET IS FOUND, THEN
*         ATTACH THAT FILE TO THE CONTROL POINT, ISSUE A *READ* ON
*         THE FILE AND READ ITS SYSTEM AND EOI SECTORS. 
* 
*         ENTRY  (X5) = FUNCTION TO ATTACH FILE.
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     .LT. 0, SKIP FILE.
*                     .GT. 0, *K* DISPLAY MESSAGE ADDRESS.
*                (X6) .NE. 0 IF END OF BUFFER.
*                (AQFA) .NE. 0 IF READ MASS STORAGE ERROR.
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 0, 1, 2, 3, 5, 6, 7. 
*                B - 6. 
* 
*         CALLS  CER, EPR.
* 
*         MACROS QCALL, READCW, REWIND. 
  
  
 AQF      SUBR               ENTRY/EXIT 
          BX6    X6-X6       CLEAR FLAGS
          SA6    AQFA 
          SA6    A6+B1
          REWIND Q,R
          REWIND S,R
  
*         ATTACH QUEUE FILE.
  
          SA0    T           ATTACH FILE
          QCALL  X5,T 
          RJ     CER         CHECK FOR ERROR
          NZ     X5,AQF2     IF ERROR 
          SA1    T+3         ADVANCE *OUT* POINTER
          SA2    A1-B1
          IX2    X2-X1       *IN* - *OUT* 
          SX6    B1+         SET FLAG FOR NO ATTACH 
          SA6    AQFB 
          ZR     X2,AQFX     IF END OF BUFFER 
          SX7    X1+QFEWL 
          SA7    A1 
          MX0    24 
          SA2    X1+         INSERT QUEUE FILE NAME IN FETS 
          BX6    X0*X2
          MX0    -18
          SA3    Q
          BX3    -X0*X3 
          BX7    X6+X3
          SA5    S
          BX5    -X0*X5 
          SA7    A3 
          BX7    X6+X5
          SA7    A5 
  
*         READ SYSTEM INFORMATION.
  
          SA0    S
          QCALL  QRSF,S      READ SYSTEM SECTOR 
          RJ     CER         CHECK FOR ERROR
          NZ     X5,AQF2     IF ERROR 
          QCALL  QREF,S      READ EOI SECTOR
 AQF1     READCW Q           READ QUEUE FILE
          BX6    X6-X6       CLEAR END OF BUFFER
          EQ     AQFX        RETURN 
  
*         PROCESS *QFM* ERROR.
  
 AQF2     SB6    TQEP        SET ERROR TABLE ADDRESS
          RJ     EPR         PROCESS ERROR
          NZ     X5,AQFX     IF ERROR 
          SA7    AQFA        SAVE READ ERROR MESSAGE ADDRESS
          SA7    CPFA 
          EQ     AQF1        RENAME OLD QUEUE FILE
  
 AQFA     CON    0           READ ERROR FLAG
 AQFB     CON    1           ATTACHING FLAG 
 BEC      SPACE  4,20 
**        BEC - BUILD EXTERNAL CONTROL WORD.
* 
*         BUILD THE CONTROL WORD TO BE USED BY *WRITECW*. 
* 
*         ENTRY  (DFBS) = SIZE OF DUMP FILE BLOCK.
*                (X1) = NUMBER OF WORDS IN BUFFER.
* 
*         EXIT   (X1) = (X5) = NUMBER OF WORDS IN BUFFER. 
* 
*         USES   X - 2, 3, 5, 6, 7. 
*                A - 2, 7.
  
  
 BEC      SUBR               ENTRY/EXIT 
          SA2    DFBS        BUILD EXTERNAL CONTROL WORD
          LX2    36 
          SX5    X1 
          SX3    5           CALCULATE BYTE COUNT 
          IX6    X3*X1
          BX7    X2+X6
          SA7    WBUF 
          EQ     BECX 
 BOF      SPACE  4,30 
**        BOF - BUILD OUTPUT FILE.
* 
*         WRITE ONE ENTRY TO THE OUTPUT FILE AND CALL THE ROUTINE 
*         TO WRITE PAGE HEADERS WHEN NECESSARY. 
* 
*         ENTRY  (X7) = ERROR CODE ADDRESS. 
*                (LNUM) = CURRENT LINE NUMBER.
*                (PNUM) = CURRENT PAGE NUMBER.
*                (QNUM) = CURRENT QUEUE FILE NUMBER.
*                (CEQP) = CURRENT EQUIPMENT.
*                (DSPB) = 0, DUMP INACTIVE QUEUE FILES. 
*                       = 1, DUMP ACTIVE QUEUE FILES. 
*                       = 2, DUMP ALL QUEUE FILES.
* 
*         EXIT   (LNUM) = NEXT LINE NUMBER. 
*                (PNUM) = NEXT PAGE NUMBER. 
*                (QNUM) = NEXT QUEUE FILE NUMBER. 
* 
*                X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 6, 7. 
*                B - 7. 
* 
*         CALLS  BOH, FQO.
* 
*         MACROS WRITEC, WRITEW.
  
  
 BOF      SUBR               ENTRY/EXIT 
          SA7    BOFA        SAVE ERROR CODE ADDRESS
          SA1    LNUM        LINE NUMBER
          SA2    A1+B1
          IX7    X1-X2
          NG     X7,BOF1     IF NOT END OF PAGE 
  
*         WRITE HEADER AND SET RECORD FLAGS.
  
          RJ     BOH         BUILD OUTPUT PAGE HEADER 
          SA2    PNUM        CHECK PAGE NUMBER
          SX6    X2-2 
          NZ     X6,BOF1     IF NOT FIRST PAGE
          SA3    LIST        INCREMENT OUTPUT FLAG
          SX7    X3+B1
          SA7    A3 
          SA7    RECF        SET CURRENT RECORD FLAG
  
*         WRITE ONE LINE TO OUTPUT FILE.
  
 BOF1     SA3    CEQP        CURRENT EQUIPMENT
          SB7    TEQA+X3     ADDRESS OF FAMILY/DEVICE 
          SA1    QNUM        INCREMENT QUEUE NUMBER 
          SX6    X1+B1
          SA6    A1 
          SA2    T+3         IQFT ENTRY ADDRESS 
          SX5    X2-QFEWL 
          SA3    DSPB        DISPOSITION FIELD ENTRY
          SA3    BOFG+X3
          RJ     FQO         FORMAT OUTPUT LINE 
          WRITEW O,B3,B2-1
  
*         WRITE ERROR CODE TO OUTPUT. 
  
          SA3    BOFA        ERROR CODE ADDRESS 
          WRITEC O,X3 
          SA2    LNUM        INCREMENT LINE NUMBER
          SX7    X2+B1
          SA7    A2 
          EQ     BOFX        RETURN 
  
 BOFA     CON    0           ERROR CODE ADDRESS 
 BOFB     DATA   C*READ ERROR - FILE IGNORED* 
 BOFC     DATA   C*READ ERROR - FILE DUMPED*
 BOFD     DATA   C*SYSTEM SECTOR ERROR - FILE IGNORED*
 BOFE     DATA   C*TRACK LIMIT - FILE IGNORED*
 BOFF     DATA   C*DUPLICATE FILE NAME - FILE IGNORED*
 BOFG     DATA   H*INACTIVE  *
          DATA   H*ACTIVE    *
          DATA   H*ACTIVE    *
 BLANK    DATA   C*        *
 BOH      SPACE  4,20 
**        BOH - BUILD OUTPUT FILE PAGE HEADER.
* 
*         BUILD THE HEADER LINES FOR EACH PAGE AND WRITE THESE
*         LINES TO OUTPUT.
* 
*         ENTRY  (PNUM) = PAGE NUMBER.
*                (PDFE+1) = SET IF PRINT DENSITY FORMAT EFFECTOR
*                           NOT YET WRITTEN.
* 
*         EXIT   (PNUM) = NEXT PAGE NUMBER. 
*                (LNUM) = LINE NUMBER FOLLOWING HEADER. 
* 
*         USES   X - 0, 1, 6, 7.
*                A - 1, 6, 7. 
* 
*         CALLS  CDD. 
* 
*         MACROS RECALL, WRITEW.
  
  
 BOH      SUBR               ENTRY/EXIT 
  
*         SET PAGE NUMBER IN HEADER.
  
          SA1    PNUM        INCREMENT PAGE NUMBER
          SX6    X1+B1
          SA6    A1 
          RJ     CDD         CONVERT NUMBER 
          MX0    36          SET IN HEADER
          SA1    BOHA3
          BX1    X0*X1
          BX6    -X0*X6 
          BX7    X1+X6
          SA7    A1+
          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
  
*         WRITE HEADER TO OUTPUT. 
  
          WRITEW O,BOHA,BOHAL 
          WRITEW O,BOHB,BOHBL 
          WRITEW O,BOHC,BOHCL 
          SX7    8           SET LINE NUMBER
          SA7    LNUM 
          EQ     BOHX        RETURN 
  
 BOHA     DATA   C*1         QDUMP PROCESSOR.               YY/MM/DD. HH
,.MM.SS.  PAGE      * 
 BOHA1    EQU    *-4         DATE 
 BOHA2    EQU    *-3         TIME 
 BOHA3    EQU    *-2         PAGE 
 BOHAL    EQU    *-BOHA 
  
 BOHB     DATA   H*0*        CARRIAGE CONTROL 
          DATA   H/                    *** DUMPED/
          DATA   C/ QUEUE FILE DISPOSITION ***/ 
 BOHBL    EQU    *-BOHB 
  
 BOHC     DATA   H*0*        CARRIAGE CONTROL 
          DATA   C*                                              LENGTH 
,ACCESS*
          DATA   H* *        CARRIAGE CONTROL 
          DATA   C*   NUM  JSNS MID FAMILY  DN DT DS   DATE      (PRUS) 
,LEVEL  DISPOSITION ERRORS* 
          DATA   C* * 
 BOHCL    EQU    *-BOHC 
 BUP      SPACE  4,10 
**        BUP - BACK UP *IN* POINTER TO BEGINNING OF CURRENT FILE.
* 
*         SET THE *IN* POINTER TO THE BEGINNING OF THE LAST RECORD
*         IN THE CIRCULAR BUFFER AND BACKSPACE TO THE START OF
*         THE CURRENT QUEUED FILE ON THE DUMP FILE IF NECESSARY.
* 
*         ENTRY  (DFBS) = DUMP FILE BLOCK SIZE. 
*                (RBCW) = ROUTE BLOCK CONTROL WORD. 
*                (ERCW) = READ ERROR CONTROL WORD.
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  BEC, WBD.
* 
*         MACROS BKSP, MESSAGE. 
  
  
 BUP      SUBR               ENTRY/EXIT 
          SA2    D+2         *IN* 
          SA3    A2+B1       *OUT*
          SA4    A3+B1       *LIMIT*
          SX4    X4+
          SX6    X3          SET LAST RECORD POINTER TO *OUT* 
          IX7    X2-X3       CHECK FOR NO DATA IN BUFFER
          SA6    BUPA 
          SX3    WBUF+1 
          ZR     X7,BUP4     IF *IN* .EQ. *OUT* 
          SX3    X6+         RESET *OUT*
  
*         GET NEXT CONTROL WORD ADDRESS.
  
 BUP1     SA1    X3+         CONTROL WORD 
          SX6    5
          SX7    X1+4        ROUND UP 
          IX6    X7/X6       WORDS IN BLOCK 
          IX7    X3+X6       CALCULATE ADDRESS OF NEXT CONTROL WORD 
          SX7    X7+2 
          IX1    X7-X4
          NG     X1,BUP2     IF NOT AT *LIMIT*
          IX7    X4-X3       CALCULATE AFTER WRAP-AROUND
          IX7    X6-X7
          SA1    D+1         *FIRST*
          SX1    X1 
          IX7    X7+X1
          SX7    X7+2 
 BUP2     SA1    DFBS        DUMP FILE BLOCK SIZE 
          IX6    X6-X1
          PL     X6,BUP3     IF NOT EOR 
          SA7    BUPA        SAVE ADDRESS OF NEXT RECORD
  
*         SET *IN* POINTER. 
  
 BUP3     SX3    X7          RESET ADDRESS
          IX6    X2-X7
          NZ     X6,BUP1     IF ADDRESS .NE. *IN* 
          SA1    BUPA 
          IX7    X2-X1
          ZR     X7,BUPX     IF *IN* = ADDRESS OF NEXT RECORD 
          SX7    X1          SET *IN* = ADDRESS OF LAST RECORD
          SA7    A2 
  
*         BACKSPACE DUMP FILE IF NOT AT BEGINNING OF FILE.
  
          SA3    A3          *OUT*
          IX6    X3-X1
          NZ     X6,BUPX     IF EOR FOUND 
          SX3    X3+B1       CHECK FOR BEGINNING OF QUEUED FILE 
          IX7    X3-X4
          NZ     X7,BUP4     IF NOT AT *LIMIT*
          SA3    D+1         *FIRST*
 BUP4     SA1    X3          CHECK FOR ROUTE BLOCK CONTROL WORD 
          SA4    RBCW 
          BX7    X4-X1
          ZR     X7,BUPX     IF AT BEGINNING OF FILE
          BKSP   D,R
          SA1    D           CHECK IF BACKSPACE COMPLETE
          SX0    77BS3
          BX6    X0*X1
          SX6    X6-50B 
          SX1    B1          SET WORDS IN BUFFER
          NZ     X6,BUPX     IF NOT REWIND STATUS 
  
*         END ERRORED FILE AND ISSUE MESSAGE. 
  
          SA2    ERCW        WRITE ERROR CONTROL WORD TO DUMP FILE
          BX6    X2 
          SA6    WBUF+1 
          RJ     BEC         BUILD EXTERNAL CONTROL WORD
          RJ     WBD         WRITE EOR BLOCK
          SA1    RBCW        SET FILE NAME IN MESSAGE 
          MX0    42 
          BX7    X0*X1
          LX7    -18
          SA2    MES11+3
          MX0    18 
          BX6    X0*X2
          BX7    X6+X7
          SA7    A2+
          MESSAGE MES11 
          EQ     BUPX 
  
 BUPA     CON    0           ADDRESS OF NEXT RECORD 
 CDI      SPACE  4,20 
**        CDI - CHECK CURRENT DEVICE IQFT.
* 
*         COUNT THE ENTRIES IN THE REMAINDER OF THE CURRENT DEVICE
*         IQFT.  IF TRACK LIMIT HAS BEEN REACHED, THE ENTRIES ARE 
*         VERIFIED AND THOSE MEETING SPECIFICATIONS ARE NOTED 
*         ON THE OUTPUT FILE. 
* 
*         ENTRY  (IGCT) = COUNT OF FILES IGNORED ON DEVICE. 
*                (CDIA) .NE. 0 IF TRACK LIMIT REACHED.
*                (CEQP) = CURRENT EST ORDINAL.
* 
*         EXIT   (IGCT) = UPDATED COUNT OF IGNORED FILES. 
*                (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
* 
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 2, 7. 
* 
*         CALLS  BOF, VIE.
* 
*         MACROS READW, WRITEW. 
  
  
 CDI      SUBR               ENTRY/EXIT 
  
*         READ REMAINDER OF OLD IQFT. 
  
 CDI1     BX5    X5-X5       CLEAR ERROR STATUS 
          READW  IQ,IQFE,QFEWL
          NZ     X5,CDIX     IF MASS STORAGE ERROR
          NZ     X1,CDIX     IF EOF/EOI 
  
*         BUILD OUTPUT FILE IF TRACK LIMIT REACHED. 
  
          SA2    CDIA 
          ZR     X2,CDI2     IF TRACK LIMIT NOT REACHED 
          SA1    IQFE+8 
          NG     X1,CDI2     IF LENGTH ERROR
          BX6    X6-X6
          RJ     VIE         VERIFY IQFT ENTRY
          NZ     X1,CDI2     IF NO MATCH
          SX7    TBUF        REWIND POINTERS
          SA7    T+2
          SA7    T+3
          SA2    CEQP        SET CURRENT EQUIPMENT IN ENTRY 
          LX2    48 
          MX0    12 
          SA1    IQFE+1 
          BX6    -X0*X1      CLEAR OLD EST ORDINAL
          BX7    X6+X2
          SA7    A1 
          WRITEW T,IQFE,QFEWL MOVE ENTRY TO BUFFER
          SA2    T+2         SET *OUT* = *IN* 
          SX7    X2 
          SA7    A2+B1
          SX7    BOFE        *TRACK LIMIT - FILE IGNORED* 
          RJ     BOF
  
*         BUILD NEW IQFT. 
  
 CDI2     SA2    IGCT        INCREMENT COUNT
          SX7    X2+B1
          SA7    A2 
          EQ     CDI1        READ NEXT ENTRY
  
 CDIA     CON    0           TRACK LIMIT FLAG 
 CPF      SPACE  4,20 
**        CPF - COPY QUEUED FILE AND ASSOCIATED DATA TO DUMP FILE.
* 
*         CALL ROUTINES TO FORMAT AND COPY THE ROUTE BLOCK, SYSTEM
*         INFORMATION (SYSTEM AND EOI SECTORS) AND THE DATA FOR THE 
*         QUEUED FILE TO THE DUMP FILE ALONG WITH THE CORRESPONDING 
*         CONTROL WORDS.
* 
*         ENTRY  (AQFA) .NE. 0 IF PREVIOUS READ ERROR.
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     .LT. 0, SKIP CURRENT FILE.
*                     .GT. 0, *K* DISPLAY MESSAGE ADDRESS.
* 
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 2, 7. 
* 
*         CALLS  BUP, CSI, DFD, FRB.
  
  
 CPF      SUBR               ENTRY/EXIT 
  
*         SET QUEUED FILE NAME IN CONTROL WORDS.
  
          SA2    T+3         SET FILE NAME
          SA2    X2-QFEWL 
          MX0    24 
          BX6    X0*X2
          SX2    B0+         SET INDEX
 CPF1     SA1    TQCW+X2     INSERT NAME IN CONTROL WORD
          BX1    -X0*X1 
          BX7    X6+X1
          SA7    A1 
          SX2    X2+B1       INCREMENT INDEX
          SX5    X2-TQCWL 
          NZ     X5,CPF1     IF NOT ALL CONTROL WORDS 
          SA1    AQFA 
          NZ     X1,CPF2     IF PREVIOUS READ ERROR 
          SX7    BLANK       SAVE NO ERROR CODE ADDRESS 
          SA7    CPFA 
  
*         COPY DATA TO DUMP FILE. 
  
 CPF2     SX0    B0+         INITIALIZE NUMBER OF WORDS IN BUFFER 
          SX7    DBLL        SET INITIAL BUFFER SEGMENT LIMIT 
          SA7    DBSL 
          RJ     FRB         FORM ROUTE BLOCK 
          RJ     CSI         COPY SYSTEM INFORMATION
          RJ     DFD         DUMP QUEUED FILE DATA
          PL     X5,CPFX     IF NOT SKIP FILE 
          RJ     BUP         BACK UP *IN* POINTER 
          EQ     CPFX 
  
 CPFA     CON    0           ERROR CODE ADDRESS 
 TQCW     SPACE  4
**        TQCW - TABLE OF QDUMP CONTROL WORDS.
  
 TQCW     BSS    0           TABLE OF QDUMP CONTROL WORDS.
 RBCW     VFD    42/0,3/1,3/0,3/0,9/EPBL  ROUTE BLOCK 
 SYCW     VFD    42/0,3/3,3/0,3/0,9/200B  SYSTEM INFORMATION
 DACW     VFD    42/0,3/0,3/0,3/0,9/0     DATA
 ERCW     VFD    42/0,3/7,3/0,3/0,9/0     DUMP ERRORS 
 TQCWL    EQU    *-TQCW 
 CQD      SPACE  4,20 
**        CQD - COPY QUEUE FILES TO DUMP FILE.
* 
*         CALL ROUTINES TO PHYSICALLY DUMP THE FILES SPECIFIED
*         IN A BUFFER OF IQFT ENTRIES TO THE DUMP FILE. 
* 
*         ENTRY  (DSPB) = 0, DUMP INACTIVE QUEUE FILES. 
*                       = 1, DUMP ACTIVE QUEUE FILES. 
*                       = 2, DUMP ALL QUEUE FILES.
*                (DPCT) = COUNT OF FILES DUMPED ON THIS DEVICE. 
*                (PQFA) .NE. 0 IF MORE FILES TO PROCESS.
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6. 
*                B - 6. 
* 
*         CALLS  AQF, BOF, CDI, CPF, EPR, RTF, SPF. 
  
  
 CQD      SUBR               ENTRY/EXIT 
          SX5    AIQF        SET ATTACH INACTIVE FILES
          SA1    DSPB 
          ZR     X1,CQD2     IF DUMP INACTIVE 
          SA1    T           SET *QFM* PARAMETERS IN FET
          RJ     SPF
 CQD1     SX5    AQFF        SET ATTACH ACTIVE FILES
  
*         ATTACH QUEUE FILES THAT MEET ALL SPECIFICATIONS.
  
 CQD2     RJ     AQF         ATTACH FILE
          NG     X5,CQD4     IF SKIP FILE 
          NZ     X5,CQD6     IF ERROR 
          NZ     X6,CQD5     IF END OF BUFFER 
  
*         MOVE QUEUE FILE TO DUMP FILE. 
  
          RJ     CPF         COPY FILE TO DUMP FILE 
          NG     X5,CQD4     IF SKIP FILE 
          NZ     X5,CQD6     IF ERROR 
          RJ     RTF         RETURN FILE
          ZR     X5,CQD3     IF NO ERROR
          SB6    TQEP        SET ERROR TABLE ADDRESS
          RJ     EPR         PROCESS ERROR
          SA1    DSPB 
          NZ     X1,CQD3     IF DUMPING ACTIVE
          SA1    IGCT        DECREMENT IGNORED COUNT
          SX6    X1-1 
          SA6    A1 
  
*         BUILD OUTPUT FILE.
  
 CQD3     SA1    DPCT        INCREMENT DUMPED COUNT 
          SX6    X1+B1
          SA6    A1 
          SA1    CPFA        SET ERROR CODE ADDRESS 
          SX7    X1 
          BX6    X5          SAVE ERROR STATUS
          SA6    CQDA 
          RJ     BOF         BUILD OUTPUT FILE
          SA5    CQDA 
          NG     X5,CQD4     IF SKIP FILE 
          NZ     X5,CQD6     IF RETURN ERROR
 CQD4     SA1    DSPB 
          NZ     X1,CQD1     IF DUMP ACTIVE 
  
*         CHECK FOR END OF FILES. 
  
 CQD5     SX5    B0+         CLEAR ERROR FLAG 
          SA3    PQFA 
          NZ     X3,CQDX     IF MORE FILES TO PROCESS 
 CQD6     SA1    DSPB 
          NZ     X1,CQDX     IF DUMP ACTIVE 
  
*         COUNT REMAINING FILES.
  
          SA2    PQFA 
          ZR     X2,CQDX     IF ALL ENTRIES PROCESSED 
          RJ     CDI         CHECK CURRENT IQFT 
          EQ     CQDX        RETURN 
  
 CQDA     CON    0           RETURN QUEUED FILE ERROR STATUS
 CSI      SPACE  4,20 
**        CSI - COPY SYSTEM INFORMATION TO DUMP FILE. 
* 
*         COPY THE SYSTEM AND EOI SECTORS, ALONG WITH THE SYSTEM
*         INFORMATION CONTROL WORD, TO THE DUMP FILE. 
* 
*         ENTRY  (X0) = NUMBER OF WORDS CURRENTLY IN BUFFER.
*                (SYCW) = SYSTEM INFORMATION CONTROL WORD.
* 
*         EXIT   (X0) = NUMBER OF WORDS IN BUFFER.
* 
*         USES   X - 0, 2, 5, 6, 7. 
*                A - 2, 5, 6, 7.
* 
*         MACROS MOVE.
  
  
 CSI      SUBR               ENTRY/EXIT 
          SX6    X0+B1       INDEX OF CONTROL WORD
          SX0    X6 
          SA6    QCWI 
          MOVE   SBUFL-1,SBUF,WBUF+1+X0 
          SA5    SYCW        GET SYSTEM INFORMATION CONTROL WORD
          SX0    X0+SBUFL-1  UPDATE BUFFER WORD COUNT 
          SA2    QCWI        INDEX FOR CONTROL WORD 
          BX7    X5 
          SA7    WBUF+X2
          EQ     CSIX        RETURN 
 CUF      SPACE  4,20 
**        CUF - CLEAN UP CURRENT FILE AFTER ERROR.
* 
*         INSURE THAT THE CURRENT FILE AND IQFT ENTRY, IF 
*         NECESSARY, ARE REPLACED ON THE SOURCE DEVICE AFTER
*         AN ERROR HAS OCCURED. 
* 
*         ENTRY  (X5) = ERROR MESSAGE ADDRESS.
*                     = 0 IF CURRENTLY PROCESSING AN ERROR. 
*                (A0) = FET ADDRESS.
*                (AQFB) = 0 IF ERROR ATTACHING QUEUED FILE. 
*                (DSPB) = 0, DUMP INACTIVE QUEUE FILES. 
*                       = 1, DUMP ACTIVE QUEUE FILES. 
*                       = 2, DUMP ALL QUEUE FILES.
* 
*         EXIT   (X4) = ERROR MESSAGE ADDRESS.
*                (X5) = 0 IF NO NEW ERROR.
*                     = MESSAGE ADDRESS IF ERROR RETURNING FILE.
* 
*         USES   X - 1, 4, 5, 6, 7. 
*                A - 1, 4, 5, 6, 7. 
* 
*         CALLS  RTF. 
* 
*         MACROS MOVE.
  
 CUF      SUBR               ENTRY/EXIT 
          SX6    X5+         SAVE ERROR ADDRESS 
          SA6    CUFA 
          SA1    AQFB 
          NZ     X1,CUF1     IF NOT ATTACHING ERROR 
          SA5    T+3         *OUT*
          MOVE   QFEWL,X5,IQFE
          SX7    X5+QFEWL    UPDATE *OUT* POINTER 
          SA7    A5 
          BX5    X5-X5       CLEAR ERROR
          EQ     CUF2        RESET ERROR ADDRESS
  
 CUF1     RJ     RTF         RETURN QUEUE FILE TO SOURCE DEVICE 
 CUF2     SA4    CUFA        RESET ERROR ADDRESS
          SA1    DSPB 
          NZ     X1,CUFX     IF DUMPING ACTIVE
          SA1    IGCT        INCREMENT IGNORED COUNT
          SX6    X1+B1
          SA6    A1 
          EQ     CUFX        RETURN 
  
 CUFA     CON    0           ERROR ADDRESS
 DFD      SPACE  4,20 
**        DFD - DUMP QUEUED FILE DATA.
* 
*         COPY ONE QUEUED FILE FROM THE SOURCE DEVICE TO THE
*         DUMP FILE.
* 
*         ENTRY  (X0) = NUMBER OF WORDS CURRENTLY IN BUFFER.
*                (DFBS) = DUMP FILE BLOCK SIZE. 
*                (DACW) = QDUMP DATA CONTROL WORD SKELETON. 
*                (ERCW) = QDUMP DUMP ERRORS CONTROL WORD SKELETON.
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     .LT. 0, SKIP CURRENT FILE.
*                     .GT. 0, *K* DISPLAY MESSAGE ADDRESS.
* 
*         USES   X - ALL. 
*                A - 0, 1, 2, 3, 5, 6, 7. 
*                B - 6. 
* 
*         CALLS  BEC, CER, EPR, PFB, WDB. 
* 
*         MACROS READW. 
  
  
*         CORRECT DUMP FOR FILES WITH ONLY EOI-S. 
  
 DFD13    SA2    DFDE 
          NZ     X2,DFD13.1  IF CONTROL WORD WRITTEN
          SA3    QCWI        CALCULATE WORD COUNT 
          SA1    DACW        QDUMP CONTROL WORD 
          IX6    X0-X3
          SX6    X6+EORC+1   ADD EOR FLAG AND LEVEL 0 TRAILER WORD
          BX7    X1+X6
          SX0    X0+B1       INCREMENT WORD COUNT 
          BX6    X6-X6       SET LEVEL 0 EOR
          SA7    WBUF+X3
          SA6    WBUF+X0
 DFD13.1  SA2    DFDC 
          ZR     X2,DFD14    IF NO EOR/EOF ON QUEUED FILE 
          SX0    X0-1        DECREMENT WORD COUNT 
  
*         BUILD DUMP ERROR CONTROL WORD.
  
 DFD14    SA1    DFDB 
          ZR     X1,DFD15    IF NO DUMP ERRORS
          SA2    ERCW        ADD ERROR COUNT TO CONTROL WORD
          IX6    X2+X1
          SX0    X0+B1       INCREMENT WORD COUNT 
          SA6    WBUF+X0
  
*         WRITE BLOCK TO DUMP FILE. 
  
 DFD15    SX1    X0+         SET NUMBER OF WORDS IN BUFFER
          SA2    DFBS        DUMP FILE BLOCK SIZE 
          IX6    X2-X1
          PL     X6,DFD16    IF ONE OR LESS BLOCKS
          SX1    X2 
 DFD16    RJ     BEC         BUILD EXTERNAL CONTROL WORD
          SX5    X0+         SET NUMBER OF WORDS IN BLOCK 
          MX0    -6          CHECK FOR EXACT MASS STORAGE PRU 
          BX7    -X0*X5 
          SA7    DFDC 
          RJ     WBD         WRITE BLOCK
          NZ     X5,DFD11    IF ERROR 
          SA1    MSFG 
          NZ     X1,DFDX     IF NOT MASS STORAGE
  
*         WRITE EOR IF EXACT MASS STORAGE PRU.
  
          SA2    DFDC 
          NZ     X2,DFDX     IF NOT EXACT PRU 
          SX1    B0+         BUILD EXTERNAL CONTROL WORD
          RJ     BEC
          RJ     WBD         WRITE ZERO LENGTH EOR BLOCK
          NZ     X5,DFD11    IF ERROR 
  
 DFD      SUBR               ENTRY/EXIT 
          BX6    X6-X6       CLEAR FLAGS
          SA6    DFDB 
          SA6    A6+B1
          SA6    A6+1 
          SA6    A6+1 
  
*         READ BLOCK OF DATA. 
  
 DFD1     SX6    X0+B1       SAVE INDEX OF FIRST CONTROL WORD IN BLOCK
          SX0    X6          ADD QDUMP CONTROL WORD 
          SA6    QCWI 
 DFD2     SA0    Q           READ CONTROL WORD
          READW  A0,WBUF,B1 
          NZ     X1,DFD13    IF EOI 
          SX6    B0+         CLEAR CONTROL WORD WRITTEN FLAG
          SA6    DFDE 
          SA1    WBUF        CHECK FOR PARITY ERROR 
          SX5    TCEPA       SET PARITY ERROR CODE
          NG     X1,DFD10    IF PARITY ERROR
          RJ     CER         CHECK FOR OTHER ERROR
          ZR     X5,DFD3     IF NO ERROR
          SX6    X5-TCEPA 
          NZ     X6,DFD10    IF ERROR OTHER THAN PARITY ERROR 
 DFD3     SA1    WBUF        FIND WORD COUNT IN BLOCK 
          SX2    5
          SX3    X1+4        ROUND UP 
          IX5    X3/X2
          READW  Q,WBUF+1+X0,X5+B1  READ REST OF BLOCK
          SA2    DBSL        BUFFER SEGMENT LIMIT 
          IX0    X0+X5       INCREMENT BUFFER WORD COUNT
          IX4    X0-X2
          SX6    X5-100B
          SA6    DFDC        SAVE EOR/EOF STATUS
          ZR     X6,DFD7     IF NO EOR/EOF ON QUEUED FILE 
  
*         DETERMINE IF EOR OR EOF.
  
          SA6    DFDE        SET CONTROL WORD WRITTEN FLAG
          SA3    WBUF+1+X0   CHECK EOR LEVEL
          LX3    12 
          MX1    -12
          BX3    -X1*X3 
          BX7    X3 
          SX1    X3-17B 
          SA5    QCWI        CHECK NUMBER OF WORDS READ 
          IX2    X0-X5
          SX6    B1 
          NZ     X2,DFD4     IF EOR 
          ZR     X1,DFD5     IF EOF 
 DFD4     SA7    A3+         RESET EOR LEVEL NUMBER 
          SA6    DFDC        SET EOR STATUS 
          SX0    X0+1        ADD ON EOR LEVEL CONTROL WORD
          SX4    X4+1 
 DFD5     NZ     X4,DFD7     IF NOT EXACT BLOCK SIZE
          SA1    DFDC        CLEAR EOR/EOF STATUS 
          BX6    X6-X6
          SA6    A1 
          SX7    EOFC        EOF CODE 
          NG     X1,DFD6     IF EOF 
          SX7    EORC        EOR CODE 
 DFD6     SA1    DACW        SET IN CONTROL WORD
          BX7    X1+X7
          SA7    A1 
  
*         WRITE BLOCK TO DUMP FILE. 
  
 DFD7     NG     X4,DFD8     IF DATA READ .LT. BUFFER SEGMENT LIMIT 
          SA0    DACW 
          RJ     PFB         PROCESS FULL BUFFER SEGMENT
          SA1    DACW        RESET CONTROL WORD 
          SA2    QCWI 
          SX7    EOFC        SET EOF CONTROL WORD FOR EXACT BLOCK 
          MX6    42 
          BX6    X6*X1
          BX7    X6+X7
          SA6    A1 
          SA7    WBUF+X2
          NZ     X5,DFDX     IF ERROR 
 DFD8     SA2    DFDC 
          ZR     X2,DFD2     IF NO EOR/EOF ON QUEUED FILE 
  
*         WRITE DUMP CONTROL WORD FOR EOR/EOF BLOCK.
  
          SA3    QCWI 
          SX1    EOFC        SET EOF CODE 
          NG     X2,DFD9     IF EOF 
          IX6    X0-X3       SET EOR CODE PLUS WORD COUNT 
          SX1    X6+EORC
 DFD9     SA2    DACW        QDUMP CONTROL WORD 
          BX6    X2+X1
          SA6    WBUF+X3
          EQ     DFD1 
  
*         PROCESS ERRORS. 
  
 DFD10    SX6    -1          SET READ ERROR FLAG
          SA6    DFDD 
 DFD11    SX7    X5-11B 
          NZ     X7,DFD12    IF NOT SPECIAL MASS STORAGE ERROR
          SA3    A0+6        GET ERROR CODE 
          MX0    -9 
          BX5    -X0*X3 
          SX5    X5+11B      BIAS ERROR CODE
 DFD12    SB6    TCEP        SET ERROR TABLE ADDRESS
          RJ     EPR         PROCESS ERROR
          NZ     X5,DFDX     IF ERROR 
          SA1    DFDD        CHECK ERROR TYPE 
          BX6    X6-X6       CLEAR FLAG 
          SA6    A1 
          ZR     X1,DFDX     IF WRITE ERROR 
          SA7    CPFA        SAVE ERROR CODE ADDRESS
          SA1    DFDB        INCREMENT ERROR COUNT
          SX6    X1+B1
          SA6    A1 
          EQ     DFD3        CONTINUE PROCESSING
  
 DFDB     CON    0           DUMP READ ERROR COUNT
 DFDC     CON    0           EOR/EOF STATUS 
 DFDD     CON    0           READ/WRITE ERROR FLAG
 DFDE     CON    0           CONTROL WORD WRITTEN FLAG
 EPR      SPACE  4,30 
**        EPR - ERROR CODE PROCESSOR. 
* 
*         USE THE GIVEN ERROR CODE TO FIND THE CORRECT ERROR
*         MESSAGE OR PROCESSOR IN THE ERROR TABLES.  IF A PROCESSOR 
*         IS NEEDED, IT IS EXECUTED, THEN CONTROL IS SENT BACK TO 
*         THE CALLING SUBROUTINE. 
* 
*         ENTRY  (X5) = ERROR CODE. 
*                (B6) = ERROR TABLE ADDRESS.
*                (A0) = FET ADDRESS.
*                (DSPB) = 0, DUMP INACTIVE QUEUE FILES. 
*                       = 1, DUMP ACTIVE QUEUE FILES. 
*                       = 2, DUMP ALL QUEUE FILES.
*                (PQFA) = NEXT ENTRY IN QFT BUFFER IF *DSPB* .NE. 0.
*                (ERRA) .NE. 0 IF ALREADY PROCESSING AN ERROR EXIT. 
*                (DQFB) .NE. 0 IF NO QUEUED FILE ATTACHED.
* 
*         EXIT   (X5) = 0 IF TO CONTINUE PROCESSING.
*                     .LT. 0 IF SKIP FILE.
*                     .GT. 0 IF *K* DISPLAY MESSAGE ADDRESS.
*                (X7) = DISPOSITION CODE ADDRESS. 
*                (ERRB) .NE. 0 IF *PO=N* SPECIFIED AND (X5) .GT. 0. 
*                (IGCT) INCREMENTED IF DUMPING INACTIVE.
*                TO *ERR1* IF PROCESSING AN ERROR EXIT OR SECOND ERROR
*                FOUND WHILE PROCESSING FIRST ERROR.
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 5, 6, 7. 
*                B - 5, 6.
* 
*         CALLS  BOF, CDI, CUF, RTF, SQB. 
* 
*         MACROS CLOSER, MESSAGE, RECALL, WRITECW.
  
  
 EPR      SUBR               ENTRY/EXIT 
          SA1    ERRA 
          NZ     X1,ERR1     IF PROCESSING ERROR EXIT 
  
*         CHECK FOR UNKNOWN ERROR CODE. 
  
          SA2    B6-B1       NUMBER OF TABLE ENTRIES
          IX6    X5-X2
          PL     X6,EPR1     IF NOT IN TABLE
  
*         GET ERROR MESSAGE ADDRESS FROM TABLE. 
  
          SA5    B6+X5
          ZR     X5,EPR1     IF DEFAULT MESSAGE TO BE USED
          NG     X5,EPR3     IF PROCESSOR ADDRESS 
          SB6    A5+
 EPR1     SA5    B6          SET ERROR MESSAGE ADDRESS
          MESSAGE X5
          SX2    IQ          CHECK IF ATTACH IQFT ERROR 
          SX1    A0 
          IX6    X2-X1
          ZR     X6,EPR2     IF OLD *IQFT*
          RJ     CUF         CLEAN UP FILE
          NZ     X5,ERR1     IF ERROR 
          SX5    X4+         RESET ORIGINAL ERROR 
 EPR2     SA1    TARA+ARFC
          PL     X1,EPRX     IF *PO=N* NOT SPECIFIED
          SA6    ERRB        SET ABORT FLAG 
          SX5    MES2        *QDUMP ABORTED.* 
          MESSAGE X5
          EQ     EPRX        RETURN 
  
 EPR3     SB5    X5          SET PROCESSOR ADDRESS
          JP     B5          JUMP TO PROCESSOR
  
 EPR4     NZ     X5,ERR1     IF ERROR 
          RJ     BOF         BUILD OUTPUT FILE
          SX5    -1          SET SKIP FILE
          EQ     EPRX        RETURN 
 EDF      SPACE  4
**        EDF - PROCESS DUPLICATE FILE NAME.
  
  
 EDF      BX5    X5-X5       SET NO ERROR MESSAGE 
          RJ     CUF         CLEAN UP FILE
          SX7    BOFF        *DUPLICATE FILE NAME - FILE IGNORED* 
          EQ     EPR4        COMPLETE PROCESSING
 EPE      SPACE  4
**        EPE - PROCESS WRITE PARITY ERRORS.
  
  
 EPE      SX2    Q           CHECK IF READ ERROR
          SX3    A0 
          IX6    X2-X3
          ZR     X6,ERM      IF READ MASS STORAGE ERROR 
          SA1    MSFG 
          ZR     X1,EPE2     IF MASS STORAGE DUMP FILE
  
*         PROCESS TAPE DUMP FILE. 
  
          MX6    1           SET PAUSE BIT
          SA1    B0 
          LX6    13 
          BX6    X1+X6
          SA6    A1+
          MESSAGE MES9,2     *TAPE ERROR - GO,JSN./DROP,JSN.* 
  
*         WAIT FOR GO,JSN. FROM OPERATOR. 
  
 EPE1     RECALL
          SA1    B0          CHECK FOR GO,JSN.
          MX0    1
          LX0    13 
          BX2    X0*X1
          NZ     X2,EPE1     IF GO,JSN. NOT SPECIFIED 
  
*         CLOSE ERRORED REEL. 
  
          RECALL D
          SA1    EBUF        SET PRU SIZE INTO CONTROL WORD 
          SA2    DFBS        DUMP FILE PRU SIZE 
          MX0    -24
          BX1    -X0*X1 
          LX2    24 
          BX6    X1+X2
          SA6    A1 
          SX6    EBUF+3      SET *IN* AND *OUT* 
          SX7    A1 
          SA6    DE+2 
          SA7    DE+3 
          WRITECW DE,R       WRITE END OF VOLUME CONTROL WORD 
          CLOSER D,UNLOAD,R 
          WRITECW D,*        PRESET WRITE FUNCTION
          SX5    B0+         CLEAR ERROR
          EQ     EPRX        RETURN 
  
*         PROCESS MASS STORAGE DUMP FILE. 
  
 EPE2     SA2    DQFB 
          NZ     X2,EPE3     IF NO QUEUED FILE TO RETURN
          RJ     RTF         RETURN FILE
          NZ     X5,ERR1     IF ERROR 
          SA1    DSPB 
          NZ     X1,EPE3     IF DUMPING ACTIVE
          SA1    IGCT        INCREMENT IGNORED COUNT
          SX6    X1+1 
          SA6    A1+
 EPE3     SX5    MES8        *BAD DUMP FILE.* 
          MESSAGE X5
          EQ     EPR2        CHECK FOR *PO=N* SPECIFIED 
 ERM      SPACE  4
**        ERM - PROCESS READ MASS STORAGE ERRORS. 
  
  
 ERM      SA2    TARA+ARFC   CHECK ERRORED FILE PROCESSING STATUS 
          LX2    59-57
          NG     X2,ERM1     IF PROCESSING SELECTED 
  
*         PROCESS READ ERRORS WITH ERRORED FILE PROCESSING DESELECTED.
  
          RJ     RTF         RETURN FILE TO SOURCE DEVICE 
          SX7    BOFB        *READ ERROR - FILE IGNORED*
          SA1    DSPB 
          NZ     X1,EPR4     IF DUMPING ACTIVE
          SA1    IGCT        INCREMENT IGNORED COUNT
          SX6    X1+B1
          SA6    A1 
          EQ     EPR4        COMPLETE PROCESSING
  
*         PROCESS READ ERRORS WITH ERRORED FILE PROCESSING SELECTED.
  
 ERM1     SX5    B0+         CLEAR ERROR
          SX7    BOFC        *READ ERROR - FILE DUMPED* 
          EQ     EPRX        RETURN 
 ESS      SPACE  4
**        ESS - PROCESS INCORRECT SYSTEM SECTOR ERRORS. 
  
  
 ESS      BX5    X5-X5       SET NO ERROR MESSAGE 
          RJ     CUF         CLEAN UP FILE
          SX7    BOFD        *SYSTEM SECTOR ERROR - FILE IGNORED* 
          EQ     EPR4        COMPLETE PROCESSING
 ETL      SPACE  4
**        ETL - PROCESS TRACK LIMIT.
  
  
 ETL      SA1    DQFB 
          NZ     X1,ETL4     IF NO QUEUED FILE TO RETURN
          RJ     RTF         RETURN QUEUE FILE
          NZ     X5,ERR1     IF ERROR 
          SX7    BOFE        *TRACK LIMIT - FILE IGNORED* 
          RJ     BOF         BUILD OUTPUT FILE
          SA2    DSPB 
          ZR     X2,ETL3     IF DUMPING INACTIVE
  
*         EMPTY BUFFER CONTENTS.
  
 ETL1     SA1    T+2         *IN* 
          SA5    A1+B1       *OUT*
          IX7    X1-X5
          ZR     X7,ETL2     IF END OF BUFFER 
          SX6    X5+QFEWL 
          SA6    A5 
          BX7    X7-X7       ZERO FAMILY/MACHINE ID WORD OF IQFT ENTRY
          SA7    X5+9 
          SX7    BOFE        *TRACK LIMIT - FILE IGNORED* 
          RJ     BOF         BUILD OUTPUT FILE
          EQ     ETL1        PROCESS NEXT ENTRY 
  
 ETL2     SA1    PQFA        SET NEXT ENTRY ADDRESS 
          SB6    X1+
          ZR     X1,ETL4     IF ALL QFT ENTRIES PROCESSED 
          RJ     SQB         SEARCH QFT BUFFER
          SA6    PQFA        SAVE STATUS
          EQ     ETL1        PROCESS NEXT ENTRY 
  
*         REWRITE IQFT. 
  
 ETL3     SA1    IGCT        INCREMENT IGNORED COUNT
          SX7    X1+B1
          SA7    A1 
          SX6    B1+         SET TRACK LIMIT FLAG 
          SA6    CDIA 
          RJ     CDI         COPY OLD TO NEW IQFT 
          NZ     X5,ERR1     IF ERROR 
          SX6    B0+         CLEAR TRACK LIMIT AND BUFFER STATUS FLAGS
          SA6    CDIA 
          SA6    PQFA 
  
*         SET FOR RETURN. 
  
 ETL4     SX5    MC07        *TRACK LIMIT*
          MESSAGE X5
          EQ     EPR2        CHECK FOR *PO=N* SPECIFIED 
 ERP$     SPACE  4,30 
**        ERP$ - *READW*/*WRITEW* ERROR PROCESSOR.
* 
*         PROCESS ERRORS FOUND DURING A *READW* OR *WRITEW* CALL. 
* 
*         ENTRY  FROM *COMCCIO*.
*                (X2) = FET ADDRESS.
*                (X7) = ERROR CODE FROM FET.
*                (B6) = ADDRESS IN WORKING BUFFER.
*                (B7) = WORDS LEFT TO TRANSFER. 
*                (DQFB) = 0 IF QUEUED FILE ATTACHED.
* 
*         EXIT   (X5) .NE. 0 IF TRACK LIMIT OR MS PARITY ERROR. 
*                (X5) .EQ. *MES5* IF IQFT READ ERROR. 
*                (X2) = FET ADDRESS IF TAPE WRITE PARITY ERROR. 
*                (B6) = WORKING BUFFER ADDRESS IF TAPE WRITE PARITY.
*                (B7) = WORDS TO TRANSFER IF TAPE WRITE PARITY ERROR. 
*                TO *DQFX* IF NO QUEUED FILE PRESENT ON MASS STORAGE
*                WRITE PARITY ERROR OR TRACK LIMIT. 
*                TO *DFDX* IF QUEUED FILE PRESENT.
*                TO *WTW1* IF WRITE PARITY ERROR. 
*                TO *ERPX$* IF READ PARITY ERROR. 
*                TO *RDW=* IF IQFT READ ERROR.
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 6, 7. 
*                B - 6, 7.
* 
*         CALLS  CER, EPR, IIM. 
* 
*         MACROS MESSAGE, QCALL.
  
  
 ERP$     SX6    X2-Q 
          ZR     X6,ERP2     IF READ PARITY ERROR 
          SX6    X2-IQ
          ZR     X6,ERP3     IF IQFT READ ERROR 
          SX6    X2          SAVE FET ADDRESS AND DATA POINTERS 
          SA6    ERPA 
          SX7    B7 
          SX6    B6+
          SA6    A6+B1
          SA7    A6+B1
  
*         PROCESS ERROR.
  
          SB6    TCEP        SET ERROR TABLE ADDRESS
          RJ     CER         CHECK FOR ERROR
          RJ     EPR         PROCESS ERROR
          NZ     X5,ERP1     IF TRACK LIMIT OR MS PARITY ERROR
  
*         PROCESS TAPE WRITE PARITY ERROR.
  
          SA2    ERPA        RESTORE FET ADDRESS
          SA1    A2+B1       RESTORE DATA POINTERS
          SA3    A1+B1
          SB6    X1+
          SB7    X3 
          EQ     /COMCWTW/WTW1  JUMP BACK INTO ROUTINE
  
*         PROCESS MASS STORAGE PARITY ERROR OR TRACK LIMIT. 
  
 ERP1     SA1    DQFB 
          ZR     X1,DFDX     IF QUEUED FILE PRESENT ON WRITE ERROR
          EQ     DQFX 
  
*         CLEAR READ PARITY STATUS IN FET.
  
 ERP2     SA1    X2          CLEAR ERROR STATUS 
          SX3    17BS10 
          BX6    -X3*X1 
          SA6    A1 
          EQ     ERPX$       RESUME *CIO* FUNCTION
  
 ERP3     SX3    11B
          IX3    X7-X3
          NZ     X3,ERP2     IF NOT SPECIAL MASS STORAGE ERROR
          QCALL  PGQF,IQ     PURGE OLD IQFT FILE
          BX6    X6-X6
          SA6    ATTA 
          SA2    CEQP 
          RJ     IIM
          SX5    MES5        * QUEUES UNRECOVERABLE THIS DEVICE.* 
          MESSAGE  X5 
          EQ     RDW=        RETURN TO CONTINUE PROCESSING
  
 ERPA     CON    0           FET ADDRESS
 ERPB     CON    0           ADDRESS IN WORKING BUFFER
 ERPC     CON    0           WORDS LEFT TO TRANSFER 
 ERR      SPACE  4,20 
**        ERR - ERROR EXIT PROCESSOR. 
* 
*         CALL ROUTINES TO CLEAN UP FILES AND SEND OUT A MESSAGE
*         FOLLOWING AN ERROR EXIT.
* 
*         ENTRY  AT *ERR1* IF SECOND ERROR EXIT OR DOUBLE ERROR.
* 
*         EXIT   (ERRB) .NE. 0 IF TO ABORT AFTER CLEAN UP FINISHED. 
*                TO *QDU3* IF POSSIBLE TO CLEAN UP FILES. 
* 
*         USES   X - 1, 3, 5, 6.
*                A - 1, 6.
* 
*         CALLS  CUF, RAF.
* 
*         MACROS ABORT, EREXIT, MESSAGE.
  
  
 ERR      SX6    B1+         SET ERROR EXIT FLAG
          SA6    ERRA 
          EREXIT ERR1        SET SECOND ERROR EXIT
          RJ     CUF         CLEAN UP FILE
          NZ     X5,ERR1     IF ERROR 
          SX5    MES2        *QDUMP ABORTED.* 
          MESSAGE X5
          SA1    TARA+ARFC
          PL     X1,QDU3     IF *PO=N* NOT SPECIFIED
          SX6    B1+         SET ABORT FLAG 
          SA6    ERRB 
          EQ     QDU3        CLEAN UP FILES 
  
*         ABORT ON SECOND ERROR OR ERROR EXIT.
  
 ERR1     SX3    IQ          RETURN ATTACHED IQFT FILE
          RJ     RAF
          MESSAGE MES10      *QUEUE STATUS INDEFINITE.* 
          MESSAGE MES2       *QDUMP ABORTED.* 
          ABORT 
  
 ERRA     CON    0           ERROR EXIT FLAG
 ERRB     CON    0           ABORT AFTER CLEAN UP (*PO=N* SPECIFIED)
 FRB      SPACE  4,40 
***       THE FOLLOWING FLAGS AND FIELDS ARE SET IN THE ROUTE 
*         BLOCK CREATED BY *QDUMP*. 
* 
*         ROUTE BLOCK     FLAG BIT
*         WORD   BITS       SET    FIELD DESCRIPTION
* 
*         0      59 - 18     X     FILE NAME. 
*         0      6  - 1      X     FORCED ORIGIN TYPE.
*         1      47 - 36           FORMS CODE (FLAG BIT AND FIELD SET 
*                                  IF NOT *INPUT* FILE TYPE). 
*         1      35 - 24           DISPOSITION CODE.
*         1      23 - 21     X     EXTERNAL CHARACTERISTICS CODES.
*         1      20 - 18     X     INTERNAL CHARACTERISTICS CODES.
*         2      23 - 0            TUI. 
*         3      11 - 0      X     PRIORITY (BIT 12 SET ALSO).
*         4      47 - 36     X     FORCED SERVICE CLASS.
*         4      16 - 12     X     REPEAT COUNT.
*         8      59 - 18     X     OWNER USER NAME. 
*         9      59 - 18     X     OWNER FAMILY NAME. 
*         10     59 - 18     X     CREATION USER NAME.
*         11     59 - 18     X     CREATION FAMILY NAME.
* 
*         THE ROUTE TO CENTRAL SITE FLAG BIT IS SET IF THE
*         DESTINATION ROUTING INFORMATION FOR THE FILE CONTAINS 
*         A LOCAL BATCH ID. 
* 
*         IF A CREATION USER NAME EXISTS FOR THE FILE, THE ORIGIN 
*         TYPE AND SERVICE CLASS WILL BE FORCED.
  
**        FRB - FORM ROUTE BLOCK FROM SYSTEM SECTOR.
* 
*         FORM A ROUTE BLOCK USING SYSTEM SECTOR INFORMATION
*         AND COPY THIS BLOCK TO THE DUMP FILE ALONG WITH AN
*         ARITHMETIC CHECKSUM WHICH IS THE SUM OF THE 
*         POPULATION COUNTS OF THE FIVE WORDS IN THE BLOCK. 
* 
*         ENTRY  (X0) = NUMBER OF WORDS CURRENTLY IN BUFFER.
*                (RBCW) = ROUTE BLOCK CONTROL WORD. 
*                (BLOCK) = FIRST WORD OF ROUTE BLOCK. 
* 
*         EXIT   (X0) = NUMBER OF WORDS IN BUFFER.
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 5, 6, 7.
* 
*         CALLS  CBL, GSF.
* 
*         MACROS MOVE.
  
  
 FRB      SUBR               ENTRY/EXIT 
          SX6    X0+1        INDEX OF CONTROL WORD
          SA6    QCWI 
          RJ     CBL         CLEAR ROUTE BLOCK
  
*         SET FILE NAME IN WORD 0.
  
          SX5    IOSS        GET NAME FROM SYSTEM SECTOR
          RJ     GSF
          MX0    24 
          BX7    X0*X6
          SA7    BLOCK
  
*         SET FLAG BITS IN WORD 1.
  
          SX5    IOSS+3*5 
          RJ     GSF
          LX6    18 
          MX0    -6 
          SX7    B1+B1       SET ROUTE TO CENTRAL SITE BIT
          BX3    -X0*X6 
          ZR     X3,FRB1     IF BATCH ID DEFINED
          BX7    X7-X7       CLEAR BIT
 FRB1     SA1    FRBA        FLAG BITS
          BX1    X1+X7       ADD ROUTE TO CENTRAL SITE FLAG 
  
*         SET INTERNAL AND EXTERNAL CODES IN WORD 1.
  
          LX6    24 
          MX0    6
          BX7    X0*X6       ADD INTERNAL CODE AND EXTERNAL CODE
          LX7    24 
          LX0    24 
          BX1    -X0*X1 
          BX1    X1+X7
  
*         SET DISPOSITION CODE IN WORD 1. 
  
          SX5    DCSS        READ DISPOSITION CODE
          RJ     GSF
          MX0    12 
          BX6    X0*X6
          LX6    12 
          SX2    2RIN        CHECK FOR INPUT TYPE 
          BX7    X2-X6
          LX6    24          ADD DISPOSITION CODE 
          BX1    X1+X6
          ZR     X7,FRB2     IF INPUT TYPE
  
*         SET FORMS CODE IN WORD 1. 
  
          SX5    IOSS+3*5+4  READ FORMS CODE FROM SYSTEM SECTOR 
          RJ     GSF
          MX0    12 
          BX6    X0*X6
          LX6    -12
          BX7    X1+X6
          SX6    B1+         SET FORMS CODE BIT 
          LX6    10 
          BX1    X7+X6
 FRB2     BX7    X1 
          SA7    BLOCK+1
  
*         SET ROUTE INFORMATION IN WORD 2.
  
          SX5    IOSS+3*5+1  READ ROUTE INFORMATION FROM SYSTEM SECTOR
          RJ     GSF
          MX0    24 
          BX7    X0*X6
          LX7    24 
          SA7    BLOCK+2
  
*         SET PRIORITY IN WORD 3. 
  
          SX5    PRSS        READ PRIORITY FROM SYSTEM SECTOR 
          RJ     GSF
          MX0    12 
          BX7    X0*X6
          LX7    12 
          SA7    BLOCK+3
  
*         SET REPEAT COUNT IN WORD 4. 
  
          SX5    RCSS        READ REPEAT COUNT FROM SYSTEM SECTOR 
          RJ     GSF
          SA1    BLOCK+4
          MX0    12 
          BX7    X0*X6
          LX7    24 
          BX7    X1+X7
          SA7    A1 
  
*         SET FORCED ORIGIN TYPE AND SERVICE CLASS. 
  
          SX5    ACSS 
          RJ     GSF
          MX0    42 
          BX6    X0*X6
          SX1    EFSC        PRESET ORIGIN DEFAULT FLAG 
          ZR     X6,FRB3     IF NO CREATION USER NAME 
          SA6    BLOCK+10    SET CREATION USER NAME 
          SX5    FMSS        SET CREATION FAMILY NAME 
          RJ     GSF
          SA6    BLOCK+11 
          SX5    IOSS+SCLQ*5 GET SERVICE CLASS AND ORIGIN TYPE
          RJ     GSF
          MX0    -6 
          LX6    6           GET SERVICE CLASS
          BX1    -X0*X6 
          LX6    6           GET ORIGIN TYPE
          BX2    -X0*X6 
          SA5    BLOCK       PLACE ORIGIN TYPE INTO PARAMETER BLOCK 
          LX2    1
          BX7    X5+X2
          SX5    4000B       SET ORIGIN TYPE FLAG 
          BX7    X7+X5
          SA7    A5 
          SA2    BLOCK+1
          LX5    9           SET SERVICE CLASS FLAG 
          BX7    X2+X5
          SA7    A2 
          SA1    FRBB+X1     GET SERVICE CLASS
          SA2    BLOCK+4     ADD TO PARAMETER BLOCK 
          BX7    X1+X2
          SA7    A2 
          SX1    EFCU        SET CREATION FAMILY/USER NAME FLAG 
 FRB3     SX5    OASS        SET OWNER USER NAME
          RJ     GSF
          MX0    42 
          BX6    X0*X6
          ZR     X6,FRB4     IF NO OWNER USER NAME
          SA6    BLOCK+8
          SX5    FOSS        SET OWNER FAMILY NAME
          RJ     GSF
          MX0    42 
          BX6    X0*X6
          SX1    X1+EFOU     SET OWNER FAMILY/USER NAME FLAG
          SA6    BLOCK+9
 FRB4     BX7    X1          SET FLAGS IN PARAMETER BLOCK 
          SA7    BLOCK+7
  
*         GENERATE CHECKSUM OF POPULATION COUNTS. 
  
          SX0    B0+         CHECKSUM 
          SX5    EPBL-1      SET INDEX
 FRB5     SA1    BLOCK+X5    GET ROUTE BLOCK WORD 
          CX2    X1 
          IX0    X0+X2       INCREMENT CHECKSUM 
          SX5    X5-1 
          PL     X5,FRB5     IF NOT ALL OF BLOCK COUNTED
  
*         MOVE ROUTE BLOCK TO BUFFER. 
  
          SA5    QCWI        SET CONTROL WORD INDEX 
          MOVE   EPBL,BLOCK,WBUF+1+X5 
          SX7    X0+         SET CHECKSUM 
          SA7    WBUF+EPBL+X5 
          SX0    X5+EPBL     INCREMENT BUFFER WORD COUNT
  
*         STORE CONTROL WORD IN BUFFER. 
  
          SA1    RBCW        CONTROL WORD 
          BX7    X1 
          SA7    WBUF+X5
          EQ     FRBX        RETURN 
  
 FRBA     CON    FRFN+FRRC+FRFC+FRPR+FRIC+FREC+FREB  FLAG BITS
 FRBB     BSS    0
          LOC    0
          BSS    1           NOT USED 
          LIST   D
 .SCL     HERE
          LIST   *
          LOC    *O 
 GAD      SPACE  4,10 
**        GAD - GET ACCESS LIMITS FOR DEVICE(S) FOR SELECTED FAMILY.
* 
*         ENTRY  (X3) = FAMILY NAME.
* 
*         EXIT   (DVLA) AND (DVUA) RESET TO LIMITS FOR SELECTED FAMILY. 
* 
*         USES   X - 0, 1, 4, 5, 6, 7.
*                A - 1, 4, 5, 6, 7. 
*                B - 6, 7.
  
  
 GAD      SUBR               ENTRY/EXIT 
          MX0    42 
          SX6    8           INITIALIZE DEVICE LEVEL LIMITS 
          SX7    -B1
          SA6    GADA 
          SA7    GADB 
          SA1    TARA+ARDN   CHECK DEVICE NUMBER SELECTION
          ZR     X1,GAD2     IF ALL DEVICES SELECTED
  
*         PROCESS SPECIFIC DEVICE FOR FAMILY. 
  
          SB6    X1          GET EST ORDINAL FOR DEVICE 
          SA1    TDAA+B6     GET DEVICE ACCESS LIMITS 
          MX0    -3 
          BX6    -X0*X1 
          AX1    3
          BX7    -X0*X1 
 GAD1     SA6    DVUA        RESET LIMITS 
          SA7    DVLA 
          EQ     GADX        RETURN 
  
*         PROCESS ALL DEVICES FOR SPECIFIED FAMILY. 
  
 GAD2     SB7    ESMX        SET NUMBER OF ENTRIES TO CHECK 
          SA1    TEQA 
          SB6    B0+         INITIALIZE TABLE INDEX 
 GAD3     BX1    X0*X1       GET FAMILY NAME
          BX4    X1-X3
          ZR     X4,GAD5     IF DEVICE FOUND
 GAD4     SA1    A1+B1       GET NEXT DEVICE ENTRY
          SB7    B7-B1
          SB6    B6+1        INCREMENT TABLE INDEX
          PL     B7,GAD3     IF NOT END OF DEVICES
          SA1    GADA        RETURN DEVICE LIMITS 
          SA4    GADB 
          BX6    X4 
          BX7    X1 
          EQ     GAD1        RESET LIMITS 
  
 GAD5     SA4    TDAA+B6     GET ACCESS LEVELS FOR DEVICE 
          MX1    -3 
          BX6    -X1*X4 
          LX4    -3 
          BX7    -X1*X4 
          SA4    GADA        COMPARE WITH CURRENT LIMITS
          SA5    GADB 
          IX4    X7-X4
          IX5    X5-X6
          NG     X4,GAD6     IF NEW LEVEL IS LOWER
          EQ     GAD7        CHECK UPPER LEVEL
  
 GAD6     SA7    A4+         SET NEW LOWER LEVEL LIMIT
 GAD7     PL     X5,GAD4     IF NEW LEVEL NOT HIGHER
          SA6    A5+         SET NEW UPPER LEVEL LIMIT
          EQ     GAD4        CHECK NEXT ENTRY 
  
 GADA     BSS    1           CURRENT LOWER LEVEL LIMIT
 GADB     BSS    1           CURRENT UPPER LEVEL LIMIT
 GSF      SPACE  4,20 
**        GSF - GET SYSTEM SECTOR FIELD.
* 
*         RETURN 60 BITS OF DATA FROM THE SYSTEM SECTOR WITH
*         THE SPECIFIED FIELD LEFT JUSTIFIED IN THE WORD. 
* 
*         ENTRY  (X5) = ADDRESS OF FIELD BIASED BY *BFMS*+2.
*                (SBUF) = SYSTEM SECTOR FIRST WORD. 
* 
*         EXIT   (X6) = FIELD LEFT JUSTIFIED. 
* 
*         USES   X - 0, 2, 3, 4, 5, 6, 7. 
*                A - 4, 5.
*                B - 5, 6.
  
  
 GSF      SUBR               ENTRY/EXIT 
          SX4    X5-BFMS-2   ADJUST ADDRESS 
          SX3    5           CONVERT TO CM ADDRESS
          SX5    X4+
          SX2    X3 
          IX6    X4/X3
          IX7    X6*X2
          IX5    X5-X7       GET BYTE COUNT 
  
*         FORM MASK.
  
          SX3    12 
          SX2    60 
          IX3    X3*X5
          MX0    1
          SA4    X6+SBUF     GET FIRST WORD 
          SB6    X3          SET SHIFT COUNT
          IX3    X2-X3       SET SHIFT COUNT = 60D - COUNT
          SA5    A4+B1
          SB5    X3-1 
          AX0    B5,X0       FORM MASK
  
*         GET DATA FROM WORDS.
  
          LX4    B6,X4       POSITION WORDS 
          LX5    B6,X5
          BX6    X0*X4       MASK UPPER DATA
          BX7    -X0*X5      MASK LOWER DATA
          BX6    X6+X7       MERGE DATA 
          EQ     GSFX 
 IDM      SPACE  4,20 
**        IDM - ISSUE DAYFILE MESSAGES. 
* 
*         FORMAT AND ISSUE MESSAGES APPLICABLE TO THE COMPLETED 
*         QUEUE OPERATION.
* 
*         ENTRY  (DPCT) = COUNT OF FILES DUMPED ON DEVICE.
*                (IGCT) = COUNT OF FILES IGNORED. 
*                (CEQP) = CURRENT EQUIPMENT.
*                (DSPB) = 0 IF DUMPING INACTIVE.
* 
*         EXIT   (DPCT) = (IGCT) = 0. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
* 
*         CALLS  CDD, COD, SFN. 
* 
*         MACROS MESSAGE. 
  
  
 IDM      SUBR               ENTRY/EXIT 
  
*         SET INDEX INTO MESSAGE TABLE. 
  
          SA1    DSPB 
          SX6    B1+
          NZ     X1,IDM1     IF DUMPING ACTIVE
          SX6    B0+
  
*         CHECK DUMPED FILE COUNT.
  
 IDM1     SA5    TFCM+X6     GET MESSAGE ADDRESS
          SA1    DPCT        DUMPED FILE COUNT
          ZR     X1,IDM3     IF NO COUNT
  
*         SET UP MESSAGE. 
  
 IDM2     BX6    X6-X6       CLEAR COUNT
          SA6    A1 
          RJ     CDD         CONVERT COUNT
          LX6    30 
          SA5    X5 
          MX0    -30
          BX6    X0*X6
          SA3    CEQP        CURRENT EQUIPMENT
          SA4    TEQA+X3
          BX5    -X0*X5 
          MX0    42 
          IX6    X6+X5
          BX1    X0*X4       FAMILY NAME
          SA6    A5 
          RJ     SFN         SPACE FILL 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
  
*         CHECK IGNORED COUNT.
  
 IDM3     SA1    IGCT 
          ZR     X1,IDMX     IF NO COUNT
          SA5    TFCM+2      GET IGNORED MESSAGE ADDRESS
          EQ     IDM2        SET UP IGNORED MESSAGE 
 TFCM     SPACE  4
 TFCM     BSS    0           FILE COUNT MESSAGE TABLE 
          CON    MSG1        INACTIVE DUMPED
          CON    MSG2        ACTIVE DUMPED
          CON    MSG3        IGNORED
  
  
 MSG1     DATA   C* XXXX FILES DUMPED(I) DNYY  FM AAAAAAA.* 
 MSG2     DATA   C* XXXX FILES DUMPED(A) DNYY  FM AAAAAAA.* 
 MSG3     DATA   C* XXXX FILES IGNORED   DNYY  FM AAAAAAA.* 
 IIM      SPACE  4,20 
**        IIM - ISSUE IQFT ERROR MESSAGE. 
* 
*         SET UP AND ISSUE THE MESSAGE * IQFT FILE ERROR DN XX
*         FAMILY AAAAAAA.* TO THE DAYFILE.
* 
*         ENTRY  (X2) = IQFT EST ORDINAL. 
* 
*         USES   X - 0, 1, 4, 6, 7. 
*                A - 1, 4, 6, 7.
* 
*         CALLS  COD, SFN.
* 
*         MACROS MESSAGE. 
  
  
 IIM      SUBR               ENTRY/EXIT 
  
*         SET FAMILY NAME IN MESSAGE. 
  
          SA4    TEQA+X2     FAMILY NAME
          MX0    42 
          BX1    X0*X4
          RJ     SFN         SPACE FILL NAME
          SA1    IIMA+3      SET IN MESSAGE 
          BX1    -X0*X1 
          BX6    X0*X6
          BX7    X1+X6
          SA7    A1 
  
*         SET DEVICE NUMBER IN MESSAGE. 
  
          LX4    -12         DEVICE NUMBER
          MX0    -6 
          BX1    -X0*X4 
          RJ     COD         CONVERT TO DISPLAY CODE
          SA1    IIMA+2      SET IN MESSAGE 
          MX0    12 
          BX4    X0*X4
          BX1    -X0*X1 
          BX6    X1+X4
          SA6    A1+
          MESSAGE IIMA       * IQFT FILE ERROR DN XX FAMILY AAAAAAA.* 
          EQ     IIMX        RETURN 
  
 IIMA     DATA   C* IQFT FILE ERROR DN XX FAMILY AAAAAAA.*
 PFB      SPACE  4,20 
**        PFB - PROCESS FULL BLOCK OF DATA. 
* 
*         WRITE ONE FULL BLOCK OF DATA TO THE DUMP FILE AND 
*         SET UP THE BUFFER AND POINTERS FOR THE NEXT BLOCK.
* 
*         ENTRY  (X4) = NUMBER OF EXTRA WORDS IN BUFFER.
*                (A0) = CONTROL WORD ADDRESS. 
*                (QCWI) = CONTROL WORD BUFFER INDEX.
*                (DBSL) = NUMBER OF WORDS OF FULL BUFFER SEGMENTS.
*                (DFBS) = MAXIMUM NUMBER OF WORDS IN BLOCK. 
* 
*         EXIT   (X0) = NUMBER OF WORDS AT TOP OF BUFFER. 
*                (QWCI) = NEW CONTROL WORD BUFFER INDEX.
*                (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF WRITE ERROR. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 3, 5, 6, 7.
*                B - 6. 
* 
*         CALLS  BEC, EPR, WBD. 
* 
*         MACROS MOVE.
  
  
*         SET UP NEXT BUFFER SEGMENT. 
  
 PFB3     MOVE   X4,WBUF+X5+1,WBUF+X5+2  ALLOW FOR QDUMP CONTROL WORD 
          SX6    X5+1 
          SX5    B0+         INDICATE NO ERROR
 PFB4     SA6    QCWI        UPDATE CONTROL WORD INDEX
          SX0    X0+1        ADD FOR QDUMP CONTROL WORD 
          SX7    X6+DBLL-1   UPDATE BUFFER SEGMENT LIMIT
          SA7    DBSL 
  
 PFB      SUBR               ENTRY/EXIT 
  
*         BUILD CONTROL WORDS.
  
          SA2    QCWI        BUILD QDUMP CONTROL WORD 
          SA5    DBSL        BUFFER SEGMENT LIMIT 
          IX1    X5-X2       NUMBER OF WORDS SINCE CONTROL WORD 
          SA3    A0 
          MX6    51 
          BX3    X6*X3
          IX6    X3+X1
          SA3    DBLS        DUMP BLOCK LOGICAL SIZE
          SA6    WBUF+X2
          IX3    X5-X3
          NG     X3,PFB3     IF BUFFER SEGMENT (BUFFER NOT FULL)
          SA1    DFBS        WORDS IN DUMP FILE BLOCK 
          RJ     BEC         BUILD EXTERNAL CONTROL WORD
  
*         WRITE BLOCK OF DATA.
  
          SA5    DBSL        BUFFER SEGMENT LIMIT 
          BX7    X4          SAVE WORD COUNT
          SA7    PFBA 
          RJ     WBD         WRITE BLOCK TO DUMP FILE 
          ZR     X5,PFB2     IF NO ERROR
  
*         PROCESS ERRORS. 
  
          SX7    X5-11B 
          NZ     X7,PFB1     IF NOT SPECIAL MASS STORAGE ERROR
          SA3    D+6         GET ERROR CODE 
          MX0    -9 
          BX5    -X0*X3 
          SX5    X5+11B      BIAS ERROR CODE
 PFB1     SB6    TCEP        SET ERROR TABLE ADDRESS
          RJ     EPR         PROCESS ERROR
          NZ     X5,PFBX     IF ERROR 
  
*         SET BUFFER FOR BEGINNING OF NEXT BLOCK. 
  
 PFB2     SA1    PFBA        RESTORE REMAINING WORD COUNT 
          SA2    DBLS        DUMP BLOCK LOGICAL SIZE
          SX0    X1 
          MOVE   X0,WBUF+X2+1,WBUF+2  MOVE WORDS TO TOP OF BUFFER 
          SX6    B1          SET INDEX OF CONTROL WORD IN NEXT BLOCK
          EQ     PFB4        SET POINTERS AND RETURN
  
 PFBA     CON    0           REMAINING WORD COUNTS
 PQF      SPACE  4,30 
**        PQF - PROCESS QUEUE FILES.
* 
*         CALL ROUTINES TO ATTACH, READ AND SEARCH THE IQFT 
*         FILE FOR INACTIVE OR QFT FOR ACTIVE QUEUE FILES THAT
*         MEET THE SPECIFICATIONS OF THE *K* DISPLAY INPUT AND
*         DUMP THOSE FILES. 
* 
*         ENTRY  (DSPB) = 0, DUMP INACTIVE QUEUE FILES. 
*                       = 1, DUMP ACTIVE QUEUE FILES. 
*                       = 2, DUMP ALL QUEUE FILES.
*                (CEQP) = CURRENT EQUIPMENT.
*                (X0) = 0 IF INITIAL CALL ON ACTIVE FILES.
*                     = 1 IF NON-INITIAL CALL.
*                (B6) = QFT BUFFER ADDRESS IF NON-INITIAL CALL. 
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
* 
*         USES   X - 1, 2, 3, 5.
*                A - 0, 1, 2, 6.
*                B - 6. 
* 
*         CALLS  ATT, CER, CQD, EPR, IIM, RAF, RQT, SIB, SQB. 
* 
*         MACROS READEI, RECALL.
  
  
 PQF6     SA2    CEQP 
          RJ     IIM         ISSUE IQFT ERROR MESSAGE 
          RJ     CER         CLEAR ERROR
          SB6    TQEP        SET ERROR TABLE ADDRESS
          RJ     EPR         PROCESS ERROR
 PQF7     BX5    X5-X5       CLEAR ERROR TO CONTINUE
  
 PQF      SUBR               ENTRY/EXIT 
          SA1    DSPB 
          ZR     X1,PQF2     IF DUMP INACTIVE FILES 
          NZ     X0,PQF1     IF NON-INITIAL CALL
  
*         SEARCH QFT FOR QUEUE FILES TO DUMP. 
  
          RJ     RQT         READ QFT 
          SB6    RBUF+QFTE   SET QFT BUFFER ADDRESS 
 PQF1     RJ     SQB         SEARCH QFT BUFFER ON SPECIFIED OPTIONS 
          SA6    PQFA        SAVE END OF BUFFER STATUS
          SA1    T+2
          SA2    A1+B1
          IX5    X1-X2       *IN* - *OUT* 
          ZR     X5,PQFX     IF BUFFER EMPTY
          EQ     PQF4        COPY QUEUE FILES TO DESTINATION DEVICE 
  
*         RETURN IQFT FILE. 
  
 PQF2     RECALL Q
          RECALL D
          SX3    IQ          RETURN ATTACHED IQFT FILE
          RJ     RAF
  
*         ATTACH AND READ IQFT. 
  
          SA2    CEQP        CURRENT EST ORDINAL
          SA1    TEQA+X2     CHECK FOR IQFT 
          LX1    59-0 
          BX5    X5-X5       CLEAR ERROR FLAG 
          PL     X1,PQFX     IF NO IQFT ON DEVICE 
          SA0    X3 
          RJ     ATT         ATTACH IQFT FILE 
          NZ     X5,PQF6     IF ERROR 
          READEI IQ,R        READ IQFT
  
*         SEARCH IQFT FOR QUEUE FILES TO DUMP.
  
 PQF3     RJ     SIB         SEARCH IQFT BUFFER ON SPECIFIED OPTIONS
          SA6    PQFA        SAVE END OF BUFFER STATUS
          NZ     X5,PQF5     IF ERROR 
 PQF4     RJ     CQD         COPY QUEUE FILES TO DESTINATION FILE 
  
*         CHECK FOR MORE TABLE TO SEARCH. 
  
          NZ     X5,PQF5     IF ERROR 
          SA1    PQFA 
          SB6    X1+         SET NEXT TABLE ADDRESS 
          ZR     X1,PQFX     IF ENTIRE TABLE SEARCHED 
          SA2    DSPB 
          ZR     X2,PQF3     IF DUMP INACTIVE FILES 
          EQ     PQF1        CONTINUE QFT SEARCH
  
 PQF5     SX1    MES5 
          IX1    X5-X1
          NZ     X1,PQF7     IF IQFT READ ERROR 
          EQ     PQFX        RETURN 
  
 PQFA     CON    0           END OF BUFFER STATUS 
 RTF      SPACE  4,20 
**        RTF - RETURN LOCAL FILE.
* 
*         RETURN THE QUEUED FILE BACK TO THE SOURCE DEVICE. 
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = ERROR CODE IF AN ERROR. 
* 
*         USES   X - 0, 1, 5, 6, 7. 
*                A - 0, 1, 5, 6, 7. 
* 
*         CALLS  CBL, CER.
* 
*         MACROS QCALL, RECALL, ROUTE.
  
  
*         RETURN ACTIVE QUEUED FILE.
  
 RTF1     RJ     CBL         CLEAR ROUTE BLOCK
          SA1    T+3         SET UP ROUTE BLOCK 
          SA1    X1-QFEWL 
          MX0    24 
          BX6    X0*X1
          SA6    BLOCK
          SA1    RTFA        SET EXTENDED BLOCK PRESENT FLAG
          BX6    X1 
          SA6    A6+B1
          SA1    RTFB        SET SPECIAL REQUEUE OPERATION FLAG 
          BX7    X1 
          SA7    BLOCK+7
          BX5    X5-X5       CLEAR ERROR
          ROUTE  BLOCK,RECALL 
  
 RTF      SUBR               ENTRY/EXIT 
          RECALL Q           MAKE QUEUED FILE FET QUIET BEFORE RETURN 
          SA1    DSPB 
          NZ     X1,RTF1     IF DUMPING ACTIVE FILES
  
*         RETURN INACTIVE QUEUED FILE.
  
          SA5    T+3         SET BACK *OUT* POINTER 
          SX7    X5-QFEWL 
          SA7    A5+
          SA0    T
          QCALL  RIQF,T 
          SX7    X5          UPDATE *OUT* POINTER 
          SA7    A5 
          RJ     CER         CHECK FOR ERROR
          EQ     RTFX        RETURN 
  
  
 RTFA     VFD    42/0,18/FREB  EXTENDED BLOCK PRESENT FLAG
 RTFB     VFD    42/0,18/EFRQ  SPECIAL REQUEUE OPERATION FLAG 
 SIB      SPACE  4,20 
**        SIB - SEARCH IQFT BUFFER ON SPECIFIED OPTIONS.
* 
*         SEARCH THE IQFT FOR QUEUE FILES THAT MEET THE 
*         SPECIFICATIONS GIVEN BY THE *K* DISPLAY INPUT AND 
*         RETURN WHEN ONE IS FOUND THAT DOES. 
* 
*         ENTRY  (CEQP) = CURRENT EQUIPMENT.
* 
*         EXIT   (X6) = 1 IF MORE BUFFER TO SEARCH. 
*                     = 0 IF ENTIRE BUFFER SEARCHED.
*                (IGCT) = NUMBER OF FILES IGNORED ON DEVICE.
*                (IQFE) = FIRST WORD OF IQFT ENTRY. 
*                (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR
* 
*         USES   X - 0, 2, 3, 4, 5, 6, 7. 
*                A - 2, 3, 7. 
* 
*         CALLS  CLD, PLE, VAF, VIE.
* 
*         MACROS READW, WRITEW. 
  
  
 SIB4     BX6    X6-X6
  
 SIB      SUBR               ENTRY/EXIT 
          SX7    TBUF        REWIND POINTERS
          SA7    T+2
          SA7    A7+B1
          EQ     SIB3        VERIFY IQFT ENTRY
  
*         PROCESS FILES NOT MEETING CRITERIA. 
  
 SIB1     RJ     PLE         PROCESS LENGTH ERROR 
 SIB2     SA2    IGCT        INCREMENT IGNORED FILE COUNT 
          SX7    X2+B1
          SA7    A2 
  
*         VERIFY IQFT ENTRY.
  
 SIB3     BX5    X5-X5       CLEAR ERROR STATUS 
          READW  IQ,IQFE,QFEWL
          NZ     X5,SIBX     IF IQFT READ ERROR 
          NZ     X1,SIB4     IF EOF/EOI 
          SA2    IQFE+8 
          NG     X2,SIB1     IF LENGTH ERROR
          SA3    IQFE+2      CHECK LOGICAL IDENTIFIER 
          SX4    B0+         SET NO NEED TO CHECK FOR LID IN TABLE
          RJ     CLD
          NZ     X3,SIB2     IF NO MATCH
          SA3    IQFE+INSQ   GET ACCESS LEVEL OF FILE 
          RJ     VAF         VALIDATE ACCESS LEVEL
          NZ     X1,SIB2     IF FILE NOT SELECTED 
          SX6    B0+         SET ACTIVATE REQUEST 
          RJ     VIE         VERIFY IQFT ENTRY
          NZ     X1,SIB2     IF NO MATCH
          SA2    CEQP        SET CURRENT EQUIPMENT IN ENTRY 
          LX2    48 
          MX0    12 
          SA3    IQFE+1 
          BX6    -X0*X3 
          BX7    X6+X2
          SA7    A3 
  
*         MOVE ENTRY TO BUFFER. 
  
          WRITEW T,IQFE,QFEWL 
          SX6    B1          SET MORE TO PROCESS
          EQ     SIBX        RETURN 
 SQB      SPACE  4,20 
**        SQB - SEARCH QFT BUFFER ON SPECIFIED OPTIONS. 
* 
*         SEARCH THE QFT FOR QUEUE FILES THAT MEET THE
*         SPECIFICATIONS GIVEN BY THE *K* DISPLAY INPUT AND 
*         BUILD A PSEUDO IQFT ENTRY IN THE TEMPORARY IQFT 
*         BUFFER FOR THOSE THAT DO. 
* 
*         ENTRY  (B6) = BUFFER ADDRESS OF NEXT ENTRY TO SEARCH. 
*                (QFTS) = QFT LENGTH. 
*                (CEQP) = CURRENT EQUIPMENT.
* 
*         EXIT   (X6) = 0 IF ENTIRE BUFFER SEARCHED.
*                     = ADDRESS OF NEXT ENTRY OTHERWISE.
* 
*         USES   X - 0, 1, 3, 4, 5, 6, 7. 
*                A - 3, 4, 5, 6, 7. 
*                B - 3, 6.
* 
*         CALLS  CLD, VAF, VQE. 
* 
*         MACROS MOVE.
  
  
 SQB4     SX6    B6          SET ADDRESS OF NEXT ENTRY
  
 SQB      SUBR               ENTRY/EXIT 
          SX7    TBUF        REWIND POINTERS
          SA7    T+2
          SA7    A7+B1
          BX5    X5-X5       PRESET NOT FULL BUFFER 
  
*         VERIFY QFT ENTRY. 
  
 SQB1     NG     X5,SQB4     IF FULL BUFFER 
          SA4    B6          READ QFT ENTRY 
          MX0    -12         CLEAR LINKAGE FIELD
          BX3    X0*X4
          ZR     X3,SQB3     IF EMPTY QFT SLOT
          LX4    59-1 
          NG     X4,SQB3     IF ATTACHED TO A JOB 
          SX4    B0          SET NO NEED TO CHECK FOR LID IN TABLE
          SA3    B6+2        CHECK LOGICAL IDENTIFIER 
          RJ     CLD
          NZ     X3,SQB3     IF NO MATCH
          SA3    B6+INSQ     GET ACCESS LEVEL 
          RJ     VAF         VALIDATE ACCESS LEVEL OF FILE
          NZ     X1,SQB3     IF FILE NOT SELECTED 
          SX1    B6+         SET QFT ADDRESS
          RJ     VQE         VERIFY QFT ENTRY 
          NZ     X1,SQB3     IF NO MATCH
          SA3    CEQP        SET CURRENT EQUIPMENT
          IX7    X3-X2
          NZ     X7,SQB3     IF NOT CORRECT EQUIPMENT 
  
*         MOVE PSEUDO IQFT ENTRY TO BUFFER. 
  
          SA5    T+2         *IN* 
          SX6    B6-RBUF     SET QFT ORDINAL IN ENTRY 
          SX1    QFTE 
          IX6    X6/X1
          SA6    X5+QFEWL-1 
          SB3    QFEWL-QFTE-1  NUMBER OF WORDS TO CLEAR 
          BX6    X6-X6
 SQB2     SB3    B3-B1
          SA6    A6-B1
          NZ     B3,SQB2     IF MORE WORDS TO CLEAR 
          MOVE   QFTE,B6,X5 
          SX7    X5+QFEWL    UPDATE *IN* POINTER
          SA7    A5+
          SA3    A5+2        *LIMIT*
          SX3    X3          CHECK FOR FULL BUFFER
          IX6    X3-X7
          SX5    X6-QFEWL 
  
*         CHECK FOR END OF QFT. 
  
 SQB3     SB6    B6+QFTE     SET NEXT ENTRY ADDRESS 
          SA3    QFTS        QFT LENGTH 
          SX6    RBUF+X3
          SX3    B6+QFTE
          IX4    X3-X6
          BX6    X6-X6       SET BUFFER SEARCHED
          NG     X4,SQB1     IF NOT END OF QFT
          ZR     X4,SQB1     IF NOT END OF QFT
          EQ     SQBX        RETURN 
 VAF      SPACE  4,15 
**        VAF - VALIDATE ACCESS LEVEL OF FILE.
* 
*         CALL *CAF* TO CHECK ACCESS LEVEL OF FILE. 
* 
*         ENTRY  (A3) = ADDRESS OF *INSQ* WORD OF QFT ENTRY OF FILE.
* 
*         EXIT   (X1) = 0, IF FILE SELECTED.
* 
*         USES   X - 0, 1, 2, 4.
*                A - 1, 2, 4. 
*                B - 2. 
* 
*         CALLS  CAF. 
  
  
 VAF      SUBR               ENTRY/EXIT 
          SB2    B1+         FORCE CHECK OF ORIGIN TYPE ACCESS LIMITS 
          SA4    ALFG 
          SA2    DVLA        PRESET TO USE DEVICE ACCESS LEVEL LIMITS 
          SA1    DVUA 
          ZR     X4,VAF1     IF DEVICE LEVELS TO BE USED
          SA2    TARA+ARLA   USE ACCESS LEVELS FROM ARGUMENT TABLE
          SA1    TARA+ARUA
 VAF1     RJ     CAF         CHECK ACCESS LEVEL OF FILE 
          EQ     VAFX        RETURN 
 WBD      SPACE  4,20 
**        WBD - WRITE BLOCK OF DATA TO DUMP FILE. 
* 
*         WRITE ONE BLOCK OF DATA TO THE DUMP FILE USING CONTROL
*         WORDS AND CHECK FOR WRITE ERRORS. 
* 
*         ENTRY  (X5) = NUMBER OF WORDS IN BUFFER.
*                (DFBS) = DUMP FILE BLOCK SIZE. 
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     .NE. 0, ERROR CODE. 
*                (A0) = FET ADDRESS OF DUMP FILE. 
* 
*         USES   X - ALL. 
*                A - 0, 1, 2, 4, 6, 7.
* 
*         CALLS  BEC, CER.
* 
*         MACROS WRITEW.
  
  
 WBD      SUBR               ENTRY/EXIT 
          SA2    DFBS        DUMP FILE BLOCK SIZE 
          SX4    B0+         CLEAR INDEX
          BX6    X2 
          SA6    WBDB 
          IX7    X5-X6
          PL     X7,WBD1     IF AT LEAST ONE BLOCK SIZE 
          SX6    X5          SET NUMBER OF WORDS IN BUFFER
          SA6    A6 
 WBD1     SA1    WBUF+1+X6   SAVE WORD FOLLOWING BLOCK
          BX6    X1 
          BX7    X7-X7       INSERT TRAILER CONTROL WORD
          SA6    WBDA 
          SA7    A1+
  
*         WRITE BLOCK TO DUMP FILE. 
  
          SA2    DFBS        DUMP FILE BLOCK SIZE 
          IX6    X5-X2
          SX0    X2 
          PL     X6,WBD2     IF AT LEAST ONE BLOCK SIZE LEFT
          SX0    X5+
 WBD2     SA0    D
          WRITEW A0,WBUF+X4,X0+2
          SX3    X5          SAVE BLOCK WORD COUNT
  
*         RESTORE DESTROYED WORD. 
  
          SA1    WBDA        RESTORE WORD FOLLOWING BLOCK 
          BX6    X1 
          SA2    WBDB 
          SA6    WBUF+1+X2
          RJ     CER         CHECK FOR ERROR
          SA1    MSFG 
          NZ     X1,WBDX     IF NOT MASS STORAGE
          NZ     X5,WBDX     IF ERROR 
  
*         PROCESS MASS STORAGE BLOCK. 
  
          IX0    X3-X0       SET REMAINING WORD COUNT 
          ZR     X0,WBDX     IF END OF DUMP BLOCK 
          SA1    DFBS        BUILD EXTERNAL CONTROL WORD
          IX7    X0-X1
          PL     X7,WBD3     IF AT LEAST ONE PRU LEFT 
          SX1    X0 
 WBD3     RJ     BEC
          SA1    WBUF        SET CONTROL WORD IN BUFFER 
          SA4    WBDB        SET INDEX FOR NEXT PRU 
          BX7    X1 
          SA7    WBUF+X4
          IX6    X4+X5
          SA6    A4 
          SX5    X0          SET WORD COUNT 
          EQ     WBD1        PROCESS NEXT BLOCK 
  
 WBDA     CON    0           WORD FOLLOWING BLOCK OF DATA 
 WBDB     CON    0           INDEX FOR WORD FOLLOWING BLOCK 
          TITLE  ERROR PROCESSING TABLES. 
**        TCEP - TABLE OF *CIO* ERROR PROCESSING. 
* 
*         INDEX INTO TABLE IS *CIO* ERROR CODE IF FET+0 CODE IS 1 
*         OR 2.  IF FET+0 CODE IS 11B, INDEX INTO TABLE IS ERROR
*         CODE BIASED BY 11B. 
  
  
          CON    21B         NUMBER OF TABLE ENTRIES
 TCEP     BSS    0           TABLE OF *CIO* ERROR PROCESSING
          LOC    0
          CON    MC00        *CIO* ERROR
          VFD    1/1,59/ETL  TRACK LIMIT
 TCEPA    VFD    1/1,59/EPE  PARITY ERROR 
          BSSZ   7
          VFD    1/1,59/EPE  PARITY ERROR 
          CON    MC02        ADDRESS ERROR
          CON    MC03        DEVICE STATUS ERROR
          CON    MC04        FUNCTION REJECT ERROR
          CON    MC05        DEVICE RESERVED
          CON    MC06        DEVICE NOT READY 
          VFD    1/1,59/ETL  TRACK LIMIT
          LOC    *O 
          SPACE  4
**        TQEP - TABLE OF *QFM* ERROR PROCESSING. 
* 
*         INDEX INTO TABLE IS *QFM* ERROR CODE. 
  
  
          CON    TQEPL       NUMBER OF TABLE ENTRIES
 TQEP     BSS    0           TABLE OF *QFM* ERROR PROCESSING
          LOC    0
          CON    MQ00        *QFM* ERROR
 FNFE     CON    MQ01        FILE NOT FOUND 
 FAIE     CON    MQ02        FILE ALREADY INTERLOCKED 
 TASE     CON    0           IQFT TRACK ALREADY ASSIGNED
 FTHE     CON    MQ04        FNT/QFT FULL 
 INSE     VFD    1/1,59/ESS  INCORRECT SYSTEM SECTOR
 RMSE     VFD    1/1,59/ERM  RMS ERROR
          BSSZ   2
 DUNE     CON    MQ03        DEVICE UNAVAILABLE 
          BSSZ   4
 DFNE     VFD    1/1,59/EDF  DUPLICATE FILE NAME
 TQEPL    EQU    *
          LOC    *O 
          TITLE  OPERATOR/DAYFILE AND ERROR MESSAGES. 
**        OPERATOR/DAYFILE MESSAGES.
  
 MES1     DATA   C* QDUMP COMPLETE.              *
 MES2     DATA   C* QDUMP ABORTED.               *
 MES3     DATA   C* INCORRECT DUMP REQUESTED.    *
 MES4     DATA   C* FILE NAME CONFLICT - FILE XXXXXXX.* 
 MES5     DATA   C* QUEUES UNRECOVERABLE THIS DEVICE.*
 MES6     DATA   C* NO OUTPUT FILE EXISTS.       *
 MES7     DATA   C* OUTPUT FILE RELEASED.        *
 MES8     DATA   C* BAD DUMP FILE.               *
 MES9     DATA   C* TAPE ERROR - GO,JSN./DROP,JSN.* 
 MES10    DATA   C* QUEUE STATUS INDEFINITE.     *
 MES11    DATA   C* ERRORED FILE PARTIALLY DUMPED -        .* 
 MES12    DATA   C* ACCESS LEVEL LIMITS OUT OF RANGE.*
  
**        *CIO* ERROR MESSAGES. 
  
 MC00     DATA   C/ *CIO* ERROR.                 /
 MC02     DATA   C* ADDRESS ERROR.               *
 MC03     DATA   C* DEVICE STATUS ERROR.         *
 MC04     DATA   C* 6681 FUNCTION REJECT ERROR.  *
 MC05     DATA   C* DEVICE RESERVED.             *
 MC06     DATA   C* DEVICE NOT READY.            *
 MC07     DATA   C* TRACK LIMIT.                 *
  
**        *QFM* ERROR MESSAGES. 
  
 MQ00     DATA   C/ *QFM* ERROR.                 /
 MQ01     DATA   C* FILE NOT FOUND.              *
 MQ02     DATA   C* FILE ALREADY INTERLOCKED.    *
 MQ03     DATA   C* DEVICE UNAVAILABLE.          *
 MQ04     DATA   C* QFT/LOCAL FNT FULL.          *
          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     COMCSFN 
*CALL     COMCSFM 
*CALL     COMCSYS 
*CALL     COMCVLC 
*CALL     COMCVQF 
 WRIF$    EQU    1
*CALL     COMCWTC 
*CALL     COMCWTW 
*CALL     COMCZTB 
          TITLE  BUFFERS. 
          USE    LITERALS 
  
*         BUFFERS.
  
 BLOCK    BSSZ   EPBL        *DSP* CALL BLOCK 
 IQFE     BSSZ   QFEWL       INACTIVE QUEUED FILE ENTRY BUFFER
 TACF     BSS    0           TABLE OF ACTIVE FAMILIES (UNUSED)
 EBUF     VFD    24/1000B,36/5  END OF VOLUME CONTROL WORD BUFFER 
          VFD    60/310000B 
          BSSZ   2
 WBUF     EQU    *           WORKING BUFFER 
 TBUF     EQU    WBUF+WBUFL  TEMPORARY IQFT ENTRY BUFFER
 OBUF     EQU    TBUF+BUFL   OUTPUT FILE BUFFER 
 QBUF     EQU    OBUF+BUFL   QUEUE FILE BUFFER
 DBUF     EQU    QBUF+QBUFL  DESTINATION QUEUE FILE BUFFER
 SBUF     EQU    DBUF+DBUFL  SYSTEM INFORMATION BUFFER
  
*         READ FNT OR QFT INTO FIELD LENGTH STARTING AT *RBUF*. 
  
 RBUF     EQU    SBUF+SBUFL   FNT/QFT BUFFER
  
*         THE LENGTH OF *IBUF* MAY BE EXPANDED TO READ THE ENTIRE 
*         FNT OR QFT IF NECESSARY.
  
 IBUF     EQU    RBUF        OLD IQFT FILE BUFFER 
 BUFFL    EQU    IBUF+IBUFL+4  END OF BUFFERS 
 PRS      TITLE  PRESET.
**        PRS - PRESET. 
* 
*         PRESET ADJUSTS FIELD LENGTH AND SETS UP A 
*         CONTROL WORD TO READ THE QFT. 
* 
*         ENTRY  (QFTA) = *QFTP* WORD IN CMR. 
* 
*         EXIT   (QFTS) = LENGTH OF QFT.
*                (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 
          EQ     PRSX        RETURN 
          SPACE  4,10 
          ERRPL  *-RFL       IF DEFAULT FIELD LENGTH TOO SMALL
          SPACE  4
          END    QDUMP
