Retro1.org codex

          IDENT  PFLOAD1,PFLRL,PFL,01,00 
          TITLE  PFLOAD - PERMANENT FILE LOAD.
          ABS
          SST
          SYSCOM B1
          SPACE  4,10
*COMMENT  PFLOAD - PERMANENT FILE LOAD.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4,10
***       PFLOAD - PERMANENT FILE LOAD.
*         D. A. HIVELEY      70/12/22.
*         S. T. WORSTELL     73/02/15.
          SPACE  4,10
***       *PFLOAD* IS A PERMANENT FILE UTILITY PROGRAM WHICH LOADS
*         FILES FROM AN ARCHIVE FILE ONTO A PERMANENT FILE DEVICE.
*         *PFLOAD* MAY BE CALLED BY THE PERMANENT FILE SUPERVISOR
*         OR BY A COMMAND.
*
*         SEE *COMSPFS* FOR A DESCRIPTION OF THE PARAMETERS VALID FOR
*         *PFLOAD*.
*
*         *PFLOAD* CAN PERFORM SEVERAL TYPES OF PERMANENT FILE LOADS.
*         AN INCREMENTAL LOAD IS PERFORMED BY READING THE CATALOG
*         IMAGE RECORD (CIR) FROM THE MOST RECENT SELECTIVE
*         *PFDUMP* (FIRST REEL OF INCREMENTAL LOAD PROCESS) AND
*         PLACING IT ON A RANDOM FILE.
*         EACH ITEM IN THE CIR REPRESENTS A FILE AT THE TIME OF THE
*         SELECTIVE DUMP.
*         WHEN READING AN ARCHIVE FILE, IF A MATCH IS FOUND ON THE
*         CIR, THE FILE IS A CANDIDATE FOR LOADING AND THE ENTRY IN
*         THE CIR IS CLEARED. ELSE, THE FILE IS SKIPPED BECAUSE IT
*         HAS BEEN EITHER PURGED OR PREVIOUSLY LOADED.
*
*         DIRECT ACCESS FILES ARE LOADED TO THE DEVICE ON WHICH THEY
*         RESIDED WHEN DUMPED UNLESS THE DEVICE NO LONGER EXISTS OR
*         THE FILE IS NOT ALLOWED ON THE DEVICE (I.E. USER INDEX .LT.
*         *AUIMX* AND USER INDEX DOES NOT MATCH THE SECONDARY DEVICE
*         MASK).  IF THE FILE CAN NOT BE LOADED ON THE ORIGINAL
*         DEVICE, IT WILL BE LOADED ON THE DESTINATION DEVICE IF
*         SPECIFIED (*DD* PARAMETER) AND IF THE FILE IS ALLOWED ON
*         THAT DEVICE.  IF THE FILE CAN NOT BE LOADED ON EITHER DEVICE,
*         AN *ALTERNATE DEVICE NOT FOUND.* MESSAGE WILL BE ISSUED AND
*         THE FILE WILL BE SKIPPED.  A DIRECT ACCESS FILE IS CONSIDERED
*         TO HAVE RESIDED ON THE MASTER DEVICE BEING LOADED IF IT
*         ORIGINALLY RESIDED ON ITS OWN MASTER DEVICE.  IF THE *OP=L*
*         OPTION IS SPECIFIED, EACH DIRECT ACCESS FILE WILL BE LOADED
*         TO THE DEVICE WITH THE MOST SPACE AVAILABLE OF THOSE WHERE
*         THE DEVICE MASK ALLOWS IT TO RESIDE, REGARDLESS OF PREVIOUS
*         RESIDENCE OR *DD* SPECIFICATION.
*
*         ARCHIVE FILE ERRORS MAY BE ENCOUNTERED WHEN PROCESSING A
*         FILE.  THIS COULD BE CAUSED BY AN ERROR WHEN WRITING THE
*         ARCHIVE FILE (*PFDUMP*) OR READING THE ARCHIVE FILE.  SUCH
*         THINGS AS DROPPED RECORDS, PARITY ERRORS COULD CAUSE THIS.
*         IF ARCHIVE FILE ERRORS ARE ENCOUNTERED THEY ARE PROCESSED BY
*         SETTING THE LENGTH IN THE CATALOG FOR FILES THAT ARE TOO
*         SHORT AND TRUNCATING EXTRA PRUS TO MATCH LENGTH SPECIFIED IN
*         THE CATALOG FOR FILES TOO LONG.
          SPACE  4,10
***       SECURITY CONSIDERATIONS.
*
*         ON A SECURE SYSTEM, THE DEVICE SELECTED FOR A FILE TO RESIDE
*         ON MUST HAVE SECURITY ACCESS LEVEL LIMITS ALLOWING THE FILE-S
*         ACCESS LEVEL FROM THE PFC ENTRY TO RESIDE THERE.  IF NO
*         DEVICE CAN BE FOUND, THE FILE IS SKIPPED AND A MESSAGE
*         ISSUED.
          SPACE  4,10
***       MESSAGE LEGEND.
*
*         THE FOLLOWING LEGEND DEFINES PARAMETERS THAT ARE USED IN MANY
*         OF THE *PFLOAD* ERROR MESSAGES.  THE DESCRIPTIVE CHARACTER
*         STRINGS DEFINED HERE ARE REPLACED BY THEIR ACTUAL VALUE WHEN
*         A PARTICULAR MESSAGE IS ISSUED.  THE _ CHARACTER DOES NOT
*         APPEAR IN ACTUAL MESSAGES BUT IS USED IN THE DOCUMENTATION AS
*         A DELIMITER TO AVOID AMBIGUITIES.
*
*         DD       = DEVICE NUMBER.
*         EEE      = EST ORDINAL.
*         MMMMMM   = FILE COUNT.
*         NNNNNNN  = PERMANENT FILE NAME.
*         UUUUUU   = USER INDEX.
*         XXXXXXXX = COUNT OF PRU-S TRUNCATED.
          SPACE  4,20
***       OPERATOR MESSAGES.
*
*         SEE *MESSAGE LEGEND* ABOVE FOR A DESCRIPTION OF PARAMETERS
*         APPEARING IN THESE MESSAGES.
*
*         *LOADING NNNNNNN UUUUUU*
*                LOAD OF THE INDICATED FILE IS IN PROGRESS.
*
*         *SKIPPING NNNNNNN UUUUUU*
*                THE INDICATED FILE IS BEING SKIPPED BECAUSE IT WAS NOT
*                SELECTED FOR LOAD.
*
*         *CREATING CATALOG IMAGE RECORD*
*                THE CATALOG IMAGE RECORD FROM THE ARCHIVE FILE IS
*                BEING COPIED TO A SCRATCH FILE.
*
*         *CLEARING UTILITY INTERLOCK*
*                *PFLOAD* IS WAITING FOR *PFU* TO CLEAR THE PERMANENT
*                FILE UTILITY INTERLOCK ON A DEVICE.
*
*         *SETTING UTILITY INTERLOCK*
*                *PFLOAD* IS WAITING FOR *PFU* TO SET THE PERMANENT
*                FILE UTILITY INTERLOCK ON A DEVICE.
          SPACE  4,10
***       INFORMATIVE DAYFILE MESSAGES.
*
*         SEE *MESSAGE LEGEND* ABOVE FOR A DESCRIPTION OF PARAMETERS
*         APPEARING IN THESE MESSAGES.
*
*         * ERROR IN ARCHIVE FILE LABEL.*
*                THE FORMAT OF THE ARCHIVE FILE LABEL IS INCORRECT.
*
*         * MMMMMM FILES LOADED WITH ERRORS.*
*                THE NUMBER OF FILES WHICH WERE LOADED BUT WHICH HAD
*                ERRORS IN THE FILE DATA OR PERMITS.  THE PFC ENTRIES
*                OF SUCH FILES WILL INDICATED THE ERRORS THAT
*                OCCURRED.
*
*         * MMMMMM FILES SKIPPED WITH ERRORS.
*                THE NUMBER OF SELECTED FILES WHICH COULD NOT BE
*                LOADED.
*
*         * MMMMMM FILES LOADED.
*
*         * READ ERRORS ENCOUNTERED ON ARCHIVE FILE.*
*                UNRECOVED ERRORS OCCURRED WHEN READING THE ARCHIVE
*                FILE.  IT IS POSSIBLE THAT SOME FILES THAT SHOULD HAVE
*                BEEN LOADED WERE NOT FOUND.
*                THE NUMBER OF FILES LOADED FROM THE ARCHIVE FILE.
          SPACE  4,10
***       NON-FATAL ERROR DAYFILE MESSAGES.
*
*         SEE *MESSAGE LEGEND* ABOVE FOR A DESCRIPTION OF PARAMETERS
*         APPEARING IN THESE MESSAGES.
*
*         * ALTERNATE DEVICE NOT FOUND, FN=NNNNNNN, UI=UUUUUU.*
*                THE DEVICE NUMBER IN THE PFC ENTRY OF A DIRECT ACCESS
*                FILE WAS NOT FOUND IN THE SYSTEM, AND THE *DD* OR
*                *OP=L* OPTIONS WERE NOT SPECIFIED.  THE FILE IS NOT
*                LOADED.
*
*         * ARCHIVE FILE BLOCK ERROR, FN=NNNNNNN, UI=UUUUUU.*
*                A PFC, PERMIT, OR DATA BLOCK WAS DETECTED WITH AN
*                INCORRECT SUB-TYPE, AN INCORRECT LENGTH FOR THE BLOCK
*                TYPE, OR INCORRECT CONTENTS FOR THE BLOCK TYPE.  ALSO
*                ISSUED WHEN PERMIT OR DATA BLOCKS WERE PRESENT OR
*                MISSING WHEN THEY SHOULD NOT BE BASED ON INFORMATION
*                IN THE PFC BLOCK OR WHEN A BLOCK OF UNKNOWN TYPE IS
*                ENCOUNTERED.  THE FILE IS NOT LOADED.
*
*         * ARCHIVE FILE READ ERROR, FN=NNNNNNN, UI=UUUUUU.*
*                A READ ERROR OCCURRED ON THE ARCHIVE FILE WHILE
*                PROCESSING THE INDICATED FILE.  THE FILE IS NOT
*                LOADED.
*
*         * DATA WRITE ERROR, FN=NNNNNNN, UI=UUUUUU.*
*                A MASS STORAGE ERROR OCCURRED WHILE WRITING THE
*                INDICATED FILE.  IF DIRECT ACCESS, THE MASS STORAGE
*                SPACE FOR THE FILE IS DROPPED, CAUSING THE FAILING
*                TRACK TO BE FLAWED.  IF INDIRECT ACCESS, THE FAILING
*                PORTION OF THE INDIRECT ACCESS FILE CHAIN IS CATALOGED
*                UNDER THE *FLAWPF* USER INDEX (377775) TO PREVENT
*                REALLOCATION.  THE FILE IS NOT LOADED.
*
*         * ERROR ON FILE PURGE, FN=NNNNNNN, UI=UUUUUU.*
*                THE FILE WAS FOUND IN THE SYSTEM AFTER AN ATTEMPTED
*                PURGE WHEN OP=R WAS SECIFIED.  THIS INDICATES EITHER
*                THAT *PFM* ENCOUNTERED AN ERROR OR THAT A USER
*                RECREATED THE FILE AFTER THE PURGE BUT BEFORE *PFLOAD*
*                RESET THE UTILITY INTERLOCK ON THE MASTER DEVICE.
*                THE FILE IS NOT LOADED.
*
*         * FILE LOAD SUPPRESSED BY ERROR OPTION, FN=NNNNNNN,
*           UI=UUUUUU.*
*                AN ERROR OCCURRED WHEN THE FILE WAS DUMPED AND THE
*                *PFLOAD* *EO* OPTION WAS SPECIFIED.  THE FILE IS NOT
*                LOADED.
*
*         * FILE TRUNCATED, FN=NNNNNNN, UI=UUUUUU.*
*                THE FILE ON THE ARCHIVE FILE IS TOO SHORT EITHER WITH
*                ERROR PADDED EOFS OR A READ ERROR.  THE FILE IS
*                TRUNCATED AND THE LENGTH IN THE CATALOG IS UPDATED TO
*                REFLECT THE SMALLER SIZE.
*
*         * INCORRECT FILE NAME/USER INDEX, OOOOOOOOOOOOOOOOOOOO.*
*                A FILE WITH AN INCORRECT NAME AND/OR USER INDEX WAS
*                ENCOUNTERED.  THE FILE NAME (48 BITS) FOLLOWED BY THE
*                USER INDEX (18 BITS) ARE SHOWN IN OCTAL.  THE ARCHIVE
*                FILE IS POSITIONED TO THE NEXT RECORD.
*
*         * NO DEVICE FOR FILE ACCESS LEVEL, FN=NNNNNNN, UI=UUUUUU.*
*                NONE OF THE DEVICES WHERE THE FILE IS ELIGIBLE TO
*                RESIDE HAS SECURITY ACCESS LEVEL LIMITS THAT WILL
*                ALLOW THE INDICATED FILE TO RESIDE THERE.  THE FILE IS
*                NOT LOADED.
*
*         * NO SPACE FOR FILE, FN=NNNNNNN, UI=UUUUUU.*
*                THE LENGTH OF THE NAMED DIRECT ACCESS FILE WAS GREATER
*                THAN THE AMOUNT OF SPACE AVAILABLE ON THE DEVICE THAT
*                HAS BEEN SELECTED.  IF *OP=L* HAS BEEN SPECIFIED, THIS
*                IS THE DEVICE WITH MAXIMUM SPACE OF THOSE WHERE THE
*                FILE IS ELIGIBLE TO RESIDE.  THE FILE IS NOT LOADED.
          SPACE  4,10
***       FATAL ERROR DAYFILE MESSAGES.
*
*         SEE *MESSAGE LEGEND* ABOVE FOR A DESCRIPTION OF PARAMETERS
*         APPEARING IN THESE MESSAGES.
*
*         THESE ERRORS RESULT IN *PFLOAD* BEING ABORTED.
*
*         * ARCHIVE FILE LABEL MISSING ON INCREMENTAL LOAD.*
*                NO ARCHIVE FILE LABEL WAS FOUND ON THE FIRST ARCHIVE
*                FILE OF AN INCREMENTAL LOAD SEQUENCE.
*
*         * CATALOG IMAGE FORMAT ERROR.*
*                A CATALOG IMAGE RECORD WAS FOUND ON THE ARCHIVE FILE
*                BUT IT WAS IN A FORMAT NOT RECOGNIZED BY *PFLOAD*.  IT
*                IS NOT POSSIBLE TO USE THE BAD ARCHIVE FILE AS THE
*                FIRST FILE OF AN INCREMENTAL LOAD.  THE BAD ARCHIVE
*                FILE CAN BE USED IN A NORMAL LOAD, HOWEVER, BY USING
*                THE OMIT OPTION (OP=O) TO SKIP THE CATALOG IMAGE
*                RECORD.
*
*         * CATALOG READ ERROR, FN=NNNNNNN, UI=UUUUUU.*
*                THE INDICATED FILE WAS CATALOGED IN A SECTOR AFFECTED
*                BY A MASS STORAGE ERROR.
*
*         * CATALOG WRITE ERROR, FN=FFFFFFF, UI=UUUUUU.*
*                THE CATALOG INFORMATION FOR THE INDICATED FILE COULD
*                NOT BE WRITTEN BECAUSE OF A MASS STORAGE WRITE ERROR.
*                ERROR IDLE STATUS IS SET FOR THE MASTER DEVICE IF DATA
*                ON THE CATALOG FILE HAS BEEN CORRUPTED.
*
*         * DESTINATION DEVICE NOT FOUND.*
*                THE DEVICE SPECIFIED ON THE *DD* PARAMETER WAS NOT
*                FOUND.
*
*         * ERROR IDLE DETECTED, EQ_EEE.*
*                AN ERROR IDLE CONDITION HAS BEEN DETECTED ON THE
*                INDICATED EQUIPMENT.
*
*         * EXTRACT OPTION REQUIRES CIR.*
*                THE EXTRACT OPTION WAS SPECIFIED FOR THE LOAD BUT THE
*                ARCHIVE FILE DID NOT CONTAIN A CATALOG IMAGE RECORD.
*
*         * NO FILES SELECTED.*
*                THE FILE SELECTION PARAMETERS SPECIFIED FOR THE LOAD
*                WERE SUCH THAT NO DEVICES IN THE SYSTEM COULD CONTAIN
*                THE SPECIFIED FILES.  THIS MAY BE CAUSED BY
*                CONFLICTING SELECTION PARAMETERS.
*
*         * PERMIT WRITE ERROR, FN=NNNNNNN, UI=UUUUUU.*
*                THE PERMIT INFORMATION FOR THE INDICATED FILE COULD
*                NOT BE WRITTEN BECAUSE OF A MASS STORAGE ERROR.  ERROR
*                IDLE STATUS IS SET FOR THE MASTER DEVICE IF DATA ON
*                THE PERMITS FILE HAS BEEN CORRUPTED.
*
*         * SELECTED FILES NOT ON ARCHIVE FILE.*
*                THE FILES SELECTED FOR LOADING ARE NOT CONTAINED ON
*                THE ARCHIVE FILE.  THIS WAS DETERMINED FROM
*                INFORMATION CONTAINED IN THE ARCHIVE FILE DUMP LABEL.
*
*         * SELECTED MASTER OR TRUE DEVICE NOT FOUND.*
*                THE DEVICE SPECIFIED WITH THE *DN* OR *TD* PARAMETER
*                WAS NOT FOUND.
*
*         * TRACK LIMIT, EQ_EEE.*
*                A TRACK LIMIT HAS OCCURRED ON THE INDICATED EQUIPMENT.
          SPACE  4,10
***       OPERATOR MESSAGES WHICH REQUIRE ACTION.
*
*         THE FOLLOWING MESSAGES REQUIRE K-DISPLAY INPUT FOR
*         INCREMENTAL LOAD OPERATIONS.
*
*         * READ ERROR IN CATALOG IMAGE DM CT.*
*                AN ERROR WAS ENCOUNTERED WHILE READING CATALOG IMAGE
*                INFORMATION FOR CATALOG TRACK *CT* FOR THE MASTER
*                DEVICE WITH MASK *DM*.  OPERATOR ENTRY OF *K.GO.* WILL
*                CAUSE THE AFFECTED CATALOG TRACK TO BE SKIPPED BUT
*                OTHER CATALOG TRACKS TO BE PROCESSED.  ENTRY OF
*                ANYTHING ELSE WILL CAUSE *PFLOAD* TO ABORT.
*
*         *END OF LOAD FILE - SEE RIGHT SCREEN.*
*
*                THE END OF AN INCREMENTAL LOAD FILE HAS BEEN
*                ENCOUNTERED.  THE *K* DISPLAY RIGHT SCREEN DISPLAYS
*                THE OPTIONS AVAILABLE TO THE OPERATOR.  THESE INCLUDE
*                TERMINATION OF THE LOAD, LISTING THE REMAINING FILES
*                FROM THE CATALOG IMAGE RECORD, OR SPECIFICATION OF THE
*                VSN OF THE NEXT TAPE IN THE INCREMENTAL LOAD SEQUENCE.
 COMMON   SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCCMD
*CALL     COMCDCM
*CALL     COMCMAC
          QUAL   COMSACC
*CALL     COMSACC
          QUAL   *
*CALL     COMSCPS
*CALL     COMSDSP
*CALL     COMSLFD
*CALL     COMSLFM
*CALL     COMSMLS
*CALL     COMSMST
          QUAL   MTX
*CALL     COMSMTX
          QUAL   *
*CALL     COMSPFM
          LIST   X
*CALL     COMSPFS
          LIST   *
*CALL     COMSPFU
*CALL     COMSPRD
*CALL     COMSRPV
*CALL     COMSSFM
*CALL     COMSVER
          TITLE  PROGRAM CONSTANTS.
*         PROGRAM CONSTANTS.
 
 NDEV     EQU    10B         MAXIMUM NUMBER OF MASTER DEVICES ON *CIR*
 NWCD     EQU    201B        NUMBER WORDS/CIR DIRECTORY
 
*         BUFFER LENGTHS.
 
 MBUFL    EQU    30061B      MAIN BUFFER LENGTH
 MXCBS    EQU    20          MAXIMUM CATALOG BUFFER SECTOR COUNT
 CBUFL    EQU    101B*MXCBS+1   CATALOG BUFFER LENGTH
 PBUFL    EQU    101B*20+1   PERMIT BUFFER LENGTH
 DBUFL    EQU    6001B       DATA BUFFER LENGTH
 OUTBL    EQU    1001B       OUTPUT BUFFER LENGTH
 TLBFL    EQU    /COMSPFS/AFLBL  TAPE LABEL BUFFER LENGTH
 FLBFL    EQU    100B/NWCE*2000  FILE LIST BUFFER LENGTH
 FLCBL    EQU    1001B       FILE LIST CIRCULAR BUFFER LENGTH
 CWBFL    EQU    1           CONTROL WORD BUFFER LENGTH
 MSFBL    EQU    10001B      *COMCMSF* SORT FILES BUFFER LENGTH
 PFLBL    EQU    1001B       PROCESSED FILES FILE BUFFER LENGTH
 SABFL    EQU    1000B       SUMMARY FILE ASSEMBLY BUFFER LENGTH
 SRTBL    EQU    20000B      SORT BUFFER LENGTH
 SSBFL    EQU    100B        SYSTEM SECTOR BUFFER LENGTH
 SUMBL    EQU    1001B       SUMMARY FILE BUFFER LENGTH
 TDBFL    EQU    511         TEMPORARY DATA BUFFER LENGTH
 CIBFL    EQU    3001B       CATALOG IMAGE BUFFER LENGTH
 CIRTL    EQU    NWCD*NDEV+1 *CIR* CATALOG TRACK DIRECTORY LENGTH
 LBUFL    EQU    1001B       LIST CIR ENTRIES OUTPUT BUFFER LENGTH
 PFMBL    EQU    NWCE+1      *PFM* CATLIST BUFFER LENGTH
 DSPBL    EQU    7           *DSP* PARAMETER BLOCK LENGTH
 ODEBL    EQU    20B         OPTICAL DISK EXTENSION BUFFER LENGTH
 
*         MISCELLANEOUS CONSTANTS.
 
 CWSW     EQU    5           CONTROL WORD STATUS WORD IN FET
 FEDT     EQU    1           FILE DATA ERROR CODE
 FEPM     EQU    2           FILE PERMIT ERROR CODE
 DLSS     EQU    4           DATA LINKAGE SYSTEM SECTOR CODE
 DLEI     EQU    2           DATA LINKAGE EOI CODE
 DLEF     EQU    1           DATA LINKAGE EOF CODE
 NCES     EQU    100B/NWCE   NUMBER OF CATALOG ENTRIES PER SECTOR
 
*         *COMSPFS* EQUIVALENCES.
 
 CPAR     EQU    /COMSPFS/CPL
 IDSA     EQU    /COMSPFS/PADR
 LBWD     EQU    /COMSPFS/LBWD
 
*         *SETPFP*/*GETPFP* FLAG CONSTANTS.
 
 FMPR     EQU    10B         FAMILY NAME PARAMETER FLAG
 PKPR     EQU    4           PACKNAME PARAMETER FLAG
 UNPR     EQU    2           USER NAME PARAMETER FLAG
 UIPR     EQU    1           USER INDEX PARAMETER FLAG
          TITLE  RESERVED LOCATIONS.
          ORG    /COMSPFS/OVLB
 
 
*         RESERVED LOCATIONS.
 
 
 PFLRL    BSS    0
 
 
 ACEA     DATA   77000B      END OF ARCHIVE FILE CONTROL WORD
 AFLI     VFD    60/0LPFDUMP ARCHIVE FILE LABEL IDENTIFIER
 ANCE     CON    0           ADDRESS OF NEW CATALOG ENTRIES
 AREF     CON    0           ARCHIVE FILE READ ERROR FLAG
 BFCA     CON    0           BAD FILE CATALOG ADDRESS
 CBFO     CON    1           CATALOG BUFFER ORDINAL
 CCTR     CON    0           CURRENT CATALOG TRACK
 CEWF     CON    0           CATALOG ENTRIES WRITTEN FLAG
 CIFC     CON    0           *CIR* REMAINING FILE COUNT
 CSWC     CON    0           CATALOG SECTOR WORD COUNT
 DDMA     CON    0           DESTINATION DEVICE *MSTT* ADDRESS
 EOLF     CON    0           END OF LOAD FLAG
 FLOF     CON    0           FILE LIST OVERFLOW FLAG
 FLPT     CON    0           FILE LIST POINTER
 INCF     CON    0           INCREMENTAL LOAD FLAG
 IPFF     CON    0           INCOMPLETE PERMANENT FILE FLAG
 MAEQ     CON    0           MASTER DEVICE EST ORDINAL
 MMSK     CON    0           CURRENT MASTER MASK
 NCTR     CON    0           NUMBER OF CATALOG TRACKS
 PAFL     CON    0           *PFU* ACTIVE FLAG
 PFCO     CON    0           PFC ONLY FLAG
 RCWF     CON    0           CONTROL WORD RE-USE FLAG
 RICT     CON    0           RANDOM INDEX COUNTER
 SKER     CON    0           SKIP TO EOR FLAG
 UDAT     CON    0           UTILITY CONTROL DATE UPDATE FLAG
 
 
 TFST     BSSZ   NCES*MXCBS  FILE STATUS TABLE
          TITLE  MESSAGE CONSTANTS.
*         DISPLAYED MESSAGE CONSTANTS.
 
 
 MSGA     DATA   10HLOADING
 MSGC     DATA   40C PFLOAD DEVICE       FAM/PACK
 MSGE     DATA   10HSKIPPING
 MSGH     DATA   40HEND OF LOAD FILE - SEE RIGHT SCREEN.
 MSGJ     DATA   30C SETTING UTILITY INTERLOCK.
 MSGK     DATA   30C CLEARING UTILITY INTERLOCK.
 MSGP     DATA   40CENTERED VSN TOO LONG.
 MSGQ     DATA   40CNO VSN ENTERED.
 MSGT     DATA   40HINCORRECT OPTION.
 MSGV     DATA   40CARCHIVE LABEL BAD, SELECT NEW VSN.
 MSGW     DATA   C*$REQUEST K DISPLAY.*
 BLNK     DATA   40H
          SPACE  4,10
*         ERROR MESSAGES.
 
 
 ERAB     DATA   C* ARCHIVE FILE BLOCK ERROR, FN=???????, UI=!!!!!!.*
 ERAL     DATA   C* ERROR IN ARCHIVE FILE LABEL.*
 ERAN     DATA   C* ALTERNATE DEVICE NOT FOUND, FN=???????, UI=!!!!!!.*
 ERAR     DATA   C* ARCHIVE FILE READ ERROR, FN=???????, UI=!!!!!!.*
 ERCR     DATA   C* CATALOG READ ERROR, FN=???????, UI=!!!!!!.*
 ERCW     DATA   C* CATALOG WRITE ERROR, FN=???????, UI=!!!!!!.*
 ERDW     DATA   C* DATA WRITE ERROR, FN=???????, UI=!!!!!!.*
 EREO     DATA   C* FILE LOAD SUPPRESSED BY ERROR OPTION, FN=???????, UI
,=!!!!!!.*
 ERER     DATA   C* MISSING EOR, FN=???????, UI=!!!!!!.*
 ERFT     DATA   C* FILE TRUNCATED, FN=???????, UI=!!!!!!.*
 ERID     DATA   C* ERROR IDLE DETECTED, FN=???????, UI=!!!!!!.*
 ERIN     DATA   C* INCORRECT NAME/INDEX, FN=???????, UI=!!!!!!.*
 ERIS     DATA   C* ERROR IDLE SET, FN=???????, UI=!!!!!!.*
 ERND     DATA   C* NO DEVICE FOR FILE ACCESS LEVEL, FN=???????, UI=!!!!
,!!.*
 ERNE     DATA   C* NO EOI FOR FILE, FN=???????, UI=!!!!!!.*
 ERNS     DATA   C* NO SPACE FOR FILE, FN=???????, UI=!!!!!!.*
 ERPE     DATA   C* ERROR ON FILE PURGE, FN=???????, UI=!!!!!!.*
 ERPW     DATA   C* PERMIT WRITE ERROR, FN=???????, UI=!!!!!!.*
 ERTL     DATA   C* TRACK LIMIT, FN=???????, UI=!!!!!!.*
          SPACE  4,10
*         FILE COUNT MESSAGES.
 
 
 LDMS     DATA   C* ?????? FILE! LOADED.*
 SEMS     DATA   C* ?????? FILE! SKIPPED WITH ERRORS.*
 LEMS     DATA   C* ?????? FILE! LOADED WITH DATA ERRORS.*
          SPACE  4,10
*         INFORMATIVE MESSAGES.
 
 
 AEMS     DATA   C* READ ERRORS ENCOUNTERED ON ARCHIVE FILE.*
          TITLE  FETS.
*         FETS.
 
 
 CATS     BSS    0           CATALOG TRACKS
 ZZZZZG1  FILEB  CBUF,CBUFL,FET=10D
 
 PETS     BSS    0           PERMIT ENTRIES
 ZZZZZG2  FILEB  PBUF,PBUFL,FET=10D
 
 DATA     BSS    0           FILE DATA
 ZZZZZG3  FILEB  DBUF,DBUFL,FET=10D
 
 T        BSS    0           ARCHIVE FILE
 TAPE     FILEB  MBUF,MBUFL,EPR,FET=14D
          ORG    TAPE+8
          VFD    1/0,1/1,58/0
          ORG    TAPE+14
 
 ODEB     BSSZ   ODEBL       OPTICAL DISK EXTENSION BUFFER
 
 CIRF     BSS    0           CATALOG IMAGE RECORD
 ZZZZZG4  RFILEB CIBF,CIBFL,FET=10D
 
 FO       BSS    0           FILE LIST OVERFLOW
 ZZZZZG5  FILEB  FLCB,FLCBL,FET=10D
 
 P        BSS    0           PURGE, CATLIST FET FOR OP=R
 PURG     FILEB  PFMB,PFMBL,EPR,FET=13
 
 LCIR     BSS    0           OUTPUT
 ZZZZZG6  FILEB  LBUF,LBUFL,FET=10D
 
 UIFT     FILEB  0,0,(FET=10) FET TO CONTROL UTILITY INTERLOCK
 UIFL     BSSZ   1           UTILITY INTERLOCK FLAG
 
 
**        NOTE - THE STATUS PORTION OF THE *CATS*, *PETS*, AND *DATA*
*         FETS ARE USED IN THE FOLLOWING MANNER.
*
*T,       42/ FILENAME,14/0,1/ C,1/ R,1/ W,1/ F
*
*         C = COMPLETION OF LOAD (*DATA*).
*         R = FORCED READ - FILL BUFFER (*CATS*).
*         W = FORCED WRITE - EMPTY BUFFER (ALL FILES).
*         F = *PFU* FINISHED.
          TITLE  MAIN LOOP.
*         MAIN LOOP.
 
 
 PFL      RJ     PRS         PRESET PROGRAM
 
*         CHECK FOR END OF LOAD.
 
 PFL1     RJ     CEL         CHECK FOR END OF LOAD
          ZR     X6,PFL2     IF NOT END OF LOAD
          RJ     EOL         PROCESS END OF LOAD
          EQ     END         TERMINATE
 
 PFL2     RJ     PCB         PROCESS CATALOG BLOCK
          ZR     X6,PFL1     IF FILE NOT TO BE LOADED
 
*         CHECK FOR PERMIT ENTRIES.
 
          RJ     RCW         READ CONTROL WORD
          SX1    X1+2
          ZR     X1,PFL1     IF READ ERROR
          SX5    X3-2        BLOCK CODE
          SA4    TCBF+FCRI   CATALOG PERMIT RANDOM INDEX
          LX4    24
          MX0    36
          BX4    -X0*X4
          NZ     X5,PFL5     IF NO PERMITS ON ARCHIVE FILE
          NZ     X4,PFL4     IF PERMIT RANDOM INDEX PRESENT
 PFL3     SA1    TCBF+FCUI
          SB2    ERAB        * ARCHIVE FILE BLOCK ERROR ...*
          RJ     SFE         SEND ERROR MESSAGE
          RJ     SER         SKIP TO END OF RECORD
          EQ     PFL1        FILE NOT TO BE LOADED
 
*         PROCESS PERMITS.
 
 PFL4     RJ     PPB         PROCESS PERMIT BLOCK
          ZR     X6,PFL1     IF FILE NOT TO BE LOADED
          EQ     PFL6        PROCESS DATA
 
 PFL5     ZR     X4,PFL7     IF NO PERMITS IN CATALOG
          EQ     PFL3        PROCESS ARCHIVE FILE ERROR
 
*         PROCESS DATA.
 
 PFL6     RJ     RCW         READ CONTROL WORD
 PFL7     SA1    PFCO        *PFC ONLY* FLAG
          NG     X3,PFL10    IF PHYSICAL EOR ON ARCHIVE MEDIUM
          BX5    X3
          SX3    X3-3
          BX4    X1+X3
          NG     X4,PFL8     IF NO DATA BLOCK PRESENT
          ZR     X4,PFL11    IF DATA PRESENT AND *PFC ONLY*
          ZR     X3,PFL10    IF DATA PRESENT
 PFL8     NZ     X1,PFL11    IF NO DATA AND NOT *PFC ONLY*
 PFL9     RJ     WCE         WRITE CATALOG ENTRY
          EQ     PFL1        CHECK FOR END OF LOAD
 
 PFL10    ZR     X1,PFL9     IF PFC ONLY
          RJ     PDB         PROCESS DATA BLOCK
          NZ     X6,PFL9     IF FILE TO BE LOADED
          EQ     PFL1        CHECK FOR END OF LOAD
 
 PFL11    NG     X5,PFL12    IF ARCHIVE MEDIUM AT EOR/EOF/EOI
          RJ     SER         SKIP TO EOR
 PFL12    SA1    TCBF+FCUI
          SB2    ERAB        * ARCHIVE FILE BLOCK ERROR ...*
          RJ     SFE         SEND ERROR MESSAGE
          EQ     PFL1        CHECK FOR END OF LOAD
          TITLE  SUBROUTINES.
 APR      SPACE  4,15
**        APR - ABORT PROCESSOR.
*
*         EXIT   ANY INCOMPLETE PERMANENT FILE DELETED.
*                COMPLETE PERMANENT FILES FLUSHED TO MASS STORAGE.
*                UTILITY PROCESSOR DROPPED.
*                UTILITY INTERLOCK CLEAR.
*                PERMANENT FILE PARAMETERS RESTORED.
*                *PFLOAD* SYSTEM FILES RETURNED.
*
*         CALLS  CIN, DUP, FPF.
*
*         MACROS RETURN, SETPFP.
 
 
 APR      SUBR               ENTRY/EXIT
          RJ     FPF         FLUSH PERMANENT FILES
          RJ     DUP         DROP UTILITY PROCESSOR
          RJ     CIN         CLEAR UTILITY INTERLOCK
          SETPFP GPAR        RESTORE PERMANENT FILE PARAMETERS
          RETURN CATS        RETURN *PFLOAD* SYSTEM FILES
          RETURN PETS
          RETURN DATA
          RETURN CIRF
          RETURN FO
          EQ     APRX        RETURN
 ADF      SPACE  4,20
**        ADF - ASSIGN DIRECT ACCESS FILE DEVICE.
*
*         ENTRY PFC ENTRY IN *TCBF*.
*
*         EXIT   (B2) = 0 IF DEVICE ASSIGNED.
*                (B2) = ERROR MESSAGE ADDRESS IF NO DEVICE ASSIGNED.
*                (X7) = *MSTT* ADDRESS OF DEVICE IF DEVICE ASSIGNED.
*                (X7) = *MSTT* ADDRESS OF DEVICE IF NO SPACE FOR FILE
*                       ERROR AND FILE MUST RESIDE ON ON THAT DEVICE.
*                (X7) = 0 IF NO SPACE FOR FILE ERROR AND DEVICE
*                       SELECTION BY LOAD LEVELING.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5.
*                B - 2, 6.
*
*         CALLS  CAL, RAS, SFD, SRD.
 
 
 ADF9     SB2    B0+         SET NO ERROR
 
 ADF      SUBR               ENTRY/EXIT
 
*         CHECK AUXILIARY DEVICE LOAD.
 
          SA2    CPAR+/COMSPFS/CPPN
          SA4    TCBF+FCUI   GET USER INDEX
          SA1    CPAR+/COMSPFS/CPOP  GET UTILITY OPTIONS
          ZR     X2,ADF1     IF NOT AUXILIARY DEVICE LOAD
          SA5    MSTT+1      GET DEVICE PARAMETERS
          EQ     ADF4        CHECK ACCESS LEVEL AND SPACE AVAILABLE
 
*         CHECK LOAD LEVELING OPTION AND SUBFAMILY USER INDEX.
 
 ADF1     SA3    TCBF+FCDN   GET DEVICE NUMBER FROM CATALOG
          MX6    -3
          BX6    -X6*X4      LAST DIGIT OF USER INDEX
          BX4    X4-X6
          SB6    X6+8-59     SET DAPF MASK SHIFT COUNT
          SX4    X4-SBUI
          SX2    B0+         SET MASTER DEVICE
          ZR     X4,ADF2     IF SUBFAMILY USER INDEX
          LX3    -36
          LX1    59-54
          MX6    -6
          NG     X1,ADF5     IF *OP=L* SPECIFIED
          BX2    -X6*X3      DEVICE NUMBER FROM PFC
 
*         SEARCH FOR DEVICE IN CURRENT SYSTEM.
 
 ADF2     RJ     SFD         SEARCH FOR DEVICE
          ZR     X1,ADF3     IF DEVICE NOT FOUND
          SA5    A1+B1       GET DEVICE PARAMETERS
          AX6    X5,B6
          ZR     X4,ADF4     IF SUBFAMILY USER INDEX, IGNORE DAPF MASK
          NG     X6,ADF4     IF USER INDEX ALLOWED ON DEVICE
 
*         CHECK DESTINATION DEVICE IF DEVICE FROM PFC NOT FOUND.
 
 ADF3     SA1    DDMA        GET DESTINATION DEVICE *MSTT* ADDRESS
          ZR     X1,ADF7     IF DESTINATION DEVICE NOT SPECIFIED
          SA5    X1+B1       GET DEVICE PARAMETERS
          AX6    X5,B6
          PL     X6,ADF7     IF USER INDEX NOT ALLOWED ON DEVICE
 
*         CHECK ACCESS LEVELS AND SPACE ON DEVICE.
 
 ADF4     RJ     CAL         CHECK ACCESS LEVELS
          NG     X6,ADF8     IF ACCESS LEVEL ERROR
          SX3    B0          SET NO SPACE INCREMENT
          RJ     RAS         RETURN AVAILABLE SPACE
          SX7    A5-B1       SET DEVICE POINTER
          NZ     X1,ADF9     IF SPACE FOR FILE ON DEVICE
          EQ     ADF6        PROCESS NO SPACE FOR FILE
 
*         PROCESS LOAD LEVELING OPTION.
 
 ADF5     RJ     SRD         SELECT RESIDENCY DEVICE
          SX7    B2          SET DEVICE POINTER
          GT     B2,B1,ADF9  IF DEVICE FOUND
          SX7    B0          CLEAR DEVICE POINTER FOR NO SPACE ERROR
          NG     B2,ADF7     IF NO DEVICE FOR USER INDEX
          ZR     B2,ADF8     IF NO DEVICE FOR ACCESS LEVEL
 
*         PROCESS FILE ASSIGNMENT ERRORS.
 
 ADF6     SB2    ERNS        * NO SPACE FOR FILE ...*
          EQ     ADFX        RETURN
 
 ADF7     SB2    ERAN        * ALTERNATE DEVICE NOT FOUND ...*
          EQ     ADFX        RETURN
 
 ADF8     SB2    ERND        * NO DEVICE FOR FILE ...*
          EQ     ADFX        RETURN
 AUP      SPACE  4,20
**        AUP - ACTIVATE UTILITY PROCESSOR.
*
*                (PAFL) = 0 IF *PFU* NOT ACTIVE.
*                       = 1 IF *PFU* ALREADY ACTIVE.
*                (MAEQ) = MASTER EQUIPMENT.
*                (CPDN) = DEVICE NUMBER.
*                (TCBF+FCUI) = USER INDEX TO ACTIVATE *PFU* ON.
*
*         EXIT   (PAFL) = 1.
*                (RICT) = RANDOM INDEX OF *PETS* EOI.
*                *PFU* ACTIVATED IF NOT ALREADY ACTIVE.
*                *CATS* AND *PETS* FILES SET UP FOR PROCESSING.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7.
*
*         CALLS  RCT.
*
*         MACROS CALLPFU, RECALL.
 
 
 AUP      SUBR               ENTRY/EXIT
          SA2    PAFL        *PFU* ACTIVITY FLAG
          SA3    MAEQ
          NZ     X2,AUPX     IF *PFU* ALREADY ACTIVE
          SA2    CPAR+/COMSPFS/CPDN
          LX3    23-11       SET MASTER EQUIPMENT
          BX6    X3
          SA1    FAPM        SET FET ADDRESS PARAMETER
          SA6    DATA+FTDW
          LX2    54          SET DEVICE NUMBER
          BX7    X2+X1
          SA7    CATS+FTPM
          SA1    CATS        CLEAR FET STATUS FIELDS
          SA2    PETS
          MX3    42
          BX6    X3*X1
          SX1    B1          SET *CATS* FET COMPLETE
          BX7    X6+X1
          SA7    A1
          BX6    X3*X2
          SA1    DATA
          SA6    A2
          BX7    X3*X1
          SA7    A1
          BX6    X6-X6       CLEAR SECTOR COUNTS
          SA6    CATS+FTSC
          SA6    PETS+FTSC
          SA6    DATA+FTSC
          SA6    DATA+FTDL   CLEAR DATA FILE STATE WORD
          CALLPFU  CATS,CTLM ACTIVATE *PFU* LOAD PROCESSOR
          RECALL DATA        WAIT FOR *PFU* TO INITIALIZE
          RJ     RCT         READ CATALOG TRACK
          SA1    PETS+FTSC   SET PETS RANDOM INDEX
          MX2    24
          BX6    X2*X1
          LX6    -36
          SA6    RICT
          EQ     AUPX        RETURN
 
 
 FAPM     VFD    6/0,18/DATA,18/PETS,18/PAFL  FET ADDRESS PARAMETER
 BFL      SPACE  4,30
**        BFL - BUILD FILE LIST.
*
*         ENTRY  (A0) = ADDRESS OF CATALOG SECTOR.
*                (X0) = WORD COUNT OF CATALOG SECTOR.
*                (CSWC) = WORD COUNT OF CATALOG SECTOR.
*                (FLOF) = 0 IF NO FILE LIST OVERFLOW.
*                       = 1 IF FILE LIST OVERFLOWED TO MASS STORAGE.
*                (FLPT) = NEXT AVAILABLE LOCATION IN FILE LIST BUFFER.
*                (FLBF) = MEMORY RESIDENT PORTION OF FILE LIST.
*
*         EXIT   (A0) = LWA+1 OF CATALOG SECTOR.
*                (FLOF) = 0 IF NO FILE LIST OVERFLOW.
*                       = 1 IF FILE LIST OVERFLOWED TO MASS STORAGE.
*                (FLPT) = NEXT AVAILABLE LOCATION IN FILE LIST BUFFER.
*                (FLBF) = MEMORY RESIDENT PORTION OF FILE LIST.
*                FILE NAME AND USER INDEX FOR EACH CATALOG ENTRY IS
*                  ADDED TO THE FILE LIST.
*                OVERFLOW PORTIONS OF THE FILE LIST ARE WRITTEN TO A
*                  SCRATCH FILE.
*                SCRATCH FILE BUFFER IS FLUSHED IF FILE LIST OVERFLOW
*                  HAS OCCURRED AND THE CATALOG SECTOR IS SHORT.
*
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 0, 1, 5, 6, 7.
*
*         MACROS WRITE, WRITEW.
 
 
 BFL      SUBR               ENTRY/EXIT
 BFL1     SX0    X0-NWCE
          NG     X0,BFL3     IF NO MORE CATALOG ENTRIES
          SA5    A0+FCFN+FCUI*0  GET FILE NAME AND USER INDEX
          SA1    FLPT
          MX6    -18
          BX6    -X6*X5      CHECK USER INDEX
          ZR     X6,BFL2.2   IF CATALOG HOLE
          SX6    X6-IFUI
          SX2    X1-FLBF-FLBFL
          ZR     X6,BFL2.2   IF INDIRECT ACCESS FLAW
          NG     X2,BFL2     IF FILE LIST NOT FULL
          SX6    B1+         SET FILE LIST OVERFLOW
          SA6    FLOF
          WRITEW FO,FLBF+FLBFL-100B,100B  WRITE LAST SECTOR OF BUFFER
          SA1    FLPT        BACK BUFFER POINTER UP ONE SECTOR
          SX1    X1-100B
 BFL2     SX6    X1+B1       ADVANCE BUFFER POINTER
          BX7    X5
          SA6    A1          UPDATE BUFFER POINTER
          SA7    X1          ENTER FILE IN LIST
 BFL2.2   SA0    A0+NWCE     ADVANCE CATALOG SECTOR ADDRESS
          EQ     BFL1        PROCESS NEXT CATALOG ENTRY
 
 BFL3     SX2    A0+NWCE     SET POINTER TO END OF SECTOR
          IX0    X0+X2
          SA0    X0
          SA1    CSWC
          SX2    X1-100B
          ZR     X2,BFLX     IF NOT SHORT SECTOR
          SA1    FLOF
          ZR     X1,BFLX     IF NO FILE LIST OVERFLOW
          WRITE  FO          FLUSH SCRATCH FILE BUFFER
          EQ     BFLX        RETURN
 CAL      SPACE  4,15
**        CAL - CHECK ACCESS LEVELS.
*
*         ENTRY  (TCBF) = CATALOG ENTRY OF FILE.
*                (X5) = SECOND WORD OF *MSTT* ENTRY.
*                (A5) = ADDRESS OF SECOND WORD OF *MSTT* ENTRY.
*
*         EXIT   (X6) .LT. 0 IF THE ACCESS LEVEL OF THE FILE IS NOT
*                     WITHIN THE DEVICE ACCESS LEVEL LIMITS OF THE
*                     DEVICE.
*                (X5) = SECOND WORD OF *MSTT* TABLE ENTRY.
*                (A5) = ADDRESS OF SECOND WORD OF *MSTT* ENTRY.
*
*         USES   X - 0, 1, 5, 6, 7.
*                A - 1.
 
 
 CAL      SUBR               ENTRY/EXIT
          SA1    SYSS        CHECK SECURITY MODE
          SX6    B0+         SET NO ERROR
          ZR     X1,CALX     IF NOT SECURE SYSTEM
          SA1    TCBF+FCAL   GET ACCESS LEVEL OF FILE
          MX0    -3
          LX5    -30
          BX6    -X0*X5      DEVICE ACCESS LEVEL UPPER LIMIT
          LX5    -3
          LX1    -36
          BX7    -X0*X5      DEVICE ACCESS LEVEL LOWER LIMIT
          BX1    -X0*X1      FILE ACCESS LEVEL
          LX5    33          RESTORE *MSTT* WORD
          IX6    X6-X1
          NG     X6,CALX     IF ACCESS LEVEL TOO HIGH FOR DEVICE
          IX6    X1-X7       ERROR IF ACCESS LEVEL TOO LOW FOR DEVICE
          EQ     CALX        RETURN
 CDE      SPACE  4,20
**        CDE - CHECK DEVICE ENVIRONMENT.
*
*         ENTRY  PFC ENTRY IN *TCBF*.
*
*         EXIT   (B2) = 0 IF NO ERROR.
*                (B2) = ERROR MESSAGE ADDRESS IF FILE CANNOT BE LOADED.
*                (X7) = PFC ENTRY *FCDN* WORD SET WITH DEVICE NUMBER IF
*                       NO ERROR.
*                (X7) = *MSTT* ADDRESS OF REQUIRED DEVICE IF NO SPACE
*                       FOR FILE ERROR AND LOAD LEVELING NOT USED.
*                (X7) = 0 IF NO SPACE FOR FILE ERROR AND LOAD LEVELING
*                       USED IN DEVICE SELECTION.
*
*         USES   X - 1, 2, 5, 6, 7.
*                A - 1, 2, 5, 6.
*                B - 2.
*
*         CALLS  ADF, CAL, SFD.
 
 
 CDE      SUBR               ENTRY/EXIT
 
*         CHECK MASTER DEVICE ACCESS LEVELS.
 
          SX2    B0          SET MASTER DEVICE SEARCH
          RJ     SFD         SEARCH FOR DEVICE
          SA5    A1+B1
          RJ     CAL         CHECK ACCESS LEVEL
          SB2    ERND        * NO DEVICE FOR FILE ...*
          NG     X6,CDEX     IF MASTER DEVICE ACCESS LEVEL CONFLICT
          SA1    TCBF+FCBS   CHECK FILE TYPE
          SA2    PFCO
          LX1    59-11
          SX6    B0          SET TO CLEAR DEVICE NUMBER
          PL     X1,CDE1     IF INDIRECT ACCESS FILE
          ZR     X2,CDE1     IF *PFC ONLY* FILE
          RJ     ADF         ASSIGN DIRECT ACCESS FILE DEVICE
          NZ     B2,CDEX     IF ERROR IN DEVICE ASSIGNMENT
 
*         CHECK MASTER DEVICE ASSIGNMENT.
 
          SA1    X7+         GET DEVICE NUMBER FROM *MSTT*
          SA2    CPAR+/COMSPFS/CPDN  MASTER DEVICE NUMBER
          MX6    -6
          BX6    -X6*X1      DEVICE NUMBER
          BX2    X6-X2
          NZ     X2,CDE1     IF SELECTED DEVICE IS NOT MASTER
          SX6    B0          CLEAR DEVICE NUMBER
 
*         SET DEVICE NUMBER IN *FCDN* WORD.
 
 CDE1     SA1    TCBF+FCDN
          MX7    -6
          LX7    36
          LX6    36
          BX7    X7*X1
          SB2    B0          SET NO ERROR
          BX7    X7+X6       MERGE DEVICE NUMBER
          EQ     CDEX        RETURN
 CEL      SPACE  4,20
**        CEL - CHECK FOR END OF LOAD.
*
*         ENTRY  (SKER) = 0 IF SKIP TO EOR NOT REQUIRED.
*                       = NON-ZERO IF SKIP TO EOR REQUIRED.
*
*         EXIT   (X6) = 0 IF NOT END OF LOAD.
*                     = NON-ZERO IF END OF LOAD.
*                (CWBF) = CATALOG CONTROL WORD IF NOT END OF LOAD.
*                ARCHIVE FILE TRANSITIONS PERFORMED AS NECESSARY.
*                ARCHIVE LABEL PROCESSED IF PRESENT.
*
*         USES   X - 1, 2, 5, 6, 7.
*                A - 1, 2, 6.
*                B - 2.
*
*         CALLS  ART, CIN, DUP, IFL, PAL, RCW, SCI, SER.
*
*         MACROS READCW, RECALL, SKIPFF.
 
 
 CEL      SUBR               ENTRY/EXIT
 
*         PROCESS FILE SKIP FLAG.
 
          SA1    SKER
          ZR     X1,CEL1     IF FILE SKIP FLAG NOT SET
          BX6    X6-X6       CLEAR FILE SKIP FLAG
          SA6    A1
          RJ     DUP         DROP UTILITY PROCESSOR
          RJ     CIN         CLEAR UTILITY INTERLOCK
          RJ     SER         SKIP TO END OF RECORD
 
*         CHECK IF ALL SELECTED FILES HAVE BEEN LOADED.
 
 CEL1     SA1    AFDM        GET ARCHIVE FILE DEVICE MASK
          SA2    FLSM        GET REMAINING FILE SELECTIONS MASK
          SA3    CPAR+/COMSPFS/CPDI
          SA4    MASK        GET ACTIVE DEVICES MASK
          BX1    X1*X2
          NZ     X3,CEL1.1   IF DESTINATION USER INDEX SPECIFIED
          BX1    X1*X4
 CEL1.1   ZR     X1,CEL10    IF LAST ARCHIVE FILE AND NO FILES SELECTED
          SA1    /COMSPFS/FISP
          SA2    /COMSPFS/NFIS
          ZR     X1,CEL2     IF NO USER INDEX/FILE NAME SELECTIONS
          ZR     X2,CEL10    IF ALL SPECIFIED FILES FOUND
 CEL2     SA1    INCF
          ZR     X1,CEL2.1   IF NOT INCREMENTAL LOAD
          SA1    CIFC
          ZR     X1,CEL10    IF END OF CATALOG IMAGE
 CEL2.1   SA2    EOLF
          ZR     X2,CEL3     IF END OF LOAD NOT REACHED
          SA2    CPAR+/COMSPFS/CPNB
          SB2    X2+
          LE     B2,B1,CEL9  IF FILE COUNT ONE
 CEL2.2   RJ     SER         SKIP TO END OF RECORD
          PL     X1,CEL2.2   IF NOT EOF/EOI
          EQ     CEL7        PROCESS EOF/EOI
 
*         PROCESS NEXT ARCHIVE FILE CONTROL WORD.
 
 CEL3     RJ     RCW         READ ARCHIVE FILE CONTROL WORD
          SX6    X3-1
          NZ     X7,CEL5     IF READ ERROR
          ZR     X6,CELX     IF CATALOG CONTROL WORD
          ZR     X3,CEL4     IF LABEL CONTROL WORD
          NG     X1,CEL7     IF EOF/EOI
          NZ     X1,CEL3     IF EOR
          SA1    CWBF        CHECK FOR END OF LOAD
          SA2    ACEA
          BX6    X1-X2
          ZR     X6,CEL6     IF END OF ARCHIVE FILE CONTROL WORD
          RJ     DUP         DROP UTILITY PROCESSOR
          RJ     CIN         CLEAR UTILITY INTERLOCK
          RJ     SER         SKIP TO END OF RECORD
          EQ     CEL3        GET NEXT CONTROL WORD
 
*         PROCESS ARCHIVE FILE LABEL.
 
 CEL4     RJ     DUP         DROP UTILITY PROCESSOR
          RJ     CIN         CLEAR UTILITY INTERLOCK
          SX6    B1+         SET CONTROL WORD RE-USE FLAG
          SA6    RCWF
          RJ     PAL         PROCESS ARCHIVE LABEL
          ZR     X6,CEL8     IF NOT A BAD LABEL
          RJ     IFL         INITIALIZE OUTPUT FILE FOR FILE PROCESSING
          SB2    ERAL        * ERROR IN ACHIVE FILE LABEL.*
          RJ     SEM
          EQ     CEL3        GET NEXT CONTROL WORD
 
*         PROCESS ARCHIVE FILE READ ERROR.
 
 CEL5     RJ     DUP         DROP UTILITY PROCESSOR
          RJ     CIN         CLEAR UTILITY INTERLOCK
          RJ     SER         SKIP TO END OF RECORD
          EQ     CEL3        GET NEXT CONTROL WORD
 
*         PROCESS END OF ARCHIVE FILE CONTROL WORD.
 
 CEL6     RECALL TAPE
          SA1    X2+B1       REWIND BUFFER
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
          SX6    30B         CHECK FOR EOF/EOI ON ARCHIVE FILE
          SA1    X2
          BX7    X6*X1
          BX6    X7-X6
          ZR     X6,CEL7     IF ARCHIVE FILE AT EOF/EOI
          SKIPFF X2,B1,R     SKIP TO EOF
 
*         PROCESS MULTIPLE FILE ARCHIVE OPTION.
 
 CEL7     SA1    TAPE
          LX1    59-9
          NG     X1,CEL9     IF ARCHIVE FILE AT EOI
          SA1    CPAR+/COMSPFS/CPNB  CHECK FILE COUNT
          SB2    X1
          SX6    B2-B1
          LE     B2,B1,CEL9  IF NO MORE FILES TO PROCESS
          SA6    A1+         SET NEW FILE COUNT
          RJ     DUP         DROP UTILITY PROCESSOR
          RJ     CIN         CLEAR UTILITY INTERLOCK
          RJ     PSF         PROCESS SORTED FILE OUTPUT FOR LAST FILE
          READCW TAPE,17B    INITIALIZE CONTROL WORD READ
          SX6    B0+         CLEAR CONTROL WORD STATUS WORD
          SA6    TAPE+CWSW
          RJ     PAL         PROCESS ARCHIVE LABEL
          ZR     X6,CEL8     IF NOT BAD LABEL
          SB2    ERAL        * ERROR IN ACHIVE FILE LABEL.*
          RJ     SEM
          RJ     SER         SKIP TO END OF RECORD
 CEL8     RJ     SCI         SKIP CATALOG IMAGE
          RJ     IFL         INITIALIZE OUTPUT FILE FOR FILE PROCESSING
          EQ     CEL3        GET NEXT CONTROL WORD
 
*         CHECK INCREMENTAL LOAD STATUS.
 
 CEL9     SA1    INCF
          ZR     X1,CEL10    IF NOT INCREMENTAL LOAD
          SA1    CIFC
          ZR     X1,CEL10    IF END OF CATALOG IMAGE
          RJ     PSF         PROCESS SORTED FILE OUTPUT
          SX6    B0+
          SA6    EOLF        CLEAR END OF LOAD FLAG ON INCREMENTAL LOAD
          SA6    MXDC        CLEAR DEVICE POSITION AND CATALOG TRACK
          SX6    377B
          SA6    AFDM        RESET ARCHIVE FILE DUMP MASK
          RJ     ART         ADVANCE INCREMENTAL LOAD
          ZR     X6,CEL8     IF NOT END OF INCREMENTAL LOAD
 
*         SET END OF LOAD STATUS.
 
 CEL10    SX6    B1          SET END OF LOAD STATUS
          EQ     CELX        RETURN
 CIN      SPACE  4,15
**        CIN - CLEAR PF UTILITY INTERLOCK.
*
*         ENTRY  (UIFL) = 0 IF UTILITY INTERLOCK NOT SET.
*                       = 1 IF UTILITY INTERLOCK SET.
*                (MAEQ) = EQUIPMENT TO CLEAR INTERLOCK ON.
*
*         EXIT   (UIFL) = 0.
*                *PFU* CALLED TO CLEAR UTILITY INTERLOCK IF NOT ALREADY
*                CLEAR.
*
*         USES   X - 1, 2, 3, 6.
*                A - 1, 2, 3, 6.
*
*         MACROS CALLPFU, MESSAGE, MOVE.
 
 
 CIN      SUBR               ENTRY/EXIT
          SA1    UIFL        CHECK PF UTILTIY INTERLOCK FLAG
          SA2    MAEQ        SET MASTER DEVICE EST ORDINAL
          ZR     X1,CINX     IF UTILITY INTERLOCK ALREADY CLEAR
          SX1    UIFL        SET INTERLOCK FLAG ADDRESS
          LX2    48
          BX6    X2+X1
          SA3    IDSA+/COMSPFS/ADM2  K DISPLAY MESSAGE ADDRESS
          SA6    UIFT+FTPM
          MOVE   3,MSGK,X3   * CLEARING UTILITY INTERLOCK.*
          MESSAGE MSGK,2,R
          CALLPFU  UIFT,CTCU,R  CLEAR PF UTILITY INTERLOCK
          SA3    IDSA+/COMSPFS/ADM2  K DISPLAY MESSAGE ADDRESS
          MOVE   3,BLNK,X3   CLEAR MESSAGES
          MESSAGE (=C**),2,R
          EQ     CINX        RETURN
 CSP      SPACE  4,20
**        CSP - CHECK SELECTION PARAMETERS.
*
*         ENTRY  (CPAR) = CONVERTED PARAMETER ARRAY.
*                (TCBF) = CATALOG ENTRY FOR CURRENT FILE.
*
*         EXIT   (X6) = 0 IF FILE NOT TO BE LOADED.
*                (X6) .NE. 0 IF FILE TO BE LOADED.
*                DESTINATION USER INDEX SET IN *TCBF* CATALOG ENTRY IF
*                  SPECIFIED.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2, 4.
*
*         CALLS  CSC.
 
 
 CSP      SUBR               ENTRY/EXIT
 
*         CHECK SELECTION CRITERIA.
 
          SB4    TCBF        SET PFC ADDRESS
          RJ     CSC         CHECK SELECTION CRITERIA
          ZR     X6,CSPX     IF FILE NOT TO BE LOADED
          ZR     B6,CSP2     IF NO FILE NAME SELECTION
          SA1    CPAR+/COMSPFS/CPOP
          SA2    CPAR+/COMSPFS/CPNB
          SA3    /COMSPFS/NFIS
          SA4    B6+         READ FILE NAME ENTRY
          SX6    B1
          LX1    59-52
          SB4    X2
          IX7    X3-X6       DECREMENT FILE SELECTION COUNT
          PL     X1,CSP1     IF REPLACE OPTION NOT SELECTED
          GT     B4,B1,CSP2  IF NOT LAST ARCHIVE FILE
 CSP1     LX6    17-0
          SA7    A3          UPDATE FILE SELECTION COUNT
          BX6    X6+X4       SET FILE FOUND FLAG
          SA6    B6          WRITE FILE NAME ENTRY
 
*         PROCESS DESTINATION USER INDEX AND DETERMINE IF FILE-S MASTER
*         DEVICE SELECTED FOR LOAD.
 
 CSP2     SA1    CPAR+/COMSPFS/CPDI
          SA2    TCBF+FCUI
          SA3    MASK
          MX7    -3
          MX0    -1
          ZR     X1,CSP3     IF DESTINATION USER INDEX NOT SPECIFIED
          MX6    42
          BX6    X6*X2
          BX6    X6+X1       SET DESTINATION INDEX IN CATALOG ENTRY
          BX2    X1
          SA6    A2+
 CSP3     BX2    -X7*X2      USER INDEX BITS 0 - 2
          SB2    X2
          AX6    X3,B2       SELECT MASK BIT
          BX6    -X0*X6
          ZR     X6,CSPX     IF USER INDEX NOT TO BE LOADED
 
*         CHECK TRUE DEVICE SELECTION.
 
          SA1    CPAR+/COMSPFS/CPTD
          ZR     X1,CSPX     IF NO TRUE DEVICE SELECTION
          SA2    TMDA+X2
          SA3    TCBF+FCDN
          SA2    X2+
          MX0    -6
          LX3    24
          BX2    -X0*X2      MASTER DEVICE NUMBER
          BX3    -X0*X3      OLD RESIDENCY DEVICE NUMBER
          IX2    X2-X1
          BX3    X3-X1
          ZR     X2,CSPX     IF FILE CATALOGED ON TRUE DEVICE
          ZR     X3,CSPX     IF FILE RESIDED ON TRUE DEVICE
          BX6    X6-X6       SET TO NOT LOAD FILE
          EQ     CSPX        RETURN
 DDS      SPACE  4,10
**        DDS - DELETE DATA SPACE.
*
*         ENTRY  (*CATS* IN POINTER) = ADDRESS OF CATALOG ENTRY.
*
*         EXIT   DATA SPACE FOR FILE DELETED.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7.
*
*         CALLS  FDB, SFD.
 
 
 DDS      SUBR               ENTRY/EXIT
          RJ     FDB         FLUSH DATA BUFFER
          SA3    CATS+2      CHECK FOR FILE WITH WRITE ERROR
          SA1    X3+FCUI
          SX6    X1+
          SX7    X1-IFUI
          ZR     X6,DDSX     IF WRITE ERROR ON FILE
          ZR     X7,DDSX     IF WRITE ERROR ON FILE
          SA1    X3+FCBS+FCBT*  SET FIRST TRACK AND SECTOR OF FILE
          MX3    -12
          BX6    -X3*X1
          LX3    12
          BX7    X3*X1       CLEAR FIRST TRACK OF FILE
          BX3    -X3*X1
          LX1    59-11
          ZR     X3,DDSX     IF NO FIRST TRACK
          SA7    A1+
          PL     X1,DDS1     IF INDIRECT ACCESS FILE
          SA2    A1+FCDN-FCBT
          MX6    -6
          LX2    -36
          BX2    -X6*X2      SET DEVICE NUMBER
          MX6    -9
          RJ     SFD         SEARCH FOR DEVICE
          LX1    -6
          BX6    -X6*X1      SET EST ORDINAL
          SX6    X6+4000B    SET *DROP TRACKS* FLAG
 DDS1     BX6    X3+X6       PUT PARAMETER IN FET
          SA1    DATA        SET POSITION REQUEST IN FET
          MX3    42
          BX7    X3*X1
          SA6    DATA+FTPM
          SA7    A1
          EQ     DDSX        RETURN
 DIF      SPACE  4,15
**        DIF - DELETE INCOMPLETE FILE.
*
*         ENTRY  (IPFF) = INCOMPLETE PERMANENT FILE FLAG.
*
*         EXIT   (IPFF) = 0.
*                (*TFST* ENTRY) = 0.
*                ANY INCOMPLETE PERMANENT FILE DELETED.
*
*         USES   X - 1, 6.
*                A - 1, 6.
*
*         CALLS  DDS, DPS.
 
 
 DIF      SUBR               ENTRY/EXIT
          SA1    IPFF
          ZR     X1,DIF1     IF NO INCOMPLETE PERMANENT FILE
          RJ     DDS         DELETE DATA SPACE
          RJ     DPS         DELETE PERMIT SPACE
 DIF1     SA1    CBFO
          SA1    TFST+X1
          SX6    B0
          SA6    IPFF        CLEAR INCOMPLETE FILE FLAG
          SA6    A1          CLEAR FILE STATUS
          EQ     DIFX        RETURN
 DPS      SPACE  4,15
**        DPS - DELETE PERMIT SPACE.
*
*         ENTRY  (*CATS* IN POINTER) = ADDRESS OF CATALOG ENTRY.
*
*         EXIT   PERMIT SPACE FOR FILE DELETED.
*                (RICT) = UPDATED TO REFLECT DELETED PERMITS.
*
*         USES   X - 1, 3, 6, 7.
*                A - 1, 3, 6, 7.
*                B - 6, 7.
*
*         CALLS  FPB, WPR.
*
*         MACROS RECALL.
 
 
 DPS      SUBR               ENTRY/EXIT
          RJ     FPB         FLUSH PERMIT BUFFER
          SA3    CATS+2      GET PERMIT RANDOM INDEX
          SA1    X3+FCRI
          MX6    24
          BX7    X6*X1
          ZR     X7,DPSX     IF NO PERMITS
          LX7    -36
          SA1    X2          SET POSITION REQUEST IN FET
          SA7    RICT        UPDATE PERMIT RANDOM INDEX
          MX3    42
          BX6    X3*X1
          SA7    X2+FTPM     PUT RANDOM INDEX PARAMETER IN FET
          SA6    X2
          RECALL X2
          SX7    B1+B1       SET EOI CONTROL WORD
          SB6    LWRD        SET BUFFER ADDRESS
          LX7    54
          SB7    B1          SET BUFFER WORD COUNT
          SA7    B6
          RJ     WPR         WRITE EOI SECTOR
          RJ     FPB         FLUSH PERMIT BUFFER TO FORCE EOI WRITE
          EQ     DPSX        RETURN
 DUP      SPACE  4,15
**        DUP - DROP UTILITY PROCESSOR.
*
*         ENTRY  (PAFL) = 0 IF *PFU* NOT ACTIVE.
*                       = 1 IF *PFU* ACTIVE.
*
*         EXIT   (PAFL) = 0.
*                *PFU* DROPPED IF ACTIVE.
*                CATALOG PROCESSING COMPLETED.
*
*         USES   X - 1, 2, 6.
*                A - 1, 6.
*
*         CALLS  FCB.
*
*         MACROS RECALL.
 
 
 DUP      SUBR               ENTRY/EXIT
          SA1    PAFL
          ZR     X1,DUPX     IF *PFU* NOT ACTIVE
          RJ     FCB         FLUSH CATALOG BUFFER
          RECALL DATA
          SA1    DATA        SIGNAL *PFU* TO DROP
          MX2    42
          BX6    X2*X1
          SX1    10B
          BX6    X6+X1
          SA6    A1
          RECALL DATA        WAIT FOR *PFU* TO COMPLETE
          EQ     DUPX        RETURN
 DWE      SPACE  4,40
**        DWE - DATA WRITE ERROR PROCESSOR.
*
*         ENTRY  (DATA+FTPM) = FST ENTRY AT TIME OF ERROR.
*                WRITE ERROR DETECTED ON DATA FILE.
*
*         EXIT   (BFCA) = BAD FILE CATALOG ADDRESS.
*
*                IF A WRITE ERROR -
*                DATA FOR BAD FILE REMOVED FROM BUFFER.
*                (DATA+FTSC) = DECREMENTED BY SECTOR COUNT REMOVED FROM
*                              BUFFER.
*                FILE LENGTH IN CATALOG DECREMENTED BY THE NUMBER OF
*                SECTORS - 1 REMOVED FROM BUFFER.
*                USER INDEX OF FILE CLEARED FROM CATALOG FOR A DIRECT
*                ACCESS FILE AND SET TO A SPECIAL WRITE ERROR USER
*                INDEX FOR AN INDIRECT ACCESS FILE.
*                DATA WRITE ERROR MESSAGES ISSUED.
*                MASS STORAGE SPACE DROPPED FOR A DIRECT ACCESS FILE.
*                ERROR STATUS CLEARED FROM FET.
*
*                IF A TRACK LIMIT OR ERROR IDLE -
*                DATA AND PERMITS FOR UNWRITTEN CATALOG ENTRIES ARE
*                PURGED.
*                UTILITY PROCESSOR IS DROPPED.
*                UTILITY INTERLOCK IS CLEARED.
*                TRACK LIMIT OR ERROR IDLE MESSAGES ARE ISSUED.
*                MESSAGE IDENTIFYING FIRST FILE NOT LOADED IS ISSUED.
*                EXIT TO *ABT* IS TAKEN.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 2.
*
*         CALLS  CFE, PFD, SEC, SFE.
 
 
 DWE      SUBR               ENTRY/EXIT
          SA1    DATA        GET FET ERROR CODE
          MX2    -6
          LX1    -12
          BX6    -X2*X1
          SX2    A1          SAVE FET ADDRESS
          SX1    X6-FEWE
          ZR     X1,DWE0     IF WRITE ERROR WITH DATA TANSFERRED
          SX1    X6-FEWN     CHECK WRITE ERROR WITH NO DATA TRANSFERRED
          NZ     X1,DWE3     IF NOT WRITE ERROR
 DWE0     SA1    DATA+FTPM
          MX7    -9
          LX1    12
          BX7    -X7*X1      SET EST ORDINAL
          SA7    DWEB
 
*         SET BAD FILE CATALOG ADDRESS.
 
          SA1    DATA+3      GET CONTROL WORD FOR BAD SECTOR
          SA2    X1
          LX2    -36         SET BAD FILE CATALOG ADDRESS
          SX6    X2
          SA6    BFCA
 
*         REMOVE BAD FILE FROM BUFFER.
 
          SX2    DATA        SKIP TO END OF BAD FILE
          RJ     SEC
          SA1    DATA+FTSC   ADJUST SECTOR COUNTER
          SX3    A0
          IX6    X1-X3
          SA6    A1
 
*         SET CORRECT CATALOG LENGTH AND USER INDEX.
 
          SA2    BFCA        ADJUST CATALOG LENGTH
          SX3    A0-B1       LEAVE BAD SECTOR WITH FILE
          SA1    X2+FCLF+FCBS*
          LX3    36
          IX6    X1-X3
          SA3    X2+FCUI
          LX1    59-11       CHECK FILE TYPE
          SA6    A1
          MX2    42          CLEAR USER INDEX
          BX7    X2*X3
          NG     X1,DWE2     IF DIRECT ACCESS FILE
          SX1    IFUI        SET *IAPF* FLAWED SECTOR CHAIN USER INDEX
          BX7    X7+X1
 DWE2     SA7    A3+
 
*         ISSUE ERROR MESSAGE.
 
          SA2    BFCA
          SA1    X2+FCUI
          SB2    ERDW        * DATA WRITE ERROR ...*
          RJ     SFE         SEND ERROR MESSAGE
          RJ     CFE         COUNT FILE SKIPPED
 
*         DROP DIRECT ACCESS FILE.
 
          SA2    BFCA
          SA1    X2+FCBS+FCBT*
          LX1    59-11
          PL     X1,DWEX     IF INDIRECT ACCESS FILE
          MX7    -12
          SA3    DWEB        SET BAD EQUIPMENT
          BX6    -X7*X1      SET FIRST TRACK OF FILE
          LX6    12
          SX3    X3+4000B    SET *DROP TRACKS* FLAG
          BX7    X3+X6
          MX2    42
          SA7    DATA+FTPM   PUT POSITION PARAMETERS IN FET
          SA1    DATA        SET POSITION FUNCTION IN FET
          BX6    X2*X1
          SA6    A1
          EQ     DWEX        RETURN
 
*         PROCESS TRACK LIMIT/ERROR IDLE CONDITION.
 
 DWE3     RJ     PFD         PROCESS FULL DEVICE
          SB2    B0          SET NO MESSAGE
          EQ     ABT         ABORT
 
 
 DWEA     CON    0           WRITE ERROR MESSAGE ADDRESS
 DWEB     CON    0           EST ORDINAL
 ECL      SPACE  4,10
**        ECL - EDIT CATALOG ENTRY FOR LOAD.
*
*         ENTRY  CATALOG ENTRY IN *TCBF*.
*
*         EXIT   CATALOG ENTRY FIELDS MODIFIED AS REQUIRED.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
 
 
 ECL      SUBR               ENTRY/EXIT
 
*         PROCESS UTILITY CONTROL DATE OPTION.
 
          SA1    UDAT        FETCH UTLITY CONTROL UPDATE FLAG
          ZR     X1,ECL1     IF FORCED UPDATE FLAG NOT SET
          SA2    TCBF+FCUD
          MX0    24
          BX6    X0*X2
          BX6    X6+X1       SET UTILITY CONTROL DATE
          SA6    A2+
 
*         PROCESS OP=Z OPTION.
 
 ECL1     SA1    PFCO        FETCH *PFC ONLY* FLAG
          ZR     X1,ECL2     IF *PFC* ONLY
          SA1    CPAR+/COMSPFS/CPOP
          BX6    X6-X6
          LX1    59-46
          PL     X1,ECL2     IF *OP=Z* NOT SELECTED
          SA6    TCBF+FCAA+FCAT*0+FCAF*0  CLEAR CARTRIDGE POINTERS
          SA6    TCBF+FCTV+FCTS*0+FCTF*0  CLEAR TAPE POINTERS
          EQ     ECLX        RETURN
 
*         INITIALIZE ALTERNATE STORAGE FLAGS.
 
 ECL2     SA1    TCBF+FCAF   CHECK ALTERNATE STORAGE INFORMATION
          SA2    TCBF+FCTF
          MX0    -59
          BX6    -X0*X1      CLEAR *AFLOK* FLAG
          BX7    -X0*X2      CLEAR *TFLOK* FLAG
          MX0    -36
          BX3    -X0*X1
          BX4    -X0*X2
          SX0    1
          LX1    59-48
          LX0    52-0
          ZR     X3,ECL3     IF NO CARTRIDGE ALTERNATE STORAGE COPY
          NG     X1,ECL3     IF CARTRIDGE COPY IS OBSOLETE
          BX6    X6+X0       SET *AFVER* FLAG
 ECL3     ZR     X4,ECL4     IF NO TAPE ALTERNATE STORAGE COPY
          LX0    48-52
          BX7    X7+X0       SET *TFVER* FLAG
 ECL4     SA6    TCBF+FCAF   SET CARTRIDGE ALTERNATE STORAGE FLAGS
          SA7    TCBF+FCTF   SET TAPE ALTERNATE STORAGE FLAGS
          EQ     ECLX        RETURN
 EFL      SPACE  4,20
**        EFL - ENTER FILE LIST.
*
*         ENTRY  (TCBF) = CATALOG ENTRY FOR FILE.
*                (FLOF) = 0 IF NO FILE LIST OVERFLOW.
*                       = 1 IF FILE LIST OVERFLOWED TO MASS STORAGE.
*                (FLPT) = NEXT AVAILABLE LOCATION IN FILE LIST BUFFER.
*                (FLBF) = MEMORY RESIDENT PORTION OF FILE LIST.
*
*         EXIT   (FLOF) = 0 IF NO FILE LIST OVERFLOW.
*                       = 1 IF FILE LIST OVERFLOWED TO MASS STORAGE.
*                (FLPT) = NEXT AVAILABLE LOCATION IN FILE LIST BUFFER.
*                (FLBF) = MEMORY RESIDENT PORTION OF FILE LIST.
*                FILE ADDED TO FILE LIST.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*
*         MACROS WRITE, WRITEW.
 
 
 EFL      SUBR               ENTRY/EXIT
          SA1    FLPT        CHECK FOR FULL FILE LIST
          SX6    X1-FLBF-FLBFL
          NG     X6,EFL1     IF FILE LIST NOT FULL
          WRITEW FO,FLBF+FLBFL-100B,100B  WRITE LAST SECTOR OF BUFFER
          WRITE  X2
          SA1    FLPT        BACK LIST POINTER UP ONE SECTOR
          SX1    X1-100B
          SX6    B1+         SET FILE LIST OVERFLOW
          SA6    FLOF
 EFL1     SA2    TCBF+FCFN+FCUI*  PUT FILE IN FILE LIST
          BX7    X2
          SA7    X1
          SX6    X1+B1       ADVANCE FILE LIST POINTER
          SA6    A1
          EQ     EFLX        RETURN
 EOL      SPACE  4,15
**        EOL - END OF LOAD PROCESSOR.
*
*         EXIT   UTILITY PROCESSOR DROPPED.
*                UTILITY INTERLOCK CLEARED.
*                LOAD SYSTEM FILES RETURNED.
*                ARCHIVE FILE POSITIONED AS APPROPRIATE.
*
*         USES   X - 1, 3, 6, 7.
*                A - 1, 3.
*
*         CALLS  CIN, DUP, PSF.
*
*         MACROS RECALL, RETURN, SKIPFF.
 
 
 EOL      SUBR               ENTRY/EXIT
          RJ     DUP         DROP UTILITY PROCESSOR
          RJ     CIN         CLEAR UTILITY INTERLOCK
          RJ     PSF         PROCESS SORTED FILE OUTPUT
          RETURN CATS        RETURN LOAD SYSTEM FILES
          RETURN PETS
          RETURN DATA
          SETPFP GPAR        RESTORE PERMANENT FILE PARAMETERS
          RETURN DATA        RETURN FILES
          RETURN CIRF
          RETURN FO
          RECALL TAPE        POSITION ARCHIVE FILE
          SA1    CPAR+/COMSPFS/CPNB
          ZR     X1,EOLX     IF NO FILE COUNT SPECIFIED
          SA3    X2          CHECK FOR EOF/EOI ON ARCHIVE FILE
          SX6    30B
          BX7    X6*X3
          BX6    X7-X6
          NZ     X6,EOL3     IF NOT EOF/EOI
          SX1    X1-1
 EOL3     ZR     X1,EOLX     IF NO FILES TO SKIP
          SKIPFF X2,X1       SKIP FILES NOT PROCESSED
          EQ     EOLX        RETURN
 FCB      SPACE  4,40
**        FCB - FLUSH CATALOG BUFFER.
*
*         ENTRY  (CEWF) = 0 IF NO CATALOG ENTRIES IN BUFFER.
*                       = NON-ZERO IF CATALOG ENTRIES IN BUFFER.
*                (CSWC) = CURRENT CATALOG SECTOR WORD COUNT.
*
*         EXIT   (CBFO) = 0.
*                (CEWF) = 0.
*                THE FOLLOWING CONDITIONS EXIST IF (CEWF) WAS NON-ZERO.
*                (CSWC) = 0.
*                (ANCE) = FWA OF CATALOG BUFFER.
*                PERMIT BUFFER FLUSHED.
*                DATA BUFFER FLUSHED.
*                CATALOG BUFFER WRITTEN TO MASS STORAGE.
*                CATALOG BUFFER REWOUND.
*
*                IF A CATALOG WRITE ERROR IS DETECTED THE UTILITY
*                PROCESSOR IS DROPPED, ERROR IDLE STATUS IS SET ON THE
*                MASTER EQUIPMENT IF DATA ON THE CATALOG FILE HAS
*                BEEN CORRUPTED, THE UTILITY INTERLOCK IS CLEARED,
*                CATALOG WRITE ERROR MESSAGES ARE ISSUED AND EXIT IS TO
*                *ABT*.
*
*                IF A TRACK LIMIT OR ERROR IDLE CONDITION IS DETECTED,
*                DATA AND PERMITS FOR UNWRITTEN CATALOG ENTRIES ARE
*                PURGED, THE UTILITY PROCESSOR IS DROPPED, THE UTILITY
*                INTERLOCK IS CLEARED, TRACK LIMIT OR ERROR IDLE
*                MESSAGES ARE ISSUED, THE FIRST FILE NOT LOADED IS
*                IDENTIFIED AND EXIT IS TO *ABT*.
*
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 6, 7.
*
*         CALLS  FDB, FPB, LLF, PCE, PFD.
*
*         MACROS RECALL.
 
 
 FCB      SUBR               ENTRY/EXIT
          SA1    CEWF
          ZR     X1,FCBX     IF NO CATALOG ENTRIES IN BUFFER
          SA1    CSWC        GET SECTOR WORD COUNT
          ZR     X1,FCB3     IF SECTOR IS EMPTY
 
*         GET SECTOR CONTROL WORD.
 
          SA2    CATS+FTIN
          SA3    CATS+FTFT
          SX2    X2
          SX3    X3
          IX6    X2-X1       IN - SECTOR WORD COUNT
          IX7    X6-X3
          ZR     X7,FCB1     IF WRAP AROUND
          PL     X7,FCB2     IF NO WRAP AROUND
 FCB1     SA3    CATS+FTLM
          SX3    X3
          IX6    X3+X7       LIMIT + COMPLEMENT OF REMAINING COUNT
 FCB2     SA2    X6-1        GET SECTOR CONTROL WORD
 
*         INSERT WORD COUNT INTO SECTOR CONTROL WORD.
 
          MX7    48
          BX6    X7*X2
          IX7    X6+X1
          SA7    A2
 
*         INCREMENT BUFFER SECTOR COUNTER.
 
          SA2    CATS+FTSC
          SX6    X2+1
          SA6    A2+
 
*         FLUSH CATALOG AND ASSOCIATED BUFFERS.
 
 FCB3     RJ     FPB         FLUSH PERMIT BUFFER
          RJ     FDB         FLUSH DATA BUFFER
          SA1    CATS        ISSUE WRITE REQUEST
          MX2    42
          BX7    X2*X1
          SX1    B1+B1       SET WRITE FUNCTION CODE
          BX6    X7+X1
          SA6    A1
          RECALL A1          WAIT FOR *PFU* TO FLUSH BUFFER
          RJ     LLF         LIST LOADED FILES
          SA1    CATS        CHECK ERROR STATUS
          MX7    -6
          LX1    -12
          BX6    -X7*X1
          NZ     X6,FCB4     IF MASS STORAGE ERROR
          SA1    A1+B1       REWIND BUFFER
          SX7    X1
          SA7    A1+B1
          SA7    A7+B1
          SA7    ANCE        SET ADDRESS OF NEW CATALOG ENTRIES
          SA6    CSWC        CLEAR SECTOR WORD COUNT
          SA6    CATS+FTSC   CLEAR SECTOR COUNTER
          SA6    CEWF        CLEAR *CATALOG ENTRIES WRITTEN*
          SA6    CBFO        RESET CATALOG BUFFER ORDINAL
          EQ     FCBX        RETURN
 
*         PROCESS CATALOG WRITE ERROR.
 
 FCB4     SX1    X6-FEWE
          ZR     X1,FCB4.1   IF WRITE ERROR WITH DATA TRANSFERRED
          SX1    X6-FEWN     CHECK WRITE ERROR WITH NO DATA TRANSFERRED
          NZ     X1,FCB5     IF NOT WRITE ERROR
 FCB4.1   SA2    CATS+FTOT   GET BAD SECTOR CONTROL WORD
          SA3    CATS+FTPM   GET BAD TRACK AND SECTOR ADDRESS
          MX6    24
          LX3    12          PUT BAD ADDRESS IN CONTROL WORD
          SA1    X2
          LX6    -12
          BX2    X6*X3
          BX3    -X6*X1
          BX7    X2+X3
          SA7    A1
          SX6    ERCW        * CATALOG WRITE ERROR...*
          RJ     PCE         PROCESS CATALOG WRITE ERROR
          SB2    B0          SET NO MESSAGE
          EQ     ABT         ABORT
 
*         PROCESS TRACK LIMIT/ERROR IDLE CONDITION.
 
 FCB5     SX2    CATS
          RJ     PFD         PROCESS FULL DEVICE
          SB2    B0          SET NO MESSAGE
          EQ     ABT         ABORT
FDB       SPACE  4,10
**        FDB - FLUSH DATA BUFFER.
*
*         EXIT   DATA BUFFER FLUSHED.
*                DATA WRITE ERRORS PROCESSED IF NECESSARY.
*
*         USES   X - 2.
*
*         CALLS  DWE, FUB.
 
 
 FDB      SUBR               ENTRY/EXIT
 FDB1     SX2    DATA        FLUSH DATA BUFFER
          RJ     FUB
          ZR     X6,FDBX     IF NO MASS STORAGE ERROR
          RJ     DWE         PROCESS DATA WRITE ERROR
          EQ     FDB1        FLUSH DATA BUFFER
 FPB      SPACE  4,20
**        FPB - FLUSH PERMIT BUFFER.
*
*         EXIT   (X2) = PERMIT FET ADDRESS.
*                PERMIT BUFFER FLUSHED.
*
*                IF A PERMIT WRITE ERROR, TRACK LIMIT ERROR OR ERROR
*                IDLE CONDITION IS DETECTED, CLEANUP IS PERFORMED AND
*                EXIT IS TO *ABT*.
*
*         USES   X - 2, 5.
*
*         CALLS  FUB, PWE.
 
 
 FPB      SUBR               ENTRY/EXIT
          SX2    PETS        FLUSH PERMIT BUFFER
          RJ     FUB
          ZR     X6,FPBX     IF NO PERMIT WRITE ERROR
          RJ     PWE         PROCESS PERMIT WRITE ERROR
          SB2    B0          SET NO MESSAGE
          EQ     ABT         ABORT
 FPF      SPACE  4,15
**        FPF - FLUSH PERMANENT FILES.
*
*         ENTRY  (UIFL) = UTILITY INTERLOCK STATUS.
*                (PAFL) = UTILITY PROCESSOR ACTIVITY FLAG.
*
*         EXIT   ANY INCOMPLETE PERMANENT FILE DELETED.
*                COMPLETE PERMANENT FILES FLUSHED TO MASS STORAGE.
*
*         USES   X - 1, 2, 6.
*                A - 1, 2, 6.
*
*         CALLS  DIF, SSC.
*
*         MACROS CALLPFU, RECALL.
 
 
 FPF1     RJ     DIF         DELETE INCOMPLETE FILE
 
 FPF      SUBR               ENTRY/EXIT
          SA1    UIFL        CHECK UTILITY INTERLOCK STATUS
          SX2    X1-1
          NZ     X2,FPFX     IF UTILITY INTERLOCK NOT SET
          SA1    PAFL
          NZ     X1,FPF1     IF UTILITY PROCESSOR ALREADY ACTIVE
          SA1    CATS+2      SET CATALOG WORD COUNT
          SA2    A1+B1
          IX6    X1-X2
          SX1    101B        SET SECTOR COUNT
          ZR     X6,FPFX     IF NO CATALOG ENTRIES
          IX6    X6/X1
          SA6    CATS+FTSC
          SX2    PETS        SET PERMIT FILE SECTOR COUNTER
          RJ     SSC
          SX2    DATA        SET DATA FILE SECTOR COUNTER
          RJ     SSC
          SA1    MAEQ        SET MASTER EQUIPMENT AND NON-INITIAL FLAG
          SX2    B1
          LX1    12
          BX6    X1+X2
          SA6    DATA+FTDW
          SA1    CPAR+/COMSPFS/CPDN  SET MASTER DEVICE NUMBER
          SA2    FAPM        SET FET ADDRESS PARAMETERS
          LX1    54
          BX6    X1+X2
          SA6    CATS+FTPM
          SA1    PETS        SET PERMITS FET BUSY
          MX2    48
          BX6    X2*X1
          SA6    A1
          SA1    DATA        SET DATA FET BUSY
          BX6    X2*X1
          SA6    A1+
          CALLPFU  CATS,CTLM ACTIVATE UTILITY LOAD PROCESSOR
          RECALL DATA        WAIT FOR UTILITY PROCESSOR TO INITIALIZE
          EQ     FPF1        DELETE INCOMPLETE FILE
 FUB      SPACE  4,20
**        FUB - FLUSH UTILITY BUFFER.
*
*         ENTRY  (X2) = FET ADDRESS.
*
*         EXIT   (X2) = FET ADDRESS.
*                (X6) = 0 IF NO ERROR DETECTED.
*                     = FET ERROR CODE IF ERROR DETECTED.
*                *PFU* WRITE FUNCTION CODE PLACED IN FET IF BUFFER NOT
*                EMPTY.
*                FET NOT BUSY.
*
*         USES   X - 1, 3, 6, 7.
*                A - 1, 3, 7.
*
*         MACROS RECALL.
 
 
 FUB      SUBR               ENTRY/EXIT
 FUB1     RECALL X2
          SA1    X2+2        CHECK FOR EMPTY BUFFER
          SA3    A1+B1
          IX6    X1-X3
          ZR     X6,FUBX     IF BUFFER EMPTY
          SA1    X2          ISSUE WRITE REQUEST
          MX7    42
          BX6    X7*X1
          SX3    B1+B1       SET WRITE FUNCTION CODE
          BX7    X6+X3
          LX1    -12         GET ERROR STATUS
          MX3    -6
          BX6    -X3*X1
          NZ     X6,FUBX     IF WRITE ERROR
          SA7    X2
          EQ     FUB1        WAIT FOR *PFU* TO FLUSH BUFFER
 IFM      SPACE  4,10
**        IFM - ISSUE FILE COUNT MESSAGES.
*
*         EXIT   FILES PROCESSED COUNTS ISSUED TO DAYFILE.
*
*         USES   X - 1, 5.
*                A - 1, 5.
*
*         CALLS  IFC.
*
*         MACROS MESSAGE.
 
 
 IFM      SUBR               ENTRY/EXIT
          SA1    AREF
          ZR     X1,IFM1     IF NO ARCHIVE FILE READ ERRORS
          MESSAGE  AEMS      * READ ERRORS ENCOUNTERED ON ARCHIVE...*
 IFM1     SA5    IFMA
          RJ     IFC         ISSUE FILE COUNT MESSAGES
          EQ     IFMX        RETURN
 
 
 IFMA     BSS    0           MESSAGE TABLE
          VFD    1/1,1/0,22/0,18/LDMS,18/PRFC
          VFD    1/1,1/0,22/0,18/SEMS,18/SEFC
          VFD    1/1,1/0,22/0,18/LEMS,18/PEFC
          CON    0           END OF TABLE
 LLF      SPACE  4,15
**        LLF - LIST LOADED FILES.
*
*         EXIT   CATALOG DATA WRITTEN TO OUTPUT FILES FOR LOADED FILES
*                  IN CATALOG BUFFER.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 0, 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  CFP.
 
 
 LLF      SUBR               ENTRY/EXIT
          SA3    CATS+FTFT
          SX4    -NWCE       INITIALIZE SECTOR WORD COUNT
          SX5    B0+         INITIALIZE CATALOG ORDINAL
          MX6    -18
          BX3    -X6*X3      ADDRESS OF FIRST SECTOR CONTROL WORD
 LLF1     SA1    CATS+FTOT   GET *OUT* POINTER
          SX4    NWCE+X4     EXCESS WORDS IN PREVIOUS SECTOR
          IX3    X3+X4       LWA+1 OF PREVIOUS SECTOR
          IX6    X3-X1
          PL     X6,LLFX     IF NO MORE SECTORS IN BUFFER
          SA4    X3          READ SECTOR CONTROL WORD
          MX6    -12
          BX4    -X6*X4      SECTOR WORD COUNT
          SX3    X3+B1       SKIP CONTROL WORD
 LLF2     SX4    X4-NWCE     DECREMENT SECTOR WORD COUNT
          NG     X4,LLF1     IF NO MORE CATALOG ENTRIES IN SECTOR
          SA1    X3+FCUI     GET USER INDEX
          SA2    ANCE
          MX6    -18
          BX6    -X6*X1
          IX2    X3-X2
          SX3    X3+NWCE     ADVANCE CATALOG ENTRY ADDRESS
          SX5    X5+1        ADVANCE CATALOG BUFFER ORDINAL
          NG     X2,LLF2     IF OLD CATALOG ENTRY
          ZR     X6,LLF2     IF CATALOG HOLE (DATA WRITE ERROR)
          SX6    X6-IFUI
          ZR     X6,LLF2     IF IAPF FLAW (DATA WRITE ERROR)
          BX6    X3
          BX7    X4
          SA6    LLFA        SAVE NEXT CATALOG ENTRY ADDRESS
          SA7    A6+B1       SAVE SECTOR WORD COUNT
          SA1    TFST-1+X5   GET FILE STATUS
          SX6    X5
          SA6    A7+B1       SAVE CATALOG BUFFER ORDINAL
          BX7    X1
          SA0    X3-NWCE     SET CATALOG ENTRY ADDRESS
          SA7    FLST        SET FILE STATUS
          RJ     CFP         COUNT FILE PROCESSED
          SA3    LLFA        RESTORE CATALOG ENTRY ADDRESS
          SA4    LLFA+1      RESTORE SECTOR WORD COUNT
          SA5    LLFA+2      RESTORE CATALOG BUFFER ORDINAL
          EQ     LLF2        PROCESS NEXT CATALOG ENTRY
 
 
 LLFA     CON    0           CATALOG ENTRY ADDRESS
          CON    0           REMAINING SECTOR WORD COUNT
          CON    0           CATALOG BUFFER ORDINAL
 MCE      SPACE  4,20
**        MCE - MOVE CATALOG ENTRY TO BUFFER.
*
*         ENTRY  (TCBF - TCBF+NWCE-1) = CATALOG ENTRY.
*                (*CATS* IN POINTER) = BUFFER ADDRESS FOR CATALOG.
*                (IPFF) = INCOMPLETE FILE FLAG.
*
*         EXIT   ANY INCOMPLETE FILE DELETED.
*                CATALOG ENTRY MOVED TO *CATS* BUFFER.
*                FIRST TRACK AND PERMIT RANDOM INDEX CLEARED FROM
*                CATALOG ENTRY IN *CATS* BUFFER.
*                (IPFF) = 1.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 2, 3.
*
*         CALLS  DIF.
 
 
 MCE      SUBR               ENTRY/EXIT
          RJ     DIF         DELETE INCOMPLETE FILE
          SA1    CATS+2      BUFFER ADDRESS = IN
          SB2    NWCE-1      CATALOG ENTRY WORD COUNT - 1
          SB3    TCBF        CATALOG ENTRY ADDRESS
 MCE1     SA2    B3+B2       GET WORD FROM CATALOG ENTRY
          BX6    X2
          SA6    X1+B2       STORE WORD IN BUFFER
          SB2    B2-B1       DECREMENT WORD COUNT
          PL     B2,MCE1     IF MORE WORDS TO MOVE
          SA2    X1+FCBS
          LX2    59-11
          PL     X2,MCE2     IF NOT DIRECT ACCESS FILE
          SX6    B1          INCREMENT FILE LENGTH (DATA SECTORS +1)
          SA2    X1+FCLF
          LX6    36-0
          IX6    X2+X6
          SA6    A2+
 MCE2     SA2    X1+FCRI     CLEAR RANDOM INDEX
          MX7    -36
          BX6    -X7*X2
          SA6    A2
          MX7    48
          SA2    X1+FCBT     CLEAR FIRST TRACK
          LX7    12
          BX6    X7*X2
          SX7    B1          SET INCOMPLETE PERMANENT FILE FLAG
          SA6    A2
          SA7    IPFF
          EQ     MCEX        RETURN
 PAL      SPACE  4,25
**        PAL - PROCESS ARCHIVE FILE LABEL.
*
*         EXIT   (X6) = 0 IF ARCHIVE FILE LABEL GOOD OR IF ARCHIVE FILE
*                         LABEL NOT FOUND AND NOT INCREMENTAL LOAD.
*                (X6) .NE. 0 IF ARCHIVE FILE LABEL BAD OR IF ARCHIVE
*                     FILE LABEL NOT FOUND AND INCREMENTAL LOAD.
*                (TLBF+/COMSPFS/PFAL) = 0 IF ARCHIVE FILE LABEL NOT
*                                       PRESENT OR BAD.
*                (TLBF - TLBF+/COMSPFS/AFLBL-1) = NEW ARCHIVE FILE
*                  LABEL IF PRESENT AND GOOD.
*                LABEL INFORMATION SET IN OUTPUT FILE HEADER IF LABEL
*                  PRESENT AND GOOD.
*                ARCHIVE FILE INFORMATION BLOCK WRITTEN TO CATALOG
*                  ENTRIES FILE IF LABEL PRESENT AND GOOD OR LABEL NOT
*                  FOUND.
*                OUTPUT FILE INITIALIZED FOR FILE PROCESSING IF LABEL
*                  PRESENT AND GOOD OR LABEL NOT FOUND.
*
*
*         USES   X - 1, 2, 5, 6, 7.
*                A - 0, 1, 2, 7.
*
*         CALLS  PLP, RCW, SER.
*
*         MACROS CWREAD, MOVE.
 
 
*         PROCESS LABEL NOT FOUND.
 
 PAL4     SA2    INCF
          SX7    1
          NZ     X2,PAL2.1   IF INCREMENTAL LOAD
          NG     X1,PAL5     IF EOF/EOI
          NZ     X1,PAL1     IF EOR
          SA7    RCWF        SET CONTROL WORD RE-USE FLAG
 PAL5     SA0    B0          SET LABEL NOT FOUND
          RJ     PLP         PROCESS LABEL PARAMETERS
          SX6    B0+         CLEAR BAD LABEL STATUS
 
 PAL      SUBR               ENTRY/EXIT
          SX7    B0+         PRESET NO LABEL PRESENT
          SA7    TLBF+/COMSPFS/PFAL
 PAL1     RJ     RCW         READ ARCHIVE FILE CONTROL WORD
          NZ     X7,PAL3     IF READ ERROR
          NZ     X3,PAL4     IF NOT LABEL CONTROL WORD
          SA1    CWBF        GET LABEL WORD COUNT
          MX2    -9
          BX6    -X2*X1
          SX1    X6-/COMSPFS/AFLBL
          NZ     X1,PAL2     IF BAD LABEL WORD COUNT
          CWREAD TAPE,TDBF,X6  READ ARCHIVE FILE LABEL
          NZ     X7,PAL3     IF READ ERROR
          NZ     X1,PAL2     IF LABEL INCOMPLETE
          SA1    TDBF+/COMSPFS/PFAL  CHECK LABEL IDENTIFIER
          SA2    AFLI
          MX6    36
          BX1    X6*X1
          IX2    X1-X2
          NZ     X2,PAL2     IF NOT CORRECT LABEL IDENTIFIER
          MOVE   /COMSPFS/AFLBL,TDBF,TLBF  MOVE LABEL TO LABEL BUFFER
          SA0    TLBF        SET ARCHIVE LABEL ADDRESS
          RJ     PLP         PROCESS ARCHIVE LABEL PARAMETERS
          RJ     SER         SKIP TO END OF RECORD
          BX6    X6-X6       CLEAR BAD LABEL STATUS
          SA6    EOLF        CLEAR END OF LOAD FLAG
          EQ     PALX        RETURN
 
*         PROCESS BAD LABEL.
 
 PAL2     SA2    INCF
          NZ     X2,PAL2.1   IF INCREMENTAL LOAD
          RJ     SER         SKIP TO END OF RECORD
          SA0    B0          SET LABEL NOT FOUND
          RJ     PLP         PROCESS LABEL PARAMETERS
 PAL2.1   SX6    B1          SET BAD LABEL STATUS
          EQ     PALX        RETURN
 
*         PROCESS READ ERROR.
 
 PAL3     SA7    AREF        INDICATE READ ERROR
          RJ     SER         SKIP TO END OF RECORD
          EQ     PAL1        READ ARCHIVE FILE CONTROL WORD
 PCB      SPACE  4,40
**        PCB - PROCESS CATALOG BUFFER.
*
*         EXIT   (X6) = 0 IF FILE NOT TO BE LOADED.
*                     = 1 IF FILE TO BE LOADED.
*                (TCBF) = CATALOG ENTRY FOR CURRENT FILE.
*                (MMSK) = UPDATED MASTER DEVICE MASK.
*                (NCTR) = UPDATED NUMBER OF CATALOG TRACKS.
*                (MAEQ) = UPDATED MASTER EQUIPMENT.
*                (CPAR+/COMSPFS/CPDN) = UPDATED MASTER DEVICE NUMBER.
*                (SKER) = 1 IF *SKIP TO EOR* REQUIRED.
*                (PFCO) = 0 IF *PFC ONLY* FILE.
*                (PFCO) .NE. 0 IF NOT *PFC ONLY* FILE.
*                MASTER DEVICE SWITCH MADE IF NECESSARY.
*                FILES OPENED IF A MASTER DEVICE SWITCH IS MADE.
*
*         USES   X - 0, 1, 2, 4, 5, 6, 7.
*                A - 1, 5, 7.
*
*         CALLS  CCE, CCI, CDE, CFE, CSP, DFN, ECL, EFL, GCT, MCE, PGF,
*                SFE, SFL, SMD, VFN.
*
*         MACROS CWREAD, MESSAGE, MOVE.
 
 
 PCB      SUBR               ENTRY/EXIT
 
*         CHECK FOR PFC ONLY FILE.
 
          SA1    CWBF        FETCH CONTROL WORD
          MX0    -3          EXTRACT SUBTYPE
          LX0    11-2
          BX7    -X0*X1
          SA7    PFCO        SAVE *PFC ONLY* FLAG
 
*         READ AND VALIDATE CATALOG ENTRY.
 
          MX0    -9
          BX5    -X0*X1
          CWREAD TAPE,TCBF,X5
          NZ     X7,PCB10    IF READ ERROR
          RJ     VFN         VALIDATE FILE NAME
          PL     X3,PCB9     IF FILE NAME NOT VALID
          SA1    TCBF+FCUI   VALIDATE USER INDEX
          SX6    X1+
          NG     X6,PCB9     IF USER INDEX NOT VALID
 
*         CHECK FORMAT OF CATALOG ENTRY.
 
          SA1    CWBF        CHECK SIZE OF CATALOG ENTRY
          MX6    -9
          BX2    -X6*X1
          SX1    X2-NWCE
          ZR     X1,PCB1     IF CURRENT SIZE
          SX4    TCBF
          RJ     CCE         CONVERT CATALOG ENTRY TO CURRENT FORMAT
 
*         PROCESS SELECTION PARAMETERS.
 
 PCB1     SA1    CPAR+/COMSPFS/CPOP
          LX1    59-46
          PL     X1,PCB2     IF *OP=Z* NOT SELECTED
          SA1    PFCO
          ZR     X1,PCB6     IF PFC ONLY FILE
 PCB2     RJ     CCI         CHECK CATALOG IMAGE
          NZ     X6,PCB6     IF FILE NOT TO BE LOADED
          RJ     CSP         CHECK SELECTION PARAMETERS
          ZR     X6,PCB6     IF FILE NOT TO BE LOADED
 
*         DETERMINE IF FILE CAN BE LOADED IN CURRENT ENVIRONMENT.
 
          RJ     SMD         SET MASTER DEVICE PARAMETERS
          RJ     SFL         SEARCH FILE LIST
          ZR     X6,PCB3     IF FILE ALREADY PRESENT
          RJ     CDE         CHECK DEVICE ENVIRONMENT
          ZR     B2,PCB5     IF NO ERROR
          EQ     PCB8        ISSUE ERROR MESSAGE AND SKIP FILE
 
 PCB3     SA1    CPAR+/COMSPFS/CPOP
          LX1    59-52
          PL     X1,PCB9     IF REPLACE OPTION NOT SPECIFIED
          RJ     CDE         CHECK DEVICE ENVIRONMENT
          SX6    B2-ERNS
          ZR     B2,PCB4     IF NO ERROR
          NZ     X6,PCB8     IF NOT *NO SPACE FOR FILE* ERROR
 PCB4     RJ     PGF         PURGE FILE
          NZ     B2,PCB8     IF NO SPACE FOR FILE
          RJ     SFL         SEARCH FILE LIST
          SB2    ERPE        * ERROR ON FILE PURGE ...*
          ZR     X6,PCB8     IF FILE FOUND AGAIN AFTER PURGE
          RJ     CDE         CHECK DEVICE ENVIRONMENT
          NZ     B2,PCB8     IF ERROR
 
*         LOAD FILE.
 
 PCB5     SA7    TCBF+FCDN   SET DEVICE NUMBER
          RJ     EFL         ENTER FILE IN LIST
          SA1    TCBF+FCUI
          SA2    MSGA        *LOADING ...*
          RJ     DFN         DISPLAY MESSAGE
          RJ     ECL         EDIT CATALOG ENTRY FOR LOAD
          RJ     MCE         MOVE CATALOG ENTRY TO CATALOG BUFFER
          SX6    B1          SET LOAD FILE
          EQ     PCBX        RETURN
 
*         DETERMINE IF END OF INDEX LOAD.
 
 PCB6     SA5    MXDC
          ZR     X5,PCB9     IF NOT SELECTIVE LOAD
          SA1    TCBF+FCUI   CURRENT USER INDEX
          MX2    -3
          BX2    -X2*X1      SUBFAMILY INDEX
          SA2    SFDT+X2
          LX1    -3
          SX6    X2          CATALOG TRACK MASK
          BX2    -X6*X2      ARCHIVE FILE DEVICE ORDINAL
          BX1    X6*X1       CATALOG TRACK
          BX6    X2+X1
          IX6    X5-X6
          PL     X6,PCB9     IF NOT PAST USER INDEX-S CATALOG TRACK
          SX7    1
          SA7    EOLF        SET END OF LOAD FLAG
          EQ     PCB9        SKIP FILE
 
*         ISSUE ERROR MESSAGE AND COUNT FILE NOT LOADED.
 
 PCB8     SA1    TCBF+FCUI   SET FILE NAME AND USER INDEX
          RJ     SFE         SEND ERROR MESSAGE
          RJ     CFE         ISSUE MESSAGE AND COUNT FILE NOT LOADED
 
*         SKIP FILE.
 
 PCB9     SX7    B1          SET SKIP TO EOR FLAG
          SA7    SKER
          SA1    TCBF+FCUI
          SA2    MSGE        *SKIPPING ...*
          RJ     DFN         DISPLAY MESSAGE
          SX6    B0          SET SKIP FILE
          EQ     PCBX        RETURN
 
*         PROCESS READ ERROR.
 
 PCB10    SA7    AREF        INDICATE READ ERROR
          EQ     PCB9        SKIP FILE
 PCE      SPACE  4,25
**        PCE - PROCESS CATALOG ERROR.
*
*         ENTRY  (X6) = CATALOG READ OR WRITE ERROR MESSAGE ADDRESS.
*                (CPAR+/COMSPFS/CPDN) = MASTER DEVICE NUMBER.
*                (CCTR) = CURRENT CATALOG TRACK.
*                (MAEQ) = MASTER DEVICE EST ORDINAL.
*                (*CATS* BUFFER) = CATALOG ENTRIES FOR FILES AFFECTED
*                                  BY THE ERROR.  CONTROL WORD FOR
*                                  FIRST SECTOR IN BUFFER CONTAINS
*                                  TRACK AND SECTOR ADDRESS OF THE
*                                  ERROR.
*
*         EXIT   *PFU* DROPPED.
*                IF A WRITE ERROR, ERROR IDLE STATUS IS SET FOR THE
*                MASTER EQUIPMENT IF DATA ON THE CATALOG FILE HAS
*                BEEN CORRUPTED.
*                UTILITY INTERLOCK CLEARED.
*                CATALOG ERROR MESSAGES ISSUED.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7.
*
*         CALLS  CIN, DUP, SEI, SFE.
 
 
 PCE      SUBR               ENTRY/EXIT
          SA6    PCEB        SAVE MESSAGE ADDRESS
 
*         DROP *PFU*.
 
          SX6    B0+         CLEAR *CATALOG ENTRIES WRITTEN*
          SA6    CEWF
          RJ     DUP         DROP UTILITY PROCESSOR
 
*         IDENTIFY FAILING DEVICE.
 
          SA1    PCEB        ERROR MESSAGE ADDRESS
          SX1    X1-ERCW
          NZ     X1,PCE0.1   IF NOT WRITE ERROR
          SA1    CATS        GET ERROR CODE FROM FET
          MX2    -6
          LX1    -12
          BX1    -X2*X1      ERROR CODE
          SX1    X1-FEWE
          NZ     X1,PCE0.1   IF DATA NOT TRANSFERRED TO DEVICE
          SB2    ELWC        * ERROR IDLE SET - PF CATALOG WRITE ...*
          RJ     SEI         SET ERROR IDLE STATUS
 PCE0.1   RJ     CIN         CLEAR UTILITY INTERLOCK
 
*         LIST FILES IN CATALOG BUFFER.
 
          SA2    CATS+3      SET ADDRESS OF FIRST CONTROL WORD
 PCE1     SA1    CATS+2      CHECK IF MORE SECTORS IN BUFFER
          IX3    X2-X1
          MX6    -12
          PL     X3,PCEX     IF NO MORE SECTORS IN BUFFER
          SA1    X2          SET SECTOR WORD COUNT
          BX3    -X6*X1
          SX2    X2+1        SET ADDRESS OF NEXT CATALOG ENTRY
 PCE2     SX3    X3-NWCE     DECREMENT SECTOR WORD COUNT
          NG     X3,PCE1     IF END OF CATALOG SECTOR
          SA1    X2+FCFN     SET FILE NAME AND USER INDEX
          SX2    X2+NWCE     ADVANCE CATALOG ENTRY ADDRESS
          MX7    -18
          BX6    -X7*X1      USER INDEX
          ZR     X6,PCE2     IF CATALOG HOLE
          BX6    X2          SAVE CATALOG ENTRY ADDRESS
          SA6    PCEA
          BX7    X3          SAVE SECTOR WORD COUNT
          SA7    A6+B1
          SA2    PCEB
          SB2    X2          SET ERROR MESSAGE ADDRESS
          RJ     SFE         SEND ERROR MESSAGE
          SA2    PCEA        RESTORE CATALOG ENTRY ADDRESS
          SA3    PCEA+1      RESTORE SECTOR WORD COUNT
          EQ     PCE2        PROCESS NEXT CATALOG ENTRY
 
 
 PCEA     BSSZ   2           SECTOR ADDRESS AND LENGTH PARAMETERS
 PCEB     CON    0           ERROR MESSAGE ADDRESS
 PDB      SPACE  4,20
**        PDB - PROCESS DATA BLOCK.
*
*         ENTRY  (X3) .LT. 0 IF EOR DETECTED ON ARCHIVE FILE.
*                     .GE. 0 IF EOR NOT DETECTED ON ARCHIVE FILE.
*                (*CATS* IN POINTER) = ADDRESS OF CATALOG ENTRY.
*
*         EXIT   (X6) = 0 IF FILE NOT TO BE LOADED.
*                     = NON-ZERO IF FILE TO BE LOADED.
*                DATA FOR FILE WRITTEN TO MASS STORAGE.
*                (SKER) = 1 IF *SKIP TO EOR* REQUIRED.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 6, 7.
*
*         CALLS  AFE, CFE, DIF, DWE, RCW, SCE, SFE, WPR.
*
*         MACROS CWREAD, RECALL.
 
 
 PDB      SUBR               ENTRY/EXIT
 
*         PRESET DATA PROCESSING PARAMETERS.
 
          SA1    TCBF+FCLF   SET FILE LENGTH
          MX0    -24
          SX2    B1          ADJUST LENGTH FOR EOI
          LX1    -36
          BX6    -X0*X1
          IX7    X6+X2
          BX5    X5-X5       CLEAR WORD ACCUMULATOR
          SA1    TCBF+FCBS   CHECK FILE TYPE
          SA7    PDBB
          BX6    X6-X6       CLEAR *PFU* CONTROL WORD
          LX1    59-11
          SA6    PDBD        CLEAR BUFFER POINTER
          SX7    SSBFL       INITIALIZE SYSTEM SECTOR LENGTH
          SA7    PDBC
          PL     X1,PDB1     IF INDIRECT ACCESS FILE
 
*         SET DEVICE NUMBER FOR DIRECT ACCESS FILE IN LINKAGE WORD.
 
          SA1    TCBF+FCDN   GET DN FROM CATALOG
          MX0    -6
          LX1    -36
          BX6    -X0*X1
          LX6    48
          NZ     X6,PDB1     IF DEVICE SPECIFIED IN CATALOG
          SA1    CPAR+/COMSPFS/CPDN  SET MASTER DEVICE NUMBER
          LX1    48
          BX6    X1
          NZ     X1,PDB1     IF DN SPECIFIED
          MX6    1           SET 4000B FOR PACK DAPF DN
 PDB1     LX6    24
 
*         SET CATALOG ADDRESS IN LINKAGE WORD.
 
          SA1    CATS+2      GET ADDRESS OF CATALOG ENTRY
          LX1    36
          BX6    X6+X1
          SA6    LWRD
          NG     X3,PDB13    IF PHYSICAL EOR
          EQ     PDB3
 
 PDB2     RJ     RCW         READ CONTROL WORD
          NZ     X7,PDB25    IF READ ERROR
          SX0    X3-3
          NZ     X0,PDB12    IF NOT DATA TYPE
 
*         BREAK UP CONTROL WORD
 
 PDB3     SA4    CWBF        CHECK FOR ERROR CONTROL WORD
          SA3    PDBE
          MX0    42
          BX2    X0*X4
          BX2    X2-X3
          ZR     X2,PDB26    IF ERROR CONTROL WORD
          MX0    51
          BX1    -X0*X4      SET NUMBER OF WORDS
          AX4    9
          AX0    6
          BX0    -X0*X4      SET DATA MARK
          IX5    X5+X1       INCREMENT WORD COUNT
 
*         CHECK FOR SYSTEM SECTOR.
 
          SA3    PDBC        GET REMAINING SYSTEM SECTOR LENGTH
          SX4    X0-4
          BX7    X7-X7
          BX6    X4+X3
          ZR     X6,PDB12    IF SYSTEM SECTOR NOT BOI
          ZR     X4,PDB4     IF SYSTEM SECTOR
          ZR     X3,PDB6     IF SYSTEM SECTOR PROCESSING COMPLETED
          SX7    X3-SSBFL
          ZR     X7,PDB5     IF BOI NOT SYSTEM SECTOR
          SB2    ERAB        * ARCHIVE FILE BLOCK ERROR ...*
          EQ     PDB27       ISSUE MESSAGE AND SUPPRESS FILE LOAD
 
 PDB4     IX7    X3-X1       DECREMENT REMAINING SYSTEM SECTOR LENGTH
          PL     X7,PDB5     IF SYSTEM SECTOR NOT TOO LONG
          SB2    ERAB        * ARCHIVE FILE BLOCK ERROR ...*
          EQ     PDB27       ISSUE MESSAGE AND SUPPRESS FILE LOAD
 
*         READ FILE DATA INTO BUFFER.
 
 PDB5     SA7    PDBC        SAVE REMAINING SYSTEM SECTOR LENGTH
 PDB6     ZR     X5,PDB8     IF NO WORDS TO READ
          SA4    PDBD        POINTER TO NEXT AVAILABLE WORD
          BX3    -X4
          SX3    X3+100B
          IX2    X5-X3
          PL     X2,PDB7     IF NOT ENOUGH SPACE
          IX6    X4+X5       NEW POINTER
          SA6    A4
          CWREAD TAPE,TDBF+X4,X5
          NZ     X7,PDB25    IF READ ERROR
          BX5    X5-X5       CLEAR WORD COUNT
          ZR     X0,PDB2     IF NO FILE MARK
          SX2    X0-4
          ZR     X2,PDB2     IF FIRST PART OF SPLIT SYSTEM SECTOR
          SX0    X0-1
          ZR     X0,PDB10    IF EOR
          SB2    ERAB        * ARCHIVE FILE BLOCK ERROR ...*
          EQ     PDB22       PROCESS ARCHIVE FILE ERROR
 
*         PROCESS BUFFER WITH NOT ENOUGH SPACE AVAILABLE.
 
 PDB7     SX6    B0+         RESET WORDS WRITTEN
          SA6    A4
          IX5    X5-X3       WORDS LEFT IN  MAIN BUFFER
          CWREAD TAPE,TDBF+X4,X3
          NZ     X7,PDB25    IF READ ERROR
          SX6    100B
          EQ     PDB14       PROCESS BLOCK
 
*         PROCESS FILE MARKS.
 
 PDB8     ZR     X0,PDB2     IF PLAIN DATA BLOCK
          SX2    X0-4
          ZR     X2,PDB2     IF SYSTEM SECTOR
          SX2    X0-1
          NZ     X2,PDB11    IF NOT EOR
 
*         PROCESS EOR WITH ZERO LENGTH PRU.
 
          SX6    B0+         SET PRU LENGTH TO ZERO
 PDB9     BX0    X0-X0       CLEAR DATA MARK
          EQ     PDB14       PROCESS DATA BLOCK
 
*         PROCESS EOR WITH SHORT PRU.
 
 PDB10    SA1    PDBD        SET PRU LENGTH
          BX6    X1
          BX7    X7-X7       CLEAR WORDS WRITTEN
          SA7    A1
          EQ     PDB14       PROCESS DATA BLOCK
 
*         PROCESS EOF.
 
 PDB11    SX6    DLEF        SET EOF INDICATOR
          LX6    54
          EQ     PDB9        CLEAR DATA MARK
 
*         PROCESS EOI.
 
 PDB12    NG     X3,PDB13    IF EOI
          SB2    ERAB        * ARCHIVE FILE BLOCK ERROR ...*
          EQ     PDB22       PROCESS MISSING EOI
 
 PDB13    SX0    3           SET EOI CONDITION
          SX6    DLEI        SET EOI INDICATOR
          LX6    54
 
*         PROCESS DATA BLOCK
 
 PDB14    SA1    LWRD        SET PRU LENGTH
          MX2    48
          BX2    -X2*X6
          SB7    X2+B1
          MX2    42
          LX2    54
          BX1    X2*X1
          BX6    X6+X1
          SX3    X0-4
          ZR     X3,PDB15    IF SYSTEM SECTOR
          SA1    PDBB        DECREMENT LENGTH
          SX2    B1
          IX7    X1-X2
          SX3    X0-3
          IX1    X7-X2
          PL     X1,PDB16    IF MORE LENGTH INDICATED BY CATALOG
          ZR     X3,PDB17    IF EOI
          EQ     PDB22       PROCESS FILE TOO LONG
 
*         PROCESS SYSTEM SECTOR.
 
 PDB15    SX1    DLSS        SET SYSTEM SECTOR INDICATOR
          LX1    54
          BX6    X6+X1
          BX0    X0-X0       CLEAR DATA MARK
          EQ     PDB18       WRITE SYSTEM SECTOR TO DATA FILE
 
*         WRITE SECTOR TO DATA FILE.
 
 PDB16    ZR     X3,PDB21    IF FILE TOO SHORT
 PDB17    SA7    A1          SAVE REMAINING LENGTH
 PDB18    SA6    LWRD        SAVE DATA LINKAGE WORD
          SB6    A6          SET BUFFER ADDRESS
 PDB19    SX2    DATA
          RJ     WPR         WRITE SECTOR TO DATA FILE
          NZ     B7,PDB20    IF WRITE ERROR
          SX1    X0-3
          NZ     X1,PDB6     IF NOT EOI
          SX6    B1+         SELECT FILE LOADING
          EQ     PDBX        RETURN
 
*         PROCESS DATA WRITE ERROR.
 
 PDB20    BX6    X0          SAVE ARCHIVE CONTROL WORD PARAMETERS
          LX7    X5
          SA6    PDBA
          SA7    A6+B1
          RJ     DWE         PROCESS DATA WRITE ERROR
          SA1    PDBA        RESTORE ARCHIVE CONTROL WORD PARAMETERS
          SA2    A1+B1
          BX0    X1
          LX5    X2
          SA1    LWRD        RESTORE SECTOR WORD COUNT
          MX2    -12
          BX3    -X2*X1
          SB6    A1          RESTORE BUFFER ADDRESS
          SA1    BFCA        CHECK IF ERROR ON CURRENT FILE
          SA2    CATS+2
          SB7    X3+B1
          BX7    X1-X2
          NZ     X7,PDB19    IF ERROR NOT ON CURRENT FILE
          SA1    PDBB        LENGTH NOT WRITTEN TO BUFFER
          SA3    X2+FCLF     ADJUST CATALOG LENGTH
          LX1    36
          IX7    X3-X1
          SX6    B1          SELECT FILE LOADING
          SA7    A3
          SA6    SKER        SET SKIP TO EOR FLAG
          EQ     PDBX        RETURN
 
*         PROCESS FILE TOO SHORT.
 
 PDB21    SA1    TCBF+FCUI
          SB2    ERFT        * FILE TRUNCATED ...*
          RJ     SFE         SEND ERROR MESSAGE
          EQ     PDB24       PROCESS TRUNCATED FILE
 
*         PROCESS ERRORS.
 
 PDB22    SA1    TCBF+FCUI
          RJ     SFE         SEND ERROR MESSAGE
          SX6    B1+         SET SKIP TO EOR FLAG
          SA6    SKER
 PDB24    SA2    PDBB        UPDATE LENGTH IN CATALOG
          SX1    B1
          IX7    X2-X1       ALLOW FOR EOI SECTOR
          ZR     X7,PDB13    IF NO CATALOG CHANGE
          MX6    0
          SA6    A2
          RECALL DATA        WAIT FOR *PFU* COMPLETION
          SA1    CATS+2      SET NEW LENGTH IN CATALOG
          SA2    X1+FCLF
          LX2    24
          IX6    X2-X7       NEW FILE LENGTH
          LX6    36
          SA6    A2
          EQ     PDB13       FORCE EOI
 
*         PROCESS READ ERROR.
 
 PDB25    SB2    ERAR        * ARCHIVE FILE READ ERROR ...*
          EQ     PDB22       PROCESS ERROR
 
*         PROCESS ERROR CONTROL WORD.
 
 PDB26    SX6    FEDT        SET DATA ERROR IN CATALOG
          RJ     SCE
          SA1    CWBF        CLEAR CONTROL WORD ERROR FLAGS
          MX7    -15
          BX6    -X7*X1
          LX1    -15         GET ERROR TYPE
          MX7    -3
          BX2    -X7*X1
          SA6    A1
          ZR     X2,PDB21    IF TRUNCATED FILE ERROR
          SA1    CPAR+/COMSPFS/CPEO
          NZ     X1,PDB27    IF BAD FILE PROCESSING SUPPRESSED
          SX7    X2-2
          NZ     X7,PDB3     IF NOT SUPPRESSED FILE CONTROL WORD
          SB2    EREO        * FILE LOAD SUPPRESSED BY ERROR ...*
 
*         ISSUE ERROR MESSAGE AND SUPRESS FILE LOAD.
 
 PDB27    SA1    TCBF        SET FILE NAME AND USER INDEX
          RJ     SFE         SEND ERROR MESSAGE
          RJ     CFE         COUNT FILE NOT LOADED
          RJ     DIF         DELETE INCOMPLETE FILE
          SX7    B1          SET SKIP TO EOR FLAG
          BX6    X6-X6       CLEAR LOAD FLAG
          SA7    SKER
          EQ     PDBX        RETURN
 
 
 PDBA     BSSZ   2           ARCHIVE CONTROL WORD PARAMETERS
 PDBB     CON    0           LENGTH ACCUMULATOR
 PDBC     CON    0           REMAINING SYSTEM SECTOR LENGTH
 PDBD     CON    0           WORDS WRITTEN
 PDBE     VFD    42/7HERROR**,18/0
 PFD      SPACE  4,25
**        PFD - PROCESS FULL DEVICE.
*
*         ENTRY  (X2) = FET ADDRESS OF FILE WITH ERROR.
*                (X6) = ERROR CODE.
*                ((X2)+FTPM) = FST ENTRY AT TIME OF ERROR.
*                (ANCE) = ADDRESS OF NEW CATALOG ENTRIES.
*                (*CATS* IN POINTER) = ADDRESS OF FIRST CATALOG SECTOR
*                                      NOT LOADED.
*
*         EXIT   DATA AND PERMITS FOR UNWRITTEN CATALOG ENTRIES PURGED.
*                ERROR MESSAGE ISSUED.
*                UTILITY INTERLOCK CLEARED.
*
*         USES   X - ALL.
*                A - 0, 1, 2, 5, 6, 7.
*                B - 5, 6, 7.
*
*         CALLS  CIN, COD, DUP, FUB, SEM, SFD, SSC, WPR.
*
*         MACROS RECALL.
 
 
 PFD      SUBR               ENTRY/EXIT
 
*         ISSUE ERROR MESSAGE.
 
          SB5    ERTL        * TRACK LIMIT ...*
          SX1    X6-FETL
          ZR     X1,PFD1     IF TRACK LIMIT ERROR
          SB5    ERID        * ERROR IDLE DETECTED ...*
 PFD1     SA1    X2+FTPM
          MX6    -9
          LX1    -48
          BX1    -X6*X1      EST ORDINAL OF DEVICE WITH ERROR
          RJ     COD         CONVERT EST ORDINAL
          BX1    X4
          SB2    1R+
          RJ     SNM         SET EST ORDINAL IN MESSAGE
          SB2    B5          SET MESSAGE ADDRESS
          RJ     SEM         SEND ERROR MESSAGE
 
*         PURGE DATA AND PERMITS FOR UNWRITTEN CATALOG ENTRIES.
 
          RECALL DATA
          RECALL PETS
          SA1    PETS+FTSC   SAVE OLD SECTOR COUNTER
          SX0    X1+
          RJ     SSC         SET BUFFER SECTOR COUNT
          SA1    PETS+FTSC   ADJUST SECTOR COUNTER
          IX6    X0-X1
          SA6    A1
          SA1    PETS+FTFT   REWIND PERMIT BUFFER
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
          BX4    X4-X4       CLEAR IAPF PROCESSED FLAG
          SA0    B0          CLEAR PERMITS PROCESSED FLAG
          SB5    B0          CLEAR BLOCK WORD COUNT
          SA5    CATS+FTOT   GET FWA OF CATALOG ENTRIES
          SA2    IPFF
          SA1    A5-B1       GET LWA+1 OF CATALOG ENTRIES
          SX5    X5-NWCE
          BX0    X1
          ZR     X2,PFD4     IF NO INCOMPLETE FILE
          SX0    X0+NWCE     INCLUDE INCOMPLETE FILE
 PFD4     SX5    X5+NWCE     ADVANCE TO NEXT CATALOG ENTRY
          GT     B5,PFD5     IF NOT END OF CATALOG BLOCK
          SB5    100B        SET FULL BLOCK WORD COUNT
          SX5    X5+1        SKIP CONTROL WORD
 PFD5     IX6    X5-X0
          SB5    B5-NWCE     DECREMENT BLOCK WORD COUNT
          MX3    -12
          PL     X6,PFD10    IF NO MORE CATALOG ENTRIES
          SA2    ANCE
          SA1    X5+FCUI
          IX7    X5-X2
          SX6    X1
          NG     X7,PFD4     IF AN OLD CATALOG ENTRY
          SX7    X1-IFUI
          ZR     X6,PFD7     IF A HOLE
          ZR     X7,PFD7     IF WRITE ERROR ON FILE
          SA1    X5+FCBT+FCBS*  GET FIRST TRACK AND SECTOR OF FILE
          BX6    -X3*X1
          LX3    12
          BX7    X3*X1       CLEAR FIRST TRACK OF FILE
          BX3    -X3*X1
          LX1    59-11
          SA7    A1
          ZR     X3,PFD7     IF NO FIRST TRACK
          NG     X1,PFD8     IF DIRECT ACCESS FILE
          NZ     X4,PFD7     IF IAPF FILE ALREADY PROCESSED
          SX4    B1+         SET IAPF FILE PROCESSED FLAG
 PFD6     BX6    X3+X6       PUT PARAMETERS IN FET
          MX3    42
          SA6    DATA+FTPM
          SA1    DATA        PUT POSITION REQUEST IN FET
          BX7    X3*X1
          SA7    A1
          RECALL A1          WAIT FOR POSITIONING TO COMPLETE
 PFD7     SA1    X5+FCRI     GET PERMIT RANDOM INDEX
          MX3    -24
          LX1    -36
          BX6    -X3*X1
          ZR     X6,PFD4     IF NO PERMITS
          SB7    A0
          NZ     B7,PFD4     IF PERMITS ALREADY PROCESSED
          SA0    B1          SET PERMITS PROCESSED FLAG
          MX3    42
          SA6    PETS+FTPM   PUT RANDOM INDEX PARAMETER IN FET
          SA1    PETS        SET POSITION REQUEST IN FET
          BX7    X3*X1
          SB6    LWRD        SET BUFFER ADDRESS
          SX6    B1+B1       SET EOI CONTROL WORD
          SA7    A1
          LX6    54
          SB7    B1          SET BUFFER WORD COUNT
          SA6    B6
          SX2    A1          SET PERMITS FET ADDRESS
          RJ     WPR         WRITE EOI SECTOR
          RJ     FUB         FLUSH PERMIT BUFFER
          EQ     PFD4        PROCESS NEXT CATALOG ENTRY
 
*         PROCESS DIRECT ACCESS FILE.
 
 PFD8     SA1    X5+FCDN     GET DEVICE NUMBER FROM CATALOG
          MX6    -6
          LX1    -36
          BX2    -X6*X1
          RJ     SFD         SEARCH FOR DEVICE
          LX1    -6          SET EST ORDINAL
          MX7    -9
          BX7    -X7*X1      EXTRACT EST ORDINAL
          SX6    X7+4000B    SET *DROP TRACKS* FLAG
          EQ     PFD6        DROP TRACK CHAIN
 
*         DROP UTILITY PROCESSOR AND UTILITY INTERLOCK.
 
 PFD10    BX6    X6-X6       CLEAR *CATALOG ENTRIES WRITTEN*
          SA6    CEWF
          RJ     DUP         DROP UTILITY PROCESSOR
          RJ     CIN         CLEAR UTILITY INTERLOCK
          EQ     PFDX        RETURN
 PGF      SPACE  4,25
**        PGF - PURGE FILE ON REPLACE OPTION.
*
*         ENTRY  (X6) .NE. 0 IF SPACE AVAILABLE FOR FILE.
*                (X6) = 0 IF NO SPACE FOR DIRECT ACCESS FILE.
*                (X7) = REQUIRED DEVICE NUMBER IF .NE. 0 AND NO SPACE
*                       FOR DIRECT ACCESS FILE.
*                (X7) = 0 IF LOAD LEVELING USED IN DEVICE SELECTION AND
*                       NO SPACE FOR DIRECT ACCESS FILE.
*
*         EXIT   (B2) = 0 IF FILE PURGE ATTEMPTED.
*                (B2) = * NO SPACE FOR FILE* MESSAGE ADDRESS IF FILE
*                       PURGE NOT ATTEMPTED.
*                UTILITY INTERLOCK SET AND *PFU* ACTIVE.
*
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 2.
*
*         CALLS  AUP, CAL, CIN, DUP, RAS, SFD, SIN.
*
*         MACROS CATLIST, PURGE, SETPFP.
 
 
*         REACTIVATE *PFU* AND RETURN NO SPACE FOR FILE ERROR.
 
 PGF5     RJ     SIN         SET UTILITY INTERLOCK
          RJ     AUP         ACTIVATE *PFU*
          SB2    ERNS        * NO SPACE FOR FILE ...*
 
 PGF      SUBR               ENTRY/EXIT
 
*         SAVE ENTRY CONDITIONS AND DROP *PFU*.
 
          SA6    PGFB        SAVE NO SPACE STATUS
          SA7    A6+1        SAVE DEVICE POINTER
          RJ     DUP         DROP UTILITY PROCESSOR
          RJ     CIN         CLEAR UTILITY INTERLOCK
 
*         SET FILE NAME AND USER INDEX FOR *PFM*.
 
          SA1    TCBF+FCFN   GET FILE NAME AND USER INDEX
          SA2    PGFA        GET CURRENT USER INDEX
          MX7    -18
          BX6    -X7*X1      USER INDEX
          BX7    X7*X1       FILE NAME
          IX2    X2-X6
          SA7    P+CFPN      SET FILE NAME IN FET
          ZR     X2,PGF1     IF SAME USER INDEX
          SA6    PGFA        UPDATE CURRENT USER INDEX
          SA6    SPAR+2      SET USER INDEX IN *CPM* CALL
          SX6    UIPR        SET USER INDEX FLAG
          SA6    SPAR
          SETPFP SPAR        SET USER INDEX
 
*         DETERMINE IF PURGE WILL CREATE SUFFICIENT SPACE FOR FILE.
 
 PGF1     SA1    PGFB
          NZ     X1,PGF4     IF SPACE FOR FILE AVAILABLE
          SX6    PFMB        SET IN = OUT = FIRST
          SA6    P+2
          SA6    P+3
          CATLIST  P         GET DEVICE NUMBER AND FILE LENGTH
          SA1    P
          MX6    -8
          AX1    10
          BX1    -X6*X1
          NZ     X1,PGF5     IF ERROR ON CATLIST CALL
          SA2    PFMB+FCDN   GET DEVICE NUMBER
          SA3    PFMB+FCBS+FCLF*0  GET FIRST SECTOR AND LENGTH
          MX6    -6
          LX2    -36
          LX3    59-11
          BX2    -X6*X2
          PL     X3,PGF5     IF INDIRECT ACCESS FILE
          RJ     SFD         SEARCH FOR DEVICE
          ZR     X1,PGF5     IF DEVICE NOT FOUND
          SA2    PGFB+1
          SA5    A1+1        GET DEVICE PARAMETERS
          ZR     X2,PGF2     IF LOAD LEVELING USED TO SELECT DEVICE
          SB2    X2
          SB2    A1-B2
          ZR     B2,PGF3     IF SAME DEVICE
          EQ     PGF5        SET NO SPACE FOR FILE
 
 PGF2     RJ     CAL         CHECK ACCESS LEVELS
          NG     X6,PGF5     IF ACCESS LEVEL ERROR
 PGF3     MX6    -24
          MX7    -12
          LX3    -24
          LX5    -36
          BX3    -X6*X3      FILE LENGTH
          SX6    B1+B1
          BX1    -X7*X5      DEVICE SECTOR LIMIT
          IX3    X3+X6       INCLUDE SYSTEM SECTOR AND EOI IN LENGTH
          SX6    X1-1
          BX7    X1
          IX3    X3+X6
          LX5    36          RESTORE DEVICE PARAMETERS
          IX3    X3/X7
          IX3    X3*X1       SPACE OCCUPIED BY FILE
          RJ     RAS         CHECK SPACE ON DEVICE WITH FILE PURGE
          ZR     X1,PGF5     IF NO SPACE AVAILABLE
 
*         REQUIRE FILE NOT BUSY TO AVOID PURGING OLD FILE WITHOUT
*         CREATING SPACE FOR FILE TO BE LOADED.
 
          SA1    P+CFPN
          SX6    SRNB        SET NOT BUSY REQUIRED
          LX6    12
          BX6    X1+X6
          SA6    A1+
 
*         PURGE FILE AND REACTIVATE *PFU*.  ERROR STATUS IS NOT CHECKED
*         SINCE A PURGE FAILURE WILL BE DETECTED BY THE FILE NAME
*         REAPPEARING IN THE FILE LIST WHEN *PFU* IS REACTIVATED.
 
 PGF4     PURGE  P           PURGE FILE
          RJ     SIN         SET UTILITY INTERLOCK
          RJ     AUP         ACTIVATE *PFU*
          SB2    B0          SET NO ERROR
          EQ     PGFX        RETURN
 
 
 PGFA     CON    0           CURRENT USER INDEX
 PGFB     CON    0           NO SPACE FOR FILE STATUS
          CON    0           REQUIRED DEVICE POINTER
 PPB      SPACE  4,30
**        PPB - PROCESS PERMIT BLOCK.
*
*         ENTRY  (CWBF) = PERMIT CONTROL WORD.
*                (RICT) = CURRENT PERMIT RANDOM INDEX.
*                (*CATS* IN POINTER) = ADDRESS OF CATALOG ENTRY.
*
*         EXIT   (X6) = 0 IF FILE NOT TO BE LOADED.
*                (X6) = 1 IF FILE TO BE LOADED.
*                (RICT) = UPDATED PERMIT RANDOM INDEX.
*                (SKER) = 1 IF *SKIP TO EOR* REQUIRED.
*                CATALOG ENTRY UPDATED WITH RANDOM INDEX OF FIRST
*                PERMIT SECTOR.
*                PERMIT SECTORS WRITTEN TO *PETS* FILE.
*                ARCHIVE FILE POSITIONED AT EOR IF FILE NOT TO BE
*                  LOADED, OTHERWISE AT FIRST WORD FOLLOWING PERMITS.
*
*                IF A PERMIT WRITE ERROR, TRACK LIMIT ERROR OR ERROR
*                IDLE CONDITION IS DETECTED, CLEANUP IS PERFORMED AND
*                EXIT IS TO *ABT*.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 2, 3, 6, 7.
*
*         CALLS  CFE, PWE, RCW, SCE, SFE, WPR.
*
*         MACROS CWREAD.
 
 
 PPB      SUBR               ENTRY/EXIT
          SA3    CATS+2      PUT FIRST RANDOM INDEX IN CATALOG
          SA1    X3+FCRI
          SA2    RICT
          MX3    -36
          BX7    -X3*X1
          LX2    36
          BX6    X2+X7
          SA6    A1
          BX5    X5-X5       CLEAR SECTOR BUFFER WORD COUNT
 PPB1     SA1    CWBF        SET WORD COUNT OF CONTROL WORD
          MX2    -9
          BX0    -X2*X1
 
*         FILL PERMIT SECTOR BUFFER.
 
 PPB2     SX1    100B
          IX3    X1-X5       REMAINING WORD COUNT OF SECTOR BUFFER
          IX2    X0-X3
          PL     X2,PPB3     IF CONTROL WORD WILL FILL SECTOR BUFFER
          BX3    X0          SET TO READ REMAINDER OF CONTROL WORD
 PPB3     ZR     X3,PPB4     IF NO WORDS TO READ
          SB6    TDBF+X5     SET SECTOR BUFFER ADDRESS
          IX0    X0-X3       REMAINING WORD COUNT FOR CONTROL WORD
          IX5    X5+X3       SECTOR BUFFER WORD COUNT
          CWREAD TAPE,B6,X3
          NZ     X7,PPB5     IF READ ERROR
          ZR     X1,PPB2     IF CONTROL WORD BLOCK COMPLETE
          SB2    ERAB        * ARCHIVE BLOCK ERROR ...*
          EQ     PPB6        PROCESS INCOMPLETE PERMIT BLOCK
 
*         PROCESS END OF CONTROL WORD.
 
 PPB4     NZ     X0,PPB10    IF NOT END OF CONTROL WORD
          SA1    CWBF        GET EOR FLAG
          MX2    -3
          LX1    -9
          BX3    -X2*X1      SET LAST SECTOR FLAG
          LX1    -6
          BX6    -X2*X1
          SB3    X3
          NZ     X6,PPB8     IF ERROR CONTROL WORD
          EQ     B3,B1,PPB9  IF EOR FLAG SET IN CONTROL WORD
          RJ     RCW         READ NEXT CONTROL WORD
          SX2    X3-2
          ZR     X2,PPB1     IF A PERMIT CONTROL WORD
 
*         PROCESS ARCHIVE FILE ERROR.
 
 PPB5     SA7    AREF        INDICATE READ ERROR
          SB2    ERAR        * ARCHIVE FILE READ ERROR ...*
 PPB6     SA1    CATS+FTIN
          SA1    X1+FCUI
          RJ     SFE         SEND ERROR MESSAGE
          RJ     CFE         COUNT FILE NOT LOADED
          SX7    B1          SET SKIP TO EOR FLAG
          BX6    X6-X6       SELECT NO FILE LOAD
          SA7    SKER
          EQ     PPBX        RETURN
 
*         PROCESS EMPTY PERMIT SECTOR.
 
 PPB8     SX6    FEPM        SET PERMIT ERROR IN CATALOG
          RJ     SCE
 PPB9     NZ     X5,PPB10    IF NOT EMPTY SECTOR
          SA3    CATS+2      CLEAR PERMIT RANDOM INDEX FROM CATALOG
          SA1    X3+FCRI
          MX2    -36
          BX7    -X2*X1
          SX6    B1          SELECT FILE LOAD
          SA7    A1
          EQ     PPBX        RETURN
 
*         WRITE PERMIT SECTOR TO PERMIT FILE.
 
 PPB10    SA1    RICT        ADVANCE RANDOM INDEX
          SA2    CATS+2      GET CATALOG ADDRESS
          SX6    B1
          IX7    X1+X6
          SB7    X5+B1       SET SECTOR WORD COUNT
          SA7    A1
          SA1    X2+FCUI     GET USER INDEX FROM CATALOG
          LX2    36          BUILD SECTOR CONTROL WORD
          BX6    X2+X5
          LX7    36
          MX2    -18
          SA6    LWRD
          BX1    -X2*X1
          ZR     X3,PPB11    IF NOT LAST SECTOR
          BX7    X7-X7       CLEAR PERMIT LINKAGE RANDOM INDEX
 PPB11    LX1    12          GET PERMIT LINKAGE WORD
          BX6    X7+X1
          SB6    LWRD        SET WORKING BUFFER ADDRESS
          BX5    X3          SAVE LAST SECTOR FLAG
          SX2    PETS        SET FET ADDRESS
          SA6    B6+B1
          RJ     WPR         WRITE PERMIT SECTOR
          NZ     B7,PPB12    IF PERMIT WRITE ERROR
          ZR     X5,PPB2     IF NOT LAST SECTOR
          SX6    B1          SELECT FILE LOAD
          EQ     PPBX        RETURN
 
*         PROCESS PERMIT WRITE ERROR.
 
 PPB12    RJ     PWE         PROCESS PERMIT WRITE ERROR
          SB2    B0          SET NO MESSAGE
          EQ     ABT         ABORT LOAD
 PWE      SPACE  4,35
**        PWE - PERMIT WRITE ERROR PROCESSOR.
*
*         ENTRY  (X6) = FET ERROR CODE.
*                (CPAR+COMSPFS/CPDN) = MASTER DEVICE NUMBER.
*                (PETS+FTPM) = BAD TRACK AND SECTOR ADDRESS.
*                (*PETS* OUT POINTER) = ADDRESS OF CONTROL WORD FOR
*                                       BAD SECTOR.
*
*         EXIT   *PFU* DROPPED.
*
*                IF A WRITE ERROR -
*                ERROR IDLE STATUS SET FOR MASTER EQUIPMENT IF DATA
*                ON THE PERMITS FILE HAS BEEN CORRUPTED.
*                UTILITY INTERLOCK CLEARED.
*                PERMIT WRITE ERROR MESSAGES ISSUED.
*
*                IF A TRACK LIMIT OR ERROR IDLE -
*                DATA AND PERMITS FOR UNWRITTEN CATALOG ENTRIES ARE
*                PURGED.
*                UTILITY PROCESSOR IS DROPPED.
*                UTILITY INTERLOCK IS CLEARED.
*                TRACK LIMIT OR ERROR IDLE MESSAGES ARE ISSUED.
*                MESSAGE IDENTIFYING FIRST FILE NOT LOADED IS
*                ISSUED.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 2.
*
*         CALLS  CIN, DUP, PFD, SEI, SFE.
 
 
*         PROCESS TRACK LIMIT/ERROR IDLE CONDITION.
 
 PWE3     SX2    PETS
          RJ     PFD         PROCESS FULL DEVICE
 
 PWE      SUBR               ENTRY/EXIT
          SX1    X6-FEWE
          ZR     X1,PWE1     IF WRITE ERROR WITH DATA TRANSFERRED
          SX1    X6-FEWN     CHECK WRITE ERROR WITH NO DATA TRANSFERRED
          NZ     X1,PWE3     IF NOT WRITE ERROR
 
*         PROCESS WRITE ERROR.
 
 PWE1     SA6    PWEA        SAVE ERROR CODE
          BX6    X6-X6       CLEAR *CATALOG ENTRIES WRITTEN*
          SA6    CEWF
          RJ     DUP         DROP UTILITY PROCESSOR
          SA1    PWEA        ERROR CODE
          SX1    X1-FEWE
          NZ     X1,PWE2     IF DATA NOT TRANSFERRED TO DEVICE
          SB2    ELWP        * ERROR IDLE SET - PF PERMITS WRITE ...*
          RJ     SEI         SET ERROR IDLE STATUS
 PWE2     RJ     CIN         CLEAR UTILITY INTERLOCK
 
*         IDENTIFY AFFECTED FILE.
 
          SA2    PETS+3      GET BAD SECTOR CONTROL WORD
          SA1    X2
          LX1    -36         SET FILE NAME OF BAD FILE
          SA1    X1+FCFN+FCUI*
          SB2    ERPW        * PERMIT WRITE ERROR ...*
          RJ     SFE         SEND ERROR MESSAGE
          EQ     PWEX        RETURN
 
 
 PWEA     BSS    1           FET ERROR CODE
 RAS      SPACE  4,25
**        RAS - RETURN AVAILABLE SPACE.
*
*         ENTRY  (X5) = SECOND WORD OF *MSTT* ENTRY.
*                (A5) = ADDRESS OF SECOND WORD OF *MSTT* ENTRY.
*                (X3) = INCREMENT TO ADD TO AVAILABLE SPACE.
*                CATALOG ENTRY IN *TCBF*.
*
*         EXIT   (X1) = 2/0, 3/ST, 31/0, 24/SC  IF SUFFICIENT SPACE FOR
*                       FILE ON DEVICE AND DEVICE IS ACCESSIBLE.
*                         ST = 7 IF DEVICE *ON* AND NOT SUSPECT.
*                            = 6 IF DEVICE *ON* AND SUSPECT.
*                            = 5 IF DEVICE *IDLE* AND NOT SUSPECT.
*                            = 4 IF DEVICE *IDLE* AND SUSPECT.
*                            = 2 IF DEVICE *OFF*.
*                         SC = AVAILABLE SECTOR COUNT ON DEVICE.
*                (X1) = 0 IF INSUFFICIENT SPACE FOR FILE ON DEVICE OR
*                       DEVICE STATE IS *DOWN*.
*                (A5) = ADDRESS OF SECOND WORD OF *MSTT* ENTRY.
*
*         USES   X - 1, 2, 5, 6, 7.
*                A - 1, 2, 6, 7.
*
*         MACROS SYSTEM.
 
 
 RAS1     SX1    B0+         SET DEVICE NOT AVAILABLE FOR FILE
 
 RAS      SUBR               ENTRY/EXIT
          LX5    12
          MX6    -12
          SX1    DALL+1      WORD COUNT FOR READ
          BX6    -X6*X5      MST ADDRESS / 10B
          LX1    36
          LX6    3+18
          BX6    X6+X1       MERGE WORD COUNT
          SX2    RASB        BUFFER ADDRESS
          BX6    X6+X2       MERGE BUFFER ADDRESS
          MX7    1           SET CMR READ
          SA6    RASA        SET STATUS WORD
          SA7    RASB        SET BUFFER CONTROL WORD
          SYSTEM RSB,R,A6    READ MST DATA
          SA1    RASB+TDGL
          SA2    RASB+DALL
          MX7    -12
          MX6    3
          LX6    -2
          BX1    -X7*X1      TRACKS AVAILABLE
          BX2    X6*X2       DEVICE STATE AND SUSPECT STATUS
          LX5    12
          IX6    X6-X2       DEVICE STATUS FACTOR
          AX2    56
          BX7    -X7*X5      SECTOR LIMIT
          SX2    X2-DWES
          IX1    X1*X7       SECTORS AVAILABLE ON DEVICE
          ZR     X2,RAS1     IF DEVICE STATE IS *DOWN*
          SA2    TCBF+FCLF
          IX1    X1+X3       ADD INCREMENT TO AVAILABLE SPACE
          MX7    -24
          LX2    24
          BX2    -X7*X2      LENGTH OF FILE
          SX7    B1+B1
          IX2    X1-X2
          IX2    X2-X7       SUBTRACT SYSTEM SECTOR AND EOI
          IX1    X1+X6       MERGE SECTORS AVAILABLE AND STATUS FACTOR
          NG     X2,RAS1     IF INSUFFICIENT SPACE FOR FILE
          EQ     RASX        RETURN
 
 
 RASA     VFD    12/0,12/DALL+1,18/0,18/RASB  *RSB* STATUS WORD
 RASB     BSSZ   DALL+1      MST DATA BUFFER
          ERRNG  DALL-TDGL   CODE DEPENDS ON WORD ORDER
 RCT      SPACE  4,45
**        RCT - READ CATALOG TRACK.
*
*         *RCT* POSITIONS THE CATALOG FILE TO THE CURRENT CATALOG
*         TRACK, READS THE TRACK AND BUILDS A LIST OF FILES THAT ARE
*         CONTAINED ON THE TRACK.  THE CATALOG FILE FET AND BUFFER ARE
*         LEFT IN A STATE READY TO WRITE ADDITIONAL CATALOG ENTRIES.
*
*         ENTRY  (CATS+FTCA) = PARAMETERS DEFINING CURRENT CATALOG
*                              TRACK.
*                UTILITY PROCESSOR ACTIVE.
*                UTILITY INTERLOCK SET.
*
*         EXIT   (FLOF) = 0 IF NO FILE LIST OVERFLOW.
*                       = 1 IF FILE LIST OVERFLOWED TO MASS STORAGE.
*                (FLPT) = LWA+1 OF MEMORY RESIDENT PORTION OF FILE
*                         LIST.
*                (FLBF) = MEMORY RESIDENT PORTION OF FILE LIST.
*                (CSWC) = WORD COUNT OF CATALOG SECTOR REMAINING IN
*                         CIRCULAR BUFFER.
*                (CEWF) = 0.
*                (CATS+FTSC) = 0.
*                (ANCE) = FIRST ADDRESS AVAILABLE FOR NEW CATALOG
*                         ENTRIES.
*                (CBFO) = BUFFER ORDINAL FOR NEW CATALOG ENTRIES.
*                CIRCULAR BUFFER (STARTING AT FIRST) CONTAINS A *FULL
*                SECTOR* CONTROL WORD WITH POSITIONING PARAMETERS
*                NECESSARY TO REWRITE THE LAST CATALOG SECTOR.  ANY
*                CATALOG ENTRIES FROM THE LAST SECTOR FOLLOW THE
*                CONTROL WORD.
*
*                IF A CATALOG READ ERROR IS DETECTED, THE UTILITY
*                PROCESSOR IS DROPPED, ERROR IDLE STATUS IS SET ON THE
*                MASTER EQUIPMENT, THE UTILITY INTERLOCK IS CLEARED,
*                CATALOG READ ERROR MESSAGES ARE ISSUED AND EXIT IS TO
*                *ABT*.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 0, 1, 2, 3, 6, 7.
*                B - 7.
*
*         CALLS  BFL, PCE.
*
*         MACROS RECALL, REWIND.
 
 
 RCT      SUBR               ENTRY/EXIT
 
*         POSITION CATALOG FILE.
 
          SA1    CATS        POSITION CATALOG FILE
          MX2    42
          BX6    X2*X1
          SA6    A1
          BX7    X7-X7       CLEAR FILE LIST OVERFLOW
          SA7    FLOF
          SX6    FLBF        SET FILE LIST BUFFER EMPTY
          SA6    FLPT
          SA7    CEWF        CLEAR *CATALOG ENTRIES WRITTEN*
          RECALL A1+         WAIT FOR POSITION COMPLETE
          REWIND FO,R        REWIND OVERFLOW SCRATCH FILE
 
*         READ CATALOG TRACK.
 
 RCT1     SA1    CATS+1      REWIND CATALOG BUFFER
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
          SA0    X1          SAVE BUFFER FIRST POINTER
          SA1    A1-B1       ISSUE READ REQUEST
          MX2    42
          BX1    X2*X1
          SX7    4           SET READ FUNCTION CODE
          BX6    X1+X7
          SA6    A1
          RECALL A1          WAIT FOR READ TO COMPLETE
 RCT2     SA1    CATS+2      CHECK FOR MORE DATA IN BUFFER
          SX2    A0
          IX6    X2-X1
          PL     X6,RCT1     IF NO DATA IN BUFFER
          SA1    A0          GET SECTOR CONTROL WORD
          MX2    -12         EXTRACT WORD COUNT
          BX6    -X2*X1
          LX2    12          EXTRACT EOF/EOI FLAG
          BX7    -X2*X1
          LX1    59-49
          NZ     X7,RCT3     IF NOT EOF/EOI
          SX6    B0+         CLEAR SECTOR WORD COUNT
 RCT3     SA6    CSWC        SAVE SECTOR WORD COUNT
          NG     X1,RCT5     IF MASS STORAGE ERROR
          BX0    X6
          SA0    A0+B1
          RJ     BFL         BUILD FILE LIST
          SA1    CSWC        CHECK FOR SHORT SECTOR
          SX6    X1-100B
          ZR     X6,RCT2     IF NOT SHORT SECTOR
 
*         MOVE LAST SECTOR TO START OF BUFFER.
 
          SA2    CATS+1      DESTINATION ADDRESS = FIRST
          SX6    A0-B1       SET ADDRESS OF LAST SECTOR
          IX7    X6-X1
          SA3    X7          SET FULL SECTOR WORD COUNT IN CONTROL WORD
          MX7    48
          SX6    100B
          BX3    X7*X3
          BX7    X3+X6
 RCT4     SA7    X2          STORE ONE WORD OF SECTOR
          SX2    X2+B1
          SA3    A3+B1
          BX7    X3
          SX1    X1-1
          PL     X1,RCT4     IF NOT END OF SECTOR
          BX6    X2          SET IN POINTER
          SA6    A2+B1
          SA6    ANCE        SET ADDRESS OF NEW CATALOG ENTRIES
          SA1    CSWC
          SX2    NWCE
          IX6    X1/X2       NUMBER OF CATALOG ENTRIES IN SECTOR
          SA6    CBFO        SET NEXT CATALOG ORDINAL
          EQ     RCTX        RETURN
 
*         PROCESS CATALOG READ ERROR.
 
 RCT5     SX7    A0          OUT = ADDRESS OF CONTROL WORD
          SA7    CATS+3
          LX1    49-59       SET SECTOR WORD COUNT
          MX3    48
          BX1    X3*X1
          IX2    X7+X6       IN = LWA+1 OF SECTOR
          BX6    X1+X6
          SX7    X2+B1
          SA6    A0+
          SA7    A7-B1
          SX6    ERCR        * CATALOG READ ERROR*
          RJ     PCE         PROCESS CATALOG READ ERROR
          SB2    B0          SET NO ERROR
          EQ     ABT         ABORT
 RCW      SPACE  4,20
**        RCW - READ ARCHIVE FILE CONTROL WORD.
*
*         ENTRY  (RCWF) = 0 IF NEW CONTROL WORD TO BE READ.
*                       = NON-ZERO IF OLD CONTROL WORD IN *CWBF* TO
*                         BE USED.
*
*         EXIT   (X1) = READ STATUS FROM *CWREAD*.
*                (X3) = -1 IF EOR/EOF/EOI OR READ ERROR DETECTED.
*                     = CONTROL WORD CODE, OTHERWISE.
*                (X7) = READ ERROR STATUS FROM *CWREAD*.
*                (CWBF) = ARCHIVE FILE CONTROL WORD.
*                (RCWF) = 0.
*                *CWSW* CLEARED FOR ARCHIVE FILE IF EOR WAS DETECTED
*                WITHOUT READ ERROR.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2, 6, 7.
*
*         MACROS CWREAD.
 
 
*         PROCESS RE-USED CONTROL WORD.
 
 RCW3     SA2    CWBF        UNPACK CONTROL WORD CODE
          MX6    -3
          BX7    X7-X7       CLEAR ERROR STATUS
          LX2    -12
          BX1    X1-X1       CLEAR EOR/EOF/EOI STATUS
          SA7    A1          CLEAR CONTROL WORD RE-USE FLAG
          BX3    -X6*X2
 
 RCW      SUBR               ENTRY/EXIT
          SA1    RCWF
          NZ     X1,RCW3     IF CONTROL WORD RE-USE FLAG SET
 
*         PROCESS NEW CONTROL WORD.
 
          CWREAD TAPE,CWBF,B1  READ ARCHIVE FILE CONTROL WORD
          NZ     X7,RCW2     IF READ ERROR
          NZ     X1,RCW1     IF EOR/EOF/EOI
          SA2    B6-B1       UNPACK CONTROL WORD CODE
          MX6    -3
          LX2    -12
          BX3    -X6*X2
          EQ     RCWX        RETURN
 
*         PROCESS EOR/EOF/EOI.
 
 RCW1     SX3    -B1         SET EOR/EOF/EOI/READ ERROR STATUS
          NG     X1,RCWX     IF EOF/EOI
          BX6    X6-X6       CLEAR EOR
          SA6    TAPE+CWSW
          EQ     RCWX        RETURN
 
*         PROCESS READ ERROR.
 
 RCW2     SA7    AREF        INDICATE READ ERROR
          SX3    -B1         SET EOR/EOF/EOI/READ ERROR STATUS
          EQ     RCWX        RETURN
 RIP      SPACE  4,10
**        RIP - REPRIEVE INTERRUPT PROCESSOR.
*
*         EXIT   BUSY FETS SET COMPLETE TO ALLOW TERMINATION
*                  PROCESSING.
*
*         MACROS COMPFET.
 
 
 RIP      SUBR               ENTRY/EXIT
          COMPFET  (CATS,PETS,DATA,CIRF,TAPE,UIFT,FO,O,SU)
          EQ     RIPX        RETURN
 SCE      SPACE  4,15
**        SCE - SET CATALOG ERROR CODE.
*
*         ENTRY  (X6) = DATA ERROR OR PERMIT ERROR CODE.
*                (*CATS* IN POINTER) = ADDRESS OF CATALOG ENTRY.
*                (CBFO) = CATALOG BUFFER ORDINAL.
*
*         EXIT   CATALOG ERROR CODE SET IN CATALOG ENTRY AND IN FILE
*                  STATUS ENTRY.
*
*         USES   X - 1, 6, 7.
*                A - 1, 6, 7.
 
 
 SCE      SUBR               ENTRY/EXIT
          SA1    CATS+2
          SA1    X1+FCEC     GET CURRENT *PFC* ERROR CODE
          LX6    42
          BX7    X1+X6       MERGE NEW ERROR CODE
          LX6    -41
          SA7    A1
          SA1    CBFO        GET CATALOG BUFFER ORDINAL
          SA1    TFST+X1     GET FILE STATUS WORD
          BX7    X1+X6       MERGE ERROR CODE
          SA7    A1
          EQ     SCEX        RETURN
 SCI      SPACE  4,20
**        SCI - SKIP CATALOG IMAGE RECORD.
*
*         EXIT   (RCWF) = SET IF A CONTROL WORD OTHER THAN FOR A
*                         CATALOG IMAGE RECORD WAS FOUND BEFORE
*                         EOF/EOI.
*                ARCHIVE FILE POSITIONED FOR PROCESSING FIRST RECORD
*                THAT IS NOT A CATALOG IMAGE RECORD.  THIS MAY BE AT
*                EOF/EOI.
*
*         USES   X - 5, 6.
*                A - 6.
*
*         CALLS  RCW, SER.
 
 
 SCI4     SX6    B1+         SET CONTROL WORD RE-USE FLAG
          SA6    RCWF
 
 SCI      SUBR               ENTRY/EXIT
 SCI1     RJ     RCW         READ ARCHIVE FILE CONTROL WORD
          SX6    X3-5
          ZR     X6,SCI3     IF CATALOG IMAGE RECORD
          PL     X3,SCI4     IF CONTROL WORD AVAILABLE
          NZ     X7,SCI2     IF READ ERROR
          NG     X1,SCIX     IF EOF/EOI
          EQ     SCI1        CHECK NEXT RECORD
 
*         SKIP TO END OF RECORD.
 
 SCI2     SA7    AREF        INDICATE READ ERROR
 SCI3     RJ     SER         SKIP TO END OF RECORD
          EQ     SCI1        CHECK NEXT RECORD
 SEC      SPACE  4,15
**        SEC - SKIP THROUGH EOI CONTROL WORD.
*
*         ENTRY  (X2) = FET ADDRESS.
*
*         EXIT   (X2) = FET ADDRESS.
*                (A0) = SECTOR COUNT SKIPPED.
*                *CIO* EOR STATUS SET IN FET.
*                DATA READ FROM BUFFER UNTIL AN EOI SECTOR IS READ OR
*                UNTIL BUFFER IS EMPTY.
*
*         USES   X - 0, 5, 6.
*                A - 0, 5, 6.
*
*         MACROS READW, RECALL.
 
 
 SEC3     SX5    X5-2
          NZ     X5,SEC1     IF NOT EOI CONTROL WORD
 
 SEC      SUBR               ENTRY/EXIT
          RECALL X2          SET EOR STATUS IN FET
          SA5    X2
          MX6    42
          SX0    23B
          BX5    X6*X5
          BX6    X5+X0
          SA0    B0          CLEAR SECTOR COUNT
          SA6    A5
 SEC1     READW  X2,SECA,B1  READ CONTROL WORD
          NZ     X1,SECX     IF BUFFER EMPTY
          SA5    SECA        GET SECTOR WORD COUNT
          MX6    -12
          BX0    -X6*X5
          AX5    54          GET CONTROL WORD TYPE
          SA0    A0+B1       INCREMENT SECTOR COUNT
 SEC2     ZR     X0,SEC3     IF END OF SECTOR
          READW  X2,SECA,B1  READ ONE WORD OF SECTOR
          NZ     X1,SECX     IF BUFFER EMPTY
          SX0    X0-1
          EQ     SEC2        CHECK FOR END OF SECTOR
 
 
 SECA     CON    0           SCRATCH BUFFER
 SER      SPACE  4,10
**        SER - SKIP TO END OF RECORD.
*
*         EXIT   ARCHIVE FILE POSITIONED AT EOR/EOF/EOI.
*                *CWSW* CLEARED FOR ARCHIVE FILE IF NOT EOF/EOI.
*                (X1) .LT. 0 IF EOF/EOI.
*
*         USES   X - 2, 5, 6, 7.
*                A - 2, 6.
*
*         MACROS CWREAD.
 
 
 SER      SUBR               ENTRY/EXIT
 SER1     CWREAD TAPE,TDBF,TDBFL
          ZR     X7,SER2     IF NO READ ERROR
          SA7    AREF        INDICATE READ ERROR
          ZR     B7,SER1     IF TRANSFER COMPLETE
 SER2     ZR     X1,SER1     IF NOT EOR/EOF/EOI
          NG     X1,SERX     IF EOF/EOI
          SX6    B0+         CLEAR EOR
          SA6    TAPE+CWSW
          EQ     SERX        RETURN
 SFD      SPACE  4,15
**        SFD - SEARCH FOR DEVICE.
*
*         ENTRY  (X2) = DEVICE NUMBER TO SEARCH FOR IF .NE. 0.
*                (X2) = 0 IF SEARCH FOR MASTER DEVICE.
*                (CPAR+/COMSPFS/CPDN) = MASTER DEVICE NUMBER.
*
*         EXIT   (A1) = ADDRESS OF FIRST WORD OF DEVICE-S *MSTT* ENTRY.
*                (X1) = FIRST WORD OF DEVICE-S ENTRY.
*                (X1) = 0 IF DEVICE NOT FOUND IN TABLE.
*
*         USES   X - 0, 1, 2, 7.
*                A - 1, 2.
*                B - 7.
 
 
 SFD      SUBR               ENTRY/EXIT
          MX0    -6
          SB7    MSTT
          NZ     X2,SFD1     IF NOT MASTER DEVICE SEARCH
          SA2    CPAR+/COMSPFS/CPDN  GET MASTER DEVICE NUMBER
 SFD1     SA1    B7+         READ NEXT TABLE ENTRY
          ZR     X1,SFDX     IF END OF TABLE
          SB7    B7+2        ADVANCE TABLE ADDRESS
          BX7    -X0*X1
          IX7    X2-X7
          NZ     X7,SFD1     IF NOT MATCHING DEVICE
          EQ     SFDX        RETURN
 SFL      SPACE  4,15
**        SFL - SEARCH FILE LIST.
*
*         ENTRY  (TCBF) = CATALOG ENTRY FOR FILE.
*                (FLOF) = 0 IF NO FILE LIST OVERFLOW.
*                       = 1 IF FILE LIST OVERFLOWED TO MASS STORAGE.
*                (FLPT) = NEXT AVAILABLE LOCATION IN FILE LIST BUFFER.
*                (FLBF) = MEMORY RESIDENT PORTION OF FILE LIST.
*
*         EXIT   (X6) = 0 IF FILE IN LIST.
*                (X6) .NE. 0 IF FILE NOT IN LIST.
*
*         USES   X - 0, 1, 2, 3, 5, 6.
*                A - 1, 2, 3.
*
*         MACROS READ, READW, REWIND.
 
 
 SFL5     SX6    B1+         SET FILE NOT FOUND
 
 SFL      SUBR               ENTRY/EXIT
 
*         CHECK FOR PRIVATE AUXILIARY DEVICE.
 
          SA1    CPAR+/COMSPFS/CPPN
          SA2    CPAR+/COMSPFS/CPUN
          MX5    60          SET TO CHECK FILE NAME AND USER INDEX
          ZR     X1,SFL1     IF NOT AUXILIARY DEVICE
          ZR     X2,SFL1     IF NOT PRIVATE DEVICE
          MX5    42          SET TO CHECK FILE NAME ONLY
 
*         SEARCH MEMORY RESIDENT PORTION OF FILE LIST.
 
 SFL1     SA1    TCBF+FCFN+FCUI*0  GET FILE NAME AND USER INDEX
          SA2    FLPT        LWA+1 OF FILE LIST
          SX0    FLBF        FWA OF FILE LIST
 SFL2     IX6    X0-X2
          PL     X6,SFL3     IF NO MORE ENTRIES IN LIST
          SA3    X0          COMPARE FILE NAME AND USER INDEX
          BX6    X3-X1
          BX6    X5*X6
          SX0    X0+1        ADVANCE FILE LIST BUFFER ADDRESS
          ZR     X6,SFLX     IF MATCHING ENTRY
          EQ     SFL2        CHECK NEXT ENTRY
 
*         SEARCH SCRATCH FILE PORTION OF FILE LIST.
 
 SFL3     SA3    FLOF
          ZR     X3,SFL5     IF NO FILE LIST OVERFLOW
          REWIND FO          START SCRATCH FILE READ
          READ   FO
 SFL4     READW  FO,SFLA,1   GET NEXT FILE LIST ENTRY
          NZ     X1,SFL5     IF END OF SCRATCH FILE
          SA1    TCBF+FCFN+FCUI*  COMPARE FILE NAME AND USER INDEX
          SA2    SFLA
          BX6    X1-X2
          BX6    X5*X6
          ZR     X6,SFLX     IF MATCHING ENTRY
          EQ     SFL4        CHECK NEXT ENTRY
 
 
 SFLA     CON    0           FILE LIST ENTRY SCRATCH WORD
 SIN      SPACE  4,15
**        SIN - SET PF UTILITY INTERLOCK.
*
*         ENTRY  (UIFL) = UTILITY INTERLOCK FLAG.
*                (MAEQ) = EQUIPMENT TO SET INTERLOCK ON.
*
*         EXIT   (UIFL) = 1.
*                *PFU* CALLED TO SET UTILITY INTERLOCK IF NOT ALREADY
*                SET.
*
*         USES   X - 1, 2, 3, 6.
*                A - 1, 2, 3, 6.
*
*         MACROS CALLPFU, MESSAGE, MOVE.
 
 
 SIN      SUBR               ENTRY/EXIT
          SA1    UIFL
          NZ     X1,SINX     IF UTILITY INTERLOCK ALREADY SET
          SA2    MAEQ        SET MASTER DEVICE EST ORDINAL
          SX1    UIFL        SET INTERLOCK FLAG ADDRESS
          LX2    48
          BX6    X2+X1
          SA3    IDSA+/COMSPFS/ADM2  K DISPLAY MESSAGE ADDRESS
          SA6    UIFT+FTPM
          MOVE   3,MSGJ,X3   * SETTING UTILITY INTERLOCK.*
          MESSAGE  MSGJ,2,R
          CALLPFU  UIFT,CTSU,R  SET PF UTILITY INTERLOCK
          SA3    IDSA+/COMSPFS/ADM2  K DISPLAY MESSAGE ADDRESS
          MOVE   3,BLNK,X3   CLEAR MESSAGES
          MESSAGE  (=C**),2,R
          EQ     SINX        RETURN
 SMD      SPACE  4,30
**        SMD - SET MASTER DEVICE PARAMETERS.
*
*         ENTRY  (TCBF) = CURRENT CATALOG ENTRY.
*                (MMSK) = CURRENT MASTER DEVICE MASK.
*                (NCTR) = CURRENT NUMBER OF CATALOG TRACKS.
*                (CCTR) = CURRENT CATALOG TRACK.
*
*         EXIT   (MMSK) = UPDATED MASTER DEVICE MASK.
*                (NCTR) = UPDATED NUMBER OF CATALOG TRACKS.
*                (CCTR) = UPDATED CURRENT CATALOG TRACK.
*                (MAEQ) = UPDATED MASTER EQUIPMENT.
*                (CPAR+/COMSPFS/CPDN) = UPDATED MASTER DEVICE NUMBER.
*                MASTER DEVICE SWITCH MADE IF NECESSARY.
*                FILES OPENED IF A MASTER DEVICE SWITCH IS MADE.
*                UTILITY INTERLOCK SET.
*                UTILITY PROCESSOR ACTIVE.
*                FILES POSITIONED.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2.
*
*         CALLS  AUP, CIN, DUP, FCB, RCT, SIN.
*
*         MACROS CALLPFU, RETURN, SETFS.
 
 
 SMD1     RJ     DUP         DROP UTILITY PROCESSOR
          RJ     CIN         CLEAR UTILITY INTERLOCK
 
*         GET CATALOG TRACK PARAMETERS.
 
          SX1    PDWD        SET ADDRESS OF PF DESCRIPTION WORD
          SX2    TCBF+FCUI   SET ADDRESS OF USER INDEX IN CATALOG
          LX1    18
          BX6    X1+X2
          SA6    CATS+FTCA
          SA6    CATS+FTPM
          CALLPFU  CATS,CTCT,R  GET CATALOG TRACK PARAMETERS
 
*         SET UP NEW MASTER DEVICE PARAMETERS.
 
          SA3    TCBF+FCUI   SET *TMDA* INDEX
          MX0    -3
          BX3    -X0*X3
          SA3    TMDA+X3     GET *MSTT* ADDRESS
          SA3    X3+
          SA4    A3+B1
          MX0    -6
          BX6    -X0*X3      SET MASTER DEVICE NUMBER
          MX0    -9
          SA6    CPAR+/COMSPFS/CPDN
          LX3    -6
          BX6    -X0*X3      SET MASTER EQUIPMENT
          LX3    -9
          SA6    MAEQ
          BX7    -X0*X3      SET NUMBER OF CATALOG TRACKS
          MX0    -8
          BX6    -X0*X4      SET MASTER DEVICE MASK
          LX3    -9
          SA7    NCTR
          SA6    MMSK
          SA1    TCBF+FCUI   SET CURRENT CATALOG TRACK
          SX2    X7-1
          LX1    -3
          BX7    X2*X1
          SA7    CCTR
 
*         SET UP CATALOG FST ENTRY.
 
          SA1    CATS+FTPM   GET CATALOG TRACK PARAMETERS
          SX2    5           SET FILE STATUS
          MX0    -24
          BX1    -X0*X1      SET EQ AND FIRST TRACK
          MX0    -12
          BX6    -X0*X1      SET CURRENT TRACK
          LX1    36
          BX2    X2+X1       BUILD CATALOG TRACK FST ENTRY
          LX6    24
          BX7    X2+X6
          SA7    A1
          LX0    36          SET ID, EQ AND STATUS
          BX6    X0*X2
 
*         SET UP PERMITS FST ENTRY.
 
          SX1    10000B*FSMS SET SECTOR FOR *PETS* AND *DATA*
          BX6    X6+X1
          MX0    -12
          BX1    -X0*X3      SET FIRST PERMITS TRACK
          BX2    X1          SET CURRENT TRACK
          LX1    36
          LX2    24
          BX7    X6+X1
          LX3    -24
          BX7    X7+X2
          SA7    PETS+FTPM
 
*         SET UP DATA FST ENTRY.
 
          BX1    -X0*X3      SET FIRST DATA TRACK
          BX2    X1          SET CURRENT TRACK
          LX1    36
          BX7    X6+X1
          LX2    24
          BX7    X7+X2
          SA7    DATA+FTPM
 
*         OPEN FILES AND SET SPECIAL SYSTEM FILE STATUS
 
          RETURN CATS        RETURN ANY EXISTING FILES
          RETURN PETS
          RETURN DATA
          CALLPFU  CATS,CTOP,R  OPEN *CATS* FILE
          CALLPFU  PETS,CTOP,R  OPEN *PETS* FILE
          CALLPFU  DATA,CTOP,R  OPEN *DATA* FILE
          SETFS  CATS,SSST
          SETFS  PETS,SSST
          SETFS  DATA,SSST
 
*         SET UTILITY INTERLOCK AND ACTIVATE *PFU*.
 
 SMD2     RJ     SIN         SET UTILITY INTERLOCK
          RJ     AUP         ACTIVATE *PFU*
 
*         CHECK FOR NEW MASTER DEVICE.
 
 SMD      SUBR               ENTRY/EXIT
          SA2    TCBF+FCUI   USER INDEX OF FILE
          SA1    MMSK
          MX0    -3
          BX6    -X0*X2      SELECT CORRECT MASK BIT
          SB2    X6-59
          AX1    X1,B2
          PL     X1,SMD1     IF NOT CORRECT MASTER DEVICE
 
*         CHECK FOR NEW CATALOG TRACK.
 
          LX2    -3
          SA1    NCTR        SET CATALOG TRACK MASK
          SA3    CCTR        CURRENT CATALOG TRACK
          SX6    X1-1
          BX7    X6*X2       NEW CATALOG TRACK
          IX2    X3-X7
          ZR     X2,SMD2     IF SAME CATALOG TRACK
 
*         SWITCH CATALOG TRACKS.
 
          SA1    PAFL
          SA7    A3+         SAVE NEW CATALOG TRACK
          ZR     X1,SMD2     IF *PFU* NOT ACTIVE
          RJ     FCB         FLUSH CATALOG BUFFER
          RJ     RCT         READ NEW CATALOG TRACK
          EQ     SMDX        RETURN
 SRD      SPACE  4,15
**        SRD - SELECT RESIDENCY DEVICE FOR LOAD LEVELING.
*
*         ENTRY  PFC ENTRY FOR FILE IN *TCBF*.
*                (B6) = DAPF MASK SHIFT COUNT.
*
*         EXIT   (B2) = *MSTT* ADDRESS OF DEVICE IF DEVICE SELECTED.
*                (B2) = -1 IF NO DEVICE FOR USER INDEX OF FILE.
*                (B2) = 0 IF NO DEVICE FOR ACCESS LEVEL OF FILE.
*                (B2) = 1 IF NO DEVICE WITH SPACE FOR FILE.
*
*         USES   X - 2, 3, 4, 5.
*                A - 5.
*                B - 2, 3.
*
*         CALLS  CAL, RAS.
 
 
 SRD      SUBR               ENTRY/EXIT
 
*         INITIALIZE SEARCH PARAMETERS.
 
          SA5    MSTT-1      INITIALIZE SEARCH ADDRESS
          SB2    -B1         PRESET ERROR STATUS = NO DEVICE FOR UI
          SX4    -B1         INITIALIZE BEST DEVICE STATUS
 
*         ADVANCE TO NEXT DEVICE AND CHECK DEVICE MASK.
 
 SRD1     SA5    A5+2        GET DEVICE PARAMETERS
          AX2    X5,B6       POSITION DAPF MASK BIT
          ZR     X5,SRDX     IF END OF DEVICES
          PL     X2,SRD1     IF USER INDEX NOT ALLOWED ON DEVICE
 
*         CHECK ACCESS LEVELS, DEVICE STATE, AND AVAILABLE SPACE.
 
          RJ     CAL         CHECK ACCESS LEVELS
          SB3    B0          SET ACCESS LEVEL ERROR
          NG     X6,SRD2     IF FILE NOT WITHIN DEVICE LEVELS
          SX3    B0          SET NO SPACE INCREMENT
          RJ     RAS         RETURN AVAILABLE SPACE
          SB3    B1          SET NO SPACE FOR FILE ERROR
          ZR     X1,SRD2     IF INSUFFICIENT SPACE ON DEVICE
          IX2    X1-X4
          NG     X2,SRD1     IF PREVIOUS DEVICE BETTER
          BX4    X1          SET NEW BEST DEVICE STATUS
          SB2    A5-B1       SET BEST DEVICE POINTER
          EQ     SRD1        ADVANCE TO NEXT DEVICE
 
*         PROCESS ACCESS LEVEL CONFLICT OR NO SPACE AVAILABLE.
 
 SRD2     SX2    B2-B3
          PL     X2,SRD1     IF NO LOWER PRIORITY ERROR SET
          SB2    B3          UPDATE ERROR STATUS
          EQ     SRD1        ADVANCE TO NEXT DEVICE
 SSC      SPACE  4,15
**        SSC - SET SECTOR COUNTER.
*
*         ENTRY  (X2) = FET ADDRESS.
*                FET NOT BUSY.
*
*         EXIT   (X2) = FET ADDRESS.
*                (X2+FTSC) = SECTOR COUNT IN BUFFER.
*
*         USES   X - 1, 5, 6, 7.
*                A - 1, 5, 6, 7.
*
*         MACROS READW.
 
 
 SSC3     SA1    SSCA        RESTORE IN
          SA5    A1+B1       RESTORE OUT
          BX6    X1
          LX7    X5
          SA6    X2+2
          SA7    A6+B1
 
 SSC      SUBR               ENTRY/EXIT
          SA1    X2+2        SAVE IN
          SA5    A1+B1       SAVE OUT
          BX6    X1
          LX7    X5
          SA6    SSCA
          SA7    A6+B1
          SA1    X2          SET EOR STATUS IN FET
          MX6    48
          SX5    23B
          BX1    X6*X1
          SX7    B0+         CLEAR SECTOR COUNT
          BX6    X1+X5
          SA7    X2+FTSC
          SA6    X2+
 SSC1     READW  X2,SSCB,B1  READ CONTROL WORD
          NZ     X1,SSC3     IF BUFFER EMPTY
          SA1    SSCB        GET SECTOR WORD COUNT
          MX6    -12
          BX5    -X6*X1
          SA1    X2+FTSC     INCREMENT SECTOR COUNT
          SX6    X1+B1
          SA6    A1
 SSC2     ZR     X5,SSC1     IF END OF SECTOR
          READW  X2,SSCB,B1  READ ONE WORD OF SECTOR
          NZ     X1,SSC3     IF BUFFER EMPTY
          SX5    X5-1
          EQ     SSC2        CHECK FOR END OF SECTOR
 
 
 SSCA     BSSZ   2           IN AND OUT SAVE AREA
 SSCB     CON    0           SCRATCH BUFFER
 VFN      SPACE  4,10
**        VFN - VALIDATE FILE NAME.
*
*         ENTRY  (TCBF) = CURRENT CATALOG ENTRY.
*
*         EXIT   (X3) .GE. 0, IF FILE NAME NOT VALID
*
*         USES   X - 0, 1, 2, 3.
*                A - 1.
 
 
 VFN      SUBR               ENTRY/EXIT
          SA1    TCBF+FCFN   CHECK FILE NAME
          MX2    42
          BX1    X2*X1
          MX0    -6
          LX1    6
          SX2    1R9+1
 VFN1     BX3    -X0*X1      CHECK FOR NON-ALPHANUMERIC CHARACTER
          ZR     X3,VFNX     IF CHARACTER NOT VALID
          BX1    X0*X1
          IX3    X3-X2
          PL     X3,VFNX     IF CHARACTER NOT VALID
          LX1    6
          NZ     X1,VFN1     IF MORE CHARACTERS
          EQ     VFNX        RETURN
 WCE      SPACE  4,20
**        WCE - WRITE CATALOG ENTRY.
*
*         ENTRY  (CSWC) = CURRENT CATALOG SECTOR WORD COUNT.
*                (*CATS* IN POINTER) = ADDRESS OF CATALOG ENTRY.
*
*         EXIT   (CSWC) = UPDATED SECTOR WORD COUNT.
*                (CBFO) = UPDATED CATALOG BUFFER ORDINAL.
*                (IPFF) = 0.
*                (CEWF) = 0 IF CATALOG BUFFER FLUSHED.
*                       = 1 IF CATALOG BUFFER NOT FLUSHED.
*                CATALOG FILE BUFFER POINTERS ADJUSTED.
*                CATALOG BUFFER FLUSHED IF NECESSARY.
*                FULL SECTOR CONTROL WORD WRITTEN TO BUFFER IF
*                  NECESSARY.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*
*         CALLS  FCB.
 
 
 WCE      SUBR               ENTRY/EXIT
          BX6    X6-X6       CLEAR INCOMPLETE FILE FLAG
          SA6    IPFF
          SX7    B1          SET *CATALOG ENTRIES WRITTEN*
          SA7    CEWF
          SA2    CBFO        ADVANCE CATALOG ORDINAL
          IX7    X2+X7
          SA7    A2
          SA2    CATS+2      SET IN POINTER TO END OF CATALOG ENTRY
          SA1    CSWC        ADJUST SECTOR WORD COUNT
          SX6    X2+NWCE
          SX7    X1+NWCE
          SA6    A2
          SA7    A1
          SX1    X7-100B
          NG     X1,WCEX     IF NOT FULL SECTOR
          BX6    X6-X6       CLEAR SECTOR WORD COUNT
          SA6    A1
          SA1    CATS+FTSC   INCREMENT SECTOR COUNTER
          SX7    X1+B1
          SA7    A1+
          LX7    59-11
          NG     X7,WCE1     IF AT SECTOR LIMIT
          SA1    CATS+4      CHECK BUFFER SPACE
          SA2    CATS+2
          SX6    X1-101B
          IX7    X2-X6
          NG     X7,WCE2     IF ROOM FOR FULL SECTOR
 WCE1     RJ     FCB         FLUSH CATALOG BUFFER
 WCE2     SX6    100B        SET FULL SECTOR CONTROL WORD
          SA1    CATS+2
          SA6    X1
          SX7    X1+B1       ADJUST IN POINTER
          SA7    A1+
          EQ     WCEX        RETURN
 WPR      SPACE  4,20
**        WPR - WRITE PRU TO *PFU* CIRCULAR BUFFER.
*
*         ENTRY  (X2) = FET ADDRESS.
*                (B6) = FWA OF WORKING BUFFER.
*                (B7) = WORD COUNT OF WORKING BUFFER.
*
*         EXIT   (X2) = FET ADDRESS.
*                (B7) = 0 IF NO WRITE ERROR DETECTED.
*                     = SAME AS ENTRY IF WRITE ERROR DETECTED.
*                (X6) = ERROR CODE FROM FET IF (B7) IS NON-ZERO.
*                DATA WRITTEN TO CIRCULAR BUFFER.
*                WRITE REQUEST ISSUED IF BUFFER AT LEAST HALF FULL.
*
*         USES   X - 1, 3, 6, 7.
*                A - 1, 3, 6, 7.
*                B - 2, 3, 4, 6, 7.
*
*         CALLS  FUB.
*
*         MACROS RECALL.
 
 
 WPR      SUBR               ENTRY/EXIT
 
*         CHECK SECTOR COUNTER.
 
          SA1    X2+FTSC     CHECK SECTOR COUNTER
          LX1    59-11
          PL     X1,WPR1     IF SECTOR COUNTER NOT AT THRESHOLD
          RJ     FUB         FLUSH BUFFER
          NZ     X6,WPRX     IF WRITE ERROR
          SA6    X2+FTSC     CLEAR SECTOR COUNTER
 
*         CHECK BUFFER SPACE.
 
 WPR1     ZR     B7,WPRX     IF NO DATA TO TRANSFER
          SA1    X2+2        (B2) = IN
          SB2    X1
          SA1    A1+B1       (B4) = OUT
          SB4    X1
          SA1    A1+B1       (B3) = LIMIT
          SB3    X1
          SB4    B4-B2       BUFFER SPACE + 1 = OUT - IN
          GE     B4,B1,WPR2  IF NO BUFFER WRAP
          SA1    X2+B1       BUFFER SPACE + 1 = (OUT-IN)+(LIMIT-FIRST)
          SB4    B4+B3
          BX1    -X1
          SB4    B4+X1
 WPR2     GT     B4,B7,WPR4  IF ENOUGH ROOM IN BUFFER
 
*         PROCESS BUFFER FULL.
 
          SA1    X2          GET FILE NAME
          MX6    42
          BX7    X6*X1
          LX1    59-0        CHECK BUFFER STATUS
          SX3    B1+B1       SET WRITE FUNCTION CODE
          MX6    -6
          PL     X1,WPR3     IF BUFFER BUSY
          LX1    0-12-59+0+60   GET ERROR STATUS
          BX6    -X6*X1
          IX7    X7+X3
          NZ     X6,WPRX     IF WRITE ERROR
          SA7    X2          ISSUE WRITE REQUEST
 WPR3     RECALL             WAIT FOR *PFU* TO CATCH UP
          EQ     WPR1        CHECK BUFFER SPACE
 
*         MOVE DATA TO CIRCULAR BUFFER.
 
 WPR4     SA1    B6          MOVE WORD
          SB6    B6+B1       ADVANCE WORKING BUFFER ADDRESS
          BX6    X1
          SB7    B7-B1       DECREMENT WORD COUNT
          SA6    B2
          SB2    B2+B1       ADVANCE IN
          LT     B2,B3,WPR5  IF IN .LT. LIMIT
          SA1    X2+B1       IN = FIRST
          SB2    X1
 WPR5     NZ     B7,WPR4     IF WORKING BUFFER NOT EMPTY
 
*         CHECK BUFFER THRESHOLD.
 
          SX6    B2          UPDATE IN
          SA3    X2          CHECK BUFFER STATUS
          SA1    X2+FTSC     INCREMENT SECTOR COUNTER
          SA6    X2+2
          SX7    X1+B1
          LX3    59-0
          SA7    A1
          SA1    X2+B1       FIRST
          PL     X3,WPRX     IF BUFFER ALREADY BUSY
          SA3    X2+3        OUT
          SX6    B3
          SX1    X1
          IX7    X6-X1       BUFFER SIZE = LIMIT - FIRST
          SX6    B2          BUFFER WC = IN - OUT
          IX3    X6-X3
          PL     X3,WPR6     IF NO BUFFER WRAP
          IX3    X3+X7       BUFFER WC = BUFFER WC + BUFFER SIZE
 WPR6     AX7    1           BUFFER SIZE / 2
          IX1    X3-X7
          NG     X1,WPRX     IF BUFFER NOT AT LEAST HALF FULL
          SA1    X2          GET FILE NAME
          MX6    42
          BX7    X6*X1
          LX1    -12         GET ERROR STATUS
          MX3    -6
          BX6    -X3*X1
          SX1    B1+B1       SET WRITE FUNCTION CODE
          BX7    X7+X1
          NZ     X6,WPRX     IF WRITE ERROR
          SA7    X2+         ISSUE WRITE REQUEST
          EQ     WPRX        RETURN
          TITLE  INCREMENTAL LOAD SUBROUTINES.
 AAT      SPACE  4,20
**        AAT - ASSIGN NEXT ARCHIVE TAPE.
*
*         ENTRY  (X1) = VSN LEFT JUSTIFIED.
*
*         EXIT   (X6) = 0 IF NEW ARCHIVE TAPE ASSIGNED.
*                (X6) .NE. 0 IF ARCHIVE FILE LABEL BAD OR MISSING ON
*                  SELECTED TAPE.
*                OLD ARCHIVE FILE UNLOADED.
*                ARCHIVE FILE LABEL PROCESSED IF LABEL GOOD.
*
*         USES   X - 1, 4, 5, 6, 7.
*                A - 1, 4, 6, 7.
*
*         CALLS  PAL, ZTB.
*
*         MACROS LABEL, READCW, UNLOAD.
 
 
 AAT      SUBR               ENTRY/EXIT
          RJ     ZTB         SPACE FILL VSN
          MX7    36
          BX7    X7*X6
          SX6    B0
          SA7    TAPE+11B    SET VSN IN FET
          SA6    A7+B1       CLEAR TAPE LABEL PARAMETERS
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          UNLOAD TAPE,R      UNLOAD OLD ARCHIVE FILE
          SA4    X2+B1       CLEAR DEVICE TYPE
          MX6    -48
          SX5    1           CLEAR ERROR PROCESSING BIT
          BX4    -X6*X4
          LX5    44
          BX6    -X5*X4
          SA6    A4
          LABEL  TAPE        REQUEST ARCHIVE TAPE
          SA4    X2+B1       SET ERROR PROCESSING BIT
          BX6    X5+X4
          SA6    A4
          SA1    X2+B1       SET IN=OUT=FIRST
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
          READCW X2,17B      INITIATE CONTROL WORD READ
          SX6    B0+         CLEAR CONTROL WORD STATUS WORD
          SA6    TAPE+CWSW
          RJ     PAL         CHECK ARCHIVE LABEL
          ZR     X6,AATX     IF GOOD ARCHIVE FILE LABEL
          UNLOAD TAPE,R      UNLOAD TAPE
          SX6    B1          SET ASSIGNMENT NOT MADE
          EQ     AATX        RETURN
 ART      SPACE  4,20
**        ART - ARCHIVE FILE TRANSITION PROCESSOR.
*
*         ENTRY  END OF INCREMENTAL LOAD FILE DETECTED.
*
*         EXIT   (X6) = 0 IF NOT END OF INCREMENTAL LOAD.
*                     = NON-ZERO IF END OF INCREMENTAL LOAD.
*                UTILITY PROCESSOR INACTIVE.
*                UTILITY INTERLOCK CLEAR.
*                FILES REMAINING ON CATALOG IMAGE RECORD LISTED IF
*                SELECTED BY OPERATOR.
*                NEW ARCHIVE FILE ASSIGNED IF NOT END OF LOAD.
*
*         USES   X - 1, 2, 4, 5, 6, 7.
*                A - 1, 2, 4, 5, 7.
*                B - 2, 3, 4, 5.
*
*         CALLS  AAT, ARM, CCI, CIN, CMA, DUP, KIP, LFS, SRS, USB, ZTB.
*
*         MACROS MOVE.
 
 
 ART      SUBR               ENTRY/EXIT
 
*         DROP *PFU* AND FLUSH CIR BUFFER.
 
          RJ     DUP         DROP UTILITY PROCESSOR
          RJ     CIN         CLEAR UTILITY INTERLOCK
          SX7    B0+         SET FLAG TO FLUSH CIR BUFFER
          SA7    TCBF+FCUI
          RJ     CCI         FLUSH CIR BUFFER
 
*         PROCESS *OP=V* SELECTED.
 
          SA1    CPAR+/COMSPFS/CPOP
          LX1    59-51
          PL     X1,ART1     IF *OP=V* NOT SELECTED
          SA1    TLBF+/COMSPFS/PVAL  CHECK FOR NEXT VSN
          SA2    =10H
          MX6    36
          BX2    X1-X2
          BX1    X6*X1
          BX2    X6*X2
          ZR     X1,ARTX     IF NEXT VSN NOT PRESENT
          ZR     X2,ARTX     IF NEXT VSN NOT PRESENT
          RJ     AAT         ASSIGN ARCHIVE TAPE
          ZR     X6,ARTX     IF TAPE ASSIGNED
          SB2    ERAL        * ERROR IN ACHIVE FILE LABEL.*
          EQ     ABT         ABORT
 
*         SET *K* DISPLAY RIGHT SCREEN FOR INPUT.
 
 ART1     SA5    IDSA+/COMSPFS/ADM2
          MOVE   4,MSGH,X5   *END OF LOAD FILE - SEE RIGHT SCREEN.*
          SX6    ARTA
          RJ     SRS         SELECT RIGHT SCREEN
 
*         CLEAR VSN SELECTION.
 
 ART2     SA1    =10H
          SX6    B0
          BX7    X1
          SA6    VSPR        CLEAR *VSN* PARAMETER
          SA7    ARTB+1      CLEAR VSN IN DISPLAY
 
*         GET OPERATOR INPUT.
 
 ART3     SX7    B0+         CLEAR *LIST* AND *END* INDICATORS
          SA7    LTPR
          SA7    ENPR
          SB2    ART4        SET ARGUMENT PROCESSOR ADDRESS
          SB3    ART9        SET FUNCTION PROCESSOR ADDRESS
          EQ     /COMSPFS/KIP  PROCESS KEYBOARD INPUT
 
*         PROCESS ARGUMENT ENTRY.
 
 ART4     SB2    /COMSPFS/KIN  SET PARAMETERS ADDRESS
          RJ     USB         UNPACK PARAMETERS
          SB3    ARGT        SET ARGUMENT TABLE ADRESS
          RJ     ARM         PROCESS ARGUMENTS
          ZR     X1,ART5     IF NO ERROR
          SA5    IDSA+/COMSPFS/ADER
          MOVE   4,MSGT,X5   *INCORRECT OPTION.*
          EQ     ART3        PROCESS KEYBOARD INPUT
 
 ART5     SA1    ENPR
          ZR     X1,ART6     IF NOT END OF LOAD
          RJ     CMA         CLEAR MESSAGE AREA
          SX6    B1          SET END OF LOAD STATUS
          EQ     ARTX        RETURN
 
 ART6     SA1    LTPR
          ZR     X1,ART7     IF NOT LIST FILES
          RJ     CMA         CLEAR MESSAGE AREA
          RJ     LFS         LIST FILES
          EQ     ART1        PROCESS KEYBOARD INPUT
 
 ART7     SA1    VSPR
          MX7    42
          MX6    -24
          ZR     X1,ART3     IF VSN NOT ENTERED
          BX1    X7*X1
          BX7    -X6*X1
          ZR     X7,ART8     IF VALID VSN
          SA5    IDSA+/COMSPFS/ADER
          MOVE   4,MSGP,X5   *ENTERED VSN TOO LONG.*
          EQ     ART2        CLEAR VSN SELECTION
 
 ART8     RJ     ZTB         SPACE FILL VSN
          SA6    ARTB+1      SET VSN IN DISPLAY
          EQ     ART3        PROCESS KEYBOARD INPUT
 
*         PROCESS *GO* ENTRY.
 
 ART9     SA1    VSPR
          NZ     X1,ART10    IF VSN ENTERED
          SA5    IDSA+/COMSPFS/ADER DISPLAY BAD LABEL MESSAGE
          MOVE   4,MSGQ,X5   *NO VSN ENTERED.*
          EQ     ART3        GET OPERATOR INPUT
 
 ART10    RJ     AAT         ASSIGN ARCHIVE TAPE
          ZR     X6,ART12    IF TAPE ASSIGNED
          SA5    IDSA+/COMSPFS/ADER DISPLAY BAD LABEL MESSAGE
          MOVE   4,MSGV,X5   *ARCHIVE LABEL BAD, SELECT NEW VSN.*
          EQ     ART2        CLEAR VSN SELECTION
 
*         PROCESS TAPE ASSIGNED.
 
 ART12    RJ     CMA         CLEAR MESSAGE AREA
          SX6    B0          SET TAPE ASSIGNED
          EQ     ARTX        RETURN
 
 
*         RIGHT SCREEN BUFFER FOR TAPE TRANSITION.
 
 ARTA     VFD    12/0,36/0,12/0  DISPLAY CONTROL WORD
 
          KDL    10,T,(INCREMENTAL LOAD FILE TRANSITION OPTIONS.)
          KDL    13,H,(ENTER K.OPTION.)
          KDL    13,,(OPTION)
          KDL    30,H,(DESCRIPTION)
          KDL    13,K,(END              TERMINATE LOAD.)
          KDL    13,K,(LIST             LIST REMAINING FILES.)
 ARTB     KDL    13,K,(VSN =            VSN OF NEXT TAPE.)
          KDL    13,K,(GO               RESUME LOAD AFTER VSN ENTERED.)
          CON    0           END OF BUFFER
 
 
*         ENTERED PARAMETERS.
 
 LTPR     CON    0           *LIST*
 ENPR     CON    0           *END*
 VSPR     CON    0           *VSN*
 
 
*         ARGUMENT TABLE.
 
 ARGT     BSS    0
 LIST     ARG    -NZ,LTPR,,1
 END      ARG    -NZ,ENPR,,1
 VSN      ARG    NZ,VSPR,,1
          CON    0
 
 NZ       CON    1           NON-ZERO VALUE
 CCI      SPACE  4,20
**        CCI - CHECK CATALOG IMAGE.
*
*         ENTRY  (TCBF) = CATALOG ENTRY BEING PROCESSED.
*                (TCBF+FCUI) = 0, IF INDEX TO BE FLUSHED.
*                (INCF) = INCREMENTAL LOAD FLAG.
*                (CIFC) = FILE COUNT FOR CATALOG IMAGE RECORD.
*                (CIRT) = CATALOG IMAGE RECORD DIRECTORY.
*
*         EXIT   (X6) = 0 IF FILE TO BE LOADED (OR NOT INCREMENTAL
*                       LOAD).
*                     .NE. 0 OTHERWISE.
*                (TCBF) = UPDATED WITH ACCESS INFORMATION FROM THE CIR
*                         IF AN INCREMENTAL LOAD AND FILE TO BE LOADED.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 3, 4.
*
*         MACROS READ, REWRITE, REWRITER.
 
 
 CCI      SUBR               ENTRY/EXIT
          SA1    INCF
          BX6    X6-X6       PRESET TO LOAD FILE
          MX0    42
          ZR     X1,CCIX     IF NOT AN INCREMENTAL LOAD
          SA1    TCBF+FCUI   GET USER INDEX OF FILE
          ZR     X1,CCI10    IF CATALOG BUFFER TO BE FLUSHED TO DISK
          BX1    -X0*X1
          MX0    -3          SAVE DEVICE MAP BITS
          BX3    -X0*X1
          SB2    X3
          SX5    B0          SET INDEX
 CCI1     SX6    NWCD
          IX4    X5*X6
          SX5    X5+B1
          SA4    CIRT+X4     READ HEADER WORD
          NZ     X4,CCI2     IF DEVICE THERE
          SX6    B1          EXIT - DEVICE NOT FOUND
          EQ     CCIX        RETURN
 
 CCI2     AX4    X4,B2
          MX0    -1
          BX4    -X0*X4
          ZR     X4,CCI1     IF NOT CORRECT DEVICE
          SA4    A4          GET NUMBER CATALOG TRACKS
          AX4    12
          SX4    X4-1        SET MASK
          AX1    3
          BX1    X4*X1
          SB2    X1
          SA4    A4+B1
          SA5    A4+B2
          SX6    B1
          ZR     X5,CCIX     IF NO ENTRIES
 CCI3     SA1    CCIA        FETCH LAST RANDOM INDEX
          SX6    B1          SET RANDOM REWRITE REQUEST
          MX2    -29
          LX6    29
          BX5    X6+X5
          NG     X1,CCI5     IF NO DATA IN BUFFER
          BX4    -X2*X5      EXTRACT RANDOM INDEX
          IX4    X4-X1
          ZR     X4,CCI6     IF NO RANDOM INDEX CHANGE
          SA4    CCIB        FETCH INDEX MODIFICATION FLAG
          BX6    X6+X1
          NZ     X4,CCI5     IF INDEX NOT MODIFIED
          SA1    CIRF        CHECK END STATUS
          SA6    CIRF+6      SET RANDOM INDEX FOR WRITE
          LX1    59-4
          PL     X1,CCI4     IF NOT END OF RECORD
          REWRITER  CIRF,R
          EQ     CCI5        PROCESS NEXT INDEX
 
 CCI4     REWRITE CIRF,R
 CCI5     SA1    CIRF+1      FETCH FIRST
          BX6    X5
          SX7    X1
          SA6    CIRF+6      SET NEW RANDOM INDEX
          MX2    -29
          SA7    A1+B1       SET IN=FIRST
          SA7    A7+B1       SET OUT=FIRST
          SA7    CCIB        CLEAR BUFFER MODIFIED FLAG (SET NONZERO)
          BX6    -X2*X6
          SA6    CCIA        SAVE RANDOM INDEX
          READ   CIRF,R      LOAD IMAGE BUFFER
 CCI6     SA1    CIRF
          SA4    TCBF+FCUI   FETCH USER INDEX AND FILE
          LX1    17-4
          SB4    X1          END OF RECORD INDICATOR
          SA1    CIRF+2      FETCH IN
          SA2    A1+B1       FETCH OUT
          IX7    X1-X2
          SX6    B1
          ZR     X7,CCIX     IF END OF RECORD AND BUFFER EMPTY
          SB2    X1          SET LAST BUFFER ADDRESS
          SB3    X2          SET ADDRESS OF FIRST ENTRY
 CCI7     SA1    B3          FETCH NEXT ENTRY
          IX1    X1-X4
          ZR     X1,CCI8     IF CATALOG ENTRY FOUND
          SB3    B3+2
          LT     B3,B2,CCI7  IF MORE ENTRIES IN BUFFER
          NG     B4,CCIX     IF END OF RECORD
          SA1    CIRF+6      FETCH RANDOM INDEX
          SA4    CCIB        FETCH BUFFER MODIFICATION FLAG
          MX2    -29
          LX1    30          CURRENT RANDOM INDEX
          BX5    X2*X5       PREVIOUS INDEX
          BX6    -X2*X1
          BX5    X5+X6
          ZR     X4,CCI3     IF BUFFER MODIFIED
          EQ     CCI5        PROCESS NEXT BUFFER LOAD
 
*         UPDATE CATALOG ENTRY WITH INFORMATION FROM CIR.
 
 CCI8     BX6    X6-X6
          SA6    CCIB        SET BUFFER MODIFIED FLAG
          SA6    B3
          SA1    B3+B1       FETCH NEW ACCESS INFORMATION FROM CIR
          SA2    TCBF+FCAD
          MX0    18
          BX7    X0*X1       EXTRACT NEW ACCESS COUNT
          SA3    TCBF+FCAC
          BX1    -X0*X1      NEW DEVICE NUMBER AND LAST ACCESS DATE
          LX7    -6
          BX2    X0*X2       CLEAR OLD DEVICE NUMBER AND ACCESS DATE
          MX0    -36
          BX6    X1+X2       UPDATE DEVICE NUMBER AND ACCESS DATE
          SA6    A2
          BX3    -X0*X3      CLEAR OLD ACCESS COUNT
          BX7    X7+X3       UPDATE ACCESS COUNT
          SA7    A3
          BX6    X6-X6
          SA5    A5          UPDATE DIRECTORY ENTRY
          LX5    30
          SX1    B1
          IX7    X5-X1
          MX5    -30
          BX5    -X5*X7
          NZ     X5,CCI9     IF MORE ENTRIES LEFT
          BX7    X7-X7
 CCI9     LX7    30
          SA7    A5
          SA4    CIFC        DECREMENT FILE COUNT
          IX7    X4-X1
          SA7    A4
          EQ     CCIX        RETURN
 
*         CLEAN UP CATALOG BUFFER.
 
 CCI10    SA1    CCIA        FETCH CURRENT RENDOM INDEX
          SA2    CCIB        FETCH BUFFER MODIFICATION FLAG
          SA4    CIRF
          NG     X1,CCI12    IF NO DATA IN BUFFER
          NZ     X2,CCI12    IF BUFFER NOT MODIFIED
          SX6    B1
          SX7    -B1
          LX6    29
          SA7    A1          CLEAR CURRENT RANDOM INDEX
          LX4    59-4
          BX6    X6+X1
          SA7    A2          CLEAR BUFFER MODIFICATION FLAG
          SA6    CIRF+6      RESET RANDOM INDEX
          PL     X4,CCI11    IF NOT END OF RECORD
          REWRITER  CIRF,R
          EQ     CCI12       SET NO LOAD STATUS
 
 CCI11    REWRITE  CIRF,R
 CCI12    SX6    B1
          EQ     CCIX        RETURN
 
 
 CCIA     DATA   -1          CURRENT RANDOM INDEX
 CCIB     DATA   -1          BUFFER MODIFICATION FLAG
 CMA      SPACE  4,10
**        CMA - CLEAR MESSAGE AREA.
*
*         EXIT   *K* DISPLAY ERROR MESSAGE LINES CLEARED.
*
*         USES   X - 5.
*                A - 5.
*
*         MACROS MOVE.
 
 
 CMA      SUBR               ENTRY/EXIT
          SA5    IDSA+/COMSPFS/ADM2
          MOVE   4,BLNK,X5
          SA5    A5+B1
          MOVE   4,BLNK,X5
          EQ     CMAX        RETURN
 LFS      SPACE  4,20
**        LFS - LIST FILES ON CATALOG IMAGE RECORD.
*
*         ENTRY  (CIFC) = REMAINING FILE COUNT.
*                (CIRT - CIRT+NWCD*NDEV) = DIRECTORY OF CATALOG IMAGE
*                RECORD FILE.
*
*         EXIT   FILE LIST CREATED AND RELEASED FOR PRINTING.
*
*         USES   X - 1, 2, 5, 6.
*                A - 1, 5, 6.
*                B - 2.
*
*         CALLS  CDD, FCI, RPP.
*
*         MACROS MESSAGE, MOVE, READ, READW, RECALL, ROUTE, WRITEF,
*                WRITEH.
 
 
 LFS      SUBR               ENTRY/EXIT
          SA1    PAGE
          SX7    B1+
          BX6    X1
          SA7    A1          RESET PAGE NUMBER
          SA6    LFSK        SAVE OUTPUT FILE PAGE NUMBER
          SX6    LCIR
          SA6    OFFA        SET OUTPUT FILE FET ADDRESS
          SX2    LFSL        SET TITLE TEXT
          SX6    CIS         SET CIR SUBHEADER PROCESSOR
          RJ     RPP         RESET PAGE PARAMETERS
          SX6    -1
          SA6    LFSA
          SA5    IDSA+/COMSPFS/ADMS
          MOVE   3,LFSB,X5   DISPLAY *LISTING FILES* MESSAGE
          MESSAGE  LFSB,1
          SA5    CIFC        SET TOTAL FILE COUNT
          ZR     X5,LFS4     IF NO FILES
 LFS1     SA1    LFSA        SET DEVICE INDEX
          SX2    NWCD
          SX6    X1+B1
          SA6    A1
          IX6    X6*X2
          SA5    CIRT+X6
          ZR     X5,LFS4     IF NO DEVICES LEFT
          AX5    12
          BX6    X5          SAVE CATALOG TRACK COUNT
          SA6    LFSD
          SX6    A5          SAVE DIRECTORY ADDRESS
          SA6    LFSF
 LFS2     SA1    LFSF        GET DIRECTORY ADDRESS
          SA5    X1+B1
          SX6    A5          SAVE DIRECTORY ADDRESS
          SA6    LFSF
          SA1    LFSD
          SX6    X1-1
          SA6    LFSD
          NG     X6,LFS1     IF END OF CATALOGS
          ZR     X5,LFS2     IF NO FILES LEFT ON THIS TRACK
          RECALL CIRF
          SA1    X2+B1       REWIND BUFFER
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
          MX6    -30
          BX6    -X6*X5
          SA6    CIRF+6
          AX5    30
          READ   CIRF        INITIATE RANDOM READ
 LFS3     READW  CIRF,LFSG,2 READ CATALOG IMAGE ENTRY
          NZ     X1,LFS2     IF END OF CATALOG TRACK
          SA1    LFSG
          ZR     X1,LFS3     IF NULL ENTRY
          BX6    X5          SAVE FILE COUNT
          SA6    LFSE
          SX6    A1+         SET CATALOG IMAGE ADDRESS
          RJ     FCI         FORMAT CIR ENTRY FOR OUTPUT
          SA5    LFSE        RESTORE FILE COUNT
          SX1    B1
          IX5    X5-X1       DECREMENT FILE COUNT
          NZ     X5,LFS3     IF MORE FILES
          EQ     LFS2        PROCESS NEXT CATALOG TRACK
 
 LFS4     SA1    CIFC        CONVERT FILE COUNT
          RJ     CDD
          SA6    LFSH+2
          WRITEH LCIR,LFSH,3
          WRITEF LCIR,R
          SX6    B0+         CLEAR PARAMETER BLOCK
          SB2    DSPBL-1
 LFS5     SA6    DSPB+B2
          SB2    B2-1
          PL     B2,LFS5     IF NOT END OF BLOCK
          SA5    LCIR        SET UP *DSP* PARAMETER BLOCK
          MX2    42
          BX6    X2*X5
          SA6    DSPB
          SA5    LFSJ        SET FLAG BITS
          BX6    X5
          SA6    A6+B1
          ROUTE  DSPB,RECALL
          SA5    IDSA+/COMSPFS/ADMS
          MOVE   3,BLNK,X5
          MESSAGE (=C**),1
          SA1    LFSK        RESET OUTPUT FILE PAGE NUMBER
          BX6    X1
          SA6    PAGE
          SX6    O
          SA6    OFFA        RESET OUTPUT FILE FET ADDRESS
          EQ     LFSX        RETURN
 
 
 LFSA     CON    0           DEVICE INDEX
 LFSB     DATA   30C LISTING REMAINING FILES.
 LFSD     CON    0           CATALOG TRACK COUNT
 LFSE     CON    0           FILE COUNT
 LFSF     CON    0           DIRECTORY ADDRESS
 LFSG     BSSZ   2           SCRATCH CATALOG IMAGE ENTRY
 LFSH     DATA   30H0   TOTAL FILE COUNT
 LFSJ     VFD    24/0,12/2HPR,6/0,18/FRDC
 LFSK     CON    1           OUTPUT FILE PAGE NUMBER
 LFSL     DATA   50H1FILES REMAINING ON CATALOG IMAGE RECORD.
 SRS      SPACE  4,15
**        SRS - SELECT RIGHT SCREEN.
*
*         *SRS* REPLACES THE CURRENT RIGHT SCREEN WITH THE REQUESTED
*         ONE AND ALERTS THE OPERATOR TO ENTER AN OPTION.
*
*         ENTRY  (X6) = FWA OF THE REQUESTED RIGHT SCREEN BUFFER.
*
*         USES   X - 0, 5, 6.
*                A - 5, 6.
*
*         MACROS MESSAGE.
 
 
 SRS      SUBR               ENTRY/EXIT
          SA5    IDSA+/COMSPFS/KDCW  CHANGE *K* DISPLAY CONTROL WORD
          MX0    42
          LX6    18
          LX0    18
          BX5    X0*X5
          BX6    X5+X6
          SA6    A5
          MESSAGE  MSGW,2    * REQUEST K DISPLAY.*
          EQ     SRSX        RETURN
          TITLE  COMMON DECKS.
*         COMMON DECKS.
 
 
*CALL     COMCARM
*CALL     COMCCCE
*CALL     COMCCDD
 ERP1$    EQU    1           SELECT *COMCCIO* ERROR PROCESSING OPTION
*CALL     COMCCIO
*CALL     COMCCOD
*CALL     COMCCPM
*CALL     COMCDXB
*CALL     COMCEDT
 FCE$     EQU    0
*CALL     COMCFCE
 GMS$     EQU    1           USE SORT KEY MASK
 MWK$     EQU    1           ALLOW MULTIPLE WORD SORT KEYS
*CALL     COMCGMS
*CALL     COMCJCR
*CALL     COMCLFM
*CALL     COMCMSF
*CALL     COMCMVE
*CALL     COMCPFM
 COM$     EQU    1           ASSEMBLE COMMON ROUTINES
 PFA$     EQU    1           ASSEMBLE COMMON ARCHIVE FILE ROUTINES
 DVA$     EQU    1           ASSEMBLE DEVICE ACCESS ROUTINES
 PFR$     EQU    1           ASSEMBLE ARCIVE FILE READ ROUTINES
          LIST   X
*CALL     COMCPFS
          LIST   *
*CALL     COMCPFU
*CALL     COMCPOP
*CALL     COMCRDW
*CALL     COMCSCB
*CALL     COMCSFN
*CALL     COMCSNM
*CALL     COMCSYS
*CALL     COMCUSB
*CALL     COMCVDT
*CALL     COMCWTC
*CALL     COMCWTH
*CALL     COMCWTO
*CALL     COMCWTW
*CALL     COMCZTB
          TITLE  BUFFERS.
 
          USE    LITERALS
 
 
*         BUFFERS.
 
 
 PBUF     EQU    *           PERMIT BUFFER
 DBUF     EQU    PBUF+PBUFL  DATA BUFFER
 TCBF     EQU    DBUF+DBUFL  TEMPORARY CATALOG BUFFER
 CWBF     EQU    TCBF+NWCE   CONTROL WORD BUFFER
 MBUF     EQU    CWBF+CWBFL  MAIN INPUT BUFFER
 CBUF     EQU    MBUF+MBUFL  CATALOG BUFFER
 TLBF     EQU    CBUF+CBUFL  TAPE LABEL BUFFER
 PFMB     EQU    TLBF+TLBFL  *PFM* CATLIST BUFFER
 DSPB     EQU    PFMB+PFMBL  *DSP* PARAMETER BLOCK
 LWRD     SPACE  4,20
**        LWRD - *PFU* BUFFER LINKAGE WORD.
*
*T LWRD   6/  TY,18/  CA,12/  0,12/  DN,12/  LN
*
*         TY = SECTOR TYPE.
*              0 = FULL SECTOR OR EOR SECTOR.
*              1 = EOF SECTOR.
*              2 = EOI SECTOR.
*              4 = SYSTEM SECTOR.
*         CA = ADDRESS OF CATALOG ENTRY FOR FILE.
*         DN = 0 FOR INDIRECT ACCESS FILES.
*            = DEVICE NUMBER FOR DIRECT ACCESS FILES.
*            = 4000 FOR DIRECT ACCESS FILES ON AN AUXILIARY DEVICE.
*         LN = LENGTH OF SECTOR.
*
*         LINKAGE WORD MUST IMMEDIATELY PRECEDE *TDBF*.
 
 
 LWRD     EQU    DSPB+DSPBL  *PFU* BUFFER LINKAGE WORD
 
 
 TDBF     EQU    LWRD+1      TEMPORARY DATA BUFFER
 FLBF     EQU    TDBF+TDBFL  FILE LIST BUFFER
 FLCB     EQU    FLBF+FLBFL  FILE LIST CIRCULAR BUFFER
 OUTB     EQU    FLCB+FLCBL  OUTPUT FILE BUFFER
 SUMB     EQU    OUTB+OUTBL  SUMMARY FILE BUFFER
 PFLB     EQU    SUMB+SUMBL  PROCESSED FILES FILE BUFFER
 MS1B     EQU    PFLB+PFLBL  SORT FILE 1
 MS2B     EQU    MS1B+MSFBL  SORT FILE 2
 MS3B     EQU    MS2B+MSFBL  SORT FILE 3
 MS4B     EQU    MS3B+MSFBL  SORT FILE 4
 SRTB     EQU    MS3B        SORT BUFFER (OVERLAYS *MS3B* AND *MS4B*)
          ERRNG  MSFBL*2-SRTBL  SORT BUFFER OVERFLOW
 CIBF     EQU    MS4B+MSFBL  *CIR* SCRATCH FILE BUFFER
 CIRT     SPACE  4,40
**        CIRT - *CIR* DIRECTORY TABLE.
*
*         *CIRT* IS A DIRECTORY TO THE CATALOG IMAGE RECORD (*CIR*)
*         WHICH IS COPIED FROM THE ARCHIVE FILE TO THE RANDOM FILE
*         *CIRF*.  *CIRT* IS INDEXED BY CATALOG TRACK NUMBER (*CT*)
*         AND THE RELATIVE DEVICE NUMBER WITHIN THE DIRECTORY (*RDEV*)
*         AS DEFINED BELOW.
*
*T,CIRT+DI  36/,12/  NCT,12/  DM
*T,CIRT+TI  30/  FC,30/  RI
*T,         60/  0
*
*           CT = CATALOG TRACK NUMBER.
*           DI = DEVICE INDEX = NWCD*RDEV.
*           DM = DEVICE MASK.
*           FC = FILE COUNT FOR CATALOG TRACK.
*           NCT = NUMBER OF CATALOG TRACKS FOR DEVICE.
*           NWCD = NUMBER OF DIRECTORY WORDS PER DEVICE.  (ASSEMBLY
*                  CONSTANT.)
*           RDEV = RELATIVE DEVICE IN DIRECTORY.
*           RI = RANDOM INDEX IN *CIRF* FOR CATALOG TRACK FILE LIST.
*           TI = CATALOG TRACK INDEX = DI+1+CT.
*
*         EACH MASTER DEVICE HAS A RECORD ON *CIRF* FOR EACH NON-NULL
*         CATALOG TRACK CONTAINING THE *CIR* ENTRIES FOR THAT TRACK.
 
 
 CIRT     EQU    CIBF+CIBFL  *CIR* DIRECTORY TABLE
 LBUF     EQU    CIRT+CIRTL  LIST *CIR* ENTRIES OUTPUT BUFFER
 ENDB     EQU    LBUF+LBUFL+5  END OF BUFFERS
          TITLE  PRESET.
 PRE      SPACE  4,40
**        PRS - PRESET PROGRAM.
*
*         ENTRY  (CPAR) = CONVERTED PARAMETER ARRAY.
*                FILES *ZZZZZG0* THROUGH ZZZZZG9 AND *ZZZZZGA* RETURNED
*                  BY *PFS*.
*                FILE *ZZZZZGB* RETURNED BY *PFS* IF NO FILE
*                  SELECTIONS.
*                FILE *ZZZZZGB* CONTAINS FILE SELECTIONS IF PRESENT.
*
*         EXIT   (B1) = 1.
*                (MSTT) = TABLE OF DEVICES IN FAMILY BEING LOADED.
*                (MASK) = MASK FOR MASTER DEVICES BEING LOADED.
*                (TMDA) = TABLE OF MASTER DEVICE ADDRESSES.
*                (PDWD) = PF DESCRIPTION WORD FOR FAMILY OR AUXILIARY
*                         DEVICE BEING LOADED.
*                (MPFM) = FAMILY NAME PARAMETER.
*                (MPPN) = PACK NAME PARAMETER.
*                EXIT TO *ABT* FOR EXTRACT OPTION WITHOUT CIR.
*                ARCHIVE FILE ASSIGNED.
*                CATALOG IMAGE RECORD PROCESSED.
*                DEVICE SELECTION PERFORMED.
*                SELECTION PARAMETERS PUT IN ACCOUNTING MESSAGES.
*                APPROPRIATE ACCOUNTING MESSAGES ISSUED TO DAYFILE AND
*                OUTPUT FILE.
*                *K* DISPLAY COORDINATES INITIALIZED.
*
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 2, 5, 6, 7.
*                B - 1.
*
*         CALLS  AAF, BMT, CAS, GAM, IFL, IOF, PCI, SBS, SFP, SMP, SSP,
*                SSS, STC.
*
*         MACROS MEMORY, REPRIEVE, SKIPFF.
 
 
 PRS      SUBR               ENTRY/EXIT
          SB1    1
          MEMORY CM,,R,ENDB  REQUEST REQUIRED MEMORY
          REPRIEVE  RPVB,SET,277B  SET EXTENDED REPRIEVE PROCESSING
          RJ     SSS         SET SECURED SYSTEM STATUS
 
*         OPEN ARCHIVE FILE.
 
          SA1    CPAR+/COMSPFS/CPTB
          SA2    TAPE
          MX0    42          SET ARCHIVE FILE NAME
          BX6    X0*X1
          BX2    -X0*X2
          BX6    X6+X2
          SA6    A2
          SX2    TAPE        SET OPTICAL DISK EXTENSION BUFFER
          SA3    PRSC
          RJ     SOE         SET FET EXTENSION IF OPTICAL DISK FILE
          OPEN   TAPE,READNR,R
          SA1    CPAR+/COMSPFS/CPSF
          ZR     X1,PRS1     IF NO FILE SKIP COUNT SPECIFIED
          SKIPFF TAPE,X1
 
*         INITIALIZE FILES AND DEVICE ENVIRONMENT.
 
 PRS1     RJ     IOF         INITIALIZE OUTPUT FILES
          SX3    PRSA        PRESET *K* DISPLAY COORDINATES
          RJ     PRK
          RJ     BMT         BUILD MASS STORAGE TABLE
          SX6    DSTBUF      SET DEVICE STATUS BUFFER ADDRESS
          RJ     ODV         OUTPUT DEVICE STATUS
          SX0    ENDB        SET BUFFER ADDRESS
          RJ     RPS         READ FILE SELECTIONS
          RJ     SMK         SET FILE SELECTION MASK
          RJ     SMP         SET MASTER DEVICE PARAMETERS
          RJ     GAM         GENERATE ACCOUNTING MESSAGES
          RJ     STC         SET TAPE CHARACTERISTICS
          READCW TAPE,17B    INITIATE CONTROL WORD READ
          BX6    X6-X6       CLEAR CONTROL WORD STATUS WORD
          SA6    TAPE+CWSW
          RJ     PAL         PROCESS ARCHIVE LABEL
          SB2    ERAL        * ERROR IN ACHIVE FILE LABEL.*
          NZ     X6,ABT      IF BAD ARCHIVE FILE LABEL
          RJ     SFP         SET PERMANENT FILE PARAMETERS
 
*         SET UTILITY CONTROL DATE UPDATE FLAG.
 
          SA1    CPAR+/COMSPFS/CPUD
          ZR     X1,PRS3     IF UNCONDITIONAL UPDATE NOT SELECTED
          SA1    /COMSPFS/STDT  SET TO UPDATE UTILITY CONTROL DATE
          BX6    X1
          SA6    UDAT
 
*         PROCESS INCREMENTAL LOAD PARAMETERS.
 
 PRS3     RJ     PCI         PROCESS CATALOG IMAGE
          RJ     IFL         INITIALIZE OUTPUT FILE FOR FILE PROCESSING
          SA1    CPAR+/COMSPFS/CPOP
          LX1    59-49
          PL     X1,PRSX     IF EXTRACT OPTION NOT SPECIFIED
          SA1    INCF
          SB2    EREC        * EXTRACT OPTION REQUIRES CIR.*
          ZR     X1,ABT      IF CATALOG IMAGE RECORD NOT PRESENT
          SA1    ACEA        SET END OF LOAD CONTROL WORD
          SX7    B1          SET CONTROL WORD RE-USE FLAG
          BX6    X1
          SA7    RCWF
          SA6    CWBF
          EQ     PRSX        RETURN
 
 
 PRSA     BSS    0           Y-COORDINATE TABLE
          KDL    *
 PRSC     VFD    36/,6/ODEBL,18/ODEB  POINTER TO *OD* EXT. BUFFER
          TITLE  PRESET SUBROUTINES.
 GAM      SPACE  4,20
**        GAM - GENERATE ACCOUNTING MESSAGES.
*
*         ENTRY  (MASK) = MASK OF MASTER DEVICES BEING LOADED.
*                (CPAR) = COMVERTED PARAMETER ARRAY.
*
*         EXIT   SELECTION PARAMETERS PUT IN ACCOUNTING MESSAGES.
*                APPROPRIATE ACCOUNTING MESSAGES ISSUED TO DAYFILE AND
*                OUTPUT FILE.
*
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 2, 5, 6, 7.
*
*         CALLS  COD, SFN.
*
*         MACROS EDATE, ETIME, MESSAGE, MOVE, WRITEH.
 
 
 GAM      SUBR               ENTRY/EXIT
 
*         PUT CORRECT DEVICE NUMBER IN MESSAGES.
 
          SA1    CPAR+/COMSPFS/CPDN
          SA2    CPAR+/COMSPFS/CPTD
          MX6    -6
          IX1    X1+X2
          BX1    -X6*X1      SET *DN* OR *TD* DEVICE NUMBER
          RJ     COD
          MX0    24
          SA5    MSGC+1
          BX5    X0*X5
          BX7    -X0*X6
          BX7    X7+X5
          SA7    A5          SET DEVICE NUMBER IN MESSAGE
 
*         PUT FAMILY/PACK NAME IN MESSAGES.
 
          SA5    CPAR+/COMSPFS/CPPN  SET PACKNAME PARAMETERS
          SA2    GAMM
          MX0    42
          BX1    X5
          NZ     X5,GAM3     IF PACKNAME SPECIFIED
          SA2    GAML        SET FAMILY NAME PARAMETERS
          SA1    CPAR+/COMSPFS/CPFN
 GAM3     LX6    X2
          BX1    X0*X1       PUT FAMILY/PACK NAME IN MESSAGE
          SA6    MSGC+2
          RJ     SFN
          ZR     X5,GAM4     IF PACKNAME NOT SPECIFIED
          SA1    GAMN        PUT PACKNAME IN MESSAGE
          BX7    X1
          SA7    A6-B1
 GAM4     BX6    X0*X6       ADD PERIOD TO NAME
          SX2    1L.
          BX1    -X0*X2
          BX6    X6+X1
          SA6    MSGC+3
          MESSAGE MSGC,,R
          WRITEH O,GAMJ,1
          WRITEH O,MSGC,4
          SA1    CPAR+/COMSPFS/CPUD
          ZR     X1,GAM5     IF UTILITY CONTROL UPDATE NOT REQUESTED
          WRITEH O,GAMO,4
 GAM5     SA5    CPAR+/COMSPFS/CPOP
          BX1    X5
          LX1    59-46
          PL     X1,GAM6     IF OP=Z NOT SPECIFIED
          WRITEH O,GAMP,4
 GAM6     MX0    2
          LX5    3
          SA1    GAMI
          BX5    X0*X5
          LX6    X1
          ZR     X5,GAM8     IF NOT INDIRECT OR DIRECT ONLY
          SA6    GAMK
          SX2    GAMH
          PL     X5,GAM7     IF DIRECT ONLY
          SX2    GAMG
 GAM7     MOVE   3,X2,GAMK+1
          WRITEH O,GAMK,4
 GAM8     SA5    CPAR+/COMSPFS/CPOP
          MX0    3
          BX5    X0*X5
          ZR     X5,GAM11    IF NO DATE OPTION SPECIFIED
          LX5    2
          SA2    X5+GAMD     LOAD *CREATED*, *ACCESSED*, OR *MODIFIED*
          SA5    CPAR+/COMSPFS/CPAD
          BX6    X2
          SA6    GAMK        SET DATE/TIME OPTION MESSAGE
          ZR     X5,GAM9     IF AFTER DATE NOT SPECIFIED
          SA2    GAMC
          BX1    X5
          AX1    18
          BX6    X2
          SA6    GAMK+1      SET *AFTER* IN MESSAGE
          EDATE  X1
          MX2    -18
          SA6    GAMK+2      SET DATE IN MESSAGE
          BX1    -X2*X5
          ETIME  X1
          SA6    GAMK+3      SET TIME IN MESSAGE
 GAM9     SA5    CPAR+/COMSPFS/CPBD
          ZR     X5,GAM10    IF BEFORE DATE NOT SPECIFIED
          SA2    GAMC+1
          BX6    X2
          SA6    A6+B1       SET *BEFORE* IN MESSAGE
          BX1    X5
          AX1    18
          SA0    A6+B1
          EDATE  X1
          MX2    -18
          SA6    A0          SET DATE IN MESSAGE
          BX1    -X2*X5
          SA0    A6+B1
          ETIME  X1
          SA6    A0          SET TIME IN MESSAGE
 GAM10    WRITEH O,GAMK,A6-GAMK+1
 GAM11    SA2    /COMSPFS/FISP
          ZR     X2,GAM12    IF NO FILE SELECTIONS
          MOVE   2,GAMB,GAMK *SELECTED FILES ON *
          SA1    CPAR+/COMSPFS/CPUI
          NZ     X1,GAM13    IF ONLY 1 USER INDEX
          MOVE   3,GAMQ,GAMK+2  * MULTIPLE USER INDICES*
          EQ     GAM14       WRITE MESSAGE
 
 GAM12    SA1    CPAR+/COMSPFS/CPUI
          ZR     X1,GAMX     IF NO USER INDEX SELECTED
          MOVE   2,GAMA,GAMK * ALL FILES FOR *
 GAM13    SA2    GAMF
          SA1    CPAR+/COMSPFS/CPUI
          BX6    X2
          SA6    GAMK+2      *USER INDEX*
          RJ     COD
          LX6    12
          SA6    A6+B1
          SA1    =10H
          BX6    X1
          SA6    GAMK+4
 GAM14    WRITEH O,GAMK,5
          EQ     GAMX        RETURN
 
 
 GAMA     DATA   20H ALL FILES FOR
 GAMB     DATA   20HSELECTED FILES ON
 GAMC     DATA   10H AFTER
          DATA   10H BEFORE
 GAMD     DATA   10H MODIFIED
          DATA   10H ACCESSED
          DATA   10H CREATED
 GAMF     DATA   10HUSER INDEX
 GAMG     DATA   30H INDIRECT ACCESS FILES ONLY
 GAMH     DATA   30H DIRECT ACCESS FILES ONLY
 GAMI     DATA   10H LOADING -
 GAMJ     DATA   10H1
 GAMK     DATA   40H
          DATA   30H
 GAML     DATA   10H  FAMILY
 GAMM     DATA   10H   PACK
 GAMN     DATA   10H   PACK
 GAMO     DATA   40H UPDATE UTILITY CONTROL DATE.
 GAMP     DATA   40H CLEAR ALTERNATE STORAGE INFORMATION.
 GAMQ     DATA   30H MULTIPLE USER INDICES
 PCI      SPACE  4,20
**        PCI - PROCESS CATALOG IMAGE RECORD.
*
*         EXIT   (RCWF) = SET IF A CONTROL WORD OTHER THAN FOR A
*                         CATALOG IMAGE RECORD WAS FOUND BEFORE
*                         EOF/EOI.
*                (INCF) = NON-ZERO IF CATALOG IMAGE FOUND AND NOT TO
*                         BE IGNORED.
*                CATALOG IMAGE COPIED TO SCRATCH FILE AND DIRECTORY
*                BUILT IF (INCF) IS NON-ZERO.
*                CATALOG IMAGE SKIPPED IF PRESENT AND (INCF) IS ZERO.
*                ARCHIVE FILE POSITIONED FOR PROCESSING FIRST RECORD
*                THAT IS NOT A CATALOG IMAGE RECORD.  THIS MAY BE AT
*                EOF/EOI.
*                EXIT TO *ABT* IF FATAL ERROR.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 2, 3.
*
*         CALLS  COD, ICI, KIP, OCI, PSI, RCW, SCI, SEM, SER.
*
*         MACROS CWREAD, MESSAGE, MOVE, WRITER, WRITEW.
 
 
 PCI14    RJ     SCI         SKIP CATALOG IMAGE
 
 PCI      SUBR               ENTRY/EXIT
          SA1    CPAR+/COMSPFS/CPOP
          LX1    59-48
          NG     X1,PCI14    IF OMIT *CIR* SPECIFIED
          RJ     RCW         READ ARCHIVE FILE CONTROL WORD
          NG     X3,PCI14    IF EOR/EOF/EOI OR READ ERROR
          SX1    X3-5
          ZR     X1,PCI0     IF CATALOG IMAGE RECORD
          SX6    B1          SET CONTROL WORD RE-USE FLAG
          SA6    RCWF
          EQ     PCIX        RETURN
 
*         INITIALIZE FOR INCREMENTAL LOAD.
 
 PCI0     SA1    TLBF+/COMSPFS/PFAL
          NZ     X1,PCI1     IF ARCHIVE FILE LABEL READ
          SB2    ERMI        * NO ARCHIVE LABEL ON INCREMENTAL LOAD...*
          EQ     ABT         ABORT
 
 PCI1     SX7    B1          SET INCREMENTAL LOAD FLAG
          BX6    X6-X6
          SA7    INCF
          SB2    CIRT        SET FWA TO CLEAR
          SB3    CIRT+CIRTL  SET LWA+1 TO CLEAR
 PCI2     SA6    B2          CLEAR WORD OF BUFFERS
          SB2    B2+B1
          LT     B2,B3,PCI2  IF NOT END OF BUFFERS
          RJ     ICI         INITIALIZE FOR OUTPUT OF CIR DATA
 PCI3     MESSAGE  MSCI,1    * CREATING CATALOG IMAGE RECORD*
          SA5    IDSA+/COMSPFS/ADMS
          MOVE   3,MSCI,X5
          BX6    X6-X6       CLEAR CATALOG TRACK WORD COUNT
          SA6    PCIB
 
*         COPY CATALOG IMAGE RECORD INFORMATION.
 
 PCI4     SA1    CWBF        SET BLOCK WORD COUNT
          MX2    -9
          BX0    -X2*X1
          LX1    0-48        CHECK IF NEW DEVICE
          MX2    -12
          BX3    -X2*X1
          LX1    0-36-0+48   SET CATALOG TRACK COUNT
          SX6    X3-2RCH
          NZ     X6,PCI5     IF NOT NEW DEVICE
          BX7    -X2*X1
          LX1    0-24-0+36   SET DEVICE MASK
          SA7    PCIE
          BX6    -X2*X1
          MX2    -24
          SA6    PCIF
          SA3    PCIC        SET DIRECTORY ADDRESS FOR NEXT DEVICE
          SX6    X3+NWCD
          BX7    -X2*X1      PUT DEVICE HEADER IN DIRECTORY
          SA6    A3
          SX2    X6-CIRT-NWCD*NDEV
          PL     X2,PCI10    IF TOO MANY DEVICES
          SA7    X6+
 PCI5     SA1    PCIC        CHECK FOR DEVICE HEADER
          SX2    X1-CIRT
          NG     X2,PCI10    IF NO DEVICE HEADER
          ZR     X0,PCI7     IF ZERO WORD COUNT
          CWREAD TAPE,TDBF,X0  READ CATALOG IMAGE BLOCK
          NZ     X7,PCI11    IF READ ERROR
          NZ     B7,PCI10    IF INCOMPLETE CATALOG IMAGE BLOCK
          WRITEW CIRF,TDBF,X0  COPY BLOCK TO SCRATCH FILE
          SA1    PCIB        INCREMENT WORD COUNT
          IX6    X1+X0
          SA6    A1
          NZ     X1,PCI6     IF NOT FIRST BLOCK
          SA1    PCIE        SET CATALOG TRACK MASK
          SA2    TDBF        GET USER INDEX
          SX6    X1-1
          LX2    0-3         SET CATALOG TRACK
          BX7    X6*X2
          SA7    PCID
 
*         WRITE CIR DATA TO SELECTED OUTPUT FILES.
 
 PCI6     SX6    TDBF        SET BUFFER ADDRESS
          SX7    X0          SET WORD COUNT
          RJ     OCI         OUTPUT CATALOG IMAGE ENTRIES
 
*         CHECK FOR EOR (END OF CATALOG TRACK).
 
 PCI7     SA2    CWBF        CHECK FOR EOR BLOCK
          MX0    -3
          LX2    0-9
          BX6    -X0*X2
          NZ     X6,PCI8     IF EOR BLOCK
          RJ     RCW         READ ARCHIVE FILE CONTROL WORD
          NZ     X7,PCI11    IF READ ERROR
          SX6    X3-5
          NZ     X6,PCI10    IF NOT CATALOG IMAGE CONTROL WORD
          EQ     PCI4        COPY MORE CATALOG IMAGE RECORD
 
*         SET DIRECTORY ENTRY.
 
 PCI8     SA1    PCIB
          ZR     X1,PCI9     IF AN EMPTY CATALOG TRACK
          SA2    CIFC        UPDATE TOTAL FILE COUNT
          AX3    X1,B1       FILE COUNT = WORD COUNT / 2
          IX6    X2+X3
          SA6    A2
          LX3    30          30/FILE COUNT, 30/RANDOM INDEX
          SA2    PCIA
          BX6    X3+X2
          AX1    6           SECTOR COUNT = WORD COUNT / 64 + 1
          SX7    B1
          IX0    X1+X7
          SA3    PCIC        GET DIRECTORY ADDRESS
          SA1    PCID        GET CATALOG TRACK
          IX7    X2+X0       UPDATE RANDOM INDEX
          SA7    A2
          IX3    X3+X1       SAVE DIRECTORY ENTRY
          SA6    X3+B1
          WRITER CIRF,R      FLUSH THIS CATALOG TRACK
 
*         PROCESS END OF CATALOG IMAGE RECORD.
 
 PCI9     RJ     RCW         READ ARCHIVE FILE CONTROL WORD
          NZ     X7,PCI11    IF READ ERROR
          SX6    X3-5
          ZR     X6,PCI3     IF CATALOG IMAGE RECORD
          NG     X1,PCI9.1   IF EOF/EOI
          NZ     X1,PCI9     IF EOR
          MESSAGE  (=C**),1  CLEAR CREATING CATALOG IMAGE MESSAGE
          SA5    IDSA+/COMSPFS/ADMS
          MOVE   3,BLNK,X5
          SX6    1           SET CONTROL WORD RE-USE FLAG
          SA6    RCWF
 PCI9.1   RJ     PSI         PROCESS SORTED CIR OUTPUT
          EQ     PCIX        RETURN
 
*         PROCESS CATALOG IMAGE RECORD FORMAT ERROR.
 
 PCI10    SB2    ERIF        * CATALOG IMAGE FORMAT ERROR.*
          EQ     ABT         ABORT
 
*         PROCESS CATALOG IMAGE RECORD READ ERROR.
 
 PCI11    SA7    AREF        INDICATE READ ERROR
          SA1    PCIF        PUT DEVICE MASK IN MESSAGE
          RJ     COD
          SA1    =1A.        ADD PERIOD TO MESSAGE
          LX6    30
          BX5    X1-X6
          SA1    PCID        PUT CATALOG TRACK IN MESSAGE
          RJ     COD
          LX6    6
          BX7    X6-X5
          SA7    ERIR+3
          SA5    IDSA+/COMSPFS/ADER  PUT MESSAGE ON *K* DISPLAY
          MOVE   4,ERIR,X5
          SB2    ERIR        *READ ERROR IN CATALOG IMAGE*
          RJ     SEM         SEND ERROR MESSAGE
          SB3    PCI12       SET *K.GO.* PROCESSOR ADDRESS
          SB2    PCI13       SET *K.ANYTHING ELSE.* PROCESSOR ADDRESS
          EQ     /COMSPFS/KIP  PROCESS KEYBOARD INPUT
 
*         PROCESS *K.GO.* RESPONSE TO READ ERROR.
 
 PCI12    RJ     SER         SKIP TO END OF RECORD
          EQ     PCI8        BUILD DIRECTORY ENTRY
 
 PCI13    SB2    B0          SET NO MESSAGE
          EQ     ABT         ABORT
 
 
 PCIA     CON    1           RANDOM INDEX FOR *CIR*
 PCIB     CON    0           CATALOG TRACK WORD COUNT
 PCIC     CON    CIRT-NWCD   CURRENT DIRECTORY ADDRESS
 PCID     CON    0           CURRENT CATALOG TRACK
 PCIE     CON    0           NUMBER OF CATALOG TRACKS FOR DEVICE
 PCIF     CON    0           DEVICE MASK BEING READ
 SMP      SPACE  4,20
**        SMP - SET MASTER DEVICE PARAMETERS.
*
*         ENTRY  (MSTBUF) = MST ENTRY OF DEVICE DESCRIBED BY
*                           PACKNAME PARAMETER.
*
*         EXIT   PACK NAME, UNIT COUNT AND EQUIPMENT MNEMONIC SET IN
*                  *PURG* FET IF AUXILIARY DEVICE BEING LOADED.
*                (DDMA) = DESTINATION DEVICE *MSTT* ADDRESS IF
*                  DESTINATION DEVICE SPECIFIED.
*                TO *ABT* IF DESTINATION DEVICE NOT FOUND.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 2, 3.
*
*         CALLS  SFD.
 
 
 SMP      SUBR               ENTRY/EXIT
 
*         INITIALIZE *PURG* FET FOR AUXILIARY DEVICE.
 
          SA1    CPAR+/COMSPFS/CPPN
          ZR     X1,SMP5     IF PACK NAME NOT SPECIFIED
          SA2    MSTBUF+DDLL SET UNIT COUNT
          MX3    -3
          LX2    12
          BX1    -X3*X2
          SA2    MSTT+1
          LX2    -18         SET EQUIPMENT MNEMONIC
          SX1    X1+B1
          MX3    -11
          BX6    X6+X1       MERGE UNIT COUNT WITH PACK NAME
          SA1    PURG+1      CLEAR OLD MNEMONIC FROM FET
          BX2    -X3*X2
          MX3    -48
          SA6    PURG+CFPK
          BX1    -X3*X1
          LX2    48          PUT MNEMONIC IN FET
          BX7    X2+X1
          SA7    A1
 
*         SET DESTINATION DEVICE *MSTT* ADDRESS.
 
 SMP5     SA2    CPAR+/COMSPFS/CPDD
          ZR     X2,SMPX     IF NO DESTINATION DEVICE
          BX6    X2
          RJ     SFD         SEARCH FOR DEVICE
          NZ     X1,SMP6     IF DEVICE FOUND
          SB2    ERDN        * DESTINATION DEVICE NOT FOUND.*
          EQ     ABT         ABORT
 
 SMP6     SX6    A1+         SET DESTINATION DEVICE *MSTT* ADDRESS
          SA6    DDMA
          EQ     SMPX        RETURN
 STC      SPACE  4,10
**        STC - SET TAPE CHARACTERISTICS.
*
*         EXIT   TAPE CHARACTERISTICS SET IN FET.
*
*         USES   X - 1, 2, 3, 4, 5, 6.
*                A - 1, 4, 5, 6.
*
*         MACROS FILINFO, RECALL, SETFS.
 
 
 STC      SUBR               ENTRY/EXIT
          RECALL TAPE
          MX1    42
          SA5    X2          SET ARCHIVE FILE NAME IN PARAMETER BLOCK
          SA4    STCA
          BX5    X1*X5
          SX4    X4
          BX6    X5+X4
          SA6    A4
          FILINFO  STCA      GET FILE INFORMATION
          SA1    STCA+1      GET TAPE DEVICE TYPE
          SA4    STCA+FIPBL  GET TAPE FORMAT
          LX1    59-24
          PL     X1,STC3     IF NOT TAPE FILE
          MX3    2
          LX1    59-26-59+24
          BX6    X3*X1       SET TAPE DEVICE TYPE
          SA5    A4+1        GET DENSITY, CONVERSION MODE, LABEL TYPE
          LX6    56-59
          LX4    -6
          MX1    -6
          LX5    -6
          BX4    -X1*X4      TAPE FORMAT
          BX2    -X1*X5      DENSITY AND CONVERSION MODE
          LX5    -6
          BX5    -X1*X5      LABEL TYPE
          LX4    30
          SA1    A5+1        GET PROCESSING OPTIONS
          BX6    X6+X4
          LX2    -12
          MX4    -12
          LX1    -12
          BX6    X6+X2
          SX2    7757B
          BX1    -X4*X1      PROCESSING OPTIONS
          BX1    X2*X1       CLEAR PO=W IF SELECTED
          SX2    /MTX/POGH*100B+/MTX/POLM*200B
          BX1    X1-X2       SET OPTIONS TO TOGGLE INSTALLATION BITS
          LX1    -24
          BX6    X6+X1
          ZR     X5,STC2     IF UNLABELED
          MX3    1
          LX3    58-59       SET LABELED TAPE BIT
          BX6    X6+X3
          SX5    X5-14B
          NZ     X5,STC2     IF STANDARD LABELS
          LX3    57-59-58+59 SET NONSTANDARD LABEL BIT
          BX6    X6+X3
 STC2     SA6    TAPE+LBWD   SET TAPE INFORMATION
 STC3     SETFS  TAPE,0      CLEAR SPECIAL FILE STATUS
          EQ     STCX        RETURN
 
 
 STCA     VFD    42/0,6/STCAL,12/1  *FILINFO* PARAMETER BLOCK
          BSS    FIPBL-1
          CON    FMTK        FORMAT KEYWORD
          CON    DENK        DENSITY, CONVERSION, LABEL TYPE KEYWORD
          CON    POPK        PROCESSING OPTIONS KEYWORD
 STCAL    EQU    *-STCA
          SPACE  4,10
*         PRESET MESSAGES.
 
 
 MSCI     DATA   30CCREATING CATALOG IMAGE RECORD
          SPACE  4,10
*         PRESET ERROR MESSAGES.
 
 
 ERDN     DATA   C* DESTINATION DEVICE NOT FOUND.*
 EREC     DATA   C* EXTRACT OPTION REQUIRES CIR.*
 ERIF     DATA   C* CATALOG IMAGE FORMAT ERROR.*
 ERIR     DATA   40C READ ERROR IN CATALOG IMAGE DM CT.
 ERMI     DATA   C* NO ARCHIVE LABEL ON INCREMENTAL LOAD FILE.*
 COMMON   SPACE  4,10
**        PRESET COMMON DECKS.
 
 
*CALL     COMCDCP
          LIST   X
*CALL     COMCPFP
          LIST   *
*CALL     COMCRSB
*CALL     COMCSOE
 
 PRK      HERE               ASSEMBLE Y-COORDINATE PRESET CODE HERE
          SPACE  4,10
*         PRESET BUFFERS.
 
 ESTADD   EQU    *           RSB PARAMETER WORD FOR EST
 ESTBUF   EQU    ESTADD+1    EST BUFFER
 MSTADD   EQU    ESTBUF+ESMX*ESTE  *RSB* PARAMETER WORD FOR MST READ
 MSTBUF   EQU    MSTADD+1    MST BUFFER
 DSTBUF   EQU    MSTBUF+MSTL
 PRSL     EQU    DSTBUF+2*63+2  PRESET LWA+1
 
          SPACE  4
          END