Retro1.org codex

RECLAIM

[00009] RECLAIM - PERMANENT FILE DUMP/LOAD UTILITY.
[00013] PERMANENT FILE DUMP/LOAD UTILITY.
[00444] *RECLAIM* DIRECTIVES.
[00613] DAYFILE MESSAGES.
[00829] COMMON DECKS.
[00846] ASSEMBLY CONSTANTS.
[00910] FILE FORMATS.
[01045] PROGRAMMING NOTES.
[01071] SYMBOL DEFINITIONS.
[01108] GENERAL MACRO DEFINITIONS.
[01112] ABORT - ABORT PROGRAM.
[01143] BREAK - PROCESS INTERACTIVE PROGRAM INTERRUPTS.
[01169] CLEAR - CLEAR FET POINTERS.
[01201] COPYBLK - COPY DATA INTO A DUMP TAPE BLOCK.
[01227] INDEX - GENERATE INDEXED TABLE WITH 4-WORD MESSAGES.
[01253] OPTION - EXPAND SELECTED DIRECTIVE KEYWORD.
[01311] MERGESORT MACRO DEFINITIONS.
[01315] REWRYTE - REWIND FILE AND PREPARE FOR WRITING.
[01336] RESET - REWIND FILE AND PREPARE FOR READING.
[01358] GETITEM - GET AN ITEM FROM A FILE.
[01382] PUTITEM - WRITE ITEM TO FILE.
[01405] COPITEM - COPY ITEM FROM ONE FILE TO ANOTHER.
[01429] COPYRUN - COPY RUN OF ENTRIES BETWEEN FILES.
[01451] ARGUMENT TABLES.
[01530] DIRECTIVES/OPTIONS TABLES.
[01596] OUTPUT HEADINGS.
[01632] VARIABLES.
[01765] ERROR MESSAGES.
[01776] MAIN LOOP.
[01778] MAIN - MAIN LOOP.
[01896] PROCESS *COMPACT* DIRECTIVE.
[01898] COMPACT - PROCESS *COMPACT* DIRECTIVE.
[02193] PROCESS *COPY* DIRECTIVE.
[02195] COPY - PROCESS *COPY* DIRECTIVE.
[02424] PROCESS *DELETE**RESET* DIRECTIVES.
[02653] PROCESS *DUMP* DIRECTIVE.
[02655] DUMP - PROCESS *DUMP* DIRECTIVE.
[02917] PROCESS *END* DIRECTIVE.
[02919] END - PROCESS *END* DIRECTIVE.
[02951] PROCESS *LIST* DIRECTIVE.
[02953] LIST - PROCESS *LIST* DIRECTIVE.
[03019] PROCESS *LOAD* DIRECTIVE.
[03021] LOAD - PROCESS *LOAD* DIRECTIVE.
[03036] PROCESS *REMOVE* DIRECTIVE.
[03038] REMOVE - PROCESS *REMOVE* DIRECTIVE.
[03085] PROCESS *SET* DIRECTIVE.
[03087] SET - PROCESS *SET* DIRECTIVE.
[03144] PROCESS *UPDATE* DIRECTIVE.
[03146] UPDATE - PROCESS *UPDATE* DIRECTIVE.
[03164] PRIMARY SUBROUTINES.
[03166] ABT - ABORT PROCESSING.
[03264] ADB - ATTACH DATABASE.
[03423] BTF - BUILD TAPE FLAGS.
[03533] CBR - COPY BINARY RECORD.
[03594] CDF - CREATE DATABASE FILE.
[03808] CDR - CREATE DATABASE RECORD.
[03890] CEI - COPY A FILE TO END-OF-INFORMATION.
[03965] CFJ - CONVERT FROM JULIAN (BINARY) TO DISPLAY *YYMMDD*.
[04058] COE - CALCULATE OPLD ENTRY.
[04098] CRF - CHECK RESERVED FILE NAMES.
[04155] CRI - CRITERIA CHECKER.
[04490] CTF - COPY *PFDUMP* FILE TO DISK AND REMOVE CONTROL WORDS.
[04918] CTJ - CONVERT DISPLAY DATE TO BINARY JULIAN DATE.
[04991] CUP - CLEAN UP AFTER DIRECTIVE PROCESSING.
[05149] CVH - CHECK FOR VALID DUMP HEADER.
[05192] CVP - CONVERT PARAMETERS.
[05532] CVS - CHECK VSN FOR SCRATCH.
[05572] CVT - CHECK FOR VALID DUMP TAPE.
[05622] DFT - DUMP FILE TO TAPE.
[05935] IMI - ISSUE MESSAGE INSERTING NAME.
[05969] ILC - INCREMENT LINE COUNT.
[05987] LCV - LOCATE CURRENT VSN AND REQUEST DUMP INPUT TAPE.
[06129] LEF - LOCATE EXISTING TAPE FLAGS.
[06176] LVI - LOCATE VSN INDEX
[06208] MDL - MAKE DUMP FILE LOCAL.
[06348] MFP - MAKE FILE PERMANENT.
[06493] PBC - PROCESS BREAK CONDITION.
[06506] PDB - POSITION DATA BASE.
[06649] PDF - POSITION DUMP FILE.
[06736] PFN - PROCESS FILE NAMES.
[06857] POT - PROCESS OUTPUT.
[06993] PPB - PROCESS PERMIT BLOCK.
[07045] PPF - PROCESS PERMANENT FILES.
[07115] PRH - PRINT HEADER.
[07177] PVZ - PAD VSN WITH CHARACTER *0*.
[07235] RDB - READ DATABASE.
[07343] RDU - READ *UPDATES* FILE.
[07370] RNT - REQUEST NEW TAPE.
[07565] ROD - REQUEST OUTPUT DUMP.
[07696] RPI - REPRIEVE INTERFACE.
[07742] SBU - SORT BY USER.
[07866] SDE - SORT DATABASE RECORDS.
[07959] SFC - SET FILE COUNT.
[07975] SRT - MERGE SORT OF 6-WORD ENTRIES.
[08022] UDV - UPDATE DUMP VSNS IN DATABASE
[08063] UFV - UPDATE FET VSN
[08110] UII - UPDATE FOR INITIAL VSN INDEX RECORD.
[08163] UPD - UPDATE DATABASE.
[08534] WOR - WRITE OPLD RECORD.
[08590] WRB - WRITE PARTIAL TAPE BLOCK.
[08654] WRS - WRITE SECTOR BOUNDED BY CONTROL WORDS.
[08679] SECONDARY SUBROUTINES.
[08681] CIT - COPY ONE ITEM FROM ONE FILE TO ANOTHER.
[08724] CRN - COPY RUN OF ENTRIES BETWEEN FILES.
[08756] DTR - DISTRIBUTE RUNS FROM C ONTO A AND B.
[08781] GIT - GET AN ITEM FROM A FILE.
[08809] MRG - MERGE PHASE OF MERGESORT.
[08868] MRN - MERGE ONE RUN FROM A AND B ONTO C.
[08910] PIT - WRITE AN ITEM TO A FILE.
[08922] RST - REWIND FILE AND PREPARE FOR READING.
[08946] RWR - REWIND FILE AND PREPARE FOR WRITING.
[08964] COMMON DECKS.
[08993] FETS AND BUFFERS.
[09069] PRS - PRESET ROUTINES.
[09072] PRS - PRESET PROGRAM.
[09336] OPTIONS.
Source Code

          IDENT  RECLAIM,ORIG
          ABS
          SST
          ENTRY  RECLAIM
          ENTRY  RFL=
          ENTRY  SDM=
          SYSCOM B1
          LIST   F
          TITLE  RECLAIM - PERMANENT FILE DUMP/LOAD UTILITY.
*COMMENT  RECLAIM - PERMANENT FILE DUMP/LOAD UTILITY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 RECLAIM  SPACE  4,10
***       RECLAIM - PERMANENT FILE DUMP/LOAD UTILITY.
*
*         J. L. COURTNEY.    81/11/23.
*         R. G. UPTON.       80/10/01.
*         J. G. HAMBLETON.   79/11/01.
*         R. L. LAMEY.       78/09/01.
          SPACE  4,10
***       *RECLAIM* IS A UTILITY WHICH ENABLES USER TO EASILY PROVIDE
*         MAGNETIC TAPE BACKUP FOR PERMANENT FILES AS WELL AS MAINTAIN
*         GREATER CONTROL OVER THE SIZE OF THEIR PERMANENT FILE DISK
*         SPACE.  THE DUMPED FILES CAN THEN LATER BE LOADED AS
*         PERMANENT FILES OR AS LOCAL FILES.
*
*         INFORMATION ABOUT DUMPED FILES IS KEPT IN A DIRECT ACCESS
*         FILE DATABASE IN THE USER CATALOG.  THIS DATABASE STORES
*         EACH FILE TYPE (IA OR DA), USER NAME, TAPE VSN WHERE IT WAS
*         DUMPED, POSITION ON THE TAPE, AND DATE IT WAS DUMPED.
          SPACE  4,20
***       COMMAND FORMAT.
*
*
*         RECLAIM(P1,P2...PN)
*                OR
*         RECLAIM(P1,P2...PN)/KW,OP1...OPN./KW,OP1...OPN./KW,OP1...OPN.
*
*
*         *P* MAY BE ONE OF THE FOLLOWING -
*
*         PARAMETER          DESCRIPTION
*         ---------          -----------
*
*         DB=PFN             NAME OF THE DIRECT ACCESS FILE CONTAINING
*                            THE *RECLAIM* DATABASE.  DEFAULT NAME
*                            IS *RECLDB*.
*
*         I=LFN              NAME OF THE LOCAL FILE CONTAINING
*                            USER INPUT DIRECTIVES.  DEFAULT NAME
*                            IS *INPUT*.
*
*         L=LFN              LIST OUTPUT FILE NAME.  DEFAULT NAME
*                            IS *OUTPUT*.
*
*         NA                 PREVENTS *RECLAIM* FROM ABORTING IN CASE
*                            OF PROGRAM ERROR.  IF OMITTED *RECLAIM*
*                            WILL ABORT WHEN AN ERROR OCCURS.
*
*         NH                 INHIBITS *RECLAIM* FROM PRINTING A HEADER
*                            IN THE OUTPUT FILE.  A HEADER IS PRINTED
*                            IF THIS OPTION IS OMITTED.
*
*         NV                 PREVENTS *RECLAIM* FROM VALIDATING THAT A
*                            RECLAIM DUMP EXISTS ON A DUMP FILE BEING
*                            WRITTEN AT END-OF-INFORMATION.  ALLOWS A
*                            RECLAIM DUMP TO BE WRITTEN TO ANY FILE.
*
*         PN=PACKNAM         OPTIONAL PACK NAME FOR THE DATABASE FILE.
*
*         PW=PASSWRD         OPTIONAL PASSWORD FOR THE DATABASE FILE.
*
*         R=DEVTYPE          OPTIONAL RESIDENCE DEVICE TYPE FOR THE
*                            DATABASE FILE.  USED ALONG WITH THE *PN*
*                            PARAMETER.  IF NOT SPECIFIED, THE SYSTEM
*                            DEFAULT DEVICE TYPE WILL BE USED.
*
*         S                  INDICATES THE SITE-MAINTAINED DATABASE IS
*                            TO BE USED RATHER THAN A USER DATABASE.
*                            USER DATABASE IS ASSUMED BY DEFAULT.
*
*         T=LFN              TAPE NUMBER FILE.  DEFAULT NAME IS
*                            *NUMBERS*.
*
*         UN=USERNAM         OPTIONAL ALTERNATE USER NAME WHERE THE
*                            DATABASE RESIDES.
*
*         Z                  INDICATES DIRECTIVES ARE TO BE TAKEN FROM
*                            COMMAND LINE.  DEFAULT IS FROM *INPUT*.
*
*                            RECLAIM(...Z...)/DIR./DIR./DIR.
*                                      / IS ANY CHARACTER NOT IN *DIR*.
          SPACE  4,20
***       *KW*  MAY BE ONE OF THE FOLLOWING -
*
*
*         *KW*     DESCRIPTION
*         ----     -----------
*
*
*         COMPACT  REMOVES DELETED OR UNSELECTED FILES FROM A
*                  DUMP TAPE.
*
*         COPY     LOADS TO LOCAL FILES ALL FILES MEETING THE CRITERIA
*                  SPECIFIED BY THE OPTIONS FOLLOWING THE KEYWORD.
*
*         DELETE   DISABLES ALL FILES MEETING THE SPECIFIED CRITERIA.
*
*         DUMP     DUMPS TO TAPE ALL FILES MEETING THE SPECIFIED
*                  CRITERIA.
*
*         END      ENDS *RECLAIM* PROCESSING.
*
*         LIST     LISTS THE NAMES OF ALL PERMANENT FILES MEETING THE
*                  SPECIFIED CRITERIA.
*
*         LOAD     LOADS ALL OF THE TAPE FILES MEETING THE SPECIFIED
*                  CRITERIA.
*
*         REMOVE   PERMANENTLY REMOVES A TAPE VSN FROM THE DATABASE.
*
*         RESET    RESTORES FILES MEETING THE SPECIFIED CRITERIA WHICH
*                  WERE PREVIOUSLY DISABLED BY THE *DELETE* DIRECTIVE.
*
*         SET      REDEFINES THE *RECLAIM* DIRECTIVE OPTION DEFAULTS.
*
*         UPDATE   UPDATE THE *RECLAIM* DATABASE.
*
*
*         SEE *RECLAIM* DIRECTIVES DESCRIPTIONS BELOW FOR DETAILS.
          SPACE  4,20
***       *OPN* MAY BE ANY OF THE FOLLOWING -
*
*
*         *OP*               DESCRIPTION
*         ----               -----------
*
*
*         AA=YYMMDD          PROCESS ONLY FILES ACCESSED AFTER YYMMDD.
*                            USEFUL FOR *DUMP*.  IF *DB=0*, THEN USABLE
*                            ALSO FOR *COPY*, *LIST* AND *LOAD*.
*
*         AB=YYMMDD          PROCESS ONLY FILES ACCESSED BEFORE YYMMDD.
*                            USEFUL FOR *DUMP*.  IF *DB=0*, THEN USABLE
*                            ALSO FOR *COPY*, *LIST* AND *LOAD*.
*
*         AD=YYMMDD          PROCESS ONLY FILES ACCESSED ON YYMMDD.
*                            USEFUL FOR *DUMP*.  IF *DB=0*, THEN USABLE
*                            ALSO FOR *COPY*, *LIST* AND *LOAD*.
*
*         AS=ASOP            SPECIFIES WHETHER TO PRESERVE PERMANENT
*                            FILE CATALOG DATA RELATING TO CARTRIDGE
*                            AND TAPE ALTERNATE STORAGE.  *ASOP* MAY BE
*                            *Y* OR *N*.  IF *AS* IS OMITTED, *ASOP*
*                            DEFAULTS TO *N*.  IF SPECIFIED WITHOUT AN
*                            EQUIVALENCE, *ASOP* IS ASSUMED TO BE *Y*.
*                            THE *AS* OPTION IS USEFUL ONLY WHERE A
*                            *RECLAIM* DUMP TAPE WILL BE PROCESSED BY
*                            THE *NOS* UTILITY *PFLOAD*.
*                            USED ONLY WITH THE *DUMP* DIRECTIVE.
*
*         CF=CLFN            SPECIFIES THE LOCAL FILE NAME TO BE USED
*                            FOR THE COMPACTED DUMP.  IF *CF* IS
*                            OMITTED, THE LFN IS THE NAME SPECIFIED BY
*                            THE *CN* OPTION.  IF THE *CN* OPTION IS
*                            OMITTED, THE LFN *NTAPE* IS USED.
*                            USED WITH THE *COMPACT* DIRECTIVE.
*
*         CN=CPFN            NAME BY WHICH THE COMPACTED DUMP WILL
*                            BE IDENTIFIED IN THE DATABASE IF THE
*                            ORIGINAL DUMP FILE IS NOT OVERWRITTEN.
*                            ALSO THE PERMANENT FILE NAME THAT WILL
*                            BE USED FOR LATER REFERENCES BY *RECLAIM*
*                            TO THE FILE.  THIS OPTION DOES NOT SAVE,
*                            REPLACE OR DEFINE THE PERMANENT FILE; THAT
*                            IS THE RESPONSIBILITY OF THE USER.
*                            USED WITH THE *COMPACT* DIRECTIVE.
*
*         CT=VSN             COMPACTED TAPE VSN.  USED WITH *COMPACT*.
*
*         D=DEN              SPECIFIES TAPE DENSITY WHEN REQUESTING A
*                            DUMP.  ACCEPTABLE VALUES ARE:
*
*                            LO -  7-TRACK REEL TAPE, 200 BPI.
*                            HI -  7-TRACK REEL TAPE, 556 BPI.
*                            HY -  7-TRACK REEL TAPE, 800 BPI.
*                            HD -  9-TRACK REEL TAPE, 800 CPI.
*                            PE -  9-TRACK REEL TAPE, 1600 CPI.
*                            GE -  9-TRACK REEL TAPE, 6250 CPI.
*                            CE -  CARTRIDGE TAPE, 38000 CPI.
*                            AE -  ACS CARTRIDGE TAPE, 38000 CPI.
*
*         DA=YYMMDD          PROCESS ONLY FILES DUMPED AFTER *YYMMDD*.
*
*         DB=YYMMDD          PROCESS ONLY FILES DUMPED BEFORE *YYMMDD*.
*
*         DD=YYMMDD          PROCESS ONLY FILES DUMPED ON *YYMMDD*.
*
*         DE                 PROCESS ONLY DELETED FILES.  DEFAULT IS
*                            UNDELETED FILES.
*
*         DF=DLFN            SPECIFIES THE LOCAL FILE NAME TO BE USED
*                            FOR THE DUMP FILE.  IF *DF* IS OMITTED,
*                            THE LFN IS THE NAME SPECIFIED ON THE *DN*
*                            OPTION.  IF THE *DN* OPTION IS OMITTED,
*                            THE LFN *TAPE* IS USED.  MAY BE USED WITH
*                            *COMPACT*, *COPY*, *DUMP*, *LOAD* OR ANY
*                            DIRECTIVE THAT REQUIRES A DUMP TO BE READ
*                            OR WRITTEN.  FOR *COMPACT*, APPLIES TO THE
*                            ORIGINAL DUMP.
*
*         DN=DPFN            NAME BY WHICH THE DUMP FILE IS IDENTIFIED
*                            IN THE DATABASE.  FOR A MASS STORAGE DUMP,
*                            THE PERMANENT FILE NAME USED BY *RECLAIM*
*                            TO ACCESS THE DUMP FILE.  THIS OPTION DOES
*                            NOT SAVE, REPLACE OR DEFINE THE PERMANENT
*                            FILE; THAT IS THE RESPONSIBILITY OF THE
*                            USER.  THE *DN* OPTION IS LOGICALLY THE
*                            EQUIVALENT OF AND INTERCHANGEABLE WITH THE
*                            *TN* OPTION, EXCEPT THAT IF NO *DT*, *MT*
*                            OR *NT* OPTION IS SPECIFIED, A *DN* OPTION
*                            IMPLIES A MASS STORAGE DUMP WHILE A *TN*
*                            OPTION IMPLIES A TAPE DUMP.
*                            USED WITH THE *COMPACT*, *COPY*, *DELETE*,
*                            *DUMP*, *LIST*, *LOAD* AND *RESET*
*                            DIRECTIVES.
*
*         DT=DTYPE           SPECIFIES THE RESIDENCY OF THE DUMP FILE
*                            BEING REFERENCED.  ACCEPTABLE VALUES ARE:
*
*                            MS -  MASS STORAGE (DISK).
*                            MT -  7-TRACK MAGNETIC TAPE - EQUIVALENT
*                                  TO USING THE OBSOLETE *MT* OPTION.
*                            NT -  9-TRACK MAGNETIC TAPE - EQUIVALENT
*                                  TO USING THE OBSOLETE *NT* OPTION,
*                                  AND THE DEFAULT VALUE FOR *DTYPE*.
*                            CT -  CARTRIDGE TAPE.
*                            AT -  ACS CARTRIDGE TAPE.
*
*                            USED WITH THE *COMPACT*, *COPY*, *DELETE*,
*                            *DUMP*, *LIST*, *LOAD* AND *RESET*
*                            DIRECTIVES.
*
*         EI                 WRITE DUMPED FILES AT EOI ON THE TAPE.
*                            THIS OPTION IS SELECTED BY DEFAULT FOR
*                            THE *DUMP* DIRECTIVE.
*                            USED WITH *DUMP* AND *COMPACT* DIRECTIVES.
*
*         EI=NO              WRITE DUMPED FILES OVER ANY EXISTING
*                            FILES ON THE TAPE.  THIS OPTION IS
*                            SELECTED BY DEFAULT FOR THE *COMPACT*
*                            DIRECTIVE.
*                            USED WITH *DUMP* AND *COMPACT* DIRECTIVES.
*
*         EI=YES             WRITE DUMPED FILES AT EOI ON THE TAPE.
*                            SAME AS UNEQUIVALENCED *EI*.
*
*         EX=EXOP            SPECIFIES THE USE OF EXCEPTION PROCESSING
*                            FOR THE CURRENT *RECLAIM* DIRECTIVE.  THE
*                            ACCEPTABLE VALUES ARE *Y* AND *N*.  IF THE
*                            *EX* OPTION IS OMITTED, *EX=N* IS ASSUMED.
*                            *EX=N* INDICATES NORMAL PROCESSING, THAT
*                            ONLY FILES MEETING ALL SELECTION CRITERIA
*                            ARE PROCESSED.  *EX=Y* INDICATES THAT ONLY
*                            FILES *FAILING* TO MEET ALL THE SELECTION
*                            CRITERIA ARE TO BE PROCESSED.
*                            USED WITH THE *COMPACT*, *COPY*, *DELETE*,
*                            *DUMP*, *LIST*, *LOAD* AND *RESET*
*                            DIRECTIVES.
*
*         F=FORMAT           FORMAT OF USER TAPE.  USED WHEN REQUESTING
*                            A DUMP.  ACCEPTABLE VALUES ARE:
*
*                            I  -  INTERNAL FORMAT (DEFAULT).
*                            SI -  SYSTEM INTERNAL FORMAT (NOS/BE).
*                            F  -  FOREIGN FORMAT.
*                            S  -  STRANGER FORMAT.
*                            L  -  LONG BLOCK STRANGER FORMAT.
*                            LI -  LONG BLOCK INTERNAL FORMAT.
*
*         FI=NN              FILE POSITION ON TAPE.  IF OMITTED THIS
*                            WILL NOT BE A PROCESSING CRITERION.
*
*         FN=FILENAME        SAME AS THE *PF* OPTION EXCEPT THAT WHEN
*                            USED WITH THE *DUMP* DIRECTIVE, *RECLAIM*
*                            FIRST CHECKS TO SEE IF THE FILE IS LOCAL,
*                            AND IF SO DUMPS THE LOCAL FILE.
*                            THE *TY* OPTION CAN BE USED WITH THE *FN*
*                            OPTION TO SPECIFY WHETHER THE NAMED LOCAL
*                            FILES ARE TO BE DUMPED AS IF THEY WERE
*                            DIRECT OR INDIRECT ACCESS PERMANENT FILES.
*                            THE DEFAULT IS DIRECT ACCESS.
*                            USED WITH THE *COMPACT*, *COPY*, *DELETE*,
*                            *DUMP*, *LIST*, *LOAD* AND *RESET*
*                            DIRECTIVES.  FOR ALL EXCEPT THE *DUMP*
*                            DIRECTIVE, THE *FN* AND *PF* OPTIONS ARE
*                            INTERCHANGEABLE.  IF BOTH THE *FN* AND THE
*                            *PF* OPTIONS ARE OMITTED, THE FILES TO BE
*                            PROCESSED ARE DETERMINED BY OTHER OPTIONS.
*
*         FT                 THE DUMP TAPE BEING REQUESTED IS *FOREIGN*
*                            IN THAT IT IS NOT KNOWN TO THE NOS TAPE
*                            MANAGEMENT SUBSYSTEM (TMS).  *FT* CAN BE
*                            USED ONLY WHEN *TMS* IS ACTIVE.  USED WITH
*                            THE *COMPACT*, *COPY*, *DUMP*, *LIST* AND
*                            *LOAD* DIRECTIVES.
*
*         GT=NNNN            PROCESS ONLY FILES WITH LENGTH GREATER
*                            THAN *NNNN* PRUS.
*
*         LT=NNNN            PROCESS ONLY FILES WITH LENGTH LESS
*                            THAN *NNNN* PRUS.
*
*         LV                 PROCESS LATEST VERSION OF THE FILE (MOST
*                            RECENT DUMP DATE).  DEFAULT IS THE LATEST
*                            VERSION FOR THE *LOAD* DIRECTIVE.
*
*         MA=YYMMDD          PROCESS ONLY FILES MODIFIED AFTER YYMMDD.
*
*         MB=YYMMDD          PROCESS ONLY FILES MODIFED BEFORE YYMMDD.
*
*         MD=YYMMDD          PROCESS ONLY FILES MODIFED ON YYMMDD.
*
*         MT                 SPECIFIES THE USE OF A 7-TRACK TAPE. THIS
*                            IS AN OBSOLETE FORM AND SHOULD NO LONGER
*                            BE USED.  *DT=MT* SHOULD BE USED INSTEAD.
*                            USED ONLY WITH THE *DUMP* DIRECTIVE.
*
*         NA                 NO ABORT OPTION.  DO NOT ABORT IF ANY OF
*                            THE FILES SPECIFIED WITH THIS DIRECTIVE
*                            ARE NOT FOUND.  NOTE THAT ANY ERROR OTHER
*                            THAN A *FILE NOT FOUND* WILL STILL CAUSE
*                            *RECLAIM* TO ABORT UNLESS THE *NA* COMMAND
*                            PARAMETER IS ALSO SPECIFIED.
*
*         NF=NNN             NUMBER OF FILES (VERSIONS) TO PROCESS.
*                            THE *LIST* OPTION ASSUMES AN UNLIMITED
*                            NUMBER OF FILES.  ALL OTHER OPTIONS
*                            DEFAULT TO NF=1.
*
*         NN=PFN             SPECIFIES THE NEW NAME OF A FILE PROCESSED
*                            BY *DUMP*, *LOAD* AND *COPY* DIRECTIVES.
*                            ALLOWS MULTIPLE LOADS OF THE SAME FILE AND
*                            DUMPING, LOADING OR COPYING TO A DIFFERENT
*                            FILE NAME.
*
*         NT                 SPECIFIES THE USE OF A 9-TRACK TAPE. THIS
*                            IS AN OBSOLETE FORM AND SHOULD NO LONGER
*                            BE USED.  *DT=NT* SHOULD BE USED INSTEAD.
*                            USED ONLY WITH THE *DUMP* DIRECTIVE.
*
*         OV                 OVERWRITE OLD DUMP TAPE WITH COMPRESSED
*                            DUMP.  USED WITH *COMPACT* DIRECTIVE.
*
*         PO=X               FORCES SPECIFIED STANDARD NOS PROCESSING
*                            OPTION X FOR TAPE REQUEST.  OPTIONS *I*,
*                            *P* AND *S* ARE NOT ACCEPTED BY *RECLAIM*.
*
*         PF=PFN             SPECIFIES PERMANENT FILE NAME PFN TO BE
*                            PROCESSED BY *RECLAIM*.  IF OMITTED ALL
*                            FILES MEETING THE OTHER SELECTION CRITERIA
*                            ARE PROCESSED.
*
*         PF=*               INDICATES A LIST OF PERMANENT FILE NAMES
*                            TO BE SPECIFIED BY THE USER WILL FOLLOW.
*                            UP TO 999 FILE NAMES MAY BE ENTERED.
*                            *RECLAIM* PROMPTS INTERACTIVE USERS FOR
*                            THE LIST OF FILE NAMES.  BATCH JOBS
*                            SPECIFY THE NAMES AS THE FOLLOWING LINE(S)
*                            ON THE *INPUT* FILE.  NAMES MAY BE OF THE
*                            FORM *PFN1,PFN2,PFN3...* OR OF THE FORM
*                            *NEW1=PFN1,PFN2,NEW3=PFN3...*, WHERE
*                            *NEW* IS THE NEW NAME TO BE APPLIED TO THE
*                            FILE ON THE LOAD OR DUMP (SEE *NN* ABOVE).
*
*         PW=PASSWORD        INDICATES THE *TMS* PASSWORD REQUIRED TO
*                            ACCESS THE REQUESTED DUMP TAPE.  USED ONLY
*                            WHEN *TMS* IS ACTIVE IN THE NOS SYSTEM AND
*                            THE *FT* OPTION IS NOT SELECTED.  CAN BE
*                            USED WITH THE *COMPACT*, *COPY*, *DUMP*,
*                            *LIST* AND *LOAD* DIRECTIVES.
*
*         RC=NNNN            RECORD NUMBER ON TAPE.  USED IN
*                            CONJUNCTION WITH *FI*.  IF OMITTED IT IS
*                            NOT USED AS A CRITERION FOR PROCESSING.
*
*         RP=RPOP            SPECIFIES WHETHER AND HOW A FILE IS TO BE
*                            LOADED/COPIED FROM A DUMP FILE IF A LOCAL
*                            OR PERMANENT FILE BY THE SAME NAME ALREADY
*                            EXISTS.  ACCEPTABLE VALUES FOR *RPOP* ARE
*                            *Y*, *N* AND *C*.  *RP* SPECIFIED ALONE IS
*                            THE SAME AS IF *RP=Y* HAD BEEN SPECIFIED.
*                            WHEN USED WITH THE *COPY* DIRECTIVE, *RP*
*                            OR *RP=Y* SPECIFIES THAT A LOCAL FILE OF
*                            THE SAME NAME AS THE FILE BEING COPIED
*                            WILL BE REWOUND BEFORE BEING OVERWRITTEN,
*                            WHILE *RP=C* MEANS THAT THE COPY WILL BE
*                            DONE AT THE CURRENT LOCATION.  IF *RP* IS
*                            OMITTED OR *RP=N* IS SPECIFIED, A LOCAL
*                            FILE WITH THE SAME NAME WILL BE RETURNED
*                            PRIOR TO COPYING FROM THE DUMP FILE.
*                            USED WITH *COPY* AND *LOAD* DIRECTIVES.
*
*         RS=FILERES         SPECIFIES THE ACCEPTABLE RESIDENCE(S) FOR
*                            FILES TO BE DUMPED.  *FILERES* VALUES ARE
*                            *C* FOR CARTRIDGE, *D* FOR DISK AND *T*
*                            FOR TAPE.  MORE THAN ONE RESIDENCE CAN BE
*                            SPECIFIED BY CONCATENATING THE LETTERS
*                            FOR THE DESIRED RESIDENCES.  FOR EXAMPLE,
*                            *RS=CD* WOULD SELECT THOSE FILES RESIDENT
*                            ON EITHER DISK OR CARTRIDGE.  IF OMITTED
*                            OR SPECIFIED WITHOUT A VALUE, ANY FILE
*                            RESIDENCE IS CONSIDERED ACCEPTABLE.
*                            USED ONLY WITH THE *DUMP* DIRECTIVE.
*
*         TN=VSN             PROCESSES ONLY FILES FROM THE SPECIFIED
*                            TAPE NUMBER.  FOR THE *COPY*, *LIST* AND
*                            *LOAD* DIRECTIVES, IF THE TAPE IS NOT IN
*                            THE USER DATABASE *RECLAIM* WILL REQUEST
*                            THE TAPE AND TRY TO ADD APPROPRIATE
*                            INFORMATION TO THE DATBASE, BASED ON THE
*                            FILES PREVIOUSLY DUMPED TO THIS TAPE.
*                            THIS ALLOWS THE USER TO RECOVER AT LEAST
*                            SOME PORTIONS OF THE DATABASE IF IT IS
*                            DESTROYED OR PURGED.
*
*         TO=USERNAME        INDICATES THE USERNAME OF THE OWNER OF THE
*                            DUMP TAPE BEING REQUESTED.  USED ONLY WHEN
*                            *TMS* IS ACTIVE IN THE NOS SYSTEM AND THE
*                            *FT* OPTION IS NOT SELECTED.  CAN BE USED
*                            WITH THE *COMPACT*, *COPY*, *DUMP*, *LIST*
*                            AND *LOAD* DIRECTIVES.
*
*         TY=T               FILE TYPE(S) TO BE PROCESSED.  *D* OR *I*.
*                            DEFAULT IS BOTH FILE TYPES.
*
*         UN=USERNAM         PROCESS ONLY FILES FOR SPECIFIED USER
*                            NAME.  THIS OPTION IS USED WHEN DUMPED
*                            FILES ARE SHARED AMONG TWO OR MORE
*                            USER NAMES.  WHEN OMITTED, PROCESSING IS
*                            PERFORMED ON THE DUMPED FILES FOR THE
*                            CALLING USER.  *UN* VALUE OF *0* INDICATES
*                            ALL USER NAMES TO BE PROCESSED (E.G., BY
*                            THE *LIST* DIRECTIVE).
          TITLE  *RECLAIM* DIRECTIVES.
          SPACE  4,20
***       *RECLAIM* DIRECTIVES.
*
*
*         *RECLAIM* IS A GENERAL PURPOSE PERMANENT FILE RETRIEVAL
*         SYSTEM WHICH ALLOWS VARIOUS TYPES OF FILE MANIPULATION
*         AND INTERROGATION BY EMPLOYING ONE OR MORE OF THE
*         FOLLOWING DIRECTIVES (*?* IS A TERMINAL INPUT PROMPT)--
*
*
*
*         COMPACT.
*
*         THE *COMPACT* DIRECTIVE ALLOWS THE USER TO PERMANENTLY
*         REMOVE UNWANTED FILES FROM A GIVEN DUMP TAPE.  FIRST
*         THE USER LOGICALLY TURNS OFF THE UNNEEDED FILES WITH THE
*         *DELETE* DIRECTIVE.  THEN THE USER ISSUES A *COMPACT*
*         TO PHYSICALLY REMOVE THE FILES FROM THE DUMP TAPE.  THE USER
*         HAS THE OPTION OF WRITING THE SHORTENED DUMP OVER THE OLD
*         TAPE OR CREATING A NEW TAPE.
*
*                RECLAIM.
*                ? DELETE,TN=123456,FI=1,NF=999999.
*                ? COMPACT,TN=123456,OV.
*
*         WILL DELETE ALL THE DUMPED FILES ON THE FIRST FILE OF TAPE
*         *123456*, AND THEN REMOVE THEM FROM THE TAPE.  WRITES THE
*         DUMP OVER THE OLD TAPE.  IF OTHER FILE SELECTION CRITERIA
*         ARE SPECIFIED (E.G., *LV*, *DD*, ETC.), ONLY FILES SATISFYING
*         THOSE CRITERIA WILL BE RETAINED--ALL DELETED FILES AND FILES
*         NOT FULFILLING THE SELECTION CRITERIA WILL BE REMOVED.  IF
*         NO FILES MEET THE CRITERIA, NO ACTION WILL OCCUR (*COMPACT*
*         OF A VSN CONTAINING ONLY DELETED FILES WILL DO NOTHING).
*
*
*
*         COPY.
*
*         THIS OPTION ALLOWS USERS TO COPY ONE OR MORE OF THEIR FILES
*         DIRECTLY FROM TAPE TO A LOCAL FILE.  THE COPIED FILES ARE
*         LOADED TO THE SAME LOGICAL FILE NAMES AS THEIR ORIGINAL
*         PERMANENT FILE NAMES.
*
*                RECLAIM(Z)/COPY,LV,NF=7,DD=YYMMDD.
*
*         COPIES TO LOCAL FILES 7 FILES THAT WERE DUMPED ON *YYMMDD*.
*
*
*
*         DELETE.
*
*         DISABLES ALL FILES MEETING THE SPECIFIED CRITERIA.  THIS
*         PERMITS A USER TO LOAD ALL FILES ON A TAPE EXCEPT THOSE THAT
*         HAVE BEEN DISABLED.  DELETED FILES ARE NOT PHYSICALLY REMOVED
*         FROM THE TAPE AND CAN BE RESTORED USING *RESET*.
*
*                RECLAIM.
*                ? DELETE,PF=C,DB=YYMMDD,NF=100.
*
*         DELETES REPORTING OF UP TO 100 FILES CALLED *C* THAT WERE
*         DUMPED BEFORE *YYMMDD*.
*
*
*
*         DUMP.
*
*         DUMPS TO TAPE ALL FILES MEETING THE SPECIFIED CRITERIA.
*         FILES ARE DUMPED IN *PFDUMP* FORMAT AND ARE READABLE BY
*         *RECLAIM* AND *PFLOAD*.  THE DATABASE FILE WILL CONTAIN
*         INFORMATION REQUIRED BY *RECLAIM* TO RELOAD THE FILE IN THE
*         FUTURE.  IF THE SPECIFIED DATABASE FILE DOES NOT CURRENTLY
*         EXIST, *RECLAIM* WILL TRY TO CREATE IT.  UNLESS *EI=NO* IS
*         SPECIFIED, THE DUMPED FILES WILL BE WRITTEN ON THE TAPE
*         FOLLOWING THE END OF INFORMATION.
*
*                RECLAIM(Z)/DUMP,TY=D,TN=001442
*
*         WILL DUMP ALL DIRECT ACCESS PERMANENT FILES TO MAGNETIC TAPE
*         WITH VSN *001442*.
*
*
*
*         END.
*
*         ENDS THE CURRENT *RECLAIM* SESSION.  *END* IS NOT REQUIRED
*         IF THE *Z* PARAMETER IS USED ON THE *RECLAIM* COMMAND.
*         ON AN INTERACTIVE TERMINAL A CARRIAGE RETURN IS EQUIVALENT
*         TO *END*.
*
*
*
*         LIST.
*
*         THE *LIST* DIRECTIVE ENABLES USERS TO RETRIEVE INFORMATION
*         ON ALL OF THE PERMANENT FILES THAT HAVE BEEN ENTERED INTO
*         THE DATABASE DEPENDING ON USER SPECIFIED CRITERIA.  FILES ARE
*         LISTED IN ALPHABETICAL ORDER.
*
*                RECLAIM(Z)/LIST,MA=YYMMDD,TY=D.
*
*         LISTS ALL DIRECT ACCESS FILES WHICH HAVE BEEN MODIFIED
*         AFTER *YYMMDD*.
*
*
*
*         LOAD.
*
*         LOADS TAPE FILES INTO THE PERMANENT FILE CATALOG BASED ON
*         THE SPECIFIED CRITERIA.  THE MOST RECENTLY MODIFIED VERSION
*         OF A FILE IS LOADED UNLESS OTHER CHARACTERISTICS ARE
*         INDICATED.  IF A FILE NAME SPECIFIED IN A *LOAD* DIRECTIVE
*         (OR THE NEW NAME SPECIFIED BY THE *NN* OPTION) ALREADY
*         EXISTS IN THE CATALOG THE FILE WILL NOT BE LOADED.
*
*                RECLAIM(Z)/LOAD,PF=A,DD=YYMMDD./LOAD,PF=B,LV.
*
*         LOAD FILE WITH THE PERMANENT FILE NAME OF *A* WHICH HAS A
*         DUMP DATE OF *YYMMDD* PLUS THE LATEST VERSION OF *B*.
*
*
*
*         REMOVE.
*
*         PERMANENTLY REMOVES A TAPE VSN FROM THE DATABASE.  ALL FILES
*         FOR THAT TAPE NUMBER WILL BE PURGED.
*
*                RECLAIM.
*                ? REMOVE,TN=001234.
*
*         ALL ENTRIES IN THE USER DATABASE ON THE CURRENT USER NAME
*         FOR THE TAPE *001234* WILL BE DELETED.
*
*
*
*         RESET.
*
*         THE RESET OPTION ENABLES UNDELETING DELETED FILES.  FILES
*         MEETING THE SPECIFIED CRITERIA WHICH WERE PREVIOUSLY DISABLED
*         BY *DELETE* WILL BE RESTORED.
*
*                RECLAIM.
*                ? RESET,NF=777
*
*         UNDELETE UP TO 777 FILES WHICH HAVE BEEN PREVIOUSLY DELETED.
*
*
*
*         SET.
*
*         ALLOWS SPECIFICATION OF NEW DEFAULT DIRECTIVE OPTIONS.
*         A *SET* DIRECTIVE WITH NO OPTIONS HAS NO EFFECT.
*
*                RECLAIM.
*                ? SET,LV,TY=D,MB=YYMMDD.
*
*         DURING THE REMAINDER OF THIS SESSION (OR UNTIL AN OVERRIDING
*         *SET* IS ENTERED) THE USER IS ONLY INTERESTED IN THE LATEST
*         VERSION OF DIRECT ACCESS FILES THAT WERE LAST MODIFIED
*         BEFORE *YYMMDD*.
*
*
*
*         UPDATE.
*
*         THIS OPTION IS USED TO UPDATE THE *RECLAIM* DATABASE.  IT
*         REQUIRES THE *UPDATES* FILE AND THE *NUMBERS* FILE AS INPUT.
*
*                RECLAIM(Z)/UPDATE.
          TITLE  DAYFILE MESSAGES.
          SPACE  4,20
***       DAYFILE MESSAGES.
*
*
*         * ADDING FILE FFFFFFF TO DATABASE.* - FILE NAMED FFFFFFF
*                IS BEING READ AND *RECLAIM* IS ADDING INFORMATION FOR
*                THIS FILE TO THE USER DATABASE.
*
*         * ADDING TAPE VVVVVV  TO DATABASE.* - TAPE WITH VSN VVVVVV
*                IS BEING READ AND *RECLAIM* IS ADDING INFORMATION FOR
*                THIS TAPE TO THE USER DATABASE.
*
*         * CANNOT ATTACH/GET FILE - FILE SKIPPED.* - WHILE TRYING TO
*                DUMP A PERMANENT FILE, *RECLAIM* DETECTED A *PFM*
*                ERROR WHEN PERFORMING A *GET* OR *ATTACH* FUNCTION.
*
*         * CONTACT CUSTOMER SERVICES -- DB ERROR.* - A SERIOUS SITE
*                DATABASE ERROR HAS OCCURRED.
*
*         * CONTACT CUSTOMER SERVICES -- DB MISSING.* - A SERIOUS SITE
*                DATABASE ERROR HAS OCCURRED.
*
*         * CT, CN OR OV KEYWORD NOT PRESENT.* - WHILE PROCESSING A
*                *COMPACT* DIRECTIVE, *RECLAIM* FOUND THAT NONE OF THE
*                *CT=VSN*, *CN=LFN* OR *OV* KEYWORDS WERE SPECIFIED IN
*                THE OPTIONS.  ONE OF THESE OPTIONS IS REQUIRED.
*
*         * DATABASE CORRUPTED.* - AN ERROR WAS ENCOUNTERED WHILE
*                READING THE DATABASE.  THIS USUALLY MEANS THE DATABASE
*                IS EMPTY OR HAS BEEN OVERWRITTEN WITH SOMETHING
*                UNIDENTIFIABLE TO *RECLAIM*.
*
*         * DATABASE NOT FOUND -- DEFINING NEW ONE.* - *RECLAIM*
*                DETECTED THAT THERE WAS NO DATABASE IN THE USER
*                CATALOG, SO IT TRIES TO CREATE A NEW ONE.
*
*         * DIRECTIVE ARGUMENT ERROR.* - *RECLAIM* DETECTED A
*                SYNTAX ERROR IN AN INPUT DIRECTIVE.
*
*         * DUMP DENIED FOR SPECIFIED DATABASE.* - USER REQUESTED
*                ACCESS TO THE SITE DATABASE BUT WAS NOT PRIVILEGED.
*
*         * DUMP FILE CONTAINS 63 DUMPS.  FILE IS FULL.* - *RECLAIM*
*                DETECTED THAT THE DUMP FILE IT WAS DIRECTED TO USE
*                ALREADY CONTAINS THE MAXIMUM NUMBER OF DUMPS.
*
*         * DUMP FILE MALFUNCTION - EOI ENCOUNTERED.* - THE END OF
*                INFORMATION WAS ENCOUNTERED BEFORE THE PROPER DUMP
*                FILE OR RECORD WAS FOUND.  THE DUMP FILE MAY HAVE
*                BEEN OVERWRITTEN OR IMPROPERLY COPIED.
*
*         * DUMP FILE MALFUNCTION - FILE NAME MISMATCH.* - THE FILE TO
*                BE PROCESSED IS NOT THE ONE FOUND AT THE POSITION ON
*                THE DUMP FILE INDICATED BY THE DATABASE.  THE DUMP
*                FILE MAY HAVE BEEN OVERWRITTEN OR IMPROPERLY COPIED.
*
*         * DUMP FILE MALFUNCTION - FILE TRUNCATED.* - THE FILE BEING
*                PROCESSED WAS INCOMPLETE ON THE DUMP FILE.  THE DUMP
*                FILE MAY HAVE BEEN OVERWRITTEN OR IMPROPERLY COPIED.
*
*         * DUMP FILE MALFUNCTION - POSITION LOST.* - THE DUMP FILE
*                POSITION DOES NOT AGREE WITH INTERNAL INDICATORS OR
*                POSITION INFORMATION FROM THE DATABASE.
*
*         * DUMP FILE MALFUNCTION - UNRECOGNIZABLE PFC.* - WHAT SHOULD
*                BE THE PFC RECORD FOR THE FILE BEING PROCESSED IS NOT
*                A PFC RECORD.  THE DUMP FILE MAY HAVE BEEN OVERWRITTEN
*                OR IMPROPERLY COPIED.
*
*         * DUMP FILE MUST BE IN WRITE MODE.* - A *DUMP* OR *COMPACT*
*                WAS ATTEMPTED USING A MASS STORAGE DUMP FILE WHICH WAS
*                ATTACHED IN SOME MODE OTHER THAN WRITE MODE.
*
*         * DUMP FILE NOT FOUND.* - A *LOAD* OR *COPY* WAS ATTEMPTED,
*                BUT THE MASS STORAGE DUMP FILE WHICH WAS INDICATED BY
*                THE DATABASE COULD NOT BE FOUND.  THE FILE MAY HAVE
*                BEEN PURGED OR MAY NEVER HAVE BEEN MADE PERMANENT.
*
*         * ERROR IN ATTACHING USER DATABASE.* - *RECLAIM* DETECTED A
*                *PFM* ERROR WHEN ATTEMPTING TO ATTACH THE
*                USER DATABASE.
*
*         * ERROR IN FILE NAME LIST.* - A SYNTAX ERROR WAS FOUND IN
*                THE LIST OF FILE NAMES ENTERED IN RESPONSE TO USING
*                THE (PF=*) OPTION.
*
*         * FILE NOT FOUND OR FAILED CRITERIA - FFFFFFF.* - *RECLAIM*
*                DID NOT PROCESS FILE *FFFFFFF* BECAUSE IT COULD NOT
*                BE FOUND ON THE DUMP FILE(*LOAD* OR *COPY*), NO LOCAL
*                OR PERMANENT FILE BY THAT NAME COULD BE FOUND(*DUMP*),
*                OR THE FILE WAS FOUND, BUT FAILED THE OTHER CRITERIA.
*
*         * INCORRECT ARGUMENT VALUE.* - A DIRECTIVE KEYWORD WAS
*                EQUATED TO AN INVALID VALUE.  THIS COULD BE A NAME
*                LONGER THAN SEVEN CHARACTERS, AN ALPHABETIC STRING
*                WHEN A NUMBER IS EXPECTED, ETC.
*
*         * INCORRECT TAPE DENSITY.* - AN INVALID NOS TAPE DENSITY WAS
*                REQUESTED FOR THE *DUMP* DIRECTIVE.
*
*         * INCORRECT TAPE FORMAT.* - AN INVALID NOS TAPE FORMAT WAS
*                REQUESTED FOR THE *DUMP* DIRECTIVE.
*
*         * NO DATA FOUND FOR USER NAME.* - *RECLAIM* COULD NOT FIND
*                THE CALLING USER IN THE DIRECTORY OF THE DATABASE.
*
*         * NO FILES FOUND FOR SPECIFIED DUMP FILE.* - FOR A *COPY*,
*                *LOAD* OR *LIST* DIRECTIVE, NO ENTRIES WERE FOUND IN
*                THE DATABASE FOR THE DUMP FILE SPECIFIED.  *RECLAIM*
*                MAY TRY TO READ THE DUMP FILE AND ENTER IT INTO THE
*                DATABASE.
*
*         * NO FILES SELECTED - NO ACTION TAKEN.* - *COMPACT* FOUND
*                NO FILES TO RETAIN AND SO NO ACTION OCCURRED.
*
*         * NO VALID DUMP FOUND ON DUMP FILE.* - FOR A *COPY*, *LOAD*
*                OR *LIST* OPERATION, *RECLAIM* DETERMINED THAT THE
*                SPECIFIED DUMP FILE WAS NOT A *RECLAIM* DUMP FILE.
*                THE DIRECTIVE BEING PROCESSED WILL BE IGNORED.
*
*         * RECLAIM ABORTED.* - *RECLAIM* HAS DETECTED AN ERROR OR
*                THE USER HAS INITIATED AN ABORT.
*
*         * RECLAIM ARGUMENT ERROR.* - AN INCORRECT ARGUMENT WAS
*                DETECTED ON THE *RECLAIM* COMMAND LINE.
*
*         * RECLAIM COMPLETE.* - NORMAL COMPLETION.
*
*         * REMOVE DENIED FOR SPECIFIED DATABASE.* - NON-PRIVILEGED
*                USER ATTEMPTED TO USE *REMOVE* WITH SITE DATABASE.
*
*         * REQUESTING DUMP FILE.* - *RECLAIM* IS REQUESTING THE DUMP
*                FILE SPECIFIED BY *TN* OR *DN*, AND WILL ATTEMPT TO
*                REBUILD THE DATABASE ENTRIES FOR THIS DUMP FILE.
*
*         * SEE DAYFILE - UNABLE TO COMPACT XXXXXXX.* - *RECLAIM*
*                CANNOT COMPACT FILE *XXXXXXX* DUE TO A TAPE, DATABASE
*                OR OTHER ERROR, AS INDICATED IN THE DAYFILE.
*
*         * SEE DAYFILE - UNABLE TO LOAD XXXXXXX.* - *RECLAIM* CANNOT
*                LOAD FILE *XXXXXXX*.  THE FILE IS ALREADY PERMANENT,
*                OR A TAPE, DATABASE OR OTHER ERROR HAS OCCURRED, AS
*                INDICATED IN THE DAYFILE.
*
*         * TAPE DENSITY/DEVICE/FORMAT MISMATCH.* - AN OPERATION OTHER
*                THAN A *DUMP* OR *COMPACT* AT *BOI* WAS ATTEMPTED ON
*                AN EXISTING *RECLAIM* DUMP TAPE, BUT THE SPECIFIED
*                DENSITY, DEVICE TYPE OR TAPE FORMAT DID NOT MATCH THE
*                EXISTING DENSITY, DEVICE TYPE OR TAPE FORMAT.
*
*         * TAPE NUMBER FILE EMPTY.* - *UPDATE* HAS BEEN ATTEMPTED
*                WITHOUT THE *NUMBERS* FILE.
*
*         * TN OR DN MUST BE SPECIFIED.* - A *RECLAIM* OPERATION WAS
*                ATTEMPTED WHICH REQUIRED A DUMP FILE NAME OR TAPE
*                NUMBER, BUT NEITHER WAS SPECIFIED.
*
*         * TOO MANY FILE NAMES IN LIST.* - WHEN READING THE LIST OF
*                FILE NAMES SPECIFIED AFTER USING (PF=*), *RECLAIM*
*                DETECTED THAT THE NUMBER OF FILE NAMES EXCEEDED THE
*                MAXIMUM NUMBER THAT *RECLAIM* CAN HANDLE.  WHEN THIS
*                HAPPENS *RECLAIM* WILL IGNORE THE DIRECTIVE WHICH HAD
*                THE (PF=*).
*
*         * UNKNOWN DUMP FILE WILL BE OVERWRITTEN.* - WHEN PREPARING TO
*                DO AN INCREMENTAL DUMP (THAT IS, THE TAPE IS TO BE
*                WRITTEN AT THE EOI), *RECLAIM* DETECTED THAT THE DUMP
*                FILE SPECIFIED DID NOT HAVE VALID DUMP INFORMATION
*                ON IT.  THIS WOULD HAPPEN IF THE DUMP FILE WAS EMPTY,
*                OR HAD BEEN USED FOR SOMETHING BESIDES FILE DUMPS.
*                IF THE USER IS EXECUTING INTERACTIVELY, *RECLAIM* WILL
*                ALSO ISSUE A PROMPT, * IS THIS OK (YES OR NO)?*, AND
*                WILL ASK THE USER FOR A RESPONSE.  THUS THE USER HAS A
*                CHANCE TO PREVENT *RECLAIM* FROM OVERWRITING THE FILE.
*
*         * USER DATABASE MISSING.* - THE USER DATABASE FILE WAS
*                NOT FOUND.
*
*         * WAITING FOR DATABASE NON-BUSY.* - WHILE TRYING TO ATTACH
*                THE DATABASE, *RECLAIM* DETECTED THAT THE DATABASE
*                WAS BUSY (I.E. ATTACHED BY SOME OTHER USER IN A
*                CONFLICTING MODE, SUCH AS WRITE MODE).  WHEN THIS
*                HAPPENS *RECLAIM* WILL ROLL OUT FOR TEN SECONDS AND
*                THEN TRY AGAIN TO ATTACH THE DATABASE.  *RECLAIM*
*                WILL CONTINUE THIS UNTIL IT CAN ATTACH THE DATABASE
*                SUCCESSFULLY OR THE USER INTERRUPTS *RECLAIM*.
*
*
*
*         ERROR EXIT MESSAGES - ISSUED WHEN A SEVERE SYSTEM ERROR
*         IS DETECTED, FROM WHICH *RECLAIM* CANNOT RECOVER AND
*         PROCEED WITH WHAT IT WAS DOING.  SUCH ERRORS WOULD BE
*         OPERATOR DROP, SRU LIMIT, UNRECOVERED TAPE ERRORS, ETC.
*
*         * CPU ERROR EXIT.                 *
*         * ARITHMETIC ERROR.               *
*         * ILLEGAL INSTRUCTION.            *
*         * PP ABORT.                       *
*         * CPU ABORT.                      *
*         * PP CALL ERROR.                  *
*         * TIME LIMIT.                     *
*         * TOO MANY LOCAL FILES.           *
*         * TRACK LIMIT.                    *
*         * ACCOUNT BLOCK SRU LIMIT.        *
*         * FORCED ERROR.                   *
*         * OPERATOR DROP.                  *
*         * OPERATOR RERUN.                 *
*         * OPERATOR KILL.                  *
*         * SUBSYSTEM ABORT.                *
*         * EXTENDED MEMORY PARITY ERROR.   *
*         * CPU PARITY ERROR.               *
*         * TERMINAL USER HUNG UP.          *
*         * SYSTEM ABORT.                   *
*         * OPERATOR OVERRIDE.              *
*         * JOB STEP SRU LIMIT.             *
          TITLE  COMMON DECKS.
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCCMD
*CALL     COMCMAC
          QUAL   MTX
*CALL     COMSMTX
          QUAL   *
*CALL     COMSPFM
*CALL     COMSPFS
*CALL     COMSRPV
*CALL     COMSSFM
          QUAL   TFM
*CALL     COMSTFM
          QUAL   *
          TITLE  ASSEMBLY CONSTANTS.
          SPACE  4,10
****      ASSEMBLY CONSTANTS.
 
 
 VER      MICRO  1,,*5.0*    CURRENT VERSION OF *RECLAIM*
 
 CFBUFL   EQU    1001B       MERGESORT BUFFER LENGTH
 DIRBUFL  EQU    1001B       *NUMBERS*, MERGESORT BUFFER LENGTH
 IBUFL    EQU    201B        INPUT BUFFER LENGTH
 NEWBUFL  EQU    3001B       DATABASE OUT BUFFER LENGTH
 OBUFL    EQU    201B        OUTPUT BUFFER LENGTH
 OLDBUFL  EQU    1001B       DATA BASE IN BUFFER LENGTH
 RLDBUFL  EQU    1001B       *OPLDF* BUFFER LENGTH
 TFBUFL   EQU    30061B      PRIMARY DUMP FILE BUFFER LENGTH
 TNBUFL   EQU    1001B       *UPDATES* BUFFER LENGTH
 WSAL     EQU    1000B       WORKING STORAGE BUFFER LENGTH
 
 AFBUFL   EQU    DIRBUFL     FIRST MERGESORT SCRATCH BUFFER LENGTH
 BFBUFL   EQU    TNBUFL      SECOND MERGESORT SCRATCH BUFFER LENGTH
 MFBUFL   EQU    TFBUFL      *COMPACT* DUMP FILE BUFFER LENGTH
 SFBUFL   EQU    NEWBUFL     LENGTH OF SCRATCH BUFFER FOR LOAD/COPY
 
 CATBUFL  EQU    NWCE+1      CATLIST BUFFER LENGTH
*         *PRMITBWC MUST BE A MULTIPLE OF TWO AND AT LEAST TWO WORDS
*         LESS THAN THE LENGTH OF A DISK PRU.
 
 PRMITBWC EQU    62          NUMBER OF PERMIT WORDS IN A FULL BLOCK
 
 PRMITBL  EQU    1+2+PRMITBWC  PERMIT BLOCK LENGTH
 TCATBFL  EQU    NWCE*3      TRUE LENGTH OF CATBUF
 CLSBUFL  EQU    NWCE*100+1  FILE *CATLIST* BUFFER LENGTH
 
 DBEL     EQU    4           DATA BASE ENTRY LENGTH
 DCW      EQU    30000B      DUMMY TAPE BLOCK CONTROL WORD
 ITEMSIZ  EQU    DBEL+2      SIZE OF ENTRIES HANDLED IN MERGESORT
 MFETSIZ  EQU    6           FET SIZE FOR MERGESORT FILES
 OLENGTH  EQU    8           OUTPUT LINE LENGTH
 PRUSIZE  EQU    100B        SIZE OF DISK SECTOR IN WORDS
 ROLLFBS  EQU    12          MAXIMUM ROLLOUTS BEFORE TAPE UNLOAD
 TFETSIZ  EQU    16          FET SIZE FOR TAPES
 UDBEL    EQU    5           UPDATE DATA BASE ENTRY LENGTH
 WRITTEN  EQU    TFETSIZ     FET OFFSET FOR WRITTEN FLAG
 CRVSN    EQU    WRITTEN+1   FET OFFSET FOR CURRENT REEL VSN
 TFLAGS   EQU    CRVSN+1     FET OFFSET FOR CHARACTERISTICS FLAGS
 INITREQ  EQU    TFLAGS+1    FET OFFSET FOR INITIAL REQUEST FLAG
 TRING    EQU    INITREQ+1   FET OFFSET FOR WRITE RING FLAG
 TMSV     EQU    TRING+1     FET OFFSET FOR MASS STORAGE FLAG
 TTNV     EQU    TMSV+1      FET OFFSET FOR VSN VARIABLE
 TDNV     EQU    TTNV+1      FET OFFSET FOR NAME VARIABLE
 TDFV     EQU    TDNV+1      FET OFFSET FOR LFN VARIABLE
 TFC      EQU    TDFV+1      FET OFFSET FOR CURRENT FILE COUNT
 TRC      EQU    TFC+1       FET OFFSET FOR CURRENT RECORD COUNT
 CFN      EQU    TRC+1       FET OFFSET FOR CURRENT RMS FILE NAME
 TFETVSN  EQU    9           FET VSN LOCATION FOR LABEL MACRO
 
 PTR      EQU    MFETSIZ     PASCAL-LIKE FILE POINTER RELATIVE LOCATION
 EOF      EQU    PTR+ITEMSIZ END-OF-FILE FLAG RELATIVE LOCATION
 
 WRIF$    EQU    0           DEFINE DATA TRANSFER FLAG
 
 NDMPWD   EQU    777B        NUMBER OF WORDS IN DUMP TEXT TABLE
 PFTABL   EQU    999         MAXIMUM FILE NAMES FOR PF=*
****
          TITLE  FILE FORMATS.
          SPACE  4,10
*         FILE FORMATS.
 DATABASE SPACE  4,20
**        DATABASE.
*
*         THE DATABASE CONSISTS OF 4-WORD RECORDS, EACH CONTAINING
*         DATA FOR ONE DUMPED PERMANENT FILE.  THESE 4-WORD ENTRIES
*         ARE SORTED BY USER NAME, PERMANENT FILE NAME, LAST
*         MODIFICATION DATE AND LAST DUMP DATE.  THE DATABASE MAY
*         CONTAIN DUMP DATA FOR MORE THAN ONE USER NAME.  IF SO, DATA
*         FOR EACH USER IS A SEPARATE SYSTEM RECORD, SO THAT A LIST
*         OF USERS CAN BE GENERATED VIA *CATALOG* OR *ITEMIZE*.  THE
*         LAST PART OF THE DATABASE IS AN *OPLD* DIRECTORY, AS USED
*         BY *MODIFY*, *LIBEDIT*, AND *GTR*.  EACH USER IN THE
*         DATABASE HAS AN ENTRY IN THE DIRECTORY, POINTING TO
*         ITS RELATIVE OFFSET WITHIN THE DATABASE (RELATIVE PRU
*         NUMBER).  THE FORMAT OF A 4-WORD DUMP ENTRY IS AS FOLLOWS--
*
*T ID     42/ USER NAME, 18/ UNUSED
*T,ID+1   42/ PERMANENT FILE NAME,18/ DUMP DATE
*T,ID+2   42/ DUMP FILE NAME, 18/ LM DATE
*T,ID+3   1/ DEL,5/ ULEN,6/ FTYP,12/ TFLGS,6/ FNUM,12/ RNUM,18/ LLEN
*
*         *LM DATE* - DATE FILE WAS LAST MODIFIED.
*
*         *DEL* - DELETE FLAG.
*
*         *ULEN* - UPPER 5 BITS OF THE LENGTH OF PF IN PRUS.
*
*         *FTYP* - FILE TYPE (DIRECT OR INDIRECT).
*
*         *FNUM* - NUMBER OF FILE THAT PF RESIDES ON TAPE.
*
*         *RNUM* - EXACT RECORD NUMBER ON FILE OF PF RESIDENCE.
*
*         *LLEN* - LOWER 18 BITS OF THE LENGTH OF PF IN PRUS.
*
*         *TFLGS* - TAPE REQUEST FLAGS FOR THIS FILE-S DUMP SET.
*                1/ MASS STORAGE DUMP FLAG (BIT 11).
*                1/ LABELED TAPE FLAG      (BIT 10).
*                1/ FOREIGN TAPE FLAG      (BIT 9).
*                2/ TAPE DEVICE TYPE       (BITS 8-7).
*                1/ 0.                     (BIT 6).
*                3/ TAPE DENSITY           (BITS 5-3).
*                3/ TAPE FORMAT            (BITS 2-0).
*
*
*         NOTE   A DATABASE MUST BE SORTED BY THE FOLLOWING KEYS--
*
*                1 - USER NAME.
*                2 - PERMANENT FILE NAME.
*                3 - LM DATE.
*                4 - DUMP DATE.
 NUMBERS  SPACE  4,10
**        VSN INDEX.
*
*         THE VSN INDEX IS A PART OF THE DATABASE. IT OCCUPIES THE
*         LAST SYSTEM RECORD BEFORE THE *OPLD* RECORD, AND APPEARS TO
*         MANY *RECLAIM* ROUTINES AS JUST ANOTHER USER RECORD. HOWEVER,
*         EACH ENTRY IN THE VSN INDEX REPRESENTS A REEL OF A DUMP
*         TAPE SET. THE 4-WORD ENTRIES CONTAIN INFORMATION WHICH LETS
*         *RECLAIM* DETERMINE WHICH REEL OF A SET IS TO BE MOUNTED TO
*         RETRIEVE A PARTICULAR FILE FROM THAT DUMP SET.
*
*T,ID     42/ 7L.VSNDX., 18/0
*T,ID+1   36/ SETVSN, 24/0
*T,ID+2   36/ CURVSN, 24/0
*T,ID+3   12/ 0, 12/ TFLGS, 6/ FNUM, 12/ RNUM, 18/0
*
*         *SETVSN* - THIS VSN IDENTIFIES THE DUMP TAPE SET. IT IS
*                NORMALLY THE VSN OF THE FIRST REEL OF THE SET.
*
*         *CURVSN* - THIS IS THE ACTUAL VSN OF THE REEL REPRESENTED
*                BY THE VSN INDEX ENTRY, AS DETERMINED BY A *FILINFO*
*                KEY 4 REQUEST AFTER EACH FILE DUMP.
*
*         *TFLGS* - TAPE REQUEST FLAGS FOR THIS DUMP SET.  *TFLGS*
*                   IS STORED ONLY IN THE FIRST RECORD OF THE SET.
*
*                1/ MASS STORAGE DUMP FLAG (BIT 11).
*                1/ LABELED TAPE FLAG      (BIT 10).
*                1/ FOREIGN TAPE FLAG      (BIT 9).
*                2/ TAPE DEVICE TYPE       (BITS 8-7).
*                1/ 0.                     (BIT 6).
*                3/ TAPE DENSITY           (BITS 5-3).
*                3/ TAPE FORMAT            (BITS 2-0).
*
*         *FNUM* - THE FILE NUMBER OF THE DUMP BEING PROCESSED AT
*                THE TIME THIS REEL WAS ASSIGNED. ZERO FOR THE FIRST
*                REEL OF A SET.
*
*         *RNUM* - THE RECORD NUMBER OF THE DUMP BEING PROCESSED AT
*                THE TIME THIS REEL WAS ASSIGNED. ZERO FOR THE FIRST
*                REEL OF A SET.
*
*
*
*         NOTE   VSN INDEX RECORDS ARE SORTED AS FOLLOWS--
*
*                1 - SET VSN.
*                2 - FILE NUMBER.
*                3 - RECORD NUMBER.
          SPACE  4,10
**        NUMBERS.
*
*         THE NUMBERS FILE IS USED BY THE *COMPACT*, *DUMP*, *REMOVE*,
*         AND *UPDATE* DIRECTIVES.  IT CONTAINS THE VSN-S OF THE
*         TAPES USED FOR THE DUMP.
*
*T,NUMB   42/ DUMP FILE NAME,18/0
 CF       SPACE  4,15
**        CF.
*
*         THE *CF* FILE IS THE SCRATCH FILE REQUIRED FOR THE *COPY*
*         AND *COMPACT* DIRECTIVES, WHICH IS SORTED EXTERNALLY.
*
*T,CF     42/ DUMP FILE NAME,6/ FNUM,12/ REC NUM
*T,CF+1   42/ PERMANENT FILE NAME,6/ FTYP,12/ REQ FLGS
*T,CF+2   60/ DATABASE ENTRY FIRST WORD
*T,CF+3   60/ DATABASE ENTRY SECOND WORD
*T,CF+4   60/ DATABASE ENTRY THIRD WORD
*T,CF+5   60/ DATABASE ENTRY FOURTH WORD
 UPDATES  SPACE  4,15
**        UPDATES.
*
*         *UPDATES* IS USED IN THE *COMPACT*, *DUMP*, *REMOVE, AND
*         *UPDATE* DIRECTIVES.  IT HAS 5-WORD RECORDS FOR THE FILES
*         TO BE ADDED TO THE *RECLAIM* DATABASE.  IT HAS THE FORMAT--
*
*T,ID     60/ DATABASE ENTRY FIRST WORD
*T,ID+1   60/ DATABASE ENTRY SECOND WORD
*T,ID+2   60/ DATABASE ENTRY THIRD WORD
*T,ID+3   60/ DATABASE ENTRY FOURTH WORD
*T,ID+4   42/ FAMILY,18/ 0
          TITLE  PROGRAMMING NOTES.
 NOTES    SPACE  4,30
**        PROGRAMMING NOTES.
*
*         1.  DEBUGGING CODE IS EMBEDDED WITHIN *RECLAIM* TO MAKE
*         TESTING EASIER.  ONE INSTANCE OF SUCH USE IS IN ROUTINE
*         *RNT* (REQUEST NEXT TAPE), WHICH ASSEMBLES EITHER A *LABEL*
*         MACRO OR A *RECALL* MACRO.  THE DEBUGGING CODE IS TURNED ON
*         BY USING THE *ML* PARAMETER ON THE COMPASS COMMAND.  A
*         TYPICAL SEQUENCE OF CODE IS--
*                DEBUG    IFC    EQ,$DEBUG$"MODLEVEL"$
*                     ....REGULAR CODE....
*                DEBUG    ELSE
*                     ....DEBUGGING CODE....
*                DEBUG    ENDIF
*         THIS CONVENTION SHOULD BE FOLLOWED FOR ANY OTHER DEBUGGING
*         OR TESTING CODE.  THEN TO ASSEMBLE THE DEBUG CODE, USE
*         *ML=DEBUG* ON THE *COMPASS* COMMAND.
*
*         2.  PROGRAM FLOW.  *RECLAIM* HAS ONE MAIN LOOP WHICH CRACKS
*         DIRECTIVES, SETS UP TABLES, AND JUMPS TO A PARTICULAR
*         DIRECTIVE PROCESSOR THROUGH A JUMP TABLE.  EACH DIRECTIVE
*         PROCESSOR RETURNS TO THE MAIN LOOP THROUGH TAG *MAIN8* IF
*         ANY OUTPUT HAS BEEN GENERATED (I.E. NORMAL RETURN).
*         OTHERWISE RETURN IS THROUGH TAG *MAIN* IF A GIVEN DIRECTIVE
*         WAS IGNORED.
          TITLE  SYMBOL DEFINITIONS.
          SPACE  4,10
****      SYMBOL DEFINITIONS.
 
 
*         DATA BASE WORD OFFSET DEFINITIONS.
 
 DBUNM    EQU    0           USER NAME
 DBUUI    EQU    0           USER INDEX
 DBPFN    EQU    1           PERMANENT FILE NAME
 DBDDT    EQU    1           DUMP DATE
 DBXSV    EQU    1           SET VSN - VSN INDEX
 DBTNO    EQU    2           TAPE NUMBER FOR FILE RESIDENCE
 DBLMO    EQU    2           LAST MODIFICATION DATE OF FILE
 DBXCV    EQU    2           CURRENT VSN - VSN INDEX
 DBFLG    EQU    3           SPECIAL FLAGS
 DBFTY    EQU    3           FILE TYPE (D/I)
 DBRFL    EQU    3           TAPE REQUEST FLAGS
 DBFNO    EQU    3           FILE NUMBER ON TAPE
 DBRNO    EQU    3           RECORD NUMBER OF FILE RESIDENCE
 DBLEN    EQU    3           LENGTH OF PERMANENT FILE
 DBXFR    EQU    3           FILE AND RECORD NUMBERS - VSN INDEX
 UDBFAM   EQU    4           FAMILY NAME IN *UPDATES* INPUT RECORD
 
*         OUTPUT LINE DEFINITIONS.
 
 LPFN     EQU    0           PERMANENT FILE NAME
 LFTY     EQU    0           FILE TYPE
 LLMO     EQU    1           LAST MOD
 LDDT     EQU    2           DUMP DATE
 LLEN     EQU    3           LENGTH
 LUNM     EQU    4           USER NAME
 LTNO     EQU    5           TAPE NUMBER
 LRNO     EQU    6           RECORD NUMBER
 LFNO     EQU    6           FILE NUMBER ON TAPE
 LEND     EQU    7           TERMINATOR
****
          TITLE  GENERAL MACRO DEFINITIONS.
          SPACE  4,10
*         GENERAL MACRO DEFINITIONS.
 ABORT    SPACE  4,15
**        ABORT - ABORT PROGRAM.
*
*         ABORT  MSG
*
*         ENTRY  *MSG* = FWA OF ERROR MESSAGE TO BE ISSUED TO THE
*                        DAYFILE.  IF OMITTED, NO MESSAGE IS ISSUED.
*                *NAP* = *NA* PARAMETER VALUE.
*
*         EXIT   OPTIONAL MESSAGE ISSUED TO DAYFILE.
*                *RECLAIM* ABORTED (OR TERMINATED NORMALLY IF *NA*).
*
*         USES   X - 1.
*                A - 1.
*
*         MACROS ENDRUN, MESSAGE, SYSTEM.
 
 
          PURGMAC  ABORT
 
 ABORT    MACRO  MSG
          LOCAL  NOBOMB
          MACREF ABORT
          IFC    NE,$MSG$$,2
          R=     X1,MSG
          MESSAGE X1,3,R
          SA1    NAP
          NZ     X1,NOBOMB
          SYSTEM ABT,R
 NOBOMB   ENDRUN
 ABORT    ENDM
 BREAK    SPACE  4,15
**        BREAK - PROCESS INTERACTIVE PROGRAM INTERRUPTS.
*
*         BREAK  REG
*
*         ENTRY  *REG* = ALTERNATE REGISTER TO BE DESTROYED BY
*                        *BREAK* MACRO.  IF OMITTED, X1 IS USED.
*
*         EXIT   TO *PBC* IF TERMINAL INTERRUPT INITIATED.
*
*         USES   X - 1 (OR X.REG).
*                A - 1 (OR A.REG).
 
 
          PURGMAC  BREAK
 
 BREAK    MACRO  REG
          MACREF BREAK
          IFC    NE,$REG$$
          SA_REG BREAK
          NZ     X_REG,PBC   IF INTERRUPT INITIATED
          ELSE
          SA1    BREAK
          NZ     X1,PBC      IF INTERRUPT INITIATED
          ENDIF
 BREAK    ENDM
 CLEAR    SPACE  4,15
**        CLEAR - CLEAR FET POINTERS.
*
*         CLEAR  FET
*
*         ENTRY  *FET* = FWA OF FET TO BE CLEARED.  IF OMITTED (X2)
*                        IS ASSUMED TO CONTAIN THE FET ADDRESS.
*
*         EXIT   FET POINTERS *IN* AND *OUT* SET TO *FIRST*.
*
*         USES   X - 1, 6.
*                A - 1, 6.
 
 
          PURGMAC  CLEAR
 
 CLEAR    MACRO  FET
          MACREF CLEAR
          IFC    EQ,$FET$$
          RECALL X2
          SA1    X2+B1       FIRST
          ELSE
          RECALL FET
          SA1    FET+B1      FIRST
          MX6    12          CLEAR *DT* FIELD
          BX6    -X6*X1
          SA6    A1
          ENDIF
          SX6    X1
          SA6    A1+B1       FIRST INTO IN
          SA6    A6+B1       IN INTO OUT
 CLEAR    ENDM
 COPYBLK  SPACE  4,15
**        COPYBLK - COPY DATA INTO A DUMP TAPE BLOCK.
*
*         COPYBLK  WC,FS,SHORT
*
*         ENTRY  *WC* = WORD COUNT TO COPY INTO TAPE BLOCK.
*                *FS* = FREE SPACE IN TAPE BLOCK.
*                *SHORT* = FLAG INDICATING IF THIS TAPE BLOCK SHOULD
*                          BE AN EOR OR EOF BLOCK--
*                        .EQ. 0 IF THIS IS A NORMAL DATA BLOCK.
*                        .LT. 0 IF THE LAST PRU READ WAS A SHORT PRU.
*
*         USES   X - 1, 2, 3.
*
*         CALLS  WRB.
 
 
          PURGMAC COPYBLK
 
 COPYBLK  MACRO  WC,FS,SHORT
          MACREF COPYBLK
          R=     X1,WC
          R=     X2,FS
          R=     X3,SHORT
          RJ     WRB
 COPYBLK  ENDM
 INDEX    SPACE  4,15
**        INDEX - GENERATE INDEXED TABLE WITH 4-WORD MESSAGES.
*
*ADDR     INDEX  I,MSG
*
*         ENTRY  *ADDR* = FWA OF TABLE, IF PRESENT.
*                *I* = TABLE INDEX.
*                *MSG* = MESSAGE TEXT (DOES NOT CONTAIN ASTERISKS).
*
*         EXIT   4-WORD TABLE ENTRY GENERATED AT I*4+ADDR.
*
*         THIS MACRO IS A MODIFIED VERSION OF *INDEX* FROM *COMPMAC*.
 
 
          PURGMAC  INDEX
 
          MACRO  INDEX,ADDR,I,MSG
          IFC    NE,$ADDR$$
 ADDR     BSS    0
 .2       SET    ADDR
          ELSE   4
          ORG    I+I+I+I+.2
          IFC    NE,$MSG$$,1
          DATA   C*MSG*
          BSS    0
          ENDM
 OPTION   SPACE  4,20
**        OPTION - EXPAND SELECTED DIRECTIVE KEYWORD.
*
*         *OPTION* GENERATES THE *COMCARM* ARGUMENT TABLE, THE DEFAULT
*         VALUE TABLE, AND THE ARGUMENT VARIABLE TABLE FOR EACH KEYWORD
*         THAT CAN BE USED ON A *RECLAIM* DIRECTIVE.
*
*         OPTION  KW,DEF,CVT,ASV,WC
*
*         ENTRY  *KW* =  OPTION ENTERED BY USER.
*                *DEF* = DEFAULT.
*                *CVT* = REQUIRED CONVERSION.
*                *ASV* = ADDRESS OF ASSUMED VALUE.
*                *WC* = WORD COUNT OF VALUE.
*
*         EXIT   *KWA* = ARGUMENT PROCESSOR EQUIVALENCE TABLE ADDRESS.
*                *KWD* = DEFAULT VALUE TABLE ADDRESS.
*                *KWV* = VARIABLE TABLE ADDRESS.
 
 
          PURGMAC  OPTION
 
 OPTION   MACRO  KW,DEF,CVT,ASV,WC
          MACREF OPTION
 
 ARMTAB   RMT
 KW_A     VFD    12/0L_KW    KEYWORD
          IFC    NE,$ASV$$
          VFD    18/ASV      FOR NON-EQUIVALENCED INPUT VARIABLES
          ELSE   1
          VFD    18/=0       VALUE EXPECTED BY ARGUMENT PROCESSOR
 
          VFD    3/4         33B = 0
 
          ECHO   1,MODE=(JDATE,OCTAL,DECIMAL,FILETY,TAPEPO,SPFILL)
 .MODE    SET    0
 .CVT     SET    1
          VFD    1/.JDATE,1/.OCTAL,1/.DECIMAL
          VFD    1/.FILETY,1/.TAPEPO,1/.SPFILL
 
          IFC    EQ,$WC$$
          VFD    3/1
          ELSE   1
          VFD    3/WC
 
          VFD    18/KW_V
 ARMTAB   RMT
 
 DEFAULT  RMT
 KW_D     VFD    60/DEF
 DEFAULT  RMT
 
 VARIABL  RMT
          IFC    EQ,$WC$$
 KW_V     BSSZ   1
          ELSE   1
 KW_V     BSSZ   WC
 VARIABL  RMT
 OPTION   ENDM
          TITLE  MERGESORT MACRO DEFINITIONS.
          SPACE  4,10
*         MERGESORT MACRO DEFINITIONS.
 REWRYTE  SPACE  4,15
**        REWRYTE - REWIND FILE AND PREPARE FOR WRITING.
*
*         REWRYTE  FILE
*
*         ENTRY  *FILE* = FET ADDRESS OF FILE TO REWIND AND WRITE.
*
*         EXIT   FILE REWOUND, EOF FLAG SET ON.
*
*         USES   X - 2.
*
*         CALLS  RWR.
 
 
          PURGMAC  REWRYTE
 
 REWRYTE  MACRO  FILE
          MACREF REWRYTE
          R=     X2,FILE
          RJ     RWR
 REWRYTE  ENDM
 RESET    SPACE  4,15
**        RESET - REWIND FILE AND PREPARE FOR READING.
*
*         RESET  FILE
*
*         ENTRY  *FILE* = FET ADDRESS OF FILE TO REWIND AND READ.
*
*         EXIT   FILE REWOUND AND PARTIALLY READ.
*                EOF FLAG SET IF FILE IS EMPTY.
*
*         USES   X - 2.
*
*         CALLS  RST.
 
 
          PURGMAC  RESET
 
 RESET    MACRO  FET
          MACREF RESET
          R=     X2,FET
          RJ     RST
 RESET    ENDM
 GETITEM  SPACE  4,15
**        GETITEM - GET AN ITEM FROM A FILE.
*
*         GETITEM  FET,ITEM
*
*         ENTRY  *FET* = FET ADDRESS OF FILE.
*                *ITEM* = ITEM DESTINATION ADDRESS.
*
*         EXIT   VALUE MOVED.
*                EOF FLAG SET IF NEXT READ FAILS.
*
*         USES   X - 0, 5.
*
*         CALLS  GIT.
 
 
          PURGMAC  GETITEM
 
 GETITEM  MACRO  FET,ITEM
          MACREF GETITEM
          R=     X0,FET
          R=     X5,ITEM
          RJ     GIT
 GETITEM  ENDM
 PUTITEM  SPACE  4,15
**        PUTITEM - WRITE ITEM TO FILE.
*
*         PUTITEM  FET,ITEM
*
*         ENTRY  *FET* = FET ADDRESS OF FILE.
*                *ITEM* = ADDRESS OF ITEM TO WRITE.
*
*         EXIT   ITEM WRITTEN TO FILE.
*
*         USES   X - 2, 5.
*
*         CALLS  PIT.
 
 
          PURGMAC  PUTITEM
 
 PUTITEM  MACRO  FET,ITEM
          MACREF PUTITEM
          R=     X2,FET
          R=     X5,ITEM
          RJ     PIT
 PUTITEM  ENDM
 COPITEM  SPACE  4,15
**        COPITEM - COPY ITEM FROM ONE FILE TO ANOTHER.
*
*         COPITEM  FILEX,FILEY
*
*         ENTRY  *FILEX* = FET ADDRESS OF FILE TO READ FROM.
*                *FILEY* = FET ADDRESS OF FILE TO WRITE TO.
*
*         EXIT   ITEM COPIED.
*                *EORUN* SET IF ITEM COPIED WAS END OF A RUN.
*
*         USES   X - 2, 5.
*
*         CALLS  CIT.
 
 
          PURGMAC  COPITEM
 
 COPITEM  MACRO  FILEX,FILEY
          MACREF COPITEM
          R=     X2,FILEX
          R=     X5,FILEY
          RJ     CIT
 COPITEM  ENDM
 COPYRUN  SPACE  4,15
**        COPYRUN - COPY RUN OF ENTRIES BETWEEN FILES.
*
*         COPYRUN  FILEX,FILEY
*
*         ENTRY  *FILEX* = FET ADDRESS OF FILE TO READ FROM.
*                *FILEY* = FET ADDRESS OF FILE TO WRITE TO.
*
*         EXIT   RUN COPIED FROM *FILEX* TO *FILEY*.
*
*         USES   X - 2, 5.
*
*         CALLS  CRN.
 
 
          PURGMAC  COPYRUN
 
 COPYRUN  MACRO  FILEX,FILEY
          MACREF COPYRUN
          R=     X2,FILEX
          R=     X5,FILEY
          RJ     CRN
 COPYRUN  ENDM
          TITLE  ARGUMENT TABLES.
          SPACE  4,10
*         ARGUMENT TABLES.
 OPTIONS  SPACE  4,10
*         OPTIONS - OPTIONS LIST FOR ARGUMENT PROCESSING.
 
 
          ORG    110B
 ORIG     BSS    0           PROGRAM ORIGIN
 
 
 OPTIONS  BSS    0                OPTIONS TABLE
          OPTION AA,0,JDATE       ACCESSED AFTER DATE
          OPTION AB,0,JDATE       ACCESSED BEFORE DATE
          OPTION AD,0,JDATE       LAST ACCESS DATE
          OPTION CF,0LNTAPE,0,OPNTAPE  COMPACT LOCAL FILE NAME
          OPTION CN,0,0           COMPACT PERMANENT FILE NAME
          OPTION CT,0,0           COMPACT TAPE VSN
          OPTION DA,0,JDATE       DUMPED AFTER DATE
          OPTION DB,0,JDATE       DUMPED BEFORE DATE
          OPTION DD,0,JDATE       DUMP DATE
          OPTION DE,0,0,-NOEQV    FILES WHICH HAVE BEEN DELETED
          OPTION DF,0LTAPE,0,OPTAPE  LOCAL DUMP FILE NAME
          OPTION DT,0,0           DEVICE TYPE ( MT/NT/CT/AT/MS )
          OPTION EX,0LNO,0,OPYES  REVERSE SELECTION CRITERIA
          OPTION GT,0,DECIMAL     FILE SIZE GREATER THAN
          OPTION FN,0             PROCESS LOCAL FILE NAME FIRST
          OPTION FI,0,DECIMAL     FILE POSITION
          OPTION LT,0,DECIMAL     FILE SIZE LESS THAN
          OPTION LV,0,0,-NOEQV    LATEST VERSION OF A FILE
          OPTION MA,0,JDATE       MODIFIED AFTER
          OPTION MB,0,JDATE       MODIFIED BEFORE
          OPTION MD,0,JDATE       LAST MODIFICATION
          OPTION NA,0,0,-NOEQV    NO ABORT OPTION
          OPTION NF,0L0,DECIMAL   NUMBER OF FILES TO BE SELECTED
          OPTION NN,0             NEW FILE NAME
          OPTION OV,0,0,-NOEQV    OVERWRITE FLAG FOR COMPACTING
          OPTION PF,0             PERMANENT FILE NAME
          OPTION PO,0LU,TAPEPO    *PO* OPTION FOR TAPE REQUESTS
          OPTION RC,0,DECIMAL     RECORD POSITION
          OPTION RP,0LNO,0,OPYES  REPLACE OPTION
          OPTION RS,0             FILE RESIDENCE
          OPTION TY,0,FILETY      FILE TYPE (DIRECT OR INDIRECT)
 
*         START OF PRIVILEGED ARGUMENTS.
 
          OPTION AS,0LNO,0,OPYES  PRESERVE ALTERNATE STORAGE DATA
          OPTION D,0,0            TAPE DENSITY FOR DUMP
          OPTION DN,0,0           DUMP FILE NAME
          OPTION EI,1L#,0,NOEQV   DUMP AT END OF INFORMATION
          OPTION F,0,0            TAPE FORMAT
          OPTION FT,0,0,-NOEQV    FOREIGN TAPE FLAG
          OPTION MT,0,0,-NOEQV    TAPE DEVICE TYPE
          OPTION NT,0,0,-NOEQV    TAPE DEVICE TYPE
          OPTION PW,0,0           TMS TAPE PASSWORD
          OPTION TO,0,0           TMS TAPE OWNER
          OPTION TN,0,0           TAPE NUMBER
          OPTION UI,0,OCTAL       USER INDEX (COPY/LIST/LOAD WITH TN)
          OPTION UN,0             USER NAME
 ARMTAB   SPACE  4,10
*         ARMTAB - TABLE OF ARGUMENT PROCESSER POINTERS FOR *COMCARM*.
 
 
 ARMTAB   BSS    0           ARGUMENT TABLE
 ARMTAB   HERE
 ARMTABL  EQU    *-ARMTAB    SET TABLE LENGTH
 PRIVARG  EQU    ASA         START PRIVILEGED ARGUMENTS AT ALT. STG.
 DEFAULT  SPACE  4,10
*         DEFAULT - TABLE OF DEFAULT VALUES FOR *COMCARM*.
 
 
 DEFAULT  BSS    0           DEFAULT VALUES TABLE
 DEFAULT  HERE
 VARIABL  SPACE  4,10
*         VARIABL - TABLE OF VARIABLES FOR *COMCARM*.
 
 
 VARIABL  BSS    0           VARIABLE TABLE
 VARIABL  HERE
          TITLE  DIRECTIVES/OPTIONS TABLES.
 TDIR     SPACE  4,10
*         TDIR - TABLE OF DIRECTIVES.
 
 
 TDIR     BSS    0           *COMCARM* EQUIVALENCE TABLE
          VFD    42/0LLIST,18/LIST
          VFD    42/0LCOPY,18/COPY
          VFD    42/0LDELETE,18/DELETE
          VFD    42/0LDUMP,18/DUMP
          VFD    42/0LRESET,18/DELETE
          VFD    42/0LLOAD,18/LOAD
          VFD    42/0LSET,18/SET
          VFD    42/0LCOMPACT,18/COMPACT
          VFD    42/0LEND,18/END
          VFD    42/0LREMOVE,18/REMOVE
          VFD    42/0LUPDATE,18/UPDATE
          VFD    42/0LQUIT,18/END
          CON    0
 TDTV     SPACE  4,10
*         TDTV - DEVICE TYPE VALUES.
 
 TDTV     BSS    0           DEVICE TYPE VALUES
 
*         ALL TAPE DEVICE TYPES MUST APPEAR FIRST.
 
          QUAL   MTX
 MT       VFD    48/0LMT,3/0,2/DVMT,1/0,3/0,3/TFI  7-TRACK REEL TAPE
 NT       VFD    48/0LNT,3/0,2/DVNT,1/0,3/0,3/TFI  9-TRACK REEL TAPE
          VFD    48/0LCT,3/0,2/DVCT,1/0,3/D380,3/TFI  CARTRIDGE TAPE
          VFD    48/0LAT,3/0,2/DVAT,1/0,3/D380,3/TFI  ACS CARTRIDGE
          QUAL   *
 TDTET    EQU    *           END OF TAPE DEVICE TYPE VALUES
 DTMS     VFD    24/0LMS,36/0  MASS STORAGE
 TDTMX    EQU    *           END OF DEVICE TYPE VALUES
 
 DTMT     EQU    /MTX/MT
 DTNT     EQU    /MTX/NT
 TDEN     SPACE  4,10
*         TDEN - TAPE DENSITIES.
 
 
 TDEN     BSS    0           TAPE DENSITIES
          QUAL   MTX
          VFD    48/0LHI,3/0,2/DVMT,1/0,3/D05,3/TFI  7-TRACK REEL TAPE
          VFD    48/0LLO,3/0,2/DVMT,1/0,3/D02,3/TFI  7-TRACK REEL TAPE
          VFD    48/0LHY,3/0,2/DVMT,1/0,3/D08,3/TFI  7-TRACK REEL TAPE
          VFD    48/0LHD,3/0,2/DVNT,1/0,3/D08,3/TFI  9-TRACK REEL TAPE
          VFD    48/0LPE,3/0,2/DVNT,1/0,3/D16,3/TFI  9-TRACK REEL TAPE
          VFD    48/0LGE,3/0,2/DVNT,1/0,3/D62,3/TFI  9-TRACK REEL TAPE
          VFD    48/0LCE,3/0,2/DVCT,1/0,3/D380,3/TFI  CARTRIDGE TAPE
          VFD    48/0LAE,3/0,2/DVAT,1/0,3/D380,3/TFI  ACS CARTRIDGE
          QUAL   *
          CON    0           END OF DENSITY TABLE
 TFMT     SPACE  4,10
*         TFMT - TAPE FORMATS.
 
 
 TFMT     BSS    0           TAPE FORMATS
          DATA   0LI
          DATA   0LSI
          DATA   0LF
          DATA   0LS
          DATA   0LL
          DATA   0LLI
 TFMTL    EQU    *-TFMT      NUMBER OF TAPE FORMATS
          TITLE  OUTPUT HEADINGS.
          SPACE  4,10
*         OUTPUT HEADINGS.
 
 
 HEAD1    DATA   1L1
 HEADER   DATA   10H RECLAIM V
 VERSION  VFD    18/3H"VER",42/7H    OP=
 OPTION   DATA   10H
 USER     DATA   3LUN=
 DATE     DATA   10H
 TIME     DATA   10H
 HEAD1.0  DATA   10H     PAGE
 PAGE     CON    0
 
          DATA   30H PFN  TYPE LAST MOD  DUMP DATE
 HEAD2    DATA   8L  LENGTH
          DATA   20HSERNAME    TAPE   FI
          DATA   8L REC
 
 HEADER0  EQU    *-HEADER
 HLENGTH  CON    0           HEADING LENGTH
 
 HEADER1  DATA   8L
 HEADER2  DATA   10H        FI
          DATA   10HLES PROCES
          DATA   0LSED.
          DATA   8L
 
 HEADER4  EQU    *-HEADER1
 
 HEADER5  DATA   10H     NO FI
 
 HEADER6  DATA   8L    NONE
 
 BLANKS   DATA   10H           TEN BLANKS
          TITLE  VARIABLES.
          SPACE  4,10
*         GLOBAL VARIABLES.
 
 
 ACCESS   BSSZ   1           PRIVILEGED USER FLAG
 BLOKHED  BSS    1           TAPE BLOCK CONTROL WORD SCRATCH
 BMSG     BSS    3           B-DISPLAY MESSAGE AREA
 BREAK    BSSZ   1           TERMINAL DISABLE ADDRESS
 
 CATSKL   BSSZ   4           DUMMY PFC SKELETON FOR DUMPING LOCAL FILES
          VFD    6/FCPR,6/PTRD,48/0
          DATA   0
          VFD    3/RSNP,3/BRNO,6/0,48/0
          BSSZ   9
 
 CCIN     BSSZ   1           *Z* INPUT PARAMETER FLAG
 COPTION  BSSZ   1           CURRENT SELECTED OPTION
 DBDEFLG  BSS    1           DATABASE DEFINED FLAG
 DBE      BSSZ   UDBEL       DATA BASE ENTRY
 DBNAM    BSS    1           DATABASE FILE NAME
 DBPN     BSS    1           DATABASE PACK NAME
 DBPW     BSSZ   1           DATABASE PASSWORD
 DBUN     BSS    1           DATABASE USER NAME
 DUMPDT   BSSZ   1           TODAY-S DATE IN PACKED JULIAN
 DUMPLOC  DATA   0           FLAG FOR DUMPING LOCAL FILE
 DUMPNUM  DATA   0           PREVIOUS DUMP FILE POSITION
 EOIFLG   BSS    1           FLAG EOI FOR COPY (NO DATABASE)
 EOR      BSSZ   1           EOR FLAG FOR READING FROM BATCH INPUT
 EORWORD  DATA   0           EOR SECTOR TRAILER WORD
 EOFWORD  VFD    12/17B,48/0 EOF SECTOR TRAILER WORD
 EORUN    DATA   0           FLAG FOR END OF RUN IN MERGESORT
 
 FIBK     VFD    42/0LTAPE,6/FIBKL,12/1  *FILINFO* DATA BLOCK
 FIBSTA   BSSZ   1           STATUS
 FIBEST   BSSZ   1           EST ORDINAL
 FIBLEN   BSSZ   2           FILE LENGTH
 FIBVSN   VFD    54/0,6/4    VSN
 FIBDEN   VFD    54/0,6/2    DENSITY
 FIBKL    EQU    *-FIBK      LENGTH OF *FILINFO* DATA BLOCK
 
 HDRJDT   DATA   0           *PFDUMP* HEADER DATE CONVERTED TO JULIAN
 
 HDRCTL   VFD    42/0LPFDUMPR,9/1,9/HDRSZ
 HDRPFD   VFD    36/0LPFDUMP,24/0        DUMP HEADER ID
          VFD    42/0LREEL,18/1
          VFD    42/0LMASK,18/377B       ALLOW ANY USER INDEX
 HDRDT    BSSZ   1                       DUMP DATE * YY/MM/DD.*
 HDRTM    BSSZ   1                       DUMP TIME * HH.MM.SS.*
 FAMILY   BSSZ   1                       USER-S FAMILY
 HDRPN    BSSZ   1                       PACK NAME / DEVICE TYPE
 HDRL     EQU    *-HDRPFD
          BSSZ   /COMSPFS/AFLBL-HDRL
 HDRSZ    EQU    *-HDRPFD
 
 IDT      DATA   1           TERMINAL INPUT ASSIGNMENT FLAG
 INDXLEN  BSSZ   1           LENGTH OF OPLD INDEX
 INDXNAM  BSSZ   2           USER NAME/PRU COUNT WORKING STORAGE AREA
 JOBORIG  BSSZ   1           JOB ORIGIN INFORMATION
 LAD      BSSZ   1           LAST ACCESS DATE FROM PFC IF AVAILABLE
 LDFN     CON    0LZZZZZG2   SCRATCH FILE LFN FOR *LOAD* PROCESSING
 LINDFP   DATA   10H RECLAIM:   DAYFILE PREFIX FOR DIRECTIVE LINE
 LINE     BSSZ   9           INPUT LINE ARRAY
 LN       DATA   0           LINE NUMBER COUNTER REGISTER
 LOADFLG  DATA   0           BATCH LOAD FLAG
 
 LOF      DATA   3           LENGTH OF LIST-OF-FILES
          VFD    42/0LOUTPUT,18/O  L.O.F. ENTRY FOR *OUTPUT*
          CON    0           L.O.F. TERMINATOR
 
 LOFPTR   VFD    12/0,18/LOF,30/1    L.O.F. POINTER WORD
 
 MEMORY   DATA   0
 MLPP     CON    LINP        MAXIMUM LINES PER PAGE
 MRFILE   DATA   0           MOST RECENT FILE PROCESSED
 MRUSER   DATA   0           MOST RECENT USER PROCESSED
 MSV      BSS    1           MASS STORAGE VARIABLE
 NAP      DATA   0           NO ABORT PARAMETER FLAG
 NFP      DATA   0           NUMBER OF FILES PROCESSED
 NHV      DATA   0           HEADER OPTION VARIABLE
 NOEQV    DATA   0L&lt;[][]>    NON-EQUIVALENCED VARIABLE FLAG
 NOBREAK  DATA   0           FLAG FOR PROCESSING/IGNORING BREAKS
 NLVIFLG  BSS    1           SET DATABASE JUST CREATED FLAG
 NOPRU    BSS    1           FULL PRU FLAG
 NRUNS    DATA   0           TOTAL RUNS FOR A GIVEN MERGESORT PASS
 NVV      DATA   0           DUMP FILE *NO VALIDATION* VARIABLE
 ODT      DATA   1           TERMINAL OUTPUT ASSIGNMENT POINTER
 OLINE    BSSZ   OLENGTH     OUTPUT LINE
 OPLDH    DATA   77000016000000000000B
 OPNO     DATA   1LN
 OPNTAPE  DATA   5LNTAPE
 OPTAPE   DATA   4LTAPE
 OPYES    DATA   1LY
 PFCNT    BSS    1           COUNTER FOR PFTAB POSITION
 PG       DATA   0           PAGE NUMBER COUNTER REGISTER
 PPFLAG   BSSZ   1           PPF CALLED FLAG
 PRUHEAD  VFD    6/0,18/PRUSIZE,36/0  BLANK PRU HEADER
 RBPF     DATA   0           REPRIEVE BYPASS FLAG
 RDT      BSS    1           RESIDENCE DEVICE TYPE FOR DATABASE
 RECSET   DATA   0           CHARACTER SET MODE CHANGED FLAG
 ROLLTIM  DATA   10          DEFAULT ROLLOUT TIME FOR BUSY FILES
 RPCL     BSS    1           COPY TO CURRENT LOCATION FLAG
 SALVAGE  DATA   0           FLAG FOR RESTORING DATABASE
 SCRFET   BSS    1           SCRATCH FET FILE NAME
 SECTOR   BSS    PRUSIZE+2   PRU BUFFER
 SITEDB   DATA   0           *USERDB* VALUE IF *S* COMMAND PARAMETER
 SAVEBUF  BSS    1           TEMPORARY STORAGE USED IN *DFT*
 SORR     BSS    ITEMSIZ     SORT RECORD AREA
 TMSTAT   BSS    1           INDICATE TMS STATUS
 TAPDFLT  BSS    0           TAPE DEFAULT VALUES
          QUAL   MTX
          VFD    51/0,2/DVNT,1/0,3/0,3/TFI
          QUAL   *
 TNN      BSSZ   1           NUMBER OF OCCURRENCES OF *TN*
 TRAILER  VFD    45/0,15/77000B  END-OF-DUMP CONTROL WORD
 UNLOAD   DATA   0           TMS FORCED UNLOAD FLAG
 UPE      BSSZ   UDBEL       UPDATE ENTRY
 USERDB   DATA   1HU         FLAG INDICATING USER DATABASE ACCESS
 VSNR     BSSZ   UDBEL       VSN INDEX UPDATE RECORD
 VSNCV    BSS    1           CURRENT VSN FOR MULTIREEL
 VSNDX    DATA   0L.VSNDX.   DUMMY USER NAME FOR VSN INDEX
 VSNFR    BSS    1           FILE AND RECORD FOR MULTIREEL
 VSNSV    BSS    1           SET VSN FOR MULTIREEL
 
 PFAC     BSSZ   1           ALTERNATE CATLIST
 PFNAM    BSSZ   1           PERMANENT FILE NAME
 PFCAT    BSSZ   1           FILE CATEGORY
 PFPERM   BSSZ   1           PERMISSION MODE
 PFUSER   BSSZ   1           USER NAME
 PFPASS   BSSZ   1           FILE PASSWORD
 PFUCW    BSSZ   1           USER CONTROL WORD
 PFDT     BSSZ   1           DEVICE TYPE
 PFSS     BSSZ   1           SUBSYSTEM
          TITLE  ERROR MESSAGES.
***       ERROR MESSAGES.
          SPACE  4,10
 EREI     DATA   C* DUMP FILE MALFUNCTION - EOI ENCOUNTERED.*
 ERFM     DATA   C* DUMP FILE MALFUNCTION - FILE NAME MISMATCH.*
 ERFT     DATA   C* DUMP FILE MALFUNCTION - FILE TRUNCATED.*
 ERPL     DATA   C* DUMP FILE MALFUNCTION - POSITION LOST.*
 ERUP     DATA   C* DUMP FILE MALFUNCTION - UNRECOGNIZABLE PFC.*
 ERND     DATA   C* NO DATA FOUND FOR USER NAME.*
 LDNG     DATA   C* SEE DAYFILE - UNABLE TO LOAD XXXXXXX.*
 ERTN     DATA   C* TN OR DN MUST BE SPECIFIED.*
          TITLE  MAIN LOOP.
 MAIN     SPACE  4,15
**        MAIN - MAIN LOOP.
*
*         *MAIN* MOVES DEFAULTS INTO THE VARIABLE TABLE, READS
*         THE INPUT LINE AND JUMPS TO THE DIRECTIVE SPECIFIED.
*
*         ENTRY  NONE.
*
*         EXIT   TO DIRECTIVE PROCESSOR.
*                TO *END* IF EOR/EOF ENCOUNTERED ON INPUT.
*
*         ERROR  TO *ABT* IF NON-INTERACTIVE JOB GETS DIRECTIVE ERROR.
*
*         CALLS  ARM, CUP, CVP, POP, USB.
*
*         MACROS BREAK, MESSAGE, READ, READC, WRITEC, WRITEW.
 
 
 MAIN8    RJ     CUP         CLEAN UP PROCESSING
 
*         PRESET VARIABLE TABLE BY MOVING *DEFAULT* TABLE INTO IT.
 
 MAIN     SB4    ARMTABL-1   END OF TABLE
 MAIN1    SA1    DEFAULT+B4  MOVE DEFAULT VALUE TO VARIABLE TABLE
          BX6    X1
          SA6    VARIABL+B4
          SB4    B4-B1
          PL     B4,MAIN1    IF MORE TO PRESET
 
*         READ LINE FROM INPUT FILE.
 
          SA1    IDT
          NZ     X1,MAIN1.1  IF NOT TERMINAL INPUT
          WRITEC O,MAINB     * ENTER DIRECTIVE.*
          READ   I,R
 MAIN1.1  READC  I,LINE,9
          BX6    X1          SAVE EOR STATUS
          SA6    EOR
          NZ     X6,END      IF EOR FOUND
          BREAK  2           PROCESS BREAK KEY
          SA1    ODT         CHECK FOR TERMINAL OUTPUT FILE
          ZR     X1,MAIN2    IF A TERMINAL OUTPUT FILE
          SA1    LN
          ZR     X1,MAIN1.2  IF NO OUTPUT
          WRITEC O,(=C*1*)   ISSUE PAGE EJECT
 MAIN1.2  WRITEW O,BLANKS,1  ISSUE SPACES TO MOVE LINE TO THE RIGHT
          WRITEC O,LINE,9    COPY DIRECTIVE TO LISTING FILE
 
*         CRACK INPUT LINE.
 
 MAIN2    MESSAGE  LINDFP,3,R  PLACE DIRECTIVE IN DAYFILE
          SX6    B0+         CLEAR PFN TABLE
          SA6    PFTAB
          SA6    PFCNT       CLEAR POINTER TO PFTAB
          SA6    NNTAB       CLEAR NEW NAME TABLE
          SA6    PPFLAG
          SA6    MSV         CLEAR MASS STORAGE FLAG
          SA6    TF+TTNV     CLEAR TAPE VSN IN DUMP FET
          SA6    MF+TTNV     CLEAR TAPE VSN IN COMPACT FET
          SB2    LINE        UNPACK LINE
          RJ     USB
          SX6    X6+B1       APPEND TERMINATOR TO INPUT LINE
          SA6    A6
          SX6    1R.
          SA6    B7+B1
          RJ     POP         PICK OUT DIRECTIVE VERB
          SA6    COPTION     SAVE VERB
          ZR     B6,MAIN3    IF NO PARAMETERS
          NG     B6,MAIN6    IF NO TERMINATOR FOUND
          NG     B5,MAIN6    IF EXCESS PARAMETERS FOUND
          SA0    B6          SET LWA IN STRING BUFFER
          SB3    ARMTAB      ADDRESS OF ARGUMENT TABLE
          RJ     ARM         MULTIPLE WORD ARGUMENT TABLE
          NZ     X1,MAIN6    IF ERROR
 MAIN3    RJ     CVP         CONVERT PARAMETERS IN EQUIVALENCE TABLE
 
*         SEARCH TABLE FOR DIRECTIVE.
 
          MX0    42
          SA1    COPTION     GET OPTION
          SA2    TDIR        START OF DIRECTIVE TABLE
 MAIN4    BX3    X0*X2
          ZR     X3,MAIN6    IF UNIDENTIFIABLE DIRECTIVE
          BX3    X1-X3
          ZR     X3,MAIN5    IF DIRECTIVE FOUND
          SA2    A2+B1
          EQ     MAIN4       CHECK NEXT DIRECTIVE
 
*         PRESET PAGE/LINE/NUMBER OF FILES COUNTS.
*         (X2) = DIRECTORY TABLE WORD.  (X0) = 42 BIT MASK.
 
 MAIN5    SA1    VSNDX
          BX6    X0*X1
          SA6    A1          INITIALIZE VSN INDEX ID/POINTER
          SA6    VSNR        SET VSN INDEX ID INTO VSN RECORD
          SX6    B0+
          SA6    LN
          SA6    NFP
          SA6    MRUSER      LAST USER NAME PROCESSED
          SA6    MRFILE      LAST PERMANENT FILE PROCESSED
          SA6    PG
          SA6    TNN         OCCURRENCES OF TAPE NUMBER
          SA6    DBDEFLG     CLEAR DATABASE DEFINED FLAG
          SA6    BMSG        CLEAR B-DISPLAY MESSAGE AREA
          BX1    -X0*X2      GET DIRECTIVE PROCESSOR ADDRESS
          SB3    X1
          JP     B3          JUMP TO PROCESSOR
 
*         PROCESS DIRECTIVE ERRORS.
 
 MAIN6    MESSAGE  MAINA,3   * DIRECTIVE ARGUMENT ERROR.*
          WRITEC O,MAINA
 MAIN7    SA1    IDT         CHECK FOR TERMINAL INPUT
          ZR     X1,MAIN     IF A TERMINAL THEN REPROMPT
          EQ     ABT         ABORT *RECLAIM*
 
 
 MAINA    DATA   C* DIRECTIVE ARGUMENT ERROR.*
 MAINB    DATA   C* ENTER DIRECTIVE.*
          TITLE  PROCESS *COMPACT* DIRECTIVE.
 COMPACT  SPACE  4,20
**        COMPACT - PROCESS *COMPACT* DIRECTIVE.
*
*         *COMPACT* WRITES A NEW DUMP TAPE FROM AN OLD ONE, REMOVING
*         ANY DELETED OR UNSELECTED FILES IN THE PROCESS.  *COMPACT*
*         EITHER REQUESTS A SECOND TAPE AND WRITES THE NEW DUMP THERE,
*         OR IT COPIES THE COMPACTED DUMP BACK OVER THE OLD TAPE.
*
*         ENTRY  NONE.
*
*         EXIT   DELETED FILES REMOVED.  DATABASE UPDATED.
*
*         USES   X - ALL.
*                A - ALL.
*
*         CALLS  CBR, CEI, LCV, LVI, MDL, PDB, PDF, POT, RDB, RNT, SBU,
*                SFC, SRT, UDV, UII, UPD, ZTB.
*
*         MACROS MESSAGE, MOVE, READ, READW, REWIND, SKIPF, SKIPFF,
*                UNLOAD, WRITEC, WRITEF, WRITEO, WRITER, WRITEW.
 
 
 COMPACT  BSS    0           ENTRY
 
*         CHECK FOR REQUISITE VSN.
 
          SA1    TF+TTNV     CHECK FOR A VSN
          NZ     X1,CMP1     IF A VSN WAS GIVEN
          MESSAGE  ERTN,3    * TN OR DN MUST BE SPECIFIED.*
          WRITEC O,ERTN
          EQ     MAIN8       RETURN TO MAIN LOOP
 
 CMP1     BX6    X1          PRESET OLD VSN FOR *NUMBERS* FILE
          SA6    CMPD
          SA1    OVV
          NZ     X1,CMP2     IF *OV* OPTION SELECTED
          SA1    MF+TTNV
          NZ     X1,CMP2     IF *CT* OR *CN* OPTION SELECTED
          MESSAGE  CMPA,3    * CT, CN OR OV KEYWORD NOT PRESENT.*
          WRITEC O,CMPA
          EQ     MAIN8       RETURN TO MAIN LOOP
 
 CMP2     SX7    PTRD        SET READ MODE FOR ATTACH
          SA1    PDBC        POINT TO WORKING USERNAME LOCATION
          BX5    X5-X5       SET UP TO ABORT IF ATTACH FAILS
          BX1    X1-X1       SET UP TO SCAN THE ENTIRE DATABASE
          RJ     PDB         POSITION DATABASE
          SX6    B0+         CLEAR COUNT OF FILES PROCESSED
          SA6    NFP
          SX6    377777B     SET FILE COUNT LIMIT
          RJ     SFC
          UNLOAD OPLDF
          UNLOAD UPDATES
          UNLOAD NUMBERS
          REWIND CF,R
          WRITE  OPLDF,*
          WRITE  UPDATES,*
          WRITE  NUMBERS,*
          WRITE  CF,*
 
*         READ DATABASE ENTRY.
 
 CMP3     RJ     RDB         READ A DATABASE ENTRY
          NZ     X1,CMP4     IF NO MORE VALID ENTRIES
          SA2    DBE+DBFNO   ENTRY WORD WITH TAPE POSITION
          MX0    -18
          AX2    18          RIGHT JUSTIFY TAPE POSITION
          BX6    -X0*X2      ISOLATE TAPE POSITION
          WRITEO CF          WRITE TAPE POSITION AS SORT KEY
          WRITEO CF          WRITE JUNK AS SECOND WORD OF SORT ENTRY
          WRITEW CF,DBE,DBEL WRITE DATABASE ENTRY INTO SORT ENTRY
          EQ     CMP3        LOOP FOR ANOTHER ENTRY
 
*         PROCESS END OF VALID DATABASE ENTRIES.
 
 CMP4     UNLOAD DB,R
          SA5    NFP
          ZR     X5,CMP20    IF NO FILES TO COPY
          WRITER CF,R        FLUSH OUT THE SORT FILE
          REWIND CF,R
          SX5    X5-1        CHECK IF ONLY ONE FILE TO COPY
          ZR     X5,CMP5     IF ONLY ONE FILE
          RJ     SRT         SORT ENTRIES BY TAPE POSITION
 CMP5     READ   CF,R        START UP READ ON SORTED FILE
          READW  CF,CMPB,ITEMSIZ  GET FIRST ITEM
 
*         READY TO REQUEST TAPE.
 
          SA1    OVV
          SA3    CMPC+DBRFL  GET WORD WITH TAPE FLAGS
          LX3    12
          MX6    -12         SET OUTPUT FLAGS SAME AS INPUT
          AX3    48
          BX6    -X6*X3
          SA6    MF+TFLAGS
          BX7    X1          PRESET FOR RING REQUIRED ON OLD DUMP
          ZR     X1,CMP6     IF NOT OVERWRITING OLD DUMP
          SX7    B1          SET RING REQUIRED ON OLD DUMP
 CMP6     SA7    TF+TRING    SET INPUT DUMP RING STATUS
          NG     X3,CMP9     IF NOT A TAPE DUMP
          SX5    B0+         ABORT IF DATABASE NOT FOUND
          SX7    PTRD        SET READ MODE FOR DATABASE ATTACH
          RJ     LVI         LOCATE VSN INDEX
          SA1    OVV
          NZ     X1,CMP9     IF OVERWRITING OLD DUMP
          NZ     X6,CMP7     IF NO VSN INDEX
          SA1    MF+TTNV
          SA3    MF+TMSV
          NZ     X3,CMP7     IF COMPACTING TO MASS STORAGE
          RJ     LEF         LOCATE EXISTING TAPE FLAGS
 CMP7     SX6    X6+         ISOLATE EXISTING FLAGS
          SA4    MF+TFLAGS   GET DEFAULT VALUES
          ZR     X6,CMP8     IF NO EXISTING TAPE FLAGS
          SA1    EIV
          BX4    X6          DEFAULT TO EXISTING FLAGS
          NZ     X1,CMP8     IF DUMPING AT *EOI*
          BX6    X6-X6       CLEAR EXISTING FLAGS FOR *BOI* DUMP
 CMP8     SX5    MF
          RJ     BTF         BUILD TAPE FLAGS FOR COMPACTED DUMP
 CMP9     SA3    CMPC+DBRFL  TAPE FLAGS FROM DUMP RECORD
          LX3    -36
          SA2    CMPB        DESIRED FILE/RECORD
          SA1    OVV
          ZR     X1,CMP10    IF NOT OVERWRITING OLD DUMP
          SX2    10001B      OVERWRITING - MUST GET FIRST REEL
 CMP10    SA1    TF+TTNV     DUMP VSN OR FILE NAME
          RJ     LCV         LOCATE CURRENT VSN
          SA2    OVV
          SX5    MF          SET OUTPUT TAPE FET ADDRESS
          ZR     X2,CMP11    IF NOT OVERWRITING ORIGINAL DUMP
          SX6    1
          SA6    FILENUM     RESET *MF* FILE COUNTER
          SA6    RECNUM      RESET *MF* RECORD COUNTER
          SA6    MF+TRING    INDICATE WRITE OPERATION
          SA1    MF+TDFV
          RJ     MDL         MAKE THE SCRATCH FILE LOCAL
          REWIND MF,R
          EQ     CMP13       BEGIN COPYING
 
 CMP11    RJ     ROD         REQUEST AND POSITION OUTPUT TAPE
          SA3    MF+TMSV
          SA1    MF+TFETVSN
          ZR     X3,CMP12    IF COMPACTING TO TAPE
          SA1    MF+TDNV
 CMP12    BX6    X1
          SA6    CMPD        SAVE NEW VSN FOR DATABASE ENTRIES
 
*         REPEAT COPY ONE FILE UNTIL SORT FILE EMPTY.
 
 CMP13    SA2    CMPC+DBFNO
          SA3    FILENUM     OUTPUT FILE COUNT
          SA4    RECNUM      OUTPUT RECORD COUNT
          MX0    -18         MASK FOR FILE/RECORD NUMBERS
          LX0    18
          BX6    X0*X2       CLEAR OLD TAPE POSITION
          LX3    12          POSITION NEW FILE COUNT
          BX3    X3+X4       MERGE FILE AND RECORD NUMBERS
          LX3    18
          BX6    X6+X3       INSERT NEW TAPE POSITION
          SA1    MF+TFLAGS
          MX0    -12         MASK FOR TAPE FLAGS
          LX0    36
          BX6    X0*X6       CLEAR OLD TAPE FLAGS
          LX1    36
          BX6    X1+X6       MERGE IN NEW FLAGS
          SA6    A2          REWRITE POSITION WORD
          SA2    CMPC+DBTNO  WORD WITH VSN
          SA3    CMPD        GET CORRECT VSN
          MX0    42
          LX6    59-47
          NG     X6,CMP14    IF PERMANENT FILE FLAG SET
          MX0    36          SET MASK FOR TAPE VSN
 CMP14    BX6    -X0*X2      SAVE BOTTOM OF VSN WORD
          BX3    X0*X3
          BX6    X3+X6       INSERT NEW VSN
          SA6    A2          REWRITE VSN WORD IN ENTRY
          SA0    CMPC
          RJ     POT         SHOW FILE BEING PROCESSED
          SA5    CMPB
          RJ     PDF         POSITION DUMP FILE
          NG     X5,CMP21    IF DUMP FILE POSITION ERROR
 
*         READY TO DO THE COPY.
 
          SX0    TF          SET INPUT FILE FET ADDRESS
          SX5    MF          SET OUTPUT FILE FET ADDRESS
          RJ     CBR         COPY ONE RECORD
          NZ     X1,CMP21    IF DUMP FILE POSITION ERROR
          SA1    OVV
          NZ     X1,CMP15    IF OVERWRITING ORIGINAL DUMP
          RJ     UDV         UPDATE OUTPUT DUMP VSN
 CMP15    SA1    CRC
          SX6    X1+B1       INCREMENT INPUT FILE RECORD COUNT
          SA6    A1
          SA4    RECNUM      OUTPUT FILE RECORD COUNT
          SX7    X4+B1       INCREMENT OUTPUT FILE RECORD COUNT
          SA7    A4
          WRITEW OPLDF,CMPC,UDBEL
          SA1    RECNUM      CHECK OUTPUT RECORD COUNTER
          SX2    7777B       MAXIMUM FILES PER TAPE FILE
          IX2    X2-X1       COMPUTE  (MAXIMUM - ACTUAL)
          NZ     X2,CMP16    IF HAVE NOT REACHED LIMIT
          SA3    FILENUM     OUTPUT FILE COUNTER
          SX6    1
          SX7    X3+1        INCREMENT FILE COUNTER
          SA6    A1          RESET OUTPUT RECORD COUNTER
          SA7    A3
          WRITEW MF,TRAILER,1
          WRITEF MF,R
          SA1    OVV
          NZ     X1,CMP16    IF OVERWRITING ORIGINAL DUMP
          SX5    MF          POINT TO OUTPUT DUMP FET
          RJ     UDV         UPDATE DUMP VSN
 CMP16    READW  CF,CMPB,ITEMSIZ  GET NEXT ENTRY
          ZR     X1,CMP13    IF ANOTHER ENTRY THEN HANDLE IT
          SA1    RECNUM      OUTPUT RECORD COUNTER
          SX1    X1-1        CHECK IF WAS JUST RESET
          ZR     X1,CMP17    IF COUNTER WAS RESET JUST ABOVE
          WRITEW MF,TRAILER,1
          WRITEF MF,R
          SA1    OVV
          NZ     X1,CMP17    IF OVERWRITING ORIGINAL DUMP
          SX5    MF          POINT TO OUTPUT DUMP FET
          RJ     UDV         UPDATE DUMP VSN
 CMP17    UNLOAD DB,R
          UNLOAD CF
          REWIND TF,R
          SA1    OVV         OVERWRITE FLAG
          ZR     X1,CMP18    IF NO OVERWRITE
          READ   TF,R        ENSURE INITIAL REEL MOUNTED
          REWIND TF,R
          REWIND MF,R
          SX0    MF          SET INPUT FET ADDRESS
          SX5    TF          SET OUTPUT FET ADDRESS
          SA1    TF+TTNV     SET OUTPUT VSN FOR OVERWRITE
          RJ     CEI         COPY WHOLE COMPACTED FILE OVER TAPE
          UNLOAD MF
          EQ     CMP19       JOIN WITH NEW TAPE CASE
 
*         WROTE A NEW TAPE.
 
 CMP18    SX5    MF          SET TAPE FET ADDRESS
          RJ     RNT         RESERVE AND UNLOAD COMPACTED TAPE
          SX6    B0+         SET DUMP/COMPACT FILE POSITIONS UNKNOWN
          SA6    CFC
          SA6    CRC
          SA6    FILENUM
          SA6    RECNUM
 
*         READY TO CLEAN UP AND RETURN.
 
 CMP19    WRITER OPLDF,R
          WRITER  NUMBERS,R
          RJ     SBU         SORT BY USER
          UNLOAD OPLDF,R
          SX5    B0+         FLAG ABORT ON DATABASE ATTACH
          RJ     UPD         UPDATE DATABASE
          EQ     MAIN8       RETURN TO MAIN LOOP
 
*         NO FILES PROCESSED.
 
 CMP20    MESSAGE  CMPF,3    * NO FILES SELECTED - NO ACTION TAKEN.*
          WRITEC O,CMPF
          EQ     MAIN8       RETURN TO MAIN LOOP
 
*         FILE NOT FOUND WHERE EXPECTED.
 
 CMP21    UNLOAD DB,R
          UNLOAD CF
          UNLOAD MF
          UNLOAD OPLDF
          UNLOAD NUMBERS
          SX5    TF
          SX1    B0+
          RJ     RNT         UNLOAD DUMP FILE IF TAPE
          SA1    TF+TDNV     PUT DUMP VSN OR FILE NAME INTO MESSAGE
          RJ     ZTB
          MX0    18
          SA1    CMPG+3
          BX1    X0*X1
          LX6    42
          BX6    -X0*X6
          BX6    X1+X6
          SA6    A1
          WRITEC O,CMPG
          SA1    NAP
          NZ     X1,MAIN8    IF NO ABORT SELECTED
          EQ     MAIN7       ABORT *RECLAIM* IF NOT INTERACTIVE
 
 
 CMPA     DATA   C* CT, CN OR OV KEYWORD NOT PRESENT.*
 CMPB     BSSZ   ITEMSIZ-DBEL
 CMPC     BSSZ   UDBEL       UPDATE ENTRY SIZE
 CMPD     DATA   0           CORRECT VSN FOR NEW DATABASE ENTRIES
 CMPF     DATA   C* NO FILES SELECTED - NO ACTION TAKEN.*
 CMPG     DATA   C* SEE DAYFILE - UNABLE TO COMPACT XXXXXXX.*
          TITLE  PROCESS *COPY* DIRECTIVE.
 COPY     SPACE  4,20
**        COPY - PROCESS *COPY* DIRECTIVE.
*
*         ENTRY  PARAMETERS FROM COMMAND LINE IN *ARMTAB*.
*                ENTERED AT *CPY1* FROM LOAD.
*
*         EXIT   SPECIFIED FILES COPIED TO DISK.
*
*         ERROR  TO *ABT* IF FILE COPY ERRORS AND *NA* NOT SPECIFIED.
*
*         USES   X - ALL.
*                A - 0, 1, 2, 3, 5, 6, 7.
*
*         CALLS  CDF, CTF, PDB, PDF, POT, RDB, RNT, SFC, SRT, UPD, ZTB.
*
*         MACROS BREAK, MESSAGE, READ, READW, REWIND, SKIPF, SKIPFF,
*                WRITEC, WRITEO, WRITER, WRITEW, UNLOAD.
 
 
 COPY     BSS    0           ENTRY
          SA1    =10H COPYING,     SET UP B-DISPLAY MESSAGE
          BX6    X1
          SA6    BMSG
          SX6    B0+         COPY FLAG
 CPY1     SA6    LOADFLG     SAVE LOAD/COPY STATUS
          BX7    X7-X7
          SX6    B1
          SA7    TF+TRING
          SA7    CPYA        CLEAR *COPY* TAPE FLAGS
          SA6    LVV         ENSURE ONLY LATEST VERSION PROCESSED
          SX6    7777B       SET MAXIMUM FILES PROCESSED
          RJ     SFC         SET FILE COUNT
          SA4    TAPDFLT     TAPE DEFAULTS FOR *BTF*
          SX5    TF
          SX6    B0+         IGNORE EXISTING TAPE FLAGS
          RJ     BTF         BUILD TAPE FLAGS
          SA1    DV
          ZR     X1,CPY2     IF DENSITY NOT SPECIFIED
          SA6    CPYA        SAVE TAPE FLAGS FOR LATER USE
 CPY2     SA1    DBNAM       DATA BASE NAME
          NZ     X1,CPY6     IF DATA BASE SPECIFIED
 
*         PROCESS WITH NO DATABASE
 
          SA1    TF+TTNV     TAPE NAME VARIABLE
          NZ     X1,CPY3     IF *TN* OR *DN* WAS GIVEN
          MESSAGE  ERTN,3    * TN OR DN MUST BE SPECIFIED.*
          WRITEC O,ERTN
          EQ     MAIN8       RETURN TO MAIN LOOP
 
 CPY3     SX5    TF
          RJ     RNT         REQUEST NEW TAPE
          REWIND TF,R
          SA1    PFV         PERMANENT FILE VARIABLE
          SA2    FNV         LOCAL FILE VARIABLE
          BX2    X2+X1
          SX6    B1
          SA6    CFC         RESET FILE NUMBER COUNTER
          SX6    B0+
          SA6    CRC         RESET RECORD NUMBER COUNTER
          ZR     X2,CPY4     IF PF OR NF NOT SET
          RJ     PPF         PROCESS PERMANENT FILE NAMES
 
*         CLEAR 6 WORD ENTRY FOR CTF CALL
 
 CPY4     SX6    B0+
          SA6    SORR
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          SA6    EOIFLG      CLEAR EOI ON DUMP FLAG
          SA1    CRC
          SX6    X1+B1       INCREMENT RECORD COUNTER
          MX0    -12
          BX6    -X0*X6
          SA6    A1
          NZ     X6,CPY5     IF NOT A PSEUDO FILE POINT
          SA1    CFC
          SX6    X6+B1
          SA6    A1
 CPY5     SA5    SORR
          RJ     CTF
          SA1    EOIFLG      EOI ON DUMP ENCOUNTERED FLAG
          NZ     X1,MAIN8    IF EOI ENCOUNTERED THEN CLEAR UP
          EQ     CPY4        LOOP FOR NEXT ENTRY
 
 CPY6     SA1    UNV
          SA2    TF+TTNV
          BX5    X1          SET DB CREATION MODE VIA UN OPTION
          ZR     X2,CPY7     IF TN WAS NOT ENTERED
          SA1    PDBC        POINT TO WORKING USER NAME LOCATION
          SX1    B0+         SET UP TO SCAN THE ENTIRE DATABASE
 CPY7     SX7    PTRD
          RJ     PDB         POSITION DATA BASE
 
*         WRITE FILE OF DATABASE ENTRIES TO PROCESS.
 
          WRITE  CF,*        PRESET WRITE FUNCTION
 CPY8     RJ     RDB         READ ENTRY FROM DATA BASE
          NZ     X1,CPY10    IF NO MORE
          BREAK              CHECK FOR INTERRUPT
          SA1    DBE+DBPFN   EXTRACT FILE NAME
          BX6    X0*X1
          SA1    DBE+DBFTY
          LX1    24
          BX2    -X0*X1
          BX6    X2+X6
          SA6    SORR
          LX1    18
          BX6    -X0*X1
          SA2    DBE+DBFLG   WORD WITH TAPE FLAGS
          LX2    59-47
          NG     X2,CPY9     IF PERMANENT FILE FLAG SET
          MX0    36          SET MASK FOR TAPE VSN
 CPY9     SA1    DBE+DBTNO   GET TN
          BX1    X0*X1
          BX6    X1+X6
          WRITEO CF
          WRITEW CF,SORR,1
          WRITEW CF,DBE,DBEL
          EQ     CPY8        LOOP FOR NEXT ENTRY
 
 CPY10    UNLOAD DB,R
          SA1    NFP
          NZ     X1,CPY11    IF THERE ARE FILES TO COPY/LOAD
          SA1    USERDB
          ZR     X1,MAIN8    IF NOT A USER DATABASE
          SA1    TF+TTNV
          ZR     X1,MAIN8    IF NO *TN* PARAMETER
          SA1    TNN         OCCURRENCES OF TN ON DATABASE
          NZ     X1,MAIN8    IF VSN FOUND ON DATABASE
          NG     X1,MAIN8    IF VSN FOUND FOR OTHER USER NAME
          SA1    UNV
          ZR     X1,MAIN8    IF UN=0 WAS SPECIFIED
          RJ     CDF         CREATE DATABASE FILE
          SA1    TNN
          ZR     X1,MAIN8    IF NO FILES ADDED TO DATA BASE
          SX5    -1          FLAG DEFINE ONLY
          RJ     UPD         UPDATE DATABASE
          SA1    LOADFLG
          BX6    X1          SET COPY
          EQ     CPY1        RESTART THIS COPY
 
 CPY11    WRITER CF,R
          REWIND CF,R
          RJ     SRT         MERGE SORT THE ENTRIES
          READ   CF
          SX5    B0+         ABORT IF DATABASE NOT FOUND
          SX7    PTRD        SET READ MODE FOR DATABASE ATTACH
          RJ     LVI         LOCATE VSN INDEX
 
*         WHILE NOT EOF(CF) DO ONE ENTRY.
 
 CPY12    BREAK
          READW  CF,SORR,ITEMSIZ
          NZ     X1,CPY14    IF END OF RECORD/FILE/INFO
          SA0    SORR+2      ADDRESS OF DATABASE ENTRY
          RJ     POT         TELL WHAT FILE WE ARE DOING
          SA1    SORR
          SA2    CPYA
          SA3    A1+B1       GET TAPE FLAGS
          ZR     X2,CPY13    IF DENSITY NOT SPECIFIED
          BX6    X2-X3
          SX5    4400B       CHECK DISK/TAPE AND NT/MT
          BX6    X5*X6
          NZ     X6,CPY13    IF DISK/TAPE OR NT/MT MISMATCH
          BX3    X2          SUBSTITUTE SPECIFIED FLAGS
 CPY13    BX2    X1          GET FILE AND RECORD NUMBER INTO X2
          RJ     LCV         LOCATE CURRENT VSN, REQUEST TAPE
          SA5    SORR
          RJ     PDF         POSITION DUMP FILE
          NG     X5,CPY15    IF AN ERROR HAS OCCURRED
          SA5    SORR
          RJ     CTF
          SA1    CRC         INCREMENT CURRENT RECORD COUNT
          SX6    X1+B1
          SA6    A1
          SX5    TF
          RJ     UFV         UPDATE FET VSN
          EQ     CPY12       PROCESS NEXT ENTRY
 
 CPY14    UNLOAD CF,R
          UNLOAD DB,R        UNLOAD DATABASE
          EQ     MAIN8       RETURN TO MAIN LOOP
 
*         COPY ABORT.
 
 CPY15    REWIND TF,R
 
*         BUILD ERROR MESSAGE.
 
          SA1    SORR+1
          MX0    42
          BX1    X0*X1       FILE NAME
          RJ     ZTB         CONVERT BINARY ZEROES TO BLANKS
          MX0    42
          SA1    LDNG+3
          BX6    X0*X6       EXTRACT TOP SEVEN CHARACTERS
          BX1    -X0*X1      BOTTOM OF MESSAGE
          BX6    X6+X1       MERGE PIECES TOGETHER
          SA6    LDNG+3
 
*         CHECK RA+0 TO SEE IF WE TOOK AN ERROR EXIT OR FELL
*         THROUGH FROM *CPY15*.  IF THERE WAS NO ERROR EXIT THEN
*         ENSURE TAPE AND VARIABLES SHOW -EOR- ON TAPE.
 
          SA2    B0          FETCH RA+0
          AX2    24          IGNORE SENSE SWITCHES, IF ANY
          NZ     X2,CPY17    IF THERE WAS AN ERROR EXIT THEN STOP NOW
          WRITEC O,LDNG      * SEE DAYFILE - UNABLE TO LOAD XXXXXXX.*
          RJ     ILC         INCREMENT LINE COUNT
          MX0    -7          WIDTH OF *CIO* FUNCTION CODE
          SA1    TF
          LX0    2           SKIP BINARY/CODED AND COMPLETE BITS
          BX1    -X0*X1      EXTRACT FUNCTION CODE/STATUS
          SX1    X1-17B      POS. IF EOR/EOF, NEG. IF COMPLETE READ
          PL     X1,CPY16    IF READ HIT AN EOR/EOF
          SKIPF  TF,1,R      SKIP TO END OF CURRENT RECORD
 CPY16    SA1    CRC         CURRENT RECORD COUNT
          SX6    X1+B1       INCREMENT RECORD COUNT
          SA6    A1          JUST IN CASE *NA* SET
          SA1    NAP
          NZ     X1,CPY12    IF NO ABORT PARAMETER SELECTED
 CPY17    UNLOAD CF
          EQ     ABT         ABORT *RECLAIM*
 
 
 CPYA     BSS    1           STORAGE FOR SPECIFIED TAPE FLAGS
          TITLE  PROCESS *DELETE*/*RESET* DIRECTIVES.
 DELETE   SPACE  4,20
**        DELETE - PROCESS *DELETE*/*RESET* DIRECTIVES.
*
*         ENTRY  *COPTION* INDICATES *DELETE* OR *RESET* DIRECTIVE.
*
*         EXIT   *DELETE*/*RESET* COMPLETE.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 0, 1, 2, 3, 5, 6, 7.
*                B - 4.
*
*         CALLS  CRI, PDB, POT, SFC.
*
*         MACROS CLEAR, READ, REWRITE, REWRITER.
 
 
 DELETE   BSS    0           ENTRY
          SX7    PTWR        SET WRITE MODE FOR ATTACH
          SX5    B0+         FLAG ABORT IF ATTACH FAILS
          SA1    UNV         SET FOR CURRENT USER NAME
          RJ     PDB         POSITION DATA BASE
          PL     X5,DLT1     IF USER RECORD FOUND
          MESSAGE  ERND,3    * NO DATA FOUND FOR USER NAME.*
          WRITEC O,ERND
          EQ     MAIN8       RETURN TO MAIN LOOP
 
 DLT1     SX6    B1
          ZR     X5,DLT2     IF USERNAME NOT SELECTION CRITERION
          BX6    X5          SAVE RANDOM ADDRESS OF USER
 DLT2     SA6    DLTA        SAVE RANDOM INDEX
          SX6    377777B     SET DEFAULT FILE COUNT
          RJ     SFC         SET FILE COUNT
          SX6    B0+
          SA6    DLTC
          SA6    DLTB
          SA6    LAD
          SA5    PFV
          MX6    -1
          LX5    6
          SA6    DLTD
          SX5    X5-1R*
          NZ     X5,DLT4     IF NO PF=*
          RJ     PPF         PROCESS PERMANENT FILES
          EQ     DLT4        CHECK FOR EOI ON DATABASE
 
*         SAVE RANDOM INDEX FROM PREVIOUS READ.
 
 DLT3     CLEAR  DB          CLEAR FET POINTERS
          MX0    30
          SA1    DB+6
          BX6    X0*X1       CURRENT RANDOM INDEX
          LX6    30
          SA6    DLTA
          READ   DB,R
 
*         CHECK FOR EOI ON DATABASE.
 
 DLT4     SA5    DB
          LX5    59-9
          NG     X5,DLT14    IF HIT EOI
          SX6    B0          RESET DELETE COUNT FOR CURRENT BUFFER
          SA6    DLTC
          LX5    9-59        MOVE FET FIRST WORD BACK IN PLACE
          MX0    -6
          BX5    -X0*X5      EXTRACT BUFFER FULL/EOR/EOF STATUS
          SX6    X5-17B      .GT. 0 IF SHORT PRU, .LT. 0 IF BUFFER FULL
          SA6    DLTD        SAVE RESULT FOR REWRITE
          SA1    DB+3        OUT
          SX6    X1-DBEL
          SA6    DLTB        ADDRESS OF CURRENT RECORD BEING READ
 
*         CHECK FOR EMPTY READ -- I.E. DISK ERROR.
 
          SA2    DB+2        IN
          BX1    X1-X2
          ZR     X1,DLT3     IF EMPTY READ
 
*         IF *RESET* SET DELETE VARIABLE TO FOOL *CRI*.
 
          SA1    COPTION
          SA2    =0LRESET
          BX6    X1-X2
          NZ     X6,DLT5     IF *DELETE* DIRECTIVE*
          SX6    B1+
          SA6    DEV
 DLT5     SA1    DLTB
          SA2    DB+2        IN
          SX6    X1+DBEL
          IX2    X6-X2
          PL     X2,DLT14    IF CURRENT BUFFER EXHAUSTED
          SA6    A1
          SA0    X6          KEEP *CRI* HAPPY
          SX5    -1          PRESET EXIT FLAG
          MX0    42
          SA1    X6
          SA2    OPLDH       OPLD HEADER
          BX2    X1-X2
          BX1    X0*X1       USER NAME
          ZR     X2,DLT14    IF OPLD RECORD (NO MORE USER NAMES)
          SA2    VSNDX       VSN INDEX IDENTIFIER
          BX2    X1-X2
          ZR     X2,DLT14    IF VSN INDEX (NO MORE USER NAMES)
          SA2    UNV
          ZR     X2,DLT6     IF UN=0 IN EFFECT
          BX2    X0*X2       STRIP PRU COUNT
          BX1    X1-X2
          NZ     X1,DLT14    IF DONE PROCESSING SELECTED USER NAME
 DLT6     RJ     CRI         CHECK CRITERIA
 
*         IF *CRI* RETURNS A NONZERO RESULT (CRITERIA NOT MET) THE
*         RESULT MAY BE NEGATIVE.  THIS MUST BE REMOVED FOR THE
*         TEST AT *DLT17*.
 
          SX1    B0+
          IX5    X5+X1       REMOVE ANY NEGATIVE ZERO, JUST IN CASE
          CX5    X5          MAKE POSSIBLY NEGATIVE RESULT POSITIVE
          NZ     X5,DLT5     IF CURRENT RECORD DOES NOT MEET CRITERIA
 
*         DECIDE WHETHER *RESET* OR *DELETE* WAS CALLED.
 
          SA3    DEV         IF SET -- RESET OPTION CALLED
          MX7    1           PRESET DELETE BIT
          SA1    A0+DBFLG
          NZ     X3,DLT7     IF RESET
          NG     X1,DLT5     IF FILE DELETED PREVIOUSLY
          BX7    X7+X1       SET DELETE FLAG
          EQ     DLT8        CHECK FILE LIMIT
 
 DLT7     PL     X1,DLT5     IF FILE NOT DELETED
          BX7    -X7*X1      CLEAR DELETE FLAG
 
 
*         CHECK FILE LIMIT/INCREMENT FILE COUNT.
 
 DLT8     SA2    PFV
          LX2    6
          SX2    X2-1R*
          NZ     X2,DLT12    IF NOT PF=*
          SA2    PFTAB-1
          MX0    42
          SA3    A0+DBPFN
          BX3    X0*X3
 DLT9     SA2    A2+B1
          ZR     X2,DLT10    IF END OF PFTAB TABLE
          BX6    X0*X2
          BX6    X6-X3
          NZ     X6,DLT9     IF NOT CORRECT FILE IN TABLE
          SA3    DEV         DELETE FLAG
          ZR     X1,DLT11    IF NOT *RESET*
          SA3    EXV         EXCEPTION PROCESSING FLAG
          ZR     X3,DLT11    IF NOT EXCEPTION PROCESSING
          IX5    X5-X5       CLEAR ALL DONE FLAG
          EQ     DLT14       DO NOT PROCESS THIS FILE
 
 DLT10    SA3    DEV         DELETE FLAG
          ZR     X3,DLT12    IF NOT *RESET*
          SA3    EXV         EXCEPTION FLAG
          NZ     X3,DLT12    IF NOT EXCEPTION PROCESSING
          IX5    X5-X5       CLEAR ALL DONE FLAG
          EQ     DLT14       DO NOT PROCESS THIS FILE
 
 DLT11    BX2    -X0*X2
          SA3    NFP
          SX6    X3+1
          IX3    X6-X2
          SA2    NFV
          IX2    X2-X3
          SX2    X2-1
          NG     X2,DLT14    IF FILE LIMIT EXCEEDED FOR THIS FILE
          EQ     DLT13       INCREMENT FILE COUNT
 
 DLT12    SA2    NFV
          SA3    NFP
          SX6    X3+1
          IX5    X2-X6
          NG     X5,DLT14    IF FILE LIMIT EXCEEDED -- EXIT FLAG SET
 DLT13    SA6    A3
          SX6    B1          SET CURRENT BUFFER DELETE/RESET FLAG
          SA6    DLTC
 
*         SET DELETE/RESET FLAG.
 
          SA7    A1
          RJ     POT         PROCESS OUTPUT
          EQ     DLT5        CONTINUE BUFFER PROCESSING
 
*         REWRITE CURRENT BUFFER IF RECORDS TO BE CHANGED.
 
 DLT14    SA1    DLTC        DELETE FLAG FOR CURRENT BUFFER
          SB4    X1
          ZR     B4,DLT17    IF NO DELETES FOR THIS BUFFER
 
*         PREPARE REWRITE - MOVE PREVIOUS RANDOM REWRITE VALUE
*         AND SET REWRITE BIT IN FET+6.
 
          SA1    DLTA
          SX6    B1
          LX6    29
          BX6    X6+X1
          SA6    DB+6
 
*         REWRITE CURRENT BUFFER -- IF EOR STATUS PERFORM *REWRITER*.
 
          SA1    DLTD
          PL     X1,DLT15    IF A SHORT PRU
          REWRITE  DB,R
          EQ     DLT16       REJOIN WITH REWRITER
 
*         SHORT PRU TO REWITE.
 
 DLT15    REWRITER  DB,R
          SX6    -1
          SA6    DLTD        RESET TO FULL PRU JUST IN CASE
 
*         CLEAR RANDOM REWRITE BIT.
 
 DLT16    SA1    DB+6
          MX0    30
          BX6    X0*X1
          SA6    A1
 DLT17    NG     X5,MAIN8    IF ALL DONE
          EQ     DLT3        READ NEXT BUFFER
 
 
 DLTA     DATA   0           PREVIOUS RANDOM INDEX ON DATABASE
 DLTB     DATA   0           ADDRESS OF CURRENT RECORD BEING READ
 DLTC     DATA   0           DELETE FLAG FOR CURRENT BUFFER
 DLTD     DATA   -1          DEFAULT FULL PRU REWRITE
          TITLE  PROCESS *DUMP* DIRECTIVE.
 DUMP     SPACE  4,20
**        DUMP - PROCESS *DUMP* DIRECTIVE.
*
*         ENTRY  NONE.
*
*         EXIT   FILES DUMPED TO TAPE.
*
*         ERROR  TO *ABT* IF TAPE ALREADY HAS 63 DUMPS ON IT.
*
*         USES   X - ALL.
*                A - 0, 1, 2, 3, 5, 6, 7.
*
*         CALLS  ADB, BTF, CDF, CDR, CRI, CVT, DFT, POT,
*                RNT, SDE, SFC, UPD.
*
*         MACROS BREAK, CATLIST, CLEAR, MESSAGE, READ, READO, REWIND,
*                SKIPFF, UNLOAD, WRITEC, WRITEF, WRITER, WRITEW.
 
 
 DUMP     BSS    0           ENTRY
          SA1    =10H DUMPING,     SET UP B-DISPLAY MESSAGE
          BX6    X1
          SA6    BMSG
          SX6    7777B       MAXIMUM FILES DUMPED PER DIRECTIVE
          RJ     SFC         SET FILE COUNT LIMIT
          SA1    USERDB
          NZ     X1,DMP1     IF A USER DATABASE
          SA1    ACCESS
          NZ     X1,DMP1     IF A PRIVILEGED USER
          MESSAGE  DMPA,3    * DUMP DENIED FOR SPECIFIED DATABASE.*
          WRITEC O,DMPA
          EQ     MAIN        RETURN TO MAIN LOOP
 
 DMP1     SA1    TF+TMSV     MASS STORAGE VARIABLE
          NZ     X1,DMP2     IF DUMP FILE IS MASS STORAGE
          SA1    TF+TTNV     TAPE NAME VARIABLE
          NZ     X1,DMP2     IF TN SPECIFIED
          MESSAGE  ERTN,3    * TN OR DN MUST BE SPECIFIED.*
          WRITEC O,ERTN
          EQ     MAIN        RETURN TO MAIN LOOP
 
 DMP2     SX7    PTWR        SET TO ATTACH DATA BASE IN WRITE MODE
          SX5    -1          SET TO CREATE DATA BASE IF NOT FOUND
          RJ     LVI         SET DATABASE IN WRITE MODE AT VSN INDEX
          NZ     X6,DMP3     IF NO VSN INDEX
          SA1    TF+TTNV
          SA3    TF+TMSV
          RJ     LEF         LOCATE EXISTING TAPE FLAGS
 DMP3     SX6    X6+
          SA4    TAPDFLT     SET DEFAULT TAPE FLAGS
          ZR     X6,DMP4     IF NO EXISTING TAPE FLAGS
          SA1    EIV
          BX4    X6          DEFAULT TO EXISTING FLAGS
          NZ     X1,DMP4     IF DUMPING AT *EOI*
          BX6    X6-X6       CLEAR EXISTING FLAGS FOR *BOI* DUMP
 DMP4     SX5    TF
          RJ     BTF         BUILD TAPE FLAGS
          SA1    PFV         PERMANENT FILE VARIABLE
          SA2    FNV         LOCAL FILE VARIABLE
          IX6    X1+X2
          ZR     X6,DMP5     IF NOT PART OF CRITERIA
          RJ     PPF         PROCESS PERMANENT FILE CRITERIA
 DMP5     WRITE  OPLDF,*     PRESET WRITE FUNCTION
          SA0    DBE
          MX6    0
          SA6    CAT+CFPN    CLEAR CATLIST FILE NAME
 DMP6     SA1    PFTAB
          ZR     X1,DMP9     IF NO PERMANENT FILE LIST
          SA1    EXV
          NZ     X1,DMP9     IF EXCEPTION PROCESSING IN EFFECT
          SA2    PFCNT       GET PFTAB POINTER
          SA1    PFTAB+X2    PFTAB(PFCNT)
          ZR     X1,DMP21    IF ALL FILES PROCESSED
          MX0    42
          BX6    -X0*X1
          BX1    X0*X1       ISOLATE FILE NAME
          LX6    58          POSITION TO LOCAL FILE FLAG
          PL     X6,DMP8     IF FILE NOT LOCAL
          SA2    CATSKL
          BX2    -X0*X2      ISOLATE USER INDEX
          BX6    X1+X2       MERGE FILE NAME AND USER INDEX
          SA6    CATBUF
          SA2    FIBK
          BX2    -X0*X2
          BX6    X1+X2
          SA6    A2+         SET FILE NAME INTO *FILINFO* BUFFER
          FILINFO  FIBK
          SA1    FIBLEN      GET FILE LENGTH IN SECTORS
          MX0    24
          BX6    X0*X1
          SA1    TYV         TYPE VARIABLE
          LX1    6
          SX2    X1-1RI
          ZR     X2,DMP7     IF FILE IS TO BE INDIRECT
          SX2    4000B       DIRECT FLAG
          BX6    X2+X6
 DMP7     SA6    CATBUF+FCLF  SAVE FILE SIZE AND TYPE
          MOVE   NWCE-2,CATSKL+2,CATBUF+2  MOVE REST OF DUMMY PFC
          EQ     DMP11       PROCESS CATLIST INFORMATION
 
 DMP8     BX6    X1
          SA6    CATBUF      SAVE FILE NAME
          SX0    4+1         SET *SA* AND *EP* BITS IN FET
          LX0    44
          SA1    CAT+B1      FET +1
          BX6    X0+X1
          SA6    A1
          CATLIST  CAT,CATBUF
          MOVE   NWCE,CLSBUF,CATBUF  MOVE TO WORKING BUFFER
          CLEAR  CAT
          SA2    CAT+1       CLEAR *SA* AND *EP* BITS
          SX0    4+1
          LX0    44
          BX6    -X0*X2
          SA6    A2+
          SA1    CAT         CHECK FOR ERRORS
          MX0    8
          LX0    17-59       POSITION MASK FOR ERROR CODE FIELD
          BX2    X0*X1
          ZR     X2,DMP11    IF NO ERROR
          SA1    PFCNT       POINTER IN PFTAB
          SX6    X1+B1
          SA6    A1          INCREMENT COUNTER
          EQ     DMP6        PROCESS NEXT ENTRY
 
 DMP9     CATLIST  CAT       FILL *CATLIST* BUFFER
 
 DMP10    READW  CAT,CATBUF,NWCE  READ CATALOG ENTRY
          ZR     X1,DMP11    IF ENTRY AVAILABLE
          SX1    X1+2
          ZR     X1,DMP21    IF END OF CATALOG
          EQ     DMP9        REFILL BUFFER
 
 DMP11    SA3    CATBUF
          RJ     CDR         CREATE DATABASE RECORD FROM CATLIST
          SA5    RSV
          ZR     X5,DMP14    IF FILE RESIDENCE NOT SPECIFIED
          LX5    59-4        CHECK FOR DISK RESIDENCE
          PL     X5,DMP12    IF DISK RESIDENCE NOT SPECIFIED
          MX0    -12
          SA1    CATBUF+FCBT
          LX0    12
          BX1    -X0*X1
          NZ     X1,DMP14    IF DISK RESIDENT
 DMP12    LX5    59-3-59+4   CHECK FOR CARTRIDGE RESIDENCE
          MX0    -36
          PL     X5,DMP13    IF CARTRIDGE RESIDENCE NOT SPECIFIED
          SA1    CATBUF+FCAA
          BX0    -X0*X1
          LX1    59-48
          ZR     X0,DMP13    IF NOT CARTRIDGE RESIDENT
          PL     X1,DMP14    IF CARTRIDGE COPY NOT OBSOLETE
 DMP13    LX5    59-20-59+3
          MX0    -24
          PL     X5,DMP15    IF RESIDENCE CRITERIA NOT MET
          SA1    CATBUF+FCTV
          BX1    -X0*X1
          ZR     X1,DMP15    IF RESIDENCE CRITERIA NOT MET
 DMP14    RJ     CRI         CHECK CRITERIA
          ZR     X5,DMP16    IF CRITERIA MET
 DMP15    SA1    PFTAB       PERMANENT FILE TABLE
          ZR     X1,DMP10    IF NO FILES SPECIFIED
          SA1    EXV
          NZ     X1,DMP10    IF EXCEPTION PROCESSING IN EFFECT
          SA1    PFCNT       POINTER TO CURRENT FILE IN PFTAB
          SX6    X1+B1       INCREMENT POINTER
          SA6    A1
          EQ     DMP6        GET NEXT FILE NAME
 
 DMP16    SA1    NFV         NUMBER OF FILES PROCESSED
          SA2    NFP         NUMBER OF FILES PROCESSED
          SX6    X2+1
          IX5    X1-X6
          NG     X5,DMP21    IF USER LIMIT EXCEEDED
          SX1    7777B       MAXIMUM FILES DUMPED AT ONCE
          IX5    X1-X6       COMPUTE  (MAXIMUM-ACTUAL)
          NG     X5,DMP21    IF IMPOSED FILE LIMIT EXCEEDED
          NZ     X2,DMP17    IF TAPE ALREADY ASSIGNED
          SX5    TF
          RJ     ROD         REQUEST AND POSITION DUMP
          SA1    DBE+DBFNO
          SA2    CFC         GET ACTUAL POSITION FOR DATABASE ENTRY
          SA3    CRC
          MX0    -30         MASK FOR TAPE FLAGS, FILE AND RECORD
          LX0    18          POSITION MASK FOR FLAGS, FILE AND RECORD
          BX1    X0*X1       REMOVE ANY DEBRIS
          LX2    30          POSITION FILE NUMBER
          LX3    18          POSITION RECORD NUMBER
          BX6    X2+X3       MERGE FILE AND RECORD NUMBERS
          SA2    TF+TFLAGS   GET TAPE FLAGS, WHICH MAY HAVE CHANGED
          BX6    X1+X6
          LX2    36
          BX6    X2+X6       MERGE IN NEW TAPE FLAGS
          SA6    A1+
 DMP17    RJ     DFT         DUMP FILE TO TAPE
          NZ     X1,DMP20    IF ERROR IN DUMPING FILE
          SX5    TF
          RJ     UDV         UPDATE DUMP VSN
          SA1    CRC
          SX6    X1+B1
          SA6    A1          UPDATE RECORD NUMBER
          SA1    NFP
          SX6    X1+B1
          SA6    A1          UPDATE NUMBER OF FILES PROCESSED
          MX0    42
          SA1    NNV         NEW NAME VARIABLE
          BX6    X0*X1
          NZ     X6,DMP18    IF NO NEW NAME
          SA1    DBE+DBUNM   NNTAB OFFSET
          BX6    -X0*X1
          ZR     X6,DMP19    IF NO NEW NAME
          SA1    X6
          BX6    X0*X1
 DMP18    SA1    DBE+DBPFN   GET THE OLD FILE NAME
          BX1    -X0*X1      MASK OFF DUMP DATE
          BX6    X6+X1       NEW PFN AND DUMP DATE
          SA6    A1
 DMP19    SA1    TF+TTNV     GET VSN IN CASE ASSIGNED BY TMS
          MX0    42
          BX6    X0*X1       ISOLATE VSN
          SA1    DBE+DBTNO   VSN IN DATABASE RECORD
          BX1    -X0*X1      CLEAR THE VSN FIELD
          BX6    X1+X6       MERGE IN SET VSN
          SA6    A1
          WRITEW OPLDF,A0,UDBEL
          SX6    1           IGNORE BREAKS
          SA6    NOBREAK
          RJ     POT
          SX6    B0+         DEAL WITH BREAKS AGAIN
          SA6    NOBREAK
          SA1    BREAK
          NZ     X1,DMP21    IF USER INTERRUPT FLAG SET
 DMP20    SA1    PFTAB       PERMANENT FILE TABLE
          ZR     X1,DMP10    IF FILE NAME NOT PART OF CRITERIA
          SA1    EXV
          NZ     X1,DMP10    IF EXCEPTION PROCESSING IN EFFECT
          EQ     DMP6        PROCESS NEXT FILE
 
 DMP21    SA1    NFP         CHECK NUMBER OF FILES DUMPED
          ZR     X1,DMP23    IF NOTHING DUMPED DO NOT UPDATE DATA BASE
          WRITEW TF,TRAILER,B1  END-OF-DUMP CONTROL WORD
          WRITEF TF,R
          SX5    TF
          RJ     UDV         UPDATE DUMP VSN
          WRITER OPLDF,R     CLOSE OFF DATABASE UPDATE FILE
          WRITER  NUMBERS,R  CLOSE OFF TAPE NUMBERS FILE
          RJ     SDE         SORT DATABASE RECORDS
          CLEAR  NEW
          UNLOAD OPLDF,R
          SA1    EIV         CHECK IF EOI DUMP
          ZR     X1,DMP22    IF AN INITIAL DUMP
          SA1    DBDEFLG
          ZR     X1,DMP22    IF DATABASE WAS NOT DEFINED
          RJ     CDF         CREATE UPDATES FOR WHOLE TAPE
          SX5    B0+         SET ABORT IF ATTACH FAILS
 DMP22    RJ     UPD         UPDATE DATABASE
 DMP23    MX6    2           SET END OF INFORMATION INDICATOR
          LX6    1
          SA6    CRC
          EQ     MAIN8       RETURN TO MAIN LOOP
 
 
 DMPA     DATA   C* DUMP DENIED FOR SPECIFIED DATABASE.*
          TITLE  PROCESS *END* DIRECTIVE.
 END      SPACE  4,15
**        END - PROCESS *END* DIRECTIVE.
*
*         ENTRY  NONE.
*
*         EXIT   TAPE UNLOADED.
*                OUTPUT BUFFER FLUSHED.
*                * RECLAIM COMPLETE.* ISSUED TO DAYFILE.
*                *RECLAIM* TERMINATED.
*
*         USES   X - 1, 5.
*
*         CALLS  RNT.
*
*         MACROS ENDRUN, MESSAGE, WRITER.
 
 
 END      BSS    0           ENTRY
          SA1    TF+TFLAGS   CURRENT TAPE FLAGS
          LX1    59-11
          NG     X1,END1     IF MASS STORAGE FILE
          SX5    TF          SET TAPE FET ADDRESS
          SX1    B0+         FLAG ONLY UNLOAD TAPE
          RJ     RNT         RESERVE TAPE IF NECESSARY AND UNLOAD
 END1     SA1    RECSET
          ZR     X1,END2     IF CHARACTER SET MODE NOT CHANGED
          CSET   RESTORE     RESTORE ORIGINAL CHARACTER SET MODE
 END2     WRITER O,R
          MESSAGE  ENDA,3    * RECLAIM COMPLETE.*
          ENDRUN
 
 
 ENDA     DATA   C* RECLAIM COMPLETE.*
          TITLE  PROCESS *LIST* DIRECTIVE.
 LIST     SPACE  4,15
**        LIST - PROCESS *LIST* DIRECTIVE.
*
*         ENTRY  NONE.
*
*         EXIT   LIST PRODUCED.
*                INFORMATION RECOVERY ATTEMPTED FOR *TN* IF NOT FOUND
*                IN DATABASE.
*
*         USES   X - 1, 5, 6, 7.
*                A - 0, 1.
*
*         CALLS  CDF, PDB, POT, RDB, SFC, UPD.
 
 
 LIST     BSS    0           ENTRY
 
*         POSITION FOR DATABASE READING.
 
          SA1    DBNAM
          ZR     X1,LST3     IF NO DATA BASE
          SA1    UNV
          SA2    TF+TTNV
          BX5    X1          SET DB CREATION MODE VIA UN OPTION
          ZR     X2,LIST0    IF TN WAS NOT ENTERED
          SA1    PDBC        POINT TO WORKING USER NAME LOCATION
          SX1    B0+         SET UP TO SCAN THE ENTIRE DATABASE
 LIST0    SX7    PTRD
          RJ     PDB         POSITION DATABASE
          SX6    377777B     SET FILE COUNT
          RJ     SFC
 
*         PRINT NEXT DATABASE ENTRY MEETING SPECIFIED CRITERIA.
 
 LST1     RJ     RDB         READ NEXT DATABASE ENTRY
          NZ     X1,LST2     IF ALL DONE
          SA0    DBE         PROCESS OUTPUT
          RJ     POT
          EQ     LST1        READ NEXT ENTRY
 
*         CHECK IF NOTHING FOUND IN DATABASE FOR SPECIFIED *TN*.
 
 LST2     SA1    NFP
          NZ     X1,MAIN8    IF SOME FILES LISTED
          SA1    USERDB
          ZR     X1,MAIN8    IF NOT A USER DATABASE
          SA1    TF+TTNV
          ZR     X1,MAIN8    IF NO *TN* PARAMETER
          SA1    TNN         OCCURRENCES OF SPECIFIED TN ON DATABASE
          NZ     X1,MAIN8    IF TN FOUND AT LEAST ONCE
          NG     X1,MAIN8    IF VSN FOUND FOR OTHER USER NAME
          SA1    UNV
          ZR     X1,MAIN8    IF UN=0 WAS SPECIFIED
 
*         NO FILES FOR SPECIFIED *TN* ON DATABASE.  ATTEMPT RECOVERY.
 
          RJ     CDF         CREATE DATABASE FILE
          SA1    TNN
          ZR     X1,MAIN8    IF NO FILES ADDED TO DATA BASE
          SX5    -1          FLAG DEFINE ONLY FOR UPD
          RJ     UPD         UPDATE DATABASE
          EQ     LIST        RESTART *LIST* COMMAND
 
*         LIST FILES ON DUMP FILE ONLY
 
 LST3     RJ     CDF
          EQ     MAIN8       RETURN
          TITLE  PROCESS *LOAD* DIRECTIVE.
 LOAD     SPACE  4,10
**        LOAD - PROCESS *LOAD* DIRECTIVE.
*
*         ENTRY  NONE.
*
*         EXIT   TO *CPY1* TO PROCESS LOAD.
*
*         USES   X - 6.
 
 
 LOAD     BSS    0           ENTRY
          SA1    =10H LOADING,     SET UP B-DISPLAY MESSAGE
          BX6    X1
          SA6    BMSG
          SX6    B1          *LOAD* FLAG
          EQ     CPY1        PROCESS *LOAD*
          TITLE  PROCESS *REMOVE* DIRECTIVE.
 REMOVE   SPACE  4,15
**        REMOVE - PROCESS *REMOVE* DIRECTIVE.
*
*         ENTRY  NONE.
*
*         EXIT   TAPE REMOVED FROM DATABASE.
*
*         USES   X - 1, 5, 7.
*                A - 1, 7.
*
*         CALLS  UPD.
*
*         MACROS MESSAGE, WRITEC, WRITER, WRITEW.
 
 
 REMOVE   BSS    0           ENTRY
 
*         ENSURE *TN* SPECIFIED.
 
          MX0    6*6         MASK FOR TAPE VSN
          SA1    TF+TMSV
          ZR     X1,RMV0     IF MASS STORAGE DUMP NOT SPECIFIED
          MX0    7*6         MASK FOR MASS STORAGE FILE NAME
 RMV0     SA1    TF+TTNV
          NZ     X1,RMV1     IF TAPE NUMBER SPECIFIED
          MESSAGE  ERTN,3    * TN OR DN MUST BE SPECIFIED.*
          WRITEC O,ERTN
          EQ     MAIN        RETURN TO MAIN LOOP
 
*         VALIDATE ACCESS TO THIS DATABASE.
 
 RMV1     BX6    X0*X1
          SA1    USERDB
          NZ     X1,RMV2     IF A USER DATABASE SPECIFIED
          SA1    ACCESS
          NZ     X1,RMV2     IF USER HAS PRIVILEGES
          MESSAGE  RMVB,3    * REMOVE DENIED FOR SPECIFIED DATABASE.*
          WRITEC O,RMVB
          EQ     MAIN        RETURN TO MAIN LOOP
 
 RMV2     WRITEO NUMBERS     TAPE NUMBER TO REMOVE
          WRITER NUMBERS,R
          SX5    B0+         FLAG ABORT IF ATTACH FAILS
          RJ     UPD         UPDATE DATABASE
          EQ     MAIN8       RETURN TO MAIN LOOP
 
 
 RMVB     DATA   C* REMOVE DENIED FOR SPECIFIED DATABASE.*
          TITLE  PROCESS *SET* DIRECTIVE.
 SET      SPACE  4,15
**        SET - PROCESS *SET* DIRECTIVE.
*
*         ENTRY  (A0) = ADDRESS OF FIRST PARAMETER IN STRING BUFFER.
*
*         EXIT   DEFAULT OPTIONS RESET.
*
*         USES   X - 0, 1, 2, 6.
*                A - 1, 6.
*                B - 2, 3, 4, 6.
*
*         CALLS  ARM.
 
 
 SET      BSS    0           ENTRY
 
*         ZERO OUT VARIABLE TABLE.
 
          SX6    B0+
          SB3    VARIABL     BEGINNING OF VARIABLE TABLE
          SB4    ARMTABL-1   LENGTH OF TABLE
 SET1     SA1    B3+B4       CLEAR NEXT VARIABLE
          SA6    A1
          SB4    B4-B1
          GE     B4,B0,SET1  IF MORE IN TABLE TO CLEAR
 
*         PROCESS ARGUMENTS.
 
          SB3    ARMTAB
          SB6    A0
          RJ     ARM         PROCESS DIRECTIVE ARGUMENTS
          SB2    DEFAULT     BEGINNING OF DEFAULT TABLE
          SB3    VARIABL
          SB4    ARMTABL-1   END OF TABLE
 
*         CHECK NEXT OPTION.
 
 SET2     SA1    B3+B4       CURRENT TABLE ENTRY
          ZR     X1,SET6     IF WORD OF ALL ZEROES
 
*         CHECK FOR DISPLAY CODE ZERO.
 
          MX0    -6
          SB6    11D
 SET3     SB6    B6-B1
          ZR     B6,SET5     IF FULL WORD COMPLETED
          BX2    -X0*X1
          SX2    X1-1R0
          NZ     X2,SET4     IF INCOMING CHARACTER NOT DISPLAY ZERO
          SX1    X1-33B
 SET4     LX1    6
          EQ     SET3        CHECK NEXT CHARACTER
 
 SET5     BX6    X1          PUT CONTENTS OF OPTION INTO DEFAULT TABLE
          SA6    B2+B4
 SET6     SB4    B4-B1       DECREMENT TABLE
          GE     B4,B0,SET2  IF MORE TO CHECK
          EQ     MAIN        RETURN TO MAIN LOOP
          TITLE  PROCESS *UPDATE* DIRECTIVE.
 UPDATE   SPACE  4,15
**        UPDATE - PROCESS *UPDATE* DIRECTIVE.
*
*         ENTRY  FILE *UPDATES* CONTAINS ENTRIES TO ADD TO DATABASE.
*                FILE *NUMBERS* CONTAINS TAPE VSN-S.
*
*         EXIT   UPDATE COMPLETE.
*
*         USES   X - 5.
*
*         CALLS  UPD.
*
*         NOTE   UPDATES FILE MUST BE SORTED.
 
 
 UPDATE   BSS    0           ENTRY
          SX5    -1          FLAG DEFINE DATABASE IF POSSIBLE
          RJ     UPD         UPDATE DATABASE
          EQ     MAIN8       RETURN TO MAIN LOOP
          TITLE  PRIMARY SUBROUTINES.
 ABT      SPACE  4,10
**        ABT - ABORT PROCESSING.
*
*         ENTRY  SOME ERROR DETECTED.
*
*         EXIT   ALL FILES RETURNED.
*                ERROR MESSAGES ISSUED.
*                *RECLAIM* ABORTED.
*
*         MACROS ABORT, MESSAGE, UNLOAD, WRITEC, WRITER.
 
 
 ABT      BSS    0           ENTRY
          SX6    1           SET EOR ON INPUT FLAG
          SA6    EOR
          SA1    RPVBLK+3    GET THE REPRIEVE ERROR CODE
          MX0    48
          BX1    -X0*X1
          ZR     X1,ABT1     IF NO ERROR EXIT
 
*         ISSUE ERROR MESSAGE.
 
          SA1    RPVBLK+3    GET ERROR CODE
          MX0    -12
          BX1    -X0*X1      ISOLATE ERROR CODE
          SB1    1           JUST IN CASE
          SB2    B1+B1       BUILD SHIFT COUNT
          LX0    X1,B2       COMPUTE WORD OFFSET OF MESSAGE
          SX0    X0+ABTA     SET MESSAGE ADDRESS
          MESSAGE  X0,3      ISSUE ERROR MESSAGE
          WRITEC O,X0
 
*         SET COMPLETE BITS IN FETS.
 
          SA1    TF
          SA2    DB
          SA3    UPDATES
          SA4    NUMBERS
          SX5    1
          BX6    X1+X5
          BX7    X2+X5
          SA6    A1
          SA7    A2
          BX6    X3+X5
          BX7    X4+X5
          SA6    A3
          SA7    A4
          SA1    NEW
          SA2    CF
          SA3    MF
          SA4    SF
          BX6    X1+X5
          BX7    X2+X5
          SA6    A1
          SA7    A2
          BX6    X3+X5
          BX7    X4+X5
          SA6    A3
          SA7    A4
 
*         UNLOAD ALL FILES (EXCEPT LOCAL FILE BEING DUMPED).
 
          SA1    DUMPLOC
          NZ     X1,ABT0     IF A LOCAL FILE WAS BEING DUMPED
          UNLOAD  NEW
 ABT0     UNLOAD CF
          UNLOAD  MF
          UNLOAD  SF
          UNLOAD  NUMBERS
          UNLOAD  UPDATES
          UNLOAD  DB
 
*         ABORT *RECLAIM*.
 
 ABT1     SA1    RECSET
          ZR     X1,ABT2     IF CHARACTER SET MODE NOT CHANGED
          CSET   RESTORE     RESTORE ORIGINAL CHARACTER SET MODE
 ABT2     WRITER O,R
          ABORT  ABTB        * RECLAIM ABORTED.*
 
 
 ABTA     INDEX              ERROR EXIT MESSAGES
          INDEX  /COMSRPV/NTEC,( NORMAL TERMINATION.                 )
          INDEX  /COMSRPV/TLEC,( TIME LIMIT.                         )
          INDEX  /COMSRPV/EEEC,( CPU ERROR EXIT.                     )
          INDEX  /COMSRPV/PPEC,( PP ABORT.                           )
          INDEX  /COMSRPV/CPEC,( CPU ABORT.                          )
          INDEX  /COMSRPV/PCEC,( PP CALL ERROR.                      )
          INDEX  /COMSRPV/ODEC,( OPERATOR DROP.                      )
          INDEX  /COMSRPV/OKEC,( OPERATOR KILL.                      )
          INDEX  /COMSRPV/RREC,( OPERATOR RERUN.                     )
          INDEX  /COMSRPV/ECEC,( EXTENDED MEMORY PARITY ERROR.       )
          INDEX  /COMSRPV/RCEC,( JOB HUNG IN AUTO RECALL.            )
          INDEX  /COMSRPV/MLEC,( MASS STORAGE LIMIT.                 )
          INDEX  /COMSRPV/SREC,( I/O LIMITS EXCEEDED.                )
          INDEX  /COMSRPV/TIEC,( TERMINAL INTERRUPT.                 )
          INDEX  /COMSRPV/TIEC+1  END OF TABLE
 ABTB     DATA   C* RECLAIM ABORTED.*
 ADB      SPACE  4,25
**        ADB - ATTACH DATABASE.
*
*         ENTRY  (X7) = ATTACH MODE.
*                (X5) = 0 IF *RECLAIM* IS TO ABORT IF ATTACH FAILS.
*                (X5) .NE. 0 IF *ADB* IS TO ATTEMPT TO DEFINE THE
*                       DATABASE SHOULD THE ATTACH FAIL.
*                       CHECKED ONLY IF *TN* SPECIFIED.
*
*         EXIT   DATABASE ATTACHED.
*                (X5) = 0 IF ATTACH WORKED.
*                (X5) .NE. 0 IF DEFINED (UNCHANGED FROM ENTRY VALUE).
*
*         ERROR  TO *ABT* IF ATTACH FAILED AND NO RECOVERY.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 6, 7.
*
*         MACROS ATTACH, BREAK, DEFINE, MESSAGE, RECALL, ROLLOUT,
*                WRITEC, WRITER.
*
*         DEFINE (X5) = FLAG FOR DEFINING DATABASE WHEN NOT FOUND.
 
 
 ADB10    SA1    DB+1        CLEAR *SA* BIT
          SX6    1
          LX6    46
          BX6    -X6*X1
          SA6    A1+
 
 ADB      SUBR               ENTRY/EXIT
          SA7    ADBD        ACCESS MODE
          SX6    ROLLFBS     MAXIMUM ROLLOUTS BEFORE TAPE UNLOAD
          SA6    ADBH
 ADB1     SA1    DB+1
          SX6    4+1         SET *SA* AND *EP* BITS
          LX6    44
          BX6    X6+X1
          SA6    A1+
          SA1    DBNAM       GET DATABASE NAME
          NZ     X1,ADB1.1   IF DATABASE .NE. 0
          SX5    B0+         ACT LIKE ATTACH WORKED
          EQ     ADB10       CLEAR *SA* BIT AND RETURN
 
 ADB1.1   ATTACH DB,DBNAM,DBUN,DBPW,ADBD,DBPN,RDT  ATTACH DATABASE
 
*         CHECK ERROR CODE RETURNED FROM *PFM*.
 
          SA1    DB
          SX0    X1
          AX0    10
          NZ     X0,ADB2     IF ATTACH FAILED
          SX5    B0+         SET ATTACH SUCCESSFUL
          EQ     ADB10       CLEAR *SA* BIT AND RETURN
 
*         ATTACH FAILED.  CHECK *PFM* STATUS.
 
 ADB2     SX3    X0-/ERRMSG/FBS  CHECK FOR FILE BUSY
          ZR     X3,ADB5     IF BUSY
          SX3    X0-/ERRMSG/PFA  CHECK FOR PF UTILITY ACTIVE
          ZR     X3,ADB5     IF ACTIVE
          SX3    X0-/ERRMSG/FNF  CHECK FOR FILE NOT FOUND
          SA1    USERDB
          NZ     X3,ADB7     IF FILE FOUND BUT SOME OTHER STATUS
          NZ     X1,ADB3     IF A USER DATABASE
          MESSAGE  ADBA,3    * CONTACT CUSTOMER SERVICES...*
          WRITEC O,ADBA
          EQ     ABT         ABORT *RECLAIM*
 
*         ATTEMPT TO DEFINE THE DATABASE FILE IF NECESSARY.
 
 ADB3     ZR     X5,ADB4     IF RECLAIM IS TO ABORT
          SA1    TF+TTNV
          ZR     X1,ADB4     IF *TN* NOT SPECIFIED
          SA2    DBUN
          NZ     X2,ADB4     IF ALTERNATE USER DATABASE
          SA2    DBNAM
          ZR     X2,ADB10    IF DB=0 (PROCESS WITHOUT DATABASE)
 
*         DEFINE DATABASE FILE.
 
          MESSAGE  ADBB,3    * DATABASE NOT FOUND...*
          WRITEC O,ADBB
          DEFINE DB,DBNAM,DBPW,,RDT,,,DBPN
          SA1    DB          CHECK *PFM* STATUS
          SX1    X1
          AX1    10
          NZ     X1,ADB4     IF ERROR DEFINING DATABASE
          SX6    B1
          SA6    DBDEFLG     SET DATABASE DEFINED FLAG
          EQ     ADB10       CLEAR *SA* BIT AND RETURN WITH (X5) INTACT
 
*         ATTACH FAILED - ABORT *RECLAIM*.
 
 ADB4     MESSAGE  ADBC,3    * USER DATABASE MISSING.*
          WRITEC O,ADBC
          RJ     ABT         ABORT *RECLAIM*
 
*         DISPLAY *WAITING* MESSAGE IF IAOT AND OUTPUT IS TT EQUIPMENT.
 
 ADB5     BREAK
          SA1    JOBORIG     ORIGIN TYPE
          SX1    X1-IAOT     TIMESHARING ORIGIN TYPE
          NZ     X1,ADB6     IF NOT INTERACTIVE USER
          SA1    ODT         TERMINAL OUTPUT STATUS POINTER
          NZ     X1,ADB6     IF OUTPUT NOT ASSIGNED TO TERMINAL
          WRITEC O,ADBE      * WAITING FOR DATABASE NON-BUSY.*
          RJ     ILC         INCREMENT LINE COUNT
          WRITER O,R
          WRITE  X2,*        PRESET FUNCTION IN FET
 
*         PF TEMPORARILY UNAVAILABLE - WAIT A BIT AND TRY AGAIN.
*         UNLOAD DUMP TAPE IF THERE IS AN EXTREMELY LONG WAIT,
*         AS THIS COULD INDICATE A POSSIBLE DEADLOCK SITUATION.
 
 ADB6     SX6    X0-/ERRMSG/PFA
          NZ     X6,ADB6.1   IF NOT FILE BUSY
          SA1    ADBH
          ZR     X1,ADB6.1   IF TAPE ALREADY UNLOADED
          SX6    X1-1        DECREMENT RETRY COUNT
          SA6    A1+
          NZ     X6,ADB6.1   IF NOT TIME TO UNLOAD TAPE
          SA2    TF+TFETVSN
          AX2    18
          SX1    B0
          ZR     X2,ADB6.1   IF NO TAPE ASSIGNED
          SX5    TF
          RJ     RNT         UNLOAD THE TAPE
          SX6    B0+         SET FILE POSITION UNKNOWN
          SA6    CFC
          SA6    CRC
          SA6    FILENUM
          SA6    RECNUM
 ADB6.1   ROLLOUT  ROLLTIM   WAIT FOR PF FREE
          RECALL             WAIT FOR ROLLOUT COMPLETION IF TERMINAL
          BREAK
          EQ     ADB1        ACQUIRE THE FILE AGAIN
 
*         ABORT -- ERROR BEYOND PROGRAM CONTROL.  (X1) = (USERDB).
 
 ADB7     NZ     X1,ADB9     IF USER DATABASE
          MESSAGE  ADBF,3    * CONTACT CUSTOMER SERVICES -- DB ERROR.*
          WRITEC O,ADBF
          EQ     ABT         ABORT *RECLAIM*
 
 ADB9     MESSAGE  ADBG,3    * ERROR IN ATTACHING USER DATABASE.*
          WRITEC O,ADBG
          RJ     ABT         ABORT *RECLAIM*
 
 
 ADBA     DATA   C* CONTACT CUSTOMER SERVICES -- DB MISSING.*
 ADBB     DATA   C* DATABASE NOT FOUND -- DEFINING NEW ONE.*
 ADBC     DATA   C* USER DATABASE MISSING.*
 ADBD     DATA   0           PF ATTACH MODE
 ADBE     DATA   C* WAITING FOR DATABASE NON-BUSY.*
 ADBF     DATA   C* CONTACT CUSTOMER SERVICES -- DB ERROR.*
 ADBG     DATA   C* ERROR IN ATTACHING USER DATABASE.*
 ADBH     BSS    1           FILE BUSY ROLLOUT COUNT
 ADBM     BSSZ   3           ERROR RETURNED BY *PFM*
 BTF      SPACE  4,15
**        BTF - BUILD TAPE FLAGS.
*
*         ENTRY  (X4) = TAPE FLAG DEFAULT VALUES.
*                (X5) = FET ADDRESS ASSOCIATED WITH TAPE FLAGS.
*                (X6) = EXISTING TAPE FLAGS.
*
*         EXIT   ((X5)+TFLAGS) = TAPE FLAGS.
*                (X6) = TAPE FLAGS.
*
*         ERROR  TO *MAIN* IF TAPE OPTION ERRORS OR MISMATCH.
*
*         USES   X - 0, 1, 2, 3, 6.
*                A - 1, 2, 6.
*
*         MACROS MESSAGE, WRITEC.
 
 
 BTF      SUBR               ENTRY/EXIT
          SA1    X5+TMSV     MASS STORAGE VARIABLE FOR THIS FET
          SX3    B0+         INITIALIZE TAPE PARAMETERS MASK
          ZR     X1,BTF1     IF NOT MASS STORAGE
          MX6    1
          LX6    11-59       SET *MASS STORAGE RESIDENT* INDICATOR
 BTF1     SA6    X5+TFLAGS   MASS STORAGE FLAG OR EXISTING TAPE FLAGS
          NZ     X1,BTFX     IF MASS STORAGE, RETURN
          SA1    TMSTAT
          SA2    FTV
          SX6    2S9         PRESET FOR LABELED TAPE
          ZR     X1,BTF1.1   IF *TMS* NOT ACTIVE
          ZR     X2,BTF1.1   IF *FT* NOT SPECIFIED
          SX6    X6+1S9      SET *FOREIGN TAPE* FLAG
 
*         CHECK TAPE DENSITY.
 
 BTF1.1   SA1    DV          TAPE DENSITY
          ZR     X1,BTF3     IF NO DENSITY SPECIFIED
          SX3    70B         SET MASK FOR DENSITY
          SA2    TDEN
 BTF2     BX0    X1-X2
          AX0    36
          ZR     X0,BTF4     IF MATCHING DENSITY
          SA2    A2+1
          NZ     X2,BTF2     IF MORE DENSITIES TO CHECK
          MESSAGE  BTFA,3    * INCORRECT TAPE DENSITY.*
          WRITEC O,BTFA
          EQ     MAIN        RETURN TO MAIN LOOP
 
*         SET DENSITY, DEVICE TYPE BASED ON *DT*, *MT* OR *NT* VALUES.
 
 BTF3     SA1    DTV
          ZR     X2,BTF3.2   IF *DT* NOT SPECIFIED
          SA2    TDTV        SEARCH DEVICE TYPE VALUES TABLE
 BTF3.1   BX0    X1-X2
          AX0    36
          ZR     X0,BTF3.3   IF CORRECT VALUE
          SA2    A2+1
          SX0    A2-TDTET
          NZ     X0,BTF3.1   IF MORE TAPE DEVICES TO CHECK
 BTF3.2   SA1    MTV         CHECK *MT* VARIABLE
          SA2    DTMT
          NZ     X1,BTF3.3   IF 7-TRACK TAPE SPECIFIED
          SA1    NTV         CHECK *NT* VARIABLE
          SA2    DTNT
          NZ     X1,BTF3.3   IF 9-TRACK SPECIFIED
          SX2    X4+         USE DEFAULT VALUES
          EQ     BTF4        CONTINUE CHECKING
 
 BTF3.3   SX3    X3+700B     SET MASK FOR DEVICE TYPE
 BTF4     SX1    7
          SX2    X2+         REMOVE SEARCH ARGUMENT FROM SELECTION
          BX0    X1*X4
          NZ     X0,BTF4.1   IF DEFAULT FORMAT GIVEN
          BX0    X1*X2       DEFAULT TO FORMAT FROM SELECTION
 BTF4.1   BX2    -X1*X2      REMOVE FORMAT FROM SELECTION
          BX6    X2+X6       SET TAPE DEVICE TYPE, DENSITY
 
*         CHECK TAPE FORMAT.
 
          SA1    FV          FORMAT VARIABLE
          ZR     X1,BTF6     IF FORMAT NOT SPECIFIED
          SX3    X3+7B       SET MASK FOR FORMAT
          SX0    B0+
 BTF5     SA2    X0+TFMT
          BX2    X1-X2
          ZR     X2,BTF6     IF MATCHING TAPE FORMAT
          SX0    X0+1
          SX2    X0-TFMTL
          NG     X2,BTF5     IF MORE FORMATS TO CHECK
          SX2    BTFB        * INCORRECT TAPE FORMAT.*
          EQ     BTF7        ISSUE MESSAGE AND RETURN TO MAIN LOOP
 
*         SET FLAGS INTO *TFLAGS* FOLLOWING FET AND EXIT.
 
 BTF6     BX6    X0+X6
          SA1    X5+TFLAGS   CHECK EXISTING TAPE FLAGS
          SA6    A1
          ZR     X1,BTFX     IF NO EXISTING TAPE FLAGS
          BX0    X1-X6
          BX0    X3*X0
          ZR     X0,BTFX     IF EXISTING TAPE FLAGS MATCH
          SX2    BTFC        * TAPE DENSITY/DEVICE/FORMAT MISMATCH.*
 BTF7     MESSAGE  X2,3      ISSUE APPROPRIATE ERROR MESSAGE
          WRITEC O,X2
          EQ     MAIN        RETURN TO MAIN LOOP
 
 
 BTFA     DATA   C* INCORRECT TAPE DENSITY.*
 BTFB     DATA   C* INCORRECT TAPE FORMAT.*
 BTFC     DATA   C* TAPE DENSITY/DEVICE/FORMAT MISMATCH.*
 CBR      SPACE  4,15
**        CBR - COPY BINARY RECORD.
*
*         *CBR* COPIES ONE SYSTEM LOGICAL RECORD FROM ONE FILE
*         TO ANOTHER.
*
*         ENTRY  (X0) = ADDRESS OF INPUT FILE FET.
*                (X5) = ADDRESS OF OUTPUT FILE FET.
*                (CMPC+DBPFN) = NAME OF DESIRED FILE RECORD TO COPY.
*
*         EXIT   (X1) = 0 IF RECORD COPIED.
*                (X1) = 1 IF RECORD NOT FOUND.
*
*         USES   X - 1, 2, 3, 6.
*                A - 2, 3, 6.
*
*         MACROS MESSAGE, READ, READW, RECALL, WRITER, WRITEW.
 
 
 
 CBR      SUBR               ENTRY/EXIT
          RECALL X0          WAIT FOR PREVIOUS ACTIVITY TO STOP
          RECALL X5
          READ   X0,R        START UP THE READ ON THE INPUT FILE
          WRITE  X5,*        SET WRITE FUNCTION
          READW  X0,WSA,WSAL
          NG     X1,CBR3     IF NOT A COMPLETED TRANSFER
          SA3    WSA         EXAMINE CATALOG CONTROL WORD
          SX6    X3-11000B   CHECK FOR NORMAL *PFC*
          AX6    9
          SX2    ERUP        * DUMP FILE MALFUNC - UNRECOGNIZABLE PFC.*
          NZ     X6,CBR4     IF NOT A VALID CATALOG RECORD
          SA2    CMPC+DBPFN
          BX6    X2-X3
          AX6    18
          SX2    ERFM        * DUMP FILE MALFUNC - FILE NAME MISMATCH.*
          NZ     X6,CBR4     IF NOT THE RIGHT FILE NAME
          NZ     X1,CBR2     IF RECORD SMALLER THAN BUFFER
 
*         MOVE AN ENTIRE BUFFER IF POSSIBLE.
 
 CBR1     WRITEW X5,WSA,WSAL
          READW  X0,WSA,WSAL
          ZR     X1,CBR1     IF COMPLETED TRANSFER
 
*         FOUND AN EOR/EOF/EOI.
 
 CBR2     RECALL X5          LET OTHER WRITE FINISH
          SX1    B6          SET LWA OF DATA IN BUFFER
          WRITEW X5,WSA,X1-WSA  MOVE LAST BIT OF RECORD
          WRITER X5,R        COMPLETE THE WRITTEN RECORD
          SX1    B0+         INDICATE COPY SUCCESSFUL
          EQ     CBRX        RETURN
 
 CBR3     SX6    X1+2
          SX2    ERPL        * DUMP FILE MALFUNCTION - POSITION LOST.*
          NZ     X6,CBR4     IF NOT AT END OF INFORMATION
          SX2    EREI        * DUMP FILE MALFUNC - EOI ENCOUNTERED.*
 CBR4     MESSAGE  X2,3,R
          SX1    B1
          EQ     CBRX        RETURN WITH ERROR INDICATION
 CDF      SPACE  4,15
**        CDF - CREATE DATABASE FILE.
*
*         ENTRY  NONE.
*
*         EXIT   SORTED UPDATE RECORDS READY FOR UPDATE.
*
*         ERROR  TO *ABT* IF TAPE HAS NO VALID DUMP ON IT.
*
*         USES   X - ALL.
*                A - 0, 1, 2, 3, 5, 6, 7.
*
*         CALLS  CCE, CDR, CRI, CTJ, CVH, POT, RNT, SDE, UDV, UII, ZTB.
*
*         MACROS BREAK, CLEAR, MESSAGE, READSKP, RECALL, REWIND,
*                UNLOAD, WRITEC, WRITER, WRITEW.
 
 
 CDF      SUBR               ENTRY/EXIT
          SX6    777         FLAG TAPE RECOVERY FOR *CDR*
          SA6    SALVAGE
          SA1    JOBORIG     JOB ORIGIN TYPE
          SX1    X1-IAOT
          NZ     X1,CDF1     IF NOT INTERACTIVE SKIP MESSAGES
          WRITEC O,CDFA      * NO FILES FOUND FOR VSN *
          WRITEC O,CDFB      * WAITING FOR REQUESTED TAPE *
          WRITER O,R
          WRITE  X2,*        PRESET FUNCTION IN FET
 CDF1     BX6    X6-X6
          SX7    B1
          SA6    CRC         CLEAR RECORD COUNT
          SA7    CFC         SET FILE COUNT
          SA6    HDRJDT      CLEAR DUMP DATE
          UNLOAD NUMBERS,R
          UNLOAD UPDATES,R
          UNLOAD OPLDF,R
          WRITE  NUMBERS,*
          WRITE  UPDATES,*
          WRITE  OPLDF,*
          RECALL TF
          SA1    TF+TMSV     MASS STORAGE VARIABLE
          ZR     X1,CDF1.1   IF NOT MASS STORAGE
          MX6    1
          LX6    11-59       SET *MASS STORAGE RESIDENT* INDICATOR
          SA6    TF+TFLAGS
 CDF1.1   SX6    B0+
          SA6    TF+TRING    FLAG DON-T CARE ABOUT WRITE RING
          SA1    TF+TTNV
          SX5    TF          SET TAPE FET ADDRESS
          RJ     RNT         REQUEST NEW TAPE
          BREAK
          RJ     CVH         CHECK FOR VALID DUMP HEADER
          NZ     X1,CDF8     IF TAPE HAS NO VALID DUMP
          SA0    DBE         DATA ENTRY ADDRESS
          SA1    TF+TTNV
          SX5    TF          FET ADDRESS
          RJ     UII         WRITE INITIAL VSN INDEX RECORD
 
*         READ RECORD UNTIL EOI.
 
 CDF2     CLEAR  TF          RESET FET POINTERS FOR READSKP
          READSKP TF,0,R
          BREAK
          SA1    CRC         INCREMENT RECORD COUNT
          SX6    X1+B1
          MX0    -12
          BX6    -X0*X6
          SA6    A1
          NZ     X6,CDF3     IF NOT A PSEUDO FILE POINT
          SA1    CFC
          SX6    X1+B1       INCREMENT FILE NUMBER
          SA6    A1
 CDF3     SX5    TF
          RJ     UDV         UPDATE DUMP VSN
          SA1    TF+2        IN POINTER
          SA2    A1+B1       OUT
          IX1    X1-X2
          NZ     X1,CDF4     IF NOT AN EMPTY RECORD - PROBABLY A PFC
          SA1    TF
          LX1    59-9        LEFT JUSTIFY EOI BIT
          NG     X1,CDF7     IF END-OF-TAPE - ALL DONE
          LX1    -59+9       MOVE BACK TO ORIGINAL POSITION
          MX0    -10
          BX1    -X0*X1      ISOLATE STATUS BITS
          SX1    X1-33B      COMPARE WITH 1033B(EOI), 33B(EOF)
          NG     X1,CDF6     IF EOR ENCOUNTERED
          NZ     X1,CDF7     IF EOI ENCOUNTERED
 
*         EOF ENCOUNTERED, SO INCREMENT RECORD/FILE COUNTS.
 
          SA1    CRC
          ZR     X1,CDF2     IF PSEUDO FILE POINT JUST PROCESSED
          BX6    X6-X6
          SA6    A1
          SA1    CFC         INCREMENT FILE COUNT
          SX6    X1+B1
          SA6    A1
          EQ     CDF2        LOOP FOR NEXT FILE
 
*         PROCESS RECORD.
 
 CDF4     SA1    TFBUF
          SX2    X1-11000B   CHECK FOR NORMAL *PFC*
          AX2    9
          ZR     X2,CDF4.2   IF A VALID CATALOG HEADER
          SA2    HDRPFD
          BX2    X1-X2
          AX2    24
          ZR     X2,CDF4.1   IF *PFDUMP* OR CURRENT *RECLAIM* HEADER
          SA2    =7LRECLAIM
          BX2    X1-X2
          AX2    18
          NZ     X2,CDF2     IF NOT INTERIM *RECLAIM* HEADER
 CDF4.1   SA5    /COMSPFS/DAAL+TFBUF+1  SAVE DUMP DATE
          RJ     CTJ         CONVERT TO JULIAN
          SA6    HDRJDT
          EQ     CDF2        GET NEXT RECORD
 
*         PROCESS PFC.
 
 CDF4.2   MX0    -9
          BX1    -X0*X1      EXTRACT LENGTH OF THIS TABLE
          SX1    X1-NWCE     COMPARE WITH PFC SIZE
          ZR     X1,CDF5     IF SIZE IS CORRECT
          SX4    TFBUF+1
          RJ     CCE         CONVERT CATALOG ENTRY TO CORRECT FORMAT
 CDF5     SA1    UIV
          ZR     X1,CDF5.1   IF *UI* NOT SPECIFIED
          SA2    TFBUF+FCUI+1 PFC USER INDEX
          MX0    -18
          BX0    -X0*X2
          BX1    X0-X1
          NZ     X1,CDF2     IF NOT THE SPECIFIED USER INDEX
 CDF5.1   SA1    TNN         INCREMENT DATABASE ADDITIONS FROM TAPE
          SX6    X1+B1
          SA6    A1
          SA3    TFBUF+1     FW OF PFC HEADER
          RJ     CDR         CREATE DATABASE RECORD
          SA1    DBNAM
          NZ     X1,CDF6     IF DATA BASE SET
          RJ     CRI         CHECK CRITERIA
          NZ     X5,CDF2     IF CRITERIA DOES NOT MATCH
          RJ     POT
          SA1    NFP         NUMBER OF FILES PROCESSED
          SX6    X1+B1
          SA6    A1
          EQ     CDF2        GET NEXT PFC FROM TAPE
 
*         WRITE UNSORTED UPDATE RECORD.
 
 CDF6     SA1    DBNAM       DATABASE NAME
          ZR     X1,CDF2     IF NO DATABASE NAME
          WRITEW OPLDF,A0,UDBEL
          EQ     CDF2        GET NEXT PFC
 
*         EOI ENCOUNTERED.  SORT DATABASE RECORDS.
 
 CDF7     SA1    DBNAM       DATABASE NAME
          ZR     X1,CDFX     IF NO DATABASE NAME
          MX6    2           SET EOI INDICATOR AND RECORD COUNT
          LX6    1
          SA1    CFC
          SA6    CRC
          SX7    X1-1        DECREMENT FILE COUNT
          SA7    A1
          WRITER OPLDF,R
          WRITER NUMBERS,R
          SA1    TNN
          NZ     X1,CDF7.0   IF ANY FILES FOR THE DATABASE
          UNLOAD OPLDF,R
          UNLOAD NUMBERS,R
          EQ     CDFX        RETURN
 
 CDF7.0   RJ     SDE         SORT DATABASE ENTRIES
          MX0    24D
          SA1    TF+TTNV
          SA2    TF+TMSV
          SA3    =10H ADDING TA
          ZR     X2,CDF7.1   IF TAPE FILE
          SA3    =10H ADDING FI
 CDF7.1   BX6    X3
          SA6    CDFC
          RJ     ZTB         CONVERT ZEROS TO BLANKS
          SA1    TF+TMSV
          SA2    =2CPE
          ZR     X1,CDF7.2   IF TAPE FILE
          SA2    =2CLE
 CDF7.2   MX1    -48
          LX6    41-59
          BX6    -X1*X6
          BX6    X6+X2
          SA6    CDFC+1
          MESSAGE   CDFC,3   * ADDING TAPE VVVVVV  TO DATABASE.*
*         MESSAGE   CDFC,3   * ADDING FILE FFFFFFF TO DATABASE.*
          WRITEC O,CDFC
          MX0    42
          SA1    UNV         CURRENT USER NAME
          BX6    X0*X1
          SA6    A1          CLEAR USER ADDRESS ON DATABASE
          SX6    B0          RESUME NORMAL DATABASE CREATION
          SA6    SALVAGE
          EQ     CDFX        RETURN
 
*         TAPE DOES NOT CONTAIN A DUMP.
 
 CDF8     MESSAGE  CDFD,3    * NO VALID DUMP ON TAPE.*
          WRITEC  O,CDFD
          EQ     ABT         ABORT *RECLAIM*
 
 
 CDFA     DATA   C* NO FILES FOUND FOR SPECIFIED DUMP FILE. *
 CDFB     DATA   C* REQUESTING DUMP FILE. *
 CDFC     DATA   C* ADDING TAPE         TO DATABASE.*
 CDFD     DATA   C* NO VALID DUMP FOUND ON DUMP FILE. *
 CDR      SPACE  4,15
**        CDR - CREATE DATABASE RECORD.
*
*         ENTRY  (A0) = ADDRESS OF RECORD BUFFER.
*                (A3) = FWA OF CATLIST/PFC BUFFER.
*                (X5) = RECORD COUNT OF FILE ON TAPE.
*                (SALVAGE) = DATABASE RECOVERY FLAG.
*                (HDRJDT) = DUMP DATE FROM HEADER IF NON-ZERO.
*
*         EXIT   ((A0)) = DATABASE RECORD CREATED FROM PFC.
*                (LAD) = LAST ACCESS DATE FROM PFC.
*
*         USES   X - 0, 1, 2, 5, 6.
*                A - 1, 2, 6.
*
*         CALLS  CVD.
 
 
 CDR      SUBR               ENTRY/EXIT
          MX0    42          SAVE USER NAME IN DATABASE RECORD
          SA1    UNV
          BX6    X0*X1
          SA6    A0+DBUNM    FIRST WORD OF DATABASE RECORD
          SA1    DUMPDT      CURRENT DATE IN PACKED JULIAN
          SA2    SALVAGE
          ZR     X2,CDR1     IF NORMAL DATABASE RECORD CREATION
          SA1    HDRJDT
          NZ     X1,CDR1     IF DUMP DATE FROM HEADER
          SA1    A3+FCPW
          BX1    -X0*X1      GET DUMP DATE FROM TAPE PFC
 CDR1     SA2    A3+FCFN     FILE NAME + USER INDEX
          BX6    X0*X2
          BX6    X6+X1
          SA6    A0+DBPFN    SECOND WORD OF DATABASE RECORD
          SA2    A3+FCPW     SAVE PASSWORD
          BX6    X0*X2
          BX6    X6+X1       MERGE DUMP DATE
          SA6    A2          SAVE DUMP DATE IN PFC
          SA1    A3+FCMD     LAST MODIFICATION DATE
          AX1    18
          BX5    -X0*X1
          RJ     CVD
          SA1    TF+TTNV     TAPE NUMBER
          MX2    42
          BX1    X2*X1       ISOLATE DUMP FILE NAME
          BX6    X6+X1
          SA6    A0+DBTNO    THIRD WORD OF DATABASE RECORD
          SA1    A3+FCBS     DIRECT/INDIRECT FLAG (ON SECTOR COUNT)
          LX1    24
          MX0    -24
          BX2    -X0*X1
          LX1    24
          SX6    1RI
          PL     X1,CDR2     IF AN INDIRECT ACCESS FILE
          SX6    1RD
 CDR2     LX6    12
          SA1    TF+TFLAGS   TAPE FLAGS BUILT BY *BTF*
          BX6    X1+X6
          LX6    6
          SA1    CFC         DUMP FILE FILE NUMBER
          BX6    X1+X6
          LX6    12
          SA1    CRC         DUMP FILE RECORD NUMBER
          BX1    -X0*X1      REMOVE POSSIBLE EOI INDICATOR (BIT 59)
          BX6    X1+X6
          LX6    18
          MX1    -18         SPLIT OFF UPPER 5 BITS OF FILE SIZE
          BX1    X1*X2       UPPER 5 BITS OF FILE SIZE
          BX2    X2-X1       LOWER 18 BITS OF FILE SIZE
          BX6    X2+X6       MERGE LOWER 18 BITS INTO DATABASE RECORD
          LX1    59-23
          BX6    X1+X6       MERGE UPPER 5 BITS INTO DATABASE RECORD
          SA6    A0+DBFLG    FOURTH WORD OF DATABASE
          SA1    FAMILY      THE CURRENT FAMILY
          BX6    X1
          SA6    A0+UDBFAM   THE FAMILY NAME
          SA1    A3+FCAD     LAST ACCESS DATE FROM PFC
          AX1    18
          BX5    -X0*X1
          RJ     CVD
          SA6    LAD
          EQ     CDRX        RETURN
 CEI      SPACE  4,15
**        CEI - COPY A FILE TO END-OF-INFORMATION.
*
*         *CEI* COPIES AN ENTIRE FILE TO ANOTHER.  COPYING STARTS
*         AT THE CURRENT POSITION FOR BOTH THE INPUT AND OUTPUT
*         FILES, SO THE CALLER MUST REWIND BOTH FILES WHEN NECESSARY.
*
*         ENTRY  (X0) = ADDRESS OF INPUT FILE FET.
*                (X5) = ADDRESS OF OUTPUT FILE FET.
*                (X1) = SET VSN FOR OUTPUT FILE.
*
*         EXIT   EOI FOUND ON INPUT FET.  FILE COPIED.
*                (CFC) = CORRECT FILE COUNT FOR DUMP FILE.
*                (CRC) = END OF DUMP INDICATOR.
*
*         USES   X - 1, 6.
*                A - 0, 1, 6.
*
*         CALLS  UDV, UII.
*
*         MACROS RECALL, READ, READW, WRITE, WRITEF, WRITER, WRITEW.
 
 
 CEI      SUBR               ENTRY/EXIT
          RJ     UII         WRITE INITIAL VSN INDEX RECORD
          SX6    1
          SA6    CFC         INITIALIZE FILE NUMBER
          SA6    CRC         INITIALIZE RECORD NUMBER
          RECALL X0          WAIT COMPLETION OF PREVIOUS ACTIVITY
          RECALL X5
 CEI1     READ   X0,R        REPEAT READ UNTIL EOI
          WRITE  X5,*
 CEI2     READW  X0,WSA,WSAL WHILE NOT EOR/EOF/EOI MOVE A CHUNK
          NZ     X1,CEI3     IF NOT *TRANSFER COMPLETE*
          RECALL X5          WAIT FOR ALL QUIET
          WRITEW X5,WSA,WSAL
          EQ     CEI2        LOOP FOR ANOTHER CHUNK
 
*         EOR/EOF/EOI FOUND.
 
 CEI3     SX1    X1+B1
          NG     X1,CEI5     IF END OF INFORMATION
          SA0    X1
          RECALL X5          WAIT FOR ALL QUIET
          SX1    B6          SET LWA OF DATA IN BUFFER
          WRITEW X5,WSA,X1-WSA
          SX1    A0
          ZR     X1,CEI4     IF EOF RATHER THAN EOR
          WRITER X5,R
          RJ     UDV         UPDATE DUMP VSN
          SA1    CRC
          SX6    X1+1
          SA6    A1          INCREMENT RECORD NUMBER
          EQ     CEI1        LOOP FOR NEXT RECORD
 
*         END OF FILE FOUND.
 
 CEI4     WRITEF X5,R
          RJ     UDV         UPDATE DUMP VSN
          SA1    CFC
          SX6    X1+1
          SA6    A1          INCREMENT FILE NUMBER
          SX6    1
          SA6    CRC         INITIALIZE RECORD NUMBER
          EQ     CEI1        LOOP FOR NEXT THING AFTER EOF
 
*         END-OF-INFORMATION FOUND.
 
 CEI5     MX6    2           SET END OF DUMP INDICATOR
          LX6    1
          SA6    CRC
          SA1    CFC         ADJUST FILE POSITION
          SX6    X6-1
          SA6    A1
          EQ     CEIX        RETURN
 CFJ      SPACE  4,10
**        CFJ - CONVERT FROM JULIAN (BINARY) TO DISPLAY *YYMMDD*.
*
*         ENTRY  (X1) = BINARY JULIAN DATE.
*
*         EXIT   (X6) = DISPLAY CODE DATE.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 4.
*
*         CALLS  CDD.
 
 
 CFJ      SUBR               ENTRY/EXIT
 
*         ISOLATE YEAR IN X1.
 
          SX4    1000
          BX2    X4
          BX3    X1          SAVE JULIAN DATE
          IX1    X1/X2       YYDDD / 1000 = YEAR
          IX4    X1*X4
          IX3    X3-X4       REMAINDER = DDD
 
*         COMPUTE MONTH IN X2.
 
          MX7    58          CHECK FOR LEAP YEAR
          BX7    -X7*X1      IS YEAR DIVISIBLE BY 4
          SX2    12
 CFJ1     SX2    X2-1
          SA4    MONTH+X2
          NZ     X7,CFJ2     IF NOT A LEAP YEAR
          LX4    30
 CFJ2     SX4    X4
          IX6    X3-X4
          NG     X6,CFJ1     IF NOT THIS MONTH
          SX2    X2+B1
 
*         ISOLATE DAY IN X3.
 
          IX3    X3-X4
          SX3    X3+B1
 
*         BUILD FINAL RESULT.
 
          SX1    X1+100      BIAS TO ACCOMODATE YEARS .GE. 2000
          SX6    10000
          IX1    X1*X6       YY*10000
          SX6    100
          IX6    X2*X6       MM*100
          IX1    X1+X6       YY + MM
          IX1    X1+X3       YYMM + DD
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
 
*         INSERT SLASHES.
 
          SX2    1R/
          MX7    -12D
          LX4    18          YY
          BX6    -X7*X4
          LX6    6           /
          BX6    X2+X6
          LX4    12          MM
          BX1    -X7*X4
          LX6    12
          BX6    X1+X6
          LX6    6           /
          BX6    X2+X6
          MX7    48          DD
          LX4    12
          BX1    -X7*X4
          LX1    12
          LX6    24
          BX6    X1+X6
          SX1    2R          INSERT 2 SPACES
          BX6    X1+X6
          LX6    54          POSITION FINAL RESULT
          EQ     CFJX        RETURN
 
 
 MONTH    BSS    0
          VFD    30/001,30/001         JANUARY
          VFD    30/032,30/032         FEBRUARY
          VFD    30/061,30/060         MARCH
          VFD    30/092,30/091         APRIL
          VFD    30/122,30/121         MAY
          VFD    30/153,30/152         JUNE
          VFD    30/183,30/182         JULY
          VFD    30/214,30/213         AUGUST
          VFD    30/245,30/244         SEPTEMBER
          VFD    30/275,30/274         OCTOBER
          VFD    30/306,30/305         NOVEMBER
          VFD    30/336,30/335         DECEMBER
 COE      SPACE  4,10
**        COE - CALCULATE OPLD ENTRY.
*
*         ENTRY  (X2) = FET OF RANDOM FILE.
*
*         EXIT   OPLD ENTRY CREATED.
*
*         USES   X - 0, 1, 3, 5, 6.
*                A - 1, 3, 6.
*
*         MACROS WRITEW.
 
 
 COE      SUBR               ENTRY/EXIT
          BX5    X2
          SA1    INDXLEN
          NZ     X1,COE1     IF INDEX HAS BEEN CREATED
 
*         CREATE INDEX RECORD.
 
          SX6    2
          SA6    A1          SAVE INDEX LENGTH
          SX6    B1
          SA6    INDXNAM+1
          WRITEW OPLDF,INDXNAM,2
          EQ     COE2        SAVE RANDOM INDEX
 
 COE1     SX6    X1+2
          SA6    A1          INCREASE INDEX LENGTH
          WRITEW OPLDF,INDXNAM,2
 
*         SAVE RANDOM INDEX.
 
 COE2     SA3    X5+6        GET RANDOM INDEX
          LX3    30
          MX0    30
          BX6    -X0*X3      EXTRACT PRU ADDRESS
          SX6    X6+B1
          SA6    INDXNAM+1
          EQ     COEX        RETURN
 CRF      SPACE  4,15
**        CRF - CHECK RESERVED FILE NAMES.
*
*         ENTRY  (X6) = FILE NAME TO BE CHECKED AGAINST RESERVED LIST.
*                (TF) = LFN IN USE FOR DUMP FILE.
*
*         EXIT   (X6) = 0 IF FILE NAME IS IN RESERVED LIST.
*                (X6) = FILE NAME IF NOT IN RESERVED LIST.
*
*         USES   X - 0, 1, 3, 6, 7.
*                A - 1, 3, 7.
*                B - 3.
*
*         CALLS  IMI.
 
 
 CRF      SUBR               ENTRY/EXIT
          SA1    TF          GET CURRENT DUMP FILE LFN
          SA3    CRFA-1      SET UP FOR RESERVED FILE NAME CHECK
          MX0    42
          BX7    X0*X1
          SA7    A3+1        SET DUMP FILE LFN INTO TABLE
 CRF1     SA3    A3+1        CHECK NEXT RESERVED NAME
          ZR     X3,CRFX     IF ALL RESERVED NAMES CHECKED
          BX3    X3-X6
          NZ     X3,CRF1     IF NO MATCH
          MX7    6
 CRF2     LX7    -6
          BX3    X6*X7
          NZ     X3,CRF2     IF END OF FILE NAME NOT REACHED
          SA3    =8L........
          BX7    X3*X7
          BX7    X6+X7
          SA7    CRFB+4
          SB3    CRFB
          SA1    COPTION
          RJ     IMI         ISSUE RESERVED FILE MESSAGE
          SX6    B0+         INDICATE RESERVED FILE NAME MATCH
          EQ     CRFX        RETURN
 
 
 CRFA     BSS    0           RESERVED FILE NAME TABLE
          DATA   0LTAPE      (REPLACED BY CURRENT DUMP FILE LFN)
          DATA   0LINPUT
          DATA   0LOUTPUT
          DATA   0LZZZZZG0
          DATA   0LZZZZZG1
          DATA   0LZZZZZG2
          DATA   0LZZZZZG3
          DATA   0LZZZZZG4
          DATA   0LZZZZZG5
          DATA   0LZZZZZG6
          DATA   0LZZZZZG7
          DATA   0LZZZZZG8
          DATA   0LZZZZZG9
          CON    0           END OF RESERVED FILE NAME TABLE
 CRFB     DATA   C* !!!! NOT ALLOWED OF RESERVED FILE NAME XXXXXXX.*
 CRI      SPACE  4,15
**        CRI - CRITERIA CHECKER.
*
*         ENTRY  (A0) = STARTING ADDRESS OF 4 WORD ENTRY.
*                (LAD) = LAST ACCESS DATE FROM PFC.
*                      = 0 IF PFC NOT AVAILABLE.
*
*         EXIT   (X5) = 0 IF CURRENT RECORD MEETS CRITERIA.
*
*         USES   X - ALL.
*                A - 1, 2, 5, 6, 7.
*                B - 2.
*
*         CALLS  PFN.
 
 
 CRI      SUBR               ENTRY/EXIT
          SA1    UNV         CHECK USERNAME
          ZR     X1,CRI0.4   IF *UN=0* OPTION
          SA2    A0+DBUNM
          MX0    42
          BX1    X1-X2
          BX1    X0*X1
          ZR     X1,CRI0.4   IF SPECIFIED USER NAME
          SA5    A0+DBFLG    FIND TYPE OF DUMP
          SA2    TF+TMSV     GET MASS STORAGE FLAG FOR DUMP
          LX5    59-47
          ZR     X2,CRI0.1   IF LOOKING FOR TAPE
          PL     X5,CRI19    IF A TAPE DUMP
          EQ     CRI0.2      CHECK DUMP FILE
 
 CRI0.1   NG     X5,CRI19    IF A MASS STORAGE DUMP
          MX0    36          SET MASK FOR TAPE VSN
 CRI0.2   SA1    TF+TTNV
          SA2    A0+DBTNO
          BX5    X1-X2
          BX5    X0*X5
          NZ     X5,CRI19    IF NOT SAME TAPE
          SA1    TNN
          SA2    COPTION
          NZ     X1,CRI0.3   IF VSN OCCURS UNDER CURRENT USER
          MX6    -0          MARK VSN FOUND FOR OTHER USER
          SA6    A1
 
*         FOR *COMPACT* DIRECTIVES FOR A SPECIFIC USER NAME, ALL FILES
*         ON THE DUMP FILE FOR OTHER USER NAMES MUST BE SELECTED.
 
 CRI0.3   SA1    =0LCOMPACT
          BX1    X1*X2
          NZ     X1,CRI19    IF NOT PROCESSING *COMPACT*
          EQ     CRI22       CHECK EXCEPTION PROCESSING
 
*         CHECK FOR DELETED FILES.
 
 CRI0.4   SA5    DEV         DELETED FILE VARIABLE
          SA1    A0+DBFLG
          PL     X1,CRI1     IF FILE HAS NOT BEEN DELETED
          NZ     X5,CRI2     IF USER PROCESSING DELETED FILES ONLY
          EQ     CRI19       DELETED FILE ENCOUNTERED
 
 CRI1     NZ     X5,CRI19    IF PROCESSING ONLY DELETED FILES
 
*         IS LATEST VERSION OPTION SET.
 
 CRI2     SA5    TF+TTNV     TAPE NUMBER VARIABLE
          ZR     X5,CRI2.2   IF DUMP NAME/VSN NOT SELECTED
          SA1    A0+DBFLG    WORD WITH TAPE FLAGS
          LX1    59-47
          MX0    42
          SA2    TF+TMSV
          PL     X1,CRI2.0   IF A TAPE DUMP
          NZ     X2,CRI2.1   IF LOOKING FOR MASS STORAGE DUMP
          EQ     CRI19       NO MATCH - WRONG TYPE OF DUMP
 
 CRI2.0   NZ     X2,CRI19    IF LOOKING FOR MASS STORAGE DUMP
          MX0    36
 CRI2.1   SA1    A0+DBTNO    DUMP FILE NAME/VSN ON DATABASE
          BX5    X1-X5
          BX5    X0*X5
          NZ     X5,CRI19    IF NO MATCH
          SA1    TNN         NUMBER OF TIMES SPECIFIED VSN ENCOUNTERED
          SX6    X1+B1
          SA6    A1          INCREMENT COUNT
 CRI2.2   SA1    A0+DBPFN    PERMANENT FILE NAME ON DATABASE
          MX0    42
          SA2    LVV         LATEST VERSION VARIABLE
          ZR     X2,CRI3     IF LATEST VERSION NOT PART OF CRITERIA
          SA5    MRUSER      LAST USER NAME PROCESSED
          SA2    A0+DBUNM
          BX4    X0*X2
          BX7    X0*X1
          BX5    X4-X5
          NZ     X5,CRI3     IF LAST USER NAME NOT EQUAL CURRENT
          SA5    MRFILE      LAST PERMANENT FILE PROCESSED
          BX5    X7-X5
          ZR     X5,CRI19    IF FILE NAME EQUAL TO LAST ONE PROCESSED
 
*         CHECK PERMANENT FILE NAME.
 
 CRI3     SA5    TF+TMSV     MASS STORAGE VARIABLE
          ZR     X5,CRI3.0   IF NOT MASS STORAGE DUMP
          SA2    TF+TDNV     DUMP NAME VARIABLE
          BX2    X1-X2
          BX2    X0*X2
          ZR     X2,CRI19    IF DUMPING TO THE DUMP FILE
 CRI3.0   SA5    PFV         PERMANENT FILE VARIABLE
          SA4    FNV
          BX5    X5+X4
          ZR     X5,CRI5     IF NOT SET
          BX2    X1-X5
          BX2    X0*X2
          ZR     X2,CRI5     IF A MATCH
 
*         CHECK FOR PF=*.
 
          LX5    6
          SX5    X5-1R*
          NZ     X5,CRI19    IF NOT PF=*
          SA5    PFTAB       CHECK IF PFN TABLE IS NOT EMPTY
          NZ     X5,CRI3.1   IF PFN TABLE IS OCCUPIED
          RJ     PPF         PROCESS PERMANENT FILE LIST
          SA1    A0+DBPFN    DATABASE ENTRY PFN
          MX0    6*7
 CRI3.1   SA5    PFTAB-1
          BX1    X0*X1
 CRI4     SA5    A5+B1
          ZR     X5,CRI19    IF END OF TABLE
          BX6    X0*X5
          BX2    X6-X1
          NZ     X2,CRI4     IF FILE NAME NOT IN TABLE
          SX1    A5-PFTAB    *NNTAB* OFFSET
          SX1    X1+NNTAB    POSITION IN *NNTAB*
          SA2    X1          NEW NAME ADDRESS
          ZR     X2,CRI5     IF NO NEW FILE NAME
          SA2    A0+DBUNM    WORD 1 OF DATABASE ENTRY
          BX2    X0*X2
          BX1    -X0*X1
          BX7    X2+X1       42/UN,18/NEW NAME ADDR
          SA7    A2          WORD 1 OF DATABASE ENTRY
 
*         CHECK LAST MODIFICATION DATE.
 
 CRI5     SA5    MDV         LAST MODIFICATION
          SA1    A0+DBLMO
          BX1    -X0*X1
          ZR     X5,CRI6     IF *MD* NOT SPECIFIED
          BX5    X1-X5
          NZ     X5,CRI19    IF NO MATCH
 
*         CHECK MODIFIED AFTER DATE.
 
 CRI6     SX1    X1-70000
          PL     X1,CRI6.1   IF YEAR .LT. 2000
          SX1    X1+100000
 CRI6.1   SA5    MAV         MODIFIED AFTER
          ZR     X5,CRI7     IF NOT SET
          SX5    X5-70000
          PL     X5,CRI6.2   IF YEAR .LT. 2000
          SX5    X5+100000
 CRI6.2   IX5    X5-X1
          PL     X5,CRI19    IF MODIFY DATE .LE. SPECIFIED DATE
 
*         CHECK MODIFIED BEFORE DATE.
 
 CRI7     SA5    MBV         MODIFIED BEFORE
          ZR     X5,CRI8     IF NOT SET
          SX5    X5-70000
          PL     X5,CRI7.1   IF YEAR .LT. 2000
          SX5    X5+100000
 CRI7.1   IX5    X1-X5
          PL     X5,CRI19    IF MODIFY DATE .GE. REQUESTED
 
*         CHECK LAST ACCESS DATE.
 
 CRI8     SA1    LAD
          SA5    ADV         LAST ACCESS
          ZR     X1,CRI9     IF LAST ACCESS DATE NOT AVAILABLE
          BX1    -X0*X1
          ZR     X5,CRI8.0   IF *AD* NOT SPECIFIED
          BX5    X1-X5
          NZ     X5,CRI19    IF NO MATCH
 
*         CHECK ACCESSED AFTER DATE.
 
 CRI8.0   SX1    X1-70000
          PL     X1,CRI8.1   IF YEAR .LT. 2000
          SX1    X1+100000
 CRI8.1   SA5    AAV         ACCESSED AFTER
          ZR     X5,CRI8.3   IF NOT SET
          SX5    X5-70000
          PL     X5,CRI8.2   IF YEAR .LT. 2000
          SX5    X5+100000
 CRI8.2   IX5    X5-X1
          PL     X5,CRI19    IF ACCESS DATE .LE. SPECIFIED DATE
 
*         CHECK ACCESSED BEFORE DATE.
 
 CRI8.3   SA5    ABV         ACCESSED BEFORE
          ZR     X5,CRI9     IF NOT SET
          SX5    X5-70000
          PL     X5,CRI8.4   IF YEAR .LT. 2000
          SX5    X5+100000
 CRI8.4   IX5    X1-X5
          PL     X5,CRI19    IF ACCESS DATE .GE. SPECIFIED DATE
 
*         CHECK FILE TYPE.
 
 CRI9     SA5    TYV         FILE TYPE
          ZR     X5,CRI10    IF NOT A MATCH CRITERION
          MX2    1
          SA1    A0+DBFTY
          LX1    12
          MX3    -6
          BX1    -X3*X1
          LX5    6
          BX5    X1-X5
          NZ     X5,CRI19    IF NO MATCH
 
*         CHECK DUMP DATE.
 
 CRI10    SA5    DDV         DUMP DATE
          SA1    A0+DBDDT
          BX1    -X0*X1
          ZR     X5,CRI11    IF NOT SET
          BX5    X5-X1
          NZ     X5,CRI19    IF NO MATCH
 
*         CHECK DUMPED BEFORE DATE.
 
 CRI11    SX1    X1-70000
          PL     X1,CRI11.1  IF YEAR .LT. 2000
          SX1    X1+100000
 CRI11.1  SA5    DBV         DUMPED BEFORE
          ZR     X5,CRI12    IF NOT SET
          SX5    X5-70000
          PL     X5,CRI11.2  IF YEAR .LT. 2000
          SX5    X5+100000
 CRI11.2  IX5    X1-X5
          PL     X5,CRI19    IF DATE GREATER THAN REQUESTED
 
*         CHECK DUMPED AFTER DATE.
 
 CRI12    SA5    DAV         DUMPED AFTER
          ZR     X5,CRI13    IF NOT SET
          SX5    X5-70000
          PL     X5,CRI12.1  IF YEAR .LT. 2000
          SX5    X5+100000
 CRI12.1  IX5    X5-X1
          PL     X5,CRI19    IF DATE LESS THAN REQUESTED
 
*         CHECK LESS THAN FIELD.
 
 CRI13    SA5    LTV         FILE SIZE LESS THAN
          SA1    A0+DBLEN
          BX1    -X0*X1
          ZR     X5,CRI14    IF NOT SET
          IX5    X5-X1
          NG     X5,CRI19    IF SIZE TOO BIG
          ZR     X5,CRI19    IF SAME VALUE AS THAT ISSUED BY USER
 
*         CHECK GREATER THAN FIELD.
 
 CRI14    SA5    GTV         FILE SIZE GREATER THAN
          NG     X5,CRI15    IF *GT=0* SELECTED
          ZR     X5,CRI16    IF *GT* OPTION OMITTED
 CRI15    IX5    X5-X1
          PL     X5,CRI19    IF SIZE TOO SMALL
          ZR     X5,CRI19    IF SAME VALUE AS THAT ISSUED BY USER
 
*         CHECK RECORD NUMBER.
 
 CRI16    SA1    RCV         RECORD NUMBER VARIABLE
          SA2    A0+DBLEN
          AX2    18
          ZR     X1,CRI17    IF NOT SET
          MX0    -12D
          BX5    -X0*X2
          BX5    X5-X1
          NZ     X5,CRI19    IF RC ON DATABASE .NE. RCV
 
*         CHECK FILE NUMBER.
 
 CRI17    SA1    FIV         FILE NUMBER VARIABLE
          ZR     X1,CRI18    IF NOT SET
          MX0    -6
          AX2    12D
          BX5    -X0*X2
          BX5    X5-X1
          NZ     X5,CRI19    IF FILE POSITION ON DB .NE. FIV
          ZR     X1,CRI20    IF NOT SET
 
*         CHECK LATEST VERSION.
 
 CRI18    SA1    LVV         LATEST VERSION VARIABLE
          SA1    A0+DBUNM
          MX0    42
          BX6    X0*X1
          SA1    A0+DBPFN
          BX7    X0*X1
          SA6    MRUSER
          SA7    MRFILE
          EQ     CRI20       DONT SET ERROR FLAG
 
*         MATCH CRITERIA WERE NOT MET.
 
 CRI19    SX5    B1          CRITERIA UNMET STATUS
          EQ     CRI22       CHECK FOR EXCEPTION PROCESSING
 
*         SET FILE SELECTED FLAG IF PF IS PART OF CRITERIA
 
 CRI20    SA1    PFTAB       PERMANENT FILE TABLE
          SA2    PPFLAG      VERIFY FILE NAME IS PART OF CRITERIA
          BX5    X5-X5       SET CRITERIA MET STATUS
          BX1    X1+X2
          ZR     X1,CRI22    IF FILE NAME NOT PART OF CRITERIA
          SA2    A0+DBPFN
          MX0    6*7
          BX2    X0*X2
          SA1    PFTAB-1
 CRI21    SA1    A1+B1
          ZR     X1,CRI19    IF END OF FILE LIST
          BX3    X0*X1
          BX3    X2-X3
          NZ     X3,CRI21    IF NO MATCH
          SX6    B1
          BX6    X6+X1       SET FILE SELECTED FLAG IN BIT ZERO
          SA6    A1          SAVE IN PFTAB
 
*         CHECK FOR CRITERIA EXCEPTION PROCESSING
 
 CRI22    SA1    EXV         EXCEPTION VARIABLE
          ZR     X1,CRIX     IF NO EXCEPTION PROCESSING
          SX1    B1
          BX5    X1-X5       REVERSE ZERO/NON-ZERO EXIT CONDITION
          EQ     CRIX        RETURN
 CTF      SPACE  4,20
**        CTF - COPY *PFDUMP* FILE TO DISK AND REMOVE CONTROL WORDS.
*
*         ENTRY  (A5) = ADDRESS OF 6-WORD SORT RECORD.
*
*         EXIT   FILE COPIED TO DISK.
*
*         ERROR  TO *ABT* IF INCORRECT DATA TYPE.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 5.
*
*         CALLS  CCE, CDR, CRF, CRI, CTJ, ICF, ILC, POT, PPB, ZTB.
*
*         MACROS MEMORY, MESSAGE, PURGE, READ, READW, RECALL, SAVE,
*                SKIPF, UNLOAD, WRITE, UNLOAD, WRITEW, WRITECW.
 
 
 CTF      SUBR               ENTRY/EXIT
          RECALL TF
          SX6    TFBUF       RESET TAPE BUFFER POINTERS
          SA6    X2+2
          SA6    A6+B1
          READ   X2,R
          READW  X2,WSA,B1   READ 1ST WORD OF FILE
          BX6    X1          SAVE READ STATUS FOR LATER EXAMINATION
          SA6    CTFA
          SX6    PRMITB      FLAG NO PERMITS
          SA6    CTFPLWA
          SA1    LDFN        PRESET SCRATCH FILE NAME
          SA2    LOADFLG
          MX0    42          SET LFN IN COPY OUTPUT FET
          BX6    X1
          NZ     X2,CTF1     IF A LOAD USE SCRATCH NAME
          SA1    DBNAM       DATABASE NAME
          ZR     X1,CTF1.1   IF NOT USING DATABASE
          SA1    A5+B1
          SA2    NNV         NEW NAME VARIABLE
          BX6    X0*X1
          NZ     X2,CTF0     IF ALTERNATE LFN/PFN SPECIFIED
          SA2    A1+B1       WORD 3 OF SORTED RECORD
          BX1    -X0*X2
          BX2    X6
          ZR     X1,CTF0     IF NO NEW NAME
          SA2    X1
 CTF0     BX6    X0*X2       NEW FILE NAME
          RJ     CRF         CHECK RESERVED FILE NAMES
          ZR     X6,CTF15    IF A RESERVED FILE NAME
          RJ     ICF         INITIALIZE COPY FET
          EQ     CTF1.1      CONTINUE PROCESSING
 
 CTF1     SA1    SF          GET CODE/STATUS
          BX1    -X0*X1
          BX6    X1+X6
          SA6    A1
 CTF1.0   UNLOAD SF,R        PREVENT ANY *PFM* ERRORS
          WRITECW  SF,R      PRESET *WRITECW* FUNCTION
 CTF1.1   SA1    CTFA        CHECK INITIAL READ STATUS
          ZR     X1,CTF2     IF DATA ENCOUNTERED
          SA2    DBNAM
          NZ     X2,CTF1.2   IF NOT DB=0
          SX3    X1+2        CHECK FOR EOI ON FILE
          ZR     X3,CTF2.2   IF EOI ON FILE
          SX3    X1+B1       CHECK FOR EOF ON FILE
          NZ     X3,CTF16    IF NOTE EOF ON READ
          SA1    CRC
          ZR     X1,CTF16    IF PSEUDO FILE POINT JUST PROCESSED
          BX6    X6-X6       RESET RECORD NUMBER
          SA6    A1
          SA2    CFC         INCREMENT FILE COUNTER
          SX6    X2+B1
          SA6    A2
          EQ     CTF16       TRY AGAIN
 
 CTF1.2   MESSAGE  EREI,3,R  * DUMP FILE MALFUNC - EOI ENCOUNTERED.*
          EQ     CTF15       FINISH UP
 
 CTF2     SA1    TFBUF       READ CATALOG CONTROL WORD
          SX2    X1-11000B   CHECK FOR NORMAL *PFC*
          AX2    9
          ZR     X2,CTF2.3   IF VALID CATALOG CODE
          SA2    DBNAM       DATABASE NAME
          NZ     X2,CTF2.1   IF USING DATABASE - ERROR
          SA2    HDRPFD
          BX2    X1-X2
          AX2    24
          ZR     X2,CTF2.0   IF *PFDUMP* OR CURRENT *RECLAIM* HEADER
          SA2    =7LRECLAIM
          BX2    X1-X2
          AX2    18
          NZ     X2,CTF16    IF NOT INTERIM *RECLAIM* HEADER
 CTF2.0   READW  TF,WSA+1,HDRSZ
          SA5    /COMSPFS/DAAL+WSA+1  GET DUMP DATE FROM HEADER
          RJ     CTJ         CONVERT TO JULIAN
          SA6    HDRJDT
          EQ     CTF16       GO ON TO NEXT RECORD
 
 CTF2.1   MESSAGE  ERUP,3,R  * DUMP FILE MALFUNC - UNRECOGNIZABLE PFC.*
          EQ     CTF15       FINISH UP
 
 CTF2.2   SX6    B1+
          SA6    EOIFLG      SET EOIFLG FOR COPY
          EQ     CTFX        RETURN
 
 CTF2.3   SA2    DBNAM
          ZR     X2,CTF3     IF NO DATA BASE
          SA2    A5+B1       VERIFY FILE NAME
          BX2    X2-X1
          MX0    42
          BX2    X0*X2
          ZR     X2,CTF3     IF FILE NAME MATCHES OK
          MESSAGE  ERFM,3,R  * DUMP FILE MALFUNC - FILE NAME MISMATCH.*
          EQ     CTF15       FINISH UP
 
 CTF3     BX6    X6-X6       CLEAR PREVIOUS PERMIT TABLE
          SA6    PRMITB
          EQ     CTF5        PROCESS THIS RECORD
 
*         GET NEXT TAPE BLOCK HEADER.
 
 CTF4     READW  TF,WSA,B1   READ CONTROL WORD
          NZ     X1,CTF9.9   IF NO MORE DATA
 CTF5     MX0    -9
          SA1    WSA
          BX5    X1
          BX1    -X0*X1      EXTRACT LENGTH
          SB5    X1          READ IN REMAINDER OF CATALOG IMAGE BLOCK
          LX5    48
          MX0    -3
          BX3    -X0*X5      EXTRACT CODE
 
*         DETERMINE CURRENT BLOCK TYPE.
 
          SX2    X3-1
          NZ     X2,CTF6     IF NOT *CATALOG* BLOCK HEADER
          READW  TF,WSA+1,B5
          ZR     X1,CTF5.0   IF PFC BLOCK IS CORRECT SIZE
          MESSAGE  ERUP,3,R  * DUMP FILE MALFUNC - UNRECOGNIZABLE PFC.*
          EQ     CTF15       FINISH UP
 
 CTF5.0   LX5    12          EXTRACT SIZE OF THIS BLOCK
          MX0    -9
          BX5    -X0*X5
          SX5    X5-NWCE     COMPARE WITH PFC SIZE
          ZR     X5,CTF5.1   IF SIZE IS CORRECT
          SX4    WSA+1       FWA OF PFC
          RJ     CCE         CONVERT PFC TO CORRECT FORMAT
 CTF5.1   SA3    DBNAM
          NZ     X3,CTF5.6   IF A DATA BASE
          SA1    UIV
          ZR     X1,CTF5.2   IF *UI* NOT SPECIFIED
          SA2    TFBUF+FCUI+1 PFC USER INDEX
          MX0    -18
          BX0    -X0*X2
          BX1    X0-X1
          NZ     X1,CTF16    IF NOT THE SPECIFIED USER INDEX
 CTF5.2   SA0    SORR+2      SET TO DUMMY DATABASE ENTRY
          SA3    TFBUF+1     FWA OF PFC ENTRY INFO
          SX5    B1
          RJ     CDR         CREATE DATA BASE RECORD
          SX5    B0+
          RJ     CRI         CHECK THE CRITERIA
          NZ     X5,CTF16    IF CRITERIA DOES NOT MATCH
          RJ     POT         PRINT OUT FILE BEING PROCESSED
          SA1    NFP         NUMBER OF FILES PROCESSED COUNTER
          SX6    X1+1
          SA6    A1          INCREMENT FILE PROCESSED COUNTER
 
*         SET UP FIRST TWO WORDS IN SIX WORD ENTRY
 
          MX0    42
          SA1    A0+DBPFN    GET PF
          BX6    X0*X1
          BX7    X6
          SA1    LOADFLG     CHECK IF LOAD OR COPY
          NZ     X1,CTF5.5   IF A LOAD
          SA2    NNV         NEW NAME VARIABLE
          NZ     X2,CTF5.4   IF NEW NAME SPECIFIED
          BX2    X7          RESET FILE NAME
          SA1    PFV         PERMANENT FILE VARIABLE
          ZR     X1,CTF5.4   IF NO FILE NAMES
          SX3    -1          PRESET COUNTER
 CTF5.3   SX3    X3+1        INCREMENT COUNTER
          SA1    PFTAB+X3    FILE NAME TABLE ENTRY
          ZR     X1,CTF5.4   IF END OF TABLE
          BX4    X0*X1       ISOLATE FILE NAME
          BX4    X6-X4
          NZ     X4,CTF5.3   IF PFNS DO NOT MATCH
          SA2    NNTAB+X3    CORRESPONDING ADDRESS IN NNTAB
          NZ     X2,CTF5.4   IF NEW NAME SPECIFIED
          BX2    X6
 CTF5.4   BX6    X0*X2
          RJ     CRF         CHECK RESERVED FILE NAMES
          ZR     X6,CTF15    IF A RESERVED FILE NAME
          RJ     ICF         INITIALIZE COPY FET
          SA2    SF          RESTORE FILE NAME
          BX6    X0*X2
 CTF5.5   SA1    A0+DBFTY
          LX1    24
          BX2    -X0*X1
          BX6    X6+X2       WORD TWO OF SIX WORD ENTRY
          SA6    SORR+1
          LX1    18
          BX6    -X0*X1
          SA1    A0+DBTNO    GET TN
          BX1    X0*X1
          BX6    X1+X6
          SA6    SORR
          SA5    A6          SET POINTER FOR SIX WORD ENTRY
 CTF5.6   RJ     MFP         MAKE FILE PERMANENT
          NZ     X1,CTF15    IF AN ERROR CREATING FILE
          WRITECW  SF,*      PRESET WRITE FUNCTION
          EQ     CTF4        GET NEXT TAPE BLOCK HEADER
 
*         MOVE PERMIT BLOCK TO PERMITS HOLDING TABLE.
 
 CTF6     SX2    X3-2
          NZ     X2,CTF7     IF NOT *PERMIT* BLOCK HEADER
          SA1    MEMORY      GET CURRENT FIELD LENGTH
          SA4    CTFPLWA     GET CURRENT PERMIT BUFFER LWA
          SB5    B5-NWPH     DISCOUNT PERMIT HEADER
          AX1    30
          SX6    X4+B5       COMPUTE NEW PERMIT BUFFER LWA
          SA6    A4
          IX7    X1-X6       CHECK BUFFER LWA AGAINST FIELD LENGTH
          SX7    X7-8
          PL     X7,CTF6.1   IF SUFFICIENT MEMORY TO HOLD PERMITS
          ERRNG  64-PRMITBWC PERMIT BLOCK WORD COUNT TOO LARGE
          SX6    X1+100B     INCREASE FIELD LENGTH
          LX6    30
          SA6    MEMORY
          MEMORY CM,MEMORY,R
 CTF6.1   SX0    X4          SKIP PERMIT HEADER
          READW  TF,X4,NWPH
          LX5    12          RESTORE WORD COUNT
          MX1    -9
          BX1    -X1*X5
          SB5    X1-NWPH
          READW  TF,X0,B5    READ PERMITS TO BUFFER
          NZ     X1,CTF13    IF PFC MISMATCH
          EQ     CTF4        GET NEXT TAPE BLOCK HEADER
 
 CTF7     SX0    X3-3        CHECK FOR DATA CONTROL WORD
          ZR     X0,CTF8     IF A DATA BLOCK
          READW  TF,WSA,B5   SKIP EXTRANEOUS TAPE BLOCK
          NZ     X1,CTF13    IF TRANSFER NOT NORMAL ISSUE ERROR
          EQ     CTF4        GET NEXT TAPE BLOCK HEADER
 
 CTF8     LX5    3           RIGHT JUSTIFY BLOCK TYPE
          MX0    -3          ISOLATE PLAIN/EOR/EOF/EOI CODE
          BX3    -X0*X5
          SX6    PRUSIZE     PRESET PRU FREE SPACE COUNTER
          SA6    CTFD
          SX1    B0+
          SX3    X3-4        CHECK FOR SYSTEM SECTOR
          NZ     X3,CTF9     IF NOT A SYSTEM SECTOR BLOCK
          READW  TF,WSA,B5   SKIP SYSTEM SECTOR BLOCK
          NZ     X1,CTF13    IF SKIP FAILED THEN ISSUE ERROR
 CTF8.1   READW  TF,WSA,1    READ DATA BLOCK HEADER
 
*         PICK TAPE BLOCKS APART INTO PRU-S AND WRITE THEM TO DISK.
 
 CTF9     NZ     X1,CTF9.9   IF NO MORE DATA
          SA1    WSA
          MX0    -9          ISOLATE TAPE BLOCK LENGTH
          BX6    -X0*X1
          SA6    CTFB        SAVE BLOCK WORD COUNT
          MX0    -3          POSITION AND ISOLATE DATA BLOCK TYPE
          AX1    9
          BX7    -X0*X1
          SA7    CTFC        SAVE TYPE
          SA2    CTFD        PRU FREE SPACE COUNTER
          SX3    X2-PRUSIZE
          ZR     X3,CTF9.3   IF ALL FREE SPACE
          IX3    X6-X2       COMPUTE TAPE BLOCK SIZE - FREE SPACE
          PL     X3,CTF9.2   IF BLOCK SIZE .GE. FREE SPACE
          ZR     X6,CTF9.3   IF TAPE BLOCK IS EMPTY
          SX5    SECTOR+PRUSIZE  SET LWA+1 OF SECTOR
          IX5    X5-X2       COMPUTE FWA OF SECTOR FREE SPACE
          READW  TF,X5,X6    MOVE TAPE BLOCK INTO SECTOR
          EQ     CTF9.5      JOIN WITH FS > WC
 
*         THERE IS DATA IN *SECTOR* FROM THE PREVIOUS TAPE BLOCK, AND
*         THE CURRENT TAPE BLOCK IS BIGGER THAN THE CURRENT FREE SPACE.
 
 CTF9.2   SX5    SECTOR+PRUSIZE  LWA+1 OF SECTOR
          IX5    X5-X2       FWA OF FREE SPACE
          SB5    X2          REMEMBER FREE SPACE SIZE
          READW  TF,X5,B5    FILL SECTOR
          SA4    CTFB        BLOCK WORD COUNT
          SA2    CTFD        SECTOR FREE SPACE
          IX6    X4-X2       COMPUTE NEW WC = WC - FS
          SX7    PRUSIZE
          SA6    A4
          SA7    A2          RESET TO FULL FREE SPACE
          SX5    X7          SET AMOUNT TO COPY
          RJ     WRS         WRITE SECTOR TO DISK
 
*         NOW *SECTOR* IS EMPTY, AND THERE STILL MAY BE DATA LEFT IN
*         THE TAPE BLOCK TO BREAK APART INTO PRU-S.
 
 CTF9.3   SA4    CTFB        CURRENT BLOCK WORD COUNT
          SX3    X4-PRUSIZE  CHECK FOR LESS THAN A FULL PRU
          NG     X3,CTF9.4   IF LESS THAN A SECTOR LEFT TO COPY
          READW  TF,SECTOR,PRUSIZE  MOVE A WHOLE PRU
          SX5    PRUSIZE     SET AMOUNT TO WRITE OUT
          RJ     WRS         WRITE SECTOR TO DISK
          SA4    CTFB        UPDATE WORD COUNT
          SX6    X4-PRUSIZE  SUBTRACT AMOUNT JUST WRITTEN
          SA6    A4
          EQ     CTF9.3      LOOP FOR NEXT FULL SECTOR
 
 CTF9.4   ZR     X4,CTF9.6   IF TAPE BLOCK IS NOW EMPTY
          READW  TF,SECTOR,X4  COPY TAIL END OF BLOCK
 CTF9.5   SA4    CTFB
          SA2    CTFD
          IX6    X2-X4       COMPUTE NEW FS = FS - WC
          SA3    CTFC        DATA BLOCK TYPE
          SA6    A2
          SX2    X3-1        CHECK FOR EOR BLOCK
          NZ     X2,CTF12    IF NOT EOR
          SX7    PRUSIZE
          IX5    X7-X6       COMPUTE SIZE OF SHORT PRU
          SA7    A2          RESET FREE SPACE
          RJ     WRS         WRITE SHORT PRU TO DISK
          EQ     CTF8.1      JOIN WITH EMPTY BLOCK CASE
 
 CTF9.6   SA3    CTFC        DATA BLOCK TYPE
          SX2    X3-1        CHECK FOR EOR BLOCK
          NZ     X2,CTF9.7   IF NOT EOR BLOCK
          SX5    B0+         WRITE ZERO-LENGTH PRU TO DISK
          RJ     WRS
          EQ     CTF8.1      JOIN WITH EOF AND EOI CASES
 
 CTF9.7   SX2    X3-2        CHECK FOR EOF BLOCK
          NZ     X2,CTF9.8   IF NOT EOF BLOCK
          WRITEW SF,PRUHEAD,1  WRITE EOF SECTOR
          WRITEW SF,EOFWORD,1
          EQ     CTF8.1      JOIN WITH EOI CASE
 
 CTF9.8   SX2    X3-3        CHECK FOR EOI BLOCK
          NZ     X2,CTF12    IF NOT EOI BLOCK
          WRITECW  SF,R      FLUSH CIRCULAR BUFFER
          WRITE  SF,*        SET WRITE FUNCTION
          SA5    CTFB        LEFTOVER WORD COUNT
          ZR     X5,CTF10    IF NOTHING LEFT TO COPY
          READW  TF,WSA,X5
          WRITEW SF,WSA,X5
          WRITE  SF,R        FLUSH LAST OF FILE
          EQ     CTF10       CLEAN UP AND RETURN
 
*         HIT EOR/EOF/EOI ON TAPE.
 
 CTF9.9   NG     X1,CTF12.1  IF EOF OR EOI WHEN EOR EXPECTED
 CTF10    WRITECW  SF,R      FLUSH CIRCULAR BUFFER
          SA1    LOADFLG
          ZR     X1,CTFX     IF A COPY
          SX2    1RI
          BX3    X2-X1       COMPARE WITH DATABASE TYPE
          NZ     X3,CTF11    IF NOT AN INDIRECT ACCESS FILE
          SA1    SF
          MX0    -8          WIDTH OF *PFM* ERROR CODE
          LX0    17-7        POSITION TO LOCATION IN FET
          BX6    X0*X1       CLEAR ANY PREVIOUS CODE
          SA6    A1
          SA1    A1+B1
          SX0    4+1         SET *SA* AND *EP* BITS
          LX0    44
          BX6    X0+X1
          MX0    12          CLEAR THE *DT* FIELD
          BX6    -X0*X6
          SA6    A1
          SAVE   SF,PFNAM,PFPASS,PFUCW,PFCAT,PFPERM,,,,PFSS,,,,,,PFAC
          SA2    SF+1
          SX0    4+1         CLEAR *SA* AND *EP* BITS
          LX0    44
          BX6    -X0*X2
          SA6    A2
          SA1    A2-B1
          SX1    X1          EXAMINE BOTTOM 18 BITS
          AX1    10          RIGHT JUSTIFY *PFM* ERROR CODE
          NZ     X1,CTF15    IF AN ERROR SAVING FILE
 CTF11    RJ     PPB         PROCESS PERMIT BLOCK
          UNLOAD SF,R
          EQ     CTFX        RETURN
 
 CTF12    ZR     X3,CTF8.1   IF DATA TYPE IS NOT 5 OR 6 OR 7
 CTF12.1  MESSAGE  ERFT,3,R  * DUMP FILE MALFUNC - FILE TRUNCATED.*
          EQ     CTF13.1     FINISH UP
 
 CTF13    MESSAGE  ERUP,3,R  * DUMP FILE MALFUNC - UNRECOGNIZABLE PFC.*
 CTF13.1  SA1    LOADFLG
          ZR     X1,CTF15    IF A COPY
          SX2    1RI
          BX3    X2-X1
          ZR     X3,CTF14    IF AN INDIRECT FILE
          PURGE  SF
 CTF14    UNLOAD SF,R
 CTF15    MX0    42
          SA1    A5+B1       ENTRY WORD WITH PFN
          BX1    X0*X1
          RJ     ZTB         CONVERT BINARY ZEROES TO BLANKS
          MX0    42
          SA1    LDNG+3
          BX6    X0*X6
          BX1    -X0*X1
          BX6    X6+X1       INSERT NAME IN MESSAGE
          SA6    LDNG+3
          WRITEC O,LDNG      * SEE DAYFILE - UNABLE TO LOAD XXXXXXX.*
          RJ     ILC         INCREMENT LINE COUNT
 
*         SKIP FORWARD IF NOT AT EOR/EOI.
 
 CTF16    SA1    TF          CHECK STATUS
          MX0    -18
          BX1    -X0*X1
          SX1    X1-13B
          NZ     X1,CTFX     IF ALREADY AT EOR/EOF/EOI
          SKIPF  TF,,R
          EQ     CTFX        RETURN
 
 
 CTFA     BSS     1          INITIAL DUMP FILE STATUS
 CTFB     BSS     1          BLOCK WORD COUNT
 CTFC     BSS     1          DATA BLOCK TYPE
 CTFD     BSS     1          PRU FREE SPACE COUNTER
 CTFPLWA  DATA   0           LWA OF PERMIT BUFFER
 CTJ      SPACE  4,15
**        CTJ - CONVERT DISPLAY DATE TO BINARY JULIAN DATE.
*
*         ENTRY  (X5) = DISPLAY DATE   36/0LYYMMDD,24/0.
*                       OR FORMATTED   * YY/MM/DD.*.
*         EXIT   (X6) = BINARY JULIAN DATE.
*                (X6) = 0 IF CONVERSION ERROR.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 4.
*                B - 7.
*
*         CALLS  DXB.
 
 
 CTJ2     SX6    B0+         SET ERROR STATUS
 
 CTJ      SUBR               ENTRY/EXIT
          MX4    -24
          BX2    -X4*X5
          ZR     X2,CTJ0     IF YYMMDD FORMAT
          MX4    12          CONVERT * YY/MM/DD.* FORMAT
          LX5    6
          BX3    X4*X5       ISOLATE YY
          LX5    18
          BX2    X4*X5       ISOLATE MM
          LX5    18
          BX5    X4*X5       ISOLATE DD
          LX5    -12
          BX5    X5+X2       MERGE TO MMDD
          LX5    -12
          BX5    X5+X3       MERGE TO YYMMDD
 CTJ0     SB7    B1+
          RJ     DXB         CONVERT (DECIMAL) DISPLAY TO BINARY
          NZ     X4,CTJ2     IF AN ERROR IN DATE
 
*         EXTRACT YEAR AND STORE IN X1.
 
          SX7    10000
          BX1    X6
          BX2    X7
          IX1    X1/X2       DIVIDE JULIAN DATE BY 10000
          IX2    X1*X7
          IX6    X6-X2       GET REMAINDER AND STORE IN X6
 
*         EXTRACT MONTH AND STORE IN X2.
 
          SX7    100
          BX2    X6
          BX3    X7
          IX2    X2/X3       DIVIDE REMAINDER BY 100
 
*         EXTRACT DAY AND STORE IN X3.
 
          IX3    X2*X7       GET REMAINDER AND STORE IN X3
          IX3    X6-X3
 
*         GET NUMBER OF DAYS IN FULL MONTHS.
 
          SA4    MONTH-1+X2
          MX7    -2          CHECK FOR LEAP YEAR
          BX6    -X7*X1
          NZ     X6,CTJ1     IF NOT A LEAP YEAR
          LX4    30
 
*         BUILD FINAL RESULT.
 
 CTJ1     SX4    X4-1
          SX2    1000
          IX6    X1*X2       YEAR*1000
          IX6    X4+X6       ADD ON DAYS FOR FULL MONTHS
          IX6    X3+X6       ADD ON DAYS FOR PARTIAL MONTH
          EQ     CTJX        RETURN
 CUP      SPACE  4,15
**        CUP - CLEAN UP AFTER DIRECTIVE PROCESSING.
*
*         ENTRY  NONE.
*
*         EXIT   NONE.
*
*         USES   X - 0, 1, 2, 5, 6.
*                A - 1, 2, 5, 6.
*                B - 3.
*
*         CALLS  CDD, IMI.
*
*         MACROS BREAK, CLEAR, MESSAGE, UNLOAD, WRITEC, WRITEW.
 
 
 CUP      SUBR               ENTRY/EXIT
          CLEAR  DB
          UNLOAD DB,R
          CLEAR  UPDATES
          CLEAR  NUMBERS
          SX6    B0+         REMOVE DEBRIS OF PREVIOUS DUMP
          SA6    INDXLEN
          SA6    INDXNAM
          SA6    INDXNAM+1
          SA6    NEW+6
          SA6    CAT+6
          SA6    DB+6
          SA6    UPE
          SA6    DBE
          MX2    13
          SA1    DB+1
          BX6    -X2*X1      REMOVE DEVICE TYPE AND RANDOM BIT
          SA6    A1+
          SA1    CAT         REMOVE EOI CODE
          MX2    6*7
          BX6    X2*X1
          SX5    3
          BX6    X6+X5
          SA6    A1
 
 
*         WARN USER OF FILES SPECIFIED BUT NOT PROCESSED
 
          MX0    42
          MX6    0
          SA6    PFCNT       CLEAR PFTAB POINTER
          SA6    CUPB        CLEAR FLAG WORD
 CUP0     SA2    PFCNT
          SA1    PFTAB+X2    PFTAB(PFCNT)
          ZR     X1,CUP0.1   IF END OF LIST
          SX6    X2+B1
          SA6    PFCNT       INCREMENT COUNTER
          BX6    X1
          LX6    59          POSITION TO SELECTED FLAG
          NG     X6,CUP0     IF FILE WAS SELECTED
          SA6    CUPB        NOTE THAT A FILE WAS MISSED
          BX1    X0*X1       EXTRACT THE FILE NAME
          SB3    CUPA        * FILE NOT FOUND OR FAILED CRITERIA.*
          RJ     IMI         ISSUE MESSAGE INSERTING NAME
          RJ     ILC         INCREMENT LINE COUNT
          EQ     CUP0        PROCESS NEXT FILE
 
*         RESET BREAK CONDITION.
 
 CUP0.1   SA2    NFP         NUMBER OF FILES PROCESSED
          BX6    X6-X6
          SA1    BREAK
          SA6    A1
          NZ     X1,CUPX     IF USER HAS INTERRUPTED
          SA1    EOR
          NZ     X1,CUP4     IF EOR/EOF ENCOUNTERED ON INPUT
 
*         CHECK FOR NO HEADER -- LO=N -- REQUEST.
 
          SA1    NHV         HEADER OPTION VARIABLE
          ZR     X1,CUP1     IF EXIT HEADER WANTED
          NZ     X2,CUP4     IF AT LEAST ONE FILE HAS BEEN PROCESSED
          WRITEC O,HEADER6
          EQ     CUP4        FINISH UP OUTPUT PROCESSING
 
*         DISPLAY EXIT MESSAGE.
 
 CUP1     SA5    HEADER2
          ZR     X2,CUP2     IF NO FILES PROCESSED
          BX1    X2
          RJ     CDD         CONVERT TO DECIMAL
          LX6    18
          MX0    42
          BX6    X0*X6
          BX1    -X0*X5
          BX6    X1+X6
          EQ     CUP3        SAVE FILE COUNT AND ISSUE MESSAGE
 
 CUP2     SA1    HEADER5     NO FILES PROCESSED
          BX6    X1
 CUP3     SA6    A5
          WRITEW O,HEADER1,HEADER4  FILES PROCESSED COUNT
          MESSAGE HEADER2,3
 CUP4     BREAK
          SA1    NAP
          NZ     X1,CUPX     IF NO ABORT PARAMETER SELECTED
          SA1    NAV
          NZ     X1,CUPX     IF NO ABORT OPTION SELECTED
          SA1    CUPB
          NZ     X1,MAIN7    IF ANY FILES WERE MISSED
          EQ     CUPX        RETURN
 
 
 CUPA     DATA   C*   FILE NOT FOUND OR FAILED CRITERIA - !!!!!!!.*
 CUPB     BSS    1           FILE MISSED FLAG
 CVD      SPACE  4,10
***       CVD - CONVERT PACKED DATE TO BINARY JULIAN DATE.
*
*         ENTRY  (X5) = 42/0,18/BIASED BINARY DATE
*
*         EXIT   (X6) = BINARY JULIAN DATE.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 4.
 
 
 CVD      SUBR               ENTRY/EXIT
 
*         EXTRACT YEAR AND STORE IN X1.
 
          MX4    -6
          BX3    -X4*X5      DD
          LX5    -6
          BX2    -X4*X5      MM
          LX5    -6
          BX1    -X4*X5      YY
          SX1    X1-30
          PL     X1,CVD1     IF YEAR .GE. 2000
          SX1    X1+100      UNBIAS YEAR
 
*         GET NUMBER OF DAYS IN FULL MONTHS.
 
 CVD1     SA4    MONTH-1+X2
          SX4    X4-1
 
*         CHECK FOR LEAP YEAR.
 
          MX0    58D         SET MASK FOR 3 BITS
          BX6    -X0*X1      SEE IF YEAR DIVISIBLE BY 4
          NZ     X6,CVD4     IF NOT A LEAP YEAR
          BX0    -X0         CHECK FOR JANUARY OR FEBRUARY
          IX6    X2-X0       SUBTRACT 3 FROM MONTH
          NG     X6,CVD4     IF JANUARY OR FEBRUARY
          SX4    X4+B1
 
*         BUILD FINAL RESULT.
 
 CVD4     SX2    1000D
          IX6    X1*X2       YEAR*1000
          IX6    X4+X6       ADD ON DAYS FOR FULL MONTHS
          IX6    X3+X6       ADD ON DAYS FOR PARTIAL MONTH
          EQ     CVDX        RETURN
 CVH      SPACE  4,15
**        CVH - CHECK FOR VALID DUMP HEADER.
*
*         CVH EXAMINES THE ASSIGNED DUMP TAPE FOR A VALID HEADER.
*
*         ENTRY  (X5) = FET ADDRESS OF ASSIGNED TAPE.
*
*         EXIT   (X1) = 0 IF FIRST RECORD ON TAPE IS A DUMP HEADER.
*                (X1) .NE. 0 IF FIRST RECORD IS NOT A DUMP HEADER.
*                TAPE IS REWOUND.
*
*         USES   X - 1.
*                A - 1.
*                B - 2.
*
*         MACROS READ, READO, REWIND.
 
 
 CVH      SUBR               ENTRY/EXIT
          REWIND X5,R
          SB2    B0+         PRESET VALID
          SA1    NVV
          NZ     X1,CVH2     IF NOT VALIDATING DUMP FILE
          READ   X5,R
          READO  X5          READ FIRST WORD AT BOI
          NZ     X1,CVH1     IF NOT *TRANSFER COMPLETE*
          SX1    X6-11000B   COMPARE WITH CATALOG CONTROL WORD
          AX1    9           IGNORE SIZE FIELD
          ZR     X1,CVH1     IF MATCHED PFC CONTROL WORD
          SA1    HDRPFD
          BX1    X6-X1       COMPARE WITH PFDUMP LABEL HEADER
          AX1    24          IGNORE POSSIBLE CATALOG TRACK COUNT
          ZR     X1,CVH1     IF *PFDUMP* OR CURRENT *RECLAIM* HEADER
          SA1    =7LRECLAIM  COMPARE WITH INTERIM *RECLAIM* HEADER
          BX1    X6-X1
          AX1    18
 
*         (X1) = VALID OR INVALID FLAG.
 
 CVH1     SB2    X1          SAVE VALID/INVALID INDICATION
          REWIND X5,R
 CVH2     SX1    B2+
          EQ     CVHX        RETURN
 CVP      SPACE  4,30
**        CVP - CONVERT PARAMETERS.
*
*         *CVP* CONVERTS DISPLAY CODE VARIABLES TO BINARY VALUES BASED
*         ON BITS SET IN THE *ARMTAB* WORD FOR EACH PARAMETER--
*                BIT 26 - JULIAN DATE TO BE CONVERTED.
*                BIT 25 - OCTAL TO BE CONVERTED.
*                BIT 24 - DECIMAL TO BE CONVERTED.
*                BIT 23 - SET OPTION BITS FOR *TY* OPTION.
*                BIT 22 - SET OPTION BITS FOR *PO* OPTION.
*                BIT 21 - SPACE FILL TAPE NUMBER.
*         DISPLAY CODE *0* IS CONVERTED TO BINARY 0.
*
*         ENTRY  NONE.
*
*         EXIT   NONE.
*
*         ERROR  TO *MAIN7* IF PARAMETER ERROR.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 3, 4, 5, 6.
*                B - 2, 6, 7.
*
*         CALLS  CTJ, CVS, DXB, ZTB.
*
*         MACROS MESSAGE, WRITEC.
 
 
 CVP      SUBR               ENTRY/EXIT
          MX0    6
          SA1    RPV         REPLACE,VARIABLE
          SA2    OPNO        NO OPTION
          BX1    X0*X1       ISOLATE OPTION
          BX6    X2-X1
          SA6    A1          SET OPTION VARIABLE
          LX1    6
          SX6    X1-1RC
          SA6    RPCL        SET COPY TO CURRENT LOCATION FLAG
          SA1    EXV         EXCEPTION VARIABLE
          BX1    X0*X1
          BX6    X2-X1
          SA6    A1          SET EXCEPTION VARIABLE
          SA1    ASV         ALTERNATE STORAGE VARIABLE
          BX1    X0*X1
          BX6    X2-X1
          SA6    A1          SET ALTERNATE STORAGE VARIABLE
          SA1    EIV         ZERO *EIV* IF *EI=NO* ON DIRECTIVE
          BX1    X0*X1
          BX6    X1-X2
          ZR     X6,CVP1     IF *EI=NO* SPECIFIED
          SA2    =1L#        CHECK FOR DEFAULT
          BX6    X1-X2
          NZ     X6,CVP1     IF NOT *NO* AND NOT DEFAULT ASSUME *YES*
          SA2    COPTION
          SA1    =0LCOMPACT
          BX6    X1-X2       *COMPACT* DEFAULT IS *NO*, ALL OTHER *YES*
 CVP1     SA6    EIV
          MX6    60
          SA1    DTV         *DT* OPTION
          ZR     X1,CVP2     IF *DT* NOT SPECIFIED
          SA2    DTMS
          BX2    X1-X2
          AX2    36
          NZ     X2,CVP3     IF NOT MASS STORAGE DEVICE TYPE
          SX6    B1+         EXPLICIT MASS STORAGE SELECTION
          SA6    MSV
          EQ     CVP4        CONTINUE
 
 CVP2     SA1    DV          *D* OPTION
          SA2    MTV         *MT* OPTION
          BX2    X1+X2
          SA1    NTV         *NT* OPTION
          BX2    X1+X2
 CVP3     ZR     X2,CVP4     IF *D*/*MT*/*NT* OPTIONS NOT SELECTED
          SA6    MSV
 CVP4     SA1    COPTION
          SA2    =0LCOMPACT
          BX5    X1-X2
          SA1    TNV         TAPE NAME VARIABLE
          ZR     X5,CVP5     IF DIRECTIVE IS *COMPACT*
          SA5    MSV         GET MASS STORAGE INDICATOR
 CVP5     NZ     X1,CVP6     IF TAPE NAME SET
          SA2    DNV         DUMP NAME VARIABLE
          SA1    DFV         DEFAULT FILE NAME
          ZR     X2,CVP6     IF DUMP NAME NOT SET
          BX1    X2
          NG     X5,CVP6     IF EXPLICIT TAPE OR DENSITY OPTION SET
          SX5    B1          MASS STORAGE IMPLIED
 CVP6     BX6    X1
          SX1    X5+         ABSOLUTE VALUE OF MASS STORAGE INDICATOR
          BX1    X1+X2
          ZR     X1,CVP7     IF NO DUMP NAME AND NOT MASS STORAGE
          SA6    TF+TTNV     SET DUMP VSN VARIABLE
 CVP7     SA6    TF+TDNV     SET DUMP NAME VARIABLE
          NZ     X5,CVP8     IF MASS STORAGE DUMP
          SA1    TF+TTNV
          ZR     X1,CVP8     IF NO *TN* OR *DN* SUPPLIED
          RJ     CVS         BLANK FILL VSN AND CHECK FOR *SCRATCH*
          SA6    TF+TTNV
          SA1    DFV
          BX6    X1
 CVP8     SA6    TF+TDFV     SET DUMP LFN
          SA1    CTV         COMPACT TAPE NAME
          SX6    X5
          BX2    X1          PRESET NON-ZERO IF *CTV* NON-ZERO
          SA6    TF+TMSV     STORE DUMP FILE MASS STORAGE FLAG
          SA5    MSV
          NZ     X1,CVP9     IF COMPACT TAPE NAME SET
          SA2    CNV         COMPACT DUMP NAME
          SA1    CFV         DEFAULT COMPACT FILE NAME
          ZR     X2,CVP9     IF COMPACT DUMP NAME NOT SET
          BX1    X2
          NG     X5,CVP9     IF EXPLICIT TAPE OR DENSITY OPTION SET
          SX5    B1+         MASS STORAGE IMPLIED
 CVP9     BX6    X1
          SX1    X5+         ABSOLUTE VALUE OF MASS STORAGE INDICATOR
          BX1    X1+X2
          ZR     X1,CVP10    IF NO COMPACT NAME AND NOT MASS STORAGE
          SA6    MF+TTNV     SET COMPACT VSN VARIABLE
 CVP10    SA6    MF+TDNV     SET COMPACT DUMP NAME VARIABLE
          NZ     X5,CVP11    IF MASS STORAGE COMPACT
          SA1    MF+TTNV
          ZR     X1,CVP11    IF NO *CT* OR *CN* SUPPLIED
          RJ     CVS         BLANK FILL VSN AND CHECK FOR *SCRATCH*
          SA6    MF+TTNV
          SA1    CFV
          BX6    X1
 CVP11    SA6    MF+TDFV     STORE COMPACT LFN
          SX6    X5
          SA6    MF+TMSV     STORE COMPACT MASS STORAGE FLAG
          SB6    ARMTABL
 
*         PROCESS NEXT PARAMETER.
 
 CVP12    SB6    B6-B1
          NG     B6,CVP26    IF END OF TABLE ENCOUNTERED
          SA5    VARIABL+B6  CHECK NEXT VALUE
          ZR     X5,CVP12    IF NO OPTION
 
*         CHECK FOR DISPLAY CODE ZERO.
 
          BX1    X5
          MX0    6
          BX6    X0*X1       ISOLATE LEFTMOST CHARACTER
          LX6    6           RIGHT JUSTIFY CHARACTER
          SX6    X6-1R0      COMPARE WITH A ZERO
          NZ     X6,CVP13    IF THIS IS NOT A DISPLAY CODE ZERO
 
*         MAKE PROVISION FOR VARIABLES THAT MAY START
*         WITH A DISPLAY CODE ZERO AS THE FIRST CHARACTER.
 
          LX1    6
          BX6    X0*X1
          NZ     X6,CVP13    IF NOT JUST DISPLAY CODE ZERO
          SX1    A5          CHECK FOR *PF* AND *FN* OPTIONS
          SX2    PFV
          BX2    X1-X2
          ZR     X2,CVP13    IF *PF* OPTION
          SX2    FNV
          BX2    X1-X2
          ZR     X2,CVP13    IF *FN* OPTION
          SX2    NNV
          BX2    X1-X2
          NZ     X2,CVP15.1  IF NOT *NN* OPTION
 
*         CHECK FOR 7 CHARACTER FILE NAME.
 
 CVP13    MX0    -18
          BX1    -X0*X5      CHECK FOR TOO MANY CHARACTERS
          NZ     X1,CVP25    IF MORE THAN SEVEN CHARACTERS ENTERED
 
*         CHECK CONVERSION BITS.  SET (X1) = CONVERSION FLAGS.
 
          SA1    ARMTAB+B6   GET CORRESPONDING TABLE ENTRY
 
*         CHECK FOR JULIAN DATE.
 
          LX1    59-26
          PL     X1,CVP14    IF NOT JULIAN DATE
          ZR     X5,CVP25    IF DATE EQUAL ZERO
          BX1    X5
          RJ     CTJ         CONVERT DATE TO BINARY JULIAN
          ZR     X6,CVP25    IF ERROR IN ASSEMBLY
          SA6    A5          SAVE CONVERTED DATE
          EQ     CVP12       PROCESS NEXT ENTRY
 
*         CHECK FOR OCTAL FIELD.
 
 CVP14    LX1    59-25-59+26
          PL     X1,CVP16    IF NOT OCTAL CONVERSION
          SB7    B0          SET OCTAL CONVERSION FOR *DXB*
 
*         CONVERT FIELD TO BINARY.
 
 CVP15    RJ     DXB         CONVERT DECIAML/OCTAL TO BINARY
          NZ     X6,CVP15.2  IF NOT EXPLICIT ZERO VALUE
 CVP15.1  SX2    GTV
          SX5    A5
          BX5    X2-X5
          NZ     X5,CVP15.2  IF NOT THE *GT* OPTION
          MX6    -0          SET TO NEGATIVE ZERO
 CVP15.2  SA6    A5          SET BINARY VALUE INTO CONVERSION TABLE
          EQ     CVP12       PROCESS NEXT ENTRY
 
*         CHECK FOR DECIMAL FIELD.
 
 CVP16    LX1    59-24-59+25
          PL     X1,CVP17    IF NOT DECIMAL CONVERSION
          SB7    1           INDICATES DECIMAL BASE
          EQ     CVP15       CONVERT TO BINARY
 
*         CHECK FOR *TY* OPTION.
 
 CVP17    MX0    -6
          SX6    B0+
          LX1    59-23-59+24
          PL     X1,CVP20    IF NOT *TY* OPTION
 CVP18    LX5    6
          BX2    -X0*X5
          ZR     X2,CVP19    IF LAST CHARACTER
          MX1    1
          SB2    X2
          LX1    B2
          BX6    X6+X1
          EQ     CVP18       ASSEMBLE NEXT BIT
 
 CVP19    SX2    1S9+1S4     ENSURE ONLY *I* OR *D* BITS ON
          LX2    -1          BIT NUMBER = CHARACTER - 1
          BX2    -X2*X6
          NZ     X2,CVP25    IF BAD CHARACTER
          EQ     CVP12       GET NEXT PARAMETER
 
*         CONVERT CHARACTER STRING TO TURN ON BITS IN WORD
*         FOR *PO* OPTION ON TAPE REQUEST.
 
 CVP20    LX1    59-22-59+23
          PL     X1,CVP23    IF NOT *PO* OPTION
          SA2    CVPA        SET DEFAULT PROCESSING OPTIONS
          BX6    X2
 CVP21    LX5    6           EXTRACT 1 CHARACTER
          BX2    -X0*X5
          ZR     X2,CVP22    IF END OF PARAMETERS
          SA4    CVPB
          SB2    X2
          AX4    X4,B2
          LX4    -1
          PL     X4,CVP25    IF NOT LEGAL OPTION
          CX4    X4
          SA2    CVPB+X4     MERGE VALUE FOR THIS CHARACTER
          BX6    X6+X2
          EQ     CVP21       PROCESS NEXT CHARACTER
 
 CVP22    MX0    -36         MERGE PROCESSING OPTIONS
          BX2    -X0*X6      EXTRACT LOWER BITS TO BE DESELECTED
          BX6    X0*X6       EXTRACT UPPER BITS TO BE SELECTED
          LX2    36
          BX6    -X2*X6      FINAL OPTION SELECTION
          EQ     CVP24       SAVE PROCESSING OPTIONS
 
*         CHECK FOR PARAMETERS REQUIRING SPACE FILL.
 
 CVP23    LX1    59-21-59+22
          PL     X1,CVP12    IF NOT SPACE FILL
          BX1    X5
          RJ     ZTB         CONVERT BINARY ZEROES TO BLANKS
 CVP24    SA6    A5          SAVE VALUE
          EQ     CVP12       PROCESS NEXT PARAMETER
 
*         PROCESS INCORRECT PARAMETER VALUE.
 
 CVP25    MESSAGE  CVPC,3    * INCORRECT ARGUMENT VALUE.*
          WRITEC O,CVPC
          EQ     MAIN7       PROCESS ERROR
 
 
*         CONVERT FILE RESIDENCE OPTION.
 
 CVP26    SA5    RSV
          ZR     X5,CVP26.3  IF FILE RESIDENCE NOT SPECIFIED
          SX0    77B
          SX6    B0+
 CVP26.1  LX5    6
          BX2    X0*X5
          ZR     X2,CVP26.2  IF LAST CHARACTER
          MX1    1
          SB2    X2+B1
          LX1    B2
          BX6    X6+X1
          EQ     CVP26.1     ASSEMBLE NEXT BIT
 
 CVP26.2  SA2    CVPE        ENSURE *C*, *D* AND/OR *T* ONLY
          BX1    -X2*X6
          NZ     X1,CVP25    IF BAD CHARACTER(S)
          SA6    A5+
 CVP26.3  SA1    MSV
          NZ     X1,CVPX     IF PROCESSING A MASS STORAGE DUMP FILE
          SA1    TMSTAT
          NZ     X1,CVPX     IF TMS IS ACTIVE
          SA1    FTV
          SX6    2RFT        SET UP FOR *FT* IN MESSAGE
          NZ     X1,CVP27    IF *FT* WAS USED
          SX6    2RPW        SET UP FOR *PW* IN MESSAGE
          SA2    PWV
          NZ     X2,CVP27    IF *PW* WAS USED
          SA3    TOV
          ZR     X3,CVPX     IF *TO* NOT USED
          SX6    2RTO        INSERT *TO* KEYWORD IN MESSAGE
 CVP27    SA1    CVPD
          MX0    -12
          LX6    42
          LX0    42
          BX1    X0*X1       REMOVE PREVIOUS KEYWORD
          BX6    X6+X1       INSERT OPTION ID
          SA6    A1
          MESSAGE  CVPD,3    * XX OPTION INCORRECT - TMS NOT ACTIVE.*
          WRITEC O,CVPD
          EQ     MAIN7       PROCESS ERROR
 
 
 CVPA     DATA   1S41        DEFAULT PROCESSING OPTIONS (U)
 
 CVPB     DATA   51070742B   MASK BITS FOR OPTIONS (WURNMLHGFEA)
          DATA   1S40        W OPTION
          DATA   1S41        U OPTION
*         DATA   1S45        S OPTION    (OP=S NOT ALLOWED)
          DATA   1S39        R OPTION
*         DATA   1S46        P OPTION    (OP=P NOT ALLOWED)
          DATA   1S37        N OPTION
          DATA   1S43        M OPTION
          DATA   1S7         L OPTION
*         DATA   1S47        I OPTION    (OP=I NOT ALLOWED)
          DATA   1S6         H OPTION
          DATA   1S42        G OPTION
          DATA   1S5         F OPTION
          DATA   1S38        E OPTION
          DATA   1S36        A OPTION
 
 CVPC     DATA   C* INCORRECT ARGUMENT VALUE.*
 CVPD     DATA   C* XX OPTION INCORRECT - TMS NOT ACTIVE.*
 CVPE     CON    1S20+1S4+1S3      MASK FOR *RS* VALUES (TDC)
 CVS      SPACE  4,20
**        CVS - CHECK VSN FOR SCRATCH.
*
*         CVS COMPARES THE VSN TO *SCRATCH* AND *0* AND CONVERTS IT TO
*         BLANKS IF IT MATCHES.  OTHERWISE THE VSN IS BLANK FILLED AND
*         TRUNCATED TO SIX CHARACTERS.  IF *TMS* IS ACTIVE AND THE *FT*
*         OPTION WAS NOT SELECTED, *PVZ* IS CALLED TO INSERT DISPLAY
*         CODE ZEROES PRECEDING THE FIRST DIGIT OF SHORT VSN-S.
*
*         ENTRY  (X1) = THE VSN VARIABLE AS SUPPLIED BY THE USER.
*
*         EXIT   (X6) = THE SIX CHARACTER BLANK FILLED VSN - ALL BLANKS
*                       IF THE ORIGINAL VALUE WAS *SCRATCH* OR *0*.
*
*         USES   X - 0, 1, 2, 6.
*                A - 2, 6.
*
*         CALLS  PVZ, ZTB.
 
 CVS      SUBR               ENTRY/EXIT
          SA2    =7LSCRATCH
          MX0    42
          BX2    X1-X2
          BX2    X0*X2
          ZR     X2,CVS1     IF VSN IS *SCRATCH*
          SA2    =1L0
          BX2    X1-X2
          NZ     X2,CVS2     IF VSN IS NOT *0*
 CVS1     BX1    X1-X1       CLEAR VSN
          SX6    B0          FORCE DUMP AT BEGINNING OF INFORMATION
          SA6    EIV
 CVS2     RJ     ZTB         CONVERT BINARY ZEROES TO BLANKS
          MX0    36
          BX6    X0*X6
          SA2    TMSTAT
          ZR     X2,CVSX     IF *TMS* NOT ACTIVE
          SA2    FTV
          NZ     X2,CVSX     IF NOT A *TMS* TAPE
          RJ     PVZ         PAD VSN WITH DISPLAY ZEROES
          EQ     CVSX        RETURN
 CVT      SPACE  4,15
**        CVT - CHECK FOR VALID DUMP TAPE.
*
*         CVT EXAMINES THE ASSIGNED DUMP FILE FOR A VALID DUMP.
*
*         ENTRY  (X5) = FET ADDRESS OF ASSIGNED DUMP FILE.
*
*         EXIT   (X1) = 0 IF TAPE HAS AT LEAST ONE GOOD DUMP OR USER
*                            SELECTED THE NO VALIDATION PARAMETER.
*                            TAPE IS POSITIONED BEFORE FIRST EOF.
*                (X1) .NE. 0 IF TAPE HAS NO GOOD DUMPS.
*                            TAPE IS REWOUND.
*
*         USES   X - 1, 2.
*                A - 1, 2.
*
*         CALLS  CVH
*
*         MACROS BKSP, READ, READO, REWIND, SKIPFF.
 
 
 CVT      SUBR               ENTRY/EXIT
          RJ     CVH         CHECK FOR VALID HEADER
          NZ     X1,CVTX     IF NO VALID HEADER
          SA2    NVV
          NZ     X2,CVTX     IF NO VALIDATION WANTED
          SKIPFF X5,1,R      SKIP FORWARD TO AN EOF
          SA1    X5
          LX1    59-9        LEFT JUSTIFY EOI BIT
          NG     X1,CVT1     IF HIT EOI THEN FINISH
          BKSP   X5,R        BACKSPACE OVER EOF
          BKSP   X5,R        BACKSPACE OVER POSSIBLE END-OF-DUMP
          SA1    X5
          LX1    59-3        LEFT JUSTIFY EXTRA *REWIND* STATUS BIT
          NG     X1,CVT1     IF *REWIND* STATUS THEN FINISH
          READ   X5,R
          READO  X5          GET A WORD FROM THE RECORD
          NZ     X1,CVT1     IF TRANSFER NOT COMPLETE
          SA2    TRAILER     END-OF-DUMP WORD
          BX1    X6-X2       COMPARE INPUT WORD WITH END-OF-DUMP
          NZ     X1,CVT1     IF NOT AN END-OF-DUMP WORD
          READO  X5          GET SECOND WORD OF RECORD
          SX1    X1-1        COMPARE STATUS WITH *EOR ENCOUNTERED*
          ZR     X1,CVTX     IF EOR (VALID DUMP TAPE)
 
*         NOT A VALID DUMP TAPE - EXIT WITH (X1) NON-ZERO.
 
 CVT1     REWIND X5,R
          SX1    B1+         FLAG NOT VALID DUMP TAPE
          EQ     CVTX        RETURN
 DFT      SPACE  4,15
**        DFT - DUMP FILE TO TAPE.
*
*         ENTRY  CATLIST OF FILE IN *CATBUF*.
*
*         EXIT   (X1) = 0 IF NO DUMP ERRORS.
*                (X1) .NE. 0 IF FILE ATTACH/GET FAILED.
*                FILE DUMPED TO TAPE.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 3.
*
*         CALLS  CRF, ILC, IMI.
*
*         MACROS ATTACH, BKSP, CATLIST, CLEAR, COPYBLK, CRF, GET,
*                PDATE, READCW, READO, REWIND, WRITE, WRITEO, WRITER,
*                WRITEW, UNLOAD.
 
 
 DFT      SUBR               ENTRY/EXIT
          SX6    DCW         INITIALIZE TAPE BLOCK CONTROL WORD
          SA6    BLOKHED
          WRITE  TF,*        SET WRITE FUNCTION
          SX6    011000B
          SX1    NWCE        LENGTH OF THE PFC
          BX6    X1+X6
          SA1    CATBUF
          MX0    42
          BX1    X0*X1
          BX6    X1+X6
          SA6    PRMITH
          SA1    ASV         ALTERNATE STORAGE VARIABLE
          SA2    NNV         NEW NAME VARIABLE
          NZ     X1,DFT0.0   IF PRESERVING ALTERNATE STORAGE DATA
          SX6    B0+         CLEAR ALTERNATE STORAGE DATA
          SA6    CATBUF+FCAA
          SA6    CATBUF+FCTV
 DFT0.0   BX2    X0*X2       MASK NEW NAME
          NZ     X2,DFT0.1   IF NEW NAME FROM *NN* OPTION
          SA1    DBE+DBUNM
          BX6    -X0*X1      GET NEW NAME POINTER
          ZR     X6,DFT0.2   IF NO NEW NAME SPECIFIED
          SA1    X6          GET NEW NAME FROM FILE NAME LIST
          BX2    X0*X1
 DFT0.1   SA1    CATBUF+FCFN CATLIST FILE NAME
          BX6    -X0*X1      EXTRACT USER INDEX
          BX6    X6+X2       UN + UI
          SA6    A1
          SA2    PRMITH      PLACE NEW NAME IN *PRMITH*
          BX2    -X0*X2
          BX6    X0*X6
          BX6    X6+X2
          SA6    A2
          BX6    X1          SAVE OLD *CATBUF* ENTRY
          SA6    SAVEBUF
          WRITEW TF,PRMITH,NWCE+1
          SA1    SAVEBUF     RESTORE OLD CATBUF ENTRY
          BX6    X1
          SA6    CATBUF+FCFN
          EQ     DFT0.3      CONTINUE
 
 DFT0.2   WRITEW TF,PRMITH,NWCE+1
 DFT0.3   SA1    PFTAB       PERMANENT FILE TABLE
          ZR     X1,DFT0.4   IF NOT PROCESSING LOCAL FILES
          SA2    PFCNT
          SA1    PFTAB+X2    PFTAB(PFCNT)
          SX6    X2+B1       INCREMENT COUNTER
          SA6    A2
          BX2    X1
          LX2    58          POSITION TO LOCAL FILE FLAG
          PL     X2,DFT0.4   IF FILE IS NOT LOCAL
          MX0    42
          BX6    X0*X1
          RJ     CRF         CHECK RESERVED FILE NAMES
          ZR     X6,DFT2.1   IF RESERVED FILE NAME
          SA1    NEW
          BX7    X1          SAVE SCRATCH FET NAME
          SA7    SCRFET
          BX1    -X0*X1      LOWER 18 BITS
          BX6    X6+X1
          SA6    A1          SET FILE NAME IN FET
          BX6    X0*X1       CLEAR LOWER 18 BITS
          SA1    A1+8        FET+8
          BX1    -X0*X1      LOWER 18 BITS
          BX6    X6+X1
          SA6    A1          SET PFN IN FET
          REWIND NEW,R
          SX6    B1          FLAG *DFT* IS DUMPING A LOCAL FILE
          SA6    DUMPLOC
          EQ     DFT2        CHECK FOR PFM ERRORS
 
 DFT0.4   SA1    CATBUF+FCRI
          MX0    24
          BX6    X0*X1
          ZR     X6,DFT0     IF FILE HAS NO PERMITS
          SA1    CATBUF+FCUI
          MX0    -18
          BX2    -X0*X1
          LX2    12
          BX6    X2+X6
          BX7    X0*X1
          SA7    A1
          SA6    PRMITB+1
          PDATE  PRMITB+2
 DFT0.5   CLEAR  NEW         RESET FET POINTERS
          CATLIST  NEW,CATBUF,,M  GET SOME PERMITS
          SA1    NEW+2       COMPUTE PERMIT WORD COUNT
          SA2    A1+B1
          IX5    X1-X2
          BX0    X2          INITIALIZE BUFFER POINTER
          SX6    20000B+PRMITBWC+2  SET PERMIT BLOCK HEADER
          SA6    PRMITB
 DFT0.6   SX5    X5-PRMITBWC REDUCE REMAINING WORD COUNT
          ZR     X5,DFT0.7   IF FULL BLOCK LEFT
          NG     X5,DFT0.7   IF LESS THAN A FULL BLOCK
          WRITEW TF,PRMITB,3 WRITE PERMIT BLOCK HEADER
          WRITEW TF,X0,PRMITBWC  WRITE PERMIT BLOCK
          SX0    X0+PRMITBWC ADVANCE BUFFER POINTER
          EQ     DFT0.6      LOOP FOR ANOTHER BLOCK
 
 DFT0.7   SX5    X5+PRMITBWC COMPUTE BLOCK WORD COUNT
          SX6    X5+20000B+2
          SA1    NEW         CHECK END OF PERMITS (EOI) FLAG
          SX2    1000B
          BX2    X2*X1
          BX6    X6+X2       TREAT EOI FLAG AS PERMIT LAST BLOCK FLAG
          SA6    PRMITB      SET PERMIT BLOCK HEADER
          WRITEW TF,PRMITB,3 WRITE PERMIT BLOCK HEADER
          WRITEW TF,X0,X5    WRITE PERMIT BLOCK
          SA1    NEW
          LX1    59-9
          PL     X1,DFT0.5   IF MORE PERMITS
 
 DFT0     CLEAR  NEW         RESET BUFFER POINTERS
          SA1    NEW+1       SET *SA* BIT IN FET
          MX6    1
          LX6    46-59
          BX6    X6+X1
          SA6    A1
          SA1    CATBUF      ENSURE PERMANENT FILE NAME IN FET
          MX6    42
          BX6    X6*X1
          SA6    NEW+10B
          SA1    CATBUF+FCBS
          LX1    59-11
          NG     X1,DFT1     IF A DIRECT ACCESS FILE
          GET    NEW
          EQ     DFT2        CHECK *PFM* STATUS
 
 DFT1     ATTACH NEW,,,,R
 DFT2     SA1    NEW+1       CLEAR *SA* BIT
          MX6    1
          LX6    46-59
          BX6    -X6*X1
          SA6    A1
          SA1    NEW         CHECK *PFM* ERROR CODE
          AX1    10
          MX0    -8
          BX1    -X0*X1
          ZR     X1,DFT3     IF NO ERROR
          SA1    CATBUF      GET FILE NAME
          MX6    42
          BX1    X1*X6
          SB3    DFTA        * CANNOT ATTACH/GET FILE - FILE SKIPPED.*
          RJ     IMI         ISSUE MESSAGE INSERTING NAME
          RJ     ILC         INCREMENT LINE COUNT
 DFT2.1   WRITER TF,R
          BKSP   TF,R
          SX1    B1+         FLAG ERROR CONDITION
          EQ     DFTX        RETURN
 
 DFT3     SX7    DCW         INITIALIZE TAPE BLOCK CONTROL WORD
          SA7    BLOKHED
          SX5    NDMPWD      SET TAPE BLOCK FREE SPACE COUNTER
          READCW NEW,0,R     START READING PRU-S
          READO  NEW         GET FIRST PRU CONTROL WORD
          ZR     X1,DFT4     IF NOT IMMEDIATE EOI (SOMETHING IN FILE)
          SX6    DCW         DUMMY TAPE BLOCK CONTROL WORD
          SX1    3000B       EOI FLAG PLUS ZERO WORD COUNT
          BX6    X6+X1       CREATE EOI CONTROL WORD
          WRITEO TF          WRITE EOI TAPE BLOCK
          EQ     DFT11       JOIN WITH NON-EMPTY CASE
 
 DFT4     MX0    -24         WIDTH OF PRU-S BYTE COUNT FIELD
          SX3    5           BYTES IN A CYBER WORD
          BX2    -X0*X6      ISOLATE BYTE COUNT
          IX6    X2/X3       COMPUTE WORD COUNT OF PRU (B7 DESTROYED)
          SX7    X6-PRUSIZE  CHECK FOR A SHORT PRU
          SA6    DFTB        REMEMBER WORD COUNT
          SA7    DFTC        REMEMBER SHORT PRU FLAG
          ZR     X6,DFT5     IF WORD COUNT IS ZERO
          IX1    X6-X5       COMPUTE WORD COUNT - FREE SPACE
          NZ     X1,DFT6     IF WORD COUNT .NE. FREE SPACE
 
*         EITHER THE PRU-S WORD COUNT IS ZERO (EMPTY) OR THE PRU
*         WILL EXACTLY FILL THE FREE SPACE IN THE TAPE BLOCK.
 
 DFT5     COPYBLK  X6,X6,X7  COPYBLOCK( WC, WC, SHORTPRU )
          SA1    DFTC        GET SHORT PRU COUNT
          NZ     X1,DFT5.1  IF A SHORT PRU
          WRITEW TF,BLOKHED,1  WRITE BLOCK HEADER FOR PLAIN BLOCK
          SA4    BLOKHED
          MX0    -9
          BX4    -X0*X4      EXTRACT SIZE OF THE BLOCK
          WRITEW TF,WSA,X4   WRITE PLAIN BLOCK JUST FILLED
 DFT5.1   SX5    NDMPWD      RESET FREE SPACE COUNTER
          SX6    DCW
          SA6    BLOKHED     RESET HEADER WORD
          EQ     DFT9        JOIN WITH OTHER CASES
 
 DFT6     NG     X1,DFT7     IF PRU WORD COUNT .LT. FREE SPACE
          SX7    1           SET NOT FULL PRU FLAG
          SA7    NOPRU
 DFT6.1   COPYBLK  X5,X5,0   COPYBLOCK( FS, FS, FALSE )
          SX7    B0+         CLEAR NOT FULL PRU FLAG
          SA7    NOPRU
          WRITEW TF,BLOKHED,1  WRITE BLOCK HEADER FOR PLAIN BLOCK
          SA4    BLOKHED
          MX0    -9          WIDTH OF TAPE BLOCK WORD COUNT FIELD
          BX4    -X0*X4      EXTRACT SIZE OF THIS BLOCK
          WRITEW TF,WSA,X4   WRITE PLAIN BLOCK JUST FILLED
          SA1    DFTB        PREVIOUS WORD COUNT
          IX6    X1-X5       COMPUTE NEW WC = WC - FS
          SX7    NDMPWD      FREE SPACE FOR EMPTY TAPE BLOCK
          SA6    A1
          IX5    X7-X6       COMPUTE NEW FS = NDMPWD - NEW WC
          SX7    DCW         RESET TAPE BLOCK CONTROL WORD
          SA7    BLOKHED
          SA3    DFTC        CURRENT SHORT PRU FLAG
          COPYBLK  X6,NDMPWD,X3  COPYBLOCK( WC, NDMPWD, SHORTPRU )
          SA1    DFTC        SHORT PRU FLAG
          ZR     X1,DFT9     IF NOT A SHORT PRU
          SX5    NDMPWD      RESET FREE SPACE COUNTER
          EQ     DFT9        JOIN WITH OTHER CASES
 
*         PRU WILL FIT IN CURRENT FREE SPACE IN BLOCK.
 
 DFT7     COPYBLK  X6,X5,X7  COPYBLOCK( WC, FS, SHORTPRU )
          SA1    DFTC        SHORT PRU FLAG
          ZR     X1,DFT8     IF NOT A SHORT PRU
          SX5    NDMPWD      RESET FREE SPACE COUNTER
          EQ     DFT9        JOIN WITH OTHER CASES
 
 DFT8     SA2    DFTB        WORD COUNT OF THIS PRU
          IX5    X5-X2       COMPUTE NEW FS = FS - WC
 DFT9     READO  NEW         GET NEXT PRU HEADER WORD
          ZR     X1,DFT4     IF NOT EOI ON PERMANENT FILE
 DFT10    SA1    BLOKHED
          MX0    -9          ISOLATE SIZE OF PENDING TAPE BLOCK
          BX5    -X0*X1
          ZR     X5,DFT11    IF NOT A LEFTOVER BLOCK
          WRITEW TF,BLOKHED,1  WRITE LAST TAPE BLOCK
          WRITEW TF,WSA,X5
 DFT11    WRITER TF,R        FLUSH TAPE
          SA1    PFCNT       POINTER TO ENTRY IN PFTAB
          SX2    X1-1        DECREMENT COUNT
          NG     X2,DFT12    IF POINTER NOT SET
          SA1    PFTAB+X2    SET TO CORRECT ENTRY IN PFTAB
          LX1    58          SET TO FILE LOCAL FLAG
          PL     X1,DFT12    IF NOT LOCAL THEN UNLOAD FILE
          SA1    SCRFET      GET ORIGIONAL SCRATCH FILE NAME
          BX7    X1
          SA7    NEW         SET FILE NAME IN FET
          SX7    B0+
          SA7    NEW+8
          SA7    NEW+9
          SA7    DUMPLOC     CLEAR DUMPING LOCAL FILE FLAG
 DFT12    UNLOAD NEW,R
          SX1    B0+
          EQ     DFTX        RETURN
 
 
 DFTA     DATA   C* CANNOT ATTACH/GET FILE !!!!!!! - FILE SKIPPED.*
 DFTB     BSS    1           PRU WORD COUNT
 DFTC     BSS    1           FLAG FOR SHORT PRU/FULL PRU
 ICF      SPACE  4,20
***       ICF - INITIALIZE COPY FET.
*
*         INITIALIZES THE *FET* FOR *COPY* OPERATIONS.  CALLED
*         IMMEDIATELY AFTER CALLING *CRF* IF NOT A RESERVED FILE.
*
*         ENTRY  (X6) = LFN OF FILE TO WHICH COPY IS TO TAKE PLACE.
*                (X0) = 42 BIT MASK.
*
*         EXIT   (X0) UNCHANGED.
*                (X2) = FET ADDRESS.
*                LFN IS STORED IN FET, FILE IS UNLOADED IF
*                NEEDED, REWOUND AND PRESET FOR *WRITECW*.
*
*         USES   X - 1, 5, 6.
*                A - 1, 6.
*
*         MACROS RECALL, REWIND, UNLOAD, WRITECW.
 
 
 ICF      SUBR               ENTRY/EXIT
          BX5    X6          PRESERVE COPY LFN
          RECALL SF
          SA1    X2          STORE THE LFN IN THE COPY FET
          BX1    -X0*X1
          BX6    X5+X1
          SA6    A1
          SA1    RPV         REPLACE OPTION
          NZ     X1,ICF1     IF REPLACE OPTION SPECIFIED
          UNLOAD X2          UNLOAD IN CASE FILE IS DIRECT ACCESS
          EQ     ICF2        PRESET AND EXIT
 
 ICF1     SA1    RPCL        CHECK FOR COPY TO CURRENT LOCATION
          ZR     X1,ICF2     IF COPY TO CURRENT LOCATION SPECIFIED
          REWIND X2
 ICF2     WRITECW  X2,*      PRESET *WRITECW* FUNCTION
          EQ     ICFX        RETURN
 IMI      SPACE  4,20
**        IMI - ISSUE MESSAGE INSERTING NAME.
*
*         *IMI* ISSUES A MESSAGE AFTER INSERTING A NAME INTO IT.
*
*         ENTRY  (X1) = NAME TO BE INSERTED INTO MESSAGE.
*                (B3) = ADDRESS OF MESSAGE TO BE ISSUED.  MESSAGE MUST
*                       BE FORMATTED WITH *!* CHARACTERS WHERE THE NAME
*                       IS TO BE INSERTED, AND ONLY THERE.
*
*         EXIT   MESSAGE ISSUED TO DAYFILE AND OUTPUT.
*
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 2, 3, 5.
*
*         CALLS  SNM.
*
*         MACROS MESSAGE, WRITEC.
 
 IMI      SUBR               ENTRY/EXIT
          SB2    1R!
          SB5    -B3         INDICATE BUILD MESSAGE IN ASSEMBLY AREA
          SB3    IMIA
          RJ     SNM         SET NAME INTO MESSAGE
          MESSAGE  IMIA,3
          WRITEC O,IMIA
          SA1    LN          INCREMENT OUTPUT LINE COUNT
          SX6    X1+B1
          SA6    A1
          EQ     IMIX        RETURN
 
 
 IMIA     BSS    8           MESSAGE ASSEMBLY AREA
 ILC      SPACE  4,10
**        ILC - INCREMENT LINE COUNT.
*
*         ILC INCREMENTS THE LIST OUTPUT LINE COUNT.
*
*         EXIT   (X1) = OLD VALUE OF LINE COUNT.
*                (X6) = NEW VALUE OF LINE COUNT.
*                (LN) = NEW VALUE OF LINE COUNT.
*
*         USES   X - 1, 6.
*                A - 1, 6.
 
 
 ILC      SUBR               ENTRY/EXIT
          SA1    LN
          SX6    X1+B1
          SA6    A1
          EQ     ILCX        RETURN
 LCV      SPACE  4,25
**        LCV - LOCATE CURRENT VSN AND REQUEST DUMP INPUT TAPE.
*
*         LCV SEARCHES THE VSN INDEX RECORD TO FIND THE VSN OF THE
*                REEL WHICH CONTAINS THE PARTICULAR FILE TO BE LOADED,
*                THEN REQUESTS THAT REEL FOR PROCESSING.
*
*         ENTRY  (X1) = SET VSN/PFN(59-18) OF FILE TO LOCATE.
*                (X2) = FILE(17-12), RECORD(11-0) OF FILE TO LOCATE.
*                (X3) = TAPE FLAGS, RIGHT JUSTIFIED.
*                (CFC) = CURRENT FILE POSITION OF DUMP FILE.
*                            (ZERO IF FIRST FILE TO BE LOADED)
*                (CRC) = CURRENT RECORD POSITION WITHIN FILE.
*                            (IF (CFC).NE.0)
*
*         EXIT   (VSNCV) = CURRENT VSN/PFN OF DUMP FILE.
*                (VSNFR) = FILE/RECORD INDEX OF CURRENT VSN/PFN.
*                (CFC) = NEW FILE POSITION OF DUMP FILE.
*                (CRC) = NEW RECORD POSITION WITHIN FILE.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 6, 7.
*
*         CALLS  RNT.
*
*         MACROS READW, REWIND.
 
 LCV      SUBR               ENTRY/EXIT
          MX6    -18
          BX6    -X6*X2
          SA6    LCVB        SAVE FILE AND RECORD
          MX6    -12
          BX6    -X6*X3
          SA6    TF+TFLAGS   SAVE TAPE FLAGS
          LX6    59-11
          NG     X6,LCV6     IF NOT TAPE DUMP FILE
          MX0    6*6
          BX6    X0*X1
          SA6    LCVA        SAVE SEARCH VSN
 LCV1     SA1    LCVA
          LX1    7*6         RIGHT JUSTIFY SEARCH VSN
          SA2    DBE+DBXSV
          MX6    6*6
          BX2    X2*X6
          LX2    7*6         RIGHT JUSTIFY DATABASE SET VSN
          IX2    X1-X2
          LX1    3*6         RESTORE SEARCH VSN POSITION
          NG     X2,LCV5     IF DATABASE SET VSN IS HIGHER
          ZR     X2,LCV3     IF VSNS ARE EQUAL
 LCV2     READW  DB,DBE,DBEL READ NEXT DATABASE ENTRY
          NZ     X1,LCV4     IF NO MORE DATABASE ENTRIES
          EQ     LCV1        CONTINUE SEARCH
 
 LCV3     SA3    LCVB        SEARCH FILE AND RECORD
          SA2    DBE+DBXFR
          LX2    17-35
          MX0    -18
          BX7    -X0*X2      STARTING FILE AND RECORD THIS VSN
          IX2    X7-X3
          PL     X2,LCV5     IF SEARCH FILE STARTS ON PREVIOUS REEL
          SA7    VSNFR       SAVE STARTING FILE AND RECORD NUMBERS
          BX7    X1
          SA7    VSNSV       SAVE SET VSN
          BX7    X7-X7
          SA1    DBE+DBXCV
          SA7    LCVC        FLAG VSN IS IN VSN INDEX
          BX6    X1*X6
          SA6    VSNCV       SAVE VSN OF THIS REEL
          EQ     LCV2        READ NEXT DB ENTRY
 
 LCV4     MX6    6*6
          SA6    DBE+DBXSV   END OF DATABASE FLAG
          SA1    LCVA        RESTORE SEARCH VSN
 LCV5     SA2    VSNSV
          SA3    CFC
          BX2    X1-X2
          NZ     X2,LCV7     IF NOT SAME SET VSN
          ZR     X3,LCV5.2   IF INITIAL FILE LOAD
          SA2    LCVC
          BX2    X1-X2
          ZR     X2,LCV5.1   IF VSN IS NOT IN VSN INDEX
          SA1    VSNCV       DESIRED CURRENT VSN
          SA2    TF+CRVSN    PREVIOUS VSN
          BX2    X1-X2
          NZ     X2,LCV8     IF VSN CHANGE
 LCV5.1   SA2    CRC
          NG     X2,LCV5.2   IF AT END OF INFORMATION FOLLOWING DUMP
          LX3    12
          BX3    X2+X3       CURRENT FILE/RECORD POSITION
          SA2    LCVB        DESIRED FILE/RECORD POSITION
          IX2    X2-X3
          PL     X2,LCVX     IF RIGHT VSN POSITIONED CORRECTLY
 LCV5.2   SA1    TMSTAT      FORCE UNLOAD/RE-REQUEST IF TMS ACTIVE
          SA2    TF+TFLAGS
          LX2    59-11       MASS STORAGE DUMP FILE FLAG
          BX6    -X2*X1      ONLY FORCE UNLOAD FOR TAPES
          SA1    FTV
          ZR     X1,LCV5.3   IF NOT A NON-*TMS* TAPE
          SX6    B0+         NO FORCED UNLOAD FOR NON-*TMS* TAPES
 LCV5.3   SA6    UNLOAD
          EQ     LCV8        PROCESS THE REQUEST
 
 LCV6     SA2    TF+CFN      PREVIOUS FILE NAME
          MX6    7*6
          BX2    X1-X2
          BX2    X6*X2
          SA3    CFC
 LCV7     BX6    X1*X6
          SA6    VSNSV       SAVE SET VSN = SEARCH VSN
          SA6    VSNCV       SAVE TRUE VSN = SET VSN
          SA6    LCVC        FLAG VSN NOT IN VSN INDEX
          SX6    0           SAVE BEGINNING-OF-SET
          SA6    VSNFR
          ZR     X3,LCV8     IF INITIAL FILE LOAD
          ZR     X2,LCV5.1   IF DUMP IS CURRENT FILE
*
*         REQUEST NEW TAPE
*
 LCV8     SA1    VSNCV       GET VSN OF REEL CONTAINING FILE
          SX5    TF
          RJ     RNT         REQUEST NEW TAPE
          SA1    UNLOAD
          BX6    X6-X6       CLEAR THE FORCED UNLOAD FLAG
          SA6    A1
          NZ     X1,LCV8.1   IF UNLOAD/RE-REQUEST WAS FORCED
          REWIND TF,R
 LCV8.1   BREAK
          MX0    -12
          SA1    VSNFR
          NZ     X1,LCV9     IF NOT BEGINNING OF SET
          SX1    10001B      BEGINNING OF SET - USE FILE 1 RECORD 1
 LCV9     BX6    -X0*X1
          SA6    CRC         SET CURRENT RECORD NUMBER
          LX1    -12
          BX6    -X0*X1
          SA6    CFC         SET CURRENT FILE NUMBER
          EQ     LCVX        RETURN
 
 
 LCVA     BSS    1           TEMP FOR SEARCH VSN
 LCVB     BSS    1           TEMP FOR FILE AND RECORD NUMBER
 LCVC     BSS    1           VSN NOT FOUND IN VSN INDEX
 LEF      SPACE  4,10
**        LEF - LOCATE EXISTING TAPE FLAGS.
*
*         LEF SEARCHES THE VSN INDEX RECORD TO FIND A DESIRED SET VSN,
*                AND EXTRACTS THE EXISTING TAPE FLAGS FOR THAT VSN.
*
*         ENTRY  (X1) = SET VSN(59-18) TO LOCATE.
*                (X3) = MASS STORAGE DUMP INDICATOR.
*                DATABASE POSITIONED AT VSN INDEX RECORD.
*
*         EXIT   (X6) = 0, IF VSN NOT FOUND, OR NOT TAPE.
*                (X6) = EXISTING TAPE FLAGS FOR VSN.
*                DATABASE POSITIONED AT VSN INDEX RECORD.
*
*         USES   X - 0, 1, 5, 6.
*                A - 1, 5.
*
*         MACROS CLEAR, READ, READW.
 
 LEF4     CLEAR  DB
          SA1    VSNDX       REPOSITION DATABASE TO VSN INDEX
          MX6    -18
          BX6    -X6*X1
          SA6    DB+6
          READ   DB,R
          AX5    36
          BX6    X5
 
 LEF      SUBR               ENTRY/EXIT
          SX6    B0+         SET FLAGS FOR NOT TAPE DUMP
          NZ     X3,LEFX     IF NOT TAPE DUMP FILE
          MX0    6*6
          BX5    X0*X1
          LX5    7*6         RIGHT JUSTIFY SEARCH VSN
 LEF1     SA1    DBE+DBXSV
          BX1    X1*X0
          LX1    7*6         RIGHT JUSTIFY DATABASE SET VSN
          IX1    X5-X1
          ZR     X1,LEF3     IF VSNS ARE EQUAL
          NG     X1,LEF2     IF DATABASE SET VSN IS HIGHER
          READW  DB,DBE,DBEL READ NEXT DATABASE ENTRY
          ZR     X1,LEF1     IF MORE DATABASE ENTRIES
 LEF2     SX5    B0+
          EQ     LEF4        EXIT WITH NO TAPE FLAGS
 
 LEF3     SA5    DBE+DBFLG   GET WORD WITH TAPE FLAGS
          EQ     LEF4        EXIT WITH TAPE FLAGS
 LVI      SPACE  4,10
**        LVI - LOCATE VSN INDEX
*
*         LVI CALLS PDB TO POSITION THE DATABASE TO THE VSN INDEX
*                RECORD, IF THERE IS ONE.
*
*         ENTRY  (X5).LT.0, DEFINE DATABASE IF IT DOES NOT EXIST.
*                (X5).EQ.0, ABORT IF DATABASE DOES NOT EXIST.
*                (X5).GT.0, DEFINE AND BUILD DATABASE IF NECESSARY.
*                (X7) = READ/WRITE MODE FOR DATABASE ATTACH.
*
*         EXIT   DATABASE ATTACHED IN SPECIFIED MODE, POSITIONED TO VSN
*                INDEX IF ONE EXISTS.
*                (VSNSV) = 0.
*                (DBE+DBXSV) = 0 IF THERE IS A VSN INDEX.
*                (DBE+DBXSV) = 777777777777000000B IF NO VSN INDEX.
*                (X6) = (DBE+DBXSV).
*
*         USES   X - 1, 6.
*                A - 1, 6.
*
*         CALLS  PDB.
 
 LVI      SUBR               ENTRY/EXIT
          SA1    VSNDX       TAPE VSN INDEX IDENTIFIER
          RJ     PDB         POSITION DATABASE TO TAPE VSN INDEX
          SX6    B0+
          SA6    VSNSV       PRESET STARTING SAVED SET VSN
          PL     X5,LVI1     IF VSN INDEX WAS FOUND
          MX6    6*6
 LVI1     SA6    DBE+DBXSV   PRESET STARTING INDEX SET VSN
          EQ     LVIX        RETURN
 MFP      SPACE  4,15
**        MDL - MAKE DUMP FILE LOCAL.
*
*         MDL SETS UP THE DUMP FILE WHEN IT IS A
*         MASS STORAGE FILE.  IF THE FILE IS LOCAL
*         A REWIND IS DONE.  IF THE FILE IS NOT FOUND
*         AN ERROR MESSAGE IS ISSUED.
*
*         ENTRY  (X1) = DESIRED DUMP FILE NAME.
*                     = 0 IF UNLOAD WANTED.
*                (X5) = FILE FET ADDRESS.
*                (RING) = 0 IF NO WRITE IS SPECIFIED.
*                       = 1 IF WRITE IS REQUIRED.
*
*         EXIT   DUMP FILE IS LOCAL OR UNLOADED.
*                (X1) = 0 IF SAME FILE AS PREVIOUSLY ASSIGNED.
*                     = DUMP FILE NAME IF NOT THE SAME FILE.
*
*         USES   X - 0, 1, 2, 3, 6.
*                A - 1, 2, 3, 6.
*
*         MACROS ATTACH, FILINFO, GET, MESSAGE, REWIND, UNLOAD, WRITEC.
 
 
 MDL      SUBR
          BX6    X1          SAVE FILE NAME IN FET
          SA6    X5+CFPN
          MX0    6*6
          SA2    X5+TFETVSN  GET FET WORD WITH VSN
          SA3    X5+INITREQ  GET INITIAL REQUEST FLAG
          BX6    X6-X6
          BX2    X0*X2
          SA6    A3          CLEAR THE INITIAL REQUEST FLAG
          SA6    A2          CLEAR THE VSN WORD
          NZ     X3,MDL1     IF INITIAL REQUEST
          ZR     X2,MDL1     IF PREVIOUS FILE WAS MASS STORAGE
 DEBUG    IFC    NE,$DEBUG$"MODLEVEL"$,1
          UNLOAD X5,R        UNLOAD THE FILE
 MDL1     SA1    X5+CFPN
          ZR     X1,MDLX     IF REQUEST WAS FOR UNLOAD ONLY
          MX0    42
          BX6    X1*X0
          SA2    X5+CFN      GET CURRENT FILE NAME
          BX2    X0*X2
          BX2    X6-X2
          NZ     X2,MDL2     IF FILE NOT ALREADY PROCESSED
          SX1    B0+         INDICATE SAME FILE
          EQ     MDLX        RETURN
 
 MDL2     SA6    A2
          SA2    FIBK
          BX2    -X0*X2      LOWER 18 BITS
          BX6    X6+X2
          SA6    A2          FIRST WORD OF *FILINFO* BLOCK
          FILINFO  FIBK
          SA3    FIBSTA
          SA2    X5+TRING
          ZR     X2,MDL4     IF WRITE MODE NOT NEEDED (LIST/LOAD/COPY)
 
*         DOING A DUMP OR COMPACT WITH OVERWRITE.
 
          ZR     X3,MDL3     IF FILE IS NOT LOCAL
          AX3    7
          MX0    -2
          BX6    -X0*X3
          NZ     X6,MDL3     IF IN WRITE MODE
          MESSAGE  MDLA,3,R  * DUMP FILE MUST BE IN WRITE MODE *
          SA1    NFP         NUMBER OF FILES PROCESSED
          SX6    X1-1        DECREMENT COUNT
          SA6    A1
          WRITEC O,MDLA
          EQ     MAIN8       RETURN
 
 MDL3     SA1    X5+CFN      CURRENT FILE PROCESSED
          SA2    X5
          MX0    42
          BX2    -X0*X2
          BX6    X1+X2
          SA6    A2          SAVE FILE NAME IN FET
          EQ     MDL6        REWIND FILE AND RETURN
 
*         DOING A COPY FROM A DUMP FILE
 
 MDL4     NZ     X3,MDL3     IF FILE IS LOCAL
          SA2    X5+1        SET *SA* AND *EP* BITS IN FET
          SX6    4+1
          LX6    44
          BX6    X2+X6
          SA6    A2
          SX6    B0          CLEAR FET+7 THRU FET+16
          SA6    X5+7        FET+7
          SA6    A6+B1       FET+8
          SA6    A6+B1       FET+9
          SA6    A6+B1       FET+10
          SA6    A6+B1       FET+11
          SA6    A6+B1       FET+12
          SA6    A6+B1       FET+13
          SA6    A6+B1       GET+14
          SA6    A6+B1       FET+15
          SA6    A6+B1       FET+16
          SA2    X5+CFN      CURRENT DUMP FILE NAME
          MX0    42
          SA1    X5          FET+0
          BX1    -X0*X1      LOWER 18 BITS
          BX6    X2+X1
          SA6    A1          SET LOCAL FILE NAME IN FET
          SA1    A1+8        FET+8
          BX1    -X0*X1      LOWER 18 BITS
          BX6    X0*X6
          BX6    X6+X1
          SA6    A1
          ATTACH X5          TRY TO ATTACH THE FILE
          SA2    X5          FET ADDR
          SX1    X2
          AX1    8
          ZR     X1,MDL5     IF FILE ATTACHED
          MX0    9
          LX0    12
          BX6    -X0*X2      CLEAR ERROR CODE
          SA6    X5
          GET    X5          TRY AND GET THE FILE
          SA2    X5
          SX1    X2
          AX1    8
 MDL5     SA2    X5+1
          SX6    4+1         CLEAR *SA* AND *EP* BITS
          LX6    44
          BX6    -X6*X2
          SA6    A2+
          ZR     X1,MDL6     IF FILE NOW LOCAL
          MESSAGE  MDLB,3,R  * DUMP FILE NOT FOUND *
          EQ     MAIN8       RETURN
 
 MDL6     REWIND X5,R
          SA1    X5+CFPN     RESTORE FILE NAME
          EQ     MDLX        RETURN
 
 
 MDLA     DATA   C* DUMP FILE MUST BE IN WRITE MODE *
 MDLB     DATA   C* DUMP FILE NOT FOUND *
          SPACE  4,10
**        MFP - MAKE FILE PERMANENT.
*
*         ENTRY  (A5) = POINTER TO ENTRY CURRENTLY BEING PROCESSED.
*
*         EXIT   (X1) = 0 IF NORMAL EXIT
*                (X1) .NE. 0 IF ERROR IN PROCESSING.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*
*         MACROS DEFINE.
 
 
 MFP      SUBR               ENTRY/EXIT
          SA1    LOADFLG
          ZR     X1,MFPX     IF A COPY
          SA1    NNV         NEW NAME VARIABLE
          NZ     X1,MFP1     IF NEW NAME SET
          MX0    42
          SA1    A5+2        WORD 3 OF 6 WORD SORTED ENTRY
          BX6    -X0*X1      NEW NAME POINTER
          ZR     X6,MFP0     IF NO POINTER
          SA1    X6          NEW NAME ENTRY
          BX1    X0*X1
          EQ     MFP1        SAVE NAME
 
 MFP0     SA1    A5+B1
          BX1    X0*X1       LFN OF FILE BEING COPIED CURRENTLY
 MFP1     BX6    X1
          SA6    PFNAM
          SX1    B0          CLEAR FILE NAME FOR *MFP* EXIT CONDITION
          MX0    6           GET FILE CATEGORY
          SA3    WSA+1+FCCT
          BX6    X0*X3
          LX6    6
          SA6    PFCAT
          LX3    6           GET PERMISSION MODE
          BX3    X0*X3
          LX3    6
          SX6    X3
          SA6    PFPERM
          SA4    WSA+1+FCAP  EXTRACT ALTERNATE CATLIST FLAG
          LX4    59-46
          MX0    59
          BX4    -X0*X4
          SX6    ACNO
          ZR     X4,MFP1.0   IF NO ALTERNATE CATLIST
          SX6    ACYS        SET ALTERNATE CATLIST,FLAG
 MFP1.0   SA6    PFAC        SET ALTERNATE CATLIST WORD
          SA4    WSA+1+FCPW  EXTRACT AND SAVE PASSWORD
          MX0    42
          BX6    X0*X4
          SA6    PFPASS
          SA4    WSA+1+FCUC  USER CONTROL WORD
          BX6    X4
          SA6    PFUCW
          SA4    WSA+1+FCFS  SUBSYSTEM FLAG
          MX3    6
          LX4    59-53
          BX6    X3*X4
          LX6    6
          SA6    PFSS
 
*         CHECK IF REPLACE OPTION IS SET
 
          SA1    RPV         REPLACE VARIABLE
          ZR     X1,MFP1.1   IF NOT REPLACE
          SA1    PFNAM       PERMANENT FILE NAME
          BX6    X1
          SA6    SF+8        SET IN FET
          SA1    PFNAM       FILE BEING PROCESSED
          MX0    42
          BX6    X0*X1       SET FILE NAME IN FET
          SA2    SF          FET ADDRESS
          BX2    -X0*X2
          BX6    X6+X2
          SA6    A2
          UNLOAD SF,R        UNLOAD POSSIBLE LOCAL FILE OF SAME NAME
          SA1    SF+1        SET *SA* AND *EP* BITS
          SX6    4+1
          LX6    44
          BX6    X6+X1
          SA6    A1
          MX0    42
          SA1    LDFN        RESTORE SCRATCH FILE FOR LOADING
          SA2    SF          FET ADDR
          BX2    -X0*X2
          BX6    X0*X1
          BX6    X6+X2
          SA6    A2
          PURGE  SF          PURGE THE DATA FILE
          SA1    SF+1        CLEAR *SA* AND *EP* BITS
          SX0    4+1
          LX0    44
          BX6    -X0*X1
          SA6    A1
          SX1    B0          RESET  *MFP* EXIT CONDITION
 
*         CHECK IF THIS IS A DIRECT OR INDIRECT ACCESS FILE.
 
 MFP1.1   SA4    A5+B1       GET FILE TYPE WORD
          MX0    -6
          LX4    48
          BX4    -X0*X4      TYPE
          SX7    1RI
          BX3    X4-X7
          SA7    LOADFLG
          SA2    SF+1        CLEAR THE DEVICE TYPE IN FET+1
          MX0    12
          BX6    -X0*X2
          SA6    A2
          ZR     X3,MFPX     IF AN INDIRECT ACCESS FILE
          SX7    1RD
          SA7    A7
 MFP4     SA1    SF          CLEAR ANY PREVIOUS *PFM* ERROR CODE
          MX0    -8
          LX0    17-7
          BX6    X0*X1
          SA6    A1
          SX0    4+1         SET *SA* AND *EP* BITS IN FET
          SA1    A1+B1
          LX0    44
          BX6    X0+X1
          SA6    A1
          SX6    B0+         CLEAR FET+7 THROUGH FET+15
          SA6    SF+7
          SA6    A6+1        FET+8
          SA6    A6+1        FET+9
          SA6    A6+1        FET+10
          SA6    A6+B1       FET+11
          SA6    A6+B1       FET+12
          SA6    A6+B1       FET+13
          SA6    A6+B1       FET+14
          SA6    A6+B1       FET+15
          DEFINE SF,PFNAM,PFPASS,PFUCW,PFDT,PFCAT,PFPERM,,,,,,,,,PFAC
          SA2    SF+1        CLEAR *SA* AND *EP* BITS
          SX0    4+1
          LX0    44
          BX6    -X0*X2
          SA6    A2
          SA1    A2-B1       GET *PFM* ERROR CODE
          SX1    X1
          AX1    10          EXIT STATUS
          EQ     MFPX        RETURN
 PBC      SPACE  4,10
**        PBC -  PROCESS BREAK CONDITION.
*
*         ENTRY  INTERRUPTION HAS OCCURED.
*
*         EXIT   TO MAIN LOOP.
*
*         MACROS CLEAR.
 
 
 PBC      BSS    0           ENTRY
          CLEAR  O           CLEAR FET POINTERS
          EQ     MAIN8       RETURN TO MAIN LOOP
 PDB      SPACE  4,25
**        PDB - POSITION DATA BASE.
*
*         *PDB* POSITIONS THE DATABASE TO THE PRU ADDRESS
*         OF THE CALLING USER.
*
*         ENTRY  (X7) = MODE OF DATABASE ATTACH.
*                (X5) = USED ONLY IF THE USER DATABASE IS NOT
*                       PRESENT AND *TN* HAS BEEN USED.
*                       = -1 IF *DB* TO BE DEFINED ONLY.
*                       =  0 IF *RECLAIM* IS TO ABORT.
*                       =  1 IF *DB* TO BE DEFINED AND
*                            RECORDS INSERTED.
*                (X1) = USERNAME/ID TO BE LOCATED.
*                (A1) = ADDRESS OF USERNAME/ID WORD.
*
*         EXIT   (X5).LT.0 = VSN INDEX NOT FOUND IN DATA BASE.
*                (X5).GE.0 = PRU ADDRESS OF CURRENT USERNAME/ID.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 2.
*
*         CALLS  ADB, CDF, UPD.
*
*         MACROS BKSP, CLEAR, MESSAGE, READ, SKIPEI, WRITEC.
 
 
 PDB      SUBR               ENTRY/EXIT
          BX6    X1
          SA6    PDBC        SAVE USERNAME/ID
          SX6    A1
          SA6    PDBD        SAVE LOCATION OF USERNAME/ID
          SA7    PDBB        SAVE ATTACH MODE
          RJ     ADB         ATTACH DATABASE
          NG     X5,PDB0     IF NOT REBUILDING DATABASE
          ZR     X5,PDB0     IF NOT REBUILDING DATABASE
          RJ     CDF         CREATE DATABASE FILE
          SX6    B1          SET FLAG SO UPD WONT CALL LVI
          SA6    NLVIFLG
          SX5    B0+         FLAG ABORT IF DATABASE ATTACH FAILS
          RJ     UPD         UPDATE DATABASE
          SA1    PDBB        RETRIEVE ATTACH MODE
          SX7    X1
          SX5    B0+         FLAG ABORT IF BAD ATTACH
          RJ     ADB         ATTACH DATABASE FOR REAL
 PDB0     SX1    B1          SET RANDOM BIT OF DATABASE FET
          LX1    47
          SA2    DB+1
          BX6    X1+X2
          SA6    A2
 
*         DETERMINE USER-S POSITION ON DATABASE.
 
          CLEAR  DB
          BX5    X5-X5       IN CASE UN=0 SPECIFIED
          SA1    PDBC
          ZR     X1,PDB5     IF USER NAME NOT PART OF CRITERIA
          MX0    -18
          BX5    -X0*X1      EXTRACT USER RANDOM ADDRESS ON DATA BASE
          NZ     X5,PDB5     IF OPLD READ PREVIOUSLY
 
 PDB1     SKIPEI DB,R
          BKSP   DB,1,R
          READ   DB,R
          SA1    DB+3        (IN) = FWA OF OPLD
          SA2    DB+2        END OF OPLD
          IX0    X1-X2
          ZR     X0,PDBX     IF EMPTY READ THEN RETURN TO CALLER
          SA1    X1
          MX0    12
          BX0    X0*X1
          LX0    12
          SX0    X0-7700B
          NZ     X0,RDB6     IF NOT A 7700 TABLE DATABASE IS CORRUPTED
          SB2    X2
          AX1    36
          MX0    -12
          BX1    -X0*X1      LENGTH OF THE 7700 TABLE
          SX2    A1+2
          IX3    X2+X1       ADDRESS OF 7000 TABLE
          SA1    X3          GET FIRST WORD OF OPLD ADDRESSES
 PDB2     SA2    PDBC        USERNAME/ID REQUESTED
          MX0    42
          BX2    X0*X2
 
*         SEARCH OPLD FOR THIS USER NAME.
 
 PDB3     BX1    X0*X1       FIND USER NAME
          BX3    X1-X2
          ZR     X3,PDB4     IF USER FOUND
          SA1    A1+2
          SX3    A1-B2
          NG     X3,PDB3     IF NOT AT END OF OPLD
          SA1    DB
          MX2    -7
          LX2    2
          BX2    -X2*X1      GET *CIO* RESPONSE
          SX2    X2-20B      COMPARE WITH EOR
          ZR     X2,PDB5.5   IF EOR ENCOUNTERED
          CLEAR  DB
          READ   DB,R
          SA1    DB+3
          SA1    X1
          SA2    DB+2
          SB2    X2
          EQ     PDB2        CONTINUE SEARCH
 
 PDB4     SA3    A1+B1       GET THE ADDRESS
          BX5    -X0*X3
          BX6    X5+X2
          SA1    PDBD
          SA6    X1          ADDRESS OF USERNAME/ID WORD
 
*         PLACE RANDOM ADDRESS INTO FET.
 
 PDB5     BX6    X5
          SA6    DB+6
          CLEAR  DB
          READ   DB,R
          EQ     PDBX        RETURN
 
 PDB5.5   SA1    PDBC        USERNAME/ID REQUESTED
          BX1    X0*X1
          SA2    VSNR        VSN INDEX ID
          BX1    X1-X2
          NZ     X1,PDB6     IF NOT LOOKING FOR VSN INDEX
          MX5    59          FLAG IN X5 MEANS NO VSN INDEX
          EQ     PDBX        RETURN
 
 PDB6     SA1    TF+TTNV
          ZR     X1,PDB7     IF *TN* NOT SPECIFIED
          SX5    -1          NO USER RECORD FOUND
          EQ     PDBX        RETURN
 
 PDB7     MESSAGE  ERND,3    * NO DATA FOUND FOR USER NAME.*
          WRITEC O,ERND
          EQ     MAIN8       RETURN TO MAIN LOOP
 
 
 PDBB     DATA   0           DATABASE ATTACH MODE
 PDBC     DATA   0           SEARCH USERNAME/ID
 PDBD     DATA   0           SEARCH USERNAME/ID WORD LOCATION
 PDF      SPACE  4,20
**        PDF - POSITION DUMP FILE.
*
*         PDF POSITIONS THE DUMP FILE TO THE FILE AND RECORD REQUIRED.
*         USED IN *COPY*, *LOAD*, AND *COMPACT* DIRECTIVE PROCESSING.
*
*         ENTRY  (X5) = REQUIRED DUMP FILE NUMBER (BITS 17-12),
*                       REQUIRED DUMP RECORD NUMBER (BITS 11-0).
*                (CFC) = CURRENT DUMP TAPE FILE NUMBER.
*                (CRC) = CURRENT DUMP TAPE RECORD NUMBER.
*
*         EXIT   (X5) .GE. 0 - DUMP FILE IS POSITIONED AT THE REQUESTED
*                            RECORD OF THE REQUESTED FILE.
*                (X5) .LT. 0 - DUMP FILE MALFUNCTION (POSITION LOST OR
*                            EOI ENCOUNTERED) OCCURRED - ERROR MESSAGE
*                            HAS BEEN ISSUED TO DAYFILE.
*                (CFC) = UPDATED FILE NUMBER.
*                (CRC) = UPDATED RECORD NUMBER.
*
*         USES   X - 0, 1, 2, 5, 6.
*                A - 1, 2, 5, 6.
*
*         CALLS  UFV.
*
*         MACROS BREAK, MESSAGE, SKIPF.
 
 
 PDF      SUBR               ENTRY/EXIT
          BX6    X5          PRESERVE REQUESTED FILE/RECORD
          SA6    PDFA
 PDF1     SA5    PDFA
          MX0    -18
          BX0    -X0*X5
          SA1    CFC
          AX0    12
          IX1    X0-X1
          ZR     X1,PDF6     IF REQUESTED FILE FOUND
          SX2    ERPL        * DUMP FILE MALFUNCTION - POSITION LOST.*
          NG     X1,PDF7     IF ALREADY PAST REQUESTED POINT
 PDF2     SKIPF  TF,1,R      SKIP ONE RECORD AT A TIME
          SA1    TF
          SX2    EREI        * DUMP FILE MALFUNC - EOI ENCOUNTERED.*
          LX1    59-9
          NG     X1,PDF7     IF PREMATURE EOI
          AX1    59-9
          SX0    X1-273B
          SA1    CRC         RECORD COUNT
          PL     X0,PDF3     IF END OF FILE ENCOUNTERED
          ZR     X1,PDF3     IF AT A PSEUDO FILE POINT
          MX0    -12
          SX6    X1+B1       INCREMENT RECORD NUMBER
          BX6    -X0*X6      RECORD NUMBER MODULO 4096
          SA6    A1
          ZR     X6,PDF4     IF AT A POSSIBLE PSEUDO FILE POINT
          EQ     PDF2        SKIP NEXT RECORD
 
 PDF3     SX6    B1          RESET THE RECORD COUNT
          SA6    A1
          ZR     X1,PDF5     IF FILE NUMBER ALREADY ADVANCED
 PDF4     SA2    CFC         FILE COUNT
          SX6    X2+B1       INCREMENT FILE COUNT
          SA6    A2
 PDF5     SX5    TF
          RJ     UFV         UPDATE FET VSN
          BREAK
          EQ     PDF1        CHECK IF DESIRED FILE FOUND
 
 PDF6     MX0    -12
          BX0    -X0*X5
          SA5    CRC
          IX5    X0-X5
          ZR     X5,PDFX     IF ALREADY AT DESIRED RECORD
          BX6    X0          SET CRC TO RECORD NUMBER AFTER SKIP
          SA6    A5
          SKIPF  TF,X5,R
          SX5    TF
          RJ     UFV         UPDATE FET VSN
          SA5    TF
          LX5    59-9
          PL     X5,PDFX     IF NOT EOI
          SX2    EREI        * DUMP FILE MALFUNC - EOI ENCOUNTERED.*
 PDF7     MESSAGE  X2,3,R    ISSUE APPROPRIATE ERROR MESSAGE
          SX5    -1
          EQ     PDFX        RETURN WITH ERROR INDICATION
 
 
 PDFA     BSS    1           REQUESTED FILE/RECORD NUMBER
 PFN      SPACE  4,15
**        PFN - PROCESS FILE NAMES.
*
*         ENTRY  *PFV* CONTAINS PF PARAMETER VALUE.
*
*         EXIT   *PFTAB* UPDATED IF PF=*.
*
*         ERROR  TO *ABT* IF FILE NAME ERROR ON NON-INTERACTIVE JOB.
*
*         USES   X - 0, 1, 2, 5, 6.
*                A - 1, 2, 5, 6.
*                B - 2.
*
*         CALLS  POP, USB.
*
*         MACROS MESSAGE, READ, READC, WRITEC, WRITEW.
 
 
 PFN      SUBR               ENTRY/EXIT
          SA1    PFV         CHECK FOR MULTIPLE FILES OPTION
          LX1    6
          SX1    X1-1R*
          NZ     X1,PFNX     IF NOT PF=*
          SA5    PFTAB
          SX0    B0+
          SA1    CCIN
          NZ     X1,PFN2     IF CALLED WITH *Z* OPTION
          SA1    IDT
          SX0    B0+
          NZ     X1,PFN2     IF NOT TERMINAL INPUT
          WRITEC O,PFNC      * ENTER FILE NAMES.*
 PFN1     READ   I,R
 PFN2     READC  I,LINE,9
          NZ     X1,PFN5     IF END-OF-RECORD FOUND
          SA1    ODT
          ZR     X1,PFN2.1   IF OUTPUT FILE IS A TERMINAL FILE
          WRITEW O,BLANKS,1  MOVE LINE OVER
          WRITEC O,LINE,9    COPY LINE OF FILE NAMES TO LISTING
 PFN2.1   SB2    LINE
          RJ     USB
          SX6    B7+B1
          SA6    A6
          SX6    1R.
          SA6    B7+B1
 
*         GET NEXT FILE NAME.
 
 PFN3     RJ     POP
          NG     B5,PFN8     IF AN ERROR FROM *POP*
          SX5    X0-PFTABL
          ZR     X5,PFN7     IF TOO MANY FILES
          SX5    X1-1R,
          ZR     X5,PFN4     IF SEPARATOR IS A COMMA
          ZR     X6,PFN6     IF COMMA AT END OF LINE
          SX5    X1-1R=      IF FILE SUBSTITUTION
          ZR     X5,PFN3.5
          SA6    A5
          SX6    B0+
          SA6    A6+B1
          SA6    NNTAB+X0    CLEAR *NNTAB* ENTRY
          EQ     PFNX        RETURN
 
 PFN3.5   SA6    NNTAB+X0    SAVE NEW FILE NAME
          RJ     POP         GET THE NEW FILE NAME
          ZR     X6,PFN8     IF NO NEW FILE NAME
          SA6    A5          SAVE OLD FILE NAME
          SA5    A5+B1       NEXT *PFTAB* ADDRESS
          SX0    X0+1        INCREMENT COUNTER
          SX5    X1-1R,
          ZR     X5,PFN3     IF COMMA
          SX6    B0          SET END OF TABLE
          SA6    A5
          SA6    NNTAB+X0    CLEAR *NNTAB* ENTRY
          EQ     PFNX        RETURN
 
 PFN4     SA6    A5
          SA5    A5+B1
          SX6    B0+         CLEAR *NNTAB* ENTRY
          SA6    NNTAB+X0
          SX0    X0+1
          EQ     PFN3        GET NEXT FILE NAME
 
*         EOR FOUND ON INPUT.
 
 PFN5     NZ     X0,PFNX     IF SOME FILES ENTERED
          SX6    B0+
          SA6    PFV         CLEAR PF=* FOR THIS DIRECTIVE
          EQ     PFNX        RETURN
 
*         COMMA AT END OF LINE.
 
 PFN6     SA1    IDT         CHECK FOR TERMINAL INPUT
          SA2    CCIN        *Z* INPUT FLAG
          IX1    X1+X2       TERMINAL INPUT .OR. *Z* INPUT
          ZR     X1,PFN1     IF A TERMINAL
          EQ     PFN2        NOT A TERMINAL
 
*         TOO MANY FILES ENTERED.
 
 PFN7     MESSAGE  PFNA,3    * TOO MANY FILE NAMES IN LIST.*
          WRITEC O,PFNA
          SA1    IDT
          SA2    CCIN        *Z* INPUT FLAG
          IX1    X1+X2       TERMINAL INPUT .OR. *Z* INPUT
          ZR     X1,MAIN8    IF A TERMINAL THEN REPROMPT
          RJ     ABT         ABORT *RECLAIM*
 
*         ERROR WHILE CRACKING FILE LIST.
 
 PFN8     MESSAGE  PFNB,3    * ERROR IN FILE NAME LIST.*
          WRITEC O,PFNB
          SA1    IDT
          SA2    CCIN        *Z* INPUT FLAG
          IX1    X1+X2       TERMINAL INPUT .OR. *Z* INPUT
          ZR     X1,MAIN8    IF A TERMINAL THEN REPROMPT
          RJ     ABT         ABORT *RECLAIM*
 
 
 PFNA     DATA   C* TOO MANY FILE NAMES IN LIST.*
 PFNB     DATA   C* ERROR IN FILE NAME LIST.*
 PFNC     DATA   C* ENTER FILE NAMES.*
 POT      SPACE  4,20
**        POT - PROCESS OUTPUT.
*
*         *POT* FORMATS THE DATA BASE ENTRY *DBE* EITHER INTO A
*         6 OR 8 WORD OUTPUT LINE DEPENDING UPON THE CALLING
*         USERS ACCESS PRIVILEGES.  IN ADDITION, IT PRINTS THE
*         APPROPRIATE HEADINGS.
*
*         ENTRY  (A0) = STARTING ADDRESS OF 4 WORD RECORD.
*
*         EXIT   FORMATTED OUTPUT LINE.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 5, 6.
*                B - 2.
*
*         CALLS  CDD, CFJ, PRH, ZTB.
*
*         MACROS BREAK, WRITEC.
 
 
 POT      SUBR               ENTRY/EXIT
 
*         IF HEADER NOT REQUIRED SKIP IT.
 
          SA5    NHV         HEADER OPTION VARIABLE
          NZ     X5,POT2     IF HEADER NOT WANTED
          SA5    ODT
          RJ     ILC         INCREMENT LINE COUNT
          ZR     X1,POT1     IF FIRST TIME THROUGH
          ZR     X5,POT2     IF TERMINAL OUTPUT ASSIGNED
          SA2    MLPP        MAXIMUM LINES PER PAGE
          IX2    X6-X2
          NG     X2,POT2     IF LINE COUNT NOT EXCEEDED
 POT1     RJ     PRH         PROCESS HEADER
 POT2     MX0    42
 
*         EXTRACT LAST MODIFICATION DATE.
 
          SA5    A0+DBLMO
          BX1    -X0*X5
          RJ     CFJ         CONVERT BINARY JULIAN DATE TO DISPLAY
          SA6    OLINE+LLMO
 
*         DUMP DATE.
 
          MX0    42
          SA5    A0+DBDDT    DUMP DATE
          BX1    -X0*X5
          RJ     CFJ         CONVERT BINARY JULIAN DATE TO DISPLAY
          SA6    OLINE+LDDT
 
*         PERMANENT FILE NAME.
 
          MX0    42D
          SA1    A0+DBPFN
          BX1    X0*X1
          BX6    X1
          SA6    BMSG+1      PUT FILE NAME INTO B-DISPLAY MESSAGE
          RJ     ZTB         CONVERT BINARY ZEROES TO BLANKS
          LX6    54D
          MX0    54D
          BX6    X0*X6
          SA1    A0+DBFTY
          LX1    12
          BX1    -X0*X1
          BX6    X1+X6
          SA6    OLINE+LPFN
 
*         PF LENGTH.
 
          SA5    A0+DBLEN
          MX0    -18         GET LOWER 18 BITS OF FILE SIZE
          BX1    -X0*X5
          MX0    5           GET UPPER 5 BITS OF FILE SIZE
          LX0    -1
          BX0    X0*X5
          LX0    24          ALIGN UPPER 5 WITH LOWER 18 BITS
          BX1    X1+X0       MERGE UPPER 5 WITH LOWER 18 BITS
          RJ     CDD         CONVERT BINARY CONSTANT TO DISPLAY
          LX6    18
          SA6    OLINE+LLEN
          BX6    X6-X6
          SA1    ACCESS
          SA2    USERDB
          BX1    X1+X2
          ZR     X1,POT6     IF NOT PRIVILEGED OR USER DATABASE
 
*         EXTRACT RECORD/FILE NUMBERS.
 
          MX0    -12
          LX5    42
          BX1    -X0*X5
          RJ     CDD         CONVERT TO DISPLAY CODE
          LX6    36
          BX6    X0*X6
          SA6    OLINE+LRNO
 
*         USER NAME.
 
          MX0    42
          SA1    A0+DBUNM
          BX1    X0*X1
          RJ     ZTB         CONVERT BINARY ZEROES TO BLANKS
          SA6    OLINE+LUNM
 
*         TAPE NUMBER.
 
          MX4    -6
          LX5    48
          BX1    -X4*X5
          RJ     CDD
          BX5    X6
          SA1    A0+DBTNO
          MX0    42
          SA2    A0+DBFLG    WORD WITH TAPE FLAGS
          LX2    59-47
          NG     X2,POT3     IF PERMANENT FILE FLAG SET
          MX0    36          SET MASK FOR TAPE VSN
 POT3     BX1    X0*X1
          RJ     ZTB         CONVERT BINARY ZEROES TO BLANKS
          BX6    X0*X6
          BX5    -X0*X5      FILE NUMBER
          BX6    X5+X6
 
*         APPEND TERMINATOR.
 
 POT6     SA6    OLINE+LTNO
          WRITEC O,OLINE
          SA1    BMSG        CHECK FOR VERB IN B-DISPLAY MESSAGE
          ZR     X1,POT7     IF NO VERB
          MESSAGE  BMSG,2,R  TELL WHAT IS BEING DONE IN B-DISPLAY
 POT7     SA1    NOBREAK     CHECK IF BREAKS ARE IGNORED
          NZ     X1,POTX     IF BREAKS TURNED OFF THEN RETURN
          BREAK
          EQ     POTX        RETURN
 PPB      SPACE  4,15
**        PPB - PROCESS PERMIT BLOCK.
*
*         CHANGE FILE TO SEMI-PRIVATE, RESTORE PERMITS,
*         THEN CHANGE BACK TO ORIGINAL CATEGORY.
*
*         ENTRY  NONE.
*
*         EXIT   FILE HAS PERMISSIONS RESTORED.
*
*         USES   X - 0, 1, 2, 5, 6.
*                A - 1, 2, 6.
*                B - 3.
*
*         MACROS CHANGE, PERMIT.
 
 
 PPB      SUBR               ENTRY/EXIT
          MX0    42
          SA2    CTFPLWA
          SX6    X2-PRMITB
          ZR     X6,PPBX     IF NO PERMITS ON FILE
          CHANGE SF,,,,,S    MAKE FILE SEMI-PRIVATE
          MX5    -3
          SB3    PRMITB
 PPB1     SA1    B3
          SB3    B3+NWPE
          BX6    X0*X1
          SA6    PFUSER      USER NAME FOR THE PERMISSION
          SA2    A1+1
          LX2    19
          NG     X2,PPB2     IF AN ACCOUNTING PERMIT
          LX2    5
          ZR     X6,PPB2     IF NO USER NAME SKIP THIS PERMIT
          BX6    -X5*X2
          SA6    PFPERM      THE PERMISSION GRANTED
          PERMIT SF,PFNAM,PFUSER,PFPERM
 PPB2     SA2    CTFPLWA
          SX6    B3
          IX6    X2-X6
          ZR     X6,PPB3     IF END OF PERMITS
          PL     X6,PPB1     IF NOT END OF PERMITS
 PPB3     SX6    B0+         CLEAR USER NAME FROM FET
          SA6    SF+CFOU
          SA1    PFCAT       RESTORE CATEGORY
          SX6    X1+40B      ENSURE CATEGORY IS UPDATED
          SA6    PPBA
          CHANGE SF,,,,,PPBA
          EQ     PPBX        RETURN
 
 
 PPBA     BSS    1           CATEGORY TYPE + 40B (FOR *CHANGE*)
 PPF      SPACE  4,20
**        PPF - PROCESS PERMANENT FILES.
*
*         ENTRY  NONE.
*
*         EXIT   PFTAB CONTAINS THE LIST OF PERMANENT
*                FILES TO BE PROCESSED.
*
*         USES   X - 1, 2, 3, 6.
*                A - 1, 2, 3, 6.
*
*         CALLS  PFN.
*
*         MACROS FILINFO.
 
 
 PPF4     RJ     PFN         PROCESS FILE NAMES
 
 PPF5     SX6    B0+         CLEAR POINTER
          SA6    PFCNT
 
 PPF      SUBR               ENTRY/EXIT
          SX6    B1+
          SA6    PPFLAG      SET PPF CALLED FLAG
          SA1    PFV         PERMANENT FILE VARIABLE
          ZR     X1,PPF1     IF NO PERMANENT FILES
          BX6    X1
          LX1    6
          SX1    X1-1R*
          ZR     X1,PPF4     IF PF=*
          SA6    PFTAB       SET FILE NAME
          BX6    X6-X6
          SA6    A6+B1       SET TERMINATOR WORD IN PFTAB
          EQ     PPF5        RETURN
 
 PPF1     SA1    FNV
          BX6    X1
          LX1    6
          SX1    X1-1R*
          ZR     X1,PPF2     IF  FN=*
          SA6    PFTAB       SET FILE NAME
          BX6    X6-X6
          SA6    A6+B1       SET TERMINATOR WORD IN PFTAB
          EQ     PPF3        SEE IF FILE LOCAL
 
 PPF2     SA6    PFV         SET PF=*
          RJ     PFN         PROCESS FILE NAMES
 PPF3     SA1    PFCNT
          SA2    PFTAB+X1    PFTAB(PFCNT)
          ZR     X2,PPF5     IF END OF TABLE
 
*         CHECK TO SEE IF THIS FILE IS LOCAL.
 
          SA3    FIBK        FIRST WORD OF *FILINFO* BLOCK
          MX1    42
          BX3    -X1*X3
          BX6    X2+X3
          SA6    FIBK
          FILINFO  FIBK
          SA3    FIBSTA
          SA1    PFCNT
          SX6    X1+B1       INCREMENT COUNTER
          SA6    A1
          ZR     X3,PPF3     IF FILE NOT LOCAL
          SA2    PFTAB+X1    CURRENT FILE IN TABLE
          SX6    B1
          LX6    1
          BX6    X6+X2       SET LOCAL FILE FLAG
          SA6    A2          SAVE IN PFTAB
          EQ     PPF3        GET NEXT ENTRY
 PRH      SPACE  4,15
**        PRH - PRINT HEADER.
*
*         ENTRY  (X5) = 0 IF OUTPUT ASSIGNED TO TERMINAL.
*
*         EXIT   OUTPUT HEADER PRINTED AND RESET PAGE/LINE COUNT.
*
*         USES   X - 0, 1, 2, 3, 4, 6.
*                A - 1, 2, 3, 6.
*
*         CALLS  CDD, ZTB.
*
*         MACROS WRITEC, WRITEW.
 
 
 PRH      SUBR               ENTRY/EXIT
 
*         RESET LINE COUNT.
 
          SX6    4
          SA6    LN
          SA1    PG
          NZ     X1,PRH2     IF NOT FIRST TIME THRU
 
*         USER NAME TO HEADER.
 
          SA1    UNV
          NZ     X1,PRH1     IF USER NAME SET
          SX1    33B
          LX1    -6
 PRH1     MX0    42
          BX1    X0*X1
          LX1    42
          SA2    USER
          MX4    18
          BX2    X4*X2
          BX1    X1+X2
          RJ     ZTB         ZEROES TO BLANKS
          SA6    A2
 
*         OPTION SELECTED TO HEADER.
 
          SA1    COPTION
          BX1    X0*X1
          RJ     ZTB         ZEROES TO BLANKS
          SA6    OPTION
 PRH2     ZR     X5,PRH3     IF OUTPUT ASSIGNED TO TERMINAL
 
*         INCREMENT PAGE COUNT.
 
          SA1    PG          ADVANCE TO NEXT PAGE
          SX1    X1+B1
          BX6    X1
          SA6    A1
          RJ     CDD         CONVERT TO DECIMAL
          BX6    X0*X4       ADD LINE TERMINATOR
          SA6    PAGE
          WRITEC O,HEAD1
 PRH3     SA3    HLENGTH
          WRITEW O,HEADER,X3
          WRITEC O,HEADER1   BLANK LINE
          EQ     PRHX        RETURN
 PVZ      SPACE  4,15
**        PVZ - PAD VSN WITH CHARACTER *0*.
*
*         ENTRY  (X6) = LEFT JUSTIFIED UNPADDED VSN.
*
*         EXIT   (X6) = PADDED VSN.  CHARACTER *0* INSERTED
*                       BEFORE FIRST NUMERIC CHARACTER UNTIL
*                       VSN IS SIX CHARACTERS LONG.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 3.
*                B - 2, 3.
 
 
 PVZ      SUBR               ENTRY/EXIT
          SA3    =1L
          MX0    6           GET LENGTH OF UNPADDED VSN
          BX2    X6
          SX4    B0
 PVZ1     BX1    X0*X6       CHECK FOR CHARACTER
          BX7    X1-X3
          ZR     X7,PVZ2     IF CHARACTER IS A BLANK
          ZR     X1,PVZ2     IF END OF CHARACTERS
          SX4    X4+B1
          LX6    6
          EQ     PVZ1        CONTINUE
 
 PVZ2     ZR     X4,PVZX     IF NO CHARACTERS, RETURN
          SX1    6           GET CORRECT NUMBER OF ZEROS
          IX4    X1*X4
          SB2    X4
          SB3    B2-6        SET UP MASK
          AX0    B3,X0
          BX2    X0*X2
          SA1    =36R000000
          AX1    B2
          SB3    60
          MX0    -6
          SX6    B0
 PVZ3     BX7    X2          SAVE END OF VSN
          LX2    6           CHECK CHARACTER
          BX3    -X0*X2
          ZR     X3,PVZ4     IF END OF CHARACTERS
          SX4    X3-1R0
          PL     X4,PVZ4     IF NUMERIC CHARACTER
          LX6    6           BUILD FIRST PART OF VSN
          BX6    X6+X3
          BX2    X0*X2
          SB3    B3-6
          EQ     PVZ3        CHECK NEXT CHARACTER
 
 PVZ4     SB2    B2-36       ADD ZEROS TO VSN
          AX6    B2
          BX6    X6+X1
          BX6    X6+X7       ADD END OF VSN
          SB3    B3+B2
          LX6    B3
          EQ     PVZX        RETURN
 RDB      SPACE  4,20
**        RDB - READ DATABASE.
*
*         *RDB* POSITIONS THE DATABASE TO THE NEXT ENTRY WHICH
*         MEETS THE SPECIFIED USER CRITERIA.
*
*         ENTRY  NONE.
*
*         EXIT   (X1) = 0 IF ALL CRITERIA MET.
*
*         ERROR  TO *ABT* IF DATABASE FILE IS CORRUPTED.
*
*         USES   X - 0, 1, 2, 6.
*                A - 0, 1, 2, 6.
*                B - 5.
*
*         CALLS  CRI.
*
*         MACROS BREAK, MESSAGE, READ, READW, UNLOAD, WRITEC.
 
 
 RDB8     SX1    B1+
 
 RDB      SUBR               ENTRY/EXIT
          SX6    B0+         CLEAR SAVE AREA FOR CRITERIA MATCH
          SA6    RDBA
          SA6    LAD
 RDB1     READW  DB,DBE,DBEL
 
*         CHECK FOR EOR/EOF/EOI.
 
          ZR     X1,RDB2     IF SUCCESSFUL READ
          SA2    PDBC
          NG     X1,RDBX     IF EOF/EOI ENCOUNTERED
          NZ     X2,RDBX     IF SCANNING ONLY ONE USER NAME
          SX2    X1-DBE
          NZ     X2,RDB6     IF DATABASE CORRUPTED
          READ   DB,R
          SX6    B1
          SA6    RDBA
 
*         CHECK FOR OPLD ON DATABASE.
 
          SA1    DB+3
          SA1    X1
          SA2    OPLDH
          BX2    X1-X2
          ZR     X2,RDBX     IF OPLD ENCOUNTERED
          SA2    VSNR
          BX2    X1-X2
          ZR     X2,RDBX     IF VSN INDEX ENCOUNTERED
          EQ     RDB1        READ NEXT ENTRY
 
 RDB2     BREAK
          SA0    DBE
          SA1    A0+DBUNM    INSURE ZERO FILL IN USER NAME WORD
          MX0    42
          BX6    X0*X1
          SA6    A1+
          RJ     CRI         CHECK CRITERIA
          NZ     X5,RDB1     IF RECORD DOES NOT MEET CRITERIA
          SA2    PFV
          LX2    6
          SX2    X2-1R*
          NZ     X2,RDB4     IF NOT PF=*
          SA1    EXV
          NZ     X1,RDB4     IF EXCEPTION PROCESSING
          SA2    PFTAB-1
          MX0    42
          SA1    DBE+DBPFN
          BX1    X0*X1
 RDB3     SA2    A2+B1
          BX6    X0*X2
          BX6    X1-X6
          NZ     X6,RDB3     IF NOT CORRECT FILE
          BX1    -X0*X2
          SA2    NFP
          SX6    X2+1
          IX2    X6-X1
          SA1    NFV
          IX1    X1-X2
          SX1    X1-1
          NG     X1,RDB1     IF FILE LIMIT EXCEEDED FOR FILE
          EQ     RDB5
 
*         CHECK FOR FILE LIMIT/INCREMENT FILE COUNT.
 
 RDB4     SA1    NFV
          SA2    NFP
          SX6    X2+1
          IX2    X1-X6
          NG     X2,RDB8     IF FILE LIMIT EXCEEDED
 RDB5     SA6    A2
          BX1    X1-X1       EXIT STATUS
          SA2    RDBA
          SB5    X2
          EQ     RDBX        RETURN
 
*         PROCESS DATABASE ERROR.
 
 RDB6     UNLOAD DB
          MESSAGE  RDBB,3    * DATABASE CORRUPTED.*
          WRITEC O,RDBB
          EQ     ABT         ABORT *RECLAIM*
 
 
 RDBA     BSSZ   1
 RDBB     DATA   C* DATABASE CORRUPTED.*
 RDU      SPACE  4,15
**        RDU - READ *UPDATES* FILE.
*
*         ENTRY  A READ HAS BEEN PERFORMED ON THE *UPDATES*.
*
*         EXIT   IF (X1) = 0 NEXT RECORD WITH SAME FAMILY IN *UPE*.
*                IF (X1) .NE. 0 RECORD IS NOT UPDATED.
*
*         USES   X - 2, 3.
*                A - 2, 3.
*
*         MACROS READW.
 
 
 RDU      SUBR               ENTRY/EXIT
 RDU1     READW  UPDATES,UPE,UDBEL
          NZ     X1,RDUX     IF EOR/EOF/EOI ENCOUNTERED
          SA2    UPE         CLEAR LAST 18 BITS
          MX0    42
          BX6    X0*X2
          SA6    A2
          SA2    FAMILY
          SA3    UPE+UDBFAM
          ZR     X3,RDUX     IF NO FAMILY NAME - ASSUME FAMILY CORRECT
          BX2    X2-X3
          NZ     X2,RDU1     IF FAMILY NOT THE CURRENT FAMILY
          EQ     RDUX        RETURN
 RNT      SPACE  4,25
**        RNT - REQUEST NEW TAPE.
*
*         *RNT* REQUESTS TAPES ONLY WHEN NECESSARY.  *RNT* CHECKS
*         THE CURRENT VSN IN WORD 9 OF THE GIVEN FET ADDRESS AGAINST
*         THE DESIRED VSN IN X1.  IF THEY ARE DIFFERENT IT CLEANS
*         UP THE FET AND REQUESTS THE NEW TAPE.  IF THE GIVEN VSN
*         IS NULL (BINARY ZERO), *RNT* ONLY UNLOADS THE TAPE.
*
*         ENTRY  (X1) = DESIRED TAPE VSN.
*                (X1) = 0 IF ONLY UNLOAD NEEDED.
*                (X5) = TAPE FET ADDRESS.
*                ((X5)+TFLAGS) = TAPE REQUEST FLAGS.  ZERO IF NONE.
*                ((X5)+TRING) = 1 IF TAPE MUST HAVE A WRITE RING.
*                             = 0 IF WRITE RING IS NOT NECESSARY.
*
*         EXIT   TAPE ASSIGNED OR UNLOADED.
*                (X1) = 0 IF CORRECT TAPE WAS ALREADY ASSIGNED.
*                (X1) .NE. 0 IF REQUEST CAUSED CHANGE IN ASSIGNMENT.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 5, 6.
*
*         CALLS  BTF.
*
*         MACROS BREAK, FILINFO, LABEL, REWIND, UNLOAD.
 
 
 RNT      SUBR               ENTRY/EXIT
          SA2    X5+TFLAGS   TAPE FLAGS
          LX2    59-11
          PL     X2,RNT1     IF DUMP FILE IS TAPE
          RJ     MDL         PROCESS MASS STORAGE DUMP FILE
          EQ     RNTX        RETURN
 
 RNT1     SA2    X5+TFETVSN  GET FET WORD WITH VSN
          MX6    6*6
          SA4    UNLOAD      UNLOAD/RE-REQUEST FLAG
          BX3    X1-X2       COMPARE VSN-S
          BX3    X6*X3       REMOVE STUFF AT BOTTOM
          NZ     X3,RNT2     IF VSN-S DO NOT MATCH
          NZ     X4,RNT2     IF UNLOAD/RE-REQUEST REQUIRED
          SA4    X5+8        FET WORD WITH REQUEST FLAGS
          SA3    X5+TRING    RING/NORING FLAG
          AX4    40          RIGHT JUSTIFY *PO=W* BIT
          BX4    -X4*X3      NOT( HAD A RING ) .AND. NEED RING
          LX4    -1          LEFT JUSTIFY EXPRESSION RESULT
          NG     X4,RNT2     IF RING NEEDED AND DO NOT HAVE RING
          SX1    B0+         FLAG SAME TAPE, SAME CONDITIONS
          EQ     RNTX        RETURN
 
 RNT2     BX0    -X6*X2      PRESERVE LOWER PART OF PRIOR VSN WORD
          BX6    X1*X6       INITIALIZE CURRENT REEL VSN
          SA6    X5+CRVSN
          BX2    X2-X0       ISOLATE PRIOR VSN
          BX6    X0+X6       MERGE NEW VSN WITH PRESERVED LOWER PART
          SA6    A2+
          MX0    7*6
          SA1    X5+INITREQ
          SA4    X5          GET PREVIOUS LFN FROM FET
          SA3    X5+TDFV     GET DUMP TAPE LFN
          NZ     X1,RNT3     IF INITIAL REQUEST
          BX6    X3-X4
          BX6    X0*X6
          ZR     X6,RNT4     IF LFN HAS NOT CHANGED
          SA6    A1+         FORCE CHECK FOR *VSN* COMMAND
          ZR     X2,RNT3     IF PREVIOUS FILE WAS MASS STORAGE
 DEBUG    IFC    NE,$DEBUG$"MODLEVEL"$,1   OMIT UNLOAD IF DEBUG
          UNLOAD X5,R        UNLOAD PREVIOUS DUMP TAPE
          SA3    X5+TDFV     GET DUMP TAPE LFN AGAIN
          MX0    7*6
          SA4    X5          GET FET LFN WORD AGAIN
 RNT3     BX4    -X0*X4      SAVE LOWER BITS OF LFN WORD
          BX3    X0*X3
          BX6    X3+X4       SET CURRENT LFN INTO FET
          SA6    X5
          SA1    X5+INITREQ
          ZR     X1,RNT4     IF NOT INITIAL TAPE REQUEST
 
*         CHECK FOR POSSIBLE *VSN* SYSTEM COMMAND.
 
          SA4    FIBK
          BX4    -X0*X4      SAVE BOTTOM OF WORD
          BX6    X3+X4       CHANGE NAME IN *FILINFO* BLOCK
          SA6    A4
          SX6    B0+         CLEAR INITIAL REQUEST FLAG
          SA6    A1
          SA1    DBNAM
          ZR     X1,RNT3.1   IF NOT USING DATABASE
          SA1    X5+TRING
          ZR     X1,RNT4     IF NO RING REQUIRED (IGNORE PRIOR *VSN*)
 RNT3.1   FILINFO  FIBK      GET INFO FOR *TAPE*
          SA2    FIBEST      *FILINFO* EST ORDINAL
          MX6    -12
          LX2    12          RIGHT JUSTIFY EST ORDINAL
          BX2    -X6*X2      EXTRACT EST
          SX2    X2-TEEQ     COMPARE WITH *VSN* EQUIPMENT
          ZR     X2,RNT5     IF PRIOR *VSN* COMMAND DO NOT UNLOAD
 
*         READY TO UNLOAD TAPE.
 
 RNT4     BSS    0
 DEBUG    IFC    NE,$DEBUG$"MODLEVEL"$,1  IGNORE *UNLOAD* IF DEBUG
          UNLOAD X5,R
 RNT5     SX6    B0+
          SA6    X5+CFN      CLEAR MASS STORAGE FILE NAME
          SA6    X5+WRITTEN  CLEAR TAPE WRITTEN FLAG
          SA2    X5+TFETVSN  CHECK VSN
          MX0    6*6
          BX2    X0*X2
          ZR     X2,RNTX     IF NULL VSN RETURN
          SA3    X5+TFLAGS   CHECK FOR PRESET REQUEST FLAGS
          NZ     X3,RNT6     IF FLAGS ALREADY SET
          SA4    TAPDFLT     TAPE DEFAULTS FOR *BTF*
          RJ     BTF         BUILD FLAGS FROM DIRECTIVE KEYWORDS
          SA3    X5+TFLAGS   GET RESULTS FROM *BTF*
 RNT6     SA1    POV         USER PROCESSING OPTIONS
          MX0    -3
          BX6    -X0*X3      GET TAPE FORMAT
          SA4    X5+TRING
          LX4    39          POSITION RING-REQUIRED TO *PO=R*
          BX1    -X4*X1      CLEAR *PO=R* IF RING IS SET
          LX4    1           POSITION TO *PO=W*
          BX1    X1+X4       INSERT POSSIBLE RING-IN BIT
          LX6    30          POSITION TAPE FORMAT
          SX2    1000B
          BX2    -X2*X3      REMOVE FOREIGN TAPE FLAG
          BX3    X3-X2       ISOLATE FOREIGN TAPE FLAG
          BX2    X0*X2       ISOLATE DENSITY, TRACKS
          LX2    48          POSITION DENSITY, TRACKS
          BX6    X6+X1       ADD PROCESSING OPTIONS
          BX6    X6+X2       ADD DENSITY, TRACKS
          SA6    X5+8        INSERT FLAGS IN TAPE FET
          SA1    TMSTAT
          BX7    X7-X7       PRESET FOR NO OWNER
          BX6    X6-X6       PRESET FOR NO PASSWORD
          ZR     X1,RNT8     IF TMS IS NOT ACTIVE
          SA1    FTV         FOREIGN TAPE VARIABLE
          SX6    2           PRESET FOREIGN TAPE FLAG BIT
          NZ     X3,RNT8     IF FOREIGN TAPE FLAG SET
          NZ     X1,RNT8     IF *FT* OPTION SELECTED
          SA1    X5+TFETVSN
          SA2    =6L         CHECK FOR BLANK VSN - SCRATCH TAPE REQUEST
          MX0    36
          BX1    X1-X2
          BX1    X0*X1
          SX6    400B        SET *RECLAIM* ONLY BIT FOR *TMS*
          NZ     X1,RNT7     IF NOT SCRATCH TAPE REQUEST
          MESSAGE  RNTC,3
          WRITEC O,RNTC      * REQUESTING A NEW DUMP TAPE.*
          WRITER O,R
          SX6    10B         SET FLAG TO RESERVE TAPE
 RNT7     SA1    TOV         TMS TAPE OWNER
          SA2    PWV         TMS TAPE PASSWORD
          MX0    42
          BX1    X0*X1       ISOLATE OWNER
          BX7    X0*X2       ISOLATE TAPE PASSWORD
          BX6    X6+X1
 RNT8     SA6    X5+/TFM/TFUN  INSERT OWNER IN TAPE FET
          SA7    X5+/TFM/TFPW  ADD PASSWORD TO FET
          BREAK              CHECK FOR USER INTERRUPT BEFORE REQUEST
 DEBUG    IFC    NE,$DEBUG$"MODLEVEL"$
          LABEL  X5          FINALLY DO THE REQUEST
          SA1    X5+TFETVSN
          SA2    =6L         CHECK FOR BLANK VSN - SCRATCH TAPE REQUEST
          MX0    36
          BX1    X0*X1
          BX2    X1-X2
          NZ     X2,RNTX     IF NOT SCRATCH TAPE REQUEST
          WRITEF X5,R        FORCE VSN TO BE MADE ACCESSIBLE
          SA3    X5          RETRIEVE LFN FROM TAPE FET
          SA1    FIBK        CHANGE NAME IN *FILINFO* BLOCK
          MX0    42
          BX1    -X0*X1      SAVE LOWER 18 BITS
          BX3    X0*X3
          BX6    X3+X1
          SA6    A1          CHANGE NAME IN *FILINFO* BLOCK
          FILINFO  FIBK
          SA2    FIBVSN      VSN IN *FILINFO* BLOCK
          MX3    6*6
          BX6    X3*X2       EXTRACT TMS ASSIGNED VSN
          SA6    X5+CRVSN    STORE CURRENT REEL VSN
          SA6    X5+TTNV     REPLACE TN/CT VARIABLE
          SA6    X5+TDNV     REPLACE DN/CN VARIABLE
          SA1    X5+TFETVSN
          BX3    -X3*X1
          BX1    X6
          BX6    X3+X6
          SA6    A1          MERGE VSN INTO FET VSN WORD
 DEBUG    ELSE   1
          RECALL             ISSUE NOOP TO MARK WHERE WE ARE
          EQ     RNTX        RETURN
 
 
 RNTC     DATA   C* REQUESTING A NEW DUMP TAPE.*
 ROD      SPACE  4,20
**        ROD - REQUEST OUTPUT DUMP.
*
*         *ROD* REQUESTS DUMP FILE AND POSITIONS IT EITHER TO *BOI* OR
*         *EOI* DEPENDING UPON WHICH IS REQUIRED.
*
*         ENTRY  (X5) = TAPE FET ADDRESS.
*                ((X5)+TFLAGS) = TAPE REQUEST FLAGS.  ZERO IF NONE.
*                ((X5)+TRING) = 1 IF TAPE MUST HAVE A WRITE RING.
*                             = 0 IF WRITE RING IS NOT NECESSARY.
*
*         EXIT   DUMP FILE ASSIGNED AND POSITIONED.
*                (X5+TFC) = CURRENT FILE POSITION.
*                (X5+TRC) = CURRENT RECORD POSITION.
*                TO *ABT* IF TAPE FULL AND *EI=YES*.
*                TO *MAIN8* IF USER DISALLOWS OVERWRITE.
*
*         USES   X - 0, 1, 3, 4, 6, 7.
*                A - 1, 3, 4, 5, 6.
*
*         MACROS BREAK, MESSAGE, READ, READO, REWIND, SKIPF,
*                WRITEC, WRITEF.
 
 
 ROD      SUBR               ENTRY/EXIT
          SX6    B0+
          SA6    RODA        CLEAR LAST EOR FILE COUNT
 ROD1     SX6    1
          SA1    X5+TTNV     GET VSN FOR REQUEST
          SA6    X5+TRING    FLAG WRITE RING IS REQUIRED
          RJ     RNT         REQUEST NEW TAPE
          SA3    EIV
          NZ     X1,ROD2     IF TAPE NOT PREVIOUSLY ASSIGNED
          SA1    X5+TFC
          BX0    X1
          ZR     X1,ROD2     IF POSITION NOT KNOWN
          SA4    X5+TRC
          ZR     X3,ROD2     IF DUMP TO BE PLACED AT BOI
          NG     X4,ROD8     IF AT EOI FOLLOWING PREVIOUS DUMP
          SX0    X0-1        ADJUST FROM COPY/LOAD TO DUMP FILE NUMBER
          EQ     ROD4        FIND END OF DUMP TAPE
 
 ROD2     REWIND X5,R
          ZR     X3,ROD7     IF DUMP TO BE PLACED AT BOI
          RJ     CVT         CHECK FOR VALID DUMP TAPE
          ZR     X1,ROD3     IF VALID DUMP - GO SKIP AS USUAL
          SX6    B0+         NO VALID DUMP - CLEAR *EI* DUMP FLAG
          SA6    EIV
          MESSAGE  RODB,3    * UNKNOWN DUMP FILE WILL BE OVERWRITTEN.*
          WRITEC O,RODB
          SA1    IDT         CHECK FOR TERMINAL INPUT FILE
          NZ     X1,ROD7     IF NOT A TERMINAL THEN OVERWRITE
          WRITEC O,RODC      * IS THIS OK (YES OR NO)?*
          READ   I,R         ISSUE QUESTION MARK PROMPT
          READO  I           GET FIRST WORD OF USER RESPONSE
          LX6    6*2         RIGHT JUSTIFY LEFT TWO CHARACTERS
          SX6    X6-2RNO     COMPARE WITH *NO*
          NZ     X6,ROD7     IF NOT *NO* THEN OVERWRITE TAPE
          SX6    B0+
          SA6    NFP         CLEAR FILES PROCESSED COUNT
          EQ     MAIN8       ABORT THE DIRECTIVE
 
 ROD3     SX4    B0+         INITIALIZE RECORD NUMBER
 ROD4     SKIPF  X5,1,R
          SA1    X5
          LX1    59-9        LEFT JUSTIFY EOI BIT
          NG     X1,ROD5     IF EOI ENCOUNTERED
          SX4    X4+B1       COMPUTE RECORDS SKIPPED
          LX1    -59+9
          MX6    -9
          BX1    -X6*X1
          SX1    X1-273B
          NG     X1,ROD4     IF JUST EOR - NOT EOF
          SX0    X0+1        COMPUTE FILES SKIPPED
          BREAK
          SA4    RODA
          BX4    X4-X0
          ZR     X4,ROD9     IF LAST STATUS WAS EOF
          SX4    X0-63       COMPARE WITH MAXIMUM DUMP COUNT
          NG     X4,ROD3     IF NOT MAXIMUM DUMPS ALREADY
          MESSAGE  RODD,3    * FILE CONTAINS 63 DUMPS.  FILE IS FULL.*
          WRITEC O,RODD
          EQ     ABT         ABORT *RECLAIM*
 
 ROD5     ZR     X4,ROD9     IF LAST STATUS WAS EOF
          SA1    NVV
          ZR     X1,ROD6     IF VALIDATING DUMP TAPE
          WRITEF X5,R        TERMINATE WITH AN EOF
          SX0    X0+1        INCREMENT FILE COUNT
          EQ     ROD8        START DUMP WITH CLEAR RECORD COUNT
 
 ROD6     BX6    X0
          SA6    RODA        SET LAST EOF FILE COUNT
          SX6    B0
          SA6    X5+TFC      INDICATE POSITION UNKNOWN
          EQ     ROD1        GO BACK TO BEGINNING OF DUMP TAPE
 
 ROD7     SA1    X5+TTNV     SET VSN
          RJ     UII         WRITE INITIAL VSN INDEX RECORD
          SX0    B0+         INITIALIZE FILE NUMBER
 ROD8     SX4    B0+         INITIALIZE RECORD NUMBER
 ROD9     SX7    X4+2        SET/INCREMENT RECORD NUMBER
          SA7    X5+TRC
          SX6    X0+B1       SET/INCREMENT FILE NUMBER
          SA6    X5+TFC
          DATE   HDRDT       GET DATE FOR HEADER
          CLOCK  HDRTM       GET TIME FOR HEADER
          WRITEW X5,HDRCTL,HDRSZ+1  WRITE DUMP HEADER
          WRITER X5,R
          SX7    B1+         SET FLAG FOR TAPE WRITTEN ON
          SA7    X5+WRITTEN
          RJ     UFV         FIND VSN AFTER POSITIONING
          SA1    X5+TMSV
          NZ     X1,RODX     IF MASS STORAGE FILE
          SA1    FIBDEN      GET DENSITY
          MX0    3
          LX1    59-11
          BX6    X0*X1
          SA1    X5+TFLAGS   GET TAPE FLAGS
          LX1    59-5
          BX1    -X0*X1      REMOVE OLD DENSITY
          BX6    X1+X6       MERGE IN NEW DENSITY
          LX6    5-59
          SA6    A1
          EQ     RODX        RETURN
 
 
 RODA     BSS    1           EOF STATUS/COUNT
 RODB     DATA   C* UNKNOWN DUMP FILE WILL BE OVERWRITTEN.*
 RODC     DATA   C* IS THIS OK (YES OR NO)?*
 RODD     DATA   C* DUMP FILE CONTAINS 63 DUMPS.  FILE IS FULL.*
 RPV      SPACE  4,20
**        RPI - REPRIEVE INTERFACE.
*
*         ENTRY  SYSTEM HAS DETECTED AN ERROR CONDITION.
*                (RBPF) .NE. 0  IF ERROR IS TO BE IGNORED.
*
*         EXIT   TO *ABT* IF A FATAL ERROR HAS OCCURED.
*                (RBPF) .EQ. 0  IF *RECLAIM* IS NOT ABORTED.
*
*         USES   X - 0, 1, 6.
*                A - 1, 6.
*
*         CALLS  ABT, PBC.
*
*         MACROS REPRIEVE, RPVBLK.
*
*         NOTE   THIS IS THE EXIT ADDRESS THE SYSTEM GIVES CONTROL
*                TO WHEN AN ERROR CONDITION HAS BEEN DETECTED.
*                THIS INCLUDES USER BREAKS AND SYSTEM ERRORS.
 
 
 RPVBLK   RPVBLK RPI         REPRIEVE PARAMETER BLOCK
 
 
 RPI      BSS    0           ENTRY POINT FOR REPRIEVE CODING
          SB1    1           ENSURE *B1=1*
          SA1    RBPF
          NZ     X1,RPV2     IF BYPASS FLAG SET
          MX0    48
          SA1    RPVBLK+3    GET REPRIEVE ERROR CODE
          BX1    -X0*X1
          SX1    X1-40B      IF TERMINAL INTERRUPT
          NZ     X1,ABT      IF NOT A TERMINAL INTERRUPT
          SA1    NOBREAK     NO BREAKS ALLOWED
          NZ     X1,RPV1     RESUME PROCESSING
          SA1    RPVBLK+6
          NZ     X1,ABT      IF INPUT REQUEST AND USER BREAK ABORT
          SA1    RPVBLK+7
          BX1    -X0*X1      ERROR FLAG
          SX1    X1-TIET     CHECK FOR TERMINAL INTERRUPT
          NZ     X1,ABT      IF NOT USER BREAK ONE
 RPV1     SX6    B1          SET INTERUPT FLAG
          SA6    BREAK
 RPV2     SX6    B0+
          SA6    RBPF        CLEAR BYPASS FLAG
          REPRIEVE  RPVBLK,RESUME,233B  RESUME PROCESSING, NO RETURN
 SBU      SPACE  4,20
**        SBU - SORT BY USER.
*
*         *SBU* SORTS THE NEW ENTRIES FOR THE DATABASE BY USERNAME,
*         FILE NAME AND FILE POSITION BEFORE UPDATING THE DATABASE.
*
*         ENTRY  UNSORTED RECORDS ON FILE *OPLDF*.
*
*         EXIT   SORTED RECORDS ON FILE *UPDATES*.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*
*         CALLS  SDE, SRT.
*
*         MACROS READ, READW, REWIND, UNLOAD, WRITE, WRITEO, WRITER,
*                WRITEW.
 
 
 SBU      SUBR               ENTRY/EXIT
          REWIND DB          CLEAR BUFFER
          REWIND SF          CLEAR BUFFER
          REWIND OPLDF
          UNLOAD DB          PREVENT ANY PFM ERRORS
          UNLOAD SF          PREVENT ANY PFM ERRORS
          WRITE  CF,*        PRESET WRITE FUNCTION
          READ   OPLDF
 SBU1     READW  OPLDF,SBUB,UDBEL
          NZ     X1,SBU2     IF NO DATA ENCOUNTERED
          MX0    6*7
          SA1    SBUB+DBUNM  GET THE USER NAME
          SA2    SBUB+DBFNO  GET THE FILE AND RECORD NUMBER
          BX6    X0*X1       ISOLATE USER NAME
          LX2    0-18
          BX2    -X0*X2      ISOLATE FILE AND RECORD NUMBER
          BX6    X6+X2       CREATE SORT KEY
          WRITEO CF          WRITE USER NAME AS SORT KEY
          WRITEW CF,SBUB,UDBEL
          EQ     SBU1        PROCESS NEXT RECORD
 
 SBU2     WRITER CF
          REWIND CF,R
          RJ     SRT         SORT BY USER NAME AND FILE/RECORD POSITION
 
*         MOVE UPDATES SORTED BY USERNAME TO *SF*.
 
          REWIND CF
          WRITE  SF,*        PRESET WRITE FUNCTION
          SX6    B0+
          SA6    MRUSER      CLEAR CURRENT USER NAME BEING PROCESSED
          SA6    SBUB+DBEL   CLEAR FAMILY ENTRY IN UPDATES TYPE RECORD
          READ   CF
 SBU3     READW  CF,SBUA,ITEMSIZ
          NZ     X1,SBU4     IF NO MORE DATA
          WRITEW SF,SBUB,UDBEL MOVE UPDATES TYPE RECORD TO *SF*
          EQ     SBU3        GET NEXT ENTRY
 
*         NOW SORT *SF* ENTRIES BY PFN, AND DUMP FILE POSITION.
 
 SBU4     WRITER SF          FLUSH THE BUFFER
          REWIND OPLDF
          REWIND SF
          WRITE  DB,*        PRESET WRITE FUNCTION
          WRITE  OPLDF,*     PRESET WRITE FUNCTION
          READ   SF
 SBU5     READW  SF,SBUB,UDBEL
          NZ     X1,SBU10    IF END OF DATA
          SA1    SBUB+DBUNM  GET SORT KEY (USER NAME)
          SA2    MRUSER      GET CURRENT USER NAME BEING PROCESSED
          MX0    42          SET USER NAME MASK
          BX6    X1-X2
          BX7    X0*X1       ISOLATE USERNAME KEY
          BX6    X0*X6       ISOLATE CURRENT USER NAME
          SA7    A2+         SAVE NEW CURRENT USER NAME
          ZR     X6,SBU6     IF USER NAMES ARE THE SAME
          NZ     X2,SBU7     IF NOT FIRST PASS
 SBU6     WRITEW OPLDF,SBUB,UDBEL
          EQ     SBU5        GET NEXT RECORD
 
 SBU7     WRITER OPLDF,R
          RJ     SDE         SORT DATABASE ENTRIES
          READ   UPDATES
          SA1    MRUSER
          ZR     X1,SBU8     IF NO MORE ENTRIES
          WRITE  OPLDF,*     PRESET WRITE FUNCTION
          WRITEW OPLDF,SBUB,UDBEL  WRITE CURRENT *SF* ENTRY
 
*         TRANSFER SORTED DATA TO *DB* UNTIL ENTRIES ARE PROCESSED.
 
 SBU8     READW  UPDATES,SBUB,UDBEL
          NZ     X1,SBU9     IF NO MORE DATA
          WRITEW DB,SBUB,UDBEL HOLD IN *DB* UNTIL ALL PROCESSED
          EQ     SBU8        GET NEXT RECORD
 
 SBU9     SA1    MRUSER      CURRENT USER NAME
          ZR     X1,SBU11    IF CLEAR, NO MORE RECORDS
          EQ     SBU5        PROCESS NEXT SET OF RECORDS
 
 SBU10    SX6    B0+         CLEAR CURRENT USER NAME
          SA6    MRUSER
          RECALL OPLDF
          SA1    OPLDF+2
          SA2    A1+B1
          IX1    X1-X2       IF BUFFER POINTERS IN = OUT
          NZ     X1,SBU7     IF DATA IN BUFFER
 SBU11    REWIND UPDATES
          WRITER DB          FLUSH THE BUFFER
          REWIND DB
          WRITE  UPDATES,*   PRESET WRITE FUNCTION
          READ   DB
 SBU12    READW  DB,SBUB,UDBEL
          NZ     X1,SBU13    IF NO MORE DATA
          WRITEW UPDATES,SBUB,UDBEL
          EQ     SBU12       GET NEXT RECORD
 
 SBU13    WRITER UPDATES
          UNLOAD DB
          UNLOAD SF
          REWIND UPDATES
          EQ     SBUX        RETURN
 
 
 SBUA     BSS    ITEMSIZ-UDBEL
 SBUB     BSS    UDBEL
 SDE      SPACE  4,40
**        SDE - SORT DATABASE RECORDS.
*
*         *SDE* SORTS *OPLDF* RECORDS BY ONE OF TWO KEYS.
*         NORMAL PFN RECORDS -
*           1. FILE NAME IS PRIMARY SORT KEY IN ASCENDING ORDER.
*           2. FILE POSITION IS SECONDARY IN DESCENDING ORDER.
*              (FILE POSITION KEY IS INVERTED FOR DESCENDING ORDER)
*         VSN INDEX RECORDS -
*           1. VSN IS PRIMARY SORT KEY IN ASCENDING ORDER.
*           2. FILE POSITION IS SECONDARY IN ASCENDING ORDER.
*         *SDE* BUILDS THE ONE WORD KEY, THEN CALLS *SRT* TO PERFORM
*         THE SORT OF UPDATE RECORDS BY THE KEY BEING USED.
*         THE SORTED RECORDS ARE THEN READ IN AND WRITTEN TO *UPDATES*.
*
*         ENTRY  UNSORTED RECORDS ON FILE *OPLDF*.
*
*         EXIT   SORTED RECORDS ON FILE *UPDATES*.
*
*         ERROR  TO *ABT* IF 2 RECORDS HAVE SAME POSITION ON TAPE.
*
*         USES   X - 0, 1, 2, 3, 6.
*                A - 1, 2, 3.
*
*         CALLS  SRT.
*
*         MACROS READ, READW, REWIND, UNLOAD, WRITE, WRITEO,
*                WRITER, WRITEW.
 
 
 SDE      SUBR               ENTRY/EXIT
          REWIND OPLDF,R
          REWIND CF,R
          REWIND UPDATES,R
          WRITE  CF,*
          WRITE  UPDATES,*
          READ   OPLDF       START UP READ ON UNSORTED UPDATES
          MX0    6*7         MASK FOR PERMANENT FILE NAME
 
*         THIS FIRST PART READS EACH ENTRY FROM *OPLDF*, EXTRACTS
*         FIELDS TO BUILD THE SORT KEY, AND WRITES A CORRESPONDING
*         ENTRY ON *CF*.  WHEN ALL ENTRIES HAVE BEEN COPIED, *SRT*
*         IS CALLED TO SORT THEM IN ASCENDING SEQUENCE BY THE KEY.
 
 SDE1     READW  OPLDF,UPE,UDBEL
          NZ     X1,SDE4     IF EOR FOUND ON UNSORTED FILE
          SA2    UPE+DBUNM
          SA3    VSNR        CHECK FOR VSN INDEX ID
          BX2    X2-X3
          NZ     X2,SDE2     IF NOT A VSN INDEX RECORD
          SA2    UPE+DBXSV   VSN OF FIRST REEL OF SET
          SA1    UPE+DBXFR   FILE/RECORD NUMBER OF FIRST FILE
          MX3    -24
          LX1    -12
          BX1    -X3*X1
          BX2    X1+X2       MERGE VSN AND FILE/RECORD
          MX3    6           BIAS VSN INDEX RECORDS TO SORT LAST
          LX2    9*6         POSITION VSN/FILE/RECORD
          EQ     SDE3        WRITE OUT SORT KEY
 
 SDE2     SA2    UPE+DBPFN   ENTRY WORD WITH PFN
          SA3    UPE+DBFNO   ENTRY WORD WITH FILE/RECORD NUMBER
          BX2    X0*X2       ISOLATE PFN
          LX3    -18         POSITION FILE/RECORD NUMBER
          BX3    -X3         INVERT FILE/RECORD FOR DESCENDING ORDER
          BX3    -X0*X3      ISOLATE INVERTED FILE/RECORD NUMBER
 
 SDE3     BX6    X2+X3       MERGE PARTS OF KEY
          WRITEO CF          WRITE SORT KEY FOR THIS ENTRY
          WRITEW CF,UPE,UDBEL  WRITE REST OF THIS ENTRY
          ERRNZ  ITEMSIZ-UDBEL-1  SIZE CHECK FOR SORT RECORD
          EQ     SDE1        LOOP TO HANDLE NEXT RECORD
 
 SDE4     WRITER CF          FLUSH MERGESORT FILE
          UNLOAD OPLDF
          RJ     SRT         SORT RECORDS BY KEY
          READ   CF
 
*         COPY SORTED RECORDS TO *UPDATES*.
 
 SDE5     READW  CF,SDEB,ITEMSIZ
          NZ     X1,SDE6     IF EOR/EOF/EOI REACHED
          WRITEW UPDATES,SDEC,UDBEL
          EQ     SDE5        GET NEXT RECORD
 
 SDE6     UNLOAD CF
          WRITER UPDATES
          REWIND UPDATES,R
          EQ     SDEX        RETURN
 
 
 SDEB     BSS    1           TEMP AREA FOR SORT ENTRY
 SDEC     BSS    ITEMSIZ-1   TEMP AREA FOR UPDATE AND SORT ENTRY
 SFC      SPACE  4,10
**        SFC - SET FILE COUNT.
*
*         ENTRY  (X6) = DEFAULT FILE LIMIT FOR CALLING OPTION.
*
*         EXIT   FILE COUNT SET.
*
*         USES   X - 1, 6.
*                A - 1, 6.
 
 
 SFC      SUBR               ENTRY/EXIT
          SA1    NFV
          NZ     X1,SFCX     IF FILE LIMIT SET BY USER
          SA6    A1
          EQ     SFCX        RETURN
 SRT      SPACE  4,20
**        SRT - MERGE SORT OF 6-WORD ENTRIES.
*
*         *SRT* SORTS THE 6-WORD ENTRIES ON FILE *CF* BASED
*         ON THE FIRST WORD OF EACH ENTRY, USED AS AN UNSIGNED, 60-BIT
*         NUMERIC SORT KEY.  THE ALGORITHM USED IS TAKEN
*         FROM N. WIRTH, *ALGORITHMS + DATA STRUCTURES = PROGRAMS*,
*         PRENTICE-HALL, PP. 97-98.
*
*         ENTRY  *CF* CONTAINS AT LEAST ONE ENTRY.
*                SORT KEY IS THE FIRST WORD OF EACH ENTRY.
*
*         EXIT   SORTED ENTRIES ON *CF*.
*
*         USES   X - 1, 2, 6.
*                A - 1, 6.
*
*         CALLS  DTR, MRG.
*
*         MACROS RESET, UNLOAD, REWIND, REWRYTE, WRITER.
 
 
 SRT      SUBR               ENTRY/EXIT
 
*         REPEAT DISTRIBUTE/MERGE PASSES.
 
 SRT1     REWRYTE  AF
          REWRYTE  BF
          RESET  CF
          RJ     DTR         DISTRIBUTE RUNS FROM C ONTO A AND B
          WRITER AF,R
          WRITER BF,R
          RESET  AF
          RESET  BF
          REWRYTE  CF
          SX6    B0+         INITIALIZE COUNT OF RUNS FOR THIS PASS
          SA6    NRUNS
          RJ     MRG         MERGE RUNS FROM A AND B ONTO C
          WRITER CF,R
          SA1    NRUNS
          SX2    B1
          IX1    X1-X2
          NZ     X1,SRT1     IF NOT A SINGLE RUN YET
          UNLOAD AF
          UNLOAD BF
          REWIND CF,R
          EQ     SRTX        RETURN
 UDV      SPACE  4,20
**        UDV - UPDATE DUMP VSNS IN DATABASE
*
*         UDV CHECKS THE CURRENT VSN OF THE DUMP FILE.
*                IF THE VSN HAS CHANGED, THE VSN IN FET+CRVSN
*                IS UPDATED AND A VSN INDEX RECORD IS WRITTEN
*                TO THE OPLDF FILE TO UPDATE THE DATA BASE.
*
*         ENTRY  (X5) = FET ADDRESS OF DUMP FILE TO CHECK.
*
*         EXIT   (X2).LT.0   FILE IS NOT A TAPE FILE.
*                (X2).EQ.0   VSN HAS NOT CHANGED.
*                (X2).GT.0   VSN CHANGED, FET+CRVSN CONTAINS NEW VSN
*                            AND VSN INDEX RECORD HAS BEEN WRITTEN.
*
*         USES   X - 1, 2, 3, 5, 6
*                A - 1, 2
*
*         CALLS  UFV
 
 UDV      SUBR               ENTRY/EXIT
          SA2    DBNAM
          ZR     X2,UDVX     IF NO DATA BASE
          RJ     UFV         UPDATE FET VSN
          NG     X2,UDVX     IF NOT A TAPE FILE
          ZR     X2,UDVX     IF VSN DID NOT CHANGE
          SA6    VSNR+DBXCV  SAVE NEW VSN (X6) IN DB RECORD
          WRITEO  NUMBERS
          SA1    X5+TTNV     SET VSN ORIGINALLY SPECIFIED
          MX6    6*6
          BX6    X1*X6
          SA6    VSNR+DBXSV  SAVE SET VSN IN CASE DUMPING AT EOI
          SA1    X5+TFC
          LX1    12
          SA2    X5+TRC
          BX6    X1+X2       MERGE FILE AND RECORD NUMBER
          LX6    18
          SA6    VSNR+DBXFR  SAVE BEGINNING FILE AND RECORD ON VSN
          WRITEW OPLDF,VSNR,UDBEL
          SX2    1           INDICATE VSN INDEX RECORD WRITTEN
          EQ     UDVX        RETURN
          SPACE  4,10
**        UFV - UPDATE FET VSN
*
*         UFV CHECKS THE CURRENT VSN OF THE DUMP FILE
*                AND UPDATES THE VSN IN FET+CRVSN.
*
*         ENTRY  (X5) = FET ADDRESS OF FILE TO BE CHECKED.
*
*         EXIT   (X2).LT.0   FILE IS NOT A TAPE FILE.
*                (X2).EQ.0   VSN HAS NOT CHANGED.
*                (X2).GT.0   VSN CHANGED, FET+CRVSN CONTAINS NEW VSN.
*                (X5) = FET ADDRESS.
*                (X6) BITS 59-24 = CURRENT VSN, IF (X2).GE.0.
*
*         USES   X - 1, 2, 3, 5, 6.
*                A - 1, 2, 5.
*
*         MACROS FILINFO
 
 UFV      SUBR               ENTRY/EXIT
          MX3    7*6
          SA1    X5          GET LFN FROM FET
          BX6    X3*X1
          SA1    FIBK        GET FIRST WORD OF *FILINFO* BLOCK
          BX1    -X3*X1      REMOVE THE LFN
          BX6    X1+X6       MERGE IN NEW LFN
          SA6    A1
          FILINFO  FIBK
          SA2    X5+TFLAGS   GET TAPE FLAGS
          LX2    59-11
          NG     X2,UFVX     IF SPECIFIED AS MASS STORAGE
 DEBUG    IFC    NE,$DEBUG$"MODLEVEL"$
          SA2    FIBVSN
 DEBUG    ELSE
          SA2    X5+CRVSN    FOR DEBUG FORCE THE SAME VSN
 DEBUG    ENDIF
          LX2    59-5        CHECK IF THIS IS A TAPE
          NG     X2,UFVX     IF NOT A TAPE
          LX2    5-59
          MX3    6*6
          BX6    X3*X2       ISOLATE CURRENT VSN
          SA2    X5+CRVSN    GET PREVIOUS VSN
          BX2    X2-X6
          ZR     X2,UFVX     IF NO CHANGE OF VSN
          SA6    A2
          SX2    B1+         INDICATE VSN CHANGED TO CALLER
          EQ     UFVX        RETURN
 UII      SPACE  4,15
**        UII - UPDATE FOR INITIAL VSN INDEX RECORD.
*
*         UII WRITES THE DATA BASE UPDATE ENTRY FOR THE FIRST
*                REEL OF A DUMP FILE.
*
*         ENTRY  (X1) = VSN OF FIRST REEL OF SET.
*                (X5) = FET ADDRESS OF DUMP FILE.
*
*         EXIT   OPLDF UPDATE RECORD FOR VSN INDEX WRITTEN.
*
*         USES   X - 1, 3, 6.
*                A - 1, 3, 6.
*
*         CALLS  UFV.
 
 UII      SUBR               ENTRY/EXIT
          SA3    DBNAM       CHECK IF USING A DATA BASE
          ZR     X3,UIIX     IF NOT USING DATA BASE
          SA3    X5+TFLAGS   GET TAPE FLAGS
          LX3    59-11
          PL     X3,UII1     IF A TAPE DUMP
          LX3    47-59       SET TAPE FLAGS, FIRST-OF-SET FILE/RECORD
          BX6    X3
          SA6    VSNR+DBXFR
          MX3    7*6
          BX6    X3*X1       ISOLATE DUMP FILE NAME
          EQ     UII3        WRITE TO *NUMBERS*
 
 UII1     MX3    6*6
          BX6    X3*X1
          SA6    VSNR+DBXSV  SAVE AS SET VSN
          SA6    VSNR+DBXCV  SAVE AS CURRENT VSN
          RJ     UFV         UPDATE FET VSN
          NG     X2,UII2     IF NOT A TAPE FILE
          SA6    VSNR+DBXCV  SAVE TRUE VSN
          SA1    FIBDEN      GET DENSITY
          MX3    3
          LX1    59-11
          BX6    X3*X1
          SA1    X5+TFLAGS   GET TAPE FLAGS
          LX1    59-5
          BX1    -X3*X1      REMOVE OLD DENSITY
          BX6    X1+X6       MERGE IN NEW DENSITY
          LX6    5-59
          SA6    A1
          LX6    36          SET TAPE FLAGS, FIRST-OF-SET FILE/RECORD
          SA6    VSNR+DBXFR
 UII2     WRITEW OPLDF,VSNR,UDBEL
          SA1    VSNR+DBXCV
          BX6    X1
 UII3     WRITEO  NUMBERS    WRITE TO *NUMBERS* FILE
          EQ     UIIX        RETURN
          SPACE 4,10
**        UPD - UPDATE DATABASE.
*
*         ENTRY  (X5) = ATTACH MODE FOR *ADB*.
*                (COPTION) = DIRECTIVE.
*                FILE *UPDATES* CONTAINS UPDATE ENTRIES
*                TO ADD TO THE DATABASE.
*                FILE *NUMBERS* CONTAINS TAPE VSN-S.
*
*         EXIT   UPDATE COMPLETE.
*
*         USES   X - ALL.
*                A - 0, 1, 2, 3, 4, 5, 6.
*                B - 7.
*
*         CALLS  ADB, COE, POT, RDU, WOR.
*
*         MACROS ABORT, CLEAR, MESSAGE, READ, READW, REWIND,
*                UNLOAD, WRITE, WRITER, WRITEW.
*
*         NOTE   UPDATES FILE MUST BE SORTED.
 
 
 UPD      SUBR               ENTRY/EXIT
          SX7    PTWR        SET WRITE MODE FOR DATABASE ATTACH
          SA1    NLVIFLG     SET IF DATABASE JUST CREATED IN PDB
          ZR     X1,UPD.1    IF DATBASE NOT JUST CREATED
          MX6    0
          SA6    NLVIFLG     CLEAR FLAG
          RJ     ADB         ATTACH THE DATABASE
          EQ     UPD.2       RESUME NORMAL PROCESSING
 
 UPD.1    RJ     LVI         ATTACH DATABASE, LOCATE VSN INDEX
 UPD.2    REWIND NEW,R       PRESET NON WRITE *CIO* FUNCTION
          WRITE  NEW,*
          SX6    B0
          SA6    NEW+6
          SA1    NEW+1       SET RANDOM BIT IN FET
          MX0    1
          LX0    47-59
          BX6    X0+X1
          SA6    A1
          REWIND OPLDF,R
          WRITE  OPLDF,*     PRESET NON-WRITE *CIO* FUNCTION
          REWIND NUMBERS,R
          READ   NUMBERS,R
          SA1    NUMBERS+2   GET LENGTH OF FILE
          SA2    A1+B1
          IX1    X1-X2
          BX6    X6-X6
          SA6    DIRBUF+X1   SET ZERO WORD AT END OF DATA IN BUFFER
          NZ     X1,UPD0     IF TAPE NUMBER FILE NOT EMPTY
          SA2    USERDB      USER DATABASE FLAG
          NZ     X2,UPD1     IF USER DATABASE
          MESSAGE  UPDA,3    * TAPE NUMBER FILE EMPTY.*
          EQ     UPD1        PROCESS UPDATES
 
 UPD0     SA2    COPTION
          SA3    =0LREMOVE
          BX2    X2-X3
          ZR     X2,UPD1     IF PROCESSING *REMOVE* OPTION
          SA2    DBE+DBXSV
          MX0    6*6
          BX2    X0*X2
          ZR     X2,UPD1     IF NO VSN INDEX FOUND
          BX5    X1          PRESERVE COUNT OF ENTRIES IN X5
 UPD0.1   READW  DB,DBE,DBEL  GET NEXT VSN INDEX ENTRY
          NZ     X1,UPD1     IF NO MORE VSN INDEX
          SA1    DBE+DBXCV
          SA2    DIRBUF-1
 UPD0.2   SA2    A2+B1       GET NEXT *NUMBERS* ITEM
          ZR     X2,UPD0.1   IF END OF *NUMBERS* LIST
          BX2    X1-X2
          NZ     X2,UPD0.2   IF NO MATCH TO CURRENT VSN ENTRY
          SA1    DBE+DBXSV
          BX6    X1+X5       MERGE LIST SIZE AND SET VSN
          SA6    A2          REPLACE *NUMBERS* ITEM
          SX5    X5-1
          NZ     X5,UPD0.1   IF UNMATCHED *NUMBERS* ITEMS LEFT
 UPD1     REWIND  DB,R
          REWIND UPDATES,R
          READ   UPDATES
          RJ     RDU         READ *UPDATES* FILE
 UPD2     READ   DB,R
          SA3    DB
          MX0    -7
          LX0    2
          BX3    -X0*X3      GET *CIO* RESPONSE
          SX3    X3-30B      CHECK FOR EOI/EOF
          ZR     X3,UPD13    IF EOF/EOI ENCOUNTERED IMMEDIATELY
          SA3    DB+3
          SA4    A3-B1       CHECK FOR EMPTY RECORD
          IX4    X4-X3
          ZR     X4,UPD2     IF EMPTY RECORD
          SA3    X3
          SA4    OPLDH
          BX4    X3-X4
          ZR     X4,UPD13    IF OPLD RECORD FOUND
 
*         SAVE USER NAME.
 
          MX0    42
          BX6    X0*X3
          SX3    2
          BX6    X3+X6
          SA6    INDXNAM
 UPD3     READW  DB,DBE,DBEL
 
*         CHECK FOR EOR/EOF/EOI.
 
          ZR     X1,UPD6     IF SUCCESSFUL READ WITH NO SPECIAL STATUS
          NG     X1,UPD14    IF EOF OR EOI
          SX2    X1-DBE      COMPUTE LENGTH OF READ
          ZR     X2,UPD4     IF EOR ENCOUNTERED
          SB2    X1
          EQ     B2,B6,UPD14 IF INCOMPLETE READ -- EOI
          EQ     ABT1        ABORT *RECLAIM*
 
 UPD4     SA1    DBE         DATABASE ENTRY
          SA2    UPE         UPDATE ENTRY
          MX0    42
          BX3    X1-X2       COMPARE USERS
          BX3    X0*X3       REMOVE POSSIBLE JUNK BITS 17-0
          NZ     X3,UPD5     UPDATE RECORDS NOT FOR USER NAME
          WRITEW NEW,UPE,DBEL
          RJ     RDU
          ZR     X1,UPD4     IF NOT END OF UPDATES
          SX6    B0
          SA6    UPE
 UPD5     SA1    NEW+2       EXAMINE IN POINTER
          SA2    NEW+3       OUT POINTER
          IX1    X1-X2
          NZ     X1,UPD5.1   IF DATA IN BUFFER TO BE WRITTEN
          SA4    NEW
          MX0    -7          WIDTH OF *CIO* FUNCTION CODE
          LX0    2           SKIP BINARY/CODED, COMPLETE BITS
          BX4    -X0*X4      EXTRACT *CIO* FUNCTION CODE
          SX4    X4-14B      CHECK FOR *WRITE* CODE
          NZ     X4,UPD2     IF NO DATA WRITTEN RECENTLY
 UPD5.1   WRITER NEW,R
          WRITE  NEW,*       RESET WRITE FUNCTION
          RJ     COE
          JP     UPD2        READ NEXT RECORD
 
 UPD6     MX0    36
          SA1    DBE+DBUNM   CHECK FOR VSN INDEX ENTRY
          SA2    VSNR
          BX2    X1-X2
          NZ     X2,UPD6.0   IF NOT A VSN INDEX ENTRY
          SA1    DBE+DBXSV
          EQ     UPD6.1      SEARCH *NUMBERS* LIST
 
 UPD6.0   SA1    DBE+DBTNO   TAPE VSN/LAST MOD
          SA3    DBE+DBFLG   WORD WITH TAPE FLAGS
          LX3    59-47
          PL     X3,UPD6.1   IF PERMANENT FILE FLAG NOT SET
          MX0    42          MASK FOR PERMANENT FILE NAME
 UPD6.1   BX1    X0*X1       EXTRACT VSN
          MX0    42          MUST MASK 7 CHAR FOR *NUMBERS* LIST
          SA3    DIRBUF-1
 UPD7     SA3    A3+B1
          ZR     X3,UPD8     IF END OF TABLE - WRITE OLD ENTRY ON *NEW*
          BX4    X0*X3       TAPE NUMBER
          BX4    X4-X1
          NZ     X4,UPD7     IF NO MATCH
          ZR     X2,UPD3     IF MATCH IS TO VSN INDEX RECORD
          SA1    COPTION
          SA2    =0LREMOVE
          BX3    X1-X2
          NZ     X3,UPD3     IF NOT *REMOVE*
 
*         DELETE CURRENT RECORD -- INCREMENT FILE COUNT.
 
          SA1    NFP
          SX6    X1+1
          SA6    A1
          SA0    DBE
          RJ     POT         PROCESS OUTPUT
          EQ     UPD3        CONTINUE
 
 UPD8     SA1    UPE
          ZR     X1,UPD9     NO UPDATE ENTRIES LEFT
 
*         CHECK USER NAMES.
 
          SA2    DBE
          MX0    42
          BX1    X0*X1
          LX1    42
          BX2    X0*X2
          LX2    42
          IX3    X2-X1
          NG     X3,UPD9     IF DATABASE .LT. UPDATE - WRITE DATABASE
          NZ     X3,UPD10    IF DATABASE .GT. UPDATE - WRITE UPDATE
 
*         CHECK PERMANENT FILE NAME OR VSN OF SET.
 
          SA1    A1+B1
          BX1    X0*X1
          LX1    42
          SA2    A2+B1
          BX2    X0*X2
          LX2    42
          IX3    X2-X1
          NG     X3,UPD9     IF DATABASE .LT. UPDATE - WRITE DATABASE
          NZ     X3,UPD12    IF DATABASE .GT. UPDATE - WRITE UPDATE
 
*         CHECK IF VSN INDEX UPDATE RECORD
 
          SA3    UPE+DBUNM
          SA4    VSNR        VSN INDEX ID
          BX3    X3-X4
          NZ     X3,UPD8.5   IF NOT VSN INDEX DATA
 
*         CHECK FILE AND RECORD POSITIONS.
 
          SA1    UPE+DBXFR
          LX1    -18
          BX1    -X0*X1
          SA2    DBE+DBXFR
          LX2    -18
          BX2    -X0*X2
          IX3    X2-X1
          NG     X3,UPD9     IF DATABASE .LT. UPDATE - WRITE DATABASE
          EQ     UPD3        DATABASE .GE. UPDATE - BYPASS DATABASE
 
*         CHECK DUMP DATE.
 
 UPD8.5   SA1    A1
          BX1    -X0*X1
          SX1    X1-70000
          PL     X1,UPD8.6   IF UPDATE YEAR .LT. 2000
          SX1    X1+100000
 UPD8.6   SA2    A2
          BX2    -X0*X2
          SX2    X2-70000
          PL     X2,UPD8.7   IF DATABASE YEAR .LT. 2000
          SX2    X2+100000
 UPD8.7   IX3    X2-X1
          NG     X3,UPD12    IF DATABASE .LT. UPDATE - WRITE UPDATE
          NZ     X3,UPD9     IF DATABASE .GT. UPDATE - WRITE DATABASE
 
*         CHECK TAPE NUMBER.
 
          SA1    UPE+DBTNO
          SA2    DBE+DBTNO
          BX1    X0*X1
          BX2    X0*X2
          BX1    X1-X2
          NZ     X1,UPD12    IF TAPE NUMBERS NOT EQUAL WRITE UPDATE
 
*         CHECK FLAG WORD (DBE+3).
 
          SA1    A1+B1
          SA2    A2+B1
          BX1    X1-X2
          NZ     X1,UPD12    IF WORD 4 NOT THE SAME - WRITE UPDATE
          SA1    EIV
          NZ     X1,UPD12    IF DUMPING TO END OF TAPE
 
*         A DUPLICATE ENTRY - DISREGARD UPDATE ENTRY.
 
          RJ     RDU
          ZR     X1,UPD9     IF NOT END OF UPDATE ENTRIES
          SX6    B0
          SA6    UPE
 UPD9     WRITEW NEW,DBE,DBEL
          EQ     UPD3        CONTINUE
 
 UPD10    WRITEW NEW,UPE,DBEL
          SA5    UPE
          BX5    X0*X5
          RJ     RDU
          ZR     X1,UPD11    IF NOT END OF UPDATE ENTRIES
          SX6    B0
          SA6    UPE
 UPD11    SA1    UPE
          BX1    X0*X1
          BX3    X1-X5
          ZR     X3,UPD10    UPDATE ENTRIES FOR SAME USER NAME
          BX6    X0*X5       MASK OUT USER NAME OF RECORD
          SX1    2
          BX6    X1+X6
          SA6    INDXNAM     SAVE USER NAME
          WRITER NEW,R
          WRITE  NEW,*       RESET WRITE FUNCTION
          RJ     COE         CREATE OPLD ENTRY
          MX0    42
          SA1    DBE
          BX6    X0*X1
          SX1    2
          BX6    X6+X1
          SA6    INDXNAM     SAVE THE NEW RECORD NAME
          EQ     UPD8        PROCESS NEXT UPDATE ENTRY
 
 UPD12    WRITEW NEW,UPE,DBEL
          RJ     RDU
          ZR     X1,UPD8     IF NOT END OF UPDATE ENTRIES
          SX6    B0
          SA6    UPE
          EQ     UPD8        PROCESS NEXT UPDATE ENTRY
 
 UPD13    SA1    UPE
          BX6    X1
          SA6    DBE
          MX0    42
          BX6    X0*X6
          SX1    2
          BX6    X1+X6
          SA6    INDXNAM
 UPD14    SA1    UPE
          ZR     X1,UPD17    IF NO UPDATE RECORDS LEFT
 UPD15    SA1    DBE
          SA2    UPE
          BX1    X2-X1
          MX0    42
          BX1    X0*X1
          ZR     X1,UPD16    IF SAME USER NAME
          WRITER NEW,R
          WRITE  NEW,*       RESET WRITE FUNCTION
          RJ     COE
          SA1    UPE
          MX0    42
          BX6    X0*X1
          SA6    DBE
          SX1    2
          BX6    X1+X6
          SA6    INDXNAM
 UPD16    WRITEW NEW,UPE,DBEL
          RJ     RDU
          ZR     X1,UPD15    IF NOT END OF UPDATES
          WRITER NEW,R
          WRITE  NEW,*       RESET WRITE FUNCTION
          RJ     COE
 UPD17    RJ     WOR
          REWIND NEW,R
          READ   NEW,R
          REWIND DB,R
          WRITE  DB,*        PRESET WRITE FUNCTION
 UPD18    READW  NEW,WSA,WSAL
          SX0    X1
          SB7    B6-WSA
          WRITEW DB,WSA,B7
          ZR     X0,UPD18    IF NO EOR/EOF/EOI
          NG     X0,UPD19    IF NOT AN EOR
          READ   NEW,R
          WRITER DB,R
          WRITE  DB,*        RESET WRITE FUNCTION
          EQ     UPD18       LOOP
 
 UPD19    UNLOAD DB,R
          UNLOAD NEW,R
          SA1    NEW+1       REMOVE RANDOM BIT FROM *NEW*
          MX0    13
          BX6    -X0*X1
          SA6    A1
 
*         UNLOAD NUMBERS/UPDATES UNLESS *UPDATE* OPTION CALLED.
 
          SA3    COPTION     LAST OPTION ENTERED BY USER
          SA2    =0LUPDATE
          BX2    X3-X2
          ZR     X2,UPDX     IF UPDATE OPTION THEN RETURN
          UNLOAD UPDATES,R
          UNLOAD NUMBERS,R
          CLEAR  NUMBERS     CLEAR FET POINTERS --- NUMBERS
          EQ     UPDX        RETURN
 
 
 UPDA     DATA   C* TAPE NUMBER FILE EMPTY.*
 UPDB     DATA   C* DATABASE CORRUPTED.*
 WOR      SPACE  4,15
**        WOR - WRITE OPLD RECORD.
*
*         ENTRY  OPLD WRITTEN ON *OPLDF*.
*
*         EXIT   OPLD RECORD WRITTEN.
*
*         USES   X - 0, 1, 6.
*                A - 1, 6.
*                B - 7.
*
*         MACROS READ, READW, REWIND, UNLOAD, WRITER, WRITEW.
 
 
 WOR      SUBR               ENTRY/EXIT
          WRITER OPLDF,R
          REWIND OPLDF,R
          WRITEW NEW,OPLDH,1
          SA1    DB+CFPN     GET FILE NAME
          MX0    42
          BX6    X0*X1
          SA6    INDXNAM
          SA6    CATBUF
          SA1    DATE
          LX1    6
          BX6    X1
          SA6    A6+B1
 
*         SET UP THE 7000 TABLE HEADER.
 
          SA1    INDXLEN
          SX1    X1+2
          MX0    3
          BX6    X1+X0
          SA6    CATBUF+16B
          WRITEW NEW,CATBUF,17B
 
*         READ THE OPLD TABLE AND WRITE IT.
 
          READ   OPLDF
 WOR1     READW  OPLDF,WSA,WSAL
          BX0    X1
          SB7    B6-WSA
          WRITEW NEW,WSA,B7
          ZR     X0,WOR1     NOT END OF OPLD ENTRIES
 
*         WRITE THE OPLD ENTRY WORD.
 
          SA1    INDXNAM
          SX6    10B
          BX6    X1+X6
          SA6    A1          REPLACE OPLD ENTRY
          WRITEW NEW,INDXNAM,2
          WRITER NEW,R
          UNLOAD OPLDF
          EQ     WORX        RETURN
 WRB      SPACE  4,25
**        WRB - WRITE PARTIAL TAPE BLOCK.
*
*         *WRB* COPIES A SPECIFIED NUMBER OF WORDS FROM THE PERMANENT
*         FILE BEING DUMPED TO THE CURRENT TAPE BLOCK BEING BUILT.
*         OPTIONALLY IT WILL ALSO WRITE THE CURRENT TAPE BLOCK TO
*         THE TAPE WHEN A SHORT PRU HAS BEEN READ.
*
*         ENTRY  (X1) = WORD COUNT OF DATA TO MOVE.
*                (X2) = SIZE OF FREE SPACE IN TAPE BLOCK.
*                (X3) = SHORT PRU FLAG--
*                     .EQ. 0 IF FULL PRU.
*                     .LT. 0 IF SHORT PRU.
*
*         EXIT   DATA COPIED INTO FREE SPACE IN TAPE BLOCK.
*                IF (X3) WAS NEGATIVE, THE TAPE BLOCK IS WRITTEN.
*
*         USES   X - 0, 1, 4, 6, 7.
*                A - 1, 4, 6, 7.
*                B - 3.
*
*         MACROS READO, READW, WRITEO, WRITEW.
 
 
 WRB      SUBR               ENTRY/EXIT
          SA4    BLOKHED     CURRENT TAPE BLOCK CONTROL WORD
          MX0    -9          WIDTH OF BLOCK SIZE
          BX6    -X0*X4      ISOLATE CURRENT BLOCK SIZE
          IX6    X6+X1       COMPUTE NEW BLOCK SIZE
          BX7    X0*X4       EXTRACT REST OF CONTROL WORD
          BX7    X7+X6       INSERT NEW SIZE
          SA7    A4
          SX6    X3          REMEMBER SHORT PRU FLAG
          SA6    WRBA
          SB3    X1          REMEMBER WORD COUNT
          SX1    WSA+NDMPWD  LWA+1 OF TAPE BLOCK BUFFER
          IX4    X1-X2       COMPUTE FWA OF FREE SPACE IN TAPE BLOCK
          READW  NEW,X4,B3   MOVE (WC) WORDS INTO FREE SPACE
          SA4    NOPRU       CHECK TO SEE IF NOT A FULL PRU
          NZ     X4,WRBX     IF NOT FULL PRU
          READO  NEW         GET PRU END CONTROL WORD
          MX0    12          WIDTH OF LEVEL NUMBER FIELD
          SA4    WRBA
          ZR     X4,WRBX     IF WAS A FULL PRU THEN RETURN
          BX6    X0*X6       ISOLATE LEVEL NUMBER OF PRU
          ZR     X6,WRB1     IF EOR LEVEL
          SX4    2           EOF TAPE BLOCK FLAG
          EQ     WRB2        JOIN WITH EOR CASE
 
 WRB1     SX4    1           EOR TAPE BLOCK
 WRB2     SA1    BLOKHED
          LX4    9           POSITION DATA BLOCK TYPE
          BX6    X1+X4       INSERT DATA BLOCK TYPE
          WRITEO TF          WRITE TAPE BLOCK CONTROL WORD
          SA4    BLOKHED
          MX0    -9
          BX4    -X0*X4      ISOLATE BLOCK SIZE
          SX6    DCW         RESET TAPE BLOCK CONTROL WORD
          SA6    A4
          WRITEW TF,WSA,X4   WRITE TAPE BLOCK
          EQ     WRBX        RETURN
 
 
 WRBA     BSS    1           SHORT PRU FLAG PARAMETER
 WRS      SPACE  4,15
**        WRS - WRITE SECTOR BOUNDED BY CONTROL WORDS.
*
*         *WRS* WRITES A PRU TO THE FILE BEING LOADED, BOUNDED BY
*         CONTROL WORDS.
*
*         ENTRY  (X5) = AMOUNT OF DATA TO WRITE FROM *SECTOR*.
*
*         EXIT   SECTOR WRITTEN.
*
*         USES   X - 2, 3, 4, 6.
*                A - 3.
*
*         MACROS WRITEO, WRITEW.
 
 
 WRS      SUBR               ENTRY/EXIT
          SX2    5           NUMBER OF BYTES IN A WORD
          IX4    X2*X5       COMPUTE BYTE COUNT OF PRU
          SA3    PRUHEAD     BLANK PRU HEADER
          BX6    X3+X4       BUILD PRU HEADER WITH BYTE COUNT
          WRITEO SF
          ZR     X5,WRS1     IF NO DATA IN PRU
          WRITEW SF,SECTOR,X5  WRITE DATA
 WRS1     WRITEW SF,EORWORD,1  WRITE EOR LEVEL WORD
          EQ     WRSX        RETURN
          TITLE  SECONDARY SUBROUTINES.
 CIT      SPACE  4,15
**        CIT - COPY ONE ITEM FROM ONE FILE TO ANOTHER.
*
*         ENTRY  (X2) = ADDRESS OF FET TO READ FROM.
*                (X5) = ADDRESS OF FET TO WRITE TO.
*
*         EXIT   ITEM COPIED.
*                *EORUN* SET IF ITEM COPIED WAS END OF A RUN.
*
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*
*         MACROS  GETITEM, PUTITEM.
 
 CIT2     NG     X1,CIT1     IF NEXT ITEM .LT. COPIED ITEM
 
 CIT      SUBR               ENTRY/EXIT
          SX6    X2          SAVE X FET ADDRESS
          SX7    X5          SAVE Y FET ADDRESS
          SA6    CITA
          SA7    CITB
          GETITEM  X2,CITC
          SA5    CITB
          PUTITEM  X5,CITC
          SA2    CITA
          SA1    X2+EOF      CHECK STATUS OF THIS FILE
          NZ     X1,CIT1     IF EOF(X)
          SA1    X2+PTR
          SA3    CITC
          SX6    B0+         CLEAR END OF RUN FLAG
          SA6    EORUN
          BX6    X1-X3
          IX1    X1-X3
          PL     X6,CIT2     IF SAME SIGN (NO OVERFLOW POSSIBLE)
          PL     X3,CITX     IF NEXT ITEM .GT. COPIED ITEM
 CIT1     SX6    B1+         SET END OF RUN FLAG
          SA6    EORUN
          EQ     CITX        RETURN
 
 
 CITA     BSS    1           INPUT FET ADDRESS
 CITB     BSS    1           OUTPUT FET ADDRESS
 CITC     BSS    ITEMSIZ     BLOCK FOR HOLDING COPIED ENTRY
 CRN      SPACE  4,15
**        CRN - COPY RUN OF ENTRIES BETWEEN FILES.
*
*         ENTRY  (X2) = FET READ FROM.
*                (X5) = FET WRITTEN TO.
*
*         EXIT   RUN COPIED FROM X2 FILE TO X5 FILE.
*
*         USES   X - 1, 2, 5, 6, 7.
*                A - 1, 2, 5, 6, 7.
*
*         MACROS  COPITEM.
 
 
 CRN      SUBR               ENTRY/EXIT
          SX6    X2          SAVE INPUT FET ADDRESS
          SX7    X5          SAVE OUTPUT FET ADDRESS
          SA6    CRNA
          SA7    CRNB
 
*         REPEAT COPYING ITEMS UNTIL END-OF-RUN.
 
 CRN1     SA2    CRNA
          SA5    CRNB
          COPITEM  X2,X5
          SA1    EORUN
          ZR     X1,CRN1     IF NOT END OF RUN BEING COPIED
          EQ     CRNX        RETURN
 
 
 CRNA     BSS    1           INPUT FET ADDRESS
 CRNB     BSS    1           OUTPUT FET ADDRESS
 DTR      SPACE  4,15
**        DTR - DISTRIBUTE RUNS FROM C ONTO A AND B.
*
*         ENTRY  ALL ENTRIES ARE ON *CF*.
*                ALL THREE FILES ARE READY TO GO.
*
*         EXIT   RUNS ARE DISTRIBUTED EVENLY BETWEEN *AF* AND *BF*.
*
*         USES   X - 1, 3.
*                A - 1, 3.
*
*         MACROS  COPYRUN.
 
 
 DTR      SUBR               ENTRY/EXIT
 
*         REPEAT COPY RUNS UNTIL EOF(C).
 
 DTR1     COPYRUN  CF,AF
          SA1    CF+EOF
          NZ     X1,DTR2     IF EOF(C)
          COPYRUN  CF,BF
          SA1    CF+EOF
 DTR2     ZR     X1,DTR1     IF NOT EOF(C)
          EQ     DTRX        RETURN
 GIT      SPACE  4,20
**        GIT - GET AN ITEM FROM A FILE.
*
*         *GIT* PERFORMS A PASCAL-LIKE READ FROM A FILE INTO
*         A SPECIFIED LOCATION.  THIS INVOLVES MOVING THE
*         CURRENT FILE POINTER VALUE INTO THE LOCATION AND
*         READING THE NEXT ENTRY FROM THE FILE INTO THE POINTER.
*
*         ENTRY  (X0) = FET ADDRESS.
*                (X5) = ITEM DESTINATION ADDRESS.
*                FILE POINTER HAS DESIRED ENTRY, OR BAD VALUE
*                IF THE FILE IS AT EOF.
*
*         EXIT   VALUE MOVED.
*                EOF FLAG SET IF NEXT READ FAILS.
*
*         USES   X - 6.
*                A - 6.
*
*         MACROS  MOVE, READW.
 
 
 GIT      SUBR               ENTRY/EXIT
          MOVE   ITEMSIZ,X0+PTR,X5
          READW  X0,X0+PTR,ITEMSIZ
          SX6    X1+         SET EOF FLAG APPROPRIATELY
          SA6    X2+EOF
          EQ     GITX        RETURN
 MRG      SPACE  4,20
**        MRG - MERGE PHASE OF MERGESORT.
*
*         *MRG* IS THE LOGICAL COMPLEMENT OF ROUTINE *DTR*.  *MRG*
*         MERGES ALL THE RUNS DISTRIBUTED ONTO *AF* AND *BF* AND
*         WRITES THEM ON *CF*.
*
*         ENTRY  *AF* AND *BF* HAVE ITEM RUNS.
*
*         EXIT   *AF* AND *BF* ARE EMPTY.
*                *CF* CONTAINS ALL RUNS.
*                NUMBER OF RUNS IS APPROXIMATELY CUT IN HALF.
*
*         USES   X - 1, 2, 3, 6.
*                A - 1, 2, 3, 6.
*
*         CALLS  MRN.
*
*         MACROS COPYRUN.
 
 
 MRG      SUBR               ENTRY/EXIT
 
*         WHILE NOT EOF(A) AND EOF(B) DO MERGERUN.
 
 MRG1     SA2    AF+EOF
          SA3    BF+EOF
          CX2    X2
          CX3    X3
          IX2    X2+X3       EOF(A) OR EOF(B)
          NZ     X2,MRG2     IF EITHER AT EOF THEN STOP
          RJ     MRN         MERGE ONE RUN ONTO C
          SA1    NRUNS
          SX6    1
          IX6    X1+X6       INCREMENT COUNT OF RUNS
          SA6    A1
          EQ     MRG1        LOOP FOR NEXT RUN TO MERGE
 
*         COPY REST OF A ONTO C.
 
 MRG2     SA2    AF+EOF
          NZ     X2,MRG3     IF EOF(A) THEN STOP
          COPYRUN  AF,CF
          SA1    NRUNS
          SX6    1
          IX6    X1+X6       INCREMENT COUNT OF RUNS
          SA6    A1
          EQ     MRG2        LOOP FOR NEXT RUN TO COPY
 
*         COPY REST OF B ONTO C.
 
 MRG3     SA3    BF+EOF
          NZ     X3,MRGX     IF EOF(B) THEN RETURN
          COPYRUN  BF,CF
          SA1    NRUNS       INCREMENT COUNT OF RUNS
          SX6    1
          IX6    X1+X6
          SA6    A1
          EQ     MRG3        LOOP FOR NEXT RUN TO COPY
 MRN      SPACE  4,15
**        MRN - MERGE ONE RUN FROM A AND B ONTO C.
*
*         ENTRY  AT LEAST ONE RUN IS ON *AF* AND ON *BF*.
*
*         EXIT   ONE FEWER RUN ON *AF* AND *BF*.
*                ONE MORE RUN ON *CF*.
*
*         USES   X - 1, 3, 4.
*                A - 1, 3, 4.
*
*         MACROS  COPITEM, COPYRUN.
 
 
 MRN      SUBR               ENTRY/EXIT
 
*         REPEAT COPYING ITEMS UNTIL END-OF-RUN.
 
 MRN1     SA3    AF+PTR
          SA4    BF+PTR
          BX1    X3-X4
          IX3    X4-X3
          PL     X1,MRN3     IF SAME SIGN (NO OVERFLOW POSSIBLE)
          NG     X4,MRN4     IF A.KEY  .LT.  B.KEY
 
*         A.KEY .GT. B.KEY.
 
 MRN2     COPITEM  BF,CF
          SA1    EORUN
          ZR     X1,MRN1     IF NOT END OF RUN ON B
          COPYRUN  AF,CF
          EQ     MRNX        RETURN
 
 MRN3     NG     X3,MRN2     IF A.KEY  .GT.  B.KEY
 
*         A.KEY .LE. B.KEY.
 
 MRN4     COPITEM  AF,CF
          SA1    EORUN
          ZR     X1,MRN1     IF NOT END OF RUN ON A
          COPYRUN  BF,CF
          EQ     MRNX        RETURN
 PIT      SPACE  4,10
**        PIT - WRITE AN ITEM TO A FILE.
*
*         ENTRY  (X2) = FET ADDRESS.
*                (X5) = ADDRESS OF ITEM TO WRITE.
*
*         MACROS  WRITEW.
 
 
 PIT      SUBR               ENTRY/EXIT
          WRITEW  X2,X5,ITEMSIZ
          EQ     PITX        RETURN
 RST      SPACE  4,15
**        RST - REWIND FILE AND PREPARE FOR READING.
*
*         *RST* REWINDS THE SPECIFIED FILE AND READS THE FIRST
*         ENTRY INTO THE FILE-S POINTER.
*
*         ENTRY  (X2) = FET ADDRESS.
*
*         EXIT   FILE REWOUND AND PARTIALLY READ
*                EOF FLAG SET IF FILE IS EMPTY.
*
*         USES   X - 6.
*                A - 6.
*
*         MACROS READ, READW, REWIND.
 
 
 RST      SUBR               ENTRY/EXIT
          REWIND X2,R
          READ   X2,R
          READW  X2,X2+PTR,ITEMSIZ
          SX6    X1+         NON-ZERO IF READW HIT EOR/EOF/EOI
          SA6    X2+EOF
          EQ     RSTX        RETURN
 RWR      SPACE  4,10
**        RWR - REWIND FILE AND PREPARE FOR WRITING.
*
*         ENTRY  (X2) = FET ADDRESS.
*
*         EXIT   FILE REWOUND, EOF FLAG SET ON.
*
*         USES   X - 6.
*                A - 6.
*
*         MACROS  REWIND, WRITE.
 
 
 RWR      SUBR               ENTRY/EXIT
          REWIND  X2,R
          WRITE  X2,*
          SX6    77B         FLAG FILE ALWAYS EOF
          SA6    X2+EOF
          EQ     RWRX        RETURN
          TITLE  COMMON DECKS.
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMCARM
*CALL     COMCCDD
*CALL     COMCCCE
*CALL     COMCCIO
*CALL     COMCCOD
*CALL     COMCCPM
*CALL     COMCDXB
*CALL     COMCLFM
*CALL     COMCMVE
*CALL     COMCPFM
*CALL     COMCPOP
*CALL     COMCRDC
*CALL     COMCRDO
*CALL     COMCRDS
*CALL     COMCRDW
*CALL     COMCSNM
*CALL     COMCSYS
*CALL     COMCUSB
*CALL     COMCWTC
*CALL     COMCWTH
*CALL     COMCWTO
*CALL     COMCWTS
*CALL     COMCWTW
*CALL     COMCZTB
          TITLE  FETS AND BUFFERS.
 FETS     SPACE  4,10
*         FETS.
 
 
 I        BSS    0           INPUT
 INPUT    FILEB  IBUF,IBUFL,(FET=8)
 
 O        BSS    0           OUTPUT
 OUTPUT   FILEB  OBUF,OBUFL,(FET=8)
 
 DB       BSS    0           DATABASE
 ZZZZZG0  FILEB  OLDBUF,OLDBUFL,(FET=15D)
 
 NUMBERS  BSS    0           FILE TO HOLD TAPE NUMBERS
 ZZZZZG4  FILEB  DIRBUF,DIRBUFL,(FET=11D)
 
 CF       BSS    0           MERGE SORT FILE
 ZZZZZG5  FILEB  CFBUF,CFBUFL,FET=MFETSIZ
 CFPTR    BSSZ   6
 CFEOF    BSSZ   1
 
 AF       BSS    0           MERGE SORT SCRATCH FILE ONE
 ZZZZZG8  FILEB  AFBUF,AFBUFL,FET=MFETSIZ
 AFPTR    BSSZ   6
 AFEOF    BSSZ   1
 
 BF       BSS    0           MERGE SORT SCRATCH FILE TWO
 ZZZZZG9  FILEB  BFBUF,BFBUFL,FET=MFETSIZ
 BFPTR    BSSZ   6
 BFEOF    BSSZ   1
 
 NEW      BSS    0           PERMANENT FILE BEING PROCESSED
 ZZZZZG1  FILEB  NEWBUF,NEWBUFL,(FET=16D),EPR
 
 TF       BSS    0           TAPE FILE
 TAPE     FILEB  TFBUF,TFBUFL,(FET=TFETSIZ)
          DATA   0           WRITTEN FLAG FOR PRIMARY TAPE
          DATA   0           CURRENT REEL VSN FOR PRIMARY TAPE
          DATA   0           CHARACTERISTICS - DENSITY, MEDIUM, ETC
          DATA   1           INITIAL REQUEST FLAG
          DATA   0           RING REQUIRED IF NON-ZERO
          DATA   0           MASS STORAGE FLAG
          DATA   0           DUMP VSN VARIABLE
          DATA   0           DUMP NAME VARIABLE
          DATA   0           DUMP LFN VARIABLE
 CFC      DATA   0           DUMP CURRENT FILE POSITION
 CRC      DATA   0           DUMP CURRENT RECORD POSITION
          DATA   0           DUMP CURRENT FILE NAME (RMS)
 
 MF       BSS    0           NEW TAPE FOR *COMPACT*
 NTAPE    FILEB  MFBUF,MFBUFL,(FET=TFETSIZ)
          DATA   0           WRITTEN FLAG FOR COMPACTED TAPE
          DATA   0           CURRENT REEL VSN FOR COMPACTED TAPE
          DATA   0           CHARACTERISTICS - DENSITY, MEDIUM, ETC
          DATA   1           INITIAL REQUEST FLAG
          DATA   0           RING REQUIRED IF NON-ZERO
          DATA   0           MASS STORAGE FLAG
          DATA   0           COMPACT VSN VARIABLE
          DATA   0           COMPACT NAME VARIABLE
          DATA   0           COMPACT LFN VARIABLE
 FILENUM  DATA   0           COMPACT CURRENT FILE POSITION
 RECNUM   DATA   0           COMPACT CURRENT RECORD POSITION
          DATA   0           COMPACT CURRENT FILE NAME (RMS)
 
 SF       BSS    0           SCRATCH FILE FOR COPY
 ZZZZZG2  FILEB  SFBUF,SFBUFL,(FET=16D)
 
 OPLDF    BSS    0           OPLD TEMPORARY STORAGE FILE
 ZZZZZG3  FILEB  RLDBUF,RLDBUFL
 
 UPDATES  BSS    0           UPDATES FILE
 ZZZZZG6  FILEB  TNBUF,TNBUFL
 
 CAT      BSS    0           CATLIST HOLDING FILE
 ZZZZZG7  FILEB  CLSBUF,CLSBUFL,(FET=10D)
          TITLE  PRS - PRESET ROUTINES.
          USE    PRESET
 PRS      SPACE  4,20
**        PRS - PRESET PROGRAM.
*
*         *PRS* CRACKS THE COMMAND LINE, CHECKS SYSTEM ORIGIN
*         PRIVILEGES AND ACCORDINGLY SETS UP THE APPROPRIATE HEADINGS
*         FOR OUTPUT.  IN ADDITION, IT CHECKS I/O ASSIGNMENT.
*
*         ENTRY  NONE.
*
*         EXIT   NONE.
*
*         USES   X - ALL.
*                A - ALL.
*                B - 2, 3, 6, 7.
*
*         CALLS  ARM, DXB, POP, RSP, STF, USB, ZAP.
*
*         MACROS ABORT, CLOCK, CSET, DATE, EREXIT, GETCN, GETJO,
*                GETPFP, JDATE, MESSAGE, MEMORY, PDATE, READ, SETLOF,
*                SYSTEM, WRITE, WRITEC.
 
 
 RECLAIM  SB1    1
          MEMORY CM,MEMORY,R,RFL=  SET/GET FL (FOR BACK LEVEL SUPPORT)
          REPRIEVE  RPVBLK,SETUP,233B  SET REPRIEVE MASKS
 
*         CRACK COMMAND LINE.
 
          SB2    CCDR        ADDRESS OF CONTROL CARD IMAGE
          RJ     USB         UNPACK CONTROL CARD TO STRING BUFFER
          SB6    USBB        SET ADDRESS OF STRING BUFFER
          RJ     POP         PICK OFF *RECLAIM* VERB
          NG     B6,PRS15    IF *POP* DETECTED AN ERROR
          ZR     B6,PRS1     IF *POP* FOUND A TERMINATOR
          SB3    CCART       SET CONTROL CARD ARGUMENT TABLE
          RJ     ARM         PROCESS ARGUMENTS
          NZ     X1,PRS15    IF *ARM* DETECTED AN ERROR
 PRS1     SX2    23B         SET EOR STATUS IF *I=* OR *L=*
          SA1    I           INPUT FET
          MX0    6*7
          BX6    X0*X1
          BX6    X2+X6       ADD BINARY AND COMPLETE BITS
          SA6    A1          REPLACE IT
          SA1    O           OUTPUT FET
          BX6    X0*X1
          ZR     X6,PRS2     IF *L=0*
          BX6    X2+X6       MERGE BINARY AND COMPLETE BITS
          SA6    A1          REPLACE IT
 PRS2     SA0    I           SET FET ADDRESS FOR R4 *ZAP*
          SX2    I           SET FET ADDRESS FOR R5 *ZAP*
          SX0    USBB        SET BUFFER ADDR FOR R4 *ZAP*
          SA1    CCIN        COMMAND LINE INPUT FLAG SET BY *ARM*
          ZR     X1,PRS3     IF *Z* ARGUMENT NOT GIVEN
          RJ     ZAP         *Z* ARGUMENT PROCESSOR
 PRS3     DATE   DATE
          CLOCK  TIME
          SA4    CCART       SET ARGUMENT TABLE ADDRESS
          SB6    TKPR        KEYWORD TABLE ADDRESS
          SA5    CCDR        COMMAND LINE IMAGE
          SB2    B0+         NO SPECIAL SKIP
          RJ     RSP         REMOVE PASSWORD FROM COMMAND LINE
          MESSAGE  CCDR,0    ISSUE COMMAND LINE TO DAYFILE
          PDATE  CATSKL      GET PACKED DATE AND TIME
          MX0    -36
          SA2    CATSKL
          BX2    -X0*X2
          SB7    FCUD
 PRS3.1   SA1    CATSKL+B7
          BX1    X0*X1
          BX6    X1+X2
          SA6    A1          STORE PACKED DATE/TIME IN PFC SKELETON
          SB7    B7-1
          NE     B7,B1,PRS3.1  IF NOT FINISHED STORING DATE/TIME
          SX6    B1+
          SA6    RBPF        SET BYPASS FLAG
          GETCN  CATSKL+FCCN  SAVE CHARGE/PROJECT FOR LOCAL FILE DUMPS
          SX6    B0+
          SA6    RBPF        CLEAR BYPASS FLAG
          GETPFP OLDBUF
          SA1    OLDBUF+2    SAVE USER NAME
          MX0    42
          BX6    X0*X1
          SA6    UND
          SA6    UNV
          BX6    -X0*X1
          SA6    CATSKL+FCUI  SAVE USER INDEX FOR LOCAL FILE DUMPS
          SA1    OLDBUF+1    SAVE PACK NAME
          BX6    X1
          SA6    HDRPN
          SA1    OLDBUF      SAVE FAMILY NAME
          BX6    X1
          SA6    FAMILY
 
*         CONVERT TODAYS DATE TO PACKED JULIAN.
 
          JDATE  DUMPDT      *DUMP* DATE
          SB7    B1
          MX0    30D
          SA5    DUMPDT
          LX5    30D
          BX5    X0*X5
          RJ     DXB         CONVERT DISPLAY TO BINARY
          SA6    DUMPDT
 
*         CHECK IF TMS IS ACTIVE.
 
          SX6    B1+         SET BYPASS FLAG
          SA6    RBPF
          SYSTEM SFM,R,TMSTAT,GTSF*100B
          SA2    RBPF        CHECK BYPASS FLAG
          BX6    X6-X6       PRESET FOR TMS NOT ACTIVE
          SA6    A2          CLEAR BYPASS FLAG
          SA1    TMSTAT
          ZR     X2,PRS3.2   IF PRE-TMS SYSTEM
          MX6    1
          BX6    X1*X6       TMS ACTIVE BIT
          LX1    59-58
          BX6    X1*X6       TMS BINARIES BIT
 PRS3.2   SA6    A1          SET TMS STATUS
 
*         DETERMINE JOB ORIGIN TYPE.
 
          GETJO  JOBORIG
          SA1    JOBORIG
          SX0    1           GIVE SPECIAL PERMISSION FOR SYOT
          SX7    HEADER0
          SX2    X1-SYOT
          ZR     X2,PRS7     IF SYSTEM ORIGIN THEN SET FULL LIST
          SX1    X1-IAOT
          NZ     X1,PRS4     IF THIS JOB IS NOT INTERACTIVE
          CSET   NORMAL
          SX6    B1+         INDICATE CHARACTER SET MODE CHANGED
          SA6    RECSET
 
*         CHECK FOR SPECIAL PRIVILEGES.
 
 PRS4     SX7    HEADER0     HEADER LENGTH
          SA1    USERDB
          SX0    B1          ALLOW FULL ACCESS TO USER DATABASE
          NZ     X1,PRS7     IF USER DATABASE
          SX0    B0          RESTRICT ACCESS TO SITE DATABASE
          BX6    X6-X6
          SA6    PRIVARG     TERMINATE LIST OF ALLOWED ARGUMENTS
          SX7    X7-3
          EQ     PRS8        SET ACCESS LEVEL
 
*         BUILD HEADER FOR PRIVILEGED USERS.
 
 PRS7     SA1    HEAD2
          SX2    2R U
          BX6    X1+X2
          SA6    A1          SET HEADER
 
*         SET ACCESS LEVEL AND HEADER SIZE.
 
 PRS8     BX6    X0          FLAG FOR SPECIAL ACCESS
          SA7    HLENGTH
          SA6    ACCESS
 
*         CHECK FOR TERMINAL FILES.
 
          SA1    CCIN
          NZ     X1,PRS8.1   IF INPUT IS FROM COMMAND LINE
          SX2    I
          RJ     STF         CHECK FOR INPUT FILE DISPOSITION
          SA6    IDT
          ZR     X6,PRS8.1   IF INPUT IS A TERMINAL FILE
          READ   I           READ FIRST PART OF DISK INPUT FILE
 PRS8.1   WRITE  O,*         PRESET WRITE FUNCTION
          SX2    O           CHECK OUTPUT FILE EQUIPMENT TYPE
          RJ     STF
          SA6    ODT
          MX0    42
          NZ     X6,PRS8.2   IF OUTPUT NOT ASSIGNED TO *TTY*
 
*         REMOVE *PAGE* FROM HEADER IF *TTY* ASSIGNED.
 
          SA1    OPTION      10 SPACES
          BX6    X1
          SA6    HEAD1.0
          SETLOF LOFPTR      SET LIST-OF-FILES ADDRESS
          EQ     PRS9        SET UP DATABASE USER NAME
 
*         SET PRINT PARAMETERS IF NOT TERMINAL OUTPUT.
 
 PRS8.2   GETPP  OBUF,MLPP,PRSB  GET PAGE LENGTH AND PRINT DENSITY
          WRITEC O,PRSB      SET PRINT DENSITY
          WRITEC O,PRSC      ISSUE INITIAL PAGE EJECT
 
*         SET UP DATABASE FILE PARAMETERS.
 
 PRS9     SA1    NDBPW
          BX0    X1
          SA1    NDBPN
          BX6    X1
          SA1    DEFPW
          BX7    X1
          SA2    DEFUN
          SA3    NDBUN
          SA4    DEFNAM
          SA5    NDBNAM
          SA1    USERDB
          NZ     X1,PRS10    IF USER DATABASE IS REQUESTED
          SA1    ACCESS      CHECK FOR PRIVILEGED ACCESS
          NZ     X1,PRS9.1   IF SPECIAL ACCESS ALLOWED
          NZ     X3,PRS15    IF *UN* PARAMETER IS USED
          NZ     X5,PRS15    IF *DB* PARAMETER IS USED
          NZ     X6,PRS15    IF *PN* PARAMETER IS USED
          NZ     X0,PRS15    IF *PW* PARAMETER IS USED
          SA1    NDBR
          NZ     X1,PRS15    IF *R* PARAMETER IS USED
 PRS9.1   SA1    DEFPN       GET DEFAULT PACK NAME
          EQ     PRS10.2     CHECK IF PACK NAME SPECIFIED
 
 PRS10    BX1    X2-X3
          NZ     X1,PRS10.1  IF DEFAULT USER NAME NOT SPECIFIED
          BX1    X4-X5
          ZR     X1,PRS15    IF DEFAULT FILE NAME IS SPECIFIED
 PRS10.1  BX7    X7-X7       CLEAR DEFAULT PASSWORD
          BX2    X2-X2       CLEAR DEFAULT USER NAME
          SX1    B0+         CLEAR DEFAULT PACK NAME
 PRS10.2  ZR     X6,PRS11    IF PACK NAME NOT SPECIFIED
          SA1    NDBR        GET DEVICE TYPE IF SPECIFIED
          NZ     X1,PRS10.3  IF DEVICE TYPE IS SPECFIED
          SA1    DEFR        DEFAULT DEVICE TYPE
 PRS10.3  BX1    X1-X6       EXCHANGE DEVICE TYPE AND PACK NAME
          BX6    X6-X1       DEVICE TYPE
          BX1    X1-X6       PACK NAME
 PRS11    SA6    RDT         SAVE DEVICE TYPE
          ZR     X3,PRS12    IF USER NAME NOT SPECIFIED
          SA2    UND         CHECK THE CURRENT USER NAME
          BX2    X2-X3
          ZR     X2,PRS12    IF CURRENT USER NAME IS SPECIFIED
          BX2    X3
 PRS12    BX6    X2
          SA6    DBUN
          BX6    X1          SAVE PACK NAME TO BE USED
          SA6    DBPN
          BX6    X4
          ZR     X5,PRS13    IF FILE NAME NOT SPECIFIED
          BX6    X5
          LX5    6
          SX5    X5-1R0
          NZ     X5,PRS13    IF NOT DB=0
          SX6    B0+
 PRS13    SA6    DBNAM
          ZR     X0,PRS14    IF PASSWORD NOT SPECIFIED
          BX7    X0
 PRS14    SA7    DBPW
          EQ     MAIN        ENTER MAIN LOOP
 
 PRS15    SA4    CCART
          SB6    TKPR
          SA5    CCDR
          SB2    B0+
          RJ     RSP         REMOVE PASSWORD FROM CONTROL CARD
          MESSAGE  CCDR,0,R  ISSUE CONTROL CARD TO DAYFILE
          MESSAGE  PRSA,3    * RECLAIM ARGUMENT ERROR.*
          WRITEC O,PRSA
          EQ     ABT1        ABORT *RECLAIM*
 
 
 PRSA     DATA   C* RECLAIM ARGUMENT ERROR.*
 PRSB     DATA   1LS         PRINT DENSITY FORMAT EFFECTOR
 PRSC     DATA   1L1         PAGE EJECT FORMAT EFFECTOR
          TITLE  OPTIONS.
          SPACE  4,10
*         OPTION TABLES.
          SPACE  4,10
*         COMMAND OPTION TABLE.
 
 CCART    BSS                          COMMAND OPTION TABLE
 I        ARG    0,I,0,1               INPUT FILE NAME
 L        ARG    0,O,0,1               OUTPUT FILE NAME
 Z        ARG    -NOEQV,CCIN,0,1       *Z* INPUT FLAG
 NA       ARG    -NOEQV,NAP,0,1        NO ABORT ON TRIVIAL ERRORS
 NH       ARG    -NOEQV,NHV,0,1        NO HEADER ON OUTPUT
 NV       ARG    -NOEQV,NVV,0,1        NO VALIDATION OF DUMP FILE
 T        ARG    0,NUMBERS,0,1         FILE WITH VSN-S FOR UPDATE
 DB       ARG    0,NDBNAM,400B,1
 UN       ARG    0,NDBUN,0,1           OWNER OF DATABASE
 PN       ARG    0,NDBPN,400B,1        PACK NAME OF DATABASE
 R        ARG    0,NDBR,400B,1         DEVICE TYPE OF DATABASE
 PW       ARG    0,NDBPW,0,1           PASSWORD OF DATABASE
 S        ARG    -SITEDB,USERDB,0,1    SITE/USER DATABASE FLAG
          CON    0                     ARGUMENT LIST TERMINATOR
          SPACE  4,10
*         TABLE OF SECURE KEYWORDS.
 
 TKPR     BSS    0           TABLE OF KEYWORDS TO REMOVE
          DATA   0LPW        PASSWORD
          CON    0           END OF TABLE
          SPACE  4,10
*         DATABASE FILE PARAMETERS FROM COMMAND LINE.
 
 NDBUN    BSSZ   1           NEW DATABASE USER NAME
 NDBPN    BSSZ   1           NEW DATABASE PACK NAME
 NDBR     BSSZ   1           NEW DATABASE DEVICE TYPE
 NDBNAM   BSSZ   1           NEW DATABASE FILE NAME
 NDBPW    BSSZ   1           NEW DATABASE PASSWORD
          SPACE  4,10
*         DEFAULT DATABASE FILE PARAMETERS.
 
 DEFUN    DATA   0LSYSTEMX   DEFAULT USER NAME
 DEFPN    DATA   0           DEFAULT PACK NAME (CURRENT PACK)
 DEFR     DATA   0           DEFAULT DEVICE TYPE (SYSTEM DEFAULT)
 DEFNAM   DATA   0LRECLDB    DEFAULT FILE NAME
 DEFPW    DATA   0LARPASS    DEFAULT PASSWORD
          SPACE  4,10
*         PRESET COMMON DECKS.
 
 
*CALL     COMCRSP
*CALL     COMCSTF
*CALL     COMCZAP
          SPACE  4,10
*         BUFFERS.
 
          USE    BUFFERS
 
 BEGIN    BSSN   RECLAIM
 OBUF     BSSN   OBUFL       OUTPUT BUFFER
 DIRBUF   BSSN   DIRBUFL     *NUMBERS*, MERGESORT BUFFER
 AFBUF    EQU    DIRBUF      REUSE DIRBUF FOR MERGESORT SCRATCH ONE
 IBUF     BSSN   IBUFL       INPUT BUFFER
 OLDBUF   BSSN   OLDBUFL     DATABASE IN/SORT1 SCRATCH BUFFER
 TFBUF    BSSN   TFBUFL      PRIMARY DUMP FILE BUFFER
 MFBUF    BSSN   MFBUFL      *COMPACT* DUMP FILE BUFFER
 SFBUF    EQU    MFBUF       REUSE MFBUF FOR LOAD FILE BUFFER
 NEWBUF   EQU    MFBUF       REUSE MFBUF FOR DATABASE OUT BUFFER
 TNBUF    BSSN   TNBUFL      *UPDATES* BUFFER
 BFBUF    EQU    TNBUF       REUSE TNBUF FOR MERGESORT SCRATCH TWO
 CFBUF    BSSN   CFBUFL      MERGESORT BUFFER
 WSA      BSSN   WSAL        WORKING STORAGE BUFFER
 RLDBUF   BSSN   RLDBUFL     *OPLDF* BUFFER
 PRMITH   BSSN   1           PERMIT HEADER
 CATBUF   BSSN   TCATBFL     CATLIST BUFFER
 CLSBUF   BSSN   CLSBUFL     FILE *CATLIST* BUFFER
 PFTAB    BSSN   PFTABL+5    PERMANENT FILE NAMES TABLE
 NNTAB    BSSN   PFTABL+5    STORAGE FOR NEW NAMES
 
*         THE FOLLOWING MUST BE THE LAST STORAGE DEFINITION BECAUSE THE
*         PERMIT BUFFER IS EXTENDED ON A *LOAD* BY INCREASING THE JOB
*         FIELD LENGTH.
 
 PRMITB   BSSN   PRMITBL     PERMIT BUFFER
 RFL=     BSSN   0           SET INITIAL FIELD LENGTH
 END      BSSN
 
 
 SDM=     EQU    0           SUPPRESS SYSTEM-ISSUED DAYFILE MESSAGE
          SPACE  4,10
*         OVERFLOW CHECK.
 
 
          USE    PRESET
          ERRPL  *-IBUF      PRESET OVERFLOWS INTO INPUT BUFFER
          SPACE  4
          END    RECLAIM
Retro1.org codex

Table of Contents

RECLAIM

Table Of Contents

Source Code
