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