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