Retro1.org codex

          IDENT  GENPFD,ORIG 
          ABS
          SST
          ENTRY  GENPFD
          ENTRY  RFL=
          SYSCOM B1
          TITLE  GENPFD - PERMANENT FILE ARCHIVE SELECTION UTILITY.
*COMMENT  GENPFD - PERMANENT FILE ARCHIVE SELECTION UTILITY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 GENPFD   SPACE  4,10
***       GENPFD - PERMANENT FILE ARCHIVE SELECTION UTILITY.
*
*         R. E. DUNBAR.      87/02/01.
          SPACE  4,10
***       *GENPFD* IS A UTILITY TO GENERATE A *PFDUMP* DIRECTIVE FILE.
*
          SPACE  4,20
***       COMMAND FORMAT.
*
*
*         GENPFD(P1,P2,...,PN)
*                OR
*         GENPFD(P1,P2,...,PN)/DIR1,DIR2,...,DIRN.
*
*
*         *PN* MAY BE ONE OF THE FOLLOWING -
*
*         PARAMETER          DESCRIPTION
*         ---------          -----------
*
*         I=IFILE            LOCAL FILE NAME OF THE INPUT DIRECTIVE
*                            FILE.  THE DEFAULT NAME IS *INPUT*.
*
*         L=OFILE            LOCAL FILE NAME OF THE OUTPUT LISTING
*                            FILE.  THE DEFAULT NAME IS *OUTPUT*.
*
*         PO=POPT            PROCESSING OPTION.
*
*                            PO=R.  SELECT FILES TO BE RELEASED.
*                            PO=D.  SELECT FILES TO BE DESTAGED.
*
*         U=UNITS            DESTAGE LIMIT/THRESHOLD UNIT OF MEASURE.
*
*                            U=FT.  MEASURED IN FEET OF TAPE.
*                            U=MB.  MEASURED IN MEGABYTES.
*                            THE DEFAULT IS *U=FT*.
*
*         S=PFILE            LOCAL FILE NAME OF THE SUMMARY FILE.
*                            THE DEFAULT NAME IS *SUMMARY*.
*
*         UD=DFILE           LOCAL FILE NAME OF THE PERMANENT FILE
*                            UTILITY DIRECTIVE FILE.  THE DEFAULT
*                            NAME IS *UDIR*.
*
*         Z                  INDICATES DIRECTIVES ARE TO BE TAKEN FROM
*                            COMMAND LINE.  DEFAULT IS FROM *INPUT*.
*
*                            GENPFD(...Z...)/DIR/DIR/DIR
*                                      / IS ANY CHARACTER NOT IN *DIR*.
          SPACE  4,20
***       *DIRN*  MAY BE ONE OF THE FOLLOWING -
*
*
*         *DIRN*             DESCRIPTION
*         ------             -----------
*
*
*         D,DENSITY.         THE DENSITY THAT WILL BE USED FOR THE
*                            ARCHIVE DUMP TAPE.  THE DEFAULT IS *GE*.
*                            THE FOLLOWING DENSITIES ARE RECOGNIZED.
*
*          7 TRACK (MT)         9 TRACK (NT)         CARTRIDGE (CT/AT)
*         D=LO   200 CPI      D=HD     800 CPI      D=CE     38000 CPI
*         D=HI   556 CPI      D=PE    1600 CPI      D=AE     38000 CPI
*         D=HY   800 CPI      D=GE    6250 CPI      D=38000  38000 CPI
*         D=200  200 CPI      D=1600  1600 CPI
*         D=556  556 CPI      D=6250  6250 CPI
*
*         DL,LIMIT.          TOTAL LENGTH OF ARCHIVE DUMP, IN FEET OF
*                            TAPE IF *U=FT*, OR IN MEGABYTES IF *U=MB*.
*                            FOR TAPE, *DL* IS USED IN CONJUNCTION WITH
*                            *D* IN CALCULATING WHETHER A FILE WILL
*                            FIT ON THE DUMP SET.  THE DEFAULT FOR
*                            *MT* OR *NT* TAPE IS 2200 FEET, ALLOWING
*                            A SIGNIFICANT NUMBER OF RECOVERED ERRORS
*                            ON A 2400 FOOT REEL.  THE DEFAULT LENGTH
*                            FOR *CT* OR *AT* TAPE IS 500 FEET; A
*                            CARTRIDGE CONTAINS 530 FEET OF TAPE.  THE
*                            DEFAULT SIZE FOR OPTICAL DISK IS 102MB.
*
*         DT,THRESHOLD.      MINIMUM LENGTH OF ARCHIVE DUMP, IN FEET OF
*                            TAPE IF *U=FT*, OR IN MEGABYTES IF *U=MB*.
*                            IF SELECTED FILES WOULD FILL LESS THAN THE
*                            SPECIFIED MINIMUM SPACE, NO PERMANENT FILE
*                            UTILITY DIRECTIVE FILE WILL BE WRITTEN.
*                            THE DEFAULT IS NINETY PERCENT OF THE VALUE
*                            OF *DL*.
*
*         F,FORMAT.          FORMAT IN WHICH THE ARCHIVE TAPE IS TO BE
*                            RECORDED.  ACCEPTABLE VALUES ARE *I* AND
*                            *LI*.  THE DEFAULT IS *I* FORMAT.
*
*         PG,PR1,PR2,PR3.    PRIORITY GROUPS, BASED ON THE MNEMONIC FOR
*                            PREFERRED RESIDENCE.  CODES D, L, M, N AND
*                            T ARE GROUPED IN 1 TO 5 GROUPS IN ORDER OF
*                            THEIR PRIORITY FOR ARCHIVING.
*
*         RL,DN,TRACKS.      DEFINES THE NUMBER OF AVAILABLE TRACKS
*         RL,DT,TRACKS.      GOAL FOR THE SPECIFIED DEVICE NUMBER OR
*                            FOR EACH DEVICE OF THE SPECIFIED DEVICE
*                            TYPE.  A *TRACKS* VALUE SPECIFIED FOR A
*                            DEVICE NUMBER TAKES PRECEDENCE OVER ONE
*                            SPECIFIED FOR A DEVICE TYPE WHEN BOTH
*                            ARE APPLICABLE.
*
*         SF,UI,F1,F2,..FN.  SELECT FILES FOR USER INDEX *UI*, FILE
*         SF,UI.             NAMES *F1* THROUGH *FN*.  IF *F1*...*FN*
*                            ARE OMITTED, SELECT ALL FILES FOR USER
*                            INDEX *UI*.
*
*         SV,V1,V2,..VN.     SELECT FILES WHOSE CATALOG ENTRIES SHOW
*                            ALTERNATE VSN-S WHICH MATCH TO ANY OF THE
*                            *V1* THROUGH *VN* VALUES.
*
*         XF,UI,F1,F2,..FN.  EXCLUDE FILES FOR USER INDEX *UI*, FILE
*         XF,UI.             NAMES *F1* THROUGH *FN*.  IF *F1*...*FN
*                            ARE OMITTED, EXCLUDE ALL FILES FOR USER
*                            INDEX *UI*.
          TITLE  DAYFILE MESSAGES.
          SPACE  4,20
***       DAYFILE MESSAGES.
*
*         * DIRECTIVE ARGUMENT ERROR.* - *GENPFD* DETECTED AN ERROR IN
*                AN INPUT DIRECTIVE.  THIS COULD BE A BAD SEPARATOR,
*                AN INCORRECT VALUE, TOO MANY VALUES, ETC.
*
*         * DN = NN,  FILE TRACK COUNT = XXXXXXXXX.* - FOR DEVICE NN,
*                SPECIFIED VIA *RL* DIRECTIVE, FILES REPRESENTING THE
*                EQUIVALENT OF X..X TRACKS WERE SELECTED.
*
*         * DT = TTT, FILE TRACK COUNT = XXXXXXXXX.* - FOR DEVICE TYPE
*                TTT, SPECIFIED VIA *RL* DIRECTIVE, FILES REPRESENTING
*                THE EQUIVALENT OF X..X TRACKS WERE SELECTED.
*
*         * DUMP THRESHOLD NOT REACHED.* - TOO FEW FILES QUALIFIED FOR
*                SELECTION.
*
*         * FEET OF DUMP TAPE REQUIRED = XXXXXXXXX.* - FILES SPECIFIED
*                BY THE UTILITY DIRECTIVES GENERATED BY *GENPFD* WILL
*                FILL X..X FEET OF TAPE AT THE SELECTED DENSITY.
*
*         * FILES SELECTED FOR PPPPPPP = XXXXXXXXX.* - *GENPFD* WROTE
*                UTILITY DIRECTIVES FOR X..X FILES TO THE *UD* FILE.
*                P..P IS EITHER *DESTAGE* OR *RELEASE*, DEPENDING ON
*                THE *PO=* OPTION SPECIFIED ON THE *GENPFD* COMMAND.
*
*         * FIRST SELECTION FILE COUNT = XXXXXXXXX.* - X..X FILES WERE
*                QUALIFIED BY SELECTED USER INDEX/FILE NAME, SELECTED
*                ARCHIVE VSN, OR PREFERRED RESIDENCE AND RELEASE DEVICE
*                RESIDENCE TO BE PRIORITIZED FOR FINAL SELECTION.
*
*         * GENPFD ABORTED.* - *GENPFD* HAS DETECTED AN ERROR OR
*                THE USER HAS INITIATED AN ABORT.
*
*         * GENPFD ARGUMENT ERROR.* - AN INCORRECT ARGUMENT WAS
*                DETECTED ON THE *GENPFD* COMMAND.
*
*         * GENPFD COMPLETE.* - NORMAL COMPLETION.
*
*         * INCORRECT ARGUMENT VALUE.* - A VALUE ENTRY ON A DIRECTIVE
*                IS NOT VALID FOR THAT DIRECTIVE.  THIS COULD BE A NAME
*                LONGER THAN SEVEN CHARACTERS, AN ALPHABETIC STRING
*                WHEN A NUMBER IS EXPECTED, ETC.
*
*         * MAXIMUM TOTAL FEET OF TAPE = XXXXXXXXX.* - FILES QUALIFYING
*                FOR FINAL SELECTION WOULD OCCUPY X..X FEET OF TAPE AT
*                THE SELECTED DENSITY IF THEY WERE ALL SELECTED.
*
*         * MAXIMUM TOTAL MEGABYTES    = XXXXXXXXX.* - FILES QUALIFYING
*                FOR FINAL SELECTION WOULD OCCUPY X..X MEGABYTES IF
*                THEY WERE ALL SELECTED.
*
*         * MEGABYTES REQUIRED FOR DUMP= XXXXXXXXX.* - FILES SPECIFIED
*                BY THE UTILITY DIRECTIVES GENERATED BY *GENPFD* WILL
*                FILL X..X MEGABYTES.
*
*         * NO FILES SELECTED FOR PPPPPPP.* - EITHER NO FILES MET THE
*                SELECTION CRITERIA OR NONE OF THE SELECTED FILES CAN
*                BE DUMPED WITHOUT EXCEEDING THE *DL* MAXIMUM.
*                P..P IS EITHER *DESTAGE* OR *RELEASE*, DEPENDING ON
*                THE *PO=* OPTION SPECIFIED ON THE *GENPFD* COMMAND.
*
*         * SELECTION FILE DEVICE NUMBER ERROR.* - PROGRAM ERROR - A
*                DEVICE NUMBER NOT IN THE CATALOG DEVICE TABLE
*                WAS FOUND IN A RECORD DURING FINAL SELECTION.
*
*         * SUFFICIENT TRACKS ALREADY AVAILABLE.* - THE *TRACKS* GOAL
*                SPECIFIED ON THE *RL* DIRECTIVE IS ALREADY AVAILABLE
*                ON THE DESIGNATED DEVICE(S).
*
*         * SUMMARY FILE IS EMPTY OR MISPOSITIONED.* - END OF
*                FILE OR END OF RECORD WAS DETECTED ON THE FIRST READ
*                OF THE SUMMARY FILE.
*
*         * SUMMARY FILE PREFIX TABLE ERROR.* - NO PREFIX TABLE
*                RECORD WAS FOUND ON THE SUMMARY FILE.
*
*         * TOO MANY DEVICE SELECTION (RL) ENTRIES.* - THE SIZE OF THE
*                *TSDV* TABLE WAS EXCEEDED.  THERE ARE TOO MANY *RL*
*                DIRECTIVES.
*
*         * TOO MANY FILE/VSN SELECTION (SF SV XF) ENTRIES.* - THE SIZE
*                OF THE *TSFV* TABLE WAS EXCEEDED.  THERE ARE TOO MANY
*                *SF*, *SV*, AND/OR *XF* DIRECTIVE ENTRIES.
*
*         * TOO MANY PRIORITY GROUP (PG) ENTRIES.* - THE SIZE OF THE
*                *TPRG* TABLE WAS EXCEEDED.  THERE ARE TOO MANY ENTRIES
*                ON THE *PG* DIRECTIVE.
*
*         * *WARNING* - FILE(S) LARGER THAN *DL* LIMIT.* - *GENPFD*
*                ENCOUNTERED AND SKIPPED ONE OR MORE FILES LARGER THAN
*                THE LIMIT SPECIFIED ON THE *DL* DIRECTIVE.
          TITLE  COMMON DECKS.
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMCCMD
*CALL     COMCMAC
*CALL     COMSPFM
*CALL     COMSRPV
          TITLE  ASSEMBLY CONSTANTS.
          SPACE  4,10
****      ASSEMBLY CONSTANTS.
 
 
*         SUMMARY FILE RECORD SIZES.
 
 SFPTL    EQU    16B         SUMMARY FILE PREFIX TABLE LENGTH
 SFSHL    EQU    13B         SUMMARY FILE SYSTEM RECORD HEADER LENGTH
 SFSIL    EQU    0           SUMMARY FILE SYSTEM RECORD ITEM LENGTH
 SFDHL    EQU    2           SUMMARY FILE DEVICE RECORD HEADER LENGTH
 SFDIL    EQU    2           SUMMARY FILE DEVICE RECORD ITEM LENGTH
 SFFHL    EQU    0           SUMMARY FILE CATALOG ENTRY HEADER LENGTH
 SFFIL    EQU    21B         SUMMARY FILE CATALOG ENTRY ITEM LENGTH
 
 DLMB     EQU    102         MEGABYTES DEFAULT FOR *DL* DIRECTIVE.
 DLDF     EQU    2200        DEFAULT FOR *DL* DIRECTIVE (*MT*/*NT*)
 DLDFC    EQU    500         DEFAULT FOR *DL* DIRECTIVE (*CT*/*AT*)
 DTDF     EQU    90          *DT* DEFAULT PERCENT OF *DL* VALUE
 ITEML    EQU    3           LENGTH OF PRIORITY SORT ITEM RECORD
 MFETL    EQU    6           FET SIZE FOR MERGE/SORT FILES
 PBYT     EQU    480         NUMBER OF 8-BIT BYTES PER PRU
 MPRU     EQU    2083        NUMBER OF SECTORS PER MEGABYTE
 RPTR     EQU    MFETL       RECORD POINTER FOR MERGE/SORT FILES
 EOF      EQU    RPTR+ITEML  END OF FILE FLAG FOR MERGE/SORT FILES
 TCDVE    EQU    2           TABLE OF CATALOG DEVICES ENTRY SIZE
 TCDVN    EQU    120B        TABLE OF CATALOG DEVICES ENTRIES
 TSDVE    EQU    2           TABLE OF SELECTED DEVICES ENTRY SIZE
 TSDVN    EQU    120B        TABLE OF SELECTED DEVICES ENTRIES
 TSFVE    EQU    1           TABLE OF SELECTED FILES/VSN-S ENTRY SIZE
 TSFVN    EQU    1000        TABLE OF SELECTED FILES/VSN-S ENTRIES
 
*         BUFFER SIZE DEFINITIONS.
 
 IBUFL    EQU    201B        INPUT BUFFER LENGTH
 OBUFL    EQU    201B        OUTPUT BUFFER LENGTH
 SBUFL    EQU    1001B       SUMMARY FILE BUFFER LENGTH
 SMBFL    EQU    1001B       SELECTION/MERGE SORT BUFFER LENGTH
 UBUFL    EQU    201B        UTILITY DIRECTIVES BUFFER LENGTH
 WSAL     EQU    1000B       WORKING STORAGE BUFFER LENGTH
          TITLE  MACRO DEFINITIONS.
          SPACE  4,10
*         MACRO DEFINITIONS USED FOR MERGESORT.
 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.
*                *ERUN* 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
 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
 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
 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
          TITLE  TABLES.
 ORIG     SPACE  4,10
          ORG    110B
 ORIG     EQU    *           PROGRAM ORIGIN
 ITEM     SPACE  4,30
**        ITEM - INTERNAL PRIORITY SORT RECORD.
*
*         *ITEM* IS USED BY *GENPFD* TO BUILD THE PRIORITY SORT
*         RECORD AND TO PROCESS IT AFTER THE SORT IS COMPLETED.
*
*T        6/ PG, 36/ PDTM, 18/ SIZE
*T,       42/ FILE NAME, 18/ USER INDEX
*T,       6/ DN, 24/ TSC, 30/ LEN
*
*         PG     PRIORITY GROUP 0-7, 10-17.
*                  0 OR 10B FOR FILES MATCHING *SF* OR *SV* ENTRIES.
*                  0 - 7 FOR FILES MATCHING *RL* DEVICE ENTRIES.
*                  10B-17B FOR FILES NOT MATCHING *RL* DEVICE ENTRIES.
*         PDTM   PACKED DATE AND TIME - LAST ACCESS IF *PO=R*,
*                  LAST DATA MODIFICATION IF *PO=D*.
*         SIZE   COMPLEMENT OF FILE SIZE IN SECTORS.  FILE SIZES
*                  OVER 17 BITS ARE REPRESENTED WITH BIT 17 CLEAR AND
*                  THE COMPLEMENT OF THE HIGH 17 BITS OF THE FILE SIZE.
*         DN     DEVICE NUMBER ON WHICH FILE RESIDES.
*         TSC    TOTAL SECTOR COUNT ADJUSTED FOR FULL TRACKS.
*         LEN    TAPE REQUIRED IN 32NDS OF AN INCH (INCHES*32).
 
 
 ITEM     BSSZ   ITEML
 ITKY     EQU    ITEM        PG / PDTM / SIZE  (SORT KEY)
 ITFN     EQU    ITEM+1      FILE NAME / USER INDEX
 ITDN     EQU    ITEM+2      DN / TSC / LEN
 ITSC     EQU    ITDN        ALTERNATE FOR *ITDN*
 TDIR     SPACE  4,10
**        TDIR - TABLE OF DIRECTIVES.
*
*         *TDIR* CONTAINS THE LEGAL DIRECTIVES AND THE ADDRESS
*         OF THE ROUTINE THAT PROCESSES THAT DIRECTIVE.
*
*T        42/ DNAME, 18/ PADDR
*
*         DNAME  DIRECTIVE NAME.
*         PADDR  ADDRESS OF PROCESSING ROUTINE FOR *DNAME*.
 
 
 TDIR     BSS    0
          VFD    42/0LD,18/PTD     TAPE DENSITY
          VFD    42/0LDL,18/PDL    DESTAGE LIMIT - FEET/MEGABYTES
          VFD    42/0LDT,18/PDT    DESTAGE THRESHOLD - FEET/MEGABYTES
          VFD    42/0LF,18/PTF     TAPE FORMAT
          VFD    42/0LPG,18/PPG    PRIORITY GROUPS
          VFD    42/0LRL,18/PRL    RELEASE LIMIT
          VFD    42/0LSF,18/PSF    SPECIFIC FILE/USER INDEX SELECTIONS
          VFD    42/0LSV,18/PSV    SPECIFIC VSN SELECTIONS
 TDIRX    VFD    42/0LXF,18/PSF    SPECIFIC FILE/USER INDEX EXCLUSIONS
          CON    0
 TDEN     SPACE  4,15
**        TDEN - TABLE OF TAPE DENSITIES AND GAP SIZES.
*
*         *TDEN* CONTAINS THE TAPE DENSITY SYMBOLS *GENPFD* RECOGNIZES,
*         A FLAG THAT INDICATES IF THIS IS A CARTRIDGE TAPE DENSITY,
*         THE INTER-RECORD GAP SIZE FOR THAT DENSITY IN 1/32NDS OF AN
*         INCH (INCHES*32), AND THE NUMBER OF 8-BIT BYTES CONTAINED IN
*         ONE INCH OF MAGNETIC TAPE RECORDED AT THAT DENSITY.
*
*T        30/ DEN, 1/ CTF, 11/ GAP, 18/ BYTES
*
*         DEN    THE DISPLAY CODE SYMBOL FOR THE DENSITY.
*         CTF    NONZERO IF CARTRIDGE TAPE DENSITY.
*         GAP    THE INTER-RECORD GAP SIZE IN INCHES*32.
*         BYTES  THE NUMBER OF 8-BIT BYTES PER INCH OF TAPE.  FOR
*                  7-TRACK TAPE, THIS IS 3/4 OF THE RATED DENSITY.
 
 
 TDEN     BSS    0           TABLE OF TAPE DENSITIES AND GAP SIZES
          VFD    30/2LLO,1/0,11/24,18/200*3/4
          VFD    30/2LHI,1/0,11/24,18/556*3/4
          VFD    30/2LHY,1/0,11/24,18/800*3/4
          VFD    30/2LHD,1/0,11/20,18/800
          VFD    30/2LPE,1/0,11/20,18/1600
          VFD    30/2LGE,1/0,11/10,18/6250
          VFD    30/2LCE,1/1,11/3,18/37871
          VFD    30/2LAE,1/1,11/3,18/37871
          VFD    30/3L200,1/0,11/24,18/200*3/4
          VFD    30/3L556,1/0,11/24,18/556*3/4
          VFD    30/4L1600,1/0,11/20,18/1600
          VFD    30/4L6250,1/0,11/10,18/6250
          VFD    30/5L38000,1/1,11/3,18/37871
          CON    0
 TFMT     SPACE  4,15
**        TFMT - TABLE OF TAPE FORMATS AND BLOCK SIZES.
*
*         *TFMT* CONTAINS THE TAPE FORMAT SYMBOLS *GENPFD* RECOGNIZES,
*         AND THE NUMBER OF DISK PRU-S (MINUS ONE) CONTAINED IN ONE
*         TAPE BLOCK RECORDED IN THAT FORMAT.
*
*T        12/ FORMAT, 36/ 0, 12/ (PBLK-1)
*
*         FORMAT THE DISPLAY CODE SYMBOL FOR THE FORMAT.
*         PBLK   THE NUMBER OF DISK PRU-S PER TAPE BLOCK.
 
 
 TFMT     BSS    0           TABLE OF TAPE FORMATS AND BLOCK SIZES
          VFD    12/1LI,36/0,12/10B-1
          VFD    12/2LLI,36/0,12/100B-1
          CON    0
 TPRG     SPACE  4,15
**        TPRG - TABLE OF PREFERRED RESIDENCE GROUPS.
*
*         *TPRG* CONTAINS THE PREFERRED RESIDENCE PRIORITY GROUPINGS
*         AS DETERMINED BY THE *PG* DIRECTIVES OR BY DEFAULT.  EACH
*         WORD IN THE TABLE REPRESENTS ONE PRIORITY GROUP, EARLIER
*         ENTRIES BEING HIGHER PRIORITY.
*
*T TPRGP  60/ N
*
*T,TPRG   6/PR, 6/PR, 6/PR, 6/PR, 6/PR, 6/PR, 6/PR, 6/PR, 6/PR, 6/PR
*T,TPRG+N 60/ 0
*
*         N      NUMBER OF PRIORITY GROUPS.
*         PR     PREFERRED RESIDENCE CODES IN THIS PRIORITY GROUP.
 
 
 TPRGP    CON    3           NUMBER OF PRIORITY GROUPS (DEFAULT = 3)
 TPRG     DATA   0LT         PREFERRED RESIDENCE *T*
          DATA   0LMN        PREFERRED RESIDENCES *M* AND *N*
          DATA   0LD         PREFERRED RESIDENCE *D*
          BSSZ   2
 TPRGL    EQU    *-TPRG      MAXIMUM NUMBER OF ENTRIES
 TCDV     SPACE  4,10
**        TCDV - TABLE OF CATALOG DEVICES.
*
*         *TCDV* IS USED TO STORE THE INFORMATION FROM THE *DEVSTAT*
*         RECORDS OF THE SUMMARY FILE.
*
*T TCDVP  60/ N
*
*T TCDV   12/ DT, 12/ TKSZ, 12/ TKAV, 12/ TKS, 3/ 0, 3/ U, 6/ DN
*T,TCDV+1 6/ 0, 24/ TASC, 14/ 0, 8/ SM, 8/ DM
*
*         N      NUMBER OF WORDS USED IN *TCDV* TABLE.
*         DT     DEVICE TYPE MNEMONIC.
*         TKSZ   TRACK SIZE OF THIS DEVICE IN SECTORS.
*         TKAV   NUMBER OF TRACKS LEFT AVAILABLE.
*         TKS    TOTAL NUMBER OF TRACKS ON DEVICE.
*         U      NUMBER OF UNITS(SPINDLES) - 1.
*         DN     DEVICE NUMBER.
*         TASC   TOTAL AVAILABLE SECTOR COUNT.
*         NCT    NUMBER OF CATALOG TRACKS ON DEVICE.
*         SM     SECONDARY DEVICE MASK.
*         DM     DEVICE MASK.
 
 TCDVP    CON    0           NUMBER OF WORDS IN TABLE
 TCDV     BSSZ   TCDVN*TCDVE+TCDVE
          CON    -0
 TSDV     SPACE  4,10
**        TSDV - TABLE OF SELECTED DEVICE TYPES AND NUMBERS.
*
*         *TSDV* CONTAINS ENTRIES FOR DEVICE TYPES OR NUMBERS
*         SELECTED BY MEANS OF *RL* DIRECTIVES.
*
*T        12/ DT, 12/ TKSZ, 24/ GOAL, 3/ 0, 3/ U, 6/ DN
*T,       30/ 0, 30/ SFSC
*
*         DT     DEVICE TYPE MNEMONIC, IF SUPPLIED ON *RL* DIRECTIVE.
*         TKSZ   TRACK SIZE FOR DEVICE/ DEVICE TYPE.
*         GOAL   SECTORS NEEDED TO MEET RELEASE GOAL.
*         U      NUMBER OF UNITS(SPINDLES) - 1, IF SUPPLIED ON *RL*.
*         DN     DEVICE NUMBER, IF SUPPLIED ON *RL* DIRECTIVE.
*         SFSC   SELECTED FILE SECTOR COUNT.
*
*         EITHER *DT* AND *U* APPEAR OR *DN* APPEARS, DEPENDING ON THE
*         FORMAT OF THE *RL* DIRECTIVE WHICH PROVIDED THE INFORMATION.
 
 
 TSDV     BSSZ   TSDVN*TSDVE+TSDVE
          CON    -0
 TSFV     SPACE  4,10
**        TSFV - TABLE OF SPECIFIC FILE AND VSN SELECTIONS.
*
*         *TSFV* CONTAINS SELECTED VSN ENTRIES SUPPLIED VIA *SV*
*         DIRECTIVES,  SELECTED FILE/USER INDEX ENTRIES SUPPLIED
*         VIA *SF* DIRECTIVES, AND EXCLUDED FILE/USER INDEX ENTRIES
*         SUPPLIED VIA *XF* DIRECTIVES.
*
*T TSFVP  60/ N
*
*T TSFV   12/ VSNL2, 12/ VSNR4, 36/0
*   OR
*T TSFV   42/ FN, 18/ UI
*
*         N      NUMBER OF WORDS IN THE *TSFV* TABLE.
*         VSNL2  THE LEFTMOST TWO CHARACTERS OF THE PRIMARY VSN.
*         VSNR4  12-BIT VALUE REPRESENTING THE RIGHTMOST 4 DIGITS
*                  OF THE PRIMARY VSN OF A DUMP FILE SET.
*         FN     THE FILE NAME OF A FILE TO BE SELECTED OR EXCLUDED.
*                  *FN* IS ALWAYS ACCOMPANIED BY *UI*.
*         UI     USER INDEX TO BE SELECTED OR EXCLUDED.  A NEGATIVE
*                  *UI* INDICATES AN EXCLUSION.  IF *FN* ACCOMPANIES
*                  *UI*, ONLY THAT FILE IS TO BE SELECTED OR EXCLUDED.
*                  *UI* APPEARS ALONE, ALL FILES FOR *UI* ARE TO BE
*                  SELECTED OR EXCLUDED.
 
 
 TSFVP    CON    0           NUMBER OF WORDS IN THE TABLE
 TSFV     BSS    TSFVN*TSFVE+TSFVE
          TITLE  GLOBAL CONSTANTS AND VARIABLES
          SPACE  4,10
*         GLOBAL CONSTANTS AND VARIABLES.
 
 ADOT     DATA   1L.         TERMINATING PERIOD FOR VARIOUS MESSAGES
 BLNK     CON    10H
 CSET     CON    0           CHARACTER SET CHANGED FLAG
 CTSF     CON    0           CARTRIDGE TAPE FLAG
 DENS     CON    6250        DENSITY OF TAPE TO BE USED FOR DUMP
 DIRV     BSS    1           CURRENT DIRECTIVE
 CFBT     CON    0           FILES LARGER THAN THRESHOLD
 DLFV     CON    0           DESTAGE LIMIT - FEET/MEGABYTES
 DTFV     CON    0           DESTAGE THRESHOLD - FEET/MEGABYTES
 ERUN     CON    0           END OF RUN INDICATOR FOR SORTING
 FCNT     CON    0           NUMBER OF FILES SELECTED
 GAPS     CON    10          INTER-RECORD GAP SIZE IN INCHES*32
 IDTP     CON    1           INPUT DEVICE TYPE
 INCH     CON    0           INCHES*32 OR BYTES*MILLION FOR SELECTIONS
 JORG     BSS    1           JOB ORIGIN
 LDFH     CON    10H  GENPFD-   DAYFILE HEADER FOR DIRECTIVE LINE
 LINE     BSSZ   9           DIRECTIVE INPUT, MESSAGE OUTPUT BUFFER
 
 LOFL     CON    3           LIST OF FILES LENGTH
          CON    0LOUTPUT+O  LIST OF FILES ENTRY FOR *OUTPUT*
          CON    0           LIST OF FILES TERMINATOR
 LOFP     VFD    30/LOFL,30/1  LIST OF FILES POINTER WORD
 
 NRUN     CON    0           NUMBER OF RUNS INDICATOR FOR SORTING
 ODTP     CON    1           OUTPUT DEVICE TYPE
 PBLK     CON    10B-1       DISK PRU-S PER TAPE BLOCK (MINUS 1)
 PNFM     CON    0           UTILITY *PN=* OR *FM=* DIRECTIVE
 POPT     DATA   0LR         PROCESSING OPTION - DEFAULT IS *R*
 UNITS    DATA   2LFT        DEFAULT DESTAGE UNITS = FEET
 PRCD     DATA   6L.LDMNT    PREFERRED RESIDENCE CODES IN SEQUENCE
 ZINF     CON    0           *Z* PARAMETER FLAG
          TITLE  ERROR MESSAGES.
*         ERROR MESSAGES.
          SPACE  4,10
 ERDA     DATA   C* DIRECTIVE ARGUMENT ERROR.*
 ERDT     DATA   C* DEVICE TYPE/NUMBER NOT FOUND.*
 ERIA     DATA   C* INCORRECT ARGUMENT VALUE.*
 ERSF     DATA   C* SELECTION FILE DEVICE NUMBER ERROR.*
 ERST     DATA   C* SUFFICIENT TRACKS ALREADY AVAILABLE.*
 ERSE     DATA   C* SUMMARY FILE IS EMPTY OR MISPOSITIONED.*
 ERSP     DATA   C* SUMMARY FILE PREFIX TABLE ERROR.*
          TITLE  MAIN LOOP.
 GENPFD   SPACE  4,15
**        MAIN LOOP.
*
*         *GENPFD* READS DIRECTIVES FROM THE INPUT FILE AND CREATES
*         A SELECTION FILE OF *PFDUMP* UTILITY DIRECTIVES THAT SATISY
*         THE SPECIFIED CONDITIONS.
*
*         CALLS  BDT, BSF, BUD, CTL, POP, PRS, RCS, SRT, USB.
*
*         MACROS MESSAGE, READ, READC, WRITEC, WRITEW.
 
 
 GENPFD   BSS    0           ENTRY
          RJ     PRS         PRESET
          RJ     BDT         BUILD DEVICE TABLE
 
*         GET NEXT DIRECTIVE.
 
 GEN1     SA1    ZINF
          SA2    INPUT
          NZ     X1,GEN2     IF *Z* OPTION SELECTED
          ZR     X2,GEN6     IF NO INPUT FILE (I=0)
          SA1    IDTP
          SA2    ODTP
          NZ     X1,GEN2     IF NOT TERMINAL INPUT
          NZ     X2,GEN2     IF NOT TERMINAL OUTPUT
          WRITEC O,GENA      * ENTER DIRECTIVE.*
          READ   I,R
 GEN2     READC  I,LINE,8
          NZ     X1,GEN6     IF EOR FOUND
          SA1    ODTP
          ZR     X1,GEN3     IF A TERMINAL OUTPUT FILE
          WRITEW O,BLNK,1    ISSUE SPACES TO MOVE LINE TO THE RIGHT
          WRITEC O,LINE,8    COPY DIRECTIVE TO LISTING FILE
 GEN3     MESSAGE  LDFH,3,R  PLACE DIRECTIVE IN DAYFILE
 
*         PROCESS INPUT LINE.
 
          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
          ZR     B6,GEN11    IF NO ARGUMENTS
          NG     B6,GEN11    IF NO TERMINATOR FOUND
          NG     B5,GEN11    IF ARGUMENT ERROR
 
*         SEARCH TABLE FOR DIRECTIVE.
 
          MX0    42
          SA4    TDIR        START OF DIRECTIVE TABLE
 GEN4     BX1    X0*X4
          ZR     X1,GEN11    IF UNIDENTIFIABLE DIRECTIVE
          BX1    X1-X6
          ZR     X1,GEN5     IF DIRECTIVE FOUND
          SA4    A4+B1
          EQ     GEN4        CHECK NEXT DIRECTIVE
 
 GEN5     SA6    DIRV        SAVE DIRECTIVE
          SB3    X4+
          RJ     POP         GET THE FIRST ARGUMENT
          NZ     B5,GEN11    IF ERROR OR ARGUMENT TOO LONG
          SA0    B6+         SAVE THE STRING BUFFER ADDRESS
          JP     B3          ENTER DIRECTIVE PROCESSOR
 
*         DIRECTIVES COMPLETE - CREATE THE SELECTION FILE.
 
 GEN6     RJ     CTL         CONVERT *DL* AND *DT* LENGTHS
          RJ     BSF         BUILD SELECTION FILE
          SA1    FCNT
          ZR     X1,GEN8     IF NO FILES SELECTED
          RJ     IIS         ISSUE INITIAL STATISTICS
          SA1    DTFV
          ZR     X1,GEN7     IF NO THRESHOLD SPECIFIED
          SA2    INCH
          IX6    X1-X2
          SX5    GENC        * DUMP THRESHOLD NOT REACHED.*
          PL     X6,GEN9     IF NOT ENOUGH FILES SELECTED
 GEN7     RJ     SRT         SORT SELECTION FILE
          RJ     BUD         BUILD UTILITY DIRECTIVE FILE
          SA1    FCNT
          ZR     X1,GEN8     IF NO FILES SELECTED
          RJ     IFS         ISSUE FINAL STATISTICS
          EQ     GEN10       TERMINATE PROCESSING
 
 GEN8     SA1    POPT
          SX5    GEND        * NO FILES SELECTED FOR DESTAGE.*
          ZR     X1,GEN9     IF *PO=D*
          SX5    GENE        * NO FILES SELECTED FOR RELEASE.*
 GEN9     MESSAGE  X5,3
          WRITEC O,X5
 GEN10    WRITER O,R
          UNLOAD CF          UNLOAD THE SELECTION FILE
          MESSAGE  GENB,3    * GENPFD COMPLETE.*
          RJ     RCS         RESET CHARACTER SET IF CHANGED
          ENDRUN
 
*         PROCESS DIRECTIVE ERRORS.
 
 GEN11    SX5    ERDA        * DIRECTIVE ARGUMENT ERROR *
          EQ     GEN13       ISSUE ERROR MESSAGE
 
 GEN12    SX5    ERIA        * INCORRECT ARGUMENT VALUE *
          EQ     GEN13       ISSUE ERROR MESSAGE
 
*         DIRECTIVE ERROR MESSAGE ABORT/CONTINUE ENTRY.
*         (X5) = ADDRESS OF ERROR MESSAGE TO BE DISPLAYED.
 
 GEN13    SA1    IDTP        CHECK FOR TERMINAL INPUT
          NZ     X1,ABT      IF NOT A TERMINAL THEN ABORT
          MESSAGE  X5,3
          WRITEC O,X5
          EQ     GEN1        PROMPT FOR NEXT DIRECTIVE
 
 
 GENA     DATA   C* ENTER DIRECTIVE.*
 GENB     DATA   C* GENPFD COMPLETE.*
 GENC     DATA   C* DUMP THRESHOLD NOT REACHED.*
 GEND     DATA   C* NO FILES SELECTED FOR DESTAGE.*
 GENE     DATA   C* NO FILES SELECTED FOR RELEASE.*
          TITLE  PRIMARY SUBROUTINES.
 ABT      SPACE  4,10
**        ABT - ABORT PROCESSING.
*
*         ENTRY  (X5) = ADDRESS OF ERROR MESSAGE.
*
*         EXIT   ALL FILES RETURNED.
*                ERROR MESSAGES ISSUED.
*                *GENPFD* ABORTED.
*
*         MACROS ABORT, MESSAGE, UNLOAD, WRITEC, WRITER.
 
 
 ABT      BSS    0           ENTRY
          MESSAGE  X5,3      ISSUE ERROR MESSAGE
          WRITEC O,X5
          UNLOAD  CF         UNLOAD FILES
          UNLOAD  BF
          UNLOAD  AF
          WRITER OUTPUT,R
          RJ     RCS         RESET CHARACTER SET IF CHANGED
          MESSAGE  ABTA,3,R  * GENPFD ABORTED.*
          SYSTEM ABT,R       ABORT
 
 
 ABTA     DATA   C* GENPFD ABORTED.*
 BDT      SPACE  4,20
**        BDT - BUILD DEVICE TABLE.
*
*         READ SUMMARY FILE DEVICE RECORDS, STORE FAMILY OR PACK
*         NAME AND BUILD CATALOG DEVICE TABLE.
*
*         EXIT   *FM=* OR *PN=* INFORMATION STORED.
*                CATALOG DEVICE TABLE COMPLETED.
*                SUMMARY FILE POSITIONED AFTER *DEVSTAT* RECORDS.
*
*         USES   X - 1, 2, 6.
*                A - 1, 2, 6.
*                B - 3.
*
*         CALLS  GSR, ZTB.
 
 
 BDT      SUBR               ENTRY/EXIT
 BDT1     SA1    BDTA        CALLING SEQUENCE ADDRESS
          RJ     GSR         GET SUMMARY FILE *DEVSTAT* RECORD
          SA1    BDTE
          NZ     X1,BDTX     IF END OF *DEVSTAT* RECORDS
          SA1    PNFM
          NZ     X1,BDT3     IF PACK/FAMILY NAME ALREADY STORED
          SA1    BDTD        CHECK DEVICE NUMBER OF FIRST RECORD
          MX6    -6
          BX1    -X6*X1
          SX2    3RFM=       PRESET FOR FAMILY NAME
          NZ     X1,BDT2     IF DEVICE NUMBER NON-ZERO
          SX2    3RPN=       SET FOR PACK NAME
 BDT2     SA1    BDTC+1      GET PACK/FAMILY NAME FROM *DEVSTAT* HEADER
          MX6    42
          BX6    X6*X1
          BX1    X2+X6       ADD UTILITY DIRECTIVE ID *FM=* OR *PN=*
          LX1    42
          RJ     ZTB         BLANK FILL
          SA6    PNFM
 BDT3     SA1    BDTD        TRACK SIZE AND COUNTS
          MX2    12
          LX1    12
          BX6    X2*X1       EXTRACT TRACK SIZE
          BX2    X1-X6       EXTRACT TRACKS AVAILABLE
          LX6    12
          AX2    36
          IX1    X2*X6       NUMBER OF SECTORS INITIALLY AVAILABLE
          SA2    A1+B1       RUNNING TOTAL OF AVAILABLE SECTORS
          MX6    -24
          LX1    30
          BX2    -X6*X2
          BX6    X1+X2       SET RUNNING TOTAL TO INITIAL AVAILABILITY
          SA1    TCDVP       ADVANCE CATALOG DEVICE TABLE POINTER
          SA6    A2
          SX6    X1+TCDVE
          SA6    A1
          SX2    X1+TCDV     POINT TO NEXT AVAILABLE ENTRY
          SB3    TCDVE-1     SET COUNTER FOR MOVE
 BDT4     SA1    BDTD+B3     MOVE RECORD TO CATALOG DEVICE TABLE
          BX6    X1
          SA6    X2+B3
          SB3    B3-B1
          PL     B3,BDT4     IF MORE WORDS TO MOVE
          BX6    X6-X6       CLEAR THE FOLLOWING WORD IN THE TABLE
          SA6    A6+SFDIL
          EQ     BDT1        GET NEXT ITEM
 
 
 BDTA     CON    BDTB        POINTER TO RECORD ID WORD
          CON    SUMMARY     POINTER TO FET
          CON    BDTC        POINTER TO BUFFER
          CON    BDTE        POINTER TO STATUS WORD
 BDTB     DATA   0LDEVSTAT
 BDTC     BSS    SFDHL+1     *DEVSTAT* HEADER BUFFER
 BDTD     BSS    SFDIL       *DEVSTAT* ITEM BUFFER
 BDTE     BSS    1           STATUS WORD
 BSF      SPACE  4,20
**        BSF - BUILD SELECTION FILE.
*
*         *BSF* CREATES THE INITIAL SELECTION FILE BY MATCHING THE
*         CATALOG ENTRIES TO THE SPECIFIED PARAMETERS.  SPECIFICALLY
*         SELECTED FILES, THOSE RESIDING ON SPECIFICALLY DESIGNATED
*         ARCHIVE VOLUMES, THOSE RESIDING ON SELECTED DEVICE NUMBERS
*         AND THOSE RESIDING ON SELECTED DEVICE TYPES ARE WRITTEN TO
*         THE SELECTED CANDIDATES FILE, WITH SORT KEYS SET FOR SORTING
*         BY PRIORITY GROUP, THEN BY AGE WITHIN THE ABOVE GROUPINGS.
*
*         ENTRY  SUMMARY FILE POSITIONED AFTER *DEVSTAT* RECORDS.
*
*         EXIT   SELECTED FILE SORT RECORDS WRITTEN TO SELECTION FILE.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 3.
*
*         CALLS  GSR.
*
*         MACROS MESSAGE, REWIND, WRITE, WRITEC, WRITER, WRITEW.
 
 
 BSF24    WRITER CF,R        TERMINATE SELECTION FILE
          REWIND CF,R
 
 BSF      SUBR               ENTRY/EXIT
          UNLOAD CF,R
          WRITE  CF,*        PRESET WRITE FOR SELECTION FILE
          SA1    TPRGP       SET PRIORITY GROUP TABLE TERMINATOR
          BX6    X6-X6
          SB2    X1
          SA6    TPRG+B2
 BSF1     SA1    BSFA
          RJ     GSR         GET SUMMARY FILE RECORD
          SA1    BSFE
          NZ     X1,BSF24    IF END OF CATALOG ENTRIES
          SA1    BSFD+FCFN   FILE NAME / USER INDEX
          MX0    -3
          BX6    X1
          SA6    ITFN
          BX0    -X0*X1      LOWER OCTAL DIGIT OF USER INDEX
          SB3    X0+B1
 
*         CHECK IF FILE MATCHES A SPECIFIC FILENAME/UI/VSN SELECTION.
*         (B3) = DEVICE MASK SHIFT COUNT.
 
          SA2    TSFVP
          SA3    BSFD+FCTV   VSN FROM SUMMARY FILE
          SB2    X2-1
          LX3    59-23
          MX0    42
 BSF2     NG     B2,BSF7     IF NO MATCH OF SPECIFIC FILE/UI OR VSN
          SA2    TSFV+B2
          SB2    B2-B1
          SX4    X2
          NZ     X4,BSF3     IF NOT A VSN SPECIFICATION
          MX6    24
          BX2    X2-X3
          BX6    X6*X2
          EQ     BSF6        COMPLETE MATCH
 
 BSF3     PL     X4,BSF4     IF NOT AN EXCLUSION
          BX2    -X0-X2      INVERT USER INDEX FOR EXCLUSIONS
 BSF4     BX6    X0*X2
          ZR     X6,BSF5     IF FILE NAME NOT SUPPLIED
          MX6    42
 BSF5     BX6    X0-X6
          BX6    -X6*X1
          BX6    X2-X6
 BSF6     NZ     X6,BSF2     IF NOT THE SAME FILE / USER INDEX / VSN
          NG     X4,BSF1     IF MATCH WAS TO AN EXCLUSION
          SA6    BSFD+FCFN   MARK FILE SELECTED
          EQ     BSF10       FIND DEVICE NUMBER
 
*         FILE DID NOT MATCH SPECIFIC FILE OR VSN SELECTIONS.
*         CHECK FOR A MATCH TO A PREFERRED RESIDENCE PRIORITY GROUP.
*         (B3) = DEVICE MASK SHIFT COUNT.
 
 BSF7     SA1    BSFD+FCRS   PREFERRED RESIDENCE FOR FILE
          MX0    3
          BX0    X0*X1
          SA1    PRCD        PREFERRED RESIDENCE MNEMONICS
          LX0    4           COMPUTE SHIFT COUNT
          SB2    X0
          LX0    1
          SB2    X0+B2
          LX1    B2          POSITION PREFERRED RESIDENCE MNEMONIC
          SB2    B0
          MX0    6
          BX1    X0*X1       PREFERRED RESIDENCE MNEMONIC
 BSF8     SA2    TPRG+B2
          ZR     X2,BSF1     IF NO MORE GROUPS TO CHECK
          SB2    B2+1
 BSF9     BX6    X0*X2
          LX2    6
          ZR     X6,BSF8     IF NO MATCH IN THIS GROUP
          BX6    X1-X6
          NZ     X6,BSF9     IF NOT THIS PREFERRED RESIDENCE
          SX6    B2          PRIORITY GROUP = TABLE ORDINAL + 1
          LX6    59-5
 
*         FILE MATCHED SPECIFIC SELECTION OR PREFERRED RESIDENCE GROUP.
*         FIND THE DEVICE NUMBER IN THE CATALOG DEVICE TABLE.
*         (X6) = PRIORITY GROUP, BITS 59-54.
*         (B3) = DEVICE MASK SHIFT COUNT.
 
 BSF10    SA1    BSFD+FCEO   DEVICE NUMBER / ACCESS DATE
          SA3    POPT
          BX2    X1          SET UP TO USE ACCESS DATE
          NZ     X3,BSF11    IF DESTAGE WAS NOT SPECIFIED
          SA2    BSFD+FCMD   DATA MODIFICATION DATE
 BSF11    MX0    -36         DATE FOR SORT KEY
          BX0    -X0*X2
          LX0    18
          BX6    X0+X6       PRIORITY GROUP / DATE
          MX0    -6
          LX1    5-41
          BX1    -X0*X1      DEVICE NUMBER
          NZ     X1,BSF12    IF DEVICE NUMBER IS KNOWN
          MX0    1
          LX0    B3          SET UP FOR DEVICE MASK SEARCH
 BSF12    SA2    TCDVP       LENGTH OF CATALOG DEVICE TABLE
          SB3    X2
 BSF13    ZR     B3,BSF1     IF DEVICE NOT FOUND IGNORE THIS FILE
          SB3    B3-TCDVE    LOOK AT NEXT ENTRY
          ZR     X1,BSF14    IF LOOKING FOR MASTER DEVICE
          SA2    TCDV+B3
          BX3    -X0*X2
          BX3    X1-X3
          NZ     X3,BSF13    IF NOT THE RIGHT DEVICE
          EQ     BSF15       GET FILE LENGTH
 
 BSF14    SA3    TCDV+1+B3
          BX3    X0*X3
          ZR     X3,BSF13    IF NOT THE MASTER DEVICE
          SA2    TCDV+B3     GET DEVICE NUMBER OF MASTER DEVICE
          MX0    -6
          BX1    -X0*X2
 
*         CATALOG DEVICE ENTRY HAS BEEN FOUND.  ADD FILE SIZE TO KEY.
*         (X1) = DEVICE NUMBER.
*         (X2) = FIRST WORD OF CATALOG DEVICE ENTRY.
*         (X6) = PRIORITY GROUP / DATE.
*         (B3) = OFFSET INTO CATALOG DEVICE ENTRY TABLE.
 
 BSF15    SA3    BSFD+FCLF   FILE SIZE
          MX0    24
          BX3    X0*X3
          LX3    24
          MX0    -17
          BX0    X0*X3
          ZR     X0,BSF16    IF FILE SIZE IS LESS THAN 2**17
 
*         FILE SIZE EXCEEDS 2**17 SECTORS, SO USE HIGH 17 BITS FOR KEY.
*         BIT 2**17 IS SET, FORCING THESE SIZE KEYS TO BE HIGHER.
 
          AX3    7
          MX0    1           SET HIGH ORDER BIT
          LX0    18
          BX3    X0+X3
 BSF16    MX0    18          INVERT FILE SIZE FOR SORT KEY
          LX0    18
          IX3    X0-X3
          BX6    X3+X6       PRIORITY GROUP / DATE / SIZE KEY
          SA6    ITKY
          LX1    -6
          BX6    X1          DEVICE NUMBER
          SA6    ITDN
          SA3    BSFD+FCLF   FILE SIZE
          MX1    24
          BX3    X1*X3
          LX3    24
          SX1    B1
          IX3    X3+X1       INCREMENT FOR SYSTEM SECTOR
 
*         CHECK IF FILE RESIDENCE DEVICE IS A SELECTED RELEASE DEVICE.
*         (X2) = FIRST WORD OF CATALOG DEVICE ENTRY.
*         (X3) = FILE SIZE IN SECTORS, ADJUSTED FOR SYSTEM SECTOR.
*         (B3) = OFFSET INTO CATALOG DEVICE ENTRY TABLE.
 
          MX0    -6          DEVICE NUMBER MASK
          SA4    TSDV        FIRST SELECTED DEVICE TABLE ENTRY
          ZR     X4,BSF18    IF NO SELECTED DEVICE ENTRIES
 BSF17    BX4    X2-X4
          BX6    -X0*X4
          ZR     X6,BSF20    IF MATCH ON DEVICE ENTRY
          SA4    A4+TSDVE    NEXT TABLE ENTRY
          NZ     X4,BSF17    IF NOT FINISHED WITH THIS PASS
          PL     X0,BSF18    IF FINISHED BOTH PASSES WITH NO MATCH
          MX1    21          FORM MASK FOR DEVICE TYPE / SPINDLES
          LX1    9
          BX0    X0-X1
          SA4    TSDV        FIRST ENTRY AGAIN
          EQ     BSF17       CHECK FOR MATCH ON DEVICE TYPE
 
 BSF18    SA1    POPT
          ZR     X1,BSF19    IF *OP=D*
          SA1    BSFD+FCFN
          NZ     X1,BSF1     IF FILE WAS NOT SELECTED
 BSF19    SA1    ITKY        DEGRADE PRIORITY GROUP
          SX6    10B
          LX6    54
          BX6    X1+X6
          SA6    A1+
 
*         FILE HAS SURVIVED TESTS AND PRIORITY HAS BEEN DETERMINED.
*         CALCULATE FILE SIZE IN TRACKS, FOR RELEASE GOAL CHECKING.
*         (X3) = FILE SIZE IN SECTORS, ADJUSTED FOR SYSTEM SECTOR.
*         (B3) = OFFSET INTO CATALOG DEVICE ENTRY TABLE.
 
 BSF20    BX4    X3          FILE SIZE IN SECTORS
          SX0    B1+
          IX4    X4+X0       ADD EOI SECTOR FOR TRACK CALCULATION
          SA1    BSFD+FCRI   CHECK IF THERE ARE PERMITS
          MX2    24
          BX1    X1*X2
          ZR     X1,BSF21    IF NO RANDOM INDEX
          IX3    X3+X0       ALLOW ONE SECTOR FOR PERMITS ON ARCHIVE
 BSF21    SA2    BSFD+FCBS   CHECK TYPE OF FILE
          MX0    -12
          BX2    -X0*X2
          SX2    X2-4000B
          NZ     X2,BSF22    IF INDIRECT FILE
          SA2    TCDV+B3     CATALOG DEVICE TRACK SIZE
          MX0    -12
          LX2    24
          BX2    -X0*X2
          BX1    X2
          BX0    X4
          IX6    X4/X2       DIVIDE SECTORS BY TRACK SIZE
          IX4    X1*X6       MULTIPLY RESULT BY TRACK SIZE
          BX2    X0-X4
          ZR     X2,BSF22    IF EVEN TRACKS
          IX4    X1+X4       INCREMENT TO EVEN TRACKS
 
*         CALCULATE AMOUNT OF SPACE THAT THIS FILE WILL TAKE.  INTEGER
*         ARITHMETIC ERROR IS MINIMIZED BY USING 1/32 INCH INCREMENTS
*         FOR CALCULATING SPACE OCCUPIED ON TAPE.
*         (X3) = FILE SIZE IN SECTORS.
*         (X4) = FILE SIZE IN SECTORS FOR COMPLETE TRACKS.
 
 BSF22    SA1    UNITS       FEET OR MEGABYTES
          BX2    X3          DISK SECTORS
          LX1    12
          SX1    X1-2RMB
          ZR     X1,BSF23.1  IF MEASURING MEGABYTES
          SA1    PBLK
          SX0    X1+B1
          IX1    X1+X3
          IX2    X1/X0       NUMBER OF TAPE BLOCKS
          SA1    GAPS        INTER-RECORD GAP SIZE IN INCHES*32
          IX6    X1*X2
          SX1    PBYT*32
          IX3    X1*X3       NUMBER OF BYTES*32 IN FILE
          SX1    16/2*15*32  PFC BYTES*32
          IX3    X1+X3
          SA1    DENS        NUMBER OF BYTES/INCH
          IX2    X3/X1       NUMBER OF INCHES*32 FOR DATA
          IX2    X2+X6       TOTAL INCHES*32 FOR THE FILE
 BSF23.1  SA1    INCH        INCREMENT TOTAL
          IX6    X1+X2
          SA6    A1
          SA1    ITDN        STORE DEV.NO. / SECTORS / ARCHIVE UNITS
          LX4    30          SECTORS
          BX4    X2+X4       SECTORS / ARCHIVE UNITS
          BX6    X1+X4       DEVICE NUMBER / SECTORS / ARCHIVE UNITS
          SA6    A1
          WRITEW CF,ITEM,ITEML  WRITE OUT THE COMPLETED ENTRY
          SA1    FCNT
          SX6    X1+B1
          SA6    A1
          EQ     BSF1        GET NEXT SUMMARY FILE RECORD
 
 
 BSFA     CON    BSFB        POINTER TO RECORD ID WORD
          CON    SUMMARY     POINTER TO FET
          CON    BSFC        POINTER TO BUFFER
          CON    BSFE        POINTER TO STATUS WORD
 BSFB     DATA   0LCATE
 BSFC     BSS    SFFHL+1     FILE HEADER BUFFER
 BSFD     BSS    SFFIL       FILE ITEM BUFFER
 BSFE     BSS    1           STATUS WORD
 BUD      SPACE  4,20
**        BUD - BUILD UTILITY DIRECTIVES.
*
*         PROCESS SORT SELECTIONS AGAINST TAPE AND DEVICE LIMITS
*         AND BUILD UP THE UTILITY DIRECTIVES FILE.
*
*         EXIT   UTILITY DIRECTIVES WRITTEN TO FILE *UDIR*
*                IF AT LEAST ONE FILE IS SELECTED.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 3, 4, 5, 6.
*                B - 3.
*
*         CALLS  CDD, COD.
*
*         MACROS READ, READW, WRITE, WRITEC, WRITER.
 
 
 BUD11    SA1    FCNT
          ZR     X1,BUDX     IF NO UTILITY DIRECTIVES WRITTEN
          WRITER UD,R        TERMINATE UTILITY DIRECTIVE FILE
 
 BUD      SUBR               ENTRY/EXIT
          WRITE  UD,*        PRESET WRITE FUNCTION
          READ   CF,R
          SX6    B0+
          SA6    INCH
          SA6    FCNT
 BUD1     READW  CF,ITEM,ITEML
          NZ     X1,BUD11    IF END OF SELECTION FILE
          SA1    DLFV        LENGTH LIMIT IN INCHES*32 OR MEGABYTES
          ZR     X1,BUD2     IF THERE IS NO LENGTH LIMIT
          SA2    ITSC
          MX0    -30
          BX6    -X0*X2      FILE LENGTH IN INCHES*32 OR SECTORS
          SA2    INCH        TOTAL LENGTH ALREADY ACCEPTED
          IX3    X6-X1
          NG     X3,BUD1.2   IF FILE .LE. LIMIT
          SA1    UNITS
          SA3    FCNT
          LX1    12
          SX1    X1-2RMB
          ZR     X1,BUD1.1   IF MEGABYTES
          ZR     X3,BUD2     IF NO FILES SELECTED YET
 BUD1.1   SA1    CFBT        INCREMENT COUNT OF FILES .GT. LIMIT
          SX6    A1+B1
          SA6    A1
          EQ     BUD1        CONTINUE PROCESSING
 
 BUD1.2   IX2    X2+X6
          IX1    X1-X2
          NG     X1,BUD1     IF LIMIT WOULD BE EXCEEDED
 BUD2     SA3    TSDV
          ZR     X3,BUD6     IF NO SELECTED DEVICES
 
*         FIND CATALOG DEVICE ENTRY FOR MATCHING DEVICE.
*         (X3) = THE FIRST SELECTED DEVICE TABLE ENTRY.
 
          SA2    ITDN
          MX0    -6          DEVICE NUMBER MASK
          LX2    6
          SA1    TCDV        GET FIRST CATALOG DEVICE
 BUD3     BX6    X1-X2
          BX6    -X0*X6
          ZR     X6,BUD4     IF MATCHING DEVICE ENTRY FOUND
          SA1    A1+TCDVE
          NZ     X1,BUD3     IF MORE DEVICES TO SEARCH
          SX5    ERSF        * SELECTION FILE DEVICE NUMBER ERROR.*
          EQ     ABT         ABORT
 
*         THE CATALOG DEVICE ENTRY FOR THE FILE HAS BEEN LOCATED.
*         SEARCH FOR MATCHING SELECTED DEVICE ENTRY.
*         (X0) = MASK FOR DEVICE NUMBER.
*         (X1) = THE CURRENT CATALOG DEVICE ENTRY.
*         (X3) = THE CURRENT SELECTED DEVICE TABLE ENTRY.
 
 BUD4     BX2    X1-X3
          BX2    -X0*X2
          ZR     X2,BUD7     IF MATCHING ENTRY FOUND
          SA3    A3+TSDVE    GET NEXT SELECTED DEVICE ENTRY
          NZ     X3,BUD4     IF MORE ENTRIES TO CHECK
 BUD5     PL     X0,BUD6     IF BOTH KINDS OF ENTRIES CHECKED
          MX2    21          SET UP MASK FOR DEVICE TYPE / SPINDLES
          LX2    9
          BX0    X0-X2       EXCLUDE DEVICE NUMBER FROM MASK
          SA3    TSDV
          NZ     X3,BUD4     IF SELECTED DEVICE ENTRIES TO PROCESS
 BUD6     SA2    POPT
          ZR     X2,BUD9     IF *PO=D*
          SA2    ITKY        CHECK PRIORITY FIELD OF KEY
          MX6    3
          LX2    3
          BX2    X6*X2
          ZR     X2,BUD9     IF FILE SELECTED VIA *SF* OR *SV*
          EQ     BUD1        BYPASS THIS FILE
 
*         FILE MATCHES ONE OF THE SELECTED DEVICE ENTRIES.
*         UPDATE COUNT OF SECTORS SELECTED IN THE MATCHING ENTRY.
*         (X0) = MASK FOR DEVICE TYPE OR DEVICE NUMBER.
*         (X1) = THE CURRENT CATALOG DEVICE ENTRY.
*         (X3) = FIRST WORD OF SELECTED DEVICE ENTRY.
 
 BUD7     SA4    A1+B1       GET SECTORS AVAILABLE ON DEVICE
          MX2    24          BUILD MASK FOR SECTOR COUNTS
          LX2    -6
          LX3    18
          BX3    X2*X3       SECTORS GOAL FROM SELECTED DEVICE ENTRY
          BX6    X2*X4       SECTORS AVAILABLE ON DEVICE
          SA5    ITSC
          IX3    X6-X3
          PL     X3,BUD5     IF NO MORE SECTORS NEEDED FOR THIS DEVICE
          SA3    A3+B1
          BX5    X2*X5       SECTOR COUNT FOR FILE
          LX5    30          UPDATE SECTORS SELECTED
          IX6    X3+X5
          SA6    A3
 
*         ACCUMULATE SPACE REQUIRED FOR FILE AND SECTORS
*         AVAILABLE FOR THE DEVICE UPON WHICH IT RESIDES.
*         (X1) = THE CURRENT CATALOG DEVICE ENTRY.
 
 BUD9     SA4    A1+B1       SECTORS AVAILABLE ON DEVICE ENTRY
          SA1    ITSC        SECTORS AND INCHES*32 FOR THIS FILE
          MX2    24          MASK FOR SECTOR COUNT
          LX2    -6
          BX6    X2*X1       FILE LENGTH IN SECTORS
          IX6    X4+X6       UPDATE SECTORS AVAILABLE ON DEVICE
          SA6    A4
          MX6    -30
          BX6    -X6*X1      FILE LENGTH IN INCHES*32 OR SECTORS
          SA1    INCH        UPDATE ACCUMULATED ARCHIVE SIZE
          IX6    X1+X6
          SA6    A1
 
*         WRITE *FM=*/*PN=* DIRECTIVE IF NOT ALREADY WRITTEN.
 
          SA1    PNFM
          ZR     X1,BUD10    IF *FM=*/*PN=* ALREADY WRITTEN
          BX6    X1
          SA6    BUDA+1
          WRITEC UD,BUDA+1,R WRITE THE *FM=*/*PN=* DIRECTIVE
          SX6    B0+
          SA6    PNFM
 
*         BUILD UTILITY DIRECTIVES FOR THE SELECTED FILE.
 
 BUD10    SA1    ITFN
          MX0    42
          BX5    X0*X1       SAVE FILE NAME
          BX1    -X0*X1
          RJ     COD         CONVERT USER INDEX TO DISPLAY
          MX0    -24
          SA2    =4R,UI=     BUILD *UI* DIRECTIVE
          BX4    X0*X4
          BX6    X2+X4
          LX6    42
          SA6    BUDA
          SA2    =3RPF=      BUILD *PF* DIRECTIVE
          BX1    X2+X5
          LX1    42
          RJ     ZTB
          SA6    BUDA+1
          WRITEC UD,BUDA,R   WRITE THE DIRECTIVE SET
          SA1    FCNT        INCREMENT FILES SELECTED
          SX6    X1+B1
          SA6    A1
          EQ     BUD1        PROCESS NEXT FILE
 
 
 BUDA     DATA   C*UI=UUUUUU,PF=FFFFFFF.*
 CTL      SPACE  4,20
**        CTL - CONVERT *DT* AND *DL* LENGTHS.
*
*         CONVERT *DL* AND *DT* DIRECTIVE VALUES TO WORKING VALUES, IN
*         1/32 INCH INCREMENTS (INCHES*32) FOR *U=FT*, OR IN PRU-S FOR
*         *U=MB*.  FOR *DT*, THE DEFAULT VALUE IS A PERCENTAGE OF *DL*.
*
*         EXIT   PARAMETERS CONVERTED TO WORKING VALUES.
*
*         USES   X - 1, 2, 3, 4, 6.
*                A - 1, 2, 3, 4, 6.
 
 
 CTL      SUBR               ENTRY/EXIT
          SA4    UNITS       FEET OR MEGABYTES
          LX4    12
          SX4    X4-2RMB
          SX6    12*32       CONVERSION FOR FEET TO INCHES*32
          NZ     X4,CTL1     IF *U=FT*
          SX6    MPRU        SECTORS PER MEGABYTE CONVERSION FACTOR
 CTL1     SA1    POPT
          SA2    DLFV
          SA3    DTFV
          NZ     X2,CTL1.1   IF *DL* DIRECTIVE WAS SPECIFIED
          NG     X2,CTL2     IF *DL=0* WAS SPECIFIED
          NZ     X1,CTL2     IF NOT *OP=D*
          SX2    DLMB        DEFAULT LIMIT FOR MEGABYTES
          ZR     X4,CTL1.1   IF *U=MB*
          SA4    CTSF
          SX2    DLDF        DEFAULT LIMIT FEET (*MT*/*NT* TAPE)
          ZR     X4,CTL1.1   IF NOT CARTRIDGE TAPE
          SX2    DLDFC       DEFAULT LIMIT FEET (*CT*/*AT* TAPE)
 CTL1.1   IX2    X2*X6
 CTL2     NZ     X3,CTL3     IF *DT* DIRECTIVE WAS SPECIFIED
          NG     X3,CTL4     IF *DT=0* WAS SPECIFIED
          NZ     X1,CTL4     IF NOT *OP=D*
          BX3    X2          CALCULATE *DT* AS A PERCENTAGE OF *DL*
          NG     X3,CTL4     IF *DL=0* WAS SPECIFIED
          SX1    100
          IX6    X3/X1
          SX3    DTDF        DEFAULT THRESHOLD PERCENTAGE
 CTL3     IX3    X3*X6
 CTL4     BX6    X2
          SA6    A2          STORE CONVERTED *DL*
          BX6    X3
          SA6    A3          STORE CONVERTED *DT*
          EQ     CTLX        RETURN
 IIS      SPACE  4,15
**        IIS - ISSUE INITIAL STATISTICS.
*
*         ISSUE STATISTICAL MESSAGES FOR INITIAL SELECTION.
*
*         EXIT   INITIAL STATISTICS ISSUED TO OUTPUT AND DAYFILE.
*
*         USES   X - 0, 1, 2, 3, 6.
*                A - 1, 2, 3, 6.
*                B - 3.
*
*         CALLS  CDD.
*
*         MACROS MESSAGE, WRITEC.
 
 
 IIS      SUBR               ENTRY/EXIT
          SA1    FCNT
          RJ     CDD         CONVERT FILE COUNT TO DISPLAY
          MX0    6
          BX6    -X0*X6
          SA1    ADOT
          BX6    X1+X6
          SB3    60
          SB3    B3-B2
          LX6    B3
          SA6    IISA+3
          MESSAGE  IISA,3    * FIRST SELECTION FILE COUNT = XXXXXXXXX.*
          WRITEC O,IISA
          SA2    INCH
          SA3    UNITS       FEET OR MEGABYTES
          LX3    12
          SX3    X3-2RMB
          NZ     X3,IIS1     IF FEET
          SX6    IISC        * MAXIMUM TOTAL MEGABYTES = X..X.*
          SA6    IISD
          SX3    PBYT        NUMBER OF 8-BIT BYTES PER PRU
          IX2    X2*X3       MAXIMUM TOTAL BYTES
          SX3    500         ROUND TO KILOBYTES
          IX2    X2+X3
          LX3    1
          IX1    X2/X3       KILOBYTES
          RJ     CFD         CONVERT TO F10.3 DISPLAY MEGABYTES
          SB3    B2+60
          EQ     IIS2        CONTINUE PROCESSING MESSAGE
 
 IIS1     SX3    12*32       CONVERSION FROM INCHES*32 TO FEET
          SX6    IISB        * MAXIMUM TOTAL FEET OF TAPE = X..X.*
          IX1    X2/X3
          SA6    IISD
          RJ     CDD         CONVERT MAXIMUM TOTAL TO DISPLAY
 IIS2     SA1    ADOT
          MX0    6
          BX2    X0*X6
          BX6    -X0*X6
          BX6    X1+X6
          SB3    60
          SB3    B3-B2
          NZ     B3,IIS3     IF NOT TEN CHARACTERS
          LX6    6
 IIS3     LX6    B3
          SA3    IISD
          SA6    X3+3
          SA1    A6-B1       STORE UPPER DIGIT OF AMOUNT
          LX1    54
          BX1    -X0*X1
          BX6    X1+X2
          LX6    6
          SA6    A1
          MESSAGE  X3,3      * MAXIMUM TOTAL MEGABYTES/FEET OF TAPE...*
          WRITEC O,X3
          EQ     IISX        RETURN
 
 
 IISA     DATA   C* FIRST SELECTION FILE COUNT = XXXXXXXXX.*
 IISB     DATA   C* MAXIMUM TOTAL FEET OF TAPE = XXXXXXXXX.*
 IISC     DATA   C* MAXIMUM TOTAL MEGABYTES    =XXXXXX.XXX.*
 IISD     BSS    1           POINTER TO MESSAGE TO BE ISSUED
 IFS      SPACE  4,15
**        IFS - ISSUE FINAL STATISTICS.
*
*         ISSUE FINAL STATISTICAL MESSAGES.
*
*         EXIT   FINAL STATISTICS ISSUED TO OUTPUT AND DAYFILE.
*
*         USES   X - 0, 1, 2, 3, 5, 6.
*                A - 1, 2, 3, 5, 6.
*                B - 3.
*
*         CALLS  CDD, COD.
*
*         MACROS MESSAGE, WRITEC.
 
 
 IFS      SUBR               ENTRY/EXIT
          SA1    CFBT
          ZR     X1,IFS0     IF NO FILES LARGER THAN THRESHOLD
          MESSAGE IFSF,3
          MESSAGE IFSE,3
          MESSAGE IFSF,3
          WRITEC O,IFSF
          WRITEC O,IFSE
          WRITEC O,IFSF
 IFS0     SA1    FCNT
          RJ     CDD         CONVERT FILE COUNT TO DISPLAY
          MX0    6
          BX6    -X0*X6
          SA1    ADOT
          BX6    X1+X6
          SB3    60
          SB3    B3-B2
          LX6    B3
          SA6    IFSA+3
          SA1    POPT
          SA5    =10HDESTAGE =
          ZR     X1,IFS1     IF *PO=D*
          SA5    =10HRELEASE =
 IFS1     BX6    X5
          SA6    IFSA+2
          MESSAGE  IFSA,3    * FILES SELECTED FOR PPPPPPP = XXXXXXXXX.*
          WRITEC O,IFSA
          MX0    -6          SET MASK FOR DEVICE NUMBER SEARCH
 IFS2     SA5    TSDV
          ZR     X5,IFS8     IF NO SELECTED DEVICE
 IFS3     BX1    -X0*X5
          ZR     X1,IFS7     IF THIS ENTRY NOT APPLICABLE
          PL     X0,IFS4     IF PROCESSING DEVICE TYPE ENTRIES
          SX1    X1+100B
          RJ     COD         CONVERT TO DISPLAY
          SA3    =8L,  DN =  SET DEVICE NUMBER INTO MESSAGE
          MX2    -12
          BX2    -X2*X6
          BX6    X2+X3
          LX6    12
          SA6    IFSC
          EQ     IFS6        ADD TRACK COUNT TO MESSAGE
 
 IFS4     SA3    =6L DT =    SET DEVICE TYPE AND SPINDLES INTO MESSAGE
          MX2    12
          BX6    X2*X1
          LX6    24
          BX1    -X2*X1
          SX2    2R,
          ZR     X1,IFS5     IF SINGLE SPINDLE DEVICE
          SX2    X1+2R1,
 IFS5     BX2    X2+X6
          BX6    X2+X3
          SA6    IFSC
 IFS6     SA2    A5+B1       SECTORS SELECTED
          MX6    12
          BX5    -X6*X5
          AX5    36          TRACK SIZE
          IX1    X2/X5       NUMBER OF TRACKS
          RJ     COD         CONVERT TRACKS TO DISPLAY
          MX1    6
          BX6    -X1*X6
          SA1    ADOT
          BX6    X1+X6
          SB3    60
          SB3    B3-B2
          LX6    B3
          SA6    IFSC+3
*         MESSAGE  IFSC,3    * DT = TTT, FILE TRACK COUNT = XXXXXXXXX.*
          MESSAGE  IFSC,3    * DN = NN,  FILE TRACK COUNT = XXXXXXXXX.*
          WRITEC O,IFSC
 IFS7     SA5    A5+TSDVE
          NZ     X5,IFS3     IF MORE SELECTED DEVICES
          PL     X0,IFS8     IF CHECKING DEVICE TYPE
          MX2    21          SET MASK FOR DEVICE TYPE/SPINDLES
          LX2    9
          BX0    X0-X2
          EQ     IFS2        SEARCH FOR DEVICE TYPES
 
 IFS8     SA2    INCH
          SA3    UNITS       FEET OR MEGABYTES
          LX3    12
          SX3    X3-2RMB
          NZ     X3,IFS9     IF FEET
          SX6    IFSD        * MEGABYTES REQUIRED FOR DUMP= X..X*
          SA6    IFSG
          SX3    PBYT        NUMBER OF 8-BIT BYTES PER PRU
          IX2    X2*X3       BYTES
          SX3    500         ROUND TO KILOBYTES FOR CONVERSION
          IX2    X2+X3
          LX3    1
          IX1    X2/X3       KILOBYTES
          RJ     CFD         CONVERT TO F10.3 DISPLAY MEGABYTES
          SB2    B3+60
          EQ     IFS10       CONTINUE PROCESSING MESSAGE
 
 IFS9     SX3    12*32       CONVERSION FROM INCHES*32 TO FEET
          SX6    IFSB        * FEET OF DUMP TAPE REQUIRED = X..X*
          IX1    X2/X3
          SA6    IFSG
          RJ     CDD         CONVERT AMOUNT REQUIRED TO DISPLAY
 IFS10    SA1    ADOT
          MX0    6
          BX2    X0*X6
          BX6    -X0*X6
          BX6    X1+X6
          SB3    60
          SB3    B3-B2
          NZ     B3,IFS11    IF NOT TEN CHARACTERS
          LX6    6
 IFS11    LX6    B3
          SA3    IFSG
          SA6    X3+3
          SA1    A6-B1
          LX1    54
          BX1    -X0*X1
          BX6    X1+X2
          LX6    6
          SA6    A1
          MESSAGE  X3,3      * MEGABYTES/FEET OF DUMP TAPE REQUIRED..*
          WRITEC O,X3
          EQ     IFSX        RETURN
 
 
 IFSA     DATA   C* FILES SELECTED FOR PPPPPPP = XXXXXXXXX.*
 IFSB     DATA   C* FEET OF DUMP TAPE REQUIRED = XXXXXXXXX.*
 IFSC     DATA   C* DT = XXX, FILE TRACK COUNT = XXXXXXXXX.*
 IFSD     DATA   C* MEGABYTES REQUIRED FOR DUMP=XXXXXX.XXX.*
 IFSE     DATA   C+ *WARNING* - FILES LARGER THAN *DL* LIMIT SKIPPED.+
 IFSF     DATA   C+ *WARNING*+
 IFSG     BSS    1           POINTER TO MESSAGE TO BE ISSUED
 RCS      SPACE  4,15
**        RCS - RESTORE CHARACTER SET.
*
*         RESTORES ORIGINAL CHARACTER SET IF IT WAS CHANGED.
*
*         ENTRY  (CSET) .NE. 0 IF CHARACTER SET WAS CHANGED.
*
*         EXIT   CHARACTER SET IS THE SAME AS UPON ENTERING *GENPFD*.
*
*         USES   X - 1.
*                A - 1.
*
*         MACROS CSET.
 
 
 RCS      SUBR               ENTRY/EXIT
          SA1    CSET
          ZR     X1,RCSX     IF CHARACTER SET WAS NOT CHANGED
          CSET   RESTORE     RESTORE ORIGINAL CHARACTER SET
          EQ     RCSX        RETURN
 SRT      SPACE  4,20
**        SRT - MERGE SORT OF *ITEML* SIZE ENTRIES.
*
*         *SRT* SORTS THE *ITEML* SIZE ENTRIES ON THE SELECTION FILE
*         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  THE SELECTION FILE CONTAINS AT LEAST ONE ENTRY.
*
*         EXIT   SORTED ENTRIES ON SELECTION FILE.
*
*         USES   X - 1, 2, 6.
*                A - 1, 6.
*
*         CALLS  DTR, MRG.
*
*         MACROS RESET, REWIND, REWRYTE, UNLOAD, WRITER.
 
 
 SRT      SUBR               ENTRY/EXIT
          UNLOAD AF          UNLOAD WORK FILES
          UNLOAD BF
 
*         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    NRUN
          RJ     MRG         MERGE RUNS FROM A AND B ONTO C
          WRITER CF,R
          SA1    NRUN
          SX2    B1
          IX1    X1-X2
          NZ     X1,SRT1     IF NOT A SINGLE RUN YET
          UNLOAD AF
          UNLOAD BF
          REWIND CF,R
          EQ     SRTX        RETURN
          TITLE  DIRECTIVE PROCESSORS.
 PDL      SPACE  4,20
**        PDL - PROCESS *DL* DIRECTIVE.
*
*         EXTRACT AND STORE DESTAGE MAXIMUM SIZE IN FEET OR MEGABYTES.
*
*         ENTRY  (X6) = FIRST ARGUMENT.
*                (B6) = NEXT STRING BUFFER ADDRESS.
*                     = 0, IF TERMINATOR ENCOUNTERED.
*
*         EXIT   DESTAGE MAXIMUM SIZE STORED.
*                TO *GEN1* IF NO ERRORS.
*                TO *GEN12* IF ERROR DETECTED.
*
*         USES   X - 5, 6.
*                A - 6.
*                B - 7.
*
*         CALLS  DXB.
 
 
 PDL      BSS    0           ENTRY
          BX5    X6
          SB7    B1          INDICATE DECIMAL CONVERSION
          RJ     DXB
          NZ     X4,GEN12    IF ARGUMENT ERROR
          NZ     X6,PDL1     IF ARGUMENT IS NOT ZERO
          MX6    -0          MARK *DL=0* ENTRY
 PDL1     SA6    DLFV        SAVE THE DESTAGE LIMIT
          EQ     GEN1        RETURN
 PDT      SPACE  4,20
**        PDT - PROCESS *DT* DIRECTIVE.
*
*         EXTRACT AND STORE DESTAGE MINIMUM SIZE IN FEET OR MEGABYTES.
*
*         ENTRY  (X6) = FIRST ARGUMENT.
*                (B6) = NEXT STRING BUFFER ADDRESS.
*                     = 0, IF TERMINATOR ENCOUNTERED.
*
*         EXIT   DESTAGE MINIMUM SIZE STORED.
*                TO *GEN1* IF NO ERRORS.
*                TO *GEN12* IF ERROR DETECTED.
*
*         USES   X - 5, 6.
*                A - 6.
*                B - 7.
*
*         CALLS  DXB.
 
 
 PDT      BSS    0           ENTRY
          BX5    X6
          SB7    B1          INDICATE DECIMAL CONVERSION
          RJ     DXB
          NZ     X4,GEN12    IF ARGUMENT ERROR
          NZ     X6,PDT1     IF ARGUMENT IS NOT ZERO
          MX6    -0          MARK *DT=0* ENTRY
 PDT1     SA6    DTFV        SAVE DESTAGE MINIMUM
          EQ     GEN1        RETURN
 PPG      SPACE  4,20
**        PPG - PROCESS *PG* DIRECTIVE.
*
*         PROCESS PREFERRED RESIDENCE GROUPINGS.
*
*         ENTRY  (X6) = FIRST ARGUMENT.
*                (B6) = NEXT STRING BUFFER ADDRESS.
*                     = 0, IF TERMINATOR ENCOUNTERED.
*
*         EXIT   PREFERRED RESIDENCE GROUPINGS STORED.
*                TO *GEN1* IF NO ERRORS.
*                TO *GEN11*, *GEN12* OR *GEN13* IF ERROR DETECTED.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 6.
*
*         CALLS  POP.
 
 
 PPG      BSS    0           ENTRY
          SX1    B0+         CLEAR TABLE POINTER
 PPG1     SA6    TPRG+X1     SAVE PARAMETER VALUE IN TABLE
          BX5    X6
          MX0    6
          SX6    X1+1
          SA6    TPRGP       SAVE PRIORITY GROUP TABLE POINTER
 PPG2     ZR     X5,PPG4     IF NO MORE CODES TO CHECK
          BX1    X0*X5
          BX5    X5-X1
          LX5    6
          SA2    PRCD        VALID PREFERRED RESIDENCE CODES
 PPG3     LX2    6
          BX3    X0*X2
          BX4    X1-X3
          ZR     X4,PPG2     IF CODES MATCH
          NZ     X3,PPG3     IF MORE CODES TO CHECK
          EQ     GEN12       REPORT ERROR
 
 PPG4     ZR     B6,GEN1     IF NO MORE ARGUMENTS
          NG     B6,GEN11    IF NO TERMINATOR FOUND
          RJ     POP         GET THE NEXT ARGUMENT
          NZ     B5,GEN11    IF ERROR OR ARGUMENT TOO LONG
          SA1    TPRGP
          SX2    X1-TPRGL
          NG     X2,PPG1     IF ROOM REMAINS IN PRIORITY GROUP TABLE
          SX5    PPGA        * TOO MANY PRIORITY GROUP (PG) ENTRIES.*
          EQ     GEN13       ISSUE ERROR MESSAGE
 
 
 PPGA     DATA   C* TOO MANY PRIORITY GROUP (PG) ENTRIES.*
 PRL      SPACE  4,20
**        PRL - PROCESS *RL* DIRECTIVE.
*
*         PROCESS RELEASE LIMITS FOR DEVICES OR DEVICE TYPES.
*
*         ENTRY  (X6) = FIRST ARGUMENT.
*                (B6) = NEXT STRING BUFFER ADDRESS.
*                     = 0, IF TERMINATOR ENCOUNTERED.
*
*         EXIT   RELEASE LIMITS DEFINED.
*                TO *GEN1* IF NO ERRORS.
*                TO *GEN11*, *GEN12* OR *GEN13* IF ERROR DETECTED.
*
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 0, 1, 5, 6.
*                B - 6, 7.
*
*         CALLS  CAP, DXB, POP.
*
*         MACROS MESSAGE, WRITEC.
 
 
 PRL      BSS    0           ENTRY
          BX1    X6
          LX1    6
          SX1    X1-1R0
          BX5    X6
          NG     X1,PRL1     IF A DEVICE TYPE
          SB7    B0          INDICATE OCTAL CONVERSION
          RJ     DXB         CONVERT DEVICE NUMBER
          NZ     X4,GEN12    IF ERROR
          MX0    6           SET UP MASK FOR DEVICE NUMBER
          LX0    6
          EQ     PRL3        CHECK ACTIVE DEVICES
 
*         VALIDATE DEVICE TYPE.
 
 PRL1     SA2    PRLA
          RJ     CAP         CHECK FOR ALLOWABLE PATTERN
          NZ     X1,GEN12    IF NOT ALLOWABLE PATTERN
          MX0    12
          BX5    -X0*X6      NUMBER OF SPINDLES
          BX6    X0*X6       DEVICE MNEMONIC
          MX1    -3          MASK FOR SPINDLE COUNT
          ZR     X5,PRL2     IF NUMBER OF SPINDLES NOT SPECIFIED
          LX5    18
          SX5    X5-1R1
          BX7    X1*X5
          NG     X5,GEN12    IF NUMBER OF SPINDLES INCORRECT
          NZ     X7,GEN12    IF TOO MANY SPINDLES SPECIFIED
 PRL2     LX5    6
          BX6    X5+X6       MERGE SPINDLES WITH DEVICE TYPE
          LX1    6
          BX0    -X1+X0      DEVICE TYPE / SPINDLES MASK
 
*         FIND MATCHING CATALOG DEVICE ENTRY.
*         (X0) = MASK FOR DEVICE NUMBER OR DEVICE TYPE/SPINDLES.
*         (X6) = DEVICE NUMBER OR DEVICE TYPE/SPINDLES SPECIFIED.
 
 PRL3     SA1    TCDV        GET FIRST ACTIVE DEVICE TABLE ENTRY
          BX7    X7-X7       CLEAR FOR TRACK DATA
          MX2    36          SET UP MASK
 PRL4     BX5    X0*X1
          BX5    X5-X6
          NZ     X5,PRL5     IF DEVICE TYPE/NUMBER DOES NOT MATCH
          LX1    12          POSITION TRACK SIZE
          BX5    X2*X1
          LX5    -12
          IX1    X5-X7
          ZR     X7,PRL4.1   IF FIRST MATCHING ENTRY
          PL     X1,PRL5     IF PREVIOUS ENTRY HAD LESS AVAILABLE
 PRL4.1   BX7    X5
          SA7    PRLB        SAVE TRACK SIZE, AVAILABLE AND TOTAL
 PRL5     SA1    A1+TCDVE    GET NEXT CATALOG DEVICE ENTRY
          NZ     X1,PRL4     IF NOT END OF TABLE
          NZ     X7,PRL5.1   IF A MATCH WAS FOUND
          SX5    ERDT        * DEVICE TYPE/NUMBER NOT FOUND.*
          MESSAGE  X5,3
          WRITEC O,X5
          EQ     GEN1        RETURN
 
*         ADD VALIDATED ENTRY TO SELECTED DEVICE TABLE.
*         (X0) = MASK FOR DEVICE NUMBER OR DEVICE TYPE/SPINDLES.
*         (X6) = DEVICE NUMBER OR DEVICE TYPE/SPINDLES SPECIFIED.
 
 PRL5.1   SA1    TSDV        GET FIRST SELECTED DEVICE TABLE ENTRY
          ZR     X1,PRL7     IF TABLE IS EMPTY
 PRL6     BX5    X0*X1
          BX1    X5-X6
          ZR     X1,PRL7     IF MATCHING ENTRY FOUND IN TABLE
          SA1    A1+TSDVE
          NZ     X1,PRL6     IF ANOTHER ENTRY TO CHECK
          PL     X1,PRL7     IF ROOM IN TABLE TO ADD NEW ENTRY
          SX5    PRLC        * TOO MANY DEVICE SELECTION (RL) ENTRIES.*
          EQ     GEN13       ISSUE ERROR MESSAGE
 
 PRL7     SA6    A1          ADD ENTRY TO TABLE
          SA0    A1          SAVE ADDRESS OF ENTRY
 
*         PROCESS REQUIRED TRACKS ARGUMENT IF PRESENT.
*         (A0) = ADDRESS OF SELECTED DEVICE ENTRY.
 
          NG     B6,PRL8     IF NO SEPARATOR/TERMINATOR
          ZR     B6,PRL8     IF NO MORE ARGUMENTS
          RJ     POP         PICK OUT NEXT ARGUMENT
          NZ     B5,GEN11    IF ERROR OR ARGUMENT TOO LONG
          NZ     B6,GEN11    IF TOO MANY ARGUMENTS
          BX5    X6
          SB7    B0          INDICATE OCTAL CONVERSION
          RJ     DXB         CONVERT REQUIRED TRACKS
          NZ     X4,GEN12    IF ERROR
          SA5    PRLB        CHECK TOTAL TRACKS
          MX0    -12
          AX5    12
          BX1    -X0*X5      TOTAL TRACKS
          IX1    X1-X6
          PL     X1,PRL8     IF LESS REQUIRED THAN TOTAL
          IX6    X1+X6       SET REQUIRED EQUAL TO TOTAL
 PRL8     AX5    12
          BX1    -X0*X5      AVAILABLE TRACKS
          IX1    X6-X1
          PL     X1,PRL11    IF SUFFICIENT TRACKS NOT ALREADY AVAILABLE
          SX5    ERST        * SUFFICIENT TRACKS ALREADY AVAILABLE.*
          MESSAGE  X5,3
          WRITEC O,X5
          SA1    TSDVE+A0    MOVE ALL FOLLOWING ENTRIES BACK ONE
 PRL9     BX6    X1
          SA1    A1+B1
          NZ     X6,PRL10    IF NOT AN EMPTY ENTRY
          SX6    B0+
          SX1    B0+
 PRL10    SA6    A0
          BX7    X1
          SA1    A1+B1
          SA7    A6+B1
          SA0    A7+B1
          NZ     X6,PRL9     IF ALL ENTRIES NOT MOVED
          EQ     GEN1        RETURN
 
*         CONSTRUCT SELECTED DEVICE TABLE ENTRY.
*         (A0) = ADDRESS OF ENTRY.
*         (X5) = TRACK SIZE (BITS 23-12).
*         (X6) = TRACKS GOAL.
 
 PRL11    SA1    A0
          AX5    12          TRACK SIZE
          MX0    24
          IX6    X5*X6       TOTAL SECTORS REQUIRED
          LX0    12
          BX1    X0*X1       DEVICE TYPE/NUMBER
          LX5    36          TRACK SIZE
          LX6    12          REQUIRED SECTORS
          BX6    X5+X6       TRACK SIZE AND REQUIRED SECTORS
          BX6    X1+X6       ADD DEVICE TYPE/NUMBER
          SA6    A0
          EQ     GEN1        RETURN
 
 
 PRLA     VFD    9/113B,51/0 PATTERN FOR DEVICE TYPE CHECK
 PRLB     BSS    1           TEMPORARY STORAGE
 PRLC     DATA   C* TOO MANY DEVICE SELECTION (RL) ENTRIES.*
 PSF      SPACE  4,15
**        PSF - PROCESS *SF* AND *XF* DIRECTIVES.
*
*         PROCESS SPECIFIC FILE/USER INDEX SELECTIONS AND EXCLUSIONS.
*
*         ENTRY  (X6) = FIRST ARGUMENT.
*                (B6) = NEXT STRING BUFFER ADDRESS.
*                     = 0, IF TERMINATOR ENCOUNTERED.
*
*         EXIT   SPECIFIED FILE SELECTIONS STORED.
*                TO *GEN1* IF NO ERRORS.
*                TO *GEN11* OR *GEN12* IF ERROR DETECTED.
*
*         USES   X - 0, 2, 5, 6.
*                A - 0, 2, 5, 6.
*                B - 7.
*
*         CALLS  DXB, PFV, POP.
 
 
 PSF      BSS    0           ENTRY
          ZR     X6,GEN11    IF NO USER INDEX SPECIFIED
          BX5    X6
          SB7    B0          INDICATE OCTAL CONVERSION
          RJ     DXB
          NZ     X4,GEN12    IF ERROR
          ZR     X6,GEN12    IF USER INDEX IS ZERO
          MX0    -17
          BX5    X0*X6
          NZ     X5,GEN12    IF USER INDEX EXCEEDS 377777B
          SA5    TDIRX
          SA2    DIRV
          MX0    -18
          BX5    X0*X5
          BX5    X2-X5
          NZ     X5,PSF1     IF NOT EXCLUSION DIRECTIVE
          BX6    -X0-X6      INVERT USER INDEX FOR EXCLUSIONS
 PSF1     SA5    PSFA        ADD USER INDEX TO PATTERN
          BX5    X0*X5
          BX6    X5+X6
          SA6    A5
          BX6    X6-X6       CLEAR FILE NAME
          NG     B6,PSF2     IF NO TERMINATOR
          ZR     B6,PSF2     IF NO MORE ARGUMENTS
          RJ     POP         GET FIRST FILE NAME
          NZ     B5,GEN11    IF ERROR EXTRACTING ARGUMENT
 PSF2     SA0    PSFA
          RJ     PFV         PROCESS POSSIBLE LIST OF FILE NAMES
          EQ     GEN1        RETURN
 
 
 PSFA     VFD    21/4444444B,21/0,18/0  PATTERN / USER INDEX
 PSFB     CON    77777777777777000000B  MASK FOR FILE NAMES IN *PFV*
 PSFC     DATA   C* ENTER FILE NAME(S).*  PROMPT
 PSV      SPACE  4,15
**        PSV - PROCESS *SV* DIRECTIVE.
*
*         PROCESS ALTERNATE STORAGE VSN SPECIFICATIONS.
*
*         ENTRY  (X6) = FIRST ARGUMENT.
*                (B6) = NEXT STRING BUFFER ADDRESS.
*                     = 0, IF TERMINATOR ENCOUNTERED.
*
*         EXIT   ALTERNATE STORAGE VSN ENTRIES PROCESSED.
*                TO *GEN1* IF NO ERRORS.
*                TO *GEN12* FROM *PFV* IF ERROR DETECTED.
*
*         USES   A - 0.
*
*         CALLS  PFV.
 
 
 PSV      BSS    0           ENTRY
          SA0    PSVA
          RJ     PFV         PROCESS POSSIBLE LIST OF VSN-S
          EQ     GEN1        RETURN
 
 
 PSVA     VFD    18/443333B,42/0        PATTERN
 PSVB     CON    77777777777700000000B  MASK FOR VSN-S IN *PFV*
 PSVC     DATA   C* ENTER VSN(S).*      PROMPT
 PTD      SPACE  4,20
**        PTD - PROCESS *D* DIRECTIVE.
*
*         EXTRACT AND STORE THE DESTAGE TAPE DENSITY.
*
*         ENTRY  (X6) = FIRST ARGUMENT.
*
*         EXIT   (DENS) = NUMBER OF BYTES/INCH FOR SELECTED DENSITY.
*                (GAPS) = SIZE OF INTERRECORD GAP IN INCHES*32.
*                (CTSF) = NONZERO IF CARTRIDGE TAPE DENSITY.
*                TO *GEN1* IF NO ERRORS.
*                TO *GEN12* IF ERROR DETECTED.
*
*         USES   X - 0, 1, 5, 6.
*                A - 1, 6.
 
 
 PTD      BSS    0           ENTRY
          MX0    30
          SA1    TDEN-1
 PTD1     SA1    A1+1
          ZR     X1,GEN12    IF NOT A VALID TAPE DENSITY
          BX5    X1-X6
          BX5    X0*X5
          NZ     X5,PTD1     IF NO MATCH
          MX0    -18
          BX6    -X0*X1      SAVE THE DENSITY
          SA6    DENS
          MX0    -11
          AX1    18          SAVE THE GAP SIZE
          BX6    -X0*X1
          MX0    -1
          SA6    GAPS
          AX1    11          SAVE THE CARTRIDGE TAPE FLAG
          BX6    -X0*X1
          SA6    CTSF
          EQ     GEN1        RETURN
 PTF      SPACE  4,20
**        PTF - PROCESS *F* DIRECTIVE.
*
*         EXTRACT AND STORE THE DESTAGE TAPE FORMAT.
*
*         ENTRY  (X6) = FIRST ARGUMENT.
*
*         EXIT   (PBLK) = NUMBER OF DISK PRU-S PER TAPE BLOCK (MINUS 1).
*                TO *GEN1* IF NO ERRORS.
*                TO *GEN12* IF ERROR DETECTED.
*
*         USES   X - 0, 1, 5, 6.
*                A - 1, 6.
 
 
 PTF      BSS    0           ENTRY
          MX0    12
          SA1    TFMT-1
 PTF1     SA1    A1+1
          ZR     X1,GEN12    IF NOT A VALID TAPE FORMAT
          BX5    X1-X6
          BX5    X0*X5
          NZ     X5,PTF1     IF NO MATCH
          MX0    -12
          BX6    -X0*X1      SAVE THE PRU-S PER TAPE BLOCK
          SA6    PBLK
          EQ     GEN1        RETURN
          TITLE  SECONDARY SUBROUTINES.
 CAP      SPACE  4,30
**        CAP - CHECK FOR ALLOWABLE PATTERNS.
*
*         CHECK PARAMETERS FOR ALLOWABLE CHARACTER PATTERNS.
*
*         ENTRY  (X5) = PARAMETER, LEFT JUSTIFIED ZERO FILLED.
*                (X2) = PATTERN, LEFT JUSTIFIED ZERO FILLED.  PATTERN
*                       CONSISTS OF ONE OCTAL DIGIT FOR EACH CHARACTER
*                       POSITION OF THE PARAMETER.  EACH OCTAL DIGIT
*                       INDICATES THE CHARACTERS THAT ARE VALID FOR
*                       THAT CHARACTER POSITION, AS FOLLOWS.
*
*                       0 - ANY CHARACTER.
*                       1 - CHARACTERS A THROUGH Z.
*                       2 - DIGITS 0 THROUGH 4.
*                       3 - DIGITS 0 THROUGH 9.
*                       4 - CHARACTERS A THROUGH Z, DIGITS 0 THROUGH 9.
*                       5 - NO CHARACTER IS VALID.
*
*         EXIT   (X1) = 0 IF PARAMETER MATCHES PATTERN.
*                (X1) .NE. 0 IF PARAMETER DOES NOT MATCH PATTERN.
*
*         USES   X - 1, 2, 4, 5.
*                A - 1.
*                B - 3, 4.
 
 
 CAP      SUBR               ENTRY/EXIT
 CAP1     LX5    6
          SX1    X5
          ZR     X1,CAPX     IF ALL CHARACTERS CHECKED
          BX5    X5-X1
          SB4    X1
          LX2    3
          SX1    X2          INDEX TO PATTERNS
          ZR     X1,CAP1     IF NO RESTRICTION ON THIS CHARACTER
          BX2    X2-X1
          LX1    2           PATTERN INDEX * 4
          SB3    X1
          LX1    1           PATTERN INDEX * 8
          SB3    B3+X1       PATTERN INDEX * 12
          SA1    CAPA
          MX4    -6
          LX1    X1,B3
          BX4    -X4*X1
          SB3    X4
          GT     B4,B3,CAPX  IF CHARACTER OUT OF RANGE
          MX4    -6
          LX1    -6
          BX4    -X4*X1
          SB3    X4
          GE     B4,B3,CAP1  IF CHARACTER WITHIN RANGE
          EQ     CAPX        RETURN WITH ERROR INDICATION
 
 
 CAPA     VFD    12/2LAZ,12/2L04,12/2L09,12/2LA9,12/2L10
 GSH      SPACE  4,20
**        GSH - GET SUMMARY RECORD HEADER.
*
*         GSH IDENTIFIES A RECORD AND MOVES THE HEADER INFORMATION
*         TO THE WORKING STORAGE AREA.  GSH IS CALLED ONLY BY GSR, AND
*         SHOULD BE CONSIDERED AS A PART OF THAT ROUTINE.
*
*         ENTRY  (X6) = FIRST WORD OF RECORD HEADER.
*
*         EXIT   (X1) .EQ. 0 IF HEADER READ OK.
*                (X1) .NE. 0 IF EOR/EOF/EOI ON READ.
*                (GSRB) = HEADER SIZE - 1.
*                (GSRC) = ITEM SIZE.
*                (GSRE) = FIRST WORD OF RECORD HEADER.  THE REST OF THE
*                         HEADER FOLLOWS IN THE NEXT (GSRB) WORDS.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 6, 7.
*
*         MACROS READO, READW.
 
 
 GSH      SUBR               ENTRY/EXIT
          READO  X5
          NZ     X1,GSHX     IF EOR/EOF/EOI ON SUMMARY FILE
          SA6    GSRE
          MX0    42
          SA1    TCER-1
          BX6    X0*X6
 GSH1     SA1    A1+B1
          BX2    X0*X1
          ZR     X2,GSH2     IF AT END OF TABLE
          BX2    X2-X6
          NZ     X2,GSH1     IF NO MATCH ON THIS TYPE
 GSH2     MX0    -9
          BX6    -X0*X1      SAVE ITEM SIZE
          SA6    GSRC
          LX1    -9
          BX6    -X0*X1      SAVE HEADER SIZE
          SA6    GSRB
          BX1    X6
          ZR     X1,GSHX     IF NO HEADER INFO TO READ
          SA1    GSRE        DECREMENT WORD COUNT FOR HEADER
          IX7    X1-X6
          SA7    A1
          READW  X5,GSRE+1,X6  READ HEADER INFORMATION
          EQ     GSHX        RETURN
 GSR      SPACE  4,40
**        GSR - GET SUMMARY RECORD.
*
*         GSR LOCATES A SPECIFIED TYPE OF RECORD AND RETURNS IT TO
*         THE CALLER IN THE SPECIFIED LOCATION.
*
*         ENTRY  (A1) = ADDRESS OF FIRST WORD OF PARAMETER LIST.
*                (X1) = FIRST WORD OF PARAMETER LIST.
*
*                PARAMETER LIST IS AS FOLLOWS:
*
*                WORD 1 -    FWA OF REQUESTED RECORD TYPE.
*                            REQUESTED RECORD TYPES CAN BE:
*
*                            INIT    - OPEN/INITIALIZE FILE - RETURNS
*                                      THE PREFIX TABLE.
*                            SYSTEM  - RETURNS THE SYSTEM ID BLOCK.
*                            DEVSTAT - RETURNS A DEVICE STATUS ENTRY.
*                            CATE    - RETURNS A CATALOG ENTRY.
*
*                WORD 2 -    FWA OF FET.
*                WORD 3 -    FWA OF BUFFER TO RECEIVE DATA.
*                WORD 4 -    ADDRESS OF STATUS RETURN WORD.
*
*         EXIT   (STATUS WORD) = 0, A RECORD OF THE DESIRED TYPE WAS
*                                   RETURNED.
*                           .GT. 0, AN EXCEPTION OF SOME TYPE OCCURRED
*                                   ON THE *READW* CALL.  USUALLY THIS
*                                   WILL BE *EOR*, *EOF* OR *EOI*.
*                           .LT. 0, THE NEXT AVAILABLE RECORD IS NOT
*                                   THE REQUESTED TYPE, AFTER PREVIOUS
*                                   TRANSFER OF THAT RECORD TYPE.
*
*                (BUFFER) = A RECORD OF THE REQUESTED TYPE, PROVIDED
*                               THAT THE STATUS IS ZERO.
*
*                THE REQUESTED RECORD IS RETURNED TO SPECIFIED BUFFER.
*                THE RECORD RETURNED (EXCEPT WHEN THE REQUEST ISSUED IS
*                *INIT*) CONSISTS OF ONE RECORD TYPE WORD CONTAINING
*                THE RECORD IDENTIFIER AND THE COUNT OF REMAINING WORDS
*                IN THE CURRENT BLOCK, A COPY OF THE HEADER PORTION OF
*                THE RECORD, AND THE CURRENT ITEM OF THE RECORD.
*                THE LENGTHS OF THE HEADER AND ITEM PORTIONS OF THE
*                RETURNED RECORD DEPEND UPON THE PARTICULAR TYPE OF
*                RECORD BEING RETURNED.
*                THE DATA RETURNED IN RESPONSE TO THE *INIT* REQUEST
*                CONSISTS OF THE PREFIX TABLE FOR THE FILE.
*
*                TO *ABT* WITH MESSAGE IF SUMMARY FILE ERROR.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 3, 4, 6.
*                B - 2.
*
*         CALLS  GSH.
*
*         MACROS READ, READO, READW.
 
 
 GSR      SUBR               ENTRY/EXIT
          SX6    A1          SAVE THE CALLING SEQUENCE POINTER
          SA6    GSRA
          SA5    A1+B1       GET FET ADDRESS
          SA3    GSRE        CHECK CURRENT RECORD TYPE
          NZ     X3,GSR2     IF ALREADY INITIALIZED
 
*         PROCESS INITIAL REQUEST.
 
          READ   X5,R
          READO  X5          READ FIRST WORD OF FILE
          NZ     X1,GSR9     IF EOR/EOF/EOI ON SUMMARY FILE
          SA6    GSRE        SAVE RECORD TYPE INDICATOR
          SA1    GSRA        RESTORE ENTRY REGISTERS
          SA1    X1
          SA2    X1          GET REQUESTED RECORD TYPE
          SA3    GSRD        CHECK AGAINST PREFIX HEADER
          BX6    X3-X6
          NZ     X6,GSR10    IF NOT A CORRECT PREFIX RECORD
          SA3    =4LINIT
          BX6    X2-X3
          SA4    A1+2        GET BUFFER ADDRESS
          ZR     X6,GSR1     IF *INIT* REQUEST
          SX4    WSA         USE SCRATCH BUFFER IF NOT *INIT* REQUEST
 GSR1     SA3    GSRE
          BX6    X3
          LX3    12
          AX3    -12         NUMBER OF WORDS TO READ
          SA6    X4          SAVE PREFIX HEADER IN BUFFER
          SX4    X4+B1
          READW  X5,X4,X3    READ THE PREFIX TABLE INTO BUFFER
          SA2    GSRA
          SA3    X2+3        GET STATUS WORD ADDRESS
          BX6    X1
          SA6    X3          SAVE STATUS
          SA1    X2
          SA2    X1
          SA3    =4LINIT
          BX6    X2-X3
          ZR     X6,GSRX     IF REQUEST WAS *INIT*
 
*         SEARCH FOR REQUESTED RECORD TYPE.
 
 GSR2     SA2    X1          GET REQUESTED RECORD TYPE
          SA3    GSRE
          MX0    42
          BX6    X2-X3
          BX6    X0*X6
          ZR     X6,GSR5     IF REQUEST IS FOR CURRENT RECORD TYPE
 
*         REQUEST IS NOT FOR CURRENT RECORD TYPE - FIND NEXT RECORD.
 
          BX6    -X0*X3
          NZ     X6,GSR3     IF CURRENT BLOCK NOT EXHAUSTED
          RJ     GSH         GET CATALOG RECORD HEADER
          NZ     X1,GSR7     IF EOR/EOF/EOI ON SUMMARY FILE
          SA1    GSRA
          SA1    X1
          EQ     GSR2        CHECK IF REQUESTED RECORD TYPE
 
 GSR3     SX2    WSAL
          IX1    X6-X2
          BX6    X0*X3
          PL     X1,GSR4     IF REMAINING WORDS EXCEED SCRATCH BUFFER
          BX2    -X0*X3      SET REMAINING WORD COUNT
          BX1    X1-X1
 GSR4     BX6    X1+X6
          SA6    A3          UPDATE RECORD HEADER WORD COUNT
          READW  X5,WSA,X2
          NZ     X1,GSR7     IF EOR/EOF/EOI ON SUMMARY FILE
          SA2    GSRA
          SA1    X1
          EQ     GSR2        REPEAT UNTIL REQUESTED RECORD TYPE FOUND
 
*         REQUEST IS FOR CURRENT RECORD TYPE.
 
 GSR5     BX6    -X0*X3
          ZR     X6,GSR8     IF CURRENT BLOCK IS EXHAUSTED
          SA4    A1+2        GET BUFFER ADDRESS
          SA2    GSRB        HEADER SIZE
          SB2    X2
          SA2    GSRC        GET ITEM SIZE
          IX6    X3-X2       DECREMENT WORDS REMAINING
          SA6    A3+
 GSR6     SA6    X4          STORE WORD OF HEADER
          SA3    A3+B1
          SX4    X4+B1       INCREMENT BUFFER ADDRESS
          SB2    B2-B1
          BX6    X3
          PL     B2,GSR6     IF MORE WORDS TO TRANSFER
          READW  X5,X4,X2    READ NEXT ITEM INTO BUFFER AFTER HEADER
 GSR7     SA2    GSRA
          SA3    X2+3        GET STATUS WORD ADDRESS
          MX6    1
          BX6    -X6*X1
          SA6    X3+         SAVE STATUS
          EQ     GSRX        RETURN
 
 GSR8     RJ     GSH         GET CATALOG RECORD HEADER
          NZ     X1,GSR7     IF EOR/EOF/EOI ON SUMMARY FILE
          SA1    GSRA
          SA1    X1
          SA2    X1
          SA3    GSRE
          MX0    42
          BX6    X2-X3
          BX6    X0*X6
          ZR     X6,GSR5     IF STILL SAME RECORD TYPE
          SA2    A1+3
          MX6    1           STORE END OF CURRENT RECORD TYPE STATUS
          SA6    X2
          EQ     GSRX        RETURN
 
 GSR9     SX5    ERSE        * SUMMARY FILE IS EMPTY.*
          EQ     ABT         ABORT
 
 GSR10    SX5    ERSP        * SUMMARY FILE PREFIX TABLE ERROR.*
          EQ     ABT         ABORT
 
 
 GSRA     BSS    1           PARAMETER LIST ADDRESS
 GSRB     BSS    1           LENGTH OF RECORD HEADER PORTION
 GSRC     BSS    1           LENGTH OF RECORD ITEM PORTION
 GSRD     VFD    12/7700B,12/SFPTL,36/0  PREFIX TABLE HEADER
 GSRE     CON    0           RECORD IDENTIFIER WORD
          BSS    SFSHL       ALLOW FOR LONGEST RECORD HEADER
 
**        TABLE OF SUMMARY FILE RECORD TYPES.
*
*         *TCER* CONTAINS THE NAMES AND HEADER AND ITEM SIZES
*         ASSOCIATED WITH KNOWN SUMMARY FILE RECORD TYPES.
*         UNKNOWN RECORD TYPES CAN EXIST ON THE SUMMARY FILE.
*         THEY WILL BE CONSIDERED TO HAVE A HEADER LENGTH OF ZERO AND
*         AN ITEM SIZE OF ONE WORD FOR BYPASSING PURPOSES.
*
*T        42/ RID, 9/ HL, 9/ IL
*
*         RID    RECORD IDENTIFIER.
*         HL     NUMBER OF WORDS IN HEADER.
*         IL     NUMBER OF WORDS IN EACH ITEM.
 
 
 TCER     BSS    0
          VFD    42/0LSYSTEM,9/SFSHL,9/SFSIL
          VFD    42/0LDEVSTAT,9/SFDHL,9/SFDIL
          VFD    42/0LCATE,9/SFFHL,9/SFFIL
          VFD    42/0,9/0,9/1
 PFV      SPACE  4,15
**        PFV - PROCESS FILE NAMES AND VSN-S.
*
*         ENTRY  (X6) = FIRST FILE NAME OR VSN TO ADD TO TABLE.
*                (A0) = ADDRESS OF PARAMETER LIST.
*
*         EXIT   FILE NAME OR VSN ENTRIES ADDED TO *TSFV* TABLE.
*
*         ERROR  TO *GEN13* WITH ERROR MESSAGE AND POSSIBLE ABORT.
*
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 2, 5, 6, 7.
*                B - 2.
*
*         CALLS  CAP, DXB, POP, USB.
*
*         MACROS READ, READC, WRITEC, WRITEW.
 
 
 PFV      SUBR               ENTRY/EXIT
          SA5    TSFVP       SAVE CURRENT TABLE SIZE
          BX0    X5
          BX7    X5
          SA7    PFVC
 PFV1     SA2    A0+B1       GET MASK
          BX5    -X2*X6
          NZ     X5,PFV9     IF ARGUMENT IS TOO LONG
          SX5    X0-TSFVN
          ZR     X5,PFV8     IF TOO MANY FILES/VSN-S
          SA5    A0          GET USER INDEX/VSN FLAG WORD
          BX2    X2*X5       EXTRACT VERIFICATION PATTERN
          BX5    X5-X2       ISOLATE USER INDEX/VSN FLAG
          BX6    X5+X6       MERGE UI/VSN FLAG WITH FILE NAME/VSN
          SA6    TSFV+X0
          SX0    X0+1
          BX5    X6-X5       ISOLATE FILE NAME/VSN
          RJ     CAP         CHECK FOR ALLOWABLE PATTERN
          NZ     X1,PFV9     IF INCORRECT ARGUMENT
          SX1    X6
          NZ     X1,PFV2     IF NOT A VSN SPECIFICATION
          LX6    12
          MX1    24
          BX5    X1*X6       EXTRACT THE DIGITS FROM THE VSN
          BX6    X0
          SA6    PFVB
          SB7    B1+         INDICATE DECIMAL CONVERSION
          RJ     DXB
          NZ     X4,PFV9     IF ERROR IN CONVERSION
          SA1    PFVB        RESTORE TABLE POINTER
          BX0    X6
          AX0    12
          NZ     X0,PFV9     IF NUMERIC VALUE EXCEEDS 4095
          BX0    X1
          SA1    TSFV-1+X0
          MX5    24          REPLACE DISPLAY DIGITS WITH BINARY
          LX5    -12
          BX1    -X5*X1
          LX6    36
          BX6    X1+X6
          SA6    A1+
 PFV2     ZR     B6,PFV3     IF TERMINATOR ENCOUNTERED
          PL     B6,PFV4     IF MORE ARGUMENTS
 PFV3     BX6    X6-X6
          SA6    TSFV+X0
          BX6    X0          UPDATE TABLE SIZE
          SA6    TSFVP
          EQ     PFVX        RETURN
 
*         GET NEXT FILE NAME OR VSN.
 
 PFV4     RJ     POP
          NG     B5,PFV9     IF ERROR
          NZ     X6,PFV1     IF ANOTHER FILE NAME/VSN
          ZR     B6,PFV3     IF TERMINATOR ENCOUNTERED
          PL     B6,PFV4     IF MORE ON THIS LINE
          SA1    ZINF
          NZ     X1,PFV3     IF CALLED WITH *Z* OPTION
          SA1    IDTP
          NZ     X1,PFV6     IF NOT TERMINAL INPUT
          SX2    A0+2        ADDRESS OF PROMPT MESSAGE
          WRITEC O,X2
          READ   I,R
 PFV6     READC  I,LINE,8
          NZ     X1,PFV3     IF END-OF-RECORD FOUND
          SA1    ODTP
          ZR     X1,PFV7     IF OUTPUT FILE IS A TERMINAL FILE
          WRITEW O,BLNK,1    MOVE LINE OVER
          WRITEC O,LINE,8    COPY LINE OF FILE NAMES TO LISTING
 PFV7     SB2    LINE
          RJ     USB
          SX6    B7+B1
          SA6    A6
          SX6    1R.
          SA6    B7+B1
          EQ     PFV4        GET NEXT FILE NAME/VSN
 
*         TOO MANY ENTRIES.
 
 PFV8     SX5    PFVA        * TOO MANY FILE/VSN SELECTION ENTRIES.*
          EQ     PFV10       RESTORE *TSFV* TABLE AND ABORT
 
*         ERROR WHILE CRACKING FILE LIST.
 
 PFV9     SX5    ERDA        * DIRECTIVE ARGUMENT ERROR.*
 PFV10    SA1    PFVC        RESTORE *TSFV* TABLE
          BX6    X1
          SA6    TSFVP
          SX6    B0+
          SA6    TSFV+X1
          EQ     GEN13       DISPLAY ERROR AND ABORT
 
 
 PFVA     DATA   C* TOO MANY FILE/VSN SELECTION (SF SV XF) ENTRIES.*
 PFVB     BSS    1           TEMPORARY STORAGE
 PFVC     BSS    1           SIZE OF *TSFV* TABLE AT ENTRY
          TITLE  SORTMERGE PROCESSING 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.
*                *ERUN* 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+RPTR
          SA3    CITC
          SX6    B0+         CLEAR END OF RUN FLAG
          SA6    ERUN
          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    ERUN
          EQ     CITX        RETURN
 
 
 CITA     BSS    1           INPUT FET ADDRESS
 CITB     BSS    1           OUTPUT FET ADDRESS
 CITC     BSS    ITEML       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    ERUN
          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 THE *CF* FILE.
*                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   ITEML,X0+RPTR,X5
          READW  X0,X0+RPTR,ITEML
          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 MERGE RUN.
 
 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    NRUN
          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    NRUN
          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    NRUN        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+RPTR
          SA4    BF+RPTR
          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    ERUN
          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    ERUN
          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,ITEML
          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+RPTR,ITEML
          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     COMCCDD
*CALL     COMCCFD
*CALL     COMCCIO
*CALL     COMCCOD
*CALL     COMCCPM
*CALL     COMCDXB
*CALL     COMCLFM
*CALL     COMCMVE
*CALL     COMCPOP
*CALL     COMCRDC
*CALL     COMCRDO
*CALL     COMCRDW
*CALL     COMCSNM
*CALL     COMCSYS
*CALL     COMCUSB
*CALL     COMCWTC
*CALL     COMCWTO
*CALL     COMCWTS
*CALL     COMCWTW
*CALL     COMCZTB
          TITLE  FILE ENVIRONMENT TABLES.
 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)
 
 UD       BSS    0           UTILITY DIRECTIVE FILE
 UDIR     FILEB  UBUF,UBUFL,(FET=8)
 
 SUMMARY  BSS    0           SUMMARY FILE
 SUMMARY  FILEB  SBUF,SBUFL
 
 AF       BSS    0           MERGE SORT SCRATCH FILE ONE
 ZZZZZG1  FILEB  AFBUF,SMBFL,FET=MFETL
 APTR     BSSZ   ITEML
 AEOF     BSSZ   1
 
 BF       BSS    0           MERGE SORT SCRATCH FILE TWO
 ZZZZZG2  FILEB  BFBUF,SMBFL,FET=MFETL
 BPTR     BSSZ   ITEML
 BEOF     BSSZ   1
 
 CF       BSS    0           MERGE SORT FILE
 ZZZZZG3  FILEB  CFBUF,SMBFL,FET=MFETL
 CPTR     BSSZ   ITEML
 CEOF     BSSZ   1
          TITLE  PRS - PRESET ROUTINES.
          USE    PRESET
 PRS      SPACE  4,20
**        PRS - PRESET PROGRAM.
*
*         *PRS* CRACKS THE COMMAND, SETS UP FETS FOR I/O, DETERMINES
*         IF INPUT IS FROM A TERMINAL AND SETS FLAGS AND POINTERS.
*
*         USES   X - 0, 1, 2, 4, 6.
*                A - 0, 1, 2, 4, 6.
*                B - 1, 2, 3, 4, 5, 6.
*
*         CALLS  ARG, STF, ZAP.
*
*         MACROS CSET, GETJO, MESSAGE, READ, SETLOF.
 
 
 PRS      SUBR               ENTRY/EXIT
          SB1    1
 
*         CRACK PARAMETERS FROM COMMAND.
 
          SA1    ACTR        GET NUMBER OF ARGUMENTS
          SB4    X1+
          SA4    ARGR        GET FIRST ARGUMENT
          SB5    TCAT        COMMAND ARGUMENT TABLE ADDRESS
          RJ     ARG         PROCESS ARGUMENTS
          NZ     X1,PRS9     IF ERROR
 
*         CHECK FOR FILE NAME CONFLICTS.
 
          SB2    B0+         BEGINNING ORDINAL FOR LFN CHECK
          SB4    B2+TLFNL    TERMINATION ORDINAL FOR LFN CHECK
          MX0    42
 PRS1     SA1    TLFN+B2     NEXT ENTRY FROM ARGUMENT TABLE
          LX1    -30
          SA1    X1          LFN FROM FET
          BX1    X0*X1
          SB3    B2+B1       BEGIN CHECKING WITH FOLLOWING ENTRY
          EQ     B3,B4,PRS3  IF ALL LFNS HAVE BEEN CHECKED
 PRS2     SA2    TLFN+B3     NEXT ENTRY FROM ARGUMENT TABLE
          LX2    -30
          SA2    X2          LFN FROM FET
          BX2    X1-X2
          BX2    X0*X2
          ZR     X2,PRS9     IF FILE NAME CONFLICT
          SB3    B3+B1
          LT     B3,B4,PRS2  IF MORE LFNS TO CHECK
          SB2    B2+B1
          EQ     PRS1        PROCESS NEXT FILE IN LIST
 
*         PROCESS *Z* PARAMETER IF SPECIFIED.
 
 PRS3     SA1    ZINF        COMMAND LINE INPUT FLAG SET BY *ARG*
          ZR     X1,PRS4     IF *Z* ARGUMENT NOT GIVEN
          SX2    I           SET FET ADDRESS FOR *ZAP*
          RJ     ZAP         *Z* ARGUMENT PROCESSOR
 
*         DETERMINE JOB ORIGIN TYPE.
 
 PRS4     GETJO  JORG
          SA1    JORG
          SX2    X1-SYOT
          ZR     X2,PRS7     IF SYSTEM ORIGIN
          SX1    X1-IAOT
          NZ     X1,PRS5     IF THIS JOB IS NOT INTERACTIVE
          CSET   NORMAL
          MX6    1           INDICATE CHARACTER SET CHANGED
          SA6    CSET
 
*         CHECK FOR TERMINAL FILES.
 
 PRS5     SA1    ZINF
          NZ     X1,PRS6     IF INPUT IS FROM COMMAND LINE
          SX2    I
          RJ     STF         CHECK FOR INPUT FILE DISPOSITION
          SA6    IDTP
          ZR     X6,PRS6     IF INPUT IS A TERMINAL FILE
          READ   I           READ FIRST PART OF DISK INPUT FILE
 PRS6     WRITE  O,*         PRESET WRITE FUNCTION
          SX2    O           CHECK OUTPUT FILE EQUIPMENT TYPE
          RJ     STF
          SA6    ODTP
          MX0    42
          NZ     X6,PRS7     IF OUTPUT NOT ASSIGNED TO TERMINAL
          SETLOF LOFP        SET LIST-OF-FILES ADDRESS
          EQ     PRS8        CONVERT PROCESSING OPTION
 
 PRS7     GETPP  OBUF,PRSB,PRSC  GET PRINT PARAMETERS
          WRITEC O,PRSC      SET PRINT DENSITY
          WRITEC O,PRSD      ISSUE PAGE EJECT
 PRS8     SA1    POPT        VALIDATE AND CONVERT PROCESSING OPTION
          LX1    6
          SX6    X1-1RD
          SX1    X1-1RR
          SA6    POPT
          ZR     X6,PRSX     IF *PO=D*
          ZR     X1,PRSX     IF *PO=R*
 PRS9     SX5    PRSA        * GENPFD ARGUMENT ERROR.*
          EQ     ABT         ABORT
 
 
 PRSA     DATA   C* GENPFD ARGUMENT ERROR.*
 PRSB     BSS    1
 PRSC     BSS    1           PRINT DENSITY FORMAT EFFECTOR
 PRSD     DATA   0L1         PAGE EJECT FORMAT EFFECTOR
          SPACE  4,10
*         COMMAND ARGUMENT TABLE.
 
 TCAT     BSS    0                 COMMAND ARGUMENT TABLE
 TLFN     BSS    0                 FILE NAME ARGUMENT LIST
 I        ARG    I,I               INPUT DIRECTIVE FILE NAME
 L        ARG    O,O               LIST OUTPUT FILE NMAE
 U        ARG    UNITS,UNITS       UNITS PARAMETER
 S        ARG    SUMMARY,SUMMARY   SUMMARY FILE NAME
 UD       ARG    UDIR,UDIR         UTILITY DIRECTIVE FILE NAME
 TLFNL    EQU    *-TCAT            LENGTH OF FILE NAME ARGUMENT LIST
 
 Z        ARG    -BLNK,ZINF        *Z* INPUT FLAG
 PO       ARG    POPT,POPT         PROCESSING OPTION
          CON    0                 ARGUMENT LIST TERMINATOR
          SPACE  4,10
*         PRESET COMMON DECKS.
 
 
*CALL     COMCARG
*CALL     COMCSTF
*CALL     COMCZAP
          SPACE  4,10
*         BUFFERS.
 
          USE    BUFFERS
 
          LIST   G
 BEGIN    BSSN   PRS
 AFBUF    BSSN   SMBFL       MERGESORT SCRATCH ONE BUFFER
 BFBUF    BSSN   SMBFL       MERGESORT SCRATCH TWO BUFFER
 CFBUF    BSSN   SMBFL       SELECTION/MERGE SORT BUFFER
 IBUF     BSSN   IBUFL       INPUT BUFFER
 OBUF     BSSN   OBUFL       OUTPUT BUFFER
 SBUF     BSSN   SBUFL       SUMMARY FILE BUFFER
 UBUF     BSSN   UBUFL       UTILITY DIRECTIVES BUFFER
 WSA      BSSN   WSAL        WORKING STORAGE BUFFER
 PAD      BSSN   20B         UNUSED END OF FL BUFFER AREA
 
 RFL=     BSSN   0           SET INITIAL FIELD LENGTH
 END      BSSN
          LIST   *
          SPACE  4,10
*         OVERFLOW CHECK.
 
 
          USE    PRESET
          ERRPL  *-IBUF      PRESET OVERFLOWS INTO INPUT BUFFER
          SPACE  4
          END    GENPFD