QLOAD 
          IDENT  QLOAD1,FWA,QLOAD,01,00 
          ABS 
          SST 
          SYSCOM B1 
 VR1$     SET    1           *COMSSSE* CONTAINS VERSION 1 EQUIVALENCES
*COMMENT  QLOAD - QUEUE LOAD PROCESSOR. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  QLOAD - QUEUE LOAD PROCESSOR.
          SPACE  4
***       QLOAD - QUEUE LOAD PROCESSOR. 
* 
*         S. L. BETH         76/02/23.
          SPACE  4
***       *QLOAD* WILL PROCESS DUMP TAPES GENERATED BY *QDUMP* OR 
*         TAPES PRODUCED BY OTHER UTILITIES USING THE SAME FORMAT.
*         QUEUES WILL BE SELECTIVELY LOADED UNDER THE GUIDANCE OF 
*         PARAMETER INPUT. *QLOAD* MAY ALSO BE USED TO LIST THE 
*         CONTENTS OF A DUMP TAPE WITHOUT LOADING ANY FILES.
          SPACE  4
***       *QLOAD* MAY BE CALLED THROUGH *QFSP* OR BY CONTROL STATEMENT. 
*         THE FOLLOWING PARAMETERS ARE VALID. 
* 
*         MI = MACHINE IDENTIFICATION.
*         DF = DESTINATION FAMILY NAME (MUST BE ENTERED). 
*                FOR ACTIVE LOADS *DF* MAY BE SET TO *ALL*. 
*                FOR INACTIVE LOADS *DF* HAS TO BE A SPECIFIC FAMILY. 
*         DD = DESTINATION DEVICE NUMBER (REQUIRED IF *DF* NOT *ALL*).
*         FU = FAMILY NAME FOR USER INDEX.
*         UI = USER INDEX RANGE (0 - 377777B).
*         DA = DATE RANGE (751112-751118) OR ALL (DA=ALL).
*         FS = FILE SIZE RANGE IN PRUS/10B (0 - 777777B). 
*         JSN = JOB SEQUENCE NUMBER, UP TO FIVE MAY BE ENTERED. 
*         LD = LOGICAL IDENTIFIER (3 ALPHANUMERIC CHARACTERS).
*         ID = RANGE OF FILE ID-S TO PROCESS. 
*         LA = LOWER SECURITY ACCESS LEVEL (1-7 CHARACTERS).
*         UA = UPPER SECURITY ACCESS LEVEL (1-7 CHARACTERS).
*         I  = ALTERNATE DIRECTIVE INPUT FILE. THIS IS A CONTROL
*                STATEMENT PARAMETER SPECIFYING WHAT FILE SHOULD
*                BE READ FOR INPUT DIRECTIVES.  THESE DIRECTIVES
*                CONSIST OF ANY VALID K-DISPLAY INPUT OR COMMANDS.
*                THESE DIRECTIVES WILL BE PROCESSED AFTER THE 
*                CONTROL STATEMENT DIRECTIVES BUT BEFORE ANY
*                K-DISPLAY INPUT IS ACCEPTED. 
*         L = OUTPUT FILE NAME. 
*         FN = LOAD FILE NAME.
*         FC = FORMS CODE FOR OUTPUT FILES. 
*         TF = FAMILY FOR REMOTE BATCH TERMINAL.
*         TUI = USER INDEX FOR REMOTE BATCH TERMINAL. 
*              TUI = XXXXXX-YYYYYY MEANS TO PROCESS ALL INDEXES IN
*                    THE RANGE XXXXXX TO YYYYYY.  YYYYYY IS OPTIONAL. 
*                    (0 - 377777B ALLOWED.) 
*         DS = DEVICE SELECTION CRITERIA FOR OUTPUT FILES.
*              (DS=DV-EX) SELECTION BASED ON DEVICE CODES AND ON
*              EXTERNAL CHARACTERISTICS.
*              (DS=DV) SELECTION BASED ON DEVICE CODES ONLY.
*         NF = NUMBER OF MEDIA FILES TO SKIP. 
*         SC = NUMBER OF QUEUED FILES TO SKIP.
*         OP = OPTION, INACTIVE OR ACTIVE.
*         DS=DT,  FILE DESTINATION AND DISPOSTION TYPE SELECTION. 
*         *DS* MAY BE ANY OF THE FOLLOWING. 
*                BC - SELECT LOCAL BATCH FILES BY DISPOSITION TYPE. 
*                RB - SELECT REMOTE BATCH FILES BY DISPOSITION TYPE.
*         *DT* MAY BE ANY OF THE FOLLOWING. 
*                IN - INPUT.
*                PL - PLOT. 
*                PH - PUNCH.
*                PR - ANY PRINTER.
*                P2 - 512 PRINTER.
*                LR - 580-12 PRINTER. 
*                LS - 580-16 PRINTER. 
*                LT - 580-20 PRINTER. 
*                LX - 5870 NON-IMPACT PRINTER.
*                LY - 5970 NON-IMPACT PRINTER.
*                PRINT - ALL PRINT TYPES. 
*                WT - WAIT QUEUE. 
*                ALL - ALL DISPOSITION TYPES. 
*                NONE - NO DISPOSITION TYPES ALLOWED. 
*                SF - INSTALLATION DEFINED TYPE.
*         PO=X, PROCESSING OPTION.
*         X MAY BE ANY COMBINATION OF THE FOLLOWING.
*                N - NO K-DISPLAY OPTION. 
*                R - REWIND LOAD FILE FLAG. 
*                E - ERRORED FILES PROCESSING FLAG. 
*                F - FAMILY ORDINAL TABLE PROCESSING FLAG.
*                K - FORCE K-DISPLAY ON ERROR RETURN. 
*                L - LID TABLE PROCESSING FLAG. 
*                I - IF SPECIFIED, INACTIVE INPUT QUEUE FILES WILL BE 
*                    ACTIVATED WHEN THE OWNER FAMILY IS NOT PRESENT.
*                U - IF SPECIFIED, UNCONDITIONALLY LOAD FILES WITHIN
*                    SECURITY RESTRAINTS AND SYSTEM FILE INTEGRITY. 
* 
*         DEFAULT VALUES. 
* 
*         MI = CURRENT MACHINE VALUE. 
*         DF = ALL. 
*         DD = ALL. 
*         FU = 0. 
*         UI = 0 - 377777B. 
*         DA = LAST FIVE DAYS.
*         FS = 0 - 777777B. 
*         JSN = NOT SPECIFIED.
*         LD = NOT SPECIFIED. 
*         ID = 0 - 77.
*         LA = NOT SPECIFIED. 
*         UA = NOT SPECIFIED. 
*         I = NONE. 
*         L = OUTPUT. 
*         FN = QFILES.
*         FC = NOT SPECIFIED. 
*         TID = 0.
*         DS = NOT SPECIFIED. 
*         NF = 0. 
*         SC = 0. 
*         OP = A. 
*         DR = ALL. 
*         DT = ALL. 
*         PO = NONE SELECTED. 
          SPACE  4
***       OPERATOR/DAYFILE MESSAGES.
* 
*         * ACTIVE LOAD NOT ALLOWED.* THE DEVICE SELECTED FOR 
*                THE ACTIVE LOAD IS REMOVABLE AND THE LOAD IS 
*                NOT ALLOWED. SELECT ANOTHER DEVICE AND RETRY THE LOAD. 
* 
*         * CANNOT ATTACH *IQFT* FILE.* AN ATTEMPT TO ACCESS THE *IQFT* 
*                FILE ON THE DESTINATION DEVICE FAILED. CHECK FOR 
*                OTHER UTILITIES ACCESSING THE FILE. WHEN THE FILE
*                IS FREE RETRY THE QLOAD OPERATION. 
* 
*         * DESTINATION DEVICE ERROR.* AN UNRECOVERABLE ERROR OCCURED 
*                WHEN WRITING TO THE DESTINATION DEVICE. CHECK THE
*                OUTPUT FILE FOR THE FILES THAT WERE PROCESSED. 
* 
*         * DESTINATION DEVICE REQUIRED.* FOR AN INACTIVE LOAD THE
*                (FAMILY AND DEVICE NUMBER) OR THE PACKNAM OF 
*                THE DESTINATION DEVICE MUST BE SPECIFIED.
* 
*         * ERROR FILE LIMIT.* THE NUMBER OF ERROR FILES CREATED HAS
*                EXCEEDED THE UPPER LIMIT OR AN URECOVERABLE ERROR
*                OCCURED WHILE ATEMPTING TO CREATE THE ERROR FILE.
*                CHECK THE OUTPUT FOR FILES PROCESSED.
* 
*         * FILE NAME CONFLICT.* THE NAMES OF THE OUTPUT, LOAD OR 
*                *IQFT* FILE CONFLICT. CHANGE THE NAME OF THE LOAD
*                OR OUTPUT FILE AND RETRY THE OPERATION.
* 
*         * FILE NOT ALLOWED ON EQUIPMENT.* 
*                THE REQUESTED EQUIPMENT DID NOT HAVE THE REQUIRED
*                ACCESS LEVEL FOR THE QUEUED FILE.
* 
*         * FOT FULL - FILES IGNORED.* - SOME OF THE QUEUED FILES 
*                WERE NOT PROCESSED BECAUSE THERE WAS NO FOT ENTRY FOR
*                THE CREATION AND/OR THE DESTINATION FAMILY AND THE 
*                FOT WAS FULL (MESSAGE ISSUED BY *COMCVQF*).
* 
*         * INACTIVE LOAD NOT ALLOWED.* THE DEVICE SELECTED FOR 
*                THE INACTIVE LOAD IS REMOVABLE AND THE LOAD IS NOT 
*                ALLOWED.  SELECT ANOTHER DEVICE AND RETRY THE LOAD.
* 
*         * IQFT NOT FOUND.* NO IQFT FILE WAS FOUND ON THE SELECTED 
*                DEVICE.  THE DEVICE SHOULD BE INITIALIZED DUE TO THE 
*                INDETERMINATE STATE THAT IT IS IN. 
* 
*         * LDLIST OPERATION COMPLETE.* INFORMATIVE MESSAGE.
* 
*         * LID NOT ADDED - FILES IGNORED.*  SOME OF THE QUEUED FILES 
*                WERE NOT PROCESSED BECAUSE THERE WAS NO LID TABLE
*                ENTRY FOR THE LID ASSOCIATED WITH THE FILES AND THE
*                LID COULD NOT BE ADDED BECAUSE ALL LID SLOTS FOR THE 
*                HOST PID WERE ALREADY OCCUPIED BY OTHER LIDS 
*                (MESSAGE ISSUED BY *COMCVQF*). 
* 
*         * LOAD FILE MISPOSITIONED.* A FILE POSITION FUNCTION
*                OR FILE READ INDICATED AN ATTEMPT TO POSITION
*                BEYOND *EOI* OR THE CONTROL WORD READ WAS NOT
*                THE EXPECTED CONTROL WORD. REWIND THE LOAD FILE
*                AND RETRY THE OPERATION. 
* 
*         * LOAD FILE POSITION LOST.* DURING THE WRITE ERROR RECOVERY 
*                SEQUENCE THE POSITION ON THE LOAD FILE WAS LOST. CHECK 
*                THE OUTPUT FILE FOR THE LIST OF FILES THAT WERE LOADED.
* 
*         * LOAD RECORD FORMAT IN ERROR.* 
*                THE FILE DATA MAY NOT BE INTACT, SINCE A LOAD RECORD 
*                FORMAT ERROR WAS ENCOUNTERED WHEN THE FILE WAS LOADED. 
*                THE FILE IS SKIPPED, UNLESS ERROR PROCESSING IS
*                SELECTED.
* 
*         * MASS STORAGE ERROR DURING DUMP.*
*                THE FILE DATA MAY NOT BE INTACT, SINCE A MASS STORAGE
*                ERROR WAS ENCOUNTERED WHEN THE FILE WAS DUMPED.
*                THE FILE IS SKIPPED, UNLESS ERROR PROCESSING IS
*                SELECTED.
* 
*         * NO OUTPUT FILE PRESENT.* THE OUT COMMAND WAS ENTERED
*                AND *QLOAD* COULD NOT FIND AN OUTPUT FILE TO RELEASE.
* 
*         * OUTPUT FILE RELEASED.* INFORMATIVE MESSAGE. 
* 
*         * PREMATURE *EOF* ENCOUNTERED.* WHILE PROCESSING THE LOAD 
*                FILE AN *EOF* WAS ENCOUNTERED BEFORE IT WAS EXPECTED.
*                NOTIFY ANALYST TO INVESTIGATE THE FORMAT OF THE
*                LOAD TAPE. 
* 
*         * QFT LIMIT ON LOAD.*  THE CALCULATED QFT THRESHOLD HAS 
*                BEEN REACHED. CONSULT LISTING TO DETERMINE WHICH 
*                FILES WERE NOT LOADED. 
* 
*         * QFT FULL DETECTED BY QFM.*  *QFM* RETURNED QFT FULL 
*                STATUS WHEN CALLED TO ASSIGN A FILE TO MASS
*                STORAGE. CHECK THE OUTPUT TO DETERMINE WHICH FILES 
*                WERE NOT PROCESSED.
* 
*         * *QFM* ERROR ON ERRNNN FILE.* *QFM* RETURNED AN ERROR
*                (OTHER THAN DUPLICATE FILE NAME) WHEN CALLED TO
*                CONVERT THE FILE TO A COMMON FILE AFTER AN ERROR.
*                CHECK THE OUTPUT TO DETERMINE WHICH FILES WERE 
*                PROCESSED. 
* 
*         * QLOAD ABORTED.* THE OPERATOR DROPPED THE JOB OR THE 
*                JOB WAS ABORTED FOR A SYSTEM ERROR. IF NOT 
*                OPERATOR DROP CHECK DAYFILE FOR CAUSE. 
* 
*         * QLOAD OPERATION COMPLETE.* INFORMATIVE MESSAGE. 
* 
*         * QLOAD TERMINATED.* QLOAD HAD ABORTED AND THE ABORT
*                PROCESSING WAS TERMINATED BY THE OPERATOR OR DUE 
*                TO A SYSTEM ERROR. CHECK THE DAYFILE FOR CAUSE.
* 
*         * QUEUE FILE ASSIGN ERROR.* AN ATTEMPT TO FORCE A DEVICE
*                ASSIGNMENT FOR THE QUEUE FILE BEING LOADED RESULTED
*                IN THE DEVICE BEING ASSIGNED TO THE WRONG EQUIPMENT. 
* 
*         * READ PARITY ERROR ON LOAD FILE.*
*                THE FILE DATA MAY NOT BE INTACT, SINCE A READ PARITY 
*                ERROR WAS ENCOUNTERED WHEN THE FILE WAS LOADED.  THE 
*                FILE IS SKIPPED, UNLESS ERROR PROCESSING IS SELECTED.
          SPACE  4
**        MESSAGES ISSUED TO DAYFILE ONLY.
* 
* 
*         * QLOAD -  NNNN FILES IGNORED.* 
* 
*         * QLOAD -  NNNN ACTIVE FILES LOADED.* 
* 
*         * QLOAD -  NNNN INACTIVE FILES LOADED.* 
* 
*         * QLOAD -  NNNN FILES LISTED.*
* 
*         * QLOAD -  NNNN ERRXXX FILES CREATED.*
* 
*         *** PROCESSING DUMP FILE. *** 
*         DUMPNAM        DATE,TIME. 
* 
*         THE TWO LINES IDENTIFYING THE DUMP TAPE BEING PROCCESSED
*         WILL BE ISSUED WHEN THE DUMP HEADER FIELD IS ENCOUNTERED. 
*         THE FILE POSITIONING REQUESTS MAY POSITION THE FILE BEYOND
*         THIS POINT IN WHICH CASE THE MESSAGE WILL NOT BE ISSUED.
          SPACE  4
**        COMMON DECKS (DEFINITIONS). 
  
  
*CALL     COMCMAC 
*CALL     COMCCMD 
          LIST   X
*CALL     COMSIOQ 
*CALL     COMSJIO 
*CALL     COMSQFS 
*CALL     COMSSFM 
          LIST   -X 
*CALL     COMSMLS 
*CALL     COMSMSC 
*CALL     COMSSSE 
*CALL     COMSSSJ 
          QUAL   COMS1DS
          QUAL   *
*CALL     COMSDSP 
 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    48/0,12/2R_MN  TX
 .SCL     RMT 
 SCLASS   ENDM
  
  
 SCL$     EQU    0           ONLY PROCESS CLASSES WITH JCB-S
*CALL     COMSSCD 
          EJECT 
          TITLE  QLOAD - CONSTANTS, COUNTERS, FETS, TABLES. 
*         CONSTANTS.
  
  
 BUFL     EQU    1001B       OUTPUT BUFFER LENGTH 
 IBUFL    EQU    1001B       *IQFT* BUFFER LENGTH 
 SBUFL    EQU    2041B       SCRATCH BUFFER LENGTH
 SSBFL    EQU    200B        SYSTEM INFORMATION BUFFER LENGTH 
 TBUFL    EQU    20041B      TAPE BUFFER LENGTH 
 WBUFL    EQU    102B        LENGTH OF WORKING BUFFER 
 TACF     EQU    FOTA        TABLE OF ACTIVE CREATION FAMILIES (*VIE*)
 LINE     EQU    TPPA+PPLN   LINE NUMBER
 PDFE     EQU    TPPA+PPPD   PRINT DENSITY FORMAT EFFECTOR
          SPACE  4
*         INDICATORS AND COUNTERS.
  
  
          ORG    OVLA 
 FWA      BSS    0
 ABTE     CON    0           ABORT AT END OF LIST FLAG
 ABTI     CON    0           ABORT PROCESSING, 0 = SKIP FILE
 ALEF     CON    0           ACCESS LEVEL ERROR FLAG
 DEVN     CON    0           FAMILY/DEVICE NUMBER 
 DSPC     CON    0           FILE DISPOSITION CODE
 DWIQ     CON    0           NON ZERO IF DATA WRITTEN ON *IQFT* FILE
 EOR      CON    0           NON ZERO IF *EOR* ENCOUNTERED
 ERRF     CON    0           NON ZERO IF ERROR IN CURRENT FILE
 ERTP     CON    0           FILE ERROR TYPE
 FILE     CON    0           QUEUE FILE COUNT 
 LIST     CON    0           NON ZERO IF LIST OPTION
 TRMM     CON    0           ADDRESS OF TERMINATION MESSAGE 
 QLIM     CON    0           QFT LIMIT FOR ACTIVE LOAD
  
*         CONTROL WORD POINTERS AND COPY CONTROLS.
  
 ASSF     CON    0           INDICATES THE FILE IS ASSIGNED TO DISK 
 CQCW     CON    0           CURRENT QUEUE CONTROL WORD 
 CTCW     CON    0           CURRENT TAPE CONTROL WORD
 CTLO     CON    0           BUFFER LOCATION OF CURRENT CONTROL WORD
 LEVL     CON    0           RECORD LEVEL NUMBER
 NTCW     CON    0           WORDS TO NEXT TAPE CONTROL WORD
 NQCW     CON    0           WORD TO NEXT QUEUE CONTROL WORD
 WDSX     CON    0           WORDS IN TRANSFER BUFFER 
          SPACE  4
*         FILE DISPOSITION COUNTS AND ERROR FILE COUNT. 
  
  
 FLDS     BSSZ   4
 EFCT     CON    0           ERROR FILE COUNT 
 FLDSL    EQU    *-FLDS 
          SPACE  4
*         IQFT ENTRY FOR CURRENT LOAD FILE. 
  
  
 IQFE     BSS    QFEWL
 OLDN     BSS    1           OLD QUEUE FILE NAME
          SPACE  4
*         ROUTE PARAMETER BLOCK.
  
  
 ROTB     BSSZ   EPBL 
          SPACE  4
*         FETS. 
  
  
 IQ       BSS    0
 NIQ      BSS    0           IQFT FILE
 "RFIQ"   RFILEB IBUF,IBUFL,EPR,(FET=8) 
  
  
 O        BSS    0           OUTPUT FILE
 OUTPUT   FILEB  OBUF,BUFL,(FET=7)
  
  
 S        BSS    0           SCRATCH FILE 
 "RFSC"   FILEB  SBUF,SBUFL,EPR,(FET=8) 
  
  
 T        BSS    0           LOAD FILE
 TAPE     FILEB  TBUF,TBUFL,EPR,LBL 
          BSS    1
  
  
 Q        BSS    0           *FET* FOR *QFM* CALLS
 QCALLS   FILEB  IQFE,QFEWL+1,(FET=8) 
  
 C        BSS    0           SYSTEM INFORMATION (SYSTEM/EOI SECTORS)
 CFILE    FILEB  SSBF,SSBFL+1,(FET=8) 
          SPACE  4
**        TRANSFER TABLES.
* 
*         THE FOLLOWING TABLES ARE USED BY ROUTINE *PTT* (CALLED BY 
*         *RSS*) TO TRANSFER NOS VERSION ONE SYSTEM SECTOR FIELDS TO
*         THEIR PROPER PLACE IN A NOS VERSION TWO SYSTEM SECTOR.  THE 
*         THREE TABLES ARE *INTB* WHICH CONTAINS INPUT DEPENDENT
*         SYSTEM SECTOR TRANSFER DATA, *OTTB*, WHICH CONTAINS 
*         OUTPUT DEPENDENT SYSTEM SECTOR TRANSFER DATA, AND *IOTB*
*         WHICH CONTAINS TRANSFER DATA THAT IS FOR BOTH INPUT AND 
*         OUTPUT SYSTEM SECTORS.  TABLES END WITH A ZERO WORD.
* 
*T        12/0, 12/DFM, 12/DAD, 12/SFM, 12/SAD. 
* 
*         DFM =  DESTINATION FIELD MASK, NUMBER OF BITS IN FIELD. 
*         DAD =  DESTINATION ADDRESS FROM *COMSSSE*.
*         SFM =  SOURCE FIELD MASK, NUMBER OF BITS IN FIELD.
*         SAD =  SOURCE ADDRESS FROM *COMSSSE*. 
  
 OTTB     VFD    12/0,12/24,12/RASS,12/24,12//NOSV1/RASS
          VFD    12/0,12/12,12/LCSS,12/12,12//NOSV1/LCSS
          VFD    12/0,12/12,12/RCSS,12/12,12//NOSV1/RCSS
          VFD    12/0,12/24,12/RTSS,12/24,12//NOSV1/RTSS
          VFD    12/0,12/12,12/SCSS,12/12,12//NOSV1/SCSS
          VFD    12/0,12/12,12/RBSS,12/12,12//NOSV1/RBSS
          VFD    12/0,12/12,12/IOSS+19,12/12,12//NOSV1/FCSS 
          VFD    60/0 
  
 INTB     VFD    12/0,12/12,12/JCSS,12/12,12//NOSV1/JCSS
          VFD    12/0,12/12,12/JESS,12/12,12//NOSV1/JESS
          VFD    12/0,12/24,12/CRSS,12/24,12//NOSV1/CRSS
          VFD    12/0,12/48,12/TNSS,12/48,12//NOSV1/TNSS
          VFD    60/0 
  
 IOTB     VFD    12/0,12/12,12/EQSS,12/12,12//NOSV1/EQSS
          VFD    12/0,12/12,12/FTSS,12/12,12//NOSV1/FTSS
          VFD    12/0,12/12,12/NSSS,12/12,12//NOSV1/NSSS
          VFD    12/0,12/60,12/DTSS,12/60,12//NOSV1/DTSS
          VFD    12/0,12/12,12/FGSS,12/12,12//NOSV1/FRSS+4
          VFD    12/0,12/12,12/RMSS,12/12,12//NOSV1/QFSS
          VFD    12/0,12/12,12/CMSS,12/12,12//NOSV1/MISS
          VFD    12/0,12/60,12/DASS,12/60,12//NOSV1/DASS
          VFD    12/0,12/48,12/FDSS,12/48,12//NOSV1/FDSS
          VFD    12/0,12/60,12/ACSS,12/60,12//NOSV1/ACSS
          VFD    12/0,12/60,12/OASS,12/60,12//NOSV1/ACSS
          VFD    12/0,12/12,12/DCSS,12/12,12//NOSV1/DVSS
          VFD    12/0,12/36,12/CDSS+2,12/36,12//NOSV1/CDSS+2
          VFD    12/0,12/60,12/JNSS,12/60,12//NOSV1/JNSS
          VFD    12/0,12/48,12/FMSS,12/48,12//NOSV1/FMSS
          VFD    12/0,12/48,12/FOSS,12/48,12//NOSV1/FMSS
          VFD    12/0,12/12,12/IOSS+5,12/12,12//NOSV1/EQSS
          VFD    12/0,12/12,12/IOSS+6,12/12,12//NOSV1/FTSS
          VFD    12/0,12/24,12/IOSS+16,12/24,12//NOSV1/DISS 
          VFD    12/0,12/12,12/IOSS+17,12/12,12//NOSV1/DISS+1 
          VFD    60/0 
          TITLE  MAIN LOOP. 
**        QLOAD - MAIN LOOP.
* 
*         ENTRY  PARAMETERS PROCESSED BY *QFSP*.
* 
*         EXIT   (X2) = K-DISPLAY CONTROL.
*                (X5) = TERMINATING MESSAGE.
  
  
 QLOAD    SUBR               ENTRY/EXIT 
          RJ     PRS         PRESET FILES 
          NZ     B7,ERR      IF ERROR IN PARAMETERS 
          SA5    TARA+ARFC   SET FUNCTION 
          SX5    X5-3        CHECK FOR OUT
          ZR     X5,OUT      IF OUT REQUEST 
          RJ     PLF         POSITION LOAD FILE 
          NZ     B7,ERR      IF PROCESSING ERROR
 QDL1     SX6    B0+         CLEAR ACCESS LEVEL ERROR FLAG
          SA6    ALEF 
          RJ     GNF         GET NEXT LOAD FILE 
          NZ     B7,ERR      IF PROCESSING ERROR
          MI     X1,QDL4     IF *EOF* ENCOUNTERED 
          NZ     X4,QDL2     IF VERSION ONE FILE TO SKIP
          RJ     BIE         BUILD *IQFT* ENTRY 
          RJ     CFS         CHECK FILE SELECTION 
          SA4    ERRF        CHECK FOR ERROR SKIP 
          IX6    X1+X4
          NZ     X6,QDL2     IF SKIP OR LIST
  
*         LOAD THE QUEUE FILE.
  
          RJ     CPY         COPY THE FILE
          SA1    ALEF 
          NZ     X1,QDL1.1   IF ACCESS LEVEL ERROR
          NZ     B7,ERR      IF ERROR IN COPY 
          RJ     DSP         DISPOSE THE FILE 
          RJ     WIQ         WRITE *IQFT* ENTRY 
          EQ     QDL3        WRITE OUTPUT DATA
  
*         SKIP QUEUED FILE. 
  
 QDL1.1   SX1    X1-1 
          NZ     X1,QDL3     IF NO SKIP NEEDED
 QDL2     RJ     SQF         SKIP QUEUED FILE 
          NZ     B7,ERR      IF PROCESSING ERROR
 QDL3     RJ     WOL         WRITE OUTPUT LINE
          EQ     QDL1        LOOP 
  
 QDL4     RJ     CIQ         CLOSE *IQFT* FILE
          RJ     ISM         ISSUE FILES PROCESSED MESSAGE
          SA1    ABTE 
          NZ     X1,TRM      IF ABORT AT END OF LIST SET
          SA5    TRMM        LOAD ADDRESS OF TERMINATION MESSAGE
          MESSAGE X5
          BX2    X2-X2       SET PRIMARY RIGHT SCREEN 
          JP     QLOADX      RETURN TO *QFSP* 
          SPACE  4
**        ABORT PROCESSING. 
  
  
 ABT      RJ     CIQ         CLOSE THE *IQFT* FILE
          RECALL S
          RETURN S
          SX6    MES2        * QLOAD ABORTED.*
          SA6    TRMM 
          MESSAGE X6
          SX7    LSDP        SET TO LIST REMAINING FILES
          SA7    DSPC 
          SA7    LIST 
          SA1    TARA+ARFC
          PL     X1,ABT1     IF K-DISPLAY SELECTED
          SX6    B1+         SET ABORT AT END OF LIST 
          SA6    ABTE 
 ABT1     EREXIT TRM         SET NEW ABORT ADDRESS
          SA5    ABTI        CHECK ABORT PROCESSING 
          ZR     X5,QDL2     IF FILE TO BE SKIPPED
          BX7    X7-X7       CLEAR ABORT PROCESSING 
          SA7    A5 
          JP     QDL3        LIST REMAINING FILES 
          SPACE  4
**        TERMINATE PROCESSING. 
  
  
 TRM      SA1    PRSA        CHECK FOR *FL* ASSIGNED
          ZR     X1,TRM1     IF *FL* NOT ASSIGNED 
          WRITER O           FLUSH OUTPUT FILE
 TRM1     SX5    MES19       * QLOAD TERMINATED.* 
          MESSAGE X5
          ABORT              TERMINATE THE LOAD 
          SPACE  4
**        ERROR PROCESSING. 
  
  
 ERR      RJ     CIQ         CLOSE THE *IQFT* FILE
          RETURN S
          SA1    PRSA        CHECK FOR *FL* ASSIGNED
          ZR     X1,ERR1     IF *FL* NOT ASSIGNED 
          RJ     ISM         ISSUE FILES PROCESSED MESSAGES 
 ERR1     SX5    B7          ISSUE MESSAGE
          MESSAGE X5
          SA1    TARA+ARFC
          PL     X1,ERR2     IF K-DISPLAY SELECTED
          SB2    FLDSL
 ERR1.1   SA1    B2+FLDS     CHECK FOR FILES PROCESSED
          NZ     X1,ERR1.2   IF FILES PROCESSED 
          SB2    B2-B1
          PL     B2,ERR1.1   IF NOT END OF FILE COUNTS
          EQ     ERR2        DO NOT ABORT IF NO FILES WERE PROCESSED
  
 ERR1.2   ABORT 
  
 ERR2     BX2    X2-X2
          JP     QLOADX      RETURN 
          SPACE  4
**        PROCESS OUT COMMAND.
  
  
 OUT      STATUS O           CHECK IF OUTPUT PRESENT
          SA5    O
          MX0    -18
          BX6    -X0*X5 
          AX6    1
          NZ     X6,OUT1     IF FILE PRESENT
          SX5    MES17       * NO OUTPUT FILE PRESENT.* 
          EQ     OUT2 
  
 OUT1     SA2    O           GET FILE NAME
          MX0    42 
          BX6    X0*X2
          SA6    ROTB        *DSP* PARAMETER BLOCK
          SA2    OUTA 
          BX6    X2 
          SA6    A6+B1
          ROUTE  ROTB,RECALL
          SX5    MES4        * OUTPUT FILE RELEASED.* 
 OUT2     MESSAGE X5
          BX2    X2-X2
          JP     QLOADX      RETURN 
  
  
 OUTA     VFD    24/0,12/2HPR,6/0,18/FRDC 
          TITLE   FIRST LEVEL SUBROUTINES.
 BIE      SPACE  4,20 
**        BIE - BUILD *IQFT* ENTRY. 
* 
*         ENTRY  (ROTB) = ROUTE BLOCK.
*                (SSBF) = SYSTEM SECTOR FOR FILE IF IT EXISTS.
* 
*         EXIT   (IQFE) = *IQFT* ENTRY. 
*                (OLDN) = OLD JSN FOR THE FILE. 
*                JSN SET AS FILENAME IN FET-S.
* 
*         USES   X - 0, 5, 6, 7.
*                A - 5, 6, 7. 
*                B - 6. 
* 
*         CALLS  CRB, GSF.
  
  
 BIE2     RJ     CRB         CONVERT ROUTE BLOCK TO AN *IQFT* ENTRY 
  
 BIE      SUBR               ENTRY/EXIT 
          SA5    SSBF        CHECK IF SYSTEM SECTOR PRESENT 
          ZR     X5,BIE2     IF NO SYSTEM SECTOR
          SB2    QFTE*5-1*5  SET NUMBER OF WORDS TO MOVE
          SB3    QFTE-1 
 BIE1     SX5    IOSS+B2     SET QFT ENTRY
          RJ     GSF         GET SYSTEM SECTOR FIELD
          SA6    IQFE+B3
          SB2    B2-5 
          SB3    B3-B1
          PL     B3,BIE1     IF MORE TO MOVE
          MX0    24 
          BX7    X0*X6
          SA7    OLDN        SAVE OLD JSN 
          SX5    B1 
          SA7    Q           SET NAME FOR *QFM* CALL
          BX7    X7+X5
          SA7    S           SET FILE NAME INTO FET 
          SX5    FLSS        GET FILE LENGTH
          RJ     GSF
          MX0    24 
          BX6    X0*X6
          SA6    IQFE+8 
          SX5    DTSS        GET DATE AND TIME
          RJ     GSF
          SA5    IQFE+8 
          MX0    -36
          BX6    -X0*X6 
          BX6    X5+X6
          SA6    A5 
          SX5    FMSS        GET FAMILY NAME
          RJ     GSF
          MX0    42 
          BX6    X0*X6
          SA6    IQFE+9 
          SX5    CMSS        GET CREATION MACHINE ID
          RJ     GSF
          SA5    IQFE+9 
          MX0    12 
          BX6    X0*X6
          LX6    12 
          BX6    X5+X6
          SA6    A5 
          MX0    42 
          SX5    FDSS        GET DESTINATION FAMILY NAME
          RJ     GSF         GET SYSTEM SECTOR FIELD
          MX0    60 
          SA6    IQFE+10
          SX5    ACSS        GET CREATION UN/UI 
          RJ     GSF
          SA6    IQFE+11
          MX0    42 
          SX5    FOSS        GET OWNER FAMILY NAME
          RJ     GSF
          SA6    IQFE+12
          JP     BIEX        RETURN 
 CIQ      SPACE  4,20 
**        CIQ - CLOSE THE *IQFT* FILE.
* 
*         ENTRY  (DWIQ) = 0 IF NO DATA WRITTEN TO THE *IQFT* FILE.
* 
*         USES   A - 5, 6.
*                X - 3, 5, 6. 
* 
*         CALLS  RAF. 
  
  
 CIQ      SUBR               ENTRY/EXIT 
          SA5    DWIQ        CHECK FOR FILE WRITTEN 
          ZR     X5,CIQ1     IF NO DATA WRITTEN 
          BX6    X6-X6       CLEAR DATA WRITTEN FLAG
          SA6    A5 
          WRITER NIQ,R       FLUSH THE BUFFER 
 CIQ1     SX3    NIQ         RELEASE THE *IQFT* FILE
          RJ     RAF
          JP     CIQX        RETURN 
 CFS      SPACE  4,20 
**        CFS - CHECK FILE SELECTION. 
* 
*         ENTRY  (IQFE - IQFE+QFEWL) = IQFT ENTRY.
*                (LIST) .NE. 0, IF LISTING FILES. 
* 
*         EXIT   (X1) = 0, IF NO ERRORS.
* 
*         ERROR  (DSPC) = *IGDP* IF FILE IGNORED. 
* 
*         USES   X - 1, 2, 3, 4, 6. 
*                A - 1, 2, 3, 6.
*                B - 2. 
* 
*         CALLS  CAF, CLD, VIE. 
  
  
 CFS      SUBR               ENTRY/EXIT 
          SA1    LIST 
          NZ     X1,CFSX     IF LISTING FILES 
          SA3    IQFE+2      CHECK LOGICAL IDENTIFIER 
          SX4    B1+         SET CHECK FOR LID IN TABLE 
          RJ     CLD
          NZ     X3,CFS1     IF NO MATCH
          SB2    B1+         FORCE CHECK OF ORIGIN TYPE ACCESS LIMITS 
          SA2    TARA+ARLA   GET ACCESS LEVEL LIMITS
          SA1    TARA+ARUA
          SA3    IQFE+INSQ   SET ADDRESS OF QFT ENTRY 
          RJ     CAF         CHECK ACCESS LEVEL OF FILE 
          NZ     X1,CFS1     IF FILE NOT SELECTED 
          SA1    TARA+AROP   SET ACTIVATE/INACTIVATE REQUEST
          BX6    X1 
          RJ     VIE         VALIDATE IQFT ENTRY
          ZR     X1,CFSX     IF FILE SELECTED 
 CFS1     SX6    IGDP        SET FILE IGNORED 
          SA6    DSPC 
          SX1    B1+         INDICATE ERROR 
          EQ     CFSX        RETURN 
 CPY      SPACE  4,20 
**        CPY - COPY FILE.
* 
*         ENTRY  (CQCW) = CURRENT QUEUE CONTROL WORD. 
*                (NTCW) = WORDS TO NEXT TAPE CONTROL WORD.
*                (NQCW) = WORDS TO NEXT QUEUE CONTROL WORD. 
*                (SSBF) = SYSTEM SECTOR.
*                (ROTB) = ROUTE BLOCK.
* 
*         EXIT   (B7) = 0 IF FILE TO BE LOADED. 
*                (B7) = ERROR MESSAGE ADDRESS IF ERROR OCCURED. 
*                (ERRF) = 0 IF NO ERROR IN FILE.
* 
*         USES   A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 5, 6, 7. 
*                X - ALL. 
* 
*         CALLS  ASF, PCW, GCW, CWE, AQF. 
  
  
 CPY      SUBR               ENTRY/EXIT 
          SA1    C+1         REWIND FET 
          SX6    X1 
          SX7    B0          CLEAR WORD COUNT 
          SA6    A1+1 
          SA5    CQCW        CHECK CURRENT CONTROL WORD 
          SA7    ASSF        CLEAR FILE ASSIGNED TO MASS STORAGE
          SA6    A6+1 
          SA7    WDSX 
          NZ     X5,CPY1     IF WORKING ON CURRENT WORD 
          RJ     GCW         GET NEXT CONTROL WORD
 CPY1     SA1    WDSX        CHECK WORDS IN BUFFER
          SA2    NTCW        LOAD BLOCK SIZE
          SA3    NQCW        FIELD SIZE 
          SX4    64 
          IX5    X4-X1       WORDS NEEDED TO FILL COPY BLOCK
          IX6    X2-X5       COMPARE BLOCK SIZE 
          IX7    X3-X5       COMPARE FIELD SIZE 
          MI     X6,CPY4     IF SHORT MEDIA DATA BLOCK
          MI     X7,CPY6     IF SHORT FIELD 
  
*         COPY DATA.
  
          SA6    A2          UPDATE COUNTS
          SA7    A3 
          BX6    X4          SET WORDS IN BLOCK 
          SA6    A1 
          READW  T,WBUF+1+X1,X5  FILL COPY BLOCK
          SA1    NQCW        CHECK FOR POSSIBLE *EOR* FIELD 
          SX7    B0+         CLEAR LEVEL NUMBER 
          SA7    LEVL 
          NZ     X1,CPY2     IF NOT POSSIBLE *EOR* FIELD
          SA1    CQCW        CHECK IF *EOR* BLOCK 
          SA2    EOR         CHECK IF LAST BLOCK
          SA3    NTCW 
          MX0    -3 
          AX1    9
          NZ     X3,CPY1.1   IF DATA REMAINING IN RECORD
          NZ     X2,CPY5     IF *EOR* MEDIA BLOCK 
 CPY1.1   BX7    -X0*X1 
          NZ     X7,CPY7     IF *EOR* OR *EOF* FIELD
 CPY2     SA1    ASSF        CHECK IF FILE ASSIGNED 
          NZ     X1,CPY3     IF FILE ASSIGNED 
          RJ     ASF         ASSIGN FILE TO DISK
          NZ     B7,CPYX     IF FILE NOT ASSIGNED 
 CPY3     SB5    B1          INDICATE NOT AT END OF RECORD
          RJ     CWE         CHECK WRITE ERRORS 
          NZ     B7,CPYX     IF UNRECOVERABLE ERROR 
          NZ     B6,CPY1     IF WRITE ERROR RECOPY FILE 
          SA1    WDSX        SET UP CONTROL WORDS 
          SX2    5
          SX3    64 
          IX6    X1*X2
          LX3    36 
          BX6    X3+X6
          BX7    X7-X7       CLEAR WORD COUNT 
          SA2    LEVL 
          SA6    WBUF 
          SA7    A1 
          BX6    X2 
          SA6    WBUF+1+X1   SET LEVEL NUMBER 
          WRITEW S,WBUF,X1+2  WRITE DATA
          EQ     CPY1        LOOP 
  
*         PROCESS SHORT MEDIA DATA BLOCK. 
  
 CPY4     IX7    X3-X2       FIELD - BLOCK LENGTH 
          MI     X7,CPY6     IF FIELD IS SHORTER
          BX6    X6-X6       UPDATE COUNTS
          SA6    A2 
          SA7    A3          WORDS REMAINING IN FIELD 
          IX6    X1+X2       INCREMENT BUFFER WORD COUNT
          SA6    A1 
          ZR     X2,CPY5     IF END OF MEDIA BLOCK
          READW  T,WBUF+1+X1,X2  READ TO END OF BLOCK 
 CPY5     READO  T           SKIP TRAILING CONTROL WORD 
          SA4    EOR
          NZ     X4,CPY11    IF *EOR* BLOCK 
          RJ     PCW         PROCESS NEXT BLOCK 
          PL     X1,CPY1     IF NOT *EOF* 
          SB7    MES20       * PREMATURE *EOF* ENCOUNTERED.*
          EQ     CPYX        RETURN 
  
*         PROCESS SHORT FIELD.
  
 CPY6     IX6    X2-X3       BLOCK - FIELD LENGTH 
          MI     X6,CPY4     IF BLOCK SHORTER 
          SA6    A2          UPDATE COUNTS - WORDS IN BLOCK 
          IX7    X1+X3
          SA7    A1          WORDS IN BUFFER
          ZR     X3,CPY7     IF END OF FIELD
          READW  T,WBUF+1+X1,X3  READ TO END OF FIELD 
 CPY7     SA1    CQCW        CHECK IF EOR BLOCK 
          MX0    -3 
          AX1    9
          BX7    -X0*X1 
          SX6    17B
          SX7    X7-1 
          MI     X7,CPY9     IF NOT *EOR* 
          NZ     X7,CPY8     IF *EOF* 
  
*         GET LEVEL NUMBER. 
  
          SA1    WDSX 
          SA2    WBUF+1-1+X1 LAST WORD READ IS LEVEL NUMBER 
          SX7    X1-1        DECREMENT WORD COUNT 
          BX6    X2 
          SA7    A1 
 CPY8     LX6    -12         SET LEVEL NUMBER 
          SA6    LEVL 
          RJ     GCW         GET NEXT CONTROL WORD
          SB7    B6-2 
          ZR     B6,CPY2     IF DATA BLOCK
          ZR     B7,CPY2     IF DAYFILE 
          EQ     CPY10       POSSIBLE ERROR ON DUMP 
  
 CPY9     RJ     GCW         GET NEXT CONTROL WORD
          SB7    B6-2 
          ZR     B6,CPY1     IF DATA
          ZR     B7,CPY1     IF DAYFILE 
          NE     B7,B1,CPY10 IF NOT *NOS* FIELD 
          NE     B5,B1,CPY10 IF NOT END OF VOLUME 
          READO  T           SKIP TRAILING CONTROL WORD 
          RJ     PCW         PROCESS NEXT BLOCK 
          PL     X1,CPY9     IF NOT *EOF* 
          SB7    MES20       * PREMATURE *EOF* ENCOUNTERED.*
          EQ     CPYX        RETURN 
  
*         CHECK FOR ERROR WHEN FILE DUMPED. 
  
 CPY10    SX7    DMER 
          SB6    B6-7 
          ZR     B6,CPY16    IF ERROR WHEN DUMPED 
  
*         PROCESS END OF LOAD FILE. 
  
 CPY11    SA1    ASSF        CHECK IF FILE ASSIGNED 
          NZ     X1,CPY12    IF FILE ASSIGNED 
          RJ     ASF         ASSIGN FILE TO CORRECT DEVICE
          SA1    ALEF 
          ZR     X1,CPY10.1  IF NOT ACCESS LEVEL ERROR
          SX6    X1+1        INDICATE NO SKIP NEEDED
          SA6    A1 
 CPY10.1  NZ     B7,CPYX     IF ERROR IN ASSIGN 
 CPY12    SA1    WDSX        DECREMENT WORD COUNT 
          SX6    17B
          NZ     X1,CPY13    IF NOT EMPTY FIELD 
          SX1    X1+1 
 CPY13    SA2    WBUF+1-1+X1 LAST WORD READ IS LEVEL NUMBER 
          SX3    5
          SA4    CQCW        CHECK FIELD TYPE 
          MX0    -3 
          AX4    9
          SX1    X1-1 
          IX3    X3*X1       BYTE COUNT 
          BX4    -X0*X4      QUEUE FIELD TYPE 
          SX7    64          PRU SIZE 
          SX4    X4-1 
          LX7    36 
          BX7    X7+X3       CONTROL WORD 
          SA7    WBUF 
          MI     X4,CPY15    IF NOT *EOR* 
          NZ     X4,CPY14    IF *EOF* FIELD 
          BX6    X2 
 CPY14    LX6    -12
          SA6    A2 
 CPY15    WRITEW S,WBUF,X1+2 WRITE LAST BLOCK OF DATA 
          SA1    NTCW 
          SA2    NQCW 
          IX3    X1+X2
          SX7    FMER        SET ERROR CODE 
          ZR     X3,CPY17    IF ALL WORD COUNTS ARE ZERO
  
*         CHECK ERROR PROCESSING SELECTION. 
  
 CPY16    SA7    ERTP        SET ERROR TYPE 
          RJ     SQF         POSITION TO END OF QUEUE FILE
          SA2    TARA+ARFC   CHECK ERROR PROCESSING 
          LX2    59-57
          MI     X2,CPY17    IF ERROR PROCESSING SELECTED 
          SA7    ERRF        SET TO IGNORE FILE 
          SB7    B0          CLEAR ERROR INDICATION 
          JP     CPYX        RETURN 
  
 CPY17    WRITECW S,R        FLUSH THE WRITE BUFFER 
          SB5    B0          INDICATE AT END OF RECORD
          RJ     CWE         CHECK FOR WRITE ERROR
          NZ     B7,CPYX     IF UNRECOVERABLE ERROR 
          NZ     B6,CPY1     IF RECOPY REQUIRED 
          JP     CPYX        RETURN 
 DSP      SPACE  4,20 
**        DSP - DISPOSE THE QUEUE FILE. 
* 
*         ENTRY  (ROTB) = ROUTE BLOCK FOR THE FILE. 
*                (IQFE) = *IQFT* ENTRY FOR THE FILE.
*                (ERRF) = 0 IF FILE NOT TO BE IGNORED.
*                (QLIM) = QFT LIMIT.
* 
*         EXIT   FILE DISPOSED TO THE PROPER QUEUE. 
*                (DSPC) = FILE DISPOSITION CODE.
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 4, 5, 6, 7.
* 
*         MACROS QCALL, RETURN, REWIND, ROUTE.
  
  
 DSP4     SA1    Q+1         SET UP *FET* FOR *QFM* CALL
          SX6    X1+QFEWL 
          SX7    X1+
          SA6    A1+B1
          SA7    A6+B1
          SA1    Q           SET FET COMPLETE 
          SX6    B1+
          BX6    X1+X6
          SA6    A1 
          QCALL  RIQF,Q      RELEASE TO THE INACTIVE QUEUE
          SX6    INDP        SET DISPOSITION *INACTIVE* 
          SA6    DSPC 
 DSP5     SX7    B0+         CLEAR ALTERNATE ABORT PROCESSING 
          SA7    ABTI 
  
 DSP      SUBR               ENTRY/EXIT 
          SA4    GNFC        CHECK FOR EOI SECTOR TO WRITE
          NZ     X4,DSP0     IF NO EOI TO WRITE 
          SA4    C+1         SET FET POSITION TO EOI DATA 
          SX7    X4+200B
          SX6    X4+100B
          SA7    C+2
          SA6    C+3
          QCALL  QWEF,C      WRITE EOI SECTOR 
 DSP0     SA4    QLIM        DECREMENT QFT LIMIT
          SA5    ERRF        CHECK FILE ERROR FLAG
          SX7    IGDP        SET FILE *IGNORED* 
          SX6    X4-1 
          SA7    ABTI        SET ALTERNATE ABORT PROCESSING 
          ZR     X5,DSP2     IF FILE NOT IGNORED
 DSP1     SA7    DSPC 
          RETURN S,R         RELEASE THE FILE SPACE 
          EQ     DSP5        RETURN 
  
*         PROCESS ACTIVE QUEUE FILE.
  
 DSP2     SA5    TARA+AROP   CHECK THE LOAD OPTION
          ZR     X5,DSP4     IF INACTIVE LOAD 
          NG     X6,DSP3     IF QFT LIMIT REACHED 
          SA4    ROTB        CLEAR COMPLETION BIT 
          SA6    QLIM        SET NEW QFT LIMIT
          SX7    B0+         PRESET PRIORITY TO ZERO
          SA5    A4+1        CLEAR CENTRAL SITE AND DEFERRED ROUTE BITS 
          SA7    ROTB+3 
          MX0    59 
          BX7    X0*X4
          SA2    IQFE+ENTQ   CHECK FOR ZERO PRIORITY FILE 
          MX4    -24
          BX2    -X4*X2 
          ZR     X2,DSP2.0   IF ZERO PRIORITY FILE
          LX5    -9          CLEAR PRIORITY FLAG
          BX5    X0*X5
          LX5    9
 DSP2.0   MX0    58 
          BX6    X0*X5
          SX1    FREP        SELECT ERROR PROCESSING
          BX6    X1+X6
          SA6    A5 
          SA7    A4 
          SA1    A4+7 
          SX6    EFSP        SET SUBSYSTEM PROCESSING BIT 
          BX6    X1+X6
          SA6    A1 
          REWIND S,R         REPOSITION FILE TO *BOI* 
          ROUTE  ROTB,RECALL RELEASE TO ACTIVE QUEUE
          SA1    ROTB        CHECK FOR ERROR
          MX0    -6 
          AX1    12 
          BX2    -X0*X1 
          ZR     X2,DSP2.3   IF NO ERROR
          SX3    X2-/ERR/EC11  CHECK ERROR RETURNED 
          ZR     X3,DSP2.2   IF UNDEFINED SERVICE CLASS 
          SX3    X2-/ERR/EC45 
          ZR     X3,DSP2.2   IF INCORRECT SERVICE CLASS 
 DSP2.1   SX7    IGDP        SET FILE IGNORED 
          EQ     DSP1        RETURN CURRENT FILE
  
*         RETRY ROUTING OF FILE.
  
 DSP2.2   BX6    X0*X1       RESET FILE NAME IN BLOCK 
          LX6    12 
          SA6    A1 
          SA1    A1+B1       CLEAR SERVICE CLASS FLAG 
          MX0    59 
          LX1    -20
          BX6    X0*X1
          LX6    20 
          SA6    A1+
          SX7    EFSP+EFSC   FORCE ORIGIN DEFAULT SERVICE CLASS 
          SA7    ROTB+7 
          ROUTE  ROTB,RECALL RETRY FILE ROUTING 
          SA1    ROTB        CHECK FOR ERROR
          AX1    12 
          MX0    -6 
          BX2    -X0*X1 
          NZ     X2,DSP2.1   IF ERROR 
 DSP2.3   SX6    ACDP        SET DISPOSITION *ACTIVE* 
          SA6    DSPC 
          EQ     DSP5        RETURN 
  
 DSP3     SX6    MES11       * QFT LIMIT ON LOAD.*
 DSP3.1   SA6    TRMM 
          SX7    LSDP        LIST REMAINING FILES 
          SA7    LIST 
          EQ     DSP1        RETURN CURRENT FILE
 GNF      SPACE  4,20 
**        GNF - GET NEXT QUEUED FILE. 
* 
*         ENTRY  LOAD FILE POSITIONED TO THE START OF A QUEUED FILE.
* 
*         EXIT   ROUTE BLOCK COPIED TO *ROTB*.
*                SYSTEM SECTOR COPIED TO *SSBF*.
*                (CQCW) = CURRENT QUEUE CONTROL WORD. 
*                (NQCW) = WORDS TO NEXT CONTROL WORD. 
*                (B7) = ADDRESS OF ERROR MESSAGE. 
*                (B7) = 0 IF NO ERRORS. 
*                (X1) = NEGATIVE IF *EOF* ENCOUNTERED.
*                (X4) = NONZERO, IF VERSION ONE FILE TO SKIP. 
* 
*         USES   X - 1, 3, 4, 6.
*                A - 3, 6.
*                B - 2, 4, 6, 7.
* 
*         CALLS  GCW, PCW, RES, RSF, RSS. 
* 
*         MACROS MESSAGE, READO, SKIPFF.
  
  
 GNF10    SB7    MES3        * LOAD FILE MISPOSITIONED.*
  
 GNF      SUBR               ENTRY/EXIT 
 GNF1     RJ     PCW         PROCESS CONTROL WORD 
          MI     X1,GNFX     IF *EOF* ENCOUNTERED 
          RJ     GCW         GET NEXT QUEUE CONTROL WORD
 GNF2     SX4    B6-1 
          NZ     X4,GNF8     IF NOT ROUTE BLOCK 
          SB4    ROTB        COPY ROUTE BLOCK 
          SA3    NQCW 
          RJ     RSF
          NZ     B7,GNFX     IF ERROR ENCOUNTERED 
          JP     B6+GNF3     PROCESS CONTROL BYTE 
  
 GNF3     BSS    0
          LOC    0
          EQ     GNF6        IF DATA FIELD
+         EQ     GNF10       IF ROUTE BLOCK 
+         EQ     GNF6        IF DAYFILE 
+         EQ     GNF4        IF *NOS* SYSTEM FIELD
+         EQ     GNF5        IF *NOS/BE* FIELD
+         EQ     GNF5        IF SCOPE 2 FIELD 
+         EQ     GNF8        IF DUMP HEADER FIELD 
+         EQ     GNF10       IF ERROR BLOCK 
          LOC    *O 
  
 GNF4     EQ     B5,B1,GNF9  IF END OF VOLUME 
          SB4    SSBF        COPY SYSTEM INFORMATION
          SA3    NQCW        GET NUMBER OF WORDS TO COPY
          SX6    X3-SSBFL    SAVE LENGTH OF SYSTEM INFORMATION
          SA6    GNFC 
          RJ     RSF
          NZ     B7,GNFX     IF ERROR ENCOUNTERED 
          SA3    SSBF        GET SYSTEM SECTOR TYPE 
          MX6    -6 
          AX3    6
          BX6    -X6*X3 
          BX4    X4-X4       CLEAR VERSION ONE FILE TO SKIP 
          SX3    X6-ROFT
          PL     X3,GNFX     IF VERSION TWO SYSTEM SECTOR 
          RJ     RSS         REFORMAT VERSION ONE SYSTEM SECTOR 
          NZ     X4,GNFX     IF VERSION ONE FILE TO BE SKIPPED
          SA3    GNFC        CHECK FOR EOI SECTOR TO REFORMAT 
          NZ     X3,GNFX     IF NO EOI TO REFORMAT
          RJ     RES         REFORMAT EOI SECTOR
          EQ     GNFX        RETURN 
  
 GNF5     SA3    T           SET LEVEL 17 INTO FET
          MX6    4
          LX6    18 
          BX3    -X6*X3 
          BX6    X6+X3
          SA6    A3 
          SKIPFF A3,1,R      SKIP TO *EOF*
          SA3    T
          LX3    59-9 
          MX1    1           SET *EOF* ENCOUNTERED
          NG     X3,GNF10    IF *EOI* ENCOUNTERED 
          EQ     GNFX        RETURN 
  
 GNF6     BX6    X6-X6       CLEAR *SSBF* 
          SB7    B0          CLEAR ERROR STATUS 
          SB2    SSBF+SSBFL-1 
          SA6    SSBF 
 GNF7     SA6    A6+B1
          SB6    A6-B2
          MI     B6,GNF7     IF NOT END OF BUFFER 
          BX4    X4-X4       CLEAR VERSION ONE FILE TO SKIP 
          EQ     GNFX        RETURN 
  
 GNF8     SB2    B6-3        CHECK IF *NOS* FIELD 
          SB6    B6-6        CHECK IF HEADER FIELD
          SB4    GNFB        COPY HEADER FIELD TO MESSAGE AREA
          ZR     B2,GNF4     IF *NOS* FIELD 
          NZ     B6,GNF10    IF NOT HEADER FIELD
          SX3    4
          RJ     RSF         READ SKIP FIELD
          MESSAGE GNFA       *** PROCESSING DUMP FILE. ***
          MESSAGE GNFB       *DUMPNAM     DATE, TIME.*
          NZ     B7,GNFX     IF ERROR ENCOUNTERED 
          EQ     GNF2        PROCESS NEXT RECORD
  
*         PROCEED TO NEXT REEL. 
  
 GNF9     READO  T           SKIP TRAILING CONTROL WORD 
          EQ     GNF1        PROCESS NEXT BLOCK 
  
 GNFA     DATA   C$*** PROCESSING DUMP FILE. ***$ 
 GNFB     BSS    5
 GNFC     BSS    1           EOI PRESENT FLAG 
 ISM      SPACE  4,20 
**        ISM - ISSUE FILES LOADED MESSAGE. 
* 
*         ENTRY  (FLDS) = FILE DISPOSITION COUNTS.
*                (EFCT) = ERROR FILE COUNT. 
* 
*         EXIT   OUTPUT FILE FLUSHED. 
* 
*         USES   A - 1, 2, 6. 
*                B - 3, 6.
*                X - 0, 1, 2, 6.
* 
*         CALLS  CDD. 
  
  
 ISM      SUBR               ENTRY/EXIT 
          SB6    B0+         CLEAR MESSAGE INDEX
 IMS1     SA1    FLDS+B6     GET DISPOSITION COUNT
          SB6    B6+B1       INCREMENT INDEX
          SB3    B6-FLDSL-1 
          ZR     B3,IMS2     IF END OF MESSAGES 
          ZR     X1,IMS1     IF EMPTY COUNT 
          RJ     CDD         CONVERT COUNT TO DECIMAL DISPLAY CODE
          SA2    IMSA-1+B6   MERGE COUNT WITH MESSAGE 
          SA1    X2+B1
          MX0    -24
          BX6    -X0*X6 
          LX0    -24
          BX1    X0*X1
          LX6    -24
          BX6    X6+X1
          SA6    A1 
          MESSAGE X2
          EQ     IMS1        LOOP TO END OF MESSAGES
  
 IMS2     WRITER O,R         FLUSH OUTPUT FILE
          JP     ISMX        RETURN 
  
*         THE FOLLOWING TABLES ARE ORDER DEPENDENT. 
  
 IMSA     CON    IMSB 
          CON    IMSC 
          CON    IMSD 
          CON    IMSE 
          CON    IMSF 
  
 IMSB     DATA   C* QLOAD -  NNNN FILES IGNORED.* 
 IMSC     DATA   C* QLOAD -  NNNN ACTIVE FILES LOADED.* 
 IMSD     DATA   C* QLOAD -  NNNN INACTIVE FILES LOADED.* 
 IMSE     DATA   C* QLOAD -  NNNN FILES LISTED.*
 IMSF     DATA   C* QLOAD -  NNNN ERRXXX FILES CREATED.*
 PLF      SPACE  4,15 
**        PLF - POSITION LOAD FILE. 
* 
*         ENTRY  LOAD FILE ASSIGNED TO JOB. 
* 
*         EXIT   LOAD FILE POSITION TO SELECTED POSITION. 
*                (B7) = ERROR MESSAGE ADDRESS.
*                (B7) = 0 IF NO ERROR OCURRED.
* 
*         USES   A - 4, 5, 6. 
*                B - 7. 
*                X - 0, 4, 5, 6.
  
  
 PLF4     SB7    MES3        * LOAD FILE MISPOSITIONED.*
  
 PLF      SUBR               ENTRY/EXIT 
          SA5    TARA+ARFC   CHECK FOR REWIND 
          LX5    59-58
          PL     X5,PLF1     IF REWIND NOT SELECTED 
          REWIND T,R
 PLF1     SA5    TARA+ARNF   CHECK FILE SKIP COUNT
          ZR     X5,PLF2     IF NO FILE COUNT 
          SA4    T           SET LEVEL NUMBER 
          MX0    4
          LX0    18 
          BX6    X4+X0
          SA6    A4 
          SKIPFF A4,X5,R     SKIP FILE COUNT
          SA5    T           CHECK RESPONSE 
          LX5    59-9 
          MI     X5,PLF4     IF INCORRECT POSITION
 PLF2     SA5    TARA+ARSC   CHECK SECTOR COUNT 
          SA4    T           CLEAR LEVEL NUMBER 
          ZR     X5,PLF3     IF SKIP COUNT NOT SPECIFIED
          MX0    4
          SX5    X5+B1       SKIP HEADER RECORD 
          LX0    18 
          BX6    -X0*X4 
          SA6    A4 
          SKIPF  A4,X5,R     SKIP RECORD COUNT
          SA5    T           CHECK RESPONSE 
          BX6    X5 
          LX5    59-9 
          MI     X5,PLF4     IF *EOI* 
 PLF3     READCW T,17B       INITIALIZE READ
          SB7    B0          CLEAR ERROR
          JP     PLFX        RETURN 
 PRS      SPACE  2,20 
**        PRS - PRESET FILES AND CONTROL. 
* 
*         ENTRY  PARAMETERS PROCESSED BY *QFSP*.
* 
*         EXIT   CONTROL BLOCKS CLEARED.
*                FILES INTIALIZED.
*                CONTROL FLAGS PRESET.
*                (B7) = ERROR MESSAGE ADDRESS.
*                (B7) = 0 IF NO ERROR.
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 2, 3, 5, 6, 7.
*                B - 5, 6, 7. 
* 
*         CALLS  PIQ, SFN, SQL. 
* 
*         MACROS CLOCK, DATE, EREXIT, MEMORY, SETFS, WRITE. 
  
  
 PRS5     SA2    X3+TEQA     CHECK FOR REMOVABLE DEVICE 
          ZR     X3,PRS6     IF EQUIPMENT NOT SPECIFIED 
          LX2    59-1 
          SB7    MES6        * ACTIVE LOAD NOT ALLOWED.*
          NG     X2,PRSX     IF REMOVABLE DEVICE
 PRS6     RJ     SQL         SET QFT LIMIT
          SB7    B0+         CLEAR ERROR INDICATOR
          SX6    B0+         CLEAR FOT AND LID TABLE FULL FLAGS 
          SA6    FOTF 
          SA6    LTFL 
  
 PRS      SUBR               ENTRY/EXIT 
          SX7    99999
          SA7    LINE        FORCE PAGE EJECT 
          SX6    B1 
          BX7    X7-X7       CLEAR CONTROL BLOCK
          SA7    FWA
          SB6    ROTB+EPBL-1
          SA6    PDFE+1      ENABLE PRINT DENSITY CONTROL 
 PRS1     SA7    A7+B1
          SB5    A7-B6
          MI     B5,PRS1     IF NOT END OF BLOCK
          SA7    SSBF        CLEAR SYSTEM INFORMATION BUFFER
          SB6    SSBF+SSBFL-1 
 PRS2     SA7    A7+B1
          SB5    A7-B6
          MI     B5,PRS2     IF NOT END OF BLOCK
          SA1    T+1         CLEAR ERROR PROCESSING BIT 
          SA6    WPHA        RESET PAGE COUNT 
          LX6    44 
          BX6    -X6*X1 
          SA5    TARA+ARFC   SET LIST CONTROL 
          SA6    T+1
          SX6    MES1        * QLOAD OPERATION COMPLETE.* 
          SX7    X5 
          SA7    LIST 
          ZR     X7,PRS3     IF *QLOAD* 
          SX7    LSDP        SET LIST DISPOSITION 
          SX6    MES5        * LDLIST OPERATION COMPLETE.*
          SA7    DSPC 
 PRS3     SA6    TRMM        SET TERMINATION MESSAGE
          EREXIT ABT         SET ERROR EXIT ADDRESS 
  
*         SET OUTPUT FILE NAME. 
  
          SA1    TARA+ARLL   GET FILE NAME
          SX6    B1          CLEAR BUSY STATUS
          BX6    X6+X1
          SA6    O
          WRITE  O,*         PRESET WRITE FUNCTION
          SETFS  O,0         PRESERVE OUTPUT FILE 
          SA5    TARA+ARFC   CHECK IF *OUT* REQUEST 
          SB7    B0 
          SX5    X5-3 
          ZR     X5,PRSX     IF *OUT* REQUEST 
  
*         PROCESS LOAD FILE AND CHECK FILE NAMES. 
  
          SA3    NIQ         COMPARE FILE NAMES 
          SA5    TARA+ARFN   SET LOAD FILE NAME 
          MX0    42 
          SX4    B1          CLEAR BUSY STATUS
          BX1    X6-X5
          BX2    X6-X3
          BX3    X5-X3
          BX6    X4+X5
          BX1    X0*X1
          BX2    X0*X2
          BX3    X0*X3
          SA6    T
          SB7    MES9        * FILE NAME CONFLICT.* 
          ZR     X1,PRSX     IF OUTPUT AND LOAD MATCH 
          ZR     X2,PRSX     IF OUTPUT AND *IQFT* MATCH 
          ZR     X3,PRSX     IF LOAD AND *IQFT* MATCH 
  
*         SET FIELD LENGTH, TIME AND DATE.
  
          SA1    T+1         RESET ERROR PROCESSING BIT 
          SX6    B1 
          LX6    44 
          BX7    X6+X1
          SA7    A1 
          DATE   WPHC        SET DATE IN OUTPUT HEADER
          CLOCK  WPHD        SET TIME IN OUTPUT HEADER
          SA1    PRSA        CHECK IF ASSIGNED
          NZ     X1,PRS4     IF *FL* ASSIGNED 
          MEMORY CM,PRSA,R,RFL= 
  
 PRS4     SA1    TARA+AROP   CHECK FOR ACTIVE LOAD
          SA5    LIST        CHECK FOR LIST OPTION
          SA2    TARA+ARDF   CHECK DESTINATION DEVICE 
          SA3    TARA+ARDD   CHECK DEVICE 
          SB7    B0+
          NZ     X5,PRSX     IF LIST OPTION 
          NZ     X1,PRS5     IF ACTIVE LOAD 
          SB7    MES8        * DESTINATION DEVICE REQUIRED.*
          ZR     X2,PRSX     IF DESTINATION = *ALL* 
          RJ     PIQ         PROCESS *IQFT* FILE
          JP     PRSX        RETURN 
  
  
 PRSA     CON    0           MEMORY REQUEST WORD
 SQF      SPACE  4,20 
**        SQF - SKIP QUEUED FILE. 
* 
*         ENTRY  (NTCW) = WORDS TO NEXT CONTROL WORD. 
*                (EOR) = NON-ZERO IF EOR BLOCK. 
* 
*         EXIT   LOAD FILE POSITIONED TO NEXT RECORD. 
*                (B7) = ADDRESS OF ERROR MESSAGE IF ERROR OCCURED.
*                (B7) = 0 IF NO ERRORS. 
* 
*         USES   A - 5, 6.
*                B - 7. 
*                X - 1, 5, 6. 
* 
*         CALLS  PCW. 
  
  
 SQF      SUBR               ENTRY/EXIT 
 SQF1     SA5    NTCW        DECREMENT WORD COUNT 
          SX1    100B 
          IX6    X5-X1
          SA6    A5 
          MI     X6,SQF2     IF .LT. 100 WORDS
          READW  T,BTB,X1    SKIP BLOCK 
          EQ     SQF1        LOOP 
  
 SQF2     ZR     X5,SQF3     IF NO DATA IN BLOCK
          READW  T,BTB,X5    SKIP REMAINDER OF BLOCK
 SQF3     READO  T           READ LEVEL NUMBER
          SA5    EOR
          SB7    B0+         CLEAR ERROR INDICATION 
          NZ     X5,SQFX     IF *EOR* ENCOUNTERED 
          RJ     PCW         PROCESS NEXT CONTROL WORD
          PL     X1,SQF1     IF NOT *EOF* 
          SB7    MES20       * PREMATURE *EOF* ENCOUNTERED.*
          JP     SQFX        RETURN 
 WIQ      SPACE  4,20 
**        WIQ - WRITE ENTRY TO *IQFT* FILE. 
* 
*         ENTRY  (IQFE) = *IQFT* ENTRY. 
*                (ERRF) = 0 IF FILE NOT TO BE IGNORED.
* 
*         EXIT   ENTRY COPIED TO THE *IQFT* FILE IF INACTIVE LOAD.
*                (X4) = 0 IF FILE NOT TO BE IGNORED.
* 
*         USES   A - 4, 5, 6. 
*                X - 4, 5, 6. 
* 
*         MACROS WRITEW.
  
  
 WIQ      SUBR               ENTRY/EXIT 
          SA4    ERRF        CHECK IF FILE IGNORED
          SA5    TARA+AROP   CHECK OPTION 
          NZ     X4,WIQX     IF FILE IGNORED
          NZ     X5,WIQX     IF NOT INACTIVE LOAD 
          WRITEW NIQ,IQFE,QFEWL 
          SX6    B1          INDICATE DATA WRITTEN TO *IQFT* FILE 
          BX4    X4-X4       SET FILE NOT IGNORED 
          SA6    DWIQ 
          EQ     WIQX        RETURN 
 WOL      SPACE  4,20 
**        WOL - WRITE OUTPUT LINE.
* 
*         ENTRY  (FILE) = QUEUE FILE COUNT. 
*                (LINE) = LINE NUMBER.
*                (IQFE)= *IQFT* ENTRY.
*                (DSPC) = DISPOSITION CODE. 
*                (DEVN) = DEVICE NUMBER.
*                (ERTP) = ERROR TYPE, 0 = NO ERROR. 
*                (OLDN) = OLD QUEUE FILE NAME.
* 
*         EXIT   LINE WRITTEN TO OUTPUT FILE. 
*                FILE DISPOSITION COUNTS UPDATED. 
* 
*         USES   A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 4, 7.
*                X - ALL. 
* 
*         CALLS  FQO, WPH.
* 
*         MACROS WRITEW.
  
  
 WOL      SUBR               ENTRY/EXIT 
          SA5    LINE 
          SX6    X5+B1       BUMP LINE COUNT
          SA6    A5 
          SA1    A5+B1
          IX7    X6-X1
          NG     X7,WOL1     IF NOT FULL PAGE 
          RJ     WPH         WRITE PAGE HEADER
 WOL1     SA1    FILE 
          SA2    OLDN        SET OLD FILE NAME
          SX6    X1+B1       INCREMENT FILE COUNT 
          MX0    24 
          BX7    X0*X2
          SX2    IQFE        SET ADDRESS OF *IQFT* ENTRY
          SA3    DSPC        GET DISPOSITION CODE 
          SB7    WOLG        ADDRESS OF NULL FAMILY/DEVICE
          SX4    X3-IGDP
          ZR     X4,WOL2.1   IF IGNORED 
          SX4    X3-LSDP
          ZR     X4,WOL2.1   IF LISTED
          SB7    DEVN        SET ADDRESS OF ASSIGNED FAMILY/DEVICE
 WOL2.1   SA4    FLDS-1+X3   UPDATE DISPOSITION COUNT 
          SA3    X3+WOLA-1   GET DISPOSITION FIELD
          SA5    X2 
          MX0    -36
          BX1    -X0*X5 
          BX7    X1+X7
          SA7    X2 
          SA6    A1 
          SX7    X4+B1
          BX1    X6          SET LINE NUMBER
          SA7    A4 
          SX5    IQFE 
          RJ     FQO         FORMAT OUTPUT LINE 
          SA5    ERTP        CHECK FOR ERRORS 
          NZ     X5,WOL3     IF ERRORS ON FILE
          WRITEW O,B3,B2     WRITE LINE TO OUTPUT FILE
          BX6    X6-X6
          SA6    ERRF 
          JP     WOLX 
  
 WOL3     SB4    B2-B1       SKIP MESSAGE TERMINATOR
          WRITEW O,B3,B4     WRITE OUT LINE 
          SA5    ERTP        APPEND ERROR MESSAGE 
          SA5    WOLB+X5-1
          WRITEW O,X5,4 
          SX6    B0+         CLEAR ERROR MESSAGE INDICATION 
          SA6    ERTP 
          SA6    ERRF 
          JP     WOLX        RETURN 
  
 WOLA     BSS    0
          LOC    1
 IGDP     DATA   H*IGNORED* 
 ACDP     DATA   H*ACTIVE*
 INDP     DATA   H*INACTIVE*
 LSDP     DATA   H*LISTED*
          LOC    *O 
  
 WOLB     BSS    0
          LOC    1
 DMER     CON    WOLC 
 RPER     CON    WOLD 
 FMER     CON    WOLE 
 VOER     CON    WOLF 
 ALER     CON    WOLH 
          LOC    *O 
  
 WOLC     DATA   C*   MASS STORAGE ERROR DURING DUMP.*
 WOLD     DATA   C*   READ PARITY ERROR ON LOAD FILE.*
 WOLE     DATA   C*   LOAD RECORD FORMAT IN ERROR.   *
 WOLF     DATA   C*   UNABLE TO LOAD VERSION 1 FILE. *
 WOLH     DATA   C*   FILE NOT ALLOWED ON EQUIPMENT. *
  
 WOLG     DATA   7L          NULL FAMILY/DEVICE 
          TITLE  SUBROUTINES. 
 ASF      SPACE  4
**        ASSIGN FILE TO MASS STORAGE.
* 
*         ENTRY  (WBUF+1) = FIRST BLOCK OF FILE.
*                (SSBF) = SYSTEM SECTOR FOR FILE. 
*                (ROTB) = ROUTE BLOCK FOR FILE. 
* 
*         EXIT   FILE ASSIGNED TO MASS STORAGE. 
*                NAME OF FILE CHANGED IF ACTIVATE REQUEST.
*                (DEVN) = *TEQA* ENTRY OF ASSIGNED EQUIPMENT. 
*                (B7) = 0 IF NO ERRORS. 
*                (B7) = ADDRESS OF ERROR MESSAGE IF ERROR OCCURED.
*                (ALEF) = 1, IF INVALID ACCESS LEVEL FOR DEVICE.
* 
*         USES   A - 2, 3, 4, 5, 6, 7.
*                B - 6, 7.
*                X - 0, 2, 3, 4, 5, 6, 7. 
* 
*         CALLS  GSF, WSF, *QFM*. 
* 
*         MACROS QCALL, STATUS, WRITECW.
  
  
 ASF4     SA2    TARA+AROP
          ZR     X2,ASF6     IF INACTIVATE REQUEST
          SA5    C           SET NEW JSN
          SX3    B1+
          MX0    24 
          BX5    X0*X5
          BX6    X3+X5
          SA6    S
          SA3    IQFE        CHANGE *IQFT* ENTRY NAME 
          SA2    ROTB        CHANGE NAME IN ROUTE BLOCK 
          MX0    -18
          BX2    -X0*X2 
          MX0    -36
          BX3    -X0*X3 
          BX7    X3+X5
          BX6    X2+X5
          SA7    A3 
          SA6    A2 
 ASF6     STATUS S,P         CHECK EQUIPMENT ASSIGMENT
          SA5    S+6
          MX0    -6 
          LX5    12 
          BX6    -X0*X5 
          SA5    TEQA+X6
          BX6    X5 
          SA6    DEVN 
          SX4    X4-NSEE
          NZ     X4,ASF7     IF NOT ACCESS LEVEL ERROR
          SX6    B1+         SET ERROR FLAGS
          SA6    ALEF 
          SX6    ALER 
          SA6    ERTP 
          EQ     ASFX        RETURN 
  
 ASF7     MX7    1           INDICATE FILE ASSIGNED TO MASS STORAGE 
          SA7    ASSF 
          SB7    B0          CLEAR ERROR INDICATOR
          WRITECW  S,*       PRESET WRITE FUNCTION
  
 ASF      SUBR               ENTRY/EXIT 
          SA5    TARA+ARDF   CHECK IF DESTINATION DEFINED 
          SX6    NEEQ 
          ZR     X5,ASF1     IF DESTINATION NOT DEFINED 
          SA5    TARA+ARDD   GET DESTINATION DEVICE 
          SX6    X5 
 ASF1     SX5    EQSS        SET EQUIPMENT IN SYSTEM SECTOR 
          LX6    -12         POSITION EST ORDINAL 
          MX4    12 
          SB6    SSBF 
          RJ     WSF         WRITE SYSTEM SECTOR FIELD
          SA1    TARA+AROP   SET ACTIVATE/INACTIVATE REQUEST
          SX6    B1 
          BX6    X1-X6
          LX6    -11
          SX5    GQSS 
          SB6    SSBF 
          MX4    12 
          RJ     WSF         WRITE SYSTEM SECTOR FIELD
          SA1    S
          SA2    C+1
          BX6    X1 
          SX7    400B        SET ERROR PROCESSING BIT 
          LX7    36 
          BX7    X2+X7
          SA6    C
          SA7    C+1
          SX7    X2+100B
          SA7    C+2
          QCALL  CQFF,C      CREATE FILE
          SA5    C           CHECK FOR ERRORS 
          MX0    -4 
          AX5    10 
          BX4    -X0*X5 
          ZR     X4,ASF4     IF NO ERROR
          SB7    B1          INDICATE ERROR 
          SX6    IGDP        SET FILE *IGNORED* 
          SA6    DSPC 
          SA6    ERRF        SET FILE ERROR FLAG
          SX2    X4-NSEE
          ZR     X2,ASF4     IF ACCESS LEVEL ERROR
          SX6    MES13       * QFT FULL DETECTED BY *QFM*.* 
 ASF3     SA6    TRMM        SET TERMINATION MESSAGE
          SX6    LSDP        SET TO LIST FILES
          SA6    LIST 
          SA6    DSPC 
          EQ     ASF4        RETURN 
          SPACE  4,15 
**        CFN - CHANGE FILE NAME. 
* 
*         EXIT   (B7) = 0 IF NO ERRORS. 
*                (B7) = ADDRESS OF ERROR MESSAGE IF AN ERROR OCCURED. 
*                FILE CONVERTED TO LOCKED COMMON FILE *ERRNNN*. 
*                (ERCT) ERROR FILE COUNT UPDATED. 
* 
*         USES   A - 5, 6, 7. 
*                B - 7. 
*                X - 0, 1, 4, 5, 6, 7.
* 
*         CALLS  CDD. 
* 
*         MACROS QCALL. 
  
  
 CFN3     SB7    MES18       * *QFM* ERROR ON ERRNNN FILE.* 
  
 CFN      SUBR               ENTRY/EXIT 
 CFN1     SA5    CFNA        GET NEXT SEQUENCE NUMBER 
          SX6    X5+B1
          BX1    X6 
          SX7    X5-1999
          SA6    A5 
          SB7    MES15       * ERROR FILE LIMIT.* 
          PL     X7,CFNX     IF ERROR FILE LIMIT
          RJ     CDD         CONVERT FILE NUMBER
          MX0    -18
          SA5    CFNB        MERGE NAME 
          BX6    -X0*X6 
          LX6    24 
          BX7    X6+X5       FORM NEW NAME
          SA7    S+6
  
*         CONVERT TO COMMON FILE. 
  
          QCALL  IQFF,Q 
          SA5    X2 
          SX0    17BS10 
          BX6    X0*X5
          AX6    10 
          SX7    X6-DFNE
          ZR     X7,CFN2     IF DUPLICATE FILE NAME 
          NZ     X6,CFN3     IF OTHER ERROR 
          SA5    EFCT        UPDATE ERROR FILE COUNT
          SB7    B0          CLEAR ERROR INDICATION 
          SX6    X5+B1
          SA6    A5 
          JP     CFNX        RETURN 
  
*         PROCESS DUPLICATE ERROR FILE NAME.
  
 CFN2     SA4    CFNA        INCREMENT SEQUENCE NUMBER BY 10D 
          SX7    X4+10
          SA7    A4 
          EQ     CFN1        TRY A NEW FILE NAME
  
 CFNA     DATA   999         ERROR FILE SEQUENCE NUMBER 
 CFNB     DATA   3CERR
 CRB      SPACE  4
**        CRB - CONVERT ROUTE BLOCK.
* 
*         ENTRY  (ROTB) = ROUTE BLOCK FOR QUEUE FILE. 
* 
*         EXIT   (SSBF) = SYSTEM SECTOR IMAGE FOR FILE. 
*                (IQFE) = *IQFT* ENTRY FOR FILE.
*                (OLDN) = OLD FILE NAME.
*                FILE NAME SET IN *FET*S. 
* 
*         USES   A - 1, 3, 5, 6, 7. 
*                B - 6. 
*                X - ALL. 
* 
*         CALLS  WSF. 
  
  
 CRB7     SA1    IQFE        SET INVALID QUEUE TYPE 
          SX6    NRQT*100B
          MX0    48 
          BX1    X0*X1
          BX6    X1+X6
          SA6    A1 
  
 CRB      SUBR               ENTRY/EXIT 
  
*         CLEAR *IQFT* ENTRY. 
  
          BX6    X6-X6
          SB6    QFEWL-1     SET ENTRY LENGTH 
 CRB0     SA6    IQFE+B6
          SB6    B6-B1
          PL     B6,CRB0     IF NOT END OF ENTRY
  
*         SET FILE NAME.
  
          SA5    ROTB        GET FILE NAME
          MX4    42 
          SX7    B1 
          BX6    X4*X5
          BX7    X6+X7       SET FILE NAME IN *FET*S
          SA7    S
          SA6    IQFE        SET NAME IN *IQFT* BLOCK 
          SA7    Q
  
*         SET SERVICE CLASS AND ORIGIN TYPE.
  
          SA3    IQFE        GET FILE NAME
          SA1    ROTB+7 
          SX2    EFCU 
          BX1    X2*X1
          ZR     X2,CRB0.3   IF NO CREATION USER NAME 
          MX0    -6          GET ORIGIN TYPE
          LX5    -1 
          BX5    -X0*X5 
          SA1    ROTB+4      GET SERVICE CLASS
          LX1    -36
          MX0    -12
          BX2    -X0*X1 
          SX7    B1 
 CRB0.1   SA1    CRBC+X7     SEARCH FOR SERVICE CLASS 
          ZR     X1,CRB0.3   IF END OF TABLE
          BX4    X2-X1
          ZR     X4,CRB0.2   IF FOUND 
          SX7    X7+B1       INCREMENT TABLE INDEX
          EQ     CRB0.1      CHECK NEXT ENTRY 
  
 CRB0.2   LX7    6
          IX7    X7+X5
          LX5    12 
          BX6    X5 
          EQ     CRB1        SET UP QFT ENTRY 
  
 CRB0.3   SA5    ROTB+1 
          SX6    BCOT*10000B
          SX7    BCSC*100B+BCOT 
          LX5    59-3 
          SA3    IQFE        MERGE WITH FILE NAME 
          PL     X5,CRB1     IF BATCH ORIGIN
          SX6    EIOT*10000B
          SX7    RBSC*100B+EIOT 
 CRB1     LX7    48 
          SA7    IQFE+SCLQ
          BX6    X3+X6
          SA6    CRBB 
  
*         PROCESS QUEUE TYPE. 
  
          SA1    IQFE 
          SA5    ROTB+1 
          MX0    -12
          AX5    24 
          BX5    -X0*X5 
          SX6    INQT 
          SX7    INQF 
          SX2    X5-2RIN
          SX3    X5-2RPU
          ZR     X2,CRB3     IF INPUT FILE
          SX6    PHQT 
          SX7    PUQF 
          ZR     X3,CRB4     IF PUNCH FILE
  
*         PROCESS PRINT FILES.
  
          SX6    PRQT 
          LX6    6
          SA1    CRBB 
          BX6    X6+X1
          SA6    A1 
          SB6    CRBAL-1
 CRB2     SA1    CRBA+B6
          BX4    -X0*X1 
          SB6    B6-B1
          BX6    X4-X5       COMPARE CHARACTERS 
          ZR     X2,CRB2.1   IF MATCH FOUND 
          PL     B6,CRB2     IF MORE ENTRIES TO CHECK 
          EQ     CRB7        SET ERROR EXIT 
  
 CRB2.1   MX0    6           GET DISPOSITION CODE 
          BX1    X0*X1
          LX0    12 
          LX1    12 
          SA2    IQFE        UPDATE QFT ENTRY 
          BX2    -X0*X2 
          BX6    X1+X2
          SA6    A2 
          EQ     CRB4.1      SET EXTERNAL CHARACTERISTICS 
  
*         PROCESS INPUT FILE. 
  
 CRB3     LX6    6           MERGE WITH QFT/FNT IMAGES
          LX7    6
          BX7    X7+X1
          SA7    A1 
          SA1    CRBB 
          BX6    X6+X1
          SA6    A1 
          EQ     CRB6 
  
*         PROCESS PUNCH FILE. 
  
 CRB4     LX6    6           MERGE WITH QFT/FNT IMAGES
          LX7    6
          BX7    X7+X1
          SA7    A1 
          SA1    CRBB 
          BX6    X6+X1
          SA6    A1 
 CRB4.1   SA1    ROTB+1      SET EXTERNAL CHARACTERISTICS 
          MX0    -3 
          LX1    59-20
          BX6    -X0*X1 
          LX6    15-0 
          SA1    IQFE+SCLQ
          BX6    X1+X6
          SA6    A1 
          EQ     CRB6 
  
*         PROCESS OTHER DEVICES.
  
 CRB5     EQ     CRB7        NONE SUPPORTED AT THIS TIME
  
*         SET INFORMATION INTO SYSTEM SECTOR. 
  
 CRB6     MX4    60 
          SA1    CRBB        SET FNT ENTRY
          BX6    X1 
          SA6    OLDN        SET OLD FILE NAME
          SX5    FNSS 
          SB6    SSBF 
          RJ     WSF
          SX5    IOSS        SET QFT ENTRY
          SX5    IQFE        SET IQFT ADDRESS 
          BX6    X1 
          SB6    SSBF 
          RJ     WSF         WRITE SYSTEM SECTOR FIELD
          SX5    IOSS+SCLQ
          SA1    IQFE+SCLQ
          BX6    X1 
          SB6    SSBF 
          RJ     WSF         WRITE SYSTEM SECTOR FIELD
          JP     CRBX        RETURN 
  
*         PRINTER DISPOSITION CODE EQUIVALENCES.
  
 CRBA     BSS    0
          VFD    6/LPQF,42/0,12/2RPR  ANY PRINTER 
          VFD    6/LPQF,42/0,12/2RP1  RESERVED
          VFD    6/P2QF,42/0,12/2RP2  512 
          VFD    6/LRQF,42/0,12/2RLR  580-12
          VFD    6/LSQF,42/0,12/2RLS  580-16
          VFD    6/LTQF,42/0,12/2RLT  580-20
          VFD    6/LXQF,42/0,12/2RLX  5870
          VFD    6/LYQF,42/0,12/2RLY  5970
 CRBAL    EQU    *-CRBA      TABLE LENGTH 
  
  
 CRBB     BSS    1           FNT ENTRY FOR SYSTEM SECTOR
  
 CRBC     BSS    0
          LOC    0
          BSS    1           NOT USED 
          LIST   D
 .SCL     HERE
          LIST   *
          LOC    *O 
          CON    0           END OF TABLE 
 CWE      SPACE  4
**        CWE - CHECK WRITE ERROR.
* 
*         ENTRY  (X2) = *FET* ADDRESS.
* 
*         EXIT   (B6) NON-ZERO IF FILE TO BE RECOPIED.
*                (B7) = 0 IF NO ERRORS. 
*                (B7) = ADDRESS OF ERROR MESSAGE IF AN ERROR OCCURED. 
*                IF A WRITE PARITY ERROR OCCURED THE CURRENT
*                DESTINATION FILE IS CHANGED TO A LOCKED COMMON FILE
*                AND THE COPY IS RESTARTED. 
* 
*         USES   A - 5, 6, 7. 
*                B - 6, 7.
*                X - 0, 5, 6, 7.
* 
*         CALLS  CFN, RPF, RSC. 
  
  
 CWE3     SB6    B0+         CLEAR ERROR STATUS 
          SB7    B0+
  
 CWE      SUBR               ENTRY/EXIT 
          SA5    X2          CHECK *FET* STATUS 
          SX0    36000B 
          BX6    X0*X5
          LX5    59-0 
          SX7    X6-4000B 
          ZR     X6,CWE3     IF NO ERRORS 
          PL     X5,CWE3     IF *FET* BUSY
          NZ     X7,CWE1     IF NOT WRITE PARITY ERROR
          RJ     CFN         CHANGE TO LOCKED COMMON FILE 
          NZ     B7,CWE2     IF ERROR IN CHANGE 
          RJ     RPF         REPOSITION THE LOAD FILE 
          RJ     RSC         RESTART THE COPY 
          SB6    B1          INDICATE RECOPY
          JP     CWEX        RETURN 
  
 CWE1     SB7    MES14       * DESTINATION DEVICE ERROR.* 
          RETURN S
 CWE2     SB6    B0          CLEAR RECOPY INDICATOR 
          SX7    B7          SET TERMINATION MESSAGE
          SA7    TRMM 
          SX6    LSDP        SET TO LIST REMAINING FILES
          SA6    DSPC 
          SA6    LIST 
          JP     CWEX        RETURN 
 ERP$     SPACE  4
**        ERP$ - CIO ERROR EXIT ROUTINE.
* 
*         ENTRY  (X2) = *FET* ADDRESS.
* 
*         EXIT   TO *CIO=* IF WRITE REQUEST.
*                TO *ERPX$* IF READ REQUEST.
* 
*         USES   A - 3, 6.
*                X - 3, 6.
  
  
 ERP$     SX3    X2-T        CHECK IF LOAD *FET*
          NZ     X3,ERP1     IF WRITE REQUEST 
          SA3    X2          CLEAR ERROR STATUS 
          SX6    36000B 
          BX6    -X6*X3 
          SA6    A3 
          EQ     ERPX$       RESUME *CIO* FUNCTION
  
 ERP1     SX6    SBUF        REWIND WRITE *FET* 
          SA6    S+2
          SA6    A6+B1
          JP     CIO=        RETURN TO PROGRAM PATH 
 GCW      SPACE  4
**        GCW - GET QUEUE CONTROL WORD. 
* 
*         ENTRY  LOAD FILE POSITIONED TO NEXT QUEUE CONTROL WORD. 
* 
*         EXIT   (B6) = *A* FIELD CONTROL BYTE. 
*                (B5) = *B* FIELD CONTROL BYTE. 
*                (NQCW) = WORDS TO NEXT QUEUE CONTROL WORD. 
*                (CQCW) = CONTROL WORD. 
*                TO *ERR* IF *EOF* ENCOUNTERED. 
* 
*         USES   A - 5, 6, 7. 
*                B - 5, 6.
*                X - 4, 5, 6, 7.
  
  
 GCW      SUBR               ENTRY/EXIT 
 GCW1     SA5    NTCW 
          NZ     X5,GCW2     IF DATA REMAINING IN BLOCK 
          SA5    EOR
          SB6    B0+
          NZ     X5,GCWX     IF *EOR* BLOCK 
          READO  T           SKIP TRAILING CONTROL WORD 
          RJ     PCW         PROCESS NEXT BLOCK 
          PL     X1,GCW1     IF NOT *EOF* 
          SB7    MES20       * PREMATURE *EOF* ENCOUNTERED.*
          EQ     ERR         PROCESS FATAL ERROR
  
 GCW2     READO  T           READ CONTROL WORD
          SA6    CQCW        SAVE CONTROL WORD
          MX5    -9          MASK OFF WORD COUNT
          MX4    -6          MASK OFF *A* AND *B* FIELDS
          BX7    -X5*X6 
          SA5    NTCW        DECREMENT BLOCK WORD COUNT 
          AX6    12 
          SA7    NQCW 
          BX6    -X4*X6 
          LX6    -3 
          SX7    X5-1 
          SB6    X6          SET *A* FIELD
          AX6    57 
          SB5    X6          SET *B* FIELD
          SA7    A5 
          JP     GCW         RETURN 
 GSF      SPACE  4
**        GSF - GET SYSTEM SECTOR FIELD.
* 
*         ENTRY  (X5) = ADDRESS OF FIELD BIASED BY (*BFMD*+2).
*                (SSBF) = SYSTEM SECTOR.
* 
*         EXIT   (X6) = FIELD LEFT JUSTIFIED. 
* 
*         USES   A - 4, 5.
*                B - 5, 6.
*                X - 0, 2, 3, 4, 5, 6, 7. 
  
  
 GSF      SUBR               ENTRY/EXIT 
          SX4    X5-BFMS-2   ADJUST ADDRESS 
          SX3    5           CONVERT TO CM ADDRESS
          IX6    X4/X3
          SX3    5
          SX4    X4+
          IX7    X6*X3
          IX5    X4-X7       GET BYTE COUNT 
          SX3    12 
          SX2    60 
          IX3    X3*X5
          MX0    1
          SA4    X6+SSBF     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
          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 
          JP     GSFX        RETURN 
 PCW      SPACE  4
**        PCW - PROCESS CONTROL WORD. 
* 
*         ENTRY  LOAD FILE POSITIONED TO CONTROL WORD.
*                (LIST) = 0 IF LIST OPTION NOT SELECTED.
* 
*         EXIT   (NTCW) = WORDS TO NEXT CONTROL WORD. 
*                (CTLO) = LOCATION OF CURRENT CONTROL WORD. 
*                (CTCW) = CURRENT TAPE CONTROL WORD.
*                (ERRF) = *RPER* IF ERROR IN CURRENT BLOCK AND ERROR
*                PROCESSING IS NOT SELECTED.
*                (ERTP) = 2 IF ERROR IN CURRENT BLOCK.
*                (EOR) = NON ZERO IF *EOR* BLOCK. 
*                (X1) = NEGATIVE IF *EOF* ENCOUNTERED.
* 
*         USES   A - 2, 6, 7. 
*                B - 7. 
*                X - 1, 2, 6, 7.
  
  
 PCW      SUBR               ENTRY/EXIT 
          SA2    T+3         SAVE LOCATION OF CONTROL WORD
          BX6    X2 
          SA6    CTLO 
          READO  T           READ CONTROL WORD
          MI     X1,PCWX     IF *EOF* ENCOUNTERED 
          SA6    CTCW        SAVE CONTROL WORD
          MX0    -24
          MX1    -17
          SA2    TARA+ARFC   CHECK ERROR PROCESSING 
          SX7    RPER 
          LX2    59-57
          PL     X6,PCW1     IF NO ERROR IN BLOCK 
          SA7    ERTP        SET ERROR TYPE 
          MI     X2,PCW1     IF ERROR PROCESSING SET
          SA2    LIST        CHECK FOR LISTING FILES
          SA7    ERRF        SET SKIP ERRORED FILE
          NZ     X2,PCW1     IF LISTING FILES 
          SX7    IGDP        SET FILE IGNORED 
          SA7    DSPC 
 PCW1     BX7    -X0*X6      MASK OFF BYTE COUNT
          LX6    59-35
          SX2    5
          BX1    -X1*X6      MASK PRU SIZE
          IX7    X7/X2
          SA7    NTCW 
          IX6    X1-X7       CHECK FOR *EOR*
          SB7    B0 
          SA6    EOR
          JP     PCWX 
 PIQ      SPACE  4
**        PIQ - PROCESS *IQFT* FILE.
* 
*         ENTRY  (TARA+ARDD) = EST ORDINAL. 
* 
*         EXIT   *IQFT* FILE ATTACHED.
*                (B7) = ERROR MESSAGE ADDRESS IF ERROR OCCURED. 
*                (B7) = 0 IF NO ERROR OCURRED.
* 
*         USES   A - 2, 3, 6. 
*                B - 7. 
*                X - 0, 2, 3, 6.
* 
*         CALLS  ATT. 
* 
*         MACROS QCALL, REQUEST, SKIPEI, WRITE, WRITEF. 
  
  
 PIQ1     SX3    NIQ         SET *FET* ADDRESS
          RJ     ATT         ATTACH THE *IQFT* FILE 
          SB7    MES7        * CANNOT ATTACH *IQFT* FILE.*
          NZ     X5,PIQX     IF ERROR 
          SB7    B0          CLEAR ERROR INDICATION 
          SKIPEI NIQ,R
          WRITE  NIQ,*       PRESET WRITE FUNCTION
  
 PIQ      SUBR               ENTRY/EXIT 
          SA2    TARA+ARDD   GET EQUIPMENT
          SA3    X2+TEQA     CHECK IF *IQFT* EXISTS 
          SX2    X2 
          LX3    59-0 
          MI     X3,PIQ1     IF *IQFT* EXISTS 
          SX2    X2+7000B    SET ASSIGN-BY-ORDINAL FLAG 
          SB7    MES24       * IQFT NOT FOUND.* 
          EQ     PIQX        EXIT WITH ERROR
 PTT      SPACE  4,15 
**        PTT - PROCESS TRANSFER TABLE. 
* 
*         ENTRY  ((A1)) = (X1) = FIRST WORD OF TABLE. 
* 
*         EXIT   SYSTEM SECTOR FIELDS TRANSFERRED.
* 
*         USES   X - 1, 2, 3, 4, 5, 6.
*                A - 1. 
*                B - 4, 6.
* 
*         CALLS  GSF, WSF.
  
  
 PTT      SUBR               ENTRY/EXIT 
 PTT1     MX3    -12         MASK OUT SOURCE ADDRESS
          BX5    -X3*X1 
          RJ     GSF         GET SYSTEM SECTOR FIELD
          MX3    -12         MASK REQUIRED BITS 
          MX2    1
          AX1    12 
          BX5    -X3*X1 
          SB6    X5-1 
          AX5    B6,X2
          BX6    X5*X6
          AX1    12          MASK OUT DESTINATION ADDRESS 
          BX5    -X3*X1 
          SB6    BTB
          AX1    12 
          SB4    X1-1        FORM FIELD MASK
          AX4    B4,X2
          RJ     WSF         WRITE SYSTEM SECTOR FIELD
          SA1    A1+1        GET NEXT TABLE ENTRY 
          NZ     X1,PTT1     IF NOT END OF TABLE
          EQ     PTTX        RETURN 
 RES      SPACE  4,15 
**        RES - REFORMAT EOI SECTOR.
* 
*         ENTRY  *SSBF* CONTAINS THE REFORMATTED SYSTEM SECTOR
*                FOLLOWED BY A VERSION ONE SYSTEM SECTOR EXTENSION. 
* 
*         EXIT   *SSBF* CONTAINS THE REFORMATTED SYSTEM SECTOR FOLLOWED 
*                BY A VERSION TWO EOI SECTOR. 
*                (B7) = 0, INDICATING NO ERROR ENCOUNTERED. 
*                (X1) = 0, INDICATING *EOF* NOT ENCOUNTERED.
*                (X4) = 0, INDICATING NOT TO SKIP VERSION ONE FILE. 
* 
*         USES   X - 1, 4, 6, 7.
*                A - 1, 7.
*                B - 6, 7.
* 
*         MACROS MOVE.
  
  
 RES      SUBR               ENTRY/EXIT 
          SX7    B0+         CLEAR 100B WORDS IN *BTB*
          SA7    BTB
          SB6    76B
 RES1     SA7    A7+B1
          SB6    B6-B1
          PL     B6,RES1     IF NOT DONE
          SA1    SSBF+100B+1 GET EXPLICIT TEXT LENGTH 
          LX1    24 
          BX4    X1 
          SA1    A1+B1       GET IMPLICIT TEXT LENGTH 
          LX1    48 
          BX6    X1 
          SA1    A1+B1       GET DATA DECLARATION 
          BX7    X1+X4
          BX7    X7+X6
          SA7    BTB+3       SAVE *DDEI*, *ILEI*, AND *ELEI*
          ZR     X6,RES2     IF NO IMPLICIT TEXT TO MOVE
          MOVE   32B,SSBF+100B+46B,BTB+4
 RES2     ZR     X4,RES3     IF NO EXPLICIT TEXT TO MOVE
          MOVE   32B,SSBF+100B+14B,BTB+36B
 RES3     MOVE   100B,BTB,SSBF+100B  MOVE REFORMATTED EOI SECTOR
          SB7    B0+         CLEAR ERROR ENCOUNTERED
          BX1    X1-X1       CLEAR *EOF* ENCOUNTERED
          BX4    X4-X4       CLEAR VERSION ONE FILE TO SKIP 
          EQ     RESX        RETURN 
 RPF      SPACE  4
**        RPF - REPOSITION THE LOAD FILE. 
* 
*         ENTRY  (NTCW) = WORDS TO NEXT BLOCK CONTROL WORD. 
*                (B5) = 0 IF AT END OF RECORD.
* 
*         EXIT   LOAD FILE POSITIONED TO START OF CURRENT QUEUE FILE. 
* 
*         USES   A - 1, 2, 3, 4, 7. 
*                B - 2, 3, 4, 6.
*                X - ALL. 
  
  
 RPF4     NZ     X7,RPF5     IF LAST PRU IS AN *EOR* BLOCK
          SB6    B6+1 
 RPF5     SA2    EOR         CHECK IF *EOR* BLOCK 
          ZR     X2,RPF6     IF CURRENT BLOCK IS NOT AN *EOR* BLOCK 
          SB6    B6+1        ADJUST RECORD COUNT
 RPF6     SKIPB  T,B6,R      BACKSPACE LOAD FILE
          SA1    X2+B1       REWIND *FET* POINTERS
          SX7    X1 
          SA7    A1+B1
          SA7    A7+B1
          READCW X2,17B      INITIATE READ
  
 RPF      SUBR               ENTRY/EXIT 
          SA1    T+1         *FIRST*
          SA2    A1+B1       *IN* 
          SA3    A2+B1       *OUT*
          SA4    A3+B1       *LIMIT*
          SB6    B0          CLEAR RECORD COUNT 
          IX5    X2-X3       *IN* - *OUT* 
          SX4    X4 
          PL     X5,RPF1     IF NO WRAP AROUND
          SX1    X1 
          IX5    X2-X1       *IN* - *FIRST* 
          IX6    X4-X3       *LIMIT* - *OUT*
          IX5    X6+X5       WORDS IN BUFFER
 RPF1     SB3    X4          SAVE *LIMIT* 
          SA4    NTCW 
          SB4    X3          SET SEARCH POINTER 
          SX4    X4-1 
          SB2    2
          NZ     B5,RPF2     IF NOT AT END OF RECORD
          SX4    X4-1        ADJUST POINTER 
  
*         COUNT RECORDS IN BUFFER.
  
 RPF2     SX4    X4+B2       ADJUST FOR CONTROL WORDS 
          MX0    -24
          IX5    X5-X4       DECREMENT WORD COUNT 
          SB4    B4+X4       INCREMENT ADDRESS
          ZR     X5,RPF4     IF END OF DATA 
          SX3    5
          GE     B3,B4,RPF3  IF NOT AT *LIMIT*
          SB4    B4-B3
          SB4    B4+X1       ADDRESS OF NEXT CONTROL WORD 
 RPF3     SA2    B4          COMPUTE WORDS TO NEXT CONTROL WORD 
          BX6    -X0*X2      BYTE COUNT 
          LX2    59-35
          IX4    X6/X3       WORDS IN BLOCK 
          MX0    -17
          BX6    -X0*X2      PRU SIZE 
          IX7    X6-X4
          ZR     X7,RPF2     IF FULL BLOCK
          SB6    B6+B1       COUNT RECORD 
          EQ     RPF2        LOOP 
 RSC      SPACE  4
**        RSC - RESTART COPY. 
* 
*         ENTRY  LOAD FILE POSITIONED AT THE START OF THE 
*                CURRENT QUEUE FILE.
*                (OLDN) = OLD QUEUE FILE NAME.
* 
*         EXIT   (B7) = 0 IF NO ERRORS. 
*                (B7) = ADDRESS OF ERROR MESSAGE IF AN ERROR OCCURED. 
* 
*         USES   A - 1, 2, 6, 7.
*                B - 6, 7.
*                X - 1, 2, 6, 7.
* 
*         CALLS  GNF, BIE.
  
  
 RSC2     SB7    MES16       * LOAD FILE POSITION LOST.*
  
 RSC      SUBR               ENTRY/EXIT 
          MOVE   QFEWL-1,IQFE+1,RSCA+1  SAVE CURRENT QUEUE FILE DATA
          SA1    OLDN        SAVE OLD NAME
          BX7    X1 
          SA7    RSCA 
          RJ     GNF         RESET LOAD INFORMATION 
          NZ     B7,RSC2     IF ERROR OCCURED 
          MI     X1,RSC2     IF * EOF* ENCOUNTERED
          RJ     BIE         REBUILD *IQFT* BLOCK 
          SB6    QFEWL-1     COMPARE FILE DATA
 RSC1     SA1    IQFE+B6     COMPARE *IQFT* DATA
          SA2    RSCA+B6
          SB6    B6-B1
          BX6    X1-X2
          NZ     X6,RSC2     IF DATA DOES NOT MATCH 
          PL     B6,RSC1     IF NOT END OF DATA 
          SA1    S+1         REWIND *FET* 
          BX6    X1 
          SX7    B0+
          SA6    A1+B1
          SA7    ASSF        CLEAR FILE ASSIGNED TO MASS STORAGE
          SA6    A6+B1
          SB7    B0 
          SA7    WDSX        CLEAR WORD COUNT 
          JP     RSCX        RETURN 
  
 RSCA     BSS    QFEWL       BUFFER FOR *IQFT* DATA COMPARE 
 RSF      SPACE  4
**        RSF - READ SKIP FIELD.
* 
*         READ SKIP FIELD WILL TRANSFER THE REQUESTED FIELD SIZE
*         TO THE BUFFER AND THEN COPY THE REMAINING DATA IN THE FIELD 
*         TO THE SCRATCH BUFFER *BTB*.
* 
*         ENTRY  (NQCW) = WORDS TO NEXT CONTROL WORD. 
*                (NTCW) = WORDS TO NEXT TAPE CONTROL WORD.
*                (B4) = BUFFER ADDRESS. 
*                (X3) = FIELD SIZE. 
* 
*         EXIT   (NQCW) AND (NTCW) UPDATED. 
*                (CQCW) = NEXT QUEUE CONTROL WORD.
*                (B7) = 0 IF NO ERRORS. 
*                (B7) = ADDRESS OF ERROR MESSAGE. 
*                (B6) = *A* FIELD CONTROL BYTE. 
*                (B5) = *B* FIELD CONTROL BYTE. 
* 
*         USES   A - 1, 2, 3, 6, 7. 
*                B - 4, 7.
*                X - 1, 2, 3, 6, 7. 
* 
*         CALLS  PCW, GCW.
  
  
 RSF6     SB7    MES20       * PREMATURE *EOF* ENCOUNTERED.*
  
 RSF      SUBR               ENTRY/EXIT 
          SX7    B0+         INDICATE START OF READ 
          SA7    RSFA 
 RSF1     SA1    NQCW        GET FIELD SIZE 
          SA2    NTCW        GET BLOCK SIZE 
          IX6    X2-X3
          IX7    X1-X3
          MI     X6,RSF2     IF SHORT DATA BLOCK
          MI     X7,RSF4     IF SHORT FIELD 
          SA6    A2          SET NEW COUNTS 
          SA7    A1 
          READW  T,B4,X3     SKIP 100B WORDS
          SB4    BTB         SKIP REMAINING DATA
          SX7    B1+         INDICATE READ COMPLETED
          SX3    100B 
          SA7    RSFA 
          EQ     RSF1        LOOP 
  
*         PROCESS SHORT MEDIA DATA BLOCK. 
  
 RSF2     IX6    X1-X2       FIELD - BLOCK LENGTH 
          MI     X6,RSF4     IF FIELD THE SMALLEST
          BX7    X7-X7
          SA6    A1          UPDATE COUNTS
          SA7    A2 
          SX7    X2+B4       UPDATE ADDRESS 
          IX6    X3-X2       SAVE REMAINING WORDS 
          SA7    ADDR 
          SA6    WCNT 
          ZR     X2,RSF3     IF NO DATA IN BLOCK
          READW  T,B4,X2     READ TO END OF BLOCK 
 RSF3     READO  T           SKIP TRAILING CONTROL WORD 
          RJ     PCW         PROCESS NEXT BLOCK CONTROL WORD
          MI     X1,RSF6     IF *EOF* ENCOUNTERED.
          SA1    ADDR        RESET COPY PARAMETERS
          SA3    WCNT 
          SB4    X1+
          EQ     RSF1        LOOP 
  
*         PROCESS SHORT QUEUE FILE FIELD. 
  
 RSF4     IX6    X2-X1       BLOCK - FIELD LENGTH 
          MI     X6,RSF2     IF BLOCK THE SMALLEST
          IX7    X3-X1       SAVE REMAINING WORD COUNT
          SA6    A2          UPDATE BLOCK LENGTH
          SA7    WCNT 
          SX6    X1+B4       SET NEW ADDRESS
          SA6    ADDR 
          ZR     X1,RSF5     IF END OF LOAD FIELD 
          READW  T,B4,X1     SKIP TO END OF FIELD 
 RSF5     RJ     GCW         GET NEXT QUEUE CONTROL WORD
          SA1    RSFA        CHECK IF READ COMPLETE 
          SA2    ADDR        RESET COPY PARAMETERS
          SA3    WCNT 
          SB7    B0          CLEAR ERROR INDICATION 
          SB4    X2 
          NZ     X1,RSFX     IF READ COMPLETE 
          EQ     RSF1        CONTINUE READ
  
  
 RSFA     CON    0           NONZERO INDICATES COPY COMPLETE
 ADDR     BSS    1           BUFFER ADDRESS 
 WCNT     BSS    1           WORD COUNT 
 RSS      SPACE  4,20 
**        RSS - REFORMAT SYSTEM SECTOR. 
* 
*         ENTRY  (X6) = VERSION ONE SYSTEM SECTOR TYPE. 
*                (SSBF) - (SSBF+SSBFL-1) = VERSION ONE SYSTEM SECTOR. 
* 
*         EXIT   (B7) = 0, INDICATING NO ERROR ENCOUNTERED. 
*                (X1) = 0, INDICATING *EOF* NOT ENCOUNTERED.
*                (X4) = NONZERO, IF VERSION ONE FILE TO SKIP. 
*                (DSPC) = *IGDP*, IF VERSION ONE FILE TO SKIP.
*                (ERTP) = *VOER*, IF VERSION ONE FILE TO SKIP.
*                (SSBF) - (SSBF+SSBFL-1) = VERSION TWO SYSTEM SECTOR. 
* 
*         USES   X - 1, 4, 5, 6, 7. 
*                A - 1, 6, 7. 
*                B - 4, 6, 7. 
* 
*         CALLS  GSF, PTT, WSF. 
* 
*         MACROS MOVE.
  
  
 RSS      SUBR               ENTRY/EXIT 
          SX7    B0+         CLEAR 100B WORDS IN *BTB*
          SB6    BTB+100B-1 
          SA7    BTB
 RSS1     SA7    A7+B1
          SB4    A7-B6
          NG     B4,RSS1     IF NOT END OF BUFFER 
          SX1    X6-2        HARDCODED VERSION ONE VALUE
          SX4    X6-3        HARDCODED VERSION ONE VALUE
          ZR     X6,RSS2     IF VERSION ONE *INPUT* SYSTEM SECTOR 
          ZR     X1,RSS5     IF VERSION ONE *PRINT* SYSTEM SECTOR 
          ZR     X4,RSS5     IF VERSION ONE *PUNCH* SYSTEM SECTOR 
          EQ     RSS8        SKIP VERSION ONE FILE
  
*         PROCESS INPUT FILE SYSTEM SECTORS FIELDS. 
  
 RSS2     SA1    INTB        PROCESS *INPUT* TRANSFER TABLE 
          RJ     PTT
          SX5    /NOSV1/PRSS GET VERSION ONE PRIORITY 
          RJ     GSF
          LX6    12          MASK OUT PRIORITY
          MX5    -12
          BX1    -X5*X6 
          SX6    B0 
          SX5    X1-100B     HARDCODED VERSION ONE VALUE
          PL     X5,RSS4     IF VERSION ONE PRIORITY IS .GE. *MNPS* 
          SX5    X1-2        HARDCODED VERSION ONE VALUE
          SX6    JCIE 
          ZR     X5,RSS4     IF VERSION ONE PRIORITY WAS *ERPS* 
          SX5    X1-5        HARDCODED VERSION ONE VALUE
          SX6    NRIE 
          ZR     X5,RSS4     IF VERSION ONE PRIORITY WAS *NRPS* 
          SX5    X1-3 
          NZ     X5,RSS8     IF UNKNOWN VERSION ONE PRIORITY
 RSS3     SX5    /NOSV1/FLSS+2  PROCESS *RNSS* AND *CNSS* 
          RJ     GSF
          SB6    BTB         WRITE *RNSS* 
          SX5    RNSS 
          MX4    12 
          BX6    X4*X6
          RJ     WSF
          SX5    /NOSV1/FSSS+3
          RJ     GSF
          SB6    BTB         WRITE *CNSS* 
          SX5    CNSS 
          MX4    12 
          BX6    X4*X6
          RJ     WSF
          SX6    BCIE 
 RSS4     LX6    48          WRITE *JASS* 
          SB6    BTB
          MX4    12 
          SX5    JASS 
          RJ     WSF
          SX5    /NOSV1/JFSS MASK *EI200 JOB* BIT IN *JFSS* 
          RJ     GSF
          MX4    -59
          BX6    -X4*X6 
          MX4    12 
          BX6    X4*X6
          SX5    JFSS        WRITE *JFSS* 
          SB6    BTB
          RJ     WSF
          SX5    /NOSV1/JTSS MULTIPLY *JTSS* BY 10B 
          RJ     GSF
          MX4    12 
          BX6    X4*X6
          LX6    51          CONVERT TO 24 BIT FIELD
          MX4    24          WRITE *JTSS* 
          SX5    JTSS 
          SB6    BTB
          RJ     WSF
          EQ     RSS6        PROCESS *INPUT* / *OUTPUT* TRANSFER TABLE
  
*         PROCESS PRINT AND PUNCH FILE SYSTEM SECTOR FIELDS.
  
 RSS5     SA1    OTTB        PROCESS *OUTPUT* TRANSFER TABLE
          RJ     PTT
          SX5    /NOSV1/ECSS PROCESS OUTPUT DEPENDENT *QFT* DATA
          RJ     GSF
          MX4    9
          BX6    X4*X6
          LX6    3
          BX1    X4*X6
          SX5    /NOSV1/ICSS
          RJ     GSF
          MX4    -51
          BX6    -X4*X6 
          MX4    12 
          BX6    X4*X6
          BX5    X6          CHECK FOR *ICSS* OF THREE
          LX5    12 
          SX5    X5-3        HARDCODED VERSION ONE VALUE
          ZR     X5,RSS8     IF UNABLE TO REFORMAT ASCII FILE 
          SB6    BTB         WRITE *ICSS* AND *ECSS* INTO *QFT* 
          SX5    IOSS+18
          BX6    X1+X6
          RJ     WSF
  
*         PROCESS COMMON INPUT/OUTPUT SYSTEM SECTOR FILES.
  
 RSS6     SA1    IOTB        PROCESS *INPUT* / *OUTPUT* TRANSFER TABLE
          RJ     PTT
          SA1    RSSA        SET *JSN* TO *NOS1*
          SB6    BTB
          BX6    X1 
          MX4    24 
          SX5    IOSS 
          RJ     WSF
          SX5    /NOSV1/OOSS PROCESS FAMILY ORDINAL AND USER INDEX
          RJ     GSF
          MX5    12 
          BX1    X5*X6
          SX5    /NOSV1/ACSS+3
          LX1    6
          BX1    X5*X1
          RJ     GSF
          MX4    -54
          BX6    -X4*X6 
          MX4    24 
          BX6    X4*X6
          SB6    BTB         WRITE FAMILY ORDINAL AND USER INDEX
          SX5    IOSS+2 
          BX6    X6+X1
          RJ     WSF
          SX5    /NOSV1/DCSS PROCESS NOS/BE DEVICE CODE 
          RJ     GSF
          MX4    12 
          BX6    X4*X6
          LX6    6
          BX6    X4*X6
          SX5    IOSS+4      WRITE DISPOSITION TYPE 
          SB6    BTB
          RJ     WSF
          SA1    RTCL        SET ENTRY TIME INTO QUEUE
          BX6    X1 
          MX4    24 
          SX5    IOSS+1*5+3 
          SB6    BTB
          BX6    X4*X6
          RJ     WSF
          SX5    /NOSV1/OTSS PROCESS ORIGIN TYPE AND SYSTEM CLASS 
          RJ     GSF
          MX4    -54
          BX6    -X4*X6 
          MX4    12 
          BX6    X4*X6
          LX6    12 
          SA1    X6+RSSC     GET DEFAULT SYSTEM CLASS 
          LX6    48 
          SX5    IOSS+3*5 
          SB6    BTB
          BX6    X1+X6
          RJ     WSF
          SA1    SSBF        PROCESS *FNSS* 
          MX6    42 
          BX1    X6*X1
          SX6    QFFT        SET FILE TYPE TO *QFFT*
          LX6    6
          BX6    X1+X6
          SA6    BTB         STORE *FNSS* INTO SYSTEM SECTOR
  
*         PROCESS SPECIAL FIELDS
  
          SX5    /NOSV1/FLSS  MULTIPLY *FLSS* BY 10B
          RJ     GSF
          MX4    24 
          BX6    X4*X6
          LX6    3
          BX6    X4*X6
          SX5    FLSS 
          SB6    BTB
          RJ     WSF
          SA1    RSSB        SET *CJSS* AND *OJSS* TO *SYS* 
          SX5    CJSS 
          SB6    BTB
          MX4    24 
          BX6    X1 
          RJ     WSF
          SA1    RSSB 
          SX5    OJSS 
          SB6    BTB
          MX4    24 
          BX6    X1 
          RJ     WSF
          SA1    RSSD        SET *CHSS* TO SYSTEM DEFAULT CHARGE
          MX4    60 
          BX6    X1 
          SX5    CHSS 
          SB6    BTB
          RJ     WSF
          SA1    RSSD        SET *PJSS* TO SYSTEM DEFAULT CHARGE
          MX4    60 
          BX6    X1 
          SX5    PJSS 
          SB6    BTB
          RJ     WSF
          SA1    GNFC        CHECK FOR VERSION ONE RHF FILE 
          NZ     X1,RSS7     IF NOT VERSION ONE RHF FILE
          SX5    /NOSV1/FRSS+4  MASK OFF ORIGINATED FROM LINK BIT 
          RJ     GSF
          MX4    12 
          BX6    X4*X6
          MX7    1
          LX7    -9 
          BX6    -X7*X6 
          SX5    FGSS        WRITE *FGSS* 
          SB6    BTB
          RJ     WSF
          SX5    /NOSV1/FMSS PROCESS *FMSS* 
          RJ     GSF
          BX1    X6          SAVE *FMSS*
          SX5    /NOSV1/OHSS GET ORIGIN *PID* 
          RJ     GSF
          MX5    -18
          LX6    -48
          BX6    -X5*X6 
          SB6    BTB
          BX6    X6+X1
          SX5    FMSS        WRITE *FMSS* 
          MX4    60 
          RJ     WSF
          SX5    /NOSV1/FDSS PROCESS *FDSS* 
          RJ     GSF
          BX1    X6          SAVE FDSS
          SX5    /NOSV1/DHSS GET DESTINATION *LID*
          RJ     GSF
          MX5    -18
          LX6    -48
          BX6    -X5*X6 
          SB6    BTB
          BX6    X1+X6
          SX5    FDSS        WRITE *FDSS
          MX4    60 
          RJ     WSF
 RSS7     MOVE   100B,BTB,SSBF  SET SYSTEM SECTOR INTO *SSBF* 
          SB7    B0          CLEAR ERROR ENCOUNTERED
          BX1    X1-X1       CLEAR *EOF* ENCOUNTERED
          SX4    B0+         CLEAR VERSION ONE FILE TO SKIP 
          EQ     RSSX        RETURN 
  
*         SKIP VERSION ONE FILE.
  
 RSS8     SX7    VOER        SET ERROR TYPE 
          SA7    ERTP 
          SX7    IGDP        SET DISPOSITION TYPE TO *IGNORED*
          SA7    DSPC 
          SB7    B0          CLEAR ERROR ENCOUNTERED
          BX1    X1-X1       CLEAR *EOF* ENCOUNTERED
          SX4    B1+         SET VERSION ONE FILE TO SKIP 
          EQ     RSSX        RETURN 
  
  
 RSSA     DATA   C*NOS1*
 RSSB     DATA   C*SYS* 
 RSSC     VFD    6/SYSC,54/0 TABLE OF DEFAULT SYSTEM CLASSES
          VFD    6/BCSC,54/0
          VFD    6/RBSC,54/0
          VFD    6/TSSC,54/0
 RSSD     VFD    60/0L"SYSCHG"  SYSTEM DEFAULT CHARGE 
 SQL      SPACE  4,10 
**        SQL - SET QFT LIMIT.
* 
*         ENTRY  (SQTL) = STATIC QFT THRESHOLD LIMIT. 
* 
*         EXIT   (QLIM) = QFT LIMIT FOR LOAD. 
* 
*         USES   X - 0, 2, 3, 6, 7. 
*                A - 2, 7.
  
  
 SQL      SUBR               ENTRY/EXIT 
          SA2    QFTA        GET MAXIMUM NUMBER OF QFT ENTRIES
          MX0    -12
          LX2    -24
          BX2    -X0*X2 
          SX3    SQTL 
          SX0    100
          IX3    X2*X3
          IX7    X3/X0
          SA7    QLIM        SET LIMIT ON LOAD
          EQ     SQLX        RETURN 
 WPH      SPACE  4
**        WPH - WRITE PAGE HEADER.
* 
*         ENTRY  (WPHC) = DATE. 
*                (WPHD) = TIME. 
* 
*         EXIT   (LINE) RESET.
* 
*         USES   A - 1, 6.
*                X - 0, 1, 6. 
* 
*         CALLS  CDD. 
  
  
 WPH      SUBR               ENTRY/EXIT 
          SA1    PDFE+1      GET PRINT DENSITY FORMAT CONTROL FLAG
          BX7    X7-X7
          SA7    A1 
          WRITEW O,A1-B1,X1  CONDITIONALLY WRITE FORMAT EFFECTOR
          SA1    WPHA        INCREMENT PAGE NUMBER
          SX6    X1+B1
          SA6    A1 
          RJ     CDD
          SA1    WPHE        SET PAGE NUMBER IN HEADER
          MX0    36 
          BX1    X0*X1
          BX6    -X0*X6 
          BX6    X1+X6
          SA6    A1 
          WRITEW O,WPHB,WPHHL WRITE HEADER LINE 
          SX6    4
          SA6    LINE 
          JP     WPHX        RETURN 
  
  
 WPHA     BSS    1           PAGE COUNT 
 WPHB     DATA   C*1         QLOAD/LDLIST PROCESSOR.       YY/MM/DD. HH 
,.MM.SS.            PAGE     .* 
 WPHC     EQU    *-5         DATE 
 WPHD     EQU    *-4         TIME 
 WPHE     EQU    *-2         PAGE 
          DATA   H*  *       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*   *      BLANK LINE 
 WPHHL    EQU    *-WPHB 
 WSF      SPACE  4
**        WSF - WRITE SYSTEM SECTOR FIELD.
* 
*         ENTRY  (X4) = FIELD MASK. 
*                (X5) = FIELD ADDRESS BIASED BY (*BFMS*+2). 
*                (X6) = FIELD LEFT JUSTIFIED. 
*                (B6) = STARTING ADDRESS OF SYSTEM SECTOR.
* 
*         USES   A - 2, 3, 6, 7.
*                B - 6. 
*                X - ALL. 
  
  
 WSF      SUBR               ENTRY/EXIT 
          SX3    X5-BFMS-2   ADJUST ADDRESS 
          SX2    5           COMPUTE *CM* ADDRESS 
          BX0    X2 
          IX7    X3/X2
          IX1    X0*X7
          SX3    X3+
          SX0    12 
          IX1    X3-X1       GET BYTE COUNT 
          IX1    X0*X1       FORM SHIFT COUNT 
          SX5    59 
          SA2    X7+B6       GET SYSTEM SECTOR WORDS
          SA3    A2+B1
          IX5    X5-X1       60D - SHIFT COUNT
          SB6    X5 
          MX0    1           FORM MASK
          AX0    B6,X0
          SB6    B6+B1
          LX6    B6,X6       POSITION DATA
          LX0    B6,X0       POSITION GENERATED MASK
          LX4    B6,X4       POSITION FIELD MASK
          BX1    X0*X4       FORM PARTIAL MASK
          BX7    -X1*X2      CLEAR FIELD
          BX5    X1*X6       MASK OFF DATA
          BX7    X5+X7       MERGE DATA 
          BX4    -X0*X4      ADJUST MASK
          SA7    A2 
          BX6    X4*X6       MASK DATA
          BX7    -X4*X3      CLEAR FIELD
          BX6    X6+X7       MERGE DATA 
          SA6    A3 
          JP     WSFX        RETURN 
          SPACE  4
*         OPERATOR/DAYFILE MESSAGES.
  
  
 MES1     DATA   C* QLOAD OPERATION COMPLETE.        *
 MES2     DATA   C* QLOAD ABORTED.                   *
 MES3     DATA   C* LOAD FILE MISPOSITIONED.         *
 MES4     DATA   C* OUTPUT FILE RELEASED.            *
 MES5     DATA   C* LDLIST OPERATION COMPLETE.       *
 MES6     DATA   C* ACTIVE LOAD NOT ALLOWED.         *
 MES7     DATA   C$ CANNOT ATTACH *IQFT* FILE.       $
 MES8     DATA   C* DESTINATION DEVICE REQUIRED.     *
 MES9     DATA   C* FILE NAME CONFLICT.              *
 MES10    DATA   C* INACTIVE LOAD NOT ALLOWED.       *
 MES11    DATA   C$ QFT LIMIT ON LOAD.               $
 MES13    DATA   C$ QFT FULL DETECTED BY *QFM*.      $
 MES14    DATA   C* DESTINATION DEVICE ERROR.        *
 MES15    DATA   C* ERROR FILE LIMIT.                *
 MES16    DATA   C* LOAD FILE POSITION LOST.         *
 MES17    DATA   C* NO OUTPUT FILE PRESENT.          *
 MES18    DATA   C$ *QFM* ERROR ON ERRNNN FILE.      $
 MES19    DATA   C* QLOAD TERMINATED.                *
 MES20    DATA   C$ PREMATURE *EOF* ENCOUNTERED.     $
 MES21    DATA   C* QUEUE FILE ASSIGN ERROR.         *
 MES24    DATA   C* IQFT NOT FOUND.*
          SPACE  4
*         COMMON DECKS (PROCESSORS).
  
  
 WRIF$    EQU    1           SELECT *REISSUE CURRENT WRITE* 
*CALL     COMCCDD 
*CALL     COMCCIO 
*CALL     COMCCOD 
*CALL     COMCCPM 
*CALL     COMCEDT 
*CALL     COMCFQO 
*CALL     COMCIQP 
*CALL     COMCLFM 
*CALL     COMCMVE 
*CALL     COMCQFM 
*CALL     COMCRDO 
*CALL     COMCRDW 
*CALL     COMCSCB 
*CALL     COMCSFM 
*CALL     COMCSYS 
*CALL     COMCVLC 
          LIST   X
*CALL     COMCVQF 
          LIST   -X 
*CALL     COMCWTW 
*CALL     COMCZTB 
          EJECT 
*         BUFFERS.
  
  
 SSBF     EQU    *           SYSTEM INFORMATION BUFFER
 WBUF     EQU    SSBF+SSBFL+1 
 OBUF     EQU    WBUF+WBUFL  OUTPUT FILE BUFFER 
 SBUF     EQU    OBUF+BUFL   SCRATCH FILE BUFFER
 TBUF     EQU    SBUF+SBUFL  LOAD FILE BUFFER 
 IBUF     EQU    TBUF+TBUFL  *IQFT* FILE BUFFER 
 BTB      EQU    IBUF+IBUFL  BIT BUCKET 
 RFL=     EQU    BTB+WBUFL
 BUFFL    EQU    RFL= 
          SPACE  4,10 
          ERRPL  *-RFL       IF DEFAULT FIELD LENGTH TOO SMALL
          SPACE  4,10 
          END    QLOAD
