Trailing-Edge
-
PDP-10 Archives
-
BB-R775B-BM
-
source/dumper.mac
There are 42 other files named dumper.mac in the archive. Click here to see a list.
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1983 BY DIGITAL EQUIPMENT CORPORATION,
; MAYNARD, MASS.
IFNDEF DSKDMP,<DSKDMP==0> ; Build tape version
IFNDEF T20V6,<T20V6==0> ; Security enhancements
SEARCH MONSYM,MACSYM,QSRMAC,GLXMAC,ACTSYM
IFN DSKDMP,<SEARCH SPSYM>
TITLE DUMPER
SALL
.REQUIRE SYS:MACREL
.REQUIRE SYS:ARMAIL ; Need mailing routines
.DIRECT FLBLST
EXTERN MLTOWN,MLTLST,MLDONE,MLINIT
EXTERN .JBOPS ;135 NON-ZERO = USE PRIVATE QUASAR
; VERSION NUMBER DEFINITIONS
VMAJOR==4 ;MAJOR VERSION OF DUMPER
VMINOR==1 ;MINOR VERSION NUMBER
VEDIT==402 ;EDIT NUMBER
VWHO==0 ;GROUP WHO LAST EDITED PROGRAM (0=DEC DEVELOPMENT)
; 1=BBN
VDUMPR== <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
SUBTTL EDIT HISTORY/jbs/kmr/mfb/eds
; DBELL 17-Feb-78
; Handle full wildcards in RESTORE command by calling CHKWLD
; routine.
;
; PORCHER 16-Mar-78
; Changes for multiple record blocking.
;
; DBELL 17-Mar-78
; Don't set protection from tape if restoring in interchange
; mode.
;
; DBELL 21-Mar-78
; Allow /INCREMENTAL switch if not WHEEL, but then complain.
;
; PORCHER 30-Mar-78
; Update to version 4(166), miscellaneous bug fixes and:
;TCO 1892 Auto-unload for multi-reel savesets, UNLOAD command.
;TCO 1893 Don't abort command if "file not found" in SAVE command
;TCO 1894 Allow just date in BEFORE/SINCE commands.
;TCO 1895 Copy protection/account from output spec in SAVE/RESTORE.
;
; PORCHER 31-Mar-78
; Make BEGUSR copy entire directory name string, use directory
; string (with wildcards) from user for RCDIR% on SAVE, allow
; TTY output after interrupted "PRINT TTY:".
;TCO 1986 Print filename properly on restore errors.
;
; PORCHER 6-Apr-78
; Make all errors type <CR> only if not at left margin already,
; put MTBUF1 and MTBUF2 on page boundry for blocking factor of
; 15.
;
; PORCHER 12-Apr-78
; Fix expression for MTBUF2 due to MACRO bug.
;
; PORCHER 13-Apr-78
; Make checksum errors interruptible, allow for "DUMPX3" - buffer
; size too big.
;
; PORCHER 18-Apr-78
;TCO 1903 Add /FULL-INCREMENTAL, /INCREMENTAL:n, no restore of backup
; words.
;
; PORCHER 27-Apr-78
; Fix bugs in /INCREMENTAL.
;
; PORCHER 10-May-78
;TCO 1909 Use system default account if tape account invalid on restore,
; make backspace to beginning of tape only warning error.
;
; PORCHER 16-May-78
;TCO 1910 Handle zero byte size correctly in interchange mode.
;
; PORCHER 19-May-78
;TCO 1913 Increase filespec default areas to 20 words.
;TCO 1914 Remove DUMPER version herald.
;
; FORTMILLER 2-Jun-78
;TCO 1891 Add 6250 BPI.
;
; PORCHER 12-Jul-78
;TCO 1942 Indicate missing pages on restore.
;TCO 1943 Remove RPACS% for existing pages on save.
;TCO 1944 Add file number checking.
;
; PORCHER 11-Aug-78
; Fix file number checking across tape boundries, update to
; version 4(174).
;
; DBELL 17-Aug-78
; Change "?" to "%" in "No files dumped" message.
;
; DBELL 22-Aug-78
;TCO 4.1990 Allow opening of list devices such as MTA0: and PLPT0:.
;
; DBELL 14-Sep-78
; Fix once again the problem of restored files in interchange
; mode having their protection set to 0.
;
; CALVIN 18-Sep-78
; Merge in ARCHIVE/VIRTUAL disk code.
;
; DBELL 25-Sep-78
;TCO 4.2020 Make multi-reel CHECK command work properly.
;
; CALVIN 2-Oct-78
; Install code to handle old style archive tapes.
;
; DBELL 3-Oct-78
;TCO 4.2029 Fix "JFN not assigned" error during incremental save at FIXBCK.
;
; DBELL 12-Oct-78
;TCO 4.2043 Fix infinite loop when saving file which is multiple of 512
; pages.
;
; CALVIN 12-Oct-78
; Begin installing IPCF stuff for communication with QUASAR.
;
; DBELL 23-Oct-78
;TCO 4.2061 Fix extraneous "Tape has files missing" messages when a
; restore is not started on the first tape.
;
; CALVIN 9-Nov-78
; REPEAT 0 out expiration code
;
; DBELL 20-Nov-78
; Remove CHKWLD routine finally, and use WILD% JSYS instead.
;
; LCAMPBELL 27-Nov-78
; Add QUIT as synonym for EXIT.
;
; CALVIN 30-Nov-78
; Fix host output code and subroutinize it (code was in 3
; places).
;
; CALVIN 15-Dec-78
; Change to release 4 style QUASAR.
;
; DBELL 18-Feb-79
;TCO 4.2192 Make the device DSK*: work properly in SAVE and RESTORE.
;
; R.ACE 26-Feb-79
; Implement the following features: make DUMPER conscious of
; unlabeled MT devices, VOLIDs, etc.; remove archiving tape
; numbering scheme.
;
; DBELL 28-Feb-79
; At OFNAM2 fix "Invalid wildcard" error on restoring interchange
; mode files.
;
; HURLEY.CALVIN 5-Mar-79
; Add time stamp in retrieved message.
;
; R.ACE 8-Mar-79
; Duplicate use of PDB was causing retrieval mounts to hang so
; create MPDB for mounting tapes.
;
; KONEN 10-Mar-79
; Update copyright for release 4.
;
; R.ACE 15-Mar-79
; Fix handling of errors from GTJFN% on offline file pointer,
; bypass structure regulations if WHEEL or OPERATOR enabled.
;
; DBELL 15-Mar-79
; Add a CRLF in the "Not dumped" message at NDMESS+7.
;
; R.ACE 16-Mar-79
; Add ERJMP after RCDIR% in LODUSR.
;
; R.ACE 17-Mar-79
; Fix bug when retrieving invisible files that span volumes.
; This fix has the side effect of making all retrieved files
; visible.
;
; R.ACE 21-Mar-79
; Ignore errors from CHFDB% setting file invisible to permit
; REL4 DUMPER to run error-free on REL3A.
;
; HURLEY.CALVIN 21-Mar-79
; Define BBN 101B FDB offsets and use them properly in OLDAFX.
;
; R.ACE 30-Mar-79
; Take out PROLOG macro reference, define logical name RETRVL:
; for retrieval tapes, rearrange MREQ routine, add NTAPER entry
; to NTAPE to rewind after tape is gotten, don't display tape
; number for virtual disk tapes.
;
; DBELL 1-Apr-79
; Make defaults for saving and restoring be as follows:
; SAVE (FROM) DSK*:<CONN-DIR> (TO) SAME-AS-INPUT-SPEC
; RESTORE (FROM) DSK*:<CONN-DIR> (TO) SAME-AS-INPUT-SPEC.
;
; KONEN 6-Apr-79
; Make usage structure entries in SIXBIT.
;
; KONEN 11-Apr-79
; Correct 7 bit to 6 bit conversion.
;
; R.ACE 12-Apr-79
; Fix retrieval to requeue request is losing because no disk
; space, add private-QUASAR code, change occurrences of T1, T2,
; T3, and T4 to A, B, C, and D, respectively.
;
; R.ACE 13-Apr-79
; Remove /COLLECT switch from SAVE command.
;
; R.ACE 17-Apr-79
; Clear RETSW on CHECK and RESTORE commands, don't accept
; switches on RETRIEVE command.
;
; R.ACE 21-Apr-79
; Fix problem of tape number getting reset to 1, lay more
; groundwork for labeled tape support, add code to WASHOU to set
; AR%RFL bit in FDB.
;
; R.ACE 23-Apr-79
; Add box-type comments describing tape formats.
;
; DBELL 26-Apr-79
; Have SETGJB always setup default pointers for device and
; directory.
;
; DBELL 3-May-79
; Make PRINT command do all volumes in the set, permit use of
; TOPS-20 labeled tapes, fix labeled tape bugs in record sequence
; bookkeeping.
;
; R.ACE 4-May-79
; Get rid of REDEOT flag - use PAGNO instead, put ERJMP after
; MSTR% to allow running R4 DUMPER on TOPS-20 R3A .
;
; DBELL 21-May-79
;TCO 4.2255 Change defaults (again) for SAVE and RESTORE to be your
; connected structure and directory.
;
; R.ACE 22-May-79
; Miscellaneous fixes.
;
; R.ACE 7-Jun-79
; Fix so default filespec for retrieve uses DSK*:, fix all error
; message to have no space after "?" or "%", don't set data mode
; when opening tape just for rewind (on labeled tapes, this can
; cause movement and possible MTOPR% failure).
;
; R.ACE 17-Jun-79
; Fix unlabeled backspace bugs when BOT is encountered, ARCFIX -
; don't do ARCF%s if not privileged.
;
; R.ACE 21-Jun-79
;TCO 4.2306 Fix losing page if continued after over-quota failure.
;
; R.ACE 12-Jul-79
;TCO 4.2323 Permit use of ANSI labeled tapes.
;
; R.ACE 27-Jul-79
;TCO 4.2352 Don't unload after save with wildcard dir. specification.
;
; R.ACE 23-Aug-79
;TCO 4.2390 Incremental saves - call PASS2 for all filespecs, proscribe
; "AS" filespec for archive/migration/incremental saves.
;
; R.ACE 7-Sep-79
; For BBN - don't do ARCF%s in OLDAFX if not enabled.
;
; DBELL 10-Sep-79
;TCO 4.2450 Prevent "Invalid wildcard" in interchange mode (again).
;
; R.ACE 12-Sep-79
;TCO 4.2458 Don't clear TNSF in TAPE and REWIND commands.
;
; R.ACE 20-Sep-79
;TCO 4.2477 Clean up "Unable to set tape data mode" bit.
;
; R.ACE 25-Sep-79
;TCO 4.2484 Labeled tape skip - don't stop at end of volume.
;
; R.ACE 19-Oct-79
; Change tag of "PRINT" command handler from "$DIR" to "PRINT"
; because of conflict with $DIR macro in GLXMAC, fix restore of
; invisible bit for BBN tapes.
;
; R.ACE 12-Dec-79
;TCO 4.2593 Fix for restoring archived files, fix for clearing AR%RAR.
;
; R.ACE 3-Jan-80
; Update copyright date.
;
;304 TG 22-May-80 SPR#: 20-14115
;TCO 4.2609 Make HELP command look on HLP: and then SYS: for DUMPER.HLP
;
;305 TG 22-May-80 SPR#: 20-12762
;TCO 4.2610 Fix infinite loop on SKIP 0 and SKIP -n commands in interchange
; mode by setting proper record type at T.END, then RETSKP so
; record is not ignored.
;
;306 TG 4-Sep-81 SPR#: 20-14491
;TCO 4.2611 When doing a RESTORE, DUMPER loops causing "? Sequence
; error...". Add MT%IRL to arg list when checking for abort
; conditions.
;
;307 JBS 1-APR-81 SPR#: 20-15751
; Add code to JSERR1 to type PC of failing JSYS error, update all
; routines which call to JSERR1 to conform to new calling
; procedures, begin edit history.
;
;310 KMR 5-Apr-81 SPR#: 20-14716
; Fix usage accounting at locations VUSABL, ARFXB1, FIXFD1.
; Major edit includes rearrangement of usage block for the USAGE%
; JSYS.
;
;311 JBS 7-Apr-81 SPR#: 20-15062
; Add question mark to error typeout if argument to TAPE command
; is not a magtape device.
;
;312 JBS 7-Apr-81 SPR#: 20-15800
; Clear typeahead buffer after [real] ^E.
;
;313 KMR 8-May-81 SPR#: 20-15873
; Change IPCF quotas from 777 to 10 to prevent QUASAR from
; over-checkpointing DUMPER.
;
;314 KMR 31-Jun-81
; Make DUMPER talk to newer versions of Galaxy. Make MRECV%
; not block on messages and reloop so it it doesn't DEBRK% while
; there are some in the queue.
;
;315 KMR 24-Jul-81 SPR#: 20-16088
; Clean up some more problems with usage accounting.
;
;316 MFB 3-Aug-81 SPR#: 20-14734
; Make sure JFN (for current load/restore file) is closed when
; interrupted by ^E to avoid invalid simultaneous access.
;
;317 EDS 3-Aug-81 SPR#: 20-15106
; Restrict the maximum number of characters in the saveset name
; (SSNAME) to NSSNBF-1 characters.
;
;320 EDS 5-Aug-81 SPR#: 20-14995
; Change MASK table to let WHEELs restore the left half of
; .FBBK0 in the FDB. This prevents a file from being saved on
; the next incremental after having been restored from a
; FULL-INCREMENTAL saveset. Don't save tape count when not doing
; an INCREMENTAL type save.
;
;321 MFB 6-Aug-81 SPR#: 20-15470
; Make GJFX44 (account string does not match) error be handled
; the same way as VACCX0 (invalid account). Use the
; SYSTEM-DEFAULT account, give a warning message and continue the
; RESTORE.
;
;322 EDS 13-Aug-81 SPR#: 20-15573
; Replace edit 305 with one that works and doesn't restrict
; INTERCHANGE tapes to 1 saveset. Make SKIP command default to
; SKIP 1 saveset.
;
;323 BPK 14-Aug-81 SPR#: 20-14279, 20-16177
; When saving multiple directories into the same directory on
; tape, make sure the file and page counts get reset properly
; between directories.
;
;324 EDS 14-Aug-81 SPR#: 20-15905
; Add test for INTERCHANGE mode to LODTST. If ICMODF is set
; pass the file name off to FIXFMM which will put ^V before
; special characters.
;
;325 EDS 20-Aug-81 SPR#: 20-16484
; Fix problem during volume switch of LABELED tapes and the
; operator refuses to mount the next volume of the tape set.
; Close magtape, setup for new tape and return to process more
; commands.
;
;326 EDS 24-Aug-81 SPR#: 20-15642
; Allow interrupt (^E) during tape filspec prompt given when no
; TAPE command has been given in commands: REWIND, PRINT and
; RESTORE.
;
;327 EDS 31-Aug-81 SPR#: 20-16182 & 20-16651
; Fix SKIP N on LABELED tapes. Doing a backspace file and
; forwardspace file can cause a large amount of tape motion which
; is unnecessary and wastes time. Note: This edit produces the
; restriction that the header of the saveset being skipped TO is
; not printed (labeled tapes only).
;
;330 EDS 10-Sep-81 SPR#: 20-16010
; Fix the .FBBK0 word of the FDB after archive/migration runs so
; the files updated FDB will be saved on subsequent incremental
; saves.
;
;331 MFB 11-Sep-81 SPR#: 20-15012
; If the tape drive drops off line during a SAVE, issue an error
; message, give up, and go back to command level.
;
;332 EDS 18-Sep-81 SPR#: 20-15457
; When a RETRIEVE will force the directory over its permanent
; disk quota, cancel the retreival and send messages to the user
; and the requestor about the retrieval failure.
;
;333 MFB 21-Sep-81 SPR#: 20-15529
; Alter some continuable error messages to use the "$" (dollar
; sign) prompt so the operator can respond to them under BATCH.
;
;334 EDS 28-Sep-81 SPR#: 20-15130
; Make INTERCHANGE routines ICICNV and ICOCNV ignore comment and
; filler record types. Make MTFILL just return if INTERCHANGE
; mode.
;
;335 EDS 29-Sep-81 SPR#: 20-15325
; When done with retrieval requests, rewind the currently mounted
; volume before calling MTCLS. This eliminates the search for
; end-of-file on LABELED tape.
;
;336 EDS 1-Oct-81 SPR#: 20-16435
; When an unprivileged user restores a file with ARCHIVE status,
; give a warning message about the failure to restore the ARCHIVE
; status of the file.
;
;337 EDS 6-Oct-81 SPR#: None
; When building the T$FIL record for INTERCHANGE format handle
; the quoting character (^V) correctly.
;
;340 EDS 27-Oct-81 SPR#: 20-15935
; Replace edit 327. This fixes problems with LABELED tape
; positioning after SKIPs and after RESTOREs. Note: This edit
; produces the restriction that the header of the saveset being
; skipped TO is not printed (labeled tapes only).
;
;341 EDS 30-Oct-81 SPR#: 20-16443
; Fix the calculation of the initial special sequence number
; used by archive/migration. This number was always incorrect
; for labeled tapes containing 2 or more savesets. Also fix
; related problems with multiple archive/migration savesets on
; tapes containing non-archival savesets.
;
;342 EDS 30-Oct-81 SPR#: 20-16956
; Fix the .FBBK0 word of the FDB after retrievals so the files
; will be saved on subsequent incremental saves.
;
;343 EDS 14-Dec-81 SPR#: 20-17078
; Change error messages strings built by BADOFP to
; place emphasis on offline nature of file in error.
;
;344 KMR 9-Mar-82 SPR#: 20-16943
; Fix the retrieval code so that when an invalid user is the
; requestor of a retrieve, the operator is notified of the
; failure and the request is cancelled. Error message "%RCUSR
; failed in QSNXT" has been removed and replace with a new
; message.
;
;345 KMR 11-Mar-82 SPR#: 20-17048
; Call UNMAPB at INIRST so that you can actually release the JFNs
; of the files associated with mapped pages in memory. When a
; DUMPO% fails at a high blocking factor, the subsequent cleanup
; does not unmap pages. If there are pages mapped during the
; cleanup process, the CLOSF% JSYS fails when files are trying to
; be released.
;
;346 KMR 12-Mar-82 SPR#: 20-17079
; Fix so that a user cannot PRINT his tape back onto the tape
; being read. Add routine CHKJFN in routine PRINT to make sure
; user is not reading and writing to the same tape by checking
; the serial numbers (if an MTA) associated with each JFN.
;
;347 KMR 15-Apr-82 SPR#: 20-17424
; Combine PCOs 21 and 28 and create a new PCO that fixes usage
; accounting once and for all. Reverse a SOUT% call so that the
; structure name gets put into the usage accounting information
; for retrieval.
;
;350 KMR 22-Apr-82 QAR#: 20-01754
; Change the error message "Use the DISMOUNT TAPE..." command to
; "Use the monitor DISMOUNT TAPE ....". This will make sure the
; user doesn't try to use DUMPER to dismount the tape.
;
;351 KMR 27-Apr-82 SPR#: 20-17554
; The SAVUSF flag is not reset before any kind of
; archive/collection/migration tape is written. This can result
; in DDB information being written on these tapes if the user has
; set this bit in a previous SAVE command. This bit is now reset
; for the archive functions.
;
;352 KMR 27-Apr-82 SPR#: 20-17639
; The A$FHLN part of an O$FILE block in an interchange format
; tape is not being correctly set. Move the value of LN$AFH [32]
; into the word. Now DIRECT on the -10 should be able to read
; DUMPER's interchange tapes without any problems.
;
;353 KMR 18-Apr-82 SPR#: 20-16224
; When a labeled tape is write-locked for an archive run the
; DUMPER-TAPE-IN-PROGRESS file is not flushed when the SAVE fails
; on the read-only tape. Mounting the tape correctly hangs the
; archive. Now the DUMPER-TAPE-IN-PROGRESS file is deleted.
;
;354 KMR 24-Apr-82 SPR#: 20-17553
; Change checking for saving DDB information on tape. DDBs are
; now only saved with the SAVE /FULL-INCREMENTAL,
; SAVE/INCREMENTAL:n and when the CREATE command is given before
; a SAVE command is issued. WHEEL or OPERATOR privs are needed
; to accomplish any of this.
;
;355 KMR 31-May-82 SPR#: 20-17281
; Put IPCF quota's back to 30 incomming/outgoing to prevent
; backup traffic. Replaces edit 313.
;
;356 JBS 3-Jun-82 SPR#: 20-17057
; Don't blow up when saving filespecs such as "<FOO*> (AS)
; <BAR>". RCDNUM wasn't setup, causing an RCDIR% failure.
;
;357 KMR 9-Jun-82 QAR#: 20-01750
; Put "$" on Try again? prompt for batch.
;
;360 KMR 9-Jun-82 QAR#: 20-01753
; Put in retry for write fail that will prompt
; user to continue the retry.
;
;361 KMR 25-Aug-82 QAR#: 20-01759
; Put in ^A interrupt to tell nervous and anxious
; operators what file Dumper is working on.
; Suggestion from Link-a-Bit.
;
;362 KMR 25-Aug-82
; sigh. Collection bug with SET DIR ARCHIVE-ONLINE
; EXPIRED-FILES. Doesn't do it at all. This fixes it.
;
;363 KMR 21-Oct-82 SPR#:20-17168
; This edit will fix the saving of "holey" files.
; Code supplied by Infomedia
;
;364 KMR 27-Oct-82 SPR#:20-16918
; Not recovering from an IOX5 data error on
; write. It will now assume a data error and attempt
; to write a duplicate record as the data error does.
;
;365 KMR 27-Dec-82 QAR#:20-01758
; NO DIRECTORIES and NO SILENCE do not suppress
; directory output on RESTORE. Add check to LODNMA for
; bit LDIRF to suppress output.
;
;366 KMR 4-Jan-83 QAR#:20-01774
; Check before call to WFERR in XMTOPR to make sure
; there really is an error. Code from 3M.
;
;367 EDS 28-Feb-83
; Replace edit 356. Edit 356 caused strange things to
; happen when saving empty directories.
;
;370 EDS 28-Feb-83
; Replace edit 323. Only reset file count and page count
; when the output directory changes. Clean up code which
; displays directory totals.
;
;371 EDS 28-Feb-83
; Add GETER% after ERJMPs to reliably get the correct
; error code.
;
;372 EDS 31-Mar-83
; Put copyright notice into data area so that it will be
; in the .EXE file.
;
;373 EDS 12-May-83 QAR#:20-01782
; Use the current directory number (DIRNUM) when getting
; the ARCHIVE-ONLINE-EXPIRED-FILES bit from the directory.
;
;374 EDS 12-May-83 QAR#:20-01783
; Remove superflous instructions at XMTOP1.
;
;375 EDS 12-May-83 QAR#:20-01784
; Test for interrupt before getting the last error code
; in routine WFERR.
;
;376 EDS 13-May-83 QAR#:20-01777
; Reinitialize the command state block when a command
; is aborted do to an illegal instruction trap.
;
;377 EDS 13-May-83 QAR#:20-01780
; Reverse test for user mode (PC%USR) on quota exceeded.
; This fixes the problem of page(s) missing when restoring
; files.
;
;400 EDS 16-MAY-83 QAR#:20-01785
; Do not allow a file which was written on a COLLECTION
; tape to be ARCHIVEd during the second run. This can
; cause the file to be written on a mixture of short
; and long term tapes.
;
;401 EDS 17-May-83 QAR#:20-01789
; Start listing on new page when switching tape volumes.
;
;402 SAM 23-AUG-83 NO SPR
; Remove edit 363, it destroys holey files.
;
;[End of Edit History]
COMMENT ^
F O R M A T O F D U M P E R T A P E S
===========================================
EACH PHYSICAL RECORD WRITTEN BY DUMPER CONTAINS ONE OR MORE
LOGICAL RECORDS, EACH OF WHICH IS 518 (1006 OCTAL) WORDS LONG.
EACH LOGICAL RECORD HAS THE FOLLOWING FORMAT:
!=======================================================!
CHKSUM ! CHECKSUM OF ENTIRE 518-WORD RECORD !
!-------------------------------------------------------!
ACCESS ! PAGE ACCESS BITS (CURRENTLY NOT USED) !
!-------------------------------------------------------!
TAPNO !SCD! SAVESET NUMBER ! TAPE NUMBER !
!-------------------------------------------------------!
PAGNO !F1!F2! FILE # IN SET ! PAGE # IN FILE !
!-------------------------------------------------------!
TYP ! RECORD TYPE CODE (NEGATED) !
!-------------------------------------------------------!
SEQ ! RECORD SEQUENCE NUMBER (INCREASES BY 1) !
!=======================================================!
! !
! CONTENTS OF FILE PAGE IF DATA RECORD !
! OTHER TYPES HAVE OTHER INFORMATION HERE !
! !
!=======================================================!
TYPE VALUE MEANING
---- ----- -------
DATA 0 CONTENTS OF FILE PAGE
TPHD 1 NON-CONTINUED SAVESET HEADER
FLHD 2 FILE HEADER (CONTAINS FILESPEC, FDB)
FLTR 3 FILE TRAILER
TPTR 4 TAPE TRAILER (OCCURS ONLY AFTER LAST SAVESET)
USR 5 USER DIRECTORY INFORMATION
CTPH 6 CONTINUED SAVESET HEADER
FILL 7 NO MEANING, USED FOR PADDING
SCD (3 BITS) - 0=NORMAL SAVE, 1=COLLECTION, 2=ARCHIVE, 3=MIGRATION
F1 F2 MEANING
-- -- -------
0 0 OLD-FORMAT TAPE (NO FILE # IN PAGNO BITS 2-17)
1 1 OLD-FORMAT TAPE, CONTINUED FILE
0 1 NEW-FORMAT TAPE (FILE # IN PAGNO BITS 2-17)
1 0 NEW-FORMAT TAPE, CONTINUED FILE
A DUMPER TAPE IS A COLLECTION OF RECORDS ORGANIZED IN THE
FOLLOWING FASHION:
!=======================================================!
! HEADER FOR FIRST SAVESET (TPHD) !
!-------------------------------------------------------!
! USER INFO (USR) OR FILE (SEE BELOW) !
!-------------------------------------------------------!
! USER INFO OR FILE !
!-------------------------------------------------------!
! . !
! . !
! . !
!=======================================================!
! HEADER FOR SECOND SAVESET (TPHD) !
!-------------------------------------------------------!
! USER INFO (USR) OR FILE (SEE BELOW) !
!-------------------------------------------------------!
! USER INFO OR FILE !
!-------------------------------------------------------!
! . !
! . !
! . !
!=======================================================!
! !
! SUBSEQUENT SAVESETS !
! !
!=======================================================!
! !
! LAST SAVESET !
! !
!=======================================================!
! TAPE TRAILER (TPTR) !
!=======================================================!
NOTES:
1. ON LABELED TAPES, THE TPTR RECORD APPEARS ONLY IF
THE SAVESET IS CONTINUED ON ANOTHER TAPE.
2. SOLITARY TAPE MARKS (EOF'S) ARE IGNORED ON INPUT.
TWO CONSECUTIVE TAPE MARKS ARE INTERPRETED AS TPTR.
3. ON LABELED TAPES, EACH SAVESET OCCUPIES EXACTLY ONE FILE.
4. THE FIRST RECORD OF A CONTINUED SAVESET IS CTPH
INSTEAD OF TPHD.
A DISK FILE SAVED ON A DUMPER TAPE ALWAYS HAS THIS
SEQUENCE OF RECORDS:
!=======================================================!
! FILE HEADER (FLHD) !
!-------------------------------------------------------!
! DATA RECORD: 1 PAGE OF FILE (DATA) !
!-------------------------------------------------------!
! DATA RECORD: 1 PAGE OF FILE (DATA) !
!-------------------------------------------------------!
! . !
! . !
! . !
!-------------------------------------------------------!
! FILE TRAILER (FLTR) !
!=======================================================!
^
SUBTTL STORAGE AND DEFINITIONS
FMTV0==0 ;BBN (TENEX) DUMPER FORMAT
FMTV1==1
FMTV2==2
FMTV3==3 ;RELEASE 2 (FDB CHANGES, STRUCTURES, ETC.)
FMTV4==4 ;RELEASE 3 (NEW GTDIR BLOCKS)
IFE T20V6<
CURFMT==FMTV4 ;DATA FORMAT TO WRITE
CD.LEN==.CDDFE+1 ;LENGTH OF DIRECTORY BLOCK
>;END IFE T20V6
IFN T20V6<
FMTV5==5 ;RELEASE 6 BIGGER GTDIR BLOCKS FOR SECURITY
CURFMT==FMTV5 ;DATA FORMAT TO WRITE
CD.LEN==.CDPEV+1 ;LENGTH OF DIRECTORY BLOCK
>;END IFN T20V6
USRLH==500000 ;THIS IS TO IDENTIFY A USER
;NUMBER. IF THE MONITOR
;CHANGES THE DEFINITION, IT
;MUST CHANGE HERE
F=0
A=1
B=2
C=3
D=4
T1=1 ;DO NOT USE T1-T4. IN CASE SOMEONE SLIPS AND DOES
T2=2 ;USE THEM, THESE DEFS OVERRIDE THOSE IN GLXMAC.
T3=3
T4=4
Q1=5
Q2=6
Q3=7
P1=10
P2=11
P3=12
P4=13
P5=14
P6=15
CX=16
P=17
PGSIZ==1000 ;PAGE SIZE
; Definitions for old BBN style archive tapes (FDB offsets for 101B system)
.BBNBT==17 ; Old FBBBT
.BBNTF==20 ; TFN1,,TFN2
.BBNTS==21 ; TSN1,,TSN2
.BBNTP==22 ; TAPE1,,TAPE2
.BBNDT==23 ; Archive date & time
;FLAGS IN F
NOFLG==1B0 ;'NO' PRECEDED COMMAND
USRDAT==1B1 ;DUMP/LOAD USER DATA
T36MOD==1B2 ;36-BIT TAPE MODE
DIRCHG==1B3 ;OUTPUT DIRECTORY NOT SAME AS
;INPUT DIRECTORY
TNSF==1B4 ;TAPE NUMBER SET FLAG
LRERR==1B5 ;LAST RECORD HAD AN UNRECOVERABLE ERROR
SAVUSF==1B6 ;WE SHOULD SAVE USER DATA IF SET
DMPFLF==1B7 ;(SAVE) WE HAVE FOUND A VALID JFN TO DUMP
TF1==1B9 ;TEMP FLAGS FOR LOCAL USE
TF2==1B10 ;FILE CONTINUED ON NEXT REEL
LFDSK==1B11 ;LOG FILE NOT DISK
ICMT1==1B12 ;INTERCHANGE MODE - REPEAT LAST RECORD
ICMODF==1B13 ;USE INTERCHANGE MODE TAPE FORMAT
LDIRF==1B14 ;LIST DIRECTORIES WHILE RUNNING
LFILF==1B15 ;LIST FILES WHILE RUNNING
LTTYF==1B16 ;LOG FILE IS TTY
LREOF==1B17 ;LAST RECORD READ WAS EOF
SSA==1B18 ;SUPERSEDE ALWAYS
SSN==1B19 ;SUPERSEDE NEVER
RESPRO==1B20 ;RESTORE PROTECTION FROM TAPE
RESACC==1B21 ;RESTORE ACCOUNT FROM TAPE
CHKSM==1B23 ;CHECKSUMMING
CS%SEQ==1B24 ;SEQUENTIAL CHECKSUMMING
SKPBFL==1B31 ;[322] SKIP BACKWARDS FLAG
%ATF==1B32 ; "@" seen (GETOWN)
%VERBA==1B33 ; Take input "as is" (GETOWN)
COMMAF==1B34 ; Comma flag (For PRTTAP)
FST%PN==1B35 ; First ";" seen in FIXFMM (TENEX tape)
;FORMAT OF HEADER PORTION OF RECORD
XCKSUM==0 ;CHECKSUM
XACC==1 ;ACCESS
XTAPNO==2 ;TAPE NUMBER
XPAGNO==3 ;PAGE NUMBER
XTYP==4 ;RECORD TYPE
XSEQ==5 ;RECORD SEQUENCE
NHEAD==6 ;HEADER SIZE
NIHEAD==^D32 ;HEADER SIZE, INTERCHANGE FORMAT
MXHEAD==NHEAD ;SET MAX (NHEAD, NIHEAD)
IFG NIHEAD-MXHEAD,<MXHEAD==NIHEAD>
MAXBKF==^D15 ;MAXIMUM BLOCKING FACTOR
DEFBKF==^D1 ;DEFAULT BLOCKING FACTOR
MTBFSZ==<<NHEAD+PGSIZ>*MAXBKF>+1 ;SIZE OF PHYSICAL RECORD BUFFERS
IFG <MXHEAD+PGSIZ+1>-MTBFSZ,<MTBFSZ==MXHEAD+PGSIZ+1>
;(THE EXTRA 1 IS TO FORCE RECORD LENGTH ERROR
; ON READING TO DETERMINE BLOCKING FACTOR)
;LOCATIONS IN UPPER ADR SPACE
N.JFN==2*PGSIZ ;DOUBLE LENGTH BUFFER (JFNSTK)
CBFSIZ==2*PGSIZ ;2 PAGES (CBFR)
NJFNL==PGSIZ ;(JFNLST & JF2LST)
NQSRML==PGSIZ ; Page for communication with QUASAR
NSNDBD==PGSIZ*3 ; Amount of space allocated for message body
JFNLST=500000 ;LIST OF JFNS FOR CURRENT COMMAND
JF2LST=501000 ;LIST OF DEST JFNS, PARALLEL TO JFNLST
JFNSTK=502000 ;JFN STACK FOR REPARSE (2 PAGES)
CBFR=504000 ;2 PAGE LINE BUFFER FOR COMMAND
MBUF=506000 ;IPCF BUFFER USED DURING TAPE MOUNT
MTBUF1=MBUF+NQSRML ;ALTERNATING BUFFERS FOR MAGTAPE I/O
MTBUF2=<MTBUF1+MTBFSZ+777>&<^-777> ; . .
QSRMSR=<MTBUF2+MTBFSZ+777>&<^-777> ; Page for QUASAR communication
QSRMSS=QSRMSR+NQSRML ; FOR SENDING TO QUASAR
SNDBDY=QSRMSS+NQSRML ; Body of messages sent
IFL <577772-<SNDBDY+NSNDBD>>,<PRINTX SNDBDY and XBUFF overlap - Readjust upper core storage>
BUFF=600000
BUFPAG==<BUFF>B44
IFL BUFF-<<MTBUF2+MTBFSZ+777>&<^-777>>,<PRINTX ? MTBUF2 OVERLAPS BUFF>
BUFF2=601000
BF2PAG==<BUFF2>B44
BUF0==602000 ;FILE WINDOW
BUF0PG==<BUF0>B44 ;PAGE NUMBER OF SAME
XBUFF=BUFF-NHEAD ;BUFFER ORIGIN
CHKSUM=XBUFF+XCKSUM
ACCESS=XBUFF+XACC
TAPNO=XBUFF+XTAPNO
PAGNO=XBUFF+XPAGNO
TYP=XBUFF+XTYP
SEQ=XBUFF+XSEQ
;BITS IN LH OF PAGNO WORD
PGNCFL==1B0 ;CONTINUED TAPE FILE (SET IN FILE TRAILER,
; TAPE TRAILER, FILE HEADER)
PGNNFL==1B1 ;FILE NUMBER IS VALID (IF COMPLEMENT OF PGNCFL)
PGNFLN==177777B17 ;FILE NUMBER
;STRUCTURE OF RECORD HEADER FOR ARCHIVE/COL./MIG. TAPES
DEFSTR SSCOD,XTAPNO,2,3 ;SAVESET TYPE CODE:
SSCOL==1 ;COLLECTION RUN SAVESET
SSARC==2 ;ARCHIVE RUN SAVESET
SSMIG==3 ;MIGRATION RUN SAVESET
DEFSTR SSNO,XTAPNO,17,15 ;SAVESET NUMBER
DEFSTR TPNO,XTAPNO,35,18 ;TAPE NUMBER
DEFSTR TFNO,XPAGNO,17,16 ;TAPE FILE NUMBER
DEFSTR PGNO,XPAGNO,35,18 ;PAGE NO. IN FILE
;RECORD TYPE CODES
DATAX==0 ;DATA RECORD
TPHDX==1 ;TAPE HEADER
FLHDX==2 ;FILE HEADER
FLTRX==3 ;FILE TRAILER
TPTRX==4 ;TAPE TRAILER
USRX==5 ;USER BLOCK
CTPHX==6 ;CONTINUED SAVE
FILLX==7 ;FILLER RECORD
SSNDX==10 ;[340] SAVESET END
;NUMBER OF ERROR RETRIES FOR MTA
NRETRY==^D40
;LISTING FORMAT PARAMETERS
FLCOL==^D5 ;COLUMN FOR FILE NAME
WTCOL==^D60 ;COLUMN FOR WRITE DATE
SIZCOL==^D80 ;COLUMN FOR SIZE
CSCOL==^D100 ;COLUMN FOR CHECKSUM
PAGLEN==^D57 ;LINES PER LISTING PAGE
;FORMAT OF RECORDS ON TAPE
;TAPE HEADER
BFMSGP==1 ;PTR TO SAVE SET NAME
BFTAD==2 ;TAD OF SAVE
BFMSG==3 ;SAVE SET NAME
;FILE HEADER
FHNAM==0 ;FILE NAME
FHFDB==200 ;FDB
;DIRECTORY INFORMATION BLOCK
UHNAM==40 ;NAME STRING
UHPSW==60 ;PASSWORD STRING
UHACT==100 ;ACCOUNT STRING
UGLEN==200 ;USER/DIRECTORY GROUP LENGTH
CDUG==200 ;USER GROUPS
CDDG==400 ;DIRECTORY GROUPS
CDSG==600 ;SUBDIRECTORY GROUPS
;FILE NAME PUNCTUATION
DEVPCT==":" ;DEVICE
DIRBP=="<" ;DIRECTORY BEGIN
DIREP==">" ;DIRECTORY END
EXTPCT=="." ;EXTENSION
GENPCT=="." ;GENERATION
ATTPCT==";" ;ATTRIBUTE
;DUMPER STATE BLOCK
S.REST==1 ;[361] We are doing a RESTORE
S.SAVE==2 ;[361] We are doing a dump (SAVE)
SUBTTL INTERCHANGE FORMAT DEFINITIONS
BKFMT==1 ;FORMAT VERSION NUMBER (CONSTANT)
;RECORD TYPES
T$LBL==1 ;LABEL IDENTIFICATION RECORD
T$BEG==2 ;SAVE START
T$END==3 ;SAVE END
T$FIL==4 ;DISK FILE DATA
T$UFD==5 ;UFD RIB
T$EOV==6 ;END OF VOLUME
T$COM==7 ;COMMENT
T$CON==10 ;CONTINUE (SAME DATA AS T$BEG-T$END)
T$MAX==T$CON ;MAXIMUM RECORD TYPE
;STANDARD RECORD
G$TYPE==0 ;RECORD TYPE
G$SEQ==1 ;SEQUENCE NUMBER
G$RTNM==2 ;RELATIVE TAPE NUMBER
G$FLAG==3 ;RECORD DEPENDENT BITS
GF$EOF==1B0 ;LAST RECORD OF FILE
GF$RPT==1B1 ;REPEAT OF LAST RECORD WRITE ERROR
GF$NCH==1B2 ;IGNORE CHECKSUM
GF$SOF==1B3 ;START OF FILE
G$CHK==4 ;CHECKSUM
G$SIZ==5 ;NUMBER OF DATA WORDS
G$LND==6 ;TOTAL LENGTH OF NON-DATA SECTION
G$CUSW==13 ;RESERVED FOR CUSTOMER USE
;O$FILE/A$FLGS
B$PERM==1B0 ;PERMANENT
B$TEMP==1B1 ;TEMPORARY
B$DELE==1B2 ;ALREADY DELETED
B$DLRA==1B3 ;DON'T DELETE FOR LACK OF RECENT ACCESS
B$NQCF==1B4 ;NOT QUOTA CHECKED
B$NOCS==1B5 ;DOES NOT HAVE VALID CHECKSUMS
B$CSER==1B6 ;HAS CHECKSUM ERROR
B$WRER==1B7 ;HAS DISK WRITE ERROR
B$MRER==1B8 ;HAD <BACKUP READ ERROR ON RESTORE
B$DAER==1B9 ;DECLARED BAD BY DAMAGE ASSESMENT
;O$FILE BLOCK
A$FHLN==0 ;HEADER LENGTH WORD
A$FLGS==1 ;FLAGS
A$WRIT==2 ;CREATION DATE/TIME
A$ALLS==3 ;ALLOCATED SIZE
A$MODE==4 ;MODE
A$LENG==5 ;LENGTH
A$BSIZ==6 ;BYTE SIZE
A$VERS==7 ;VERSION
A$PROT==10 ;PROTECTION
A$ACCT==11 ;BYTE POINTER ACCOUNT STRING
A$NOTE==12 ;BYTE POINTER TO ANONOTATION STRING
A$CRET==13 ;CREATION DATE/TIME OF THIS GENERATION
A$REDT==14 ;LAST READ DATE/TIME OF THIS GENERATION
A$MODT==15 ;MONITOR SET LAST WRITE DATE/TIME
A$ESTS==16 ;ESTIMATED SIZE IN WORDS
A$RADR==17 ;REQUESTED DISK ADDRESS
A$FSIZ==20 ;MAXIMUM FILE SIZE IN WORDS
A$MUSR==21 ;BYTE POINTER TO ID OF LAST MODIFIER
A$CUSR==22 ;BYTE POINTER TO ID OF CREATOR
A$BKID==23 ;BYTE POINTER TO SAVE SET OF PREVIOUS <BACKUP
A$BKDT==24 ;DATE/TIME OF LAST BACKUP
A$NGRT==25 ;NUMBER OF GENERATIONS TO RETAIN
A$NRDS==26 ;NBR OPENS FOR READ THIS GENERATION
A$NWRT==27 ;NBR OPENS FOR WRITE THIS GENERATION
A$USRW==30 ;USER WORD
A$PCAW==31 ;PRIVILEGED CUSTOMER WORD
LN$AFH==32 ;LENGTH OF FIXED HEADER
;PROTECTION FIELDS
AC$OWN==377B19 ;OWNER ACCESS FIELD
AC$GRP==377B27 ;AFFINITY GROUP ACCESS FIELD
AC$WLD==377B35 ;WORLD ACCESS FIELD
PR$ATR==7B31 ;ATTRIBUTE PROTECTION SUBFIELD
PR$WRT==3B33 ;WRITE PROTECTION SUBFIELD
PR$RED==3B35 ;READ PROTECTION SUBFIELD
;O$DIRT/D$FLGS
DF$FOD==1B0 ;FILES ONLY DIRECTORY
DF$AAL==1B1 ;ALPHA ACCOUNTS ARE LEGAL
DF$RLM==1B2 ;REPEAT LOGIN MESSAGES
;O$DIRT BLOCK
D$FHLN==0 ;FIXED HEADER LENGTH WORD
D$FLGS==1 ;DIRECTORY FLAGS
D$ACCT==2 ;ACCOUNT NUMBER
D$PROT==3 ;DIRECTORY PROTECTION
D$FPRT==4 ;DEFAULT FILE PROTECTION
D$LOGT==5 ;LOGIN DATE/TIME
D$GENR==6 ;NUMBER GENERATIONS TO KEEP
D$QTF==7 ;LOGGED-IN QUOTA
D$QTO==10 ;LOGGED-OUT QUOTA
D$ACSL==11 ;ACCESS LIST
D$USRL==12 ;USER LIST
D$PRVL==13 ;PRIVILEGE LIST
D$PSWD==14 ;PASSWORD
LN$DFH==15 ;LENGTH OF DIRECTORY FIXED HEADER
;NON-DATA BLOCK TYPES
O$NAME==1 ;FULL PATH NAME BLOCK
O$FILE==2 ;FILE ATTRIBUTE BLOCK
O$DIRT==3 ;DIRECTORY ATTRIBUTE BLOCK
O$SYSN==4 ;SYSTEM HEADER BLOCK
O$SSNM==5 ;SAVE SET NAME BLOCK
;T$LBL RECORD
L$DATE==14 ;DATE/TIME OF LABELING
L$FMT==15 ;BACKUP FORMAT
L$BVER==16 ;BACKUP VERSION
L$MON==17 ;MONITOR TYPE
L$SVER==20 ;SYSTEM VERSION
L$APR==21 ;APR SERIAL NUMBER WRITING LABEL
L$DEV==22 ;DEVICE ID WRITING LABEL
L$MTCH==23 ;TAPE WRITE PAREMETERS
L$RLNM==24 ;SIXBIT TAPE REEL NAME
L$DSTR==25 ;DATE/TIME FOR DESTRUCTION
L$CUSW==37 ;RESERVED CUSTOMER WORD
;T$BEG, T$END, T$CON RECORDS
S$DATE==14 ;DATE/TIME OF START/END OF SAVE
S$FMT==15 ;RETRIEVAL VERSION
S$BVER==16 ;BACKUP VERSION
S$MON==17 ;MONITOR TYPE
S$SVER==20 ;SYSTEM VERSION
S$APR==21 ;APR SERIAL NUMBER
S$DEV==22 ;DEVICE ID WRITING SAVE SET
S$MTCH==23 ;TAPE WRITE PARAMETERS
S$RLNM==24 ;REELID
S$CUSW==37 ;CUSTOMER WORD
;T$UFD RECORD
D$PCHK==14 ;PATH CHECKSUM
D$LVL==15 ;UFD LEVEL (UFD=0, SFD1=1, ETC.)
D$STR==16 ;STRUCTURE OF UFD ( MAX OF 12(10) WORDS )
D$CUSW==37 ;CUSTOMER WORD
;T$FIL RECORD
F$PCHK==14 ;PATH CHECKSUM
F$RDW==15 ;RELATIVE DATA WORD OF FILE
F$PTH==16 ;START OF PATH BLOCK
LN$PTH==14 ;LENGTH OF F$PTH BLOCK
F$CUSW==37 ;RESERVED CUSTOMER WORD
F$NND==400 ;LENGTH OF NON-DATA PORTION OF FIRST RECORD
;T$FIL/O$NAME SUB-BLOCK TYPES
.FCDEV==1 ;DEVICE
.FCNAM==2 ;FILE NAME
.FCEXT==3 ;EXTENSION
.FCVER==4 ;VERSION
.FCGEN==5 ;GENERATION
.FCDIR==40 ;DIRECTORY
.FCSF1==41 ;FIRST SFD
.FCSF2==42 ;SECOND SFD
; Defn's for retrievals & QUASAR interface
DEFSTR TPNM1,.ARTP1,35,36 ; Tape 1 ID
DEFSTR TSN1,.ARSF1,17,18 ; Tape 1 saveset #
DEFSTR TFN1,.ARSF1,35,18 ; Tape 1 tape file #
DEFSTR TPNM2,.ARTP2,35,36 ; Tape 2 ID
DEFSTR TSN2,.ARSF2,17,18 ; Tape 2 saveset #
DEFSTR TFN2,.ARSF2,35,18 ; Tape 2 tape file #
FILNM=.ARPSZ+1 ; Where file name will start
SUBTTL STORAGE
ASCIZ /
THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
COPYRIGHT (C) 1976,1983 BY DIGITAL EQUIPMENT CORPORATION,
MAYNARD, MASS.
/
;BUFFERS NOT CLEARED AT STARTUP
ICOBUF: BLOCK PGSIZ+NHEAD ;CONVERSION OUTPUT BUFFER
;STORAGE CLEARED AT STARTUP
STGBGN: ;BEGINNING OF STORAGE CLEARED AT STARTUP
; Do not seperate the following block
TPTSK: BLOCK 1 ; Internal task name on ret blk
TPRQUS: BLOCK 1 ; User who requested the retrieve
ABTFLG: BLOCK 1 ; Abort received from QUASAR
TPBLK:!
TPOFL: BLOCK 1 ; Flags
TAP1ID: BLOCK 1 ; Tape 1 ID
SSF1ID: BLOCK 1 ; Tape 1 saveset & tape file #
TAP2ID: BLOCK 1 ; Tape 2 ID
SSF2ID: BLOCK 1 ; Tape 2 saveset & tape file #
TPODT: BLOCK 1 ; Tape write date
TPPSZ: BLOCK 1 ; # pages in file
TAPNAM: BLOCK <6+1+1+^D39*2+1+^D39*2+1+^D39*2+1+6+1>/5 ; Space for file name (^V's incl)
TPACT: BLOCK <2*^D39>/5 ; Account of request
MYPID: BLOCK 1 ; My PID (for talking to QUASAR)
QSRPID: BLOCK 1 ; QUASAR's PID
PDB: BLOCK .IPCAS+11 ; Space for MUTILing around
MPDB: BLOCK 10 ;PDB FOR MOUNTING TAPES
NUSABL==27
USABLK: BLOCK NUSABL ; Block for USAGE
USADIR: BLOCK 20 ; Directory string for USAGE
USASTR: BLOCK ^D12 ; Structure name for USAGE
USASSI: BLOCK 2 ;SIXBIT STRUCTURE ID FOR USAGE
USAACT: BLOCK ^D39/5 ; Account string for USAGE
LHOSTN: BLOCK 1 ; Local host # (ARPAnet)
RFSPEC: BLOCK 11 ; Space for type in restart file
CURBUF: BLOCK 1 ;CURRENT OUTPUT BUFFER
FORMAT: BLOCK 1 ;DATA FORMAT
MTBUFF: BLOCK 1 ;BUFFER SWITCH
MTBPTR: BLOCK 1 ;ADDRESS OF CURRENT LOGICAL RECORD WITHIN
; MTBUF1 OR MTBUF2
MTRACT: BLOCK 1 ;READ-AHEAD REQUEST ISSUED
SETBKF: BLOCK 1 ;LAST BLOCKING-FACTOR SET
TAPBKF: BLOCK 1 ;BLOCKING-FACTOR OF CURRENT TAPE
BLKCNT: BLOCK 1 ;DOWN-COUNTER FOR LOGICAL RECORDS BLOCKED
; WITHIN EACH PHYSICAL RECORD
NAMBUF: BLOCK 100 ;FULL FILESPEC FOR FILE BEING DUMPED
ONMBUF: BLOCK 100 ;FULL SPEC FOR FILE NAME GOING ON TAPE
LSTRD: BLOCK 100 ;[361] LAST FILE SEEN ON TAPE
IPDLP: BLOCK 1 ;PDL POINTER AT INTERUPT TIME
TPDLP: BLOCK 1 ;TEMP PDL POINTER
PDLP: BLOCK 1 ;STACK PTR AT TOP OF COMMAND
NPDL==100
PDL: BLOCK NPDL ;MAIN FORK STACK
INIPTR: BLOCK 1 ;INITIAL JFN STACK POINTER
CMDPTR: BLOCK 1 ;TOP OF COMMAND POINTER
RPSPTR: BLOCK 1 ;REPARSE JFN STACK POINTER
CURPTR: BLOCK 1 ;CURRENT JFN STACK POINTER
NLINB==40
LINBUF: BLOCK NLINB ;RDTTY LINE BUFFER
TEMPS: BLOCK 100 ; Temp storage for FIXFMM
STABLK: BLOCK 1 ;[361] RESTORING OR SAVING
WORKING:BLOCK 1 ;[361] WORKING OR LOOKING
XPRARC: BLOCK 1 ;[362] CD%DAR SET FOR DIRECTORY
DIRINF: BLOCK 5 ;[362] DIRECTORY INFORMATION
;COMND STORAGE
ACBSIZ==^D200/5 ;SIZE OF ATOM BUFFER
ACBFR: BLOCK ACBSIZ
CBLK: BLOCK .CMGJB+1 ;COMMAND STATE BLOCK
GJBLK: BLOCK .GJBFP+1 ;GTJFN ARG BLOCK
;COMMAND TYPE INFORMATION.
CMDTYP: BLOCK 1 ;CURRENT COMMAND TYPE HERE
TY%NOC==1B0 ;NO-CONTINUE COMMAND
TY%RPO==1B1 ;STACK JFNS FOR REPARSE ONLY
TY%MAP==1B2 ;COMMAND MAPS BUFPAG
TY%DBL==1B3 ;COMMAND USES JFNLST
;STORAGE FOR GTJFN DEFAULT STRINGS
DEFDEV: BLOCK 20 ;DEFAULT DEVICE
DEFDIR: BLOCK 20 ;DEFAULT DIRECTORY
DEFNAM: BLOCK 20 ;DEFAULT NAME
DEFEXT: BLOCK 20 ;DEFAULT EXTENSION
DEFVER: BLOCK 20 ;DEFAULT VERSION
DEFPRO: BLOCK 20 ;DEFAULT PROTECTION
DEFACC: BLOCK 20 ;DEFAULT ACCOUNT
NIJFN: BLOCK 1 ;SAVED JFNLST PTR IN CASE OF INTERRUPT
NJFN: BLOCK 1 ;NUMBER OF JFNS IN JFNLST IN USE
NJFN1: BLOCK 1 ;NUMBER ACTIVE JFNS STILL IN LIST
NSSNBF==^D140 ;[317] SIZE OF SAVE SET NAME BUFFER
SSNBUF: BLOCK NSSNBF/5 ;[317] SAVE SET NAME BUFFER
MNTDSG: BLOCK 1 ;DESIGNATOR OF MT ASSIGNED BY QUASAR
MTDSG: BLOCK 1 ;DESIGNATOR FOR SPECIFIED MAGTAPE
MTTYP: BLOCK 1 ;TYPE OF MAGTAPE DEVICE
;-1 = MTA
; 0 = UNLABELED MT
;+1 = LABELED (TOPS-20) MT
NAMPTR: BLOCK 1 ;POINTER TO NAME FIELD OF NAMBUF
ONMPTR: BLOCK 1 ;POINTER TO NAME FIELD OF ONMBUF
OGNPTR: BLOCK 1 ;POINTER TO GENERATION NUMBER IN ONMBUF
OACPTR: BLOCK 1 ;POINTER TO ACCOUNT FIELD IN ONMBUF
NOFILS: BLOCK 1 ;NUMBER FILES DUMPED THIS DIRECTORY
TOTFIL: BLOCK 1 ;NUMBER FILES DUMPED ALL DIRECTORIES
WHEEL: BLOCK 1 ;NON-0 IF BEING RUN WITH WHEEL STATUS
DIRNUM: BLOCK 1 ;DIRECTORY NUMBER CURRENT DUMP DIRECTORY
RCDNUM: BLOCK 1 ;DIRECTORY NUMBER FOR RCDIR STEPPING
RCDSTR: BLOCK 12 ;STR:<*> STRING FOR RCDIR
SCNJFN: BLOCK 1 ;CURRENT JFN FOR DUMP SCAN
MTDEV: BLOCK 2 ;NAME STRING FOR SPECIFIED MTA
VOLID: BLOCK 2 ;CURRENT VOLUME IDENTIFIER (ASCIZ)
VOLID6: BLOCK 1 ;CURRENT VOLUME IDENTIFIER (SIXBIT)
DENSIT: BLOCK 1 ;SPECIFIED MTA DENSITY
PARITY: BLOCK 1 ;SPECIFIED MTA PARITY
LASTID: BLOCK 1 ;ID OF CURRENT DUMP PAGE FOR ERROR PSI
LSTERO: BLOCK 1 ;LAST ID REPORTED BY PSI
INT1AC: BLOCK 20 ;INT LEVEL 1 ACS
INT2AC: BLOCK 20 ;INT LEVEL 2 ACS
INT3AC: BLOCK 20 ;INT LEVEL 3 ACS
NINTPD==30 ;SIZE OF INT STACKS
INT1PD: BLOCK NINTPD ;INT LEVEL 1 STACK
INT2PD: BLOCK NINTPD ;INT LEVEL 2 STACK
INT3PD: BLOCK NINTPD ;INT LEVEL 3 STACK
LPC1: BLOCK 1 ;PSI PC'S
LPC2: BLOCK 1
LPC3: BLOCK 1
EINT1: BLOCK 2 ;JSR ENTRY
INTRQ: BLOCK 1 ;INTERRUPT REQUEST FLAG
INTPC: BLOCK 1 ;INTERRUPT PC
ICMDTY: BLOCK 1 ;INTERRUPTED COMMAND TYPE
CEXFLG: BLOCK 1 ;COMMAND IN EXECUTION FLAG
TRAPJ: BLOCK 1 ;TRAP RECOVERY JUMP ADDRESS
TRAPSP: BLOCK 1 ;TRAP RECOVERY STACK FENCE
ITRAPJ: BLOCK 1 ;INTERRUPTED TRAP RECOVERY
ITRAPS: BLOCK 1 ;...
RTAPNO: BLOCK 1 ;EXPECTED TAPE NUMBER OF READ
RSEQ: BLOCK 1 ;EXPECTED SEQ NUMBER ON READ
TAPLFT: BLOCK 1 ;SET TO 0 WHEN EOT MARK ENCOUNTERED
CNTR: BLOCK 1 ;PAGES THIS FILE REMAINING TO BE DUMPED
USRCNT: BLOCK 1 ;COUNT OF PAGES THIS DIR
TOTCNT: BLOCK 1 ;COUNT OF PAGES ALL DIRS
CDIRN: BLOCK 1 ;CONNECTED DIRECTORY NUMBER
CHECK: BLOCK 1 ;NON-0 IF CHECKING, 0 IF LOADING
LPTJFN: BLOCK 1 ;JFN FOR LISTING FILE
LSTFIL: BLOCK 40 ;FILESPEC FOR LOG FILE
INCRSW: BLOCK 1 ;-1 FOR FULL-INCREMENTAL, ELSE INCREMENTAL COUNT OR 0
TFNAME: BLOCK 100 ;SAVE FILE NAME HERE
DIRNAM: BLOCK 20 ;NAME STRING OF CURRENT DIRECTORY
ODRNAM: BLOCK 20 ;NAME STRING OF OUTPUT DIRECTORY
LSTDIR: BLOCK 20 ;NAME STRING OF LAST DIRECTORY
CONBUF: BLOCK 20 ;STORAGE OF CONNECTED STRUCTURE AND DIRECTORY
CONSTR: BLOCK 1 ;POINTER TO CONNECTED STRUCTURE STRING
CONDIR: BLOCK 1 ;POINTER TO CONNECTED STRUCTURE STRING
JFN: BLOCK 1 ;JFN FOR CURRENT DUMP OR LOAD FILE
MTJFN: BLOCK 1 ;JFN OF MAG TAPE
MTCOMS: BLOCK 2 ;MTA DUMPI/DUMPO COMMAND LIST
LPTPOS: BLOCK 1 ;LPT LINE POSITION
BGNTAD: BLOCK 1 ;TAD AT START OF SAVE
INIJFN: BLOCK 1 ;INITIAL JFN FOR SAVE
INIPGN: BLOCK 1 ;INITIAL PAGE NUMBER FOR SAVE
INICNT: BLOCK 1 ;SAVED COUNTER IF IN MIDDLE OF FILE
ININUM: BLOCK 1 ;FLAG FOR INITIAL DDB
FDB: BLOCK .FBLN0 ;FDB FOR CURRENT FILE
FDBAUT: BLOCK 10 ;STORE AUTHER OF FILE
FDBLWR: BLOCK 10 ;STORE LAST WRITER NAME
FDBARC: BLOCK .ARPSZ+1 ; Tape info for arc/col/mig
ICFDB: BLOCK .FBLN0 ;SAVED FDB FOR INTERCHANGE FORMAT
WBTAD: BLOCK 1 ;WRITTEN-BEFORE TAD
WSTAD: BLOCK 1 ;WRITTEN-SINCE TAD
ABTAD: BLOCK 1 ;ACCESSED-BEFORE TAD
ASTAD: BLOCK 1 ;ACCESSED-SINCE TAD
MBTAD: BLOCK 1 ;MOVED-BEFORE TAD
MSTAD: BLOCK 1 ;MOVED-SINCE TAD
DEVNAM: BLOCK 14 ;DEVICE NAME FOR INCREMENTAL SAVE
FBUF1: BLOCK 11 ;BUFFERS FOR FILESPEC STRING COMPARE
FBUF2: BLOCK 11
LPTBUF: BLOCK ^D200/5 ;[317] BUFFER FOR LPT TEXT
LSTHDR: BLOCK ^D200/5 ;HEADING FOR EACH LISTING PAGE
LPTLIN: BLOCK 1 ;LISTING LINE NUMBER
LPTPAG: BLOCK 1 ;LISTING PAGE
TMODE: BLOCK 1 ;BIT 0 - LOCAL FLAG FOR MTOPN INDICATING
; TAPE DATA MODE MUST BE SET
;OF%RD - SET IF TAPE OPEN FOR READ
;OF%WR - SET IF TAPE OPEN FOR WRITE
NWTBIT: BLOCK 1 ;OVERLAP BIT
ICOLEN: BLOCK 1 ;LENGTH OF FILE FOR INTERCHANGE SAVE
;CHECKSUM INFORMATION
CHKCN0: BLOCK 1 ;CHECKSUM FOR FILE
LSTPGE: BLOCK 1 ;LAST PAGE CHECKSUMMED
FPGCNT: BLOCK 1 ;# OF COMPLETE PAGES BEFORE EOF
RMRPGE: BLOCK 1 ;PARTIAL PAGE BEFORE EOF
P2JFN: BLOCK 1 ;JFN FOR PASS2, INCREMENTAL & ARCHIVAL
UNLTAP: BLOCK 1 ;NON-0 FOR UNLOAD TAPE AFTER SAVE
ARCSW: BLOCK 1 ;NON-0 FOR ARCHIVE RUN
COLSW: BLOCK 1 ; 1=> COL; -1=>MIG
ARSETS: BLOCK 1 ;#SETS ARCHIVE INFO. IN FDB
ARCTSN: BLOCK 1 ;ARCHIVE SAVESET NO.
SSTYP: BLOCK 1 ;SAVESET TYPE (ARCHIVE, COLL., OR MIG.)
ARSSTB: BLOCK 7 ;ARG BLOCK FOR .ARSST
SPSEQ: BLOCK 1 ;SPEC. SEQ. NO. FOR RESTART OF ARCH. RUN
IDIR: BLOCK 12 ;INITIAL STR:DIRECTORY ON TAPE
CDIR: BLOCK 12 ;CURRENT STR:DIRECTORY FOR PASS 2
XDIR: BLOCK 12 ;STR:DIRECTORY AT END OF TAPE (PASS2)
FNDDIR: BLOCK 1 ;FLAG FOR FOUND XDIR (PASS2)
ISPEC: BLOCK 200 ;INITIAL FILESPEC ON TAPE
CSPEC: BLOCK 200 ;CURRENT FILESPEC (PASS2)
XSPEC: BLOCK 200 ;FILESPEC AT TAPE SWITCH
LODARC: BLOCK 1 ;FLAG LOAD ARCHIVE INFO
NXTRTP: BLOCK 1 ; Pointer to current retrieval blk
SNDFRK: BLOCK 1 ; SNDMSG fork handle
RETSW: BLOCK 1 ; Non 0 => doing retrievals
TPJFN: BLOCK 1 ; Temp JFN storage - used by SND & LSTMSG
LDSALL: BLOCK 1 ; Non 0 => doing RESTORE /SEARCH-ALL-SAVESETS
; Do not separate the following SNDMSG blk
SNDTO: BLOCK 1
SNDSUB: BLOCK 1
SNDTXT: BLOCK 1
TOLST: BLOCK 40
BMBFLG: BLOCK 1
CURSNP: BLOCK 1 ; Text body ptr for ARMSUS routine
LTARDR: BLOCK 11 ; Current dir name for arc'd msgs
FKRTBK: BLOCK FILNM ; Fake retrieval block
TEMP: BLOCK 40 ; For file name in fake retrieval blk
STGEND: ;END OF STORAGE CLEARED AT STARTUP
BADPC: BLOCK 1 ;[307] PC OF FAILING JSYS - USED BY JSERRR
; Block used for ACKing msgs with ACK request on
ACKBLK: MSHSIZ,,.QOHEL ; Size & hello
MF.NOM ; No message, just an ACK
.-. ; ACK code to be filled in
;FLAG USED IN DUMPI/DUMPO TO REQUEST OVERLAPPED OPERATION
NWTBT0: DM%NWT ;SET TO 0 FOR NON-OVERLAPPED
NBUF: 10 ;SIZE OF FILE WINDOW AT BUF0
INIPDL: IOWD NPDL,PDL ;INITIAL PUSH DOWN LIST
;STANDARD RETURNS
RSKP: AOS 0(P)
R: RET
;GTJFN BLOCK USED ONLY FOR REFERENCING FILES WHICH CAN BE INVISIBLE.
;***WARNING*** THE ONLY WORD OF THIS BLOCK WHICH SHOULD BE CHANGED
;IS THE FLAG WORD .GJGEN.
RETBLK: 0 ;FLAGS, FILLED IN AT RUNTIME
.NULIO,,.NULIO ;NO EXTRA INPUT OR OUTPUT
0 ; No device default
0 ; No directory
0 ; No name
0 ; No type
0 ; No protection
0 ; No account
0 ; No special JFN
G1%IIN ; Find invisible files
CRLF: ASCIZ/
/
DEFINE SAVPQ <
JSP CX,.SAV8##>
DEFINE SAVEQ <
JSP CX,.SAV3##>
DEFINE JSERR<
JSP CX,JSERR0>
DEFINE ERROR (TAG,MSG)<
JRST [ TMSGC <MSG
>
JRST TAG]>
DEFINE ERRORJ (TAG,MSG)<
JRST [ TMSGC <MSG, >
CALL JSERRM
JRST TAG]>
DEFINE FATAL (TXT) <
JRST [PUSH P,A
HRROI A,[ASCIZ \TXT\]
PSOUT%
POP P,A
HALTF%]>
DEFINE TMSG(S)<
HRROI B,[ASCIZ \S\]
CALL TMSGQ>
DEFINE LPMSG(S)<
HRROI B,[ASCIZ \S\]
CALL LPMSGQ>
DEFINE BTMSG(S)<
HRROI B,[ASCIZ \S\]
CALL BTMSGQ>
DEFINE TMSGC(S)<
HRROI B,[ASCIZ \S\]
CALL TMSGQC>
DEFINE BTMSGC(S)<
HRROI B,[ASCIZ \S\]
CALL BTMSQC>
DEFINE TXTPTR (MSG)<POINT 7,[ASCIZ \MSG\]>
DEFINE TB (DAT,TXT)<
XWD [ASCIZ \TXT\],DAT>
SUBTTL MAIN LOOP
;PROGRAM ENTRY VECTOR
ENTVEC: JRST START ;STARTING LOCATION
JRST CLRST ;REENTER LOCATION
VDUMPR ;VERSION NUMBER
START: RESET%
MOVE A,[STGBGN,,STGBGN+1]
SETZM -1(1)
BLT A,STGEND-1 ;CLEAR ALL VARIABLES
MOVE P,INIPDL
MOVEM P,PDLP ;SET COMMAND STACK FENCE
MOVE A,[SIXBIT /LHOSTN/]
SYSGT% ; Look up local ARPAnet site #
SKIPE B ; Table exist?
MOVEM A,LHOSTN ; Stash away local site #
MOVE A,[IOWD N.JFN,JFNSTK]
MOVEM A,INIPTR ;INITIALIZE JFN STACK POINTER
MOVEM A,RPSPTR ;REPARSE POINTER
MOVEM A,CURPTR ;AND CURRENT POINTER
MOVEM A,CMDPTR ;AND COMMAND POINTER
MOVE A,[JRST EINT1A]
MOVEM A,EINT1+1 ;SETUP JSR DISPATCH
MOVX F,LDIRF+RESPRO+RESACC ;DEFAULTS
SETZM LSTFIL ;NO LIST IS DEFAULT
SETO A,
MOVE B,[-2,,Q1]
MOVEI C,.JIDEN
GETJI% ;GET JOB DEFAULT DENSITY AND PARITY
JSERR
MOVEM Q1,DENSIT ;SAVE THEM
MOVEM Q2,PARITY
MOVEI A,CURFMT ;DEFAULT IS CURRENT FORMAT
MOVEM A,FORMAT
MOVX A,DEFBKF ;GET DEFAULT BLOCKING-FACTOR
MOVEM A,SETBKF ; AS LAST BLOCKING-FACTOR SET
CALL MTBOT ;SET UP AS IF AT BEGINNING OF TAPE
HRROI A,[ASCIZ/RETRVL/]
STDEV% ;RETRIEVAL TAPE FROM PREVIOUS RUN?
SKIPA ;NO
JRST [ LOAD A,DV%TYP,B
CAIE A,.DVMTA ;JUST MAKE SURE IT'S A TAPE
JRST .+1
MOVEM B,MNTDSG ;IS A TAPE
SETZ A,
CALL SETMNT ;RELEASE TAPE AND DELETE LOGICAL NAME
JRST .+1]
MOVEI A,.FHSLF
MOVE B,[LEVTAB,,CHNTAB]
SIR% ;DECLARE INTERRUPT TABLES
EIR% ;ENABLE INTERRUPTS
MOVE B,CHNMSK
AIC% ;ACTIVATE CHANNELS
MOVE A,[.TICCE,,CECHN]
ATI% ;ACTIVATE ^E INTERRUPT
MOVE A,[.TICCA,,CFCHN] ;[361]
ATI% ;[361] Activate ^A interrupt
CALL UNMAPB ;RESET BUFFERS
MOVEI A,.FHSLF
RPCAP%
TXNE C,SC%WHL+SC%OPR ;WHEEL OR OPERATOR?
JRST [ SETOM WHEEL ;YES
MOVEI A,.MSIIC
MSTR% ;OVERRIDE STRUCTURE REGULATION
ERCAL R ;POSSIBLY RUNNING ON TOPS-20 REL 3A
JRST .+1]
HRLOI A,377777 ;INIT 'BEFORE' DATE TO PLUS INFINITY
MOVEM A,ABTAD
MOVEM A,WBTAD
MOVEM A,MBTAD
MOVX A,1B0 ;INIT 'SINCE' DATE TO MINUS INFINITY
MOVEM A,ASTAD
MOVEM A,WSTAD
MOVEM A,MSTAD
MOVE A,[ICBLK,,CBLK] ;INIT COMMAND STATE BLOCK
BLT A,CBLK+.CMGJB
;RESET AND START COMMAND
CLRST: MOVE P,PDLP ;RESTORE PDL NOW
CALL MTCLS ;CLOSE MAGTAPE IF OPEN
SETZM TRAPJ ;CLEAR TRAP FENCE
SETZM INTPC ;NO ^E
MOVE P,INIPDL ;RESET PUSH DOWN LIST
CALL INIRST ;RESET JFN STACK TO INIPTR
; JRST RESTRT ;AND START OVER
; ..
;TOP OF COMMAND
RESTRT: MOVEM P,PDLP ;SAVE PDL POINTER
SETZM CMDTYP ;ZERO COMMAND TYPE FLAG
SETZM TRAPSP
SETZM TRAPJ ;ZERO TRAP STUFF
SETZM CEXFLG
SETZM INTRQ
MOVE A,CURPTR
CAME A,CMDPTR ;ERROR IF NOT SAME
ERROR BMBCM1,<?CMDPTR SHOULD EQUAL CURPTR>
TXZ F,NOFLG
MOVE A,CMDPTR ;GET COMMAND POINTER
MOVEM A,RPSPTR ;RESET REPARSE POINTER
MOVEM A,CURPTR ;AND CURRENT POINTER
MOVEI A,REPAR0 ;GET REPARSE ADDRESS
HRROI B,[ASCIZ /DUMPER>/] ;GET POINTER TO PROMPT
CALL CMDINI ;INIT FOR COMND JSYS
REPAR1: TXZ F,NOFLG ;FORGET STUFF FROM PARTIAL COMMAND
MOVEI A,CBLK
MOVEI B,[FLDDB. (.CMKEY,,CTBL,<command name>)]
COMND% ;GET COMMAND NAME
NO1: TXNE A,CM%NOP
ERROR RESTRT,<?Not a defined command>
HRRZ B,0(B) ;GET POINTER TO COMMAND WORD
MOVE B,(B) ;FLAGS,,DISPATCH ADDRESS
MOVEM B,CMDTYP ;STORE AS CURRENT TYPE
JRST 0(B) ;DISPATCH TO IT
;HERE WHEN REPARSE NEEDED
REPAR0: MOVE P,PDLP ;RESTORE PDL PNTR
CALL REPRST ;RESET JFN STACK
JRST REPAR1 ;CONTINUE PARSE
REPRST: MOVE D,RPSPTR ;REPARSE POINTER
CALL RSTSTK ;RESET STACK TO REPARSE POINTER
RET ;RETURN
;HERE WHEN COMMAND COMPLETED
CDONE: SETZM STABLK ;[361] zero the tape state block
SKIPN ARCSW ; Doing an archive run?
SKIPE COLSW ; Collection/migration?
JRST [ SKIPE ICMDTY ; One of those, Under ^E?
JRST .+1 ; Yes, don't clean up
SETZM ARCSW
SETZM COLSW
CALL MLDONE ; Finished with SNDMSG stuff
JRST .+1]
SKIPE RETSW ; Doing a retrieval?
JRST [ SKIPE ICMDTY ; Yes, under ^E?
JRST .+1 ; Yes, don't clean up now
CALL RETCLN ; Do clean up actions
CALL MLDONE ; We're done with SNDMSG fork
SETZM RETSW ; Flag no longer retrieving
CALL RELPID ; Relase PID used for QSR comm.
JRST .+1]
SETZM CEXFLG
SKIPN ICMDTY ;SKIP IF UNDER ^E
JRST [ TXZ F,TF2 ;NOT IN MIDDLE OF FILE
MOVE D,CMDPTR ;GET COMMAND POINTER
CAMN D,INIPTR ;COMPARE TO INITIAL POINTER
JRST .+1 ;SAME, OK
TMSGC <%CMDPTR SHOULD EQUAL INIPTR>
CALL INIRST ;RESET STUFF
JRST RESTRT] ;RESTART COMMAND
MOVE D,CMDPTR ;FINAL POINTER
CALL RSTSTK ;RESET STACK TO COMMAND POINTER
MOVEM D,RPSPTR ;SET BACK TO COMMAND POINTER
JRST RESTRT
;HERE TO BOMB THE CURRENT COMMAND
;IF COMMAND IS CONFIRMED, ENTER AT BMBCMD
;IF COMMAND IS NOT CONFIRMED, ENTER AT BMBCM1
BMBCMD: MOVE D,CMDTYP ;GET COMMAND TYPE
TXNE D,TY%MAP ;NOSKIP IF COMMAND MAPS BUFPAG
CALL UNMAPB ;RESET BUFFERS
BMBCM1: MOVE P,PDLP ;RESET PDL TO TOP OF COMMAND
MOVE D,CMDPTR ;RESET TO TOP OF COMMAND
CALL RSTSTK ;RESET STACK TO TOP OF COMMAND
MOVEM D,RPSPTR ;REPARSE POINTER RESET
MOVEI A,.PRIIN ;PRIMARY INPUT DEVICE
CFIBF% ;CLEAR BUFFER
SKIPE RETSW ; In a retrieval?
JRST [ SKIPN MYPID ; Have a PID?
JRST .+1 ; No, forget this
CALL GDBYE ; Tell QUASAR goodbye
JFCL
CALL RELPID ; And release the PID
JRST .+1]
JRST RESTRT ;TOP OF NEW COMMAND
;CONFIRM
CONFRM: PUSH P,A
PUSH P,B
PUSH P,C ;BE TRANSPARENT
MOVEI A,CBLK
MOVEI B,[FLDDB. .CMCFM]
COMND% ;CONFIRM
TXNE A,CM%NOP
ERROR BMBCM1,<?Not confirmed>
CALL JFNCFM ;WORK OVER JFN STACK
POP P,C
POP P,B
POP P,A
RET
; COMNDX - EXECUTE COMND JSYS AND HANDLE NO-PARSE ERRORS
; B/ ADDRESS OF FUNCTION DESCRIPTOR BLOCK (FDB)
; RETURNS +1: PARSE SUCCESSFUL; A,B,C/ AS RETURNED BY COMND
; TO BMBCM1 AFTER TYPING ERROR MESSAGE IF CM%NOP IS RETURNED
COMNDX: MOVEI A,CBLK ;GET STATE BLOCK ADDRESS
COMND% ;ISSUE COMND
TXNN A,CM%NOP ;PARSE OK?
RET ;YES
TMSGC <?>
CALL JSERRM ;TYPE REASON FOR FAILURE
JRST BMBCM1
; COMNDN - SAME AS COMNDX, BUT TAKES +1 ON NO-PARSE, +2 ON SUCCESS
COMNDN: MOVEI A,CBLK
COMND%
TXNN A,CM%NOP ;OK?
RETSKP ;YES
TMSGC <?>
CALLRET JSERRM ;TYPE REASON AND RETURN TO CALLER
; NOISE - PARSE NOISE PHRASE
; A/ STRING POINTER TO NOISE PHRASE
; RETURNS +1: NOISE PARSED SUCCESSFULLY
NOISE: STKVAR <<NOIFDB,2>>
MOVEM A,.CMDAT+NOIFDB ;STUFF POINTER IN FDB
MOVX A,FLD(.CMNOI,CM%FNC)
MOVEM A,.CMFNP+NOIFDB
MOVEI B,NOIFDB ;GET FDB ADDR
CALLRET COMNDX ;ISSUE COMND JSYS AND RETURN
; KEYWD - PARSE A KEYWORD
; A/ LH: ADDRESS OF ASCIZ HELP TEXT (0 IF NONE)
; RH: ADDRESS OF KEYWORD TABLE
; RETURNS +1: KEYWORD PARSED, B/ ADDRESS OF KEYWORD TABLE ENTRY
KEYWD: SAVEQ ;BUILD FDB IN Q1-Q3
MOVX Q1,FLD(.CMKEY,CM%FNC) ;.CMFNP WORD OF FDB
HRRZ Q2,A ;.CMDAT WORD OF FDB
HLRO Q3,A ;.CMHLP WORD OF FDB
TRNE Q3,-1 ;HELP MESSAGE SPECIFIED?
TXO Q1,CM%HPP ;YES, TELL COMND
MOVEI B,Q1 ;GET FDB ADDRESS FOR COMND
CALLRET COMNDX ;GO PARSE AND RETURN TO CALLER
; CMDINI - INITIALIZE FOR COMND JSYS
; A/ FLAGS,,REPARSE ADDRESS
; B/ STRING POINTER TO PROMPT
; RETURNS +1: ALWAYS
CMDINI: MOVEM A,CBLK+.CMFLG ;STORE FLAGS AND REPARSE ADDRESS
MOVEM B,CBLK+.CMRTY ;STORE POINTER TO PROMPT STRING
MOVEI B,[FLDDB. .CMINI] ;GET ADDRESS OF INIT FDB
CALLRET COMNDX ;ISSUE COMND JSYS AND RETURN +1
;COMMAND HAS JUST BEEN CONFIRMED. CHECK FOR UNDER ^E
;AND SET JFNSTK POINTERS CORRECTLY FOR CIRCUMSTANCES
;ROUTINE ASSUMES IT MAY USE AC'S A,B,C.
JFNCFM: SKIPE ICMDTY ;UNDER ^E?
JRST JFNCF1 ;YES, SEE IF THIS IS A CONTINUE CMD.
TXZ F,LTTYF
MOVE A,CMDTYP ;GET TYPE
TXNE A,TY%RPO ;SKIP IF NOT REPARSE ONLY
JRST [ MOVE A,RPSPTR ;GET REPARSE POINTER
MOVEM A,CURPTR ;STORE AS CURRENT POINTER
RET]
MOVE A,CURPTR ;CURRENT POINTER
MOVEM A,RPSPTR ;BECOMES REPARSE POINTER
RET
;THE USER HAS TYPED A COMMAND UNDER ^E. CHECK IF IT IS
;A CONTINUE OR NO-CONTINUE COMMAND. IF IT IS NO-CONTINUE,
;INFORM THE USER AND GIVE HER/HIM THE CHOICE BETWEEN THE
;OLD COMMAND AND THE CURRENT COMMAND.
;CALLED WITH A,B,C ON THE STACK AND WITH THE
;CURRENT COMMAND TYPE IN CMDTYP.
JFNCF1: MOVE A,CMDTYP ;GET COMMAND INFORMATION
TXNE A,TY%NOC ;SKIP IF CONTINUE-ABLE
JRST JFNCF2 ;NOT CONTINUE-ABLE
TXNN A,TY%RPO ;SKIP IF REPARSE ONLY
JRST [ MOVE B,RPSPTR ;GET REPARSE POINTER
MOVEM B,CMDPTR ;USE AS COMMAND POINTER
MOVE B,CURPTR ;CURRENT POINTER
MOVEM B,RPSPTR ;ALSO REPARSE POINTER
RET ] ;RETURN
MOVE B,RPSPTR ;GET REPARSE POINTER
MOVEM B,CURPTR ;RESET CURRENT POINTER
RET ;RETURN
;HERE IF UNDER ^E AND NOT CONTINUEABLE
JFNCF2: HRROI A,[ASCIZ\%Do you really want to abort your interrupted command? \]
CALL YESNO ;GET YES OR NO
JUMPE A,DLTNEW ;NO-- DELETE NEW COMMAND
; JRST DLTOLD ;YES-- DELETE OLD COMMAND
;HERE TO DELETE OLD COMMAND
DLTOLD: SAVPQ ;SAVE PERM REGS
TXZ F,LTTYF
SKIPE MTJFN ;TAPE OPEN?
JRST [ MOVX B,OF%RD ;YES
TDNE B,TMODE ;OPEN FOR READING
SKIPG MTTYP ; AND LABELED?
JRST .+1 ;NOT BOTH
CALL XGDSTS ;CLEAR ERRORS
CALL REWCV ;PROBABLY IN THE MIDDLE OF SOME SAVESET
JRST .+1]
CALL MTCLS ;CLOSE TAPE IF OPEN
SETZ A,
CALL SETMNT ;RELEASE MOUNTED MT IF ANY
TXZ F,TF2 ;NOT IN MIDDLE OF FILE
TXZ F,SKPBFL ;[322] CLEAR BACKWARD SKIP FLAG
MOVE D,CMDPTR ;COMMAND POINTER
CAMN D,INIPTR ;SKIP IF JFNS TO DELETE
JRST DLTOL2 ;NONE
CALL UNMAPB ;RESET BUFFERS
DLTOL1: POP D,A ;GET OLD JFN
CALL RLSJFN ;THROW AWAY
CAME D,INIPTR ;SKIP IF DONE
JRST DLTOL1 ;LOOP
MOVE A,JFN ;[316]GET JFN OF CURRENT LOAD/DUMP FILE
CALL RLSJFN ;[316]CLOSE IT
SETZM JFN ;[316]FLAG IT AS NO LONGER IN USE
MOVE A,INIPTR ;INITIAL POINTER
MOVE B,CURPTR ;CURRENT POINTER
SUB B,CMDPTR ;NEW SIZE
HRLS B ;SIZE,,SIZE
ADD A,B ;NEW POINTER
MOVEM A,CURPTR ;STORE
HRLZ B,CMDPTR ;START BLT FROM
HRR B,INIPTR ;BLT TO
ADD B,[1,,1]
BLT B,0(A) ;MOVE IT
MOVE A,INIPTR
MOVEM A,CMDPTR
DLTOL2: MOVE A,CURPTR
MOVEM A,RPSPTR ;UPDATE REPARSE POINTER
MOVE A,LPTJFN ;LIST FILE JFN
CALL RLSJFN ;RELEASE IT
SETZM INTPC
SETZM ICMDTY ;NO LONGER UNDER ^E
MOVE A,INIPDL ;
MOVE B,P ;
SUB B,IPDLP ;# ITEMS TO GET RID OF
HRLS B ;IN BOTH SIDES
ADD A,B ;CONSTRUCT NEW POINTER
MOVE P,A ;AND STORE
HRLZ B,IPDLP ;BLT FROM
HRR B,INIPDL ;BLT TO
ADD B,[1,,1]
BLT B,0(A) ;MOVE IT
MOVE A,INIPDL
MOVEM A,PDLP ;RESET PDLP
HRRZS A,Q1 ;OFFSET ONLY
HRRZ B,NIJFN ;PICK UP INTERRUPTED OFFSET
SUB Q1,B ;NEW OFF SET
HRLS Q1 ;NEW OFFSET IN BOTH SIDES
HRLZ B,NIJFN ;BLT START OFFSET
MOVE C,[JFNLST,,JFNLST] ;BASE FOR FIRST BLT
ADD C,B ;FIGURE BLT START ADDRESSES
BLT C,JFNLST(Q1)
ADD B,[JF2LST,,JF2LST] ;BLT START ADDRESSES
BLT B,JF2LST(Q1)
MOVSI B,-NJFNL+1 ;SET UP Q1
ADD Q1,B ;...
RET
;HERE TO FORGET NEW COMMAND
DLTNEW: CALL REPRST ;RESET JFN STACK
MOVE P,PDLP ;SET PDL BACK
SETZM CMDTYP ;NO COMMAND
JRST RESTRT ;GO ON
;COMMAND NAME TABLE
DEFINE CTB (DAT,FLGS,TXT)<
XWD [ASCIZ \TXT\],[FLGS+DAT]>
CTBL: NCTBL,,NCTBL
CTB $AB4,,<ABEFORE>
CTB $ACC,,<ACCOUNT>
CTB $ASI,,<ASINCE>
CTB $B4,,<BEFORE>
CTB CHCK,TY%NOC+TY%MAP,<CHECK>
CTB $CSUM,,<CHECKSUM>
CTB $CONT,,<CONTINUE>
CTB $CREAT,,<CREATE>
CTB $DEN,,<DENSITY>
CTB $LDIR,,<DIRECTORIES>
CTB $EOT,TY%NOC+TY%MAP,<EOT>
CTB $EXIT,TY%NOC,<EXIT>
CTB $LFIL,,<FILES>
CTB $FMT,,<FORMAT>
CTB TYPHLP,,<HELP>
CTB $INDMD,,<INDUSTRY>
CTB $INISP,TY%RPO,<INITIAL>
CTB $ICMOD,TY%NOC,<INTERCHANGE>
CTB $LIST,TY%RPO,<LIST>
CTB $MB4,,<MBEFORE>
CTB $MSI,,<MSINCE>
CTB $NO,,<NO>
CTB $PAR,,<PARITY>
CTB PRINT,TY%NOC+TY%MAP,<PRINT>
CTB $PRO,,<PROTECTION>
CTB $EXIT,TY%NOC,<QUIT> ;synonym for EXIT
CTB $LOAD,TY%NOC+TY%MAP+TY%DBL,<RESTORE>
CTB $RETRI,TY%NOC+TY%MAP+TY%DBL,<RETRIEVE>
CTB $REW,TY%NOC,<REWIND>
CTB DUMP,TY%NOC+TY%MAP+TY%DBL,<SAVE>
CTB $$SET,,<SET>
CTB $SIL,,<SILENCE>
CTB $SINCE,,<SINCE>
CTB $SKIP,TY%NOC+TY%MAP,<SKIP>
CTB $SSNAM,,<SSNAME>
CTB $SUP,,<SUPERSEDE>
CTB $TAPE,TY%RPO,<TAPE>
CTB $UNL,TY%NOC,<UNLOAD>
NCTBL==.-CTBL-1
;INITIAL COMMAND STATE BLOCK
ICBLK: REPAR0 ;REPARSE DISPATCH
.PRIIN,,.PRIOU
POINT 7,[ASCIZ /DUMPER>/] ;PROMPT
POINT 7,CBFR
POINT 7,CBFR
CBFSIZ*5
0
POINT 7,ACBFR
ACBSIZ*5
GJBLK
SUBTTL COMMANDS
;DATE SETTING COMMANDS
;ACCESSED-BEFORE
$AB4: CALL GETTAD
MOVEM A,ABTAD
JRST CDONE
;ACCESSED-SINCE
$ASI: CALL GETTAD
MOVEM A,ASTAD
JRST CDONE
;WRITTEN-BEFORE
$B4: CALL GETTAD
MOVEM A,WBTAD
JRST CDONE
;WRITTEN-SINCE
$SINCE: CALL GETTAD
MOVEM A,WSTAD
JRST CDONE
;MOVED-BEFORE
$MB4: CALL GETTAD
MOVEM A,MBTAD
JRST CDONE
;MOVED-SINCE
$MSI: CALL GETTAD
MOVEM A,MSTAD
JRST CDONE
;GET TIME AND DATE AS NEXT FIELD
GETTAD: HRROI A,[ASCIZ/DATE AND TIME/]
CALL NOISE
MOVEI B,[FLDDB. (.CMTAD,,CM%IDA+CM%ITM,,,[FLDDB. (.CMTAD,,CM%IDA)])]
CALL COMNDX ;PARSE DATE WITH OPTIONAL TIME
MOVE A,B
CALLRET CONFRM ;CONFIRM IT
;INTERCHANGE MODE
$ICMOD: HRROI A,[ASCIZ/FORMAT/]
CALL NOISE
CALL CONFRM
TXNE F,NOFLG
TXZA F,ICMODF ;NO INTERCHANGE
TXO F,ICMODF ;INTERCHANGE
JRST CDONE
;(NO)CREATE DIRECTORIES FROM TAPE DATA ON RESTORE
$CREAT: HRROI A,[ASCIZ/DIRECTORIES FROM TAPE DATA/]
CALL NOISE
CALL CONFRM
TXNE F,NOFLG
TXZA F,USRDAT ;MEANS IGNORE USER DATA
TXO F,USRDAT
JRST CDONE
;(NO)INDUSTRY COMPATIBLE 36-BIT MODE, I.E. LIKE MULTICS AND BBN
$INDMD: HRROI A,[ASCIZ/COMPATIBLE 36-BIT MODE/]
CALL NOISE
CALL CONFRM
TXNE F,NOFLG
TXZA F,T36MOD ;NORMAL DEC 'CORE DUMP' MODE
TXO F,T36MOD ;ELSE 2 36-BIT WORDS IN 9 FRAMES
JRST CDONE
;INITIAL FILE SPECIFICATION FOR SAVE/RESTORE. MUST BE FILE WITHIN
;GROUP SPECIFIED IN SAVE OR RESTORE COMMAND. OPERATIONS
;BEGINS WITH THIS FILE.
$INISP: HRROI A,[ASCIZ/FILESPEC/]
CALL NOISE
SETZ B, ;PREPARE B IN CASE OF NEGATION
JXN F,NOFLG,$INIS1 ;JUMP IF NEGATED
MOVEI A,[EXP CSCD,CSWD,CSCD,CSCD] ;POINT TO ROUTINES
CALL FILDFI ;SETUP DEFAULT STRING
MOVX A,GJ%OLD+GJ%IFG
HLLM A,GJBLK+.GJGEN ;ALLOW STARS
MOVEI A,CBLK
MOVEI B,[FLDDB. .CMFIL]
COMND%
TXNE A,CM%NOP
ERRORJ RESTRT,<?Invalid filespec>
CALL ADFILE ;ADD JFN TO JFN STACK
$INIS1: CALL CONFRM ;CONFIRM
EXCH B,INIJFN ;SAVE NEW JFN, GET OLD JFN
HRRZ A,B ;GET OLD JFN ALONE IN A
SKIPE A ;DID I HAVE A JFN BEFORE?
RLJFN% ;YES, DUMP IT
JFCL
SETZM ININUM ;CLEAR DDB FLAG
JRST CDONE
;SAVESET NAME
$SSNAM: MOVE Q1,CBLK+.CMPTR ;SAVE CURRENT LINE POINTER
MOVEI B,[FLDDB. (.CMTXT,CM%SDH,,<arbitrary save set name text>)]
CALL COMNDX ;PARSE TO EOL
HRROI A,SSNBUF ;DESTINATION POINTER
MOVE B,CBLK+.CMABP ;POINT TO ATOM BUFFER WHERE TEXT IS NOW
MOVEI C,NSSNBF-1 ;[317] MAXIMUM SSNAME LENGTH
SETZ D, ;[317] ASCIZ
SOUT% ;COPY NAME
JRST CDONE ;ALL DONE WITH $SSNAM
;SUPERSEDE ALWAYS/NEVER/OLDER
$SUP: MOVEI A,STBL
CALL KEYWD ;PARSE KEYWORD
CALL CONFRM
HRRZ B,0(B) ;GET FLAGS
TXZ F,SSA+SSN ;MOVE THEM TO F
IOR F,B
JRST CDONE
STBL: NSTBL,,NSTBL
TB SSA,<ALWAYS>
TB SSN,<NEVER>
TB 0,<OLDER>
NSTBL==.-STBL-1
;PROTECTION TO BE RESTORED FROM TAPE OR SYSTEM DEFAULT
$PRO: HRROI A,[ASCIZ/OF RESTORED FILES FROM/]
CALL NOISE
MOVEI A,ACCTB
CALL KEYWD ;PARSE KEYWORD
CALL CONFRM
HRRZ B,0(B)
SKIPN B ;SET FLAG PER ARGUMENT
TXZA F,RESPRO
TXO F,RESPRO
JRST CDONE
;ACCOUNT OF RESTORED FILES TO BE SET FROM TAPE OR SYSTEM DEFAULT
$ACC: HRROI A,[ASCIZ/OF RESTORED FILES FROM/]
CALL NOISE
MOVEI A,ACCTB
CALL KEYWD ;PARSE KEYWORD
CALL CONFRM
HRRZ B,0(B)
SKIPN B ;SET FLAG PER ARG
TXZA F,RESACC
TXO F,RESACC
JRST CDONE
;ARGUMENT KEYWORD TABLE FOR PROTECTION AND ACCOUNT
ACCTB: NACCTB,,NACCTB
TB 0,<SYSTEM-DEFAULT>
TB 1,<TAPE>
NACCTB==.-ACCTB-1
;TAPE - SETS MTA UNIT SPECIFICATION
$TAPE: HRROI A,[ASCIZ/DEVICE/]
CALL NOISE
CALL PRSTAP ;PARSE MAGTAPE DESIGNATOR, GET JFN IN B
JRST RESTRT ;USER BLEW IT
CALL ADLIST ;ADD JFN TO JFN STACK
CALL CONFRM ;CONFIRM IT
MOVE A,B ;PASS JFN
CALL CHKMTJ ;CHECK OUT JFN
JRST RESTRT ;FAILED
JRST CDONE
;NTAPE - GET TAPE SPEC FOR SECOND AND SUBSEQUENT TAPES
;NTAPER ENTRY REWINDS TAPE BEFORE RETURNING
;RETURNS +1: ERROR SWITCHING VOLUMES
; +2: SUCCESS
NTAPE: TDZA A,A ;NO REWIND
NTAPER: MOVEI A,1 ;REWIND
SAVEQ
MOVE Q2,A ;SAVE REWIND FLAG
MOVEM P,TPDLP ;TEMPORARY PLACE TO SAVE P
NTAPE1: SETZM VOLID6 ;CLEAR VOLID
CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
SKIPE MTDSG ;SKIP IF NO TAPE DEVICE YET
JRST [ SKIPGE A,MTTYP ;WHAT KIND OF TAPE?
JRST .+1 ;MTA, HAVE TO TALK TO USER
JUMPE A,NTUMT ;UNLABELED MT, DO VOLSWITCH
RETSKP] ;LABELED MT, NO ACTION NECESSARY
MOVEI A,NTAPEC ;REPARSE ADDRESS
HRROI B,[ASCIZ /$ Tape filespec /]
CALL CMDINI ;INIT FOR COMND JSYS
NTAPE2: CALL PRSTAP ;PARSE TAPE FILESPEC
JRST NTAPE1 ;ERROR
CALL ADLIST ;ADD JFN TO JFN STACK
MOVE Q1,B ;SAVE JFN
MOVEI B,[FLDDB. .CMCFM]
CALL COMNDN ;GET CONFIRMATION
JRST [ CALL REPRST ;ERROR, CLEAN UP DEAD JFNS
JRST NTAPE1] ;TRY AGAIN
MOVE A,RPSPTR ;REPARSE POINTER
MOVEM A,CURPTR ;RESET TO REPARSE POINTER
MOVE A,Q1 ;GET JFN IN A FOR CHKMTJ
CALL CHKMTJ ;SETUP FOR OPEN
JRST NTAPE1 ;FAILED
JUMPE Q2,RSKP ;RETURN NOW IF NO REWIND REQUESTED
CALL MTOPNX ;GET IT OPEN
CALL REWCV ;REWIND IT
CALL MTCLS ;CLOSE IT
RETSKP
;REPARSE HERE
NTAPEC: MOVE P,TPDLP ;RESTORE PNTR
CALL REPRST ;RESET JFN STACK
JRST NTAPE2 ;CONTINUE
; SWITCH TO NEXT VOLUME ON UNLABELED MT DEVICE
NTUMT: TMSGC <[Mounting next tape volume]
>
CALL MTOPNX ;OPEN JFN
MOVE A,MTJFN ;GET JFN
MOVEI B,.MOVLS ;VOLUME-SWITCH MTOPR FUNCTION CODE
MOVEI C,[EXP 3,.VSMRV,1] ;ARG LIST TO GET TO NEXT VOLUME
MTOPR%
ERJMP [TMSGC <?Cannot switch to next tape volume because:
>
CALL JSERRM ;SAY WHY
CALLRET MTCLS] ;CLOSE JFN
MOVE A,MTJFN
CALL GMTINF ;UPDATE VOLID
CALL REWCV ;AT NEXT VOLUME, SO REWIND IT
CALL MTCLS
RETSKP
; PRSTAP - PARSE MAGTAPE FILESPEC
; RETURNS +1: ERROR ON PARSE, MESSAGE TYPED
; +2: SUCCESSFUL PARSE, B/ JFN
PRSTAP: MOVE A,[GJBLK,,GJBLK+1]
SETZM GJBLK
BLT A,GJBLK+.GJBFP ;CLEAR COMND GTJFN BLOCK
MOVEI A,CBLK
MOVEI B,[FLDDB. (.CMFIL,CM%SDH,,<magtape designator>)]
COMND% ;READ MAGTAPE FILESPEC
TXNE A,CM%NOP
ERRORJ R,<?Invalid magtape designator>
RETSKP ;GOOD RETURN, B/ JFN
; CHKMTJ - GIVEN A JFN, CHECK IF IT IS A REASONABLE MAGTAPE JFN
; AND SET UP MTTYP, MTDSG, AND MTDEV
; A/ JFN (RELEASED BY CHKMTJ)
; RETURNS +1: NON-MAGTAPE OR ILLEGAL LABEL TYPE, ERROR MESSAGE TYPED
; +2: SUCCESS, MTDSG/ DESIGNATOR, MTDEV/ ASCIZ NAME
; MTTYP/ -1=MTA, 0=UNLABELED MT, +1=LABELED MT
CHKMTJ: SAVEQ
MOVE Q1,A ;SAVE JFN
DVCHR% ;GET DEVICE CHARACTERISTICS
LOAD D,DV%TYP,B ;GET DEVICE TYPE
IFN DSKDMP,<MOVEI D,.DVMTA> ;For disk version, accept non-magtape
CAIE D,.DVMTA ;IS IT A MAGTAPE?
JRST [ JSP D,NTAP4 ;NO, GO GIVE ERROR MESSAGE
ASCIZ/ is not a magtape/]
MOVEM A,MTDSG ;SAVE DESIGNATOR
SETZM VOLID6 ;CLEAR VOLID IN CASE OF MTA
SETO B, ;ASSUME MTA
TRNN A,DV%PSD ;CORRECT?
JRST NTAP3 ;YES, SKIP MT CODE
MOVE A,Q1 ;GET JFN
CALL GMTINF ;GET LABEL TYPE IN A
MOVEI B,1 ;GET CODE FOR LABELED-MT
CAIE A,.LTANS ;ANSI?
CAIN A,.LTT20 ;OR TOPS-20?
JRST NTAP3 ;YES, LABELED MT
SETZ B, ;GET CODE FOR UNLABELED-MT
CAIN A,.LTUNL
JRST NTAP3 ;UNLABELED MT
MOVEI D,[ASCIZ/Illegal label type - must be UNLABELED or TOPS-20/]
NTAP4: MOVEI A,"?" ;[311] LOAD QUESTION MARK
PBOUT% ;[311] TYPE IT
MOVEI A,.PRIOU ;REPORT NAME
HRRZ B,Q1
MOVX C,<FLD(.JSSSD,JS%DEV)+FLD(.JSSSD,JS%DIR)+FLD(.JSSSD,JS%NAM)+FLD(.JSSSD,JS%TYP)+JS%PAF> ;[311] LOAD JFNS FORMAT BITS
JFNS%
HRRO A,D ;GET STRING POINTER TO TEXT
PSOUT% ;TYPE MESSAGE
MOVE A,Q1
RLJFN% ;DUMP THE JFN
JFCL
SETZM MTDSG ;CLEAR DESIGNATOR
HRROI B,CRLF
CALLRET TMSGQ ;TYPE CRLF AND RETURN +1
NTAP3: MOVEM B,MTTYP ;STORE TYPE OF TAPE DEVICE
HRROI A,MTDEV ;GET DESTINATION STRING POINTER
HRRZ B,Q1 ;GET JFN
MOVX C,<FLD(.JSAOF,JS%DEV)+JS%PAF> ;DEVICE FIELD, PUNCTUATION
IFN DSKDMP,<MOVX C,FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS%
MOVE A,Q1 ;RELEASE TEMP JFN
RLJFN%
JFCL
RETSKP
;SET COMMAND
$$SET: MOVEI A,SETTBL
CALL KEYWD ;PARSE KEYWORD
HRRZ B,0(B)
MOVE B,(B)
MOVEM B,CMDTYP ;STORE AS CURRENT COMMAND TYPE
JRST 0(B) ;AND GO ON
SETTBL: NSETTB,,NSETTB
CTB SETBLK,,<BLOCKING-FACTOR>
CTB TAPNUM,,<TAPE-NUMBER>
NSETTB==.-SETTBL-1
;SET TAPE NUMBER --SETS REEL #
TAPNUM: HRROI A,[ASCIZ/DECIMAL NUMBER/]
CALL NOISE
MOVEI B,[FLDDB. (.CMNUM,,^D10)]
CALL COMNDX ;PARSE DECIMAL NUMBER
CALL CONFRM
MOVEM B,TAPNO
MOVEM B,RTAPNO ;IN CASE USER IS READING
TXO F,TNSF ;USER SET TAPE NUMBER
JRST CDONE
;SET BLOCKING-FACTOR
SETBLK: HRROI A,[ASCIZ/TO/]
CALL NOISE
MOVEI B,[FLDDB. (.CMNUM,,^D10,<number of records,>)]
CALL COMNDX ;PARSE DECIMAL NUMBER
PUSH P,B
HRROI A,[ASCIZ/RECORDS/]
CALL NOISE
CALL CONFRM
POP P,B
CAIGE B,1 ;MUST BE 1 OR GREATER
ERROR RESTRT,<?BLOCKING-FACTOR must be greater than 0>
CAILE B,MAXBKF ;MUST BE WITHIN LIMIT
ERROR RESTRT,<?BLOCKING-FACTOR too large>
MOVEM B,SETBKF ;REMEMBER BLOCKING-FACTOR
JRST CDONE
;TAPE PARAMETERS
;DENSITY
$DEN: HRROI A,[ASCIZ/OF MAGTAPE/]
CALL NOISE
MOVEI A,DENTAB
CALL KEYWD ;PARSE DENSITY KEYWORD
CALL CONFRM
HRRZ B,0(B) ;GET DENSITY CODE
MOVEM B,DENSIT ;SAVE FOR OPEN
JRST CDONE
DENTAB: NDENTB,,NDENTB
TB .SJD16,<1600-BPI>
TB .SJDN2,<200-BPI>
TB .SJDN5,<556-BPI>
TB .SJD62,<6250-BPI>
TB .SJDN8,<800-BPI>
TB .SJDDN,<JOB-DEFAULT>
NDENTB==.-DENTAB-1
;PARITY
$PAR: HRROI A,[ASCIZ/OF MAGTAPE/]
CALL NOISE
MOVEI A,PARTAB
CALL KEYWD ;PARSE PARITY KEYWORD
CALL CONFRM
HRRZ B,0(B) ;GET PARITY CODE
MOVEM B,PARITY ;SAVE FOR OPEN
JRST CDONE
PARTAB: NPARTB,,NPARTB
TB .SJPRE,<EVEN>
TB .SJPRO,<ODD>
NPARTB==.-PARTAB-1
;FORMAT SPECIFICATION - USEFUL IF STARTING IN MIDDLE OF TAPE
$FMT: HRROI A,[ASCIZ/VERSION NUMBER IS/]
CALL NOISE
MOVEI B,[FLDDB. (.CMNUM,,^D10)]
COMND%
TXNE A,CM%NOP
ERROR RESTRT,<?Not a decimal number>
CALL CONFRM
MOVEM B,FORMAT ;SAVE SPECIFIED NUMBER
JRST CDONE
;'NO' - INVERTS MEANING OF FOLLOWING COMMAND
$NO: TXO F,NOFLG ;NOTE INVERSION
MOVEI B,[FLDDB. (.CMKEY,,NOTBL,<command name>)]
COMND% ;ONLY CERTAIN COMMANDS AFTER NO
JRST NO1 ;JOIN NORMAL CASE
NOTBL: NNOTB,,NNOTB
CTB $CSUM,,<CHECKSUM>
CTB $CREAT,,<CREATE>
CTB $LDIR,,<DIRECTORIES>
CTB $LFIL,,<FILES>
CTB $INDMD,,<INDUSTRY>
CTB $INISP,,<INITIAL>
CTB $ICMOD,,<INTERCHANGE>
CTB $LIST,,<LIST>
CTB $SIL,,<SILENCE>
NNOTB==.-NOTBL-1
;'HELP'
TYPHLP: CALL CONFRM
MOVX A,GJ%OLD+GJ%SHT
HRROI B,[ASCIZ /HLP:DUMPER.HLP/] ;[304] Try HLP: first
GTJFN% ;[304] GET HELP FILE
ERJMP [MOVX A,GJ%OLD+GJ%SHT ;[304] Set flags for GTJFN
HRROI B,[ASCIZ /SYS:DUMPER.HLP/];[304] Set the file name
GTJFN% ;[304] LOOK ON SYS:
ERJMP [ TMSGC <?DUMPER help file not available, use "?" for list of commands.
>
JRST BMBCMD] ;[304] To parser
JRST .+1] ;[304] Go back
MOVEM A,JFN
MOVX B,<FLD(7,OF%BSZ)+OF%RD>
OPENF%
ERJMP [MOVE A,JFN
RLJFN%
JFCL
CALL JSERR1
SETZM JFN
JRST BMBCMD]
TYPHL1: MOVE A,JFN ;COPY FILE TO TERMINAL
BIN%
JUMPN B,[MOVEI A,.PRIOU
BOUT%
JRST TYPHL1]
CLOSF% ;NULL, ASSUME EOF
JFCL
SETZM JFN
JRST RESTRT
;EXIT
$EXIT: CALL CONFRM
HALTF%
CALL MTCLS ;CLOSE MAGTAPE IF OPEN
JRST RESTRT ;IF CONTINUED
;TAPE POSITION COMMANDS
;REWIND
$REW: MOVEI B,[FLDDB. .CMKEY,,RWTB,,CURRENT-VOLUME]
CALL COMNDX ;PARSE KEYWORD
HRRZ B,(B) ;GET DISPATCH ADDRESS
JRST (B) ;OFF TO KEYWORD HANDLER
RWTB: RWTBL,,RWTBL
TB REWC,CURRENT-VOLUME
TB REWS,SWITCHING
RWTBL==.-RWTB-1
REWC: CALL CONFRM
SETOM CEXFLG ;[326] ALLOW INTERRUPT
CALL MTOPNX
CALL REWCV ;REWIND TO BEGINNING OF CURRENT VOLUME
JRST REW2
REWS: SAVEQ
HRROI A,[ASCIZ/TO VOLUME NUMBER/]
CALL NOISE
MOVEI B,[FLDDB. .CMNUM,CM%SDH,12,decimal sequence number of volume within set,1]
CALL COMNDX ;PARSE VOLUME #
CALL CONFRM
SKIPG Q3,B
ERROR RESTRT,<?Volume number must be positive>
SETOM CEXFLG ;[326] ALLOW INTERRUPT
CALL MTOPNX ;OPEN MAGTAPE
SKIPGE A,MTTYP ;MTA DEVICE?
ERROR REW2,<?Use "TAPE" command to switch MTA devices>
JUMPG A,[CAIE Q3,1 ;LABELED TAPE, CHECK VOLUME #
ERROR REW2,<?Labeled tapes can be switched only to volume 1>
CALL REWVS ;REWIND TO FIRST VOLUME OF SET
JRST REW1]
MOVE A,MTJFN ;UNLABELED MT, GET JFN
MOVEI B,.MOVLS ;VOLUME-SWITCH FUNCTION
MOVEI C,Q1 ;ARG BLOCK ADDRESS
MOVEI Q1,3 ;PUT SIZE IN ARG BLOCK
MOVEI Q2,.VSMNV ;MOUNT ABSOULTE VOLUME # (IN Q3)
MTOPR%
ERJMP [TMSGC <?Cannot switch to specified volume because:
>
CALL JSERRM ;TELL ABOUT ERROR
JRST REW1]
CALL REWCV ;REWIND TAPE, RESET COUNTERS
REW1: SETZM VOLID6 ;CLEAR VOLID
REW2: CALL MTCLS ;CLOSE MT
JRST CDONE
;UNLOAD
$UNL: CALL CONFRM ;CONFIRM
SKIPN MTDSG ;HAVE A TAPE YET?
ERROR BMBCMD,<?No tape device specified yet> ;NO
SKIPL MTTYP ;MT DEVICE?
ERROR CDONE,<%Use the monitor DISMOUNT TAPE command to unload MOUNTed tapes> ;[350]YES
CALL MTOPNX ;MTA DEVICE
CALL UNLOAD ;UNLOAD IT
JRST REW1 ;CLEAR VOLID, CLOSE TAPE, EXIT
;SKIP TO END OF TAPE, I.E. TO JUST BEFORE TAPE TRAILER RECORD
$EOT: CALL CONFRM ;CONFIRM
SETOM CEXFLG ;ALLOW INTERRUPT
CALL MTOPNR ;OPEN TAPE FOR READ
EOT1: CALL MTRED ;READ NEXT RECORD
JRST [ TMSG <, record ignored
>
JRST EOT1]
MOVN A,TYP ;CHECK TYPE
CAIE A,CTPHX
CAIN A,TPHDX ;TAPE HEADER?
JRST [ CALL TYHEDR ;YES, TYPE INFO
JRST EOT1]
CAIN A,FLHDX ;[361] FILE HEADER?
JRST [ MOVE A,[XWD BUFF,LSTRD] ;[361] Copy last filename read
BLT A,LSTRD+100-1 ;[361] from tape buffer
JRST EOT1] ;[361] CONTINUE SCANNING
CAIE A,TPTRX ;TAPE TRAILER?
JRST EOT1 ;NO, KEEP SCANNING
SKIPLE MTTYP ;YES, LABELED TAPE?
JRST EOT2 ;[340] YES, SKIP TAPE REPOSITIONING
CALL BACKSP ;BACK UP OVER TAPE TRAILER
CALL BACKSP ; and back over another
CALL FWRSP ; Then advance one to be going in
; proper direction
EOT2: CALL MTCLS ;CLOSE AND DONE
TMSGC <Tape positioned after last saveset
>
TXO F,TNSF ;SET TAPE # KNOWN
JRST CDONE
$CSUM: JXN F,NOFLG,CSUM1 ;JUMP IF USER WANTS NO CHECKSUM
HRROI A,[ASCIZ/FILES/]
CALL NOISE
MOVEI A,CSMTAB
CALL KEYWD ;PARSE KEYWORD
CSUM1: CALL CONFRM
HRRZ B,0(B)
TXZ F,CHKSM+CS%SEQ ;TURN OFF FLAGS
TXNN F,NOFLG ;SKIP IF 'NO CHECKSUM'
IOR F,B
JRST CDONE
CSMTAB: NCKTBL,,NCKTBL
TB CHKSM,<BY-PAGES>
TB CHKSM+CS%SEQ,<SEQUENTIAL>
NCKTBL==.-CSMTAB-1
;SKIP n SAVESETS
$SKIP: HRROI A,[ASCIZ/NUMBER OF SAVESETS/]
CALL NOISE
MOVEI B,[FLDDB. .CMNUM,,12,,1] ;[322] BASE 10 NUMBER, DEFAULT 1
CALL COMNDX ;PARSE NUMBER OF SAVESETS TO SKIP
MOVE Q1,B ;SAVE IT
CALL CONFRM ;CONFIRM
SETOM CEXFLG ;ALLOW INTERRUPT
JUMPLE Q1,SKIPR ;SCAN REVERSE IF 0 OR NEG
;SKIPPING FORWARD
CALL MTOPNR ;OPEN TAPE FOR READ
SKIPLE MTTYP ;[340] LABELED TAPE?
JRST SKPFL1 ;[340] YES, HANDLE DIFFERENTLY
CALL MTRED ;READ FIRST RECORD
JRST SKIPF1 ;BAD, IGNORE
MOVN A,TYP
CAIE A,CTPHX
CAIN A,TPHDX ;SAVESET HEADER?
AOJA Q1,SKIPF3 ;YES, SKIP ONE MORE THAN SPEC
JRST SKIPF2
SKIPF1: CALL MTRED ;SCAN FORWARD
JRST [ TMSG <, record ignored
>
JRST SKIPF1]
SKIPF2: MOVN A,TYP ;CHECK TYPE
CAIN A,TPTRX ;END OF TAPE?
JRST [ CALL BACKSP ;[340] BACKSPACE OVER TAPE TRAILER
CALL MTCLS
TXO F,TNSF ;SET TAPE # KNOWN
ERROR (BMBCMD,<%End of tape encountered>)]
CAIN A,FLHDX ;[361] FILE HEADER?
JRST [ MOVE A,[XWD BUFF,LSTRD] ;[361] Copy last filename read
BLT A,LSTRD+100-1 ;[361] from tape buffer
JRST SKIPF1] ;[361] CONTINUE SCANNING
CAIE A,TPHDX ;TAPE HEADER?
JRST SKIPF1 ;NO, KEEP SCANNING
SKIPF3: CALL TYHEDR ;YES, TYPE INFO
SOJG Q1,SKIPF1 ;LOOP IF MORE SAVESETS TO SKIP
CALL BACKSP ;[340] BACK OVER TAPE HEADER
CALL MTCLS ;[340] CLOSE TAPE
TXO F,TNSF ;[340] SET TAPE # KNOWN
JRST CDONE ;[340]
;SKIPPING FORWARD ON LABELED TAPE
SKPFL1: CALL MTRED ;[340] READ FIRST RECORD
JRST [ TMSG <, record ignored
> ;[340]
JRST SKPFL1] ;[340] TRY AGAIN
MOVN A,TYP ;[340] CHECK TYPE
CAIN A,TPTRX ;[340] END OF TAPE?
JRST [ CALL MTCLS ;[340] CLOSE TAPE
TXO F,TNSF ;[340] SET TAPE # KNOWN
ERROR (BMBCMD,<%End of tape encountered>)] ;[340]
CAIN A,SSNDX ;[340] SAVESET END?
JRST SKPFL2 ;[340] YES, COUNT IT
CAIN A,FLHDX ;[361] FILE HEADER?
JRST [ MOVE A,[XWD BUFF,LSTRD] ;[361] Copy last filename read
BLT A,LSTRD+100-1 ;[361] from tape buffer
JRST SKPFL1] ;[361] CONTINUE SCANNING
CAIN A,TPHDX ;[340] TAPE HEADER?
CALL TYHEDR ;[340] YES, TYPE INFO
JRST SKPFL1 ;[340] SCAN REST OF SAVESET
SKPFL2: SOJG Q1,SKPFL1 ;[340] LOOP IF MORE SAVESETS TO SKIP
CALL MTCLS ;[340] CLOSE TAPE
TMSG <Labeled tape positioned after the above saveset
> ;[340]
TXO F,TNSF ;SET TAPE # KNOWN
JRST CDONE
;SKIPPING REVERSE
SKIPR: SKIPLE MTTYP ;LABELED TAPE?
ERROR BMBCMD,<?Cannot backspace on labeled tape> ;YES, ERROR
CALL MTOPNR ;UNLABELED, OPEN IT
SETZM NWTBIT ;PREVENT OVERLAP READS
TXO F,SKPBFL ;[322] SET SKIP BACKWARDS FLAG
TXNE F,ICMODF ;[322] SKIP BACK OVER EOF IF INTERCHANGE
SKIPR2: CALL BACKSP ;BACKSPACE ONE RECORD NET
SKIPR1: CALL BACKSP
MOVE A,MTJFN ;GET TAPE JFN
GDSTS% ;GET STATUS
TRNE B,MT%BOT ;AT BOT?
JRST SKIPR3 ;YES, IT HAS BEEN REPORTED, GO WRAP UP
TXZ F,ICMT1 ;[322] NO REPEAT RECORD
CALL MTRED
JRST [ TMSG <, record ignored
>
JRST SKIPR2]
MOVN A,TYP ;CHECK TYPE
CAIN A,FLHDX ;[361] FILE HEADER?
JRST [ MOVE A,[XWD BUFF,LSTRD] ;[361] Copy last filename read
BLT A,LSTRD+100-1 ;[361] from tape buffer
JRST SKIPR2] ;[361] CONTINUE SCANNING
CAIE A,TPHDX ;TAPE HEADER?
CAIN A,CTPHX
SKIPA
JRST SKIPR2 ;NO, KEEP SCANNING
CALL TYHEDR ;YES, TYPE INFO
AOJLE Q1,SKIPR2 ;COUNT HEADERS SEEN
CALL BACKSP ;NO, BACK OVER LAST HEADER SEEN
SKIPR3: CALL MTCLS ;DONE WITH TAPE
TXO F,TNSF ;SET TAPE # KNOWN
TXZ F,SKPBFL ;[322] RESET SKIP BACKWARD FLAG
JRST CDONE
;LISTING CONTROL COMMANDS
;(NO)DIRECTORIES
$LDIR: CALL CONFRM
TXNE F,NOFLG ;NEGATED?
TXZA F,LDIRF ;YES, NO DIRECTORIES
TXO F,LDIRF ;DIRECTORIES
JRST CDONE
;(NO)FILES
$LFIL: CALL CONFRM
TXNE F,NOFLG ;NEGATED?
TXZA F,LFILF ;YES, "NO FILES"
TXO F,LFILF ;"FILES"
JRST CDONE
;(NO)SILENCE
$SIL: CALL CONFRM
TXNE F,NOFLG ;NEGATED?
TXOA F,LFILF+LDIRF ;"NO SILENCE"
TXZ F,LFILF+LDIRF ;"SILENCE"
JRST CDONE
;SPECIFY LOG FILE
$LIST: JXN F,NOFLG,[CALL CONFRM ;IF NEGATED, NO FURTHER ARGS
SETZM LSTFIL ;NO LOG FILE
TXZ F,LTTYF+LFDSK ;NOT LOGGING TO ANYTHING
JRST CDONE]
HRROI A,[ASCIZ/LOG INFORMATION ON FILE/]
CALL NOISE
MOVEI B,[FLDDB. (.CMOFI,,,,<LPT:DUMPER.LOG>)]
COMND%
TXNE A,CM%NOP
ERRORJ RESTRT,<?Output filespec invalid>
CALL ADLIST ;ADD JFN TO JFN STACK
CALL CONFRM
HRROI A,LSTFIL ;PUT FILESPEC INTO BUFFER
MOVX C,<FLD(.JSSSD,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS%
MOVE A,B
RLJFN%
JFCL
JRST CDONE
SUBTTL DIRECTORY LISTING
PRINT: HRROI A,[ASCIZ/DIRECTORY OF TAPE ONTO FILE/]
CALL NOISE
MOVEI B,[FLDDB. (.CMOFI,,,,<TTY:>)]
COMND%
TXNE A,CM%NOP
ERRORJ RESTRT,<?Output filespec invalid>
CALL ADLIST ;ADD JFN TO JFN STACK
CALL CONFRM
MOVE A,B ;PICK UP JFN
CALL CHKJFN ;[346] PRINTING TO THE MAGTAPE??
ERROR CDONE,<?Output filespec for PRINT command is the same as the tape being read.>
;[346] TELL USER OF ERROR AND TRY AGAIN
CALL LPTOP0 ;OPEN DEVICE TO RECEIVE DIRECTORY
CALL DIRS ;DO IT VIA SUBROUTINE
TXO F,TNSF ;SET TAPE # KNOWN
JRST CDONE
CHKJFN: SAVEAC <A> ;[346] SAVE THE OUTPUT JFN
MOVE Q1,A ;[346] SAVE IT HERE TOO
DVCHR% ;[346] WHAT KIND OF DEVICE?
LOAD D,DV%TYP,B ;[346] LOAD TYPE
CAIE D,.DVMTA ;[346] MAGTAPE??
RETSKP ;[346] NO, JUST CONTINUE
EXCH A,Q1 ;[346] GET JFN & SAVE DEVICE DESIGNATOR
CALL MTOPNR ;[346] GET A HANDLE ON THE TAPE
MOVE A,MTJFN ;[346] THE REAL MAGTAPE JFN
DVCHR% ;[346] GET DESIGNATOR
MOVE Q2,A ;[346] SAVE DEVICE DESIGNATOR
CALL MTCLS ;[346] CLOSE MAGTAPE JFN
CAME Q1,Q2 ;[346] COMPARE THE DEVICE DESIGNATORS
RETSKP ;[346] NOT THE SAME DEVICE, JUST CONTINUE
RET ;[346] REPROMPT FOR ANOTHER TRY
DIRS: SETZM LSTHDR ;NO HEADER YET
MOVE A,LPTJFN ;[401]
MOVEI B,.CHFFD ;[401] SEND A FORMFEED
BOUT% ;[401]
AOS LPTPAG ;[401] INCREMENT LISTING PAGE NUMBER
SETOM CEXFLG ;[326] ALLOW INTERRUPT
CALL MTOPNR ;[326]
DIR1: CALL MTRED ;READ NEXT RECORD, DISPATCH ON TYPE
JRST [ TMSG <, record ignored
>
JRST DIR1]
MOVN B,TYP
CAIN B,FLHDX
JRST DIRF ;FILE HEADER
CAIN B,USRX
JRST DIRU ;USER INFO
CAIN B,TPTRX
JRST DIRE ;END OF TAPE
CAIE B,CTPHX
CAIN B,TPHDX
JRST DIRB ;BEGINNING OF TAPE
CAIN B,FLTRX
JRST DIRFDB ;FDB INFO
CAIN B,DATAX ;[340]
CALL PGECSM ;CHECKSUM DATA PAGE
JRST DIR1
;BEGINNING OF TAPE
DIRB: MOVE A,[POINT 7,LSTHDR] ;[401] SET TO BUILD LISTING HEADER MESSAGE
CALL PRHEDR ;[401] BUILD IT
HRROI B,LSTHDR ;[401]
CALL BTMSGQ ;TYPE AND PRINT IT
BTMSG <
>
CALL PRTHDR
LPMSG <
> ;[401]
JRST DIR1
;END OF TAPE
DIRE: SKIPL PAGNO ;CONTINUED SAVE?
JRST DIRE01 ;NO-- GO ON
BTMSG <
End of tape, saveset continued on next reel.
>
SKIPLE MTTYP ;LABELED TAPE?
JRST DIR1 ;YES, CONTINUE SCANNING
CALL UNLOAD ;UNLABELED, UNLOAD IF MTA
CALL MTCLS ;CLOSE TAPE JFN
CALL NTAPER ;GET NEXT VOLUME UP
JRST [ BTMSG <
?Cannot switch to next volume.
>
JRST DIRE02] ;LOSE
CALL MTOPNR ;OPEN IT
JRST DIR1 ;CONTINUE LISTING
DIRE01: BTMSG <
End of tape.
>
DIRE02: SKIPN A,LPTJFN ;SEE IF LISTING?
JRST DIRE1 ;NO
MOVEI B,.CHFFD
BOUT%
CLOSF%
JFCL
SETZM LPTJFN
DIRE1: SKIPG MTTYP ;LABELED?
CALL BACKSP ;NO, BACKSPACE OVER TAPE TRAILER
CALLRET MTCLS
;USER INFO
DIRU: BTMSG <
DDB for >
HRROI B,BUFF+UHNAM
CALL BTMSGQ
BTMSG <
>
JRST DIR1
;BEGINNING OF FILE
DIRF: MOVEI B,FLCOL
CALL TAB ;TAB TO NAME COLUMN
SKIPN FORMAT ;BBN FORMAT?
CALL FIXFMM ;YES, FIX SEMICOLON
MOVE A,[XWD BUFF,LSTRD] ;[361] Copy last file read from tape
BLT A,LSTRD+100-1 ;[361] from tape buffer.
MOVE B,[POINT 7,BUFF]
DIRF1: ILDB A,B ;SCAN FILESPEC
CAIN A,";" ;END OF GENERATION?
SETZ A, ;YES, USE NULL
JUMPN A,DIRF1 ;JUMP IF NOT END OF STRING
DPB A,B ;TIE OFF STRING
HRROI B,BUFF
CALL LPMSGQ ;OUTPUT FILESPEC
SKIPL PAGNO ;SKIP IF FILE CONTINUED
JRST DIRF4 ;GO ON
LPMSG <
(File continued from previous reel)
>
JRST DIR1 ;DON'T RESET CHECKSUM
DIRF4: TXNN F,CHKSM ;SKIP IF CHECKSUMMING
JRST DIR1 ;REST WILL BE PRINTED FROM TRAILER
SETZM CHKCN0 ;INITIALIZE CHECKSUM
SETZM LSTPGE ;AND LAST PAGE #
TXNN F,CS%SEQ ;SKIP IF SEQUENTIAL
JRST DIR1 ;GO ON
CALL FILSZE ;FIGURE FILE SIZE
JRST DIR1 ;GO ON
;END OF FILE, FDB INFO
DIRFDB: SKIPL PAGNO ;SKIP IF FILE CONTINUED
JRST DIRF3 ;GO ON
LPMSG <
(File continued on next reel)
>
JRST DIR1 ;FDB PRINTER TO BE ADDED
DIRF3: MOVEI B,WTCOL
CALL TAB ;TAB TO WRITE COLUMN
HRROI A,LPTBUF ;CONSTRUCT DATE STRING IN LPT BUFFER
SKIPN B,BUFF+.FBWRT ;HAVE WRITE DATE?
JRST [ LPMSG <(NEVER)> ;NO
JRST DIRF2]
MOVX C,OT%NSC!OT%NCO!OT%SCL
ODTIM% ;YES, PRINT IT
HRROI B,LPTBUF
CALL LPMSGQ
DIRF2: MOVEI B,SIZCOL
CALL TAB ;TAB TO SIZE COLUMN
LOAD B,FB%PGC,BUFF+.FBBYV ;GET PAGE COUNT
MOVEI C,^D10
CALL LPNOUT ;OUTPUT SIZE
TXNE F,CHKSM ;SKIP IF CHECKSUMMING
CALL PRTCSM ;PRINT CHECKSUM
LPMSG <
>
JRST DIR1 ;GO ON
SUBTTL DUMP ROUTINES
DUMP: MOVX A,S.SAVE ;[361] flag we are dumping
MOVEM A,STABLK ;[361] store it
CALL DUMPS
TXO F,TNSF ;SET TAPE # KNOWN
JRST CDONE
DUMPS: HRROI A,[ASCIZ/DISK FILES/]
CALL NOISE
CALL GETCON ;OBTAIN CURRENT CONNECTED DIRECTORY
SETZM INCRSW ;DEFAULT NO INCREMENTAL
SETZM ARCSW ; Default not archive run
SETZM COLSW ; Default not collection/migration run
HRRZS TAPNO ;[341] Clear old archive tape info
SKIPE ICMDTY ;SKIP IF NOT UNDER ^E
SKIPN Q1,NIJFN ;PICK UP POINTER, IF ANY
MOVSI Q1,-NJFNL+1 ;INIT PTR TO JFN LIST
SKIPA Q2,[[FLDDB. .CMSWI,,DSWTB,,,FILCDB]] ;ALLOW SWITCHES
DUMP1: MOVEI Q2,FILCDB ;GET FDB FOR FILESPEC ONLY
MOVEI A,[EXP CSCD,CSWD,CSCD,CSCD] ;POINT TO ROUTINES
CALL FILDFI ;SETUP DEFAULT FILE SPEC
MOVX A,GJ%OLD+GJ%IFG+GJ%XTN ;ALLOW STARS, CK EXTENDED BLOCK
HLLM A,GJBLK+.GJGEN
MOVEI A,CBLK
MOVE B,Q2 ;GET FDB ADDRESS
SETZ Q2, ;INDICATE FILE SPEC OK (WILL BE ERROR CODE IF NOT)
COMND% ;GET FILESPEC OR SWITCH
JXN A,CM%NOP,DUMP2 ;IF NO PARSE, CHECK GTJFN ERROR
LOAD C,CM%FNC,0(C) ;GET CODE OF BLOCK USED
CAIE C,.CMSWI ;SWITCH?
JRST DUMP4 ;NO, MUST BE FILENAME
HRRZ B,0(B) ;GET DISPATCH
JRST 0(B)
;SWITCH TABLE
DSWTB: NDSWTB,,NDSWTB
TB $ARC,<ARCHIVE>
TB $COL,<COLLECT>
TB $FINC,<FULL-INCREMENTAL>
TB $INC,<INCREMENTAL:>
TB $MIG,<MIGRATE>
TB $NINC,<NOINCREMENTAL>
NDSWTB==.-DSWTB-1
$ARC: SKIPN INCRSW ; Some kind of incremental?
SKIPE COLSW ; Or collection run?
ERROR BMBCM1,<?Switch combination invalid>
SETOM ARCSW
JRST DUMP1
$MIG: SKIPA A,[-1] ;FLAG AS MIGRATION
$COL: MOVEI A,1 ;FLAG AS COLLECTION
SKIPN INCRSW
SKIPE ARCSW
ERROR BMBCM1,<?Switch combination invalid>
MOVEM A,COLSW
JRST DUMP1
$FINC: SETO B, ;-1 MEANS FULL-INCREMENTAL
TXO F,USRDAT ;[354] REQUEST USER DATA
JRST $INC5
$INC: MOVEI B,1 ;ASSUME 1 TAPE FOR /INC:
JXE A,CM%SWT,$INC5 ;IF NO SWITCH TERMINATOR, USE 1
MOVEI B,[FLDDB. (.CMNUM,,^D10,<number of tapes each file must be on,>,<1>)]
CALL COMNDX ;PARSE # OF TAPES
CAIGE B,1 ;VALID NUMBER?
ERROR BMBCM1,<?Tape count must be greater than 0>
$INC5: SKIPN ARCSW ; /ARCHIVE been specified?
SKIPE COLSW ; Or /COLLECT or /MIGRATE ?
ERROR BMBCM1,<?Switch combination invalid>
MOVEM B,INCRSW ;SAVE INCREMENTAL STATE
TXO F,USRDAT ;[354] REQUEST USER DATA
JRST DUMP1
$NINC: SETZM INCRSW ;NO INCREMENTAL
TXZ F,USRDAT ;[354] NO USER DATA
JRST DUMP1
;COMMAND BLOCK FOR SOURCE FILE
FILCDB: FLDDB. (.CMFIL,CM%SDH,,<file group descriptor>)
;LIST OF GTJFN ERRORS WHICH ALL MEAN "FILE NOT FOUND"
OKGJXL: BYTE (18)GJFX16,GJFX17,GJFX18,GJFX19,GJFX20,GJFX24,GJFX32,GJFX35,GJFX36,GJFX38
OKGJXZ==<.-OKGJXL>*2
;HERE WHEN FIRST FILSPEC TYPED, BUT WAS IN ERROR.
;CHECK FOR "OK" GTJFN ERROR: ALL POSSIBLE "FILE NOT FOUND" CODES.
;ERROR CODE IN B, COMND FLAGS IN A
DUMP2: JXN A,CM%ESC,DUMP22 ;GIVE ERROR NOW IF RECOGNITION ATTEMPTED
MOVE C,[POINT 18,OKGJXL] ;GET POINTER TO LIST OF OK CODES
MOVEI D,OKGJXZ ;GET SIZE OF LIST
DUMP21: ILDB A,C ;GET A CODE FROM TABLE
CAME A,B ;MATCH ERROR GIVEN?
SOJG D,DUMP21 ;NO-- LOOP FOR ALL POSSIBLE OK ERRORS
JUMPLE D,DUMP22 ;NOT AN OK ERROR-- TYPE ERROR MESSAGE
MOVE Q2,B ;ERROR IS FILE NOT FOUND-- REMEMBER CODE TO BE
; PUT IN JF2LST AND CHECKED WHILE SCANNING
MOVX A,GJ%OFG ;SET UP TO PARSE-ONLY THE NOT-FOUND FILESPEC
HLLM A,GJBLK+.GJGEN ; . .
MOVEI A,CBLK ;GET COMMAND STATE BLOCK ADDRESS
MOVEI B,[FLDDB. .CMFIL] ;ONLY PARSE FILE-SPEC
COMND% ; . .
TXNE A,CM%NOP ;THIS SHOULD ALWAYS SUCCEED!!
DUMP22: ERRORJ BMBCM1,<?Not a switch or filespec>
;HERE WHEN FIRST FILESPEC HAS BEEN TYPED
;JFN OF FILE IN B
DUMP4: CALL ADLIST ;ADD FILE TO JFNSTACK
SKIPN Q2 ;DON'T CHECK DEVICE IF FILE-NOT-FOUND
CALL CHKDVC ;DO A DVCHR FOR LEGAL DEVICE
JUMPGE Q1,[ERROR (BMBCM1,<?Too many items in filespec list>)]
MOVEM B,JFNLST(Q1) ;SAVE JFN
MOVEM Q2,JF2LST(Q1) ;SET NO DESTINATION YET, ZERO OR ERROR CODE IF FILE-NOT-FOUND
AOBJN Q1,.+1
TXZ F,SAVUSF ;[351] Let's NOT write DDB information!!
SKIPN ARCSW ; No user info on archive or migration tapes
SKIPE COLSW
JRST DUMP41
TXNE F,USRDAT ;[354] "CREATE" SPECIFIED?
TXO F,SAVUSF ;YES, IMPLIES USER INFO ALSO
DUMP41: SKIPN ARCSW ; Auto unload on archive or migration
SKIPE COLSW
SETOM UNLTAP ;REQUEST AUTO-UNLOAD
;SET UP TO GET JFN ON "AS" FILESPEC
MOVX B,GJ%OFG
HLLM B,GJBLK+.GJGEN ;PARSE ONLY
CALL OFNAME ;MAKE UP OUTPUT NAME DEFAULT
;CHECK IF "AS" FILESPEC IS PROSCRIBED
SKIPN INCRSW ;INCREMENTAL?
SKIPE ARCSW ;OR ARCHIVE?
SKIPA
SKIPE COLSW ;OR COLLECT/MIGRATE?
JRST [ MOVE A,[.NULIO,,.NULIO] ;ONE OF THE ABOVE
MOVEM A,GJBLK+.GJSRC ;SET SOURCE, DEST TO NULL
MOVEI A,GJBLK ;GET ADDRESS OF GTJGN BLOCK
SETZ B, ;NO STRING
GTJFN% ;SYNTHESIZE "AS" JFN
ERRORJ BMBCM1,<?Invalid file group descriptor>
MOVE B,A ;GET JFN IN B
JRST DUMP42] ;GO STUFF IT IN JF2LST
;PARSE "AS" FILESPEC
HRROI A,[ASCIZ/AS/]
CALL NOISE
MOVEI B,LIT1 ;PARSE FILESPEC OR COMMA OR CRLF
MOVEI A,CBLK
COMND%
TXNE A,CM%NOP
ERRORJ BMBCM1,<?Invalid file group descriptor>
;CHECK WHAT WAS PARSED. THE FDB CHAIN CONTAINS FILESPEC,COMMA,CONFIRM.
;HOWEVER, IF COMMA OR CONFIRM IS TYPED, IT WILL PARSE AS A FILESPEC.
;THE NEXT 3 LINES ARE A CHECK FOR THAT, JUST IN CASE COMND GETS CHANGED.
LOAD C,CM%FNC,(C) ;GET CODE USED
CAIE C,.CMFIL ;DID I PARSE A FILESPEC?
ERROR BMBCM1,<?Parse error> ;NO, STRANGENESS IN COMND JSYS
DUMP42: CALL ADLIST ;OUTPUT FILE SPEC
SKIPN JF2LST-1(Q1) ;FIRST SPEC NOT FOUND?
MOVEM B,JF2LST-1(Q1) ;NO, SAVE THIS JFN AS DESTINATION
DUMP5: SKIPN ARCSW
SKIPE COLSW
JRST [ MOVEI A,CBLK ; Either archive or migration, need conf
MOVEI B,[FLDDB. .CMCFM]
COMND%
TXNE A,CM%NOP
ERROR BMBCM1,<?Carriage return required.
Only one filespec allowed for Archive/Collection/Migration runs.>
JRST DUMP6]
MOVEI A,CBLK
MOVEI B,[FLDDB. (.CMCFM,,,,,[FLDDB. (.CMCMA)])]
COMND%
TXNE A,CM%NOP
ERROR BMBCM1,<?Comma or carriage return required.>
LOAD C,CM%FNC,0(C) ;GET CODE USED
CAIE C,.CMCFM ;TERMINATOR?
JRST DUMP1 ;NO, ASSUME COMMA. TRY AGAIN
DUMP6: CALL [ SKIPE WHEEL ;WHEEL OR OPERATOR?
RETSKP ;YES, NO FURTHER CHECKS REQUIRED
SKIPN ARCSW ;NOT PRIVILEGED
SKIPE COLSW
RET ;CAN'T ARCHIVE/COLLECT/MIGRATE
SKIPE INCRSW
RET ;CAN'T DO INCREMENTAL SAVE
RETSKP] ;OK, NOT TRYING ANYTHING SPECIAL
ERROR BMBCM1,<?WHEEL or OPERATOR capability required>
CALL JFNCFM ;FIX UP JFN STACK
SETOM CEXFLG ;INDICATE INTERRUPTIBLE COMMAND
MOVEM Q1,NIJFN ;SAVE IN CASE OF ^E
MOVNI Q1,0(Q1) ;SAVE NUMBER OF JFNS SETUP
MOVEM Q1,NJFN
GTAD% ;GET NOW
MOVEM A,BGNTAD ;KEEP TIME AT START OF SAVE
SETZM TOTFIL ;INIT DUMP COUNTS
SETZM TOTCNT
SETZM LSTDIR ;RESET LAST DIRECTORY NAME
SETZM INIPGN ;RESET CONTINUED FILE PAGE
TXNN F,TNSF ;SKIP IF TAPE # SET
SETZM TAPNO ; START AFTER TAPE 0
SKIPN ARCSW ; Archive
SKIPE COLSW ; Or collection/migration run?
CALL ARCINI ; Yes, set up for that
MOVX A,PA%RD!PA%WT!PA%EX!PA%PEX ;GET ALL ACCESS
MOVEM A,ACCESS ;SET UP ACCESS WORD FOR COMPATABILITY
SETZM JFN ; Make sure is 0 initially
;LOOP THROUGH JFNLST FOR ALL FILESPECS TYPED
TXZ F,DMPFLF ;INDICATE NO VALID JFNS FOUND YET
HRLZ P5,NJFN ;SET TO SCAN JFN LIST
;IF THIS JFN HAD A "FILE-NOT-FOUND", THEN PRINT WARNING
DUMPL1: MOVE B,JF2LST(P5) ;GET ERROR CODE OR OUTPUT JFN
TRNN B,1B18 ;ERROR CODE (6XXXXX) OR JFN?
JRST DUMPL2 ;JFN, IT'S OK
TMSGC <%>
MOVEI A,.PRIOU ;SET TTY
MOVE B,JF2LST(P5) ;GET ERROR CODE BACK
HRLI B,.FHSLF ;MYSELF, ERROR CODE NOW IN B
SETZ C, ;NO LIMIT
ERSTR% ;TYPE ERROR MESSAGE
JFCL
JFCL
TMSG < - >
MOVEI A,.PRIOU ;OUTPUT FILESPEC THAT FAILED
MOVE B,JFNLST(P5) ;GET JFN FOR IT
SETZ C, ;DEFAULT OUTPUT
JFNS% ;TYPE FILE SPEC
CALL TCRLF
JRST DUMPL5 ;IGNORE THE FILE
;VALID JFN-- SEE IF OUTPUT DIRECTORY HAS CHANGED
DUMPL2: TXNE B,GJ%DIR ;SKIP IF OUTPUT DIRECTORY NOT WILD
JRST DUMPL3
HRROI A,ODRNAM ;OUTPUT DIR NAME
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS%
HRROI A,DIRNAM ;OUTPUT DIR NAME
MOVE B,JFNLST(P5) ;INPUT JFN
JFNS%
HRROI A,ODRNAM ;OUTPUT DIR NAME
HRROI B,DIRNAM ;INPUT DIRECTORY NAME
STCMP%
SKIPN A ;SKIP IF STRINGS ARE DIFFERENT
DUMPL3: TXZA F,DIRCHG ;OUTPUT DIR SAME AS INPUT DIRECTORY
TXO F,DIRCHG ;DIRECTORY IS DIFFERENT
;SCAN THIS JFN FILE GROUP FOR ALL ITS FILES
TXON F,DMPFLF ;INDICATE A VALID JFN FOUND, FIRST ONE?
CALL DNEWV ;YES, START NEW TAPE
HRROI B,[ASCIZ/%Using INTERCHANGE mode with labeled tape
/]
TXNE F,ICMODF ;INTERCHANGE MODE
SKIPG MTTYP ; AND LABELED TAPE?
CAIA ;NOT BOTH
CALL TMSGQC ;YOU PROBABLY DON'T WANT TO DO THIS
MOVE A,JFNLST(P5) ;PICK UP JFN
SKIPE INIJFN ;SKIP IF NO INITIAL JFN
JRST [ HRR A,INIJFN ;GET INITIAL JFN
SETZM INIJFN ;USED UP NOW
SETOM ININUM ;FLAG BEGUSR CODE
JRST .+1]
CALL SCNJFG ;SCAN THIS GROUP
DUMPL5: AOBJN P5,DUMPL1 ;LOOP FOR ALL GROUPS
;ALL DONE WITH ALL FILESPECS
TXNN F,DMPFLF ;ANY VALID JFN'S FOUND?
ERROR DUMPL9,<%No files dumped>
CALL ENDTAP ; TERMINATE TAPE
SKIPE UNLTAP ; Want auto unload?
CALL UNLOAD ; Yes
CALL MTCLS ;CLOSE MAGTAPE
SKIPN COLSW ; Did we do collection/migration?
SKIPE ARCSW ; or an archive run?
JRST [ CALL ARDELF ; One of the two
TMSG <
Pass 1 completed.
Saveset complete. Tape ready for storage.
>
CALL PASS2 ; Do fixup pass
SETZM TAPNO ;GET RID OF ARCHIVE MODIFICATIONS
SETZM PAGNO ;IN RECORD HEADER
SETZM MTDSG ;REQUIRE RESPEC OF TAPE UNIT
SETZM SSNBUF ;CLEANUP SAVESET NAME BUFFER
JRST .+1]
SKIPN INCRSW ;INCREMENTAL?
JRST DUMPL8 ;NO, SKIP THIS STUFF
;INCREMENTAL SAVE - CALL PASS2 FOR ALL FILESPECS BEING SAVED
HRLZ P5,NJFN ;GET -(# OF FILESPECS),,0
DUMPL6: MOVE B,JF2LST(P5) ;GET JFN
TRNN B,1B18 ;JFN VALID?
JRST [ HRROI A,DEVNAM ;YES, GET DESTINATION
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS% ;GET FILESPEC IN DEVNAM FOR PASS2
CALL PASS2 ;FIX FDB'S
JRST .+1]
AOBJN P5,DUMPL6 ;LOOP THRU ALL FILESPECS IN LIST
DUMPL8:
;TYPE STATISTICS
BTMSG <
Total files dumped = >
MOVE B,TOTFIL
MOVEI C,^D10
CALL BTNOUT
BTMSG <
Total pages dumped = >
MOVE B,TOTCNT
MOVEI C,^D10
CALL BTNOUT
BTMSG <
>
DUMPL9: SKIPN A,LPTJFN
RET ;DONE IF NO LISTING
CLOSF%
JFCL
SETZM LPTJFN ; No JFN any more
RET
;SCAN FILE GROUP DESCRIPTOR
; A/ JFN
SCNJFG: TXO A,GN%DIR+GN%NAM+GN%EXT ;NOTE ALL FIELDS CHANGED
MOVEM A,SCNJFN ;SAVE JFN AND FLAGS
HRROI A,DEVNAM ;GET CURRENT FULL FILE-SPEC,
MOVE B,SCNJFN ; INCLUDING WILDCARDS, FOR FIXBCK
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS%
HRROI A,RCDSTR ;SET TO BUILD STR:<*>, FOR RCDIR
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
MOVE B,SCNJFN
JFNS% ;GET STRUCTURE NAME
SETZM RCDNUM ;NONE YET
SCNLUP: MOVE A,SCNJFN
HRRZM A,JFN ;SETUP SINGLE JFN FOR ROUTINES
TXNE A,GN%DIR ;DIRECTORY CHANGED?
JRST [ CALL BEGUSR ;YES
SKIPG COLSW ;COLLECTION?
JRST .+1 ;NO, SPLIT
MOVE A,DIRNUM ;[373] GET CURRENT DIRECTORY NUMBER
MOVEI B,^D5 ;[362] LENGTH OF BLOCK TO RETURN
MOVEM B,DIRINF+.CDLEN ;[362]
MOVEI B,DIRINF ;[362]
MOVE C,[POINT 7,BUFF+UHPSW] ;[362]
GTDIR% ;[362]
ERJMP [JSERR] ;[362]
MOVE D,DIRINF+.CDMOD ;[362]
SETZM XPRARC ;[362] CLEAR FLAG
TXNE D,CD%DAR ;[362] ARCHIVE-ONLINE-EXPIRED-FILES?
SETOM XPRARC ;[362] YES, SET FLAG
JRST .+1] ;[362]
CALL DMPFIL ;DO THE FUNCTION
MOVE A,SCNJFN
GNJFN% ;STEP TO NEXT FILE
ERJMP ENDU ;NO MORE
PUSH P,A ;[361] save it
HRROI A,LSTRD ;[361] Where to store file spec last considered
HRRZ B,SCNJFN ;[361] Only JFN
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS% ;[361] get last file name we considered
POP P,A ;[361]
XOR A,SCNJFN ;SET CHANGED BITS
ANDX A,GN%DIR+GN%NAM+GN%EXT
XORB A,SCNJFN
TXNE A,GN%DIR ;DIRECTORY CHANGED?
TXNE F,DIRCHG ;[370] SKIP IF SAVING AS SAME DIRECTORY
SKIPA ;[370] NO, SKIP
CALL ENDUSR ;YES, CLEANUP USER
JRST SCNLUP
;END OF GROUP
ENDU: CALL ENDUSR ;CLEAN UP LAST USER
TXNN F,DIRCHG ;[367] SKIP IF NOT SAVING AS SAME DIRECTORY
TXNN F,SAVUSF ;DOING USER DATA?
RET ;[367] NO - RETURN
ENDU1: MOVX A,RC%STP!RC%AWL ;MAKE SURE WE GOT ALL DIRECTORIES
HRROI B,RCDSTR
MOVE C,RCDNUM ;LAST NUMBER
RCDIR% ;STEP
TXNE A,RC%NMD ;[367] MORE?
RET ;[367] NO - DONE
MOVEM C,RCDNUM ;[367] YES - SAVE NUMBER
CALL DMPUSR ;[367] DUMP USER INFO
JRST ENDU1 ;[367] LOOP TILL DONE
PASS2: SETZM LTARDR ; No current directory
MOVEI A,[EXP CSCD,CSWD,CSCD,CSCD] ;POINT TO ROUTINES
CALL FILDFI ;DEFAULT THE FILE SPEC
MOVE A,[.NULIO,,.NULIO] ;AS IN COMMAND, BUT FILE SPEC.
MOVEM A,GJBLK+.GJSRC ;NOT FROM TERMINAL THIS TIME
MOVX A,GJ%OLD+GJ%IFG+GJ%XTN ;ALLOW STARS, CK EXTENDED BLOCK
HLLM A,GJBLK+.GJGEN
MOVEI A,GJBLK ;GTJFN BLOCK
HRROI B,DEVNAM ;GET JFN FOR ALL FILES SPEC. AT SCNJFG
GTJFN%
ERRORJ BMBCMD,<?Command aborted>
MOVEM A,P2JFN
SKIPE INCRSW ; Incremental?
JRST SCNLU1 ; Yes, skip archive/coll/mig. setup
TMSG < Pass 2 started.
>
SETZM FNDDIR ; Flag terminating directory not found
SKIPN IDIR ;INITIAL DIRECTORY SET UP?
JRST SCNLU0 ;NO--START FROM BEGINNING OF RUN
MOVEI A,GJBLK ; Same as just used
HRROI B,ISPEC ; Initial filespec on tape
GTJFN% ; File still there?
ERJMP TRYDIR ; No, try for initial directory
TXO F,TF2 ; Yes, flag cont. (or just 1st) file
JRST XP2JFN ; Go switch RH of P2JFN
TRYDIR: MOVEI A,GJBLK ;SAME AS JUST USED
HRROI B,IDIR ;INITIAL DIRECTORY ON THIS TAPE
GTJFN%
ERJMP SCNLU0 ;OK TO START FROM BEGINNING OF RUN
XP2JFN: MOVE B,P2JFN ;BETTER TO START FROM 1ST DIR. ON TAPE
HRRM A,P2JFN ;BY REPLACING RH OF JFN FOR GNJFN
HRRZ A,B ;FINISHED WITH 1ST P2JFN
RLJFN%
JFCL
SCNLU0: MOVE A,P2JFN ; Initial P2JFN for archive/col/mig. run
TXO A,GN%DIR ; Set new directory flag bit
SCNLU1: SKIPE INCRSW ;INCREMENTAL?
JRST [ CALL FIXBCK ;NOTE INCREMENTAL DUMP COMPLETED FOR FILE
JRST SCNLU2]
MOVE D,A ; Keep bits returned by GNJFN
HRRZ A,A ; Clear bits for GTFDB
MOVE B,[1,,.FBBBT] ;GET FLAG BITS
MOVEI C,B ; INTO B
GTFDB%
ERJMP [MOVEI A,SCNLU2 ;[307] LOAD PC TO RETURN TO
PUSH P,A ;[307] STACK IT
MOVEI A,.+1 ;[307] LOAD CURRENT PC
PUSH P,A ;[307] SAVE IT TOO
CALLRET JSERRR] ;[307] TYPE JSYS ERROR AND RESUME AT SCNLU2
MOVEM B, FDB+.FBBBT ;YES, SAVE FLAG BITS
SKIPE XSPEC ;CONT. SAVESET AT END OF THIS TAPE?
TXNN D,GN%DIR ; And new directory?
JRST DIRCHK ; No, skip dir. termination test
HRROI A,CDIR ; Place for current str:dir string
HRRZ B,P2JFN
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF> ; Get structure:dir
JFNS%
HRROI A,CDIR ; Test string is current dir
HRROI B,XDIR ; Base string is dir at end of tape
STCMP%
JUMPE A,[SETOM FNDDIR ; Flag have found XDIR
JRST DIRCHK] ; And go on to check for XSPEC in part.
SKIPE FNDDIR ; Had previously reached XDIR?
CALLRET P2DON1 ; Yes, terminate pass 2
DIRCHK: MOVE B,FDB+.FBBBT
TXNN B,AR%1ST ;ARCH./COLL. IN PROGRESS FOR THIS FILE?
JRST SCNLU2 ;NO, NOTHING TO DO HERE
SKIPN FNDDIR ; In XDIR?
JRST TAPCHK ; No, go on to check tape ID's
HRROI A,CSPEC ; Place for current filespec
HRRZ B,P2JFN
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF> ; STR: to VER
JFNS%
HRROI A,CSPEC ; Test string is current filespec
HRROI B,XSPEC ; Base string is last filespec on tape
STCMP%
JUMPE A,P2DON1 ; This file is XSPEC--all done
TAPCHK: MOVE A,P2JFN
MOVEI B,.ARGST ;GET TAPE INFO
MOVEI C,FDBARC ;INTO FDBARC BLOCK
ARCF%
ERJMP SCNLU2 ;FAILURE: SKIP THIS FILE
TXZE F,TF2 ; Cont. (or just 1st) file?
JRST DOFXBK ; Yes, known to be on this tape
MOVE B,VOLID6 ; Tape ID of current tape
CAMN B,FDBARC+.ARTP1 ; There as tape 1?
JRST DOFXBK ; Yes, do fixup
CAMN B,FDBARC+.ARTP2 ; There as tape 2?
JRST DOFXBK ; Yes, do fixup
SKIPN FNDDIR ; Have reached terminating dir (if any)?
JRST SCNLU2 ; No, skip this file and go on
LOAD B,AR%RSN,FDB+.FBBBT ; Yes, check further: get reason code
CAIN B,.AREXP ; File expired?
SKIPG COLSW ; And this is a collection run?
CAIA ; No, go on
CALLRET P2DON1 ; Yes, file was not reached, so done
CAIN B,.ARRAR ; File archived?
SKIPN ARCSW ; And this is an archive run?
CAIA ; No, go on
CALLRET P2DON1 ; Yes, file was not reached, so done
CAIN B,.ARRIR ; File was migrated?
SKIPN COLSW ; And this is a coll. or mig. run?
JRST SCNLU2 ; Not of this run--skip it
CALLRET P2DON1 ; Yes, file was not reached, so done
DOFXBK: CALL ARFXBK ;NOTE ARCHIVE RUN COMPLETED FOR FILE
SCNLU2: MOVE A,P2JFN
GNJFN% ;STEP JFN
ERJMP [MOVEI A,.FHSLF ;[371] CURRENT PORCESS
GETER% ;[371] GET LAST ERROR
HRRZ A,B ;[371] ONLY THE ERROR CODE
CAIE A,GNJFX1 ;DONE?
CALL JSERR1 ;NO, SCREWUP
SKIPN COLSW ; Collection/migration?
SKIPE ARCSW ;ARCHIVAL?
CALLRET P2DONE ; Yes, tell user pass 2 done
RET] ; No, done here
JRST SCNLU1
P2DON1: HRRZ A,P2JFN
RLJFN% ;Through with pass 2 JFN
JFCL
P2DONE: TMSG < Pass 2 completed.
>
SETZM IDIR ; THROUGH WITH PASS2 FILE LIMITS
SETZM ISPEC
SETZM XDIR
SETZM XSPEC
MOVEI A,SNDTO
SKIPE LTARDR ;ANY MESSAGES WAITING?
CALL SNDMSG ;YES
SETZM LTARDR ;NONE NOW
RET
;BEGIN NEW TAPE
DNEWV: CALL MTOPNW ;REOPEN MAGTAPE
DNEWV1: MOVSI A,(1B1) ;SAY MUCHO TAPE LEFT
MOVEM A,TAPLFT
CALL LPTOPN ;REOPEN LPT
SETZM LPTPAG ;[401] INIT PAGE NUMBER
TXZN F,TNSF ;SKIP IF TAPE NUMBER SET
AOS TAPNO ;COUNT TAPES
CALL UNMAPB ;RESET BUFFERS
MOVEI B,CURFMT ;THE CURRENT FORMAT
MOVEM B,BUFF ;TO THE HEADER
MOVE B,BGNTAD ;BEGINNING TAD
MOVEM B,BUFF+BFTAD
MOVEI B,BFMSG ;OFFSET FOR MESSAGE
MOVEM B,BUFF+BFMSGP ;TO THE HEADER AS WELL
SKIPN COLSW ;COLLECTION/MIGRATION?
SKIPE ARCSW ;OR ARCHIVE?
JRST [ CALL GTVOL ;YES, GET VOLID
CALL ARCSSN ; Construct arc/col/mig header
SETZM IDIR
SKIPN B,JFN ; JFN from end of previous tape (if any)
HRRZ B,INIJFN ; Initial JFN (if any)
JUMPE B,.+1 ; Start from beginning of this tape
HRROI A,IDIR ; Dev & directory at start of tape
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS%
HRROI A,ISPEC ; Full filespec at start of tape
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS%
JRST .+1]
HRROI A,BUFF+BFMSG ;LOC IN HEADER FOR SSNAME
HRROI B,SSNBUF
SETZ C,
SOUT% ;COPY SET NAME TO HEADER
SETZM PAGNO ;RESET PAGE NUMBER IN TAPE HEADER
MOVX A,-TPHDX
SKIPE INIPGN ;SKIP IF NOT CONTINUED FILE
MOVX A,-CTPHX ;CONTINUED TAPE HEADER
MOVEM A,TYP
CALL MTOUT
MOVE A,[POINT 7,LSTHDR] ;SET TO BUILD LISTING HEADER MESSAGE
CALL PRHEDR ;BUILD IT
TXNE F,LTTYF ;[401] NOT TO TTY IF LOGGING ON TTY
JRST DNEWV2 ;[401]
HRROI B,LSTHDR
CALL TMSGQ ;[401] TYPE IT
CALL TCRLF ;[401]
DNEWV2: CALL LNEWPG ;[401] PRINT NEW LOG PAGE
LPMSG <Directory (number)
> ;[401] MORE HEADER...
PRTHDR: MOVEI B,FLCOL
CALL TAB ;POSITION FILE COLUMN HEADING
LPMSG <file>
MOVEI B,WTCOL ;DO LIST COLUMN HEADINGS
CALL TAB
LPMSG <last write>
MOVEI B,SIZCOL
CALL TAB
LPMSG <size (pages)>
MOVEI B,CSCOL ;TAB TO CHECKSUM COLUMN
CALL TAB ;TAB OVER
LPMSG <checksum
>
SKIPN COLSW
SKIPE ARCSW
JRST [ TMSG < Pass 1 started
>
JRST .+1]
RET
;DUMP ONE FILE
DMPFIL: MOVEI A,[CALL NDMESS ;PRINT REASON FOR ERROR
CALL UNMAPB ;RESET BUFFERS
TMSGC <%File skipped
>
SKIPN COLSW ; Migration/collection?
SKIPE ARCSW ; or archive?
CALL UNARC ; Yes, undo invalid tape info (if any)
JRST DMPFIX] ;SKIP TO NEXT FILE
CALL SETTRP ;SET TRAP FENCE
MOVE A,JFN
MOVSI B,.FBLN0
MOVEI C,FDB
GTFDB% ;READ ENTIRE FDB
ERCAL JSERRR ;[307] FAILED, TYPE JSYS ERROR AND RETURN
MOVE B,FDB+.FBCTL ;GET BITS
TXNE B,FB%NXF!FB%NEX!FB%DEL!FB%TMP
JRST DMPFIZ
TXNE F,ICMODF ;SKIP IF NOT INTERCHANGE MODE
JRST DMPFI2 ;SKIP IT
HRR A,JFN ;PIC UP FILE JFN
HRLI A,.GFAUT
HRROI B,FDBAUT ;STORE AUTHOR HERE
GFUST%
ERJMP [SETZM FDBAUT ;SET AS NULL
JRST .+1]
HRLI A,.GFLWR ;FUNCTION IS LAST WRITER
HRROI B,FDBLWR
GFUST% ;GET LAST WRITER
ERJMP [SETZM FDBLWR
JRST .+1]
MOVE A,JFN
MOVEI B,.ARGST ; Get tape info
MOVEI C,FDBARC ; Where to put the info
ARCF% ; Get it
ERJMP [MOVE A,[FDBARC,,FDBARC+1]
SETZM -1(A)
BLT A,FDBARC+.ARPSZ
JRST .+1]
DMPFI2: HRROI A,NAMBUF ;[307] LOAD PTR. TO DIRECTORY NAME
HRROI B,DIRNAM ;COPY CURRENT DIRECTORY NAME
SETZ C,
SOUT%
MOVEM A,NAMPTR
MOVE B,JFN
MOVX C,<FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF> ;[307] LOAD JFNS FORMAT BITS
JFNS%
MOVE B,FDB+.FBCTL
TXNE B,FB%NOD ;IS THIS FILE NOT TO BE DUMPED?
JRST NODUMP ;YES, DONT DUMP IT
MOVE A,FDB+.FBCRE ;GET LAST MODIFICATION DATE
CAMG A,MBTAD ;NOT 'BEFORE'?
CAMGE A,MSTAD ;NOT 'SINCE'?
JRST NODUMP ;YES, DON'T DUMP
MOVE A,FDB+.FBWRT ;GET LAST WRITE DATE
CAMG A,WBTAD ;NOT 'BEFORE'?
CAMGE A,WSTAD ;NOT 'SINCE'
JRST NODUMP ;YES, DON'T DUMP
CAMGE A,FDB+.FBREF ;GET MOST RECENT OF WRITE, READ
MOVE A,FDB+.FBREF
CAMG A,ABTAD ;NOT 'BEFORE'?
CAMGE A,ASTAD ;NOT 'SINCE'?
JRST NODUMP ;YES, DON'T DUMP
; ..
; ..
SKIPLE A,INCRSW ;SKIP IF NOT INCREMENTAL OR /FULL-INCREMNTAL
JRST [ HLRZ B,FDB+.FBCNT ;GET COUNT OF WRITES
HLRE C,FDB+.FBBK0 ;GET TAPE COUNT AND FLAG
HRRZ D,FDB+.FBBK0 ;GET LAST WRITE COUNT OF SAVE
CAMN B,D ;SAME WRITE COUNT?
CAMGE C,A ;YES-- HAS IT BEEN SAVED ENOUGH TIMES?
JRST .+1 ;NO-- DUMP THE FILE
JRST NODUMP] ;YES-- DON'T DUMP IT
SKIPN COLSW ; Collection/migration?
SKIPE ARCSW ; Or archive run?
JRST [ CALL ARCTST ; Yes, check this file for inclusion
JRST NODUMP ; Don't dump on this tape
JRST .+1] ; Do dump on this tape
;FILE WILL BE DUMPED
CALL TSTEOT ;CHECK TO MAKE SURE FILE WILL FIT ON TAPE
SKIPN INIPGN ;SKIP IF CONTINUED FILE
JRST DMPF4 ;NO
LPMSG <
(File continued from previous reel)
>
DMPF4: CALL GOFNAM ;MAKE UP TAPE FILE NAME
SETOM WORKING ;[361] actually have a name
MOVEI B,FLCOL
CALL TAB ;TAB TO FILESPEC COLUMN
MOVE B,ONMPTR ;PRINT FILE NAME
CALL LPMSGQ ;NAME TO LISTING
MOVEI B,WTCOL ;TAB TO WRITE COLUMN
CALL TAB
SKIPN NOFILS ;FIRST FILE THIS USER?
SKIPE INIPGN ; And not continued file?
CAIA
CALL TDRNAM ;TYPE DIRECTORY NAME
TXNE F,LFILF ;TYPE FILE NAMES REQUESTED?
TXNE F,LTTYF ;AND NOT LOGGING TO TTY?
JRST DMPF2 ;NO
MOVE B,NAMPTR ;YES, TYPE NAME
CALL TMSGQ
TMSG < (AS) >
MOVE B,ONMPTR
CALL TMSGQ ;TYPE OUTPUT NAME
DMPF2: MOVE A,JFN
HRLOM A,LASTID ;REMEMBER FILE IN CASE ERROR ON OPENF
MOVX B,OF%RD+OF%PDT ;READ AND PRESERVE ACCESS DATES
OPENF%
ERJMP [MOVEI A,.FHSLF ;[371] CURRENT PROCESS
GETER% ;[371] GET LAST ERROR
HRRZ A,B ;[371] ONLY THE ERROR CODE
CAIE A,OPNX2 ;NONEXISTENT (EMPTY OR...)
CAIN A,OPNX31 ; File offline?
JRST .+1 ; Yes, dump it
MOVE A,JFN
MOVX B,OF%RD+OF%THW+OF%PDT ;TRY THAW MODE
OPENF%
ERJMP [CALL NDMESS ;PRINT REASON
RET]
JRST .+1]
SKIPN COLSW
SKIPE ARCSW
JRST [ SKIPN INIPGN ; Info already set if cont file
CALL ARC1 ; Go set archive/collection info
JRST .+1]
HRROI A,BUFF ;SET TO PUT NAME IN FILE HEADER
HRROI B,ONMBUF
SETZ C,
SOUT% ;COPY FILESPEC THROUGH VERSION
CALL GOFPAT ;GET OUTPUT PROTECTION, ACCOUNT AND ;T
MOVEI B,0
IDPB B,A
MOVE A,[FDB,,BUFF+FHFDB]
BLT A,BUFF+FHFDB+.FBLN0-1+20+.ARPSZ+1 ;COPY FDB TO HEADER
TXNE F,CHKSM ;SKIP IF NOT CHECKSUMMING
CALL [ SKIPE INIPGN ;SKIP IF START OF FILE
RET ;MIDDLE OF FILE
SETZM CHKCN0 ;INITIALIZE CHECKSUM
SETZM LSTPGE ;AND PAGE #
CALL FILSZE ;FIGURE FILE SIZE
RET]
;SETUP INITIAL PAGNO AND PAGE CNTR
SKIPGE A,INIPGN ;SKIP IF NOT MIDDLE OF FILE
JRST [ MOVE B,INICNT ;SAVE SAVED COUNTER
MOVEM B,CNTR ;STORE IT
JRST DMPF3]
MOVE A,FDB+.FBBYV ;GET SIZE
HRRZM A,CNTR
AOS NOFILS
AOS TOTFIL ;BUMP TOTAL FILE COUNT
HRLZ A,TOTFIL ;GET FILE NUMBER
TXZ A,PGNCFL!PGNNFL ;CLEAR FLAG BITS
TXO A,PGNNFL ;SET FLAG TO INDICATE PAGNO HAS FILE NUMBER
DMPF3: MOVEM A,PAGNO ;STORE PAGE NUMBER WORD
SETZM INIPGN ;BE SURE INIPGN OFF
;WRITE FILE HEADER TO TAPE
MOVX A,-FLHDX
MOVEM A,TYP
CALL MTOUT
MOVX A,PGNCFL!PGNNFL ;COMPLEMENT THE CONTINUED FILE FLAGS
SKIPGE PAGNO ; IF THIS IS
XORM A,PAGNO ; A CONTINUED FILE
SKIPN LPTJFN
JRST DMPF1
HRROI A,LPTBUF ;SET TO GET WRITE TAD STRING
SKIPN B,FDB+.FBWRT ;HAVE ONE?
JRST [ LPMSG <(NEVER)> ;NO
JRST DMPF1]
MOVX C,OT%NSC+OT%NCO+OT%SCL
ODTIM% ;CONVERT TO STRING
HRROI B,LPTBUF
CALL LPMSGQ ;COPY TO LISTING
DMPF1: MOVEI B,SIZCOL ;TAB TO NEXT COLUMN
CALL TAB
SETZM CURBUF ;NO PAGES MAPPED YET
SKIPN CNTR ; 0 pages in file? (e.g. offline)
JRST DMPLUX ; Yes--no pages to write to tape
; ..
;LOOP FOR ALL PAGES IN FILE
DMPLUP: SKIPG TAPLFT ;ANY TAPE LEFT?
JRST DMPEOT ;NO, CLOSE OUT REEL
;MAP A WINDOW OF THE FILE INTO BUF0
DMPIT: HRRZ A,PAGNO ;FORM FILE PAGE
HRL A,JFN ; PAGE ID
SKIPN CURBUF ;FIRST TIME HERE?
JRST DMPL1 ;YES - SET UP WINDOW
HRRZ B,A ;GET PAGE DESIRED
HRRZ C,LASTID ; BASE PAGE # IN WINDOW
SUB B,C ;SEE IF INSIDE WINDOW
CAMGE B,NBUF ;...
JRST [ IMULI B,PGSIZ ;YES - CALC BUFFER ADDRS
ADDI B,BUF0 ;BASE ADDR
HRRZM B,CURBUF ;SET BUFFER ADDRS
JRST DMPL2] ;CONTINUE
DMPL1: MOVEM A,LASTID ;SAVE BASE PAGE INFO
MOVEI B,BUF0 ;SETUP CURBUF
MOVEM B,CURBUF
MOVE B,[XWD .FHSLF,BUF0PG]
MOVX C,PM%RD!PM%PLD!PM%CNT
HRR C,NBUF ;NUMBER OF PAGES TO MAP
PMAP%
ERJMP DMPL4 ;IN CASE NON-EX PT
;MAKE SURE THE PAGE WE ARE ABOUT TO DUMP EXISTS
DMPL2: SKIP @CURBUF ;TEST READABILITY
ERJMP DMPL4 ;CAN'T ACCESS PAGE-- FIND OUT WHY
;WRITE THE PAGE OUT TO TAPE
DMPL3: SETZM TYP
TXNE F,CHKSM ;SKIP IF NOT CHECKSUMMING
CALL [ HRRZ A,CURBUF ;CURRENT BUFFER
LSH A,-11 ;PAGE #
HRLI A,.FHSLF
MOVE B,[XWD .FHSLF,BUFPAG]
MOVX C,PM%RD
PMAP% ;POINT TO CURRENT BUFFER
CALLRET PGECSM]
CALL MTOUT
SOS CNTR
AOS A,PAGNO ;INCREMENT PAGE #
; HRL A,JFN ;[363] GET JFN INTO HL
; FFUFP% ;[363] TEST FOR MORE PAGES
; JRST DMPLUX ;[363] NO MORE, FINISH UP
; MOVE A,PAGNO ;[363] GET PAGE NUMBER BACK
TRNE A,777777 ;WRAP AROUND TO ZERO??
JRST DMPLUP ;NO-- KEEP ON GOING
MOVX A,-<XWD 1,0> ;YES-- MUST UNDO
ADDB A,PAGNO ; CARRY INTO LH
JRST DMPLUX ;AND NOW DONE WITH FILE
;HERE WHEN CURRENT PAGE CANNOT BE ACCESSED (SKIP ERJMP'ED)
DMPL4: HRRZ B,CURBUF ;GET PAGE
LSH B,-^D9 ; NUMBER
HRLI B,.FHSLF ; IN OUR PROCESS
SETO A, ;UNMAP
SETZ C, ; FILE PAGE FROM
PMAP% ; THIS PROCESS
MOVE D,B ;SAVE PROCESS PAGE ID
HRRZ A,PAGNO ;FIND OUT
HRL A,JFN ; WHAT FILE PAGE'S ACCESS IS
RPACS% ; . . .
TXNE B,PA%PEX ;PAGE EXIST?
JRST [ MOVE B,D ;YES-- GET BACK PROCESS PAGE ID
MOVX C,PM%RD!PM%PLD ; . .
PMAP% ;MAP THE FILE PAGE BACK AGAIN
ERJMP DMPL3 ; . .
JRST DMPL3] ; AND TRY TO ACCESS PAGE ANYWAY
FFUFP% ;NO-- FIND NEXT PAGE WHICH DOES EXIST
JRST DMPLUX ;NO MORE PAGES IN FILE-- ALL DONE
HRRM A,PAGNO ;FOUND A PAGE-- REMEMBER IT
; SETO A, ;[363] SAY UNMAP CURRENT WINDOW
; MOVE B,[XWD .FHSLF,BUFPAG] ;[363] GET BASE OF WINDOW
; MOVX C,PM%CNT ;[363] SPECIFY SEVERAL PAGES
; HRR C,NBUF ;[363] AND HOW MANY
; PMAP% ;[363] UNMAP THE WINDOW
; ERJMP DMPIT ;[363] TRIED TO UNMAP NONEXISTANT PAGES
JRST DMPIT ; AND TRY TO WRITE IT
;DONE WITH FILE-- FINISH UP AND WRITE TRAILERS
DMPLUX: TXNE F,ICMODF ;SKIP IF NOT INTERCHANGE MODE
TRNE A,777777 ;ZERO LENGTH FILE ?
JRST DMPLX2 ;NOT INTERCHANGE OR NOT ZERO
;LENGTH FILE
MOVEI A,BUFF ;USE THIS BUFFER
MOVEM A,CURBUF ;...
SETZM TYP ;DATA TYPE PAGE
CALL MTOUT
DMPLX2: SKIPG CNTR
JRST DMPLX1
BTMSGC <%Cannot find all the pages of file: >
HRROI B,NAMBUF
CALL BTMSGQ ;TYPE FILESPEC
BTMSG <
>
; ..
DMPLX1: CALL UNMAPB ;RESET BUFFERS
MOVE A,[FDB,,BUFF]
BLT A,BUFF+.FBLN0-1+20+.ARPSZ+1 ;COPY FDB TO TRAILER BLOCK
MOVX A,-FLTRX
MOVEM A,TYP
SKIPE INCRSW ;INCREMENTAL?
JRST [ HLRZ B,BUFF+.FBCNT ;GET COUNT OF WRITES
MOVE C,BUFF+.FBBK0 ;GET LAST BACKUP WORD
CAIN B,(C) ;SAME WRITE COUNT AS LAST SAVE?
SKIPGE INCRSW ;YES-- BUT FULL-INCREMENTAL?
HRRZ C,B ;FULL OR NEW WRITE-- SET TAPE COUNT TO 0
; AND WRITE COUNT TO NEW WRITE COUNT
TXO C,1B0 ;INDICATE INCOMPLETE DUMP
MOVE A,JFN
HRLI A,.FBBK0
TXO A,CF%NUD ;SUPPRESS DIRECTORY UPDATE
MOVNI B,1 ;CHANGE ALL BITS
CHFDB% ;NOTE DUMP PARTIALLY DONE
TXZ C,1B0 ;STORE FDB ON TAPE
ADD C,[XWD 1,0] ; AS IF
MOVEM C,BUFF+.FBBK0 ; DUMP COMPLETED SUCCESSFULLY
JRST .+2] ;[320]
HRRZS BUFF+.FBBK0 ;[320] CLEAR TAPE COUNT
CALL MTOUT ;OUTPUT TRAILER RECORD
TXNE F,LFILF ;TYPE FILE NAMES ?
TXNE F,LTTYF ;AND NOT LOGGINT TO TTY?
JRST DMPLX3
TMSG < [OK]
>
DMPLX3: HRRZ B,FDB+.FBBYV ;GET SIZE
ADDM B,USRCNT ;COUNT PAGES FOR THIS DIR
MOVEI C,^D10
CALL LPNOUT ;OUTPUT SIZE TO LISTING
TXNE F,CHKSM ;SKIP IF NOT CHECKSUMMING
CALL PRTCSM ;PRINT CHECKSUM
LPMSG <
>
DMPFIX: MOVE A,JFN
TXO A,CO%NRJ ;NO RELEASE JFN
CLOSF% ;CLOSE FILE
JFCL
NODUMP:
DMPFIZ: SETZM WORKING ;[361] Done with it.
RET ;DONE WITH FILE
;FILE NOT DUMPED
NDMESS: TMSGC <%File >
HRROI B,NAMBUF
CALL TMSGQ ;TYPE FILESPEC
TMSG < not dumped because:
>
CALL JSERRM ;PRINT REASON SYSTEM GAVE
LPMSG <not dumped
>
RET ;RETURN
;ENCOUNTERED END OF TAPE IN THE MIDDLE OF FILE.
;REMEMBER CURRENT FILE POSITION FOR NEXT REEL.
DMPEOT: CALL UNMAPB ;RESET BUFFERS
MOVE A,[FDB,,BUFF]
BLT A,BUFF+.FBLN0-1+20+.ARPSZ+1 ;COPY FDB TO FILE TRAILER
MOVX A,-FLTRX
MOVEM A,TYP ;SET RECORD TYPE TO FILE TRAILER
MOVX B,PGNCFL!PGNNFL ;SET CONTINUED FILE FLAG
XORB B,PAGNO ;SET IN PAGE NUMBER WORD
MOVEM B,INIPGN ;MARK TO CONTINUE FILE ON NEXT REEL
MOVE B,CNTR ;SAVE COUNTER
MOVEM B,INICNT ;...
CALL MTOUT ;WRAP UP FILE IN USUAL WAY
LPMSG <
(File continued on next reel)
>
MOVE A,JFN
HRLI A,(1B0) ;SAY DON'T RELEASE JFN
CLOSF% ;CLOSE THE FILE
JFCL
CALL TSTEOT ;START NEW TAPE
JRST DMPFIL ;RESTART THIS FILE
;ROUTINE TO CONTINUE SAVE ON NEXT TAPE IF NO TAPE LEFT
TSTEOT: SKIPLE TAPLFT ;ANY TAPE LEFT?
RET ;YES, ALL OK
SKIPN COLSW ;Collection/migration run?
SKIPE ARCSW ;Archive run?
CALL XINFO ;Yes, get new tape #, file spec later
SETOM PAGNO ;INDICATE CONTINUED TAPE TRAILER
CALL ENDTAP
CALL UNLOAD
SKIPG MTTYP ;UNLABELED TAPE?
CALL MTCLS ;YES, CLOSE IT
SKIPN COLSW ;Collection or migration run?
SKIPE ARCSW ;ARCHIVAL?
JRST [ CALL ARDELF ;DELETE AND EXPUNGE OLD RESTART FILE
TMSG < Pass 1 completed.
Tape >
HRROI B,VOLID
CALL TMSGQ ;DISPLAY VOLID
TMSG < is complete and ready for storage.
Please mark it full.
>
CALL PASS2 ;FIX UP FOR FILES ON THIS TAPE
MOVEI A,1 ;1 FOR CONT. SAVESET#
MOVEM A,ARCTSN
MOVEI B,XBUFF
STOR A,SSNO,(B) ; Put in record header too
JRST .+1]
SKIPN A,LPTJFN ;SKIP IF LISTING
JRST TSTET1
CLOSF% ;CLOSE LISTING FILE
JFCL
TSTET1: SKIPLE A,MTTYP ;LABELED TAPE?
JRST [ MOVE A,MTJFN ;YES, GET TAPE JFN
MOVEI B,.MOVLS
MOVEI C,[EXP 2,.VSFLS]
MTOPR% ;FORCE VOLUME SWITCH
ERJMP [ERRORJ BMBCMD,<?Error switching volumes>]
CALL DNEWV1 ;WRITE STUFF AT BEGINNING OF TAPE
JRST TSTET2]
JUMPL A,[TMSGC <$ End of tape, continue save on
> ;MTA, WE'LL HAVE TO ASK THE USER
JRST .+1]
CALL NTAPER ;GET NEW TAPE SPEC
JRST BMBCMD ;CAN'T
CALL DNEWV ;START NEXT TAPE
TSTET2: SKIPN COLSW ; Collection/migration?
SKIPE ARCSW ;ARCHIVAL?
JRST [ SETZM SPSEQ ;RESTART AT BEGINNING OF TAPE
CALL SETRF ;SET RESTART FILE SPEC W/ NEW TAPE ID
CALL WRARFL ;WRITE RESTART FILE--TAPE HEADER EXISTS
JRST .+1]
RET
;ROUTINE TO RESET FILE WINDOW AND CURBUF
UNMAPB: SETO A,
MOVE B,[XWD .FHSLF,BUF0PG]
MOVX C,PM%CNT ;SET NUMBER OF PAGES
HRR C,NBUF
PMAP% ;REMOVE THEM
HRRI B,BUFPAG
SETZ C, ;ONLY ONE PAGE
PMAP%
MOVEI A,BUFF ;SET THIS TO BE CURRENT BUFFER
MOVEM A,CURBUF
RET ;RETURN
BEGUSR: TXNE F,DIRCHG ;SKIP IF SAVING AS SAME DIRECTORY
JRST BEGUS1
HRROI A,DIRNAM
HRRZ B,JFN ;GET CURRENT DIRECTORY NAME STRING
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS%
HRROI B,DIRNAM
MOVX A,RC%EMO ;EXACT MATCH ONLY
RCDIR%
ERJMP BEGUS3 ;RCDIR FAILURE
TXNE A,RC%NOM!RC%AMB
JRST BEGUS3 ;REPORT ERROR
MOVEM C,DIRNUM ;SAVE DIRECTORY NUMBER
TXNN F,SAVUSF ;WANT USER DATA?
JRST BEGU2 ;NO - SKIP THIS
BEGU1: MOVX A,RC%AWL ;ALLOW WILDCARDS
SKIPE C,RCDNUM ;FIRST TIME HERE?
TXO A,RC%STP ;NO - STEP DIRECTORIES
HRROI B,RCDSTR
RCDIR%
TXNE A,RC%NMD
JRST [ TMSGC <?RCDIR out of sync on directories
>
TXZ F,SAVUSF ;TURN THIS OFF
JRST BEGU2]
MOVEM C,RCDNUM ;SAVE WHERE WE ARE
SKIPE ININUM ;HAD INITIAL FILESPEC
JRST [ CAME C,DIRNUM ;CAUGHT UP?
JRST BEGU1 ;NO - CONTINUE
SETZM ININUM ;DONE WITH INITIAL DDB
JRST BEGU1A] ;DUMP THIS DIRECTORY
CAME C,DIRNUM ;THE ONE WE WANT?
JRST [ CALL DMPUSR ;NO - DUMP A DIRECTORY
JRST BEGU1] ;LOOP TO CATCH UP
BEGU1A: CALL DMPUSR ;YES - DUMP USER INFO AND PROCEED
BEGU2: SETZM USRCNT
SETZM NOFILS
LPMSG <
>
HRROI B,DIRNAM
CALL LPMSGQ ;PRINT DIRECTORY NAME
LPMSG < (>
HRRZ B,DIRNUM
MOVEI C,^D8
CALL LPNOUT ;PRINT DIRECTORY NUMBER FOR INFO
LPMSG <)
>
RET
;HERE IF DIRECTORY NAME ON DISK .NE. DIRECTORY NAME ON TAPE
BEGUS1: HRROI A,ODRNAM ;CURRENT DIRECTORY NAME
HRROI B,LSTDIR ;LAST DIRECTORY NAME
STCMP%
JXE A,SC%LSS+SC%SUB+SC%GTR,BEGUS2
CALL TSTEOT ;SEE IF ROOM ON TAPE FOR THIS DDB
HRROI B,ODRNAM ;NEW DIRECTORY
HRROI A,LSTDIR
SETZ C,
SOUT%
SETZM USRCNT ;RESET # PAGES
SETZM NOFILS ;RESET # FILES
HRROI B,ODRNAM ;NAME OF DIRECTORY
CALL LPMSGQ
LPMSG <
>
SETZM BUFF
MOVE B,[XWD BUFF,BUFF+1]
BLT B,BUFF+777
MOVE B,[XWD ODRNAM,BUFF+UHNAM]
BLT B,BUFF+UHNAM+17
MOVX A,-USRX
MOVEM A,TYP ;STORE RECORD TYPE
CALL MTOUT
BEGUS2: RET
;RCDIR FAILURE - PRINT MESSAGE
BEGUS3: TMSGC <?RCDIR failure for - >
HRROI B,DIRNAM ;TELL ON DIRECTORY
CALL TMSGQ
CALLRET TCRLF ;RETURN
;DUMP USER INFORMATION
DMPUSR: STKVAR <DMPNUM>
MOVEM C,DMPNUM ;SAVE NUMBER OF DIRECTORY
CALL TSTEOT ;MAKE SURE WE HAVE SOME TAPE FOR DDB
SETZM BUFF
MOVE B,[XWD BUFF,BUFF+1]
BLT B,BUFF+777
TXNE F,SAVUSF ;NOT WHEEL OR USER DATA NOT WANTED?
SKIPN WHEEL
JRST DMPUS1 ;YES, DON'T DUMPER DIR INFO
MOVEI A,BUFF+CDSG ;SET UP BUFFER TO RECEIVE SUB GROUPS
MOVEM A,BUFF+.CDCUG
MOVEI A,BUFF+CDUG ;SET UP BUFFER TO RECEIVE USER GROUPS
MOVEM A,BUFF+.CDUGP
MOVEI A,BUFF+CDDG ;SET UP BUFFER TO RECEIVE DIR GROUPS
MOVEM A,BUFF+.CDDGP
MOVEI A,UGLEN ;LENGTH OF BUFFERS FOR GROUPS
MOVEM A,BUFF+CDUG
MOVEM A,BUFF+CDDG
MOVEM A,BUFF+CDSG
HRROI A,BUFF+UHACT ;POINT TO ACCOUNT STRING SPACE
MOVEM A,BUFF+.CDDAC
MOVEI A,CD.LEN ;CURRENT MAX SIZE
MOVEM A,BUFF+.CDLEN
MOVE A,DMPNUM
MOVEI B,BUFF
MOVE C,[POINT 7,BUFF+UHPSW]
GTDIR%
ERJMP [JSERR]
MOVEI B,UHPSW ;SET PASSWORD OFFSET
MOVEM B,BUFF+.CDPSW
MOVEI B,UHACT ;SET POINTER TO ACCOUNT STRING
MOVEM B,BUFF+.CDDAC
DMPUS1: HRROI A,BUFF+UHNAM ;POINT TO NAME BUFFER
MOVE B,DMPNUM ;THIS DIRECTORY NUMBER
DIRST% ;CONVERT TO STRING
JSHLT ;CANT HAPPEN
MOVX A,-USRX
MOVEM A,TYP
CALL MTOUT
RET
ENDUSR: MOVE B,USRCNT ;[370] ADD THIS DIRECTORY PAGE COUNT
ADDM B,TOTCNT ;[370] TO TOTAL PAGE COUNT
SKIPN A,LPTJFN ;[370] GET LISTING JFN
RET ;[370] NONE - RETURN NOW
LPMSG <
>
MOVEI B,FLCOL
CALL TAB ;INDENT TOTAL
SKIPN NOFILS
JRST [ LPMSG <No files
>
RET]
LPMSG <Total >
MOVEI C,^D10
MOVE B,NOFILS
CALL LPNOUT
LPMSG < files, >
MOVEI C,^D10
MOVE B,USRCNT
CALL LPNOUT
LPMSG < pages
>
TXNN F,LFDSK ;SKIP IF LOGGING TO NON-SPOOLED
;DISK FILE
RET
MOVE A,LPTJFN ;[370] LOG FILE JFN
TXO A,CO%NRJ ;KEEP JFN
CLOSF% ;UPDATE FILE
ERJMP [TMSGC <?Cannot close LOG file> ;[370] NOTE ERROR
RET] ;[370] AND CONTINUE
MOVE A,LPTJFN ;[370] LOG FILE JFN
MOVX B,<FLD(7,OF%BSZ)+OF%APP>
OPENF%
ERJMP LPTNA0 ;[370] ERROR
RET
;OPEN LPT FOR LISTING FILE. DONE AT BEGINNING OF EACH TAPE
LPTOPN: SKIPN LSTFIL ;HAVE LOG FILE SPEC?
JRST LPTOP1 ;NO
MOVX A,GJ%MSG+GJ%SHT ;MESSAGE AND SHORT FORM
HRROI B,LSTFIL
GTJFN%
ERJMP LPTNAV
LPTOP0: MOVEM A,LPTJFN
DVCHR% ;SEE WHAT DEVICE
LOAD C,DV%TYP,A
CAIN C,.DVTTY ;TTY?
TXOA F,LTTYF ;YES
TXZ F,LTTYF ;NO
CAIE C,.DVDSK ;DISK?
TXZA F,LFDSK ;LOG FILE NOT TO DISK
TXO F,LFDSK ;IS DISK
MOVE A,LPTJFN
MOVX B,<FLD(7,OF%BSZ)+OF%APP>
TXNN F,LFDSK ;OPENING A DISK?
MOVX B,<FLD(7,OF%BSZ)+OF%WR> ;NO, THEN OPEN JUST FOR WRITE
OPENF%
ERJMP LPTNA0 ;[370] ERROR
SETZM LPTPOS ;INIT LIST VARIABLES
SETZM LPTLIN
RET
LPTNA0: MOVE A,LPTJFN ;[370] LOG FILE JFN
RLJFN% ;[370] RELEASE JFN
JFCL ;[370] IGNORE ERROR
LPTNAV: TMSGC <%Log file not available because:
> ;[370]
CALL JSERRM
LPTOP1: TXZ F,LFDSK+LTTYF ;NOT DISK OR TTY
SETZM LPTJFN ;SAY NO LISTING
RET
;FIXUP FDB BACKUP WORD AFTER DUMP COMPLETED SUCCESSFULLY
FIXBCK: HRRZ A,P2JFN
MOVE B,[XWD 1,.FBBK0]
MOVEI C,C
GTFDB%
JUMPGE C,R
TLZ C,(1B0) ;CLEAR DUMP-IN-PROGRESS FLAG
ADD C,[XWD 1,0] ;INCREMENT TAPE COUNT
MOVSI B,-1 ;GET MASK FOR BITS TO CHANGE
HRLI A,.FBBK0+CF%NUD_-^D18 ;NO UPDATE DIRECTORY
CHFDB%
RET
;INITIALIZATION FOR ARCHIVE/COLLECTION/MIGRATION RUN: DETERMINE TAPE NO., SAVESET NO.,
;STARTING POSITION FROM OLD TAPE OR FROM USER FOR NEW TAPE
ARCINI: SETZM INIPGN ;NON-0 FOR CONT. FILE
SETZM ARCTSN ;SAVE SET #
CALL GTVOL ;GET VOLID
CALL SETRF ;SET RESTART FILE SPEC. (EXT.=TAPE ID)
SKIPE ARCSW ; Determine SS type: archival?
MOVEI A,SSARC ; Yes, load code for archive saveset
SKIPLE COLSW ; Collection run?
MOVEI A,SSCOL ; Yes, code for collection saveset
SKIPGE COLSW ; Migration run?
MOVEI A,SSMIG ; Yes, code for migration saveset
MOVEM A,SSTYP ; Saveset type is determined
HRROI A,[ASCIZ /$Is this a new tape? /]
CALL YESNO
JUMPN A, [HRROI A,[ASCIZ /$Are you sure? /]
CALL YESNO
JUMPE A,[ERROR BMBCMD,<?Command aborted>]
MOVEI B,2 ;FIRST TSN ON A NEW TAPE TO BE 2
MOVEM B,ARCTSN ;TO RESERVE 1 FOR CONT. SAVESET
SETZM SPSEQ ;INIT. SEQUENCE NO.
CALL MTOPNX
CALL REWCV ;REWIND THE TAPE
CALL MTCLS
JRST ARINI1]
;OLD TAPE:
TXZ F,TF1 ;[341] CLEAR 1ST SCAN FLAG
CALL SCNTAP ;GET TAPNO=SSTYP!SS#,,TAPE# FROM 1ST REC ON TAPE
MOVEI C,XBUFF ; Address of record header
; LOAD B,TPNO,(C) ; Tape # from tape
; CAME B,ARCTN ;=SUPPLIED TAPE #?
; JRST [ TMSGC <?Tape # input disagrees with tape # on tape.
; The first tape header on this tape follows:
;>
; CALL TYHEDR
; ERROR BMBCMD, <?Command aborted>]
LOAD B,SSCOD,(C) ; SS type from tape
CAME B,SSTYP ; Matches type for this run?
JRST [ TMSG <$This tape has been previously used for a different DUMPER purpose.
Continuation of this run will cause a mixture of saveset types on this tape.
The first tape header on this tape follows:
> ;[341]
CALL TYHEDR
HRROI A,[ASCIZ /
$Do you wish to continue this run? /] ;[341]
CALL YESNO
JUMPE A,[ERROR BMBCMD,<?Command aborted>]
JRST .+1]
CALL RDARFL ;READ RESTART FILE, IF ANY. EXISTS?
JRST [ CALL SEQFND ;YES, FIND START POS. BY SEQ. NO.
JRST ARINI1]
CALL SCNTAP ;NO,SCAN TO TRAILER REC.
;NOW ARCTN, ARCTSN, SSTYP, SPSEQ, INIPGN, INICNT, AND XSPEC ARE
; DETERMINED FOR NEW SAVESET AND TAPE IS POSITIONED TO START
ARINI1: TXO F,TNSF ;[341] SET TAPE # KNOWN
MOVEI B,XBUFF ;[341] Address of tape header block
SKIPE A,SPSEQ ; 1st seq. # on last phys. rec.
JRST [ SKIPLE MTTYP ;[341] Labeled tape?
JRST .+1 ;[341] Yes, seq. # is ok
ADD A,TAPBKF ;[341] 1st seq. # of new SS
SOJA A,.+1] ;[341] But will be incremented before write
MOVEM A,SEQ ;SEQ NO. FOR TAPE
MOVEM A,RSEQ ;EXPECTED SEQUENCE NO.
MOVE A,ARCTSN ;SAVESET#
STOR A,SSNO,(B) ; In LH of TAPNO for record header
MOVE A,SSTYP ; Saveset type (archive, coll., mig.)
STOR A,SSCOD,(B) ; Put in 1st 3 bits of TAPNO
CALL WRARFL ;WRITE RESTART FILE
MOVE A,INIPGN ;=0 EXCEPT FOR CONT. FILE
MOVEM A,PAGNO ;INIT. PAGNO=TFN,,PAGE# FOR TAPE, EXCEPT
RET ; =PGNCFL!PGNNFL,,PAGE# INITIALLY FOR CONT. FILE
; ROUTINE TO CONSTRUCT RESTART FILE NAME FOR ARCHIVING
SETRF: HRROI A,RFSPEC ;SET UP RESTART FILE NAME, EXT.
HRROI B,[ASCIZ /SYSTEM:DUMPER-TAPE-IN-PROGRESS./]
SETZ C,
SOUT% ;RESTART FILE NAME
HRROI B,VOLID
SOUT% ;FILE TYPE IS TAPE VOLID
RET
; GTVOL - GET VOLUME-ID FOR ARCHIVING RUNS
; RETURNS +1: ALWAYS, IDENTIFIER IN VOLID (ASCIZ) AND VOLID6 (SIXBIT)
GTVOL: SKIPN MTDSG ;USER GIVE ME A TAPE YET?
CALL NTAPE ;NO, GET TAPE SPEC
JFCL ;WON'T FAIL
SKIPE VOLID6 ;DO I KNOW THE VOLID?
RET ;YES, RETURN
SKIPL MTTYP ;MT DEVICE?
JRST [ MOVX A,GJ%SHT ;YES
HRROI B,MTDEV
GTJFN% ;GET JFN ON MT
ERJMP .+1 ;SHOULD NEVER FAIL
PUSH P,A
CALL GMTINF ;GET VOLID FROM MONITOR
POP P,A
RLJFN% ;DUMP JFN
JFCL
RET]
GTVOLA: MOVEM P,TPDLP ;DON'T FEAR THE REPARSE
GTVOL0: MOVE A,[CM%RAI+GTVOL1] ;RAISE LOWER CASE, REPARSE ADDRESS
HRROI B,[ASCIZ/$ Enter tape ID /]
CALL CMDINI
GTVOL1: MOVE P,TPDLP ;RESTORE P IN CASE OF REPARSE
MOVEI B,[FLDDB. .CMFLD,,,<tape serial number or volume identifier,
1 to 6 alphanumeric characters long>]
CALL COMNDN ;PARSE FIELD
JRST GTVOL0 ;ERROR, TRY AGAIN
MOVEI B,[FLDDB. .CMCFM]
CALL COMNDN ;GET CONFIRMATION
JRST GTVOL0
DMOVE A,ACBFR
DMOVEM A,VOLID ;SAVE ASCIZ VERSION OF VOLID
SETZM VOLID6 ;CLEAR SIXBIT VOLID
MOVE A,[POINT 6,VOLID6]
MOVE B,[POINT 7,ACBFR]
MOVEI C,6
GTVOL3: ILDB D,B ;GET CHARACTER FROM ATOM BUFFER
JUMPN D,[SOJL C,GTVOL2 ;GIVE ERROR IF TOO LONG
SUBI D,40 ;CONVERT TO SIXBIT CODE
JUMPL D,GTVOL2
IDPB D,A ;STORE SIXBIT CHAR
JRST GTVOL3] ;CONTINUE SCAN
CAIE C,6 ;VACUOUS VOLID?
RET ;NO, ALL'S WELL
GTVOL2: TMSGC <?Bad volume identifier>
JRST GTVOL0 ;LET HIM TRY AGAIN
;SUBROUTINE TO READ RESTART FILE, DUMPER-TAPE-IN-PROGRESS, IF ANY
;RETURNS +1 IF RESTART FILE EXISTS
; +2 IF NO RESTART FILE EXISTS
RDARFL: MOVX A,GJ%OLD+GJ%SHT
HRROI B,RFSPEC ;RESTART FILE SPEC. (EXT.=TAPE ID)
GTJFN%
ERJMP [MOVEI A,.FHSLF ;[371] CURRENT PROCESS
GETER% ;[371] GET LAST ERROR
HRRZ A,B ;[371] ONLY THE ERROR CODE
CAIE A,GJFX19 ;NO SUCH FILE TYPE ERROR?, OR
CAIN A,GJFX24 ;FILE NOT FOUND ERROR?
RETSKP ;SKIP RETURN FOR NO RESTART FILE
CAIE A,GJFX18 ;NO SUCH FILENAME ERROR?
CAIN A,GJFX20 ;OR NO SUCH GENERATION ERROR?
RETSKP ;SKIP RETURN FOR NO RESTART FILE
JRST BDARFL] ;BAD RESTART FILE
MOVX B,<FLD(^D36,OF%BSZ)+OF%RD> ;36-BIT BYTE, READ ACCESS
OPENF%
ERJMP BDARFL ;BAD RESTART FILE
HRLI A,0 ;CLEAR LH
BIN% ;1ST WORD IN FILE IS TAPE#
CAME B,VOLID6 ;CHECK AGAINST REQUESTED TAPE#
JRST BDARFL ;BAD RESTART FILE
BIN% ;2ND WORD IN FILE IS SAVESET NO.
MOVEM B,ARCTSN ;(1 IF CONT., 2 AT START OF NEW TAPE)
BIN% ; 1st seq. no. of physical record
; just before new SS
MOVEM B,SPSEQ ;SAVED IN SPSEQ
PUSH P,A ;SAVE FOR CLOSE BELOW
MOVE B,ARCTSN
CAIE B,1 ;SAVESET 1 FOR CONT. SAVESET, READ ON...
JRST CLSAFL ;OTHERWISE, DONE
BIN%
MOVEM B,INIPGN ;INITIAL PAGE NO. IN CONT. FILE
BIN%
MOVEM B,INICNT ;INITIAL PAGES REMAINING IN CONT. FILE
HRROI B,XSPEC ;FILE SPEC FOR CONT. SAVESET
SETZ C, ; I.E., SPEC OF CONT. FILE
SIN% ; OR 1ST FILE FOR NEW TAPE
MOVEI A,[EXP CSCD,CSWD,CSCD,CSCD] ;POINT TO ROUTINES
CALL FILDFI ;SET UP FILE DEFAULTS
MOVE A,[.NULIO,,.NULIO] ;AS IN COMMAND, BUT FILESPEC
MOVEM A,GJBLK+.GJSRC ;IS XSPEC
MOVX A,GJ%OLD+GJ%IFG+GJ%XTN ;ALLOW STARS, CK EXTENDED BLOCK
HLLM A,GJBLK+.GJGEN
MOVEI A,GJBLK ;GTJFN BLOCK
HRROI B,XSPEC
GTJFN%
ERJMP [SETZM INIPGN ;START OVER ON FILESPEC
SETZM INICNT ; GIVEN IN SAVE COMMAND
SETZM XSPEC
JRST CLSAFL]
MOVEM A,INIJFN ;INITIAL JFN SET
HRRZ B,A ;JFN IN B FOR ADFILE
CALL ADFILE ;ADD JFN TO JFN STACK
CLSAFL: POP P,A
CLOSF%
ERCAL JSERRM
RET
BDARFL: ERROR BMBCMD, <?Bad restart file. Mark this tape as full
and use new tape for further archivals.>
SEQFND: CALL MTOPNR
PUSH P,TAPBKF ; Preserve blocking factor thru REWIND
CALL REWCV ;INITIALIZES SEQ AND RSEQ
POP P,TAPBKF
SKIPG SPSEQ ;DONE IF SPEC. SEQUENCE NO.=0
JRST [ CALL ARDELF ; Expunge restart file
CALL MTCLS
RET]
SEQFN1: CALL TSTINT
CALL MTRED ;READ A RECORD
JRST [TMSG <, record ignored.
> ;[341]
JRST SEQFN1]
MOVN A,TYP
CAIN A,TPTRX
SKIPL PAGNO ;TAPE FULL?
SKIPA ;NO
JRST [ CALL ARDELF ;YES, Expunge restart file
CALL REWCV
CALL MTCLS
ERROR BMBCMD, <?Tape full. Please mark it.>]
MOVE A,SEQ ;SEQ NO. FROM TAPE
CAMGE A,SPSEQ ; At or past SPSEQ yet?
JRST SEQFN1 ; No, keep scanning
CAME A,SPSEQ ; At SPSEQ?
JRST [ CALL MTCLS
ERROR BMBCMD,<?Tape error prevents proper positioning of tape for new saveset.
Mark this tape as full.>] ;[341]
CALL BACKSP ;BACKSPACE ONE RECORD
CALL FWRSP ;THEN ADVANCE ONE RECORD
; TO BE GOING IN RIGHT DIRECTION
CALL MTCLS
RET
SCNTAP: CALL MTOPNR
PUSH P,TAPBKF ;Preserve blocking factor thru REWIND
CALL REWCV ;INITIALIZES SEQ AND RSEQ
POP P,TAPBKF
SCNTP1: CALL MTRED ;[341] READ A RECORD
JRST [TMSG <, record ignored.
> ;[341]
JRST SCNTP1]
MOVN A,TYP
CAIN A,TPTRX
SKIPL PAGNO ;TAPE FULL?
SKIPA ;NO
JRST [ CALL REWCV ;YES
CALL MTCLS
ERROR BMBCMD, <?Tape full. Please mark it.>]
CAIE A,CTPHX ;CONTINUED SAVE SET?
CAIN A,TPHDX ;OR TAPE HEADER?
JRST [ MOVEI C,XBUFF ;[341]
LOAD B,SSNO,(C) ; Saveset no. from record header
SKIPE B ;[341] IGNORE NON ARCHIVAL SAVESETS
MOVEM B,ARCTSN ;UPDATE SAVESET#
TXOE F,TF1 ;[341] WHICH SCAN?
JRST SCNTP1 ;[341] 2ND SCAN: SCAN TO TRAILER REC
MOVE A,TAPBKF ;[341] Blocking factor determined from tape
MOVEM A,SETBKF ;[341] Set as blocking factor for tape write
PUSH P,TAPBKF ;[341] KEEP BLOCKING FACTOR
CALL REWCV ;[341] REWIND TAPE
POP P,TAPBKF ;[341]
CALLRET MTCLS] ;[341] TAPNO SET FROM 1ST REC
CAIE A,TPTRX ;TAPE TRAILER?
JRST SCNTP1 ;NO, KEEP SCANNING
MOVE B,SEQ ;[341] SEQ. NO. OF LAST RECORD
MOVEM B,SPSEQ ;[341] SAVE FOR RESTART FILE
SKIPG MTTYP ;TRAILER FOUND, UNLABELED TAPE?
CALL [ CALL BACKSP ;YES, BACK OVER TRAILER
CALL BACKSP ;[341] BACKSPACE ONE RECORD
MOVE B,SEQ ;[341] Seq. no. just before last physical
;[341] record before new savest
ADDI B,1 ;[341] Calc. 1st seq. no. on last physical
;[341] record before new SS
MOVEM B,SPSEQ ;[341] Save for restart file
CALLRET FWRSP] ;[341] ADVANCE ONE RECORD
; Now positioned for new SS
AOS ARCTSN ;NEW SAVESET NO.
CALLRET MTCLS
ARCSSN: HRROI A,SSNBUF
HRROI B,[ASCII /Save set# /]
MOVNI C,^D10 ;10 CHARACTERS ONLY
SOUT%
MOVE B,ARCTSN ;SAVESET#
MOVEI C,^D10 ;RADIX
NOUT%
JFCL
HRROI B,[ASCIZ /, Archive Tape/]
MOVE C,COLSW
CAIN C,1 ; Collection?
HRROI B,[ASCIZ /, Collection Tape/]
CAMN C,[-1] ; Or migration?
HRROI B,[ASCIZ /, Migration Tape/]
SETZ C,
SOUT%
RET
WRARFL: MOVX A,GJ%SHT
HRROI B,RFSPEC ;RESTART FILE SPEC. (EXT.=TAPE ID)
GTJFN%
ERJMP BDWRFL
MOVX B,<FLD(^D36,OF%BSZ)+OF%WR>
OPENF%
ERJMP BDWRFL
HRLI A,0 ;CLEAR LH
MOVE B,VOLID6 ;1ST WORD OF FILE IS TAPE NO.
BOUT%
MOVE B,ARCTSN ;2ND WORD IS SAVESET NO.
BOUT%
MOVE B,SPSEQ ; 1st seq. no. of last physical
BOUT% ; record before new saveset
PUSH P,A ;SAVE FOR CLOSF BELOW
SKIPN XSPEC ;CONTINUED SAVESET?
JRST CLSWFL ;NO, WRITE IS COMPLETE
MOVE B,INIPGN ;REMAINING PAGES IN CONT. FILE
BOUT%
MOVE B,INICNT ;PAGE LOC. IN CONT. FILE
BOUT%
HRROI B,XSPEC ;FILESPEC OF CONT. SAVESET
SETZ C,
SOUT%
CLSWFL: POP P,A
CLOSF%
ERJMP BDWRFL
RET
BDWRFL: ERROR BMBCMD,<?Cannot create restart file>
;FOR ARCHIVE/MIGRATION/COLLECTION RUN, TEST FILE FOR INCLUSION ON THIS TAPE
;RETURNS +1 FOR NO DUMP
; +2 FOR OK TO DUMP
ARCTST: SKIPE INIPGN ;CONT. FILE?
RETSKP ;YES, GO ON WITH DUMP
MOVE B,FDB+.FBCTL
TXNE B,FB%OFF ; File offline?
RET ; Yes, skip it
SKIPN ARCSW ; Archive run?
JRST ARCTS1 ; No, must be Migration/Collection
MOVE B,FDB+.FBBBT
TXNN B,AR%RAR ; Archive requested?
RET ; No, skip it
JRST ARCTS3 ; Yes, go on with check
ARCTS1: MOVE B,FDB+.FBBBT
TXNE B,AR%RIV ; Migration request?
JRST ARCTS3 ; Explict request, cont. with test
SKIPG COLSW ; We taking expired files? (Collection)
RET ; No, bypass the file
TXNE B,AR%RAR ; Archive requested already?
RET ; Yes, skip it
HLRZ B,FDB+.FBNET ; Get online expiration
HLRZ A,BGNTAD ; Get day at start of COLLECTION run
CAIGE A,(B) ; File expired?
RET ; No (& does have exp. date)
JUMPN B,ARCTS2 ; Expired date if non-zero--dump it
MOVE A,FDB+.FBCRE ; Interval, find most recent date
CAMG A,FDB+.FBCRV
MOVE A,FDB+.FBCRV
CAMG A,FDB+.FBWRT
MOVE A,FDB+.FBWRT
CAMG A,FDB+.FBREF
MOVE A,FDB+.FBREF
HRRZ B,FDB+.FBNET ; Get the interval
HLRZS A
ADD B,A ; Form expiration date
HLRZ A,BGNTAD ; Get day at start of COLLECTION run
CAIG A,(B) ; Expired?
RET ; No, skip it
ARCTS2: SKIPN XPRARC ;[400] ARCHIVE-ONLINE-EXPIRED-FILES?
JRST ARCTS3 ;[400] No, continue.
CALL NSETS ;[400] DETERMINE ARSETS=NO. SETS TAPE INFO
JUMPN A,ARCTS3 ;[400] Cannot change to ARCHIVE between tapes
MOVE A,JFN ;[400] ARCHIVE THE FILE
MOVEI B,.ARRAR ;[400]
MOVEI C,.ARSET ;[400]
ARCF% ;[400]
ERJMP [TMSGC <%Unable to ARCHIVE COLLECTED file: > ;[400]
HRROI B,NAMBUF ;[400]
CALL TMSGQ ;[400]
CALLRET TCRLF ] ;[400] Skip file on error
RET ;[400] Return, ARCHIVE requested
ARCTS3: CALL NSETS ;DETERMINE ARSETS=NO. SETS TAPE INFO
MOVE B,FDB+.FBBBT
TXNE B,AR%1ST ;IF AR%1ST ON, IGNORE INVALID TAPE INFO
JRST [ SOS A,ARSETS ;CORRECT ARSETS FOR IGNORED SET
SKIPGE ARSETS
SETZB A,ARSETS ;ENSURE ARSETS>=0
JRST .+1]
CAIN A,2 ;ARSETS=2,I.E., 2 SETS TAPE INFO?
JRST [ MOVE B,FDB+.FBCTL
TXNE B,FB%ARC ; File archived?
SKIPN ARCSW ; And during archive run?
RET ; No, just skip it (REAPER will take it)
CALLRET OLDARC] ; Yes, complain and skip it
CAIE A,1 ;NOW ARSETS=0 FOR 1ST RUN,=1 FOR SECOND
RETSKP ;FINISHED IF 1ST RUN
MOVE B,FDBARC+.ARTP1 ;FOR 2ND RUN, CHECK FIRST TAPE NO.
CAME B,VOLID6 ;1ST TAPE # = 2ND TAPE #?
RETSKP ;NO, OK TO DUMP
RET ;YES, DEFER DUMP TILL ANOTHER TAPE
OLDARC: CALL GOFNAM ;GET TAPE FILE NAME SET
TMSGC <%File >
MOVE B,ONMPTR ;POINTER TO FILENAME INCL. DIR.
CALL TMSGQ
TMSG < skipped because:
Already marked as having two valid tape copies.
>
RET
;FOR ARCHIVE/COLL./MIG. RUN, SET TAPE INFO AND AR%1ST
ARC1: CALL ARSST0 ;SET UP ARG BLOCK FOR .ARSST
MOVE A,JFN
HRLI A,.FBBBT ;SET AR%1ST IN .FBBBT
MOVX B,AR%1ST ;TO MARK 1ST PASS OF ARC./COL./MIG. RUN
MOVE C,B ;IN PROGRESS
CHFDB%
MOVEI B,.ARSST ;CODE FOR SET ARCHIVE STATUS
MOVEI C,ARSSTB ;ARG BLOCK FOR .ARSST
ARCF% ;SET ARCHIVE STATUS
MOVEI B,.ARGST ;READ TAPE INFO JUST SET
MOVEI C,FDBARC ;INTO FDBARC FOR USE IN TAPE WRITE
ARCF%
MOVX B,AR%1ST+AR%RAR+AR%RIV ;WRITE FDB ON TAPE AS IF THE ARCHIVE
ANDCAM B,FDB+.FBBBT ;RUN HAD COMPLETED SUCCESSFULLY
RET
NSETS: SETZB A,ARSETS ; Assume none
SKIPE FDBARC+.ARTP1 ; First one there?
AOS A,ARSETS ; Yes, note that
SKIPE FDBARC+.ARTP2 ; How about the 2nd tape?
AOS A,ARSETS ; That one too
RET
ARSST0: SETZM ARSSTB+.AROFL ; Set up blk - use not for tape write
SETZM ARSSTB+.ARODT
MOVX B,AR%ARC ; Flag archive?
SKIPE ARCSW
MOVEM B,ARSSTB+.AROFL ; Yes
SKIPE ARSETS ;FIRST ARCHIVE RUN?
JRST ARCP2 ;NO
MOVX B,AR%O1 ;YES, IN 1ST TAPE SLOTS
IORM B,ARSSTB+.AROFL ;FLAG FIRST RUN
MOVE B,TOTFIL ;TAPE FILE NUMBER
ADDI B,1 ; TOTFIL WILL BE INC'D BY TIME IS WRITTEN
HRRM B,ARSSTB+.ARSF1
MOVE B,ARCTSN ;TAPE SAVE SET NUMBER
HRLM B,ARSSTB+.ARSF1
MOVE B,VOLID6 ;TAPE NUMBER
MOVEM B,ARSSTB+.ARTP1
RET
ARCP2: MOVX B,AR%O2
IORM B,ARSSTB+.AROFL ;FLAG SECOND RUN
MOVE B,TOTFIL ;TAPE FILE NUMBER
ADDI B,1 ; TOTFIL WILL HAVE BEEN INC'D BY TIME WRITTEN
HRRM B,ARSSTB+.ARSF2
MOVE B,ARCTSN ;TAPE SAVE SET NUMBER
HRLM B,ARSSTB+.ARSF2
MOVE B,VOLID6 ;TAPE NUMBER
MOVEM B,ARSSTB+.ARTP2
RET
;REMOVE ONE SET TAPE INFO FROM FDB IF AR%1ST IS SET
;DOES NOT UPDATE TAPE INFO IN MEMORY AFTER REMOVAL FROM FDB
UNARC: MOVE A,JFN
MOVE B,[1,,.FBBBT] ;GET CURRENT FLAG BITS
MOVEI C,B ; INTO B
GTFDB%
ERCAL JSERRR ;[307] FAILED, TYPE JSYS ERROR AND RETURN
TXNN B,AR%1ST ;TAPE INFO VALID?
RET ;YES
MOVEI B,.ARGST ; Get the tape info
MOVEI C,FDBARC ; Put with other FDB info
ARCF%
CALL NSETS ;NO. OF SETS TAPE INFO IN A
JUMPE A,R ; None?
MOVX C,AR%CR1 ;RUN 1:CLEAR THAT INFO
CAIN A,2 ;RUN 2?
MOVX C,AR%CR2 ;YES: CLEAR ONLY RUN 2 INFO
MOVEI B,.ARDIS ;DISCARD TAPE INFO
MOVE A,JFN
ARCF%
ERJMP [TMSGC <?Unable to discard invalid tape backup information.
>
RET]
HRLI A,.FBBBT ;DISCARD SUCCEEDED: TURN OFF AR%1ST
MOVX B,AR%1ST
SETZ C,
CHFDB%
ERJMP [TMSGC <?Unable to clear AR%1ST after discarding tape information.
>
RET]
RET
ARFXBK: MOVE A,P2JFN
HRLI A,.FBBK0+CF%NUD_-^D18 ;[330] NO UPDATE DIRECTORY
HRLZI B,-1 ;[330] CHANGE LEFT HALF ONLY
SETZ C, ;[330] TO ZERO
CHFDB% ;[330]
ERJMP R ;[330] FAILURE: SKIP THIS FILE
MOVE A,P2JFN ;[330]
HRLI A,.FBBBT ;SET AR%1ST TO ZERO
MOVX B,AR%1ST ;CHANGE JUST THIS BIT
SETZ C, ;TO 0
CHFDB%
ERJMP R ;FAILURE: SKIP THIS FILE
ANDCAM B,FDB+.FBBBT
CALL NSETS ;DETERMINE ARSETS= #SETS ARCH INFO
CAIE A,2 ;2ND RUN?
RET ;NO, DONE
MOVE C,FDB+.FBBBT ; Get backup bits
TXNE C,AR%NDL ; Delete on disk not allowed?
JRST ARFXB1 ; Right, skip delete
MOVX A,DF%CNO!DF%NRJ ;Delete disk contents only
HRR A,P2JFN
DELF%
ERJMP [MOVX B,AR%NDL
IORM B, FDB+.FBBBT
JRST .+1]
ARFXB1: MOVE A,P2JFN ;GET JFN
MOVX B,.ARRAR ;CODE FOR SET/CLEAR ARCH REQUESTS
MOVE C,FDB+.FBBBT
TXNE C,AR%RIV
MOVEI B,.ARRIV ; Migration request
MOVEI C,.ARCLR ; Clear it
ARCF%
ERJMP [TMSGC <?Unable to clear archive/migration request bit after migration to tape complete.
>
JRST .+1]
MOVE D,FDB+.FBBBT ; Get who archived it
HRLI A,.FBCTL
MOVX B,FB%INV ; Change invisible bit
MOVE C,B
TXNN D,AR%NDL ;FLUSH NOT ALLOWED?
TXNN D,AR%RAR ; User request the archive?
CAIA ;FILE MADE INVISIBLE ONLY IF
CHFDB% ;FLUSHED & USER REQUESTED ARCHIVE
ERJMP .+1 ;FAILURE SHOULD NOT BE DISASTROUS
HRRZ A,P2JFN ; JFN for file being messed with
MOVE B,FDB+.FBBBT ; Get old back up words
ANDX B,AR%NDL ; Save only that bit (flag for ARMSUS)
CALL ARMSUS ; Message to user about this file
CALL USAINI ; Init USAGE block here
HRRZ A,P2JFN ;[347] Get the JFN
MOVSI B,.FBLN0 ;[347] Want all of the FDB
MOVEI C,FDB ;[347] And put it in FDB
GTFDB% ;[347] And get it!
MOVX A,.UTARC
SKIPGE COLSW ; -1=migration
MOVX A,.UTMIG
SKIPLE COLSW ; 1=collection
MOVX A,.UTCOL
HRRM A,USABLK ; Store entry type
LOAD A,AR%PSZ,FDB+.FBBBT ;[347] Get # pages that were in the file
MOVEM A,USABLK+10
MOVEI A,FDBARC ; Point to tape info blk
CALL USATAP ; And spray it into the USAGE blk
LOAD B,AR%RSN,FDB+.FBBBT ; Get reason off-line code
MOVEM B,USABLK+26 ; Add reason code to blk
HRRZ B,P2JFN ; JFN of file in question
HRROI A,USASTR ; Structure of the file
MOVX C,<FLD(.JSAOF,JS%DEV)>
JFNS%
HRROI A,USADIR
MOVX C,<FLD(.JSAOF,JS%DIR)>
JFNS%
MOVE A,B ; JFN
HRROI B,USAACT ; Account of the file
GACTF%
CAIA ; Error, ignore it
JRST .+2 ;[347] Second return not accounted for before.
JRST [ MOVEM B,USABLK+2 ;[347] We somehow got a numeric account in
MOVX B,US%IMM ;[347] the rearranged the rdb.
IORM B,USABLK+1 ;[347] Mark as an immediate quanity
JRST .+1]
MOVEI A,USASTR ;GET ASCIZ STRUCTURE NAME
HRLI A,(POINT 7,)
MOVEI B,USASSI ;PUT SIXBIT STRUCTURE NAME INTO
CALL SEVSIX ; USASSI
MOVEI A,.USENT
MOVEI B,USABLK
USAGE%
ERJMP [TMSGC <%USAGE entry failed in ARFXBK
>
JRST .+1]
RET
;FOR ARCHIVE RUN, END-OF-TAPE FUNCTIONS
XINFO: TMSG < This >
CALL PRTTYP ; Print archive/collection/migration
TMSG < run will be continued onto another tape.
>
HRROI A,XSPEC ;FILESPEC AT TAPE SWITCH
MOVE B,JFN ;CURRENT FILE, TO BE CONT.
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS%
HRROI A,XDIR ;STR:DIRECTORY AT TAPE SWITCH
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS%
RET
PRTTYP: HRROI B,[ASCIZ/archive/]
SKIPE ARCSW
JRST TMSGQ
HRROI B,[ASCIZ/collection/]
SKIPL COLSW
JRST TMSGQ
HRROI B,[ASCIZ/migration/]
JRST TMSGQ
ARDELF: MOVX A,GJ%SHT
HRROI B,RFSPEC ;RESTART FILE SPEC. (EXT.=TAPE ID)
GTJFN%
ERJMP DELBMB
HRLI A,0
TXO A,DF%EXP ;DELETE AND EXP
DELF% ;OLD RESTART FILE
ERJMP DELBMB
RET
DELBMB: TMSGC <%Failed in attempt to delete restart file: >
HRROI B,RFSPEC ;RESTART FILE SPEC. (EXT.=TAPE ID)
CALL TMSGQ
TMSG <
IMPORTANT: Make sure this file does NOT remain on the system.
>
RET
SUBTTL PSEUDO INTERRUPT ROUTINES
CHNMSK: 1B<CECHN>+1B<CFCHN>+1B<QSRCHN>+1B<VSCHN>+1B<.ICPOV>+1B<.ICDAE>+17B<.ICIEX>+1B<.ICMSE>+1B<.ICQTA> ;CHANNELS USED
CFINT: MOVEM 17,INT3AC+17 ;[361] SAVE ACS
MOVEI 17,INT3AC ;[361]
BLT 17,INT3AC+16 ;[361]
MOVE P,[IOWD NINTPD,INT3PD];[361] interrupt PDL
SKIPN CEXFLG ;[361]
JRST [ TMSGC <%No interruptible command in progress.
>
JRST CFINT1] ;[361]
SKIPE INTRQ ;[361]
JRST [ TMSGC <%Interrupt request already in progress.
>
JRST CFINT1] ;[361]
SKIPN WORKING ;[361] if we are not actually doing something
JRST LSFIL ;[361] just print last file seen
MOVE B,STABLK ;[361] Get what we are doing
CAIN B,S.REST ;[361] Are we RESTORing?
JRST RESTO ;[361] Yes
CAIE B,S.SAVE ;[361] No, are we SAVEing?
JRST CFINT1 ;[361] Nope, skip it.
TMSGC <Saving > ;[361]
HRROI B,NAMBUF ;[361]
CALL TMSGQ ;[361] Filespec being dumped
TXNN F,DIRCHG ;[361] <Input> same as <Output>
JRST CFINT2 ;[361] Yes..
TMSG < as > ;[361]
HRROI B,ONMBUF ;[361] Filespec being saved as
CALL TMSGQ ;[361]
CALL TCRLF ;[361]
JRST CFINT1 ;[361] Go home
RESTO: TMSGC <Restoring > ;[361]
MOVE B,[POINT 7,LSTRD]
RESTO1: ILDB A,B ;[361] SCAN FILESPEC
CAIN A,";" ;[361] END OF GENERATION?
SETZ A, ;[361] YES, USE NULL
JUMPN A,RESTO1 ;[361] JUMP IF NOT END OF STRING
DPB A,B ;[361] TIE OFF STRING
HRROI B,LSTRD ;[361] File name on tape
CALL TMSGQ ;[361]
TMSG < as > ;[361]
HRROI B,ONMBUF ;[361] File name we are restoring it as.
CALL TMSGQ ;[361]
CALL TCRLF ;[361]
JRST CFINT1 ;[361]
LSFIL: TMSGC <Last file seen: >
MOVE B,[POINT 7,LSTRD]
LSFIL1: ILDB A,B ;[361] SCAN FILESPEC
CAIN A,";" ;[361] END OF GENERATION?
SETZ A, ;[361] YES, USE NULL
JUMPN A,LSFIL1 ;[361] JUMP IF NOT END OF STRING
DPB A,B ;[361] TIE OFF STRING
HRROI B,LSTRD ;[361] Get last file we saw on tape
CALL TMSGQ ;[361] Print it
CFINT2: CALL TCRLF ;[361]
CFINT1: MOVSI 17,INT3AC ;[361] Restore ACs
BLT 17,17 ;[361]
DEBRK% ;[361]
;TERMINAL INTERRUPT - ^E
CEINT: MOVEM 17,INT3AC+17 ;SAVE ACS
MOVEI 17,INT3AC
BLT 17,INT3AC+16
MOVE P,[IOWD NINTPD,INT3PD]
SKIPN CEXFLG ;EXECUTING COMMAND?
JRST [ TMSGC <%No interruptible command in progress.
>
JRST CEINT1]
SKIPE INTRQ ;ALREADY REQUEST PENDING?
JRST [ TMSGC <%Interrupt request already in progress.
>
JRST CEINT1]
TMSG <
Interrupting...
>
SETOM INTRQ ;REQUEST INTERRUPT
MOVEI A,.PRIIN ;[312] POINT TO TTY
CFIBF% ;[312] CLEAR USER TYPEAHEAD
CEINT1: MOVSI 17,INT3AC ;RESTORE ACS
BLT 17,17
DEBRK%
;TEST FOR INTERRUPT REQUEST, RETURN IMMEDIATELY IF NONE.
;OTHERWISE, ENTER COMMAND INPUT AND RETURN WHEN 'CONTINUE' GIVEN
TSTINT: SKIPN INTRQ ;INT REQUEST?
RET ;NO
POP P,INTPC ;YES, SAVE PC AND NOTE INTERRUPTED
MOVE A,CMDTYP ;GET CURRENT COMMAND TYPE
TXNN A,TY%DBL ;SKIP IF SAVE OR RESTORE COMMAND
SETZM NIJFN ;DON'T SAVE JFNLST POINTER
MOVEM A,ICMDTY ;SAVE AS INTERRUPTED COMMAND TYPE
MOVEM P,IPDLP ;SAVE PUSH DOWN POINTER
SETZM INTRQ ;CLEAR INTERRUPT REQUEST
MOVE A,CURPTR
MOVEM A,CMDPTR
SETZM CEXFLG ;COMMAND NO LONGER IN PROGRESS
MOVE A,TRAPJ ;GET TRAP STUFF
MOVEM A,ITRAPJ ;SAVE TRAP STUFF
MOVE A,TRAPSP ;..
MOVEM A,ITRAPS ;..
JRST RESTRT ;GO TO COMMAND LEVEL
;'CONTINUE' COMMAND
$CONT: CALL CONFRM
SKIPN INTPC ;WERE INTERRUPTED?
ERROR RESTRT,<?Cannot continue>
MOVE A,ICMDTY ;GET INTERRUPTED COMMAND TYPE
MOVEM A,CMDTYP ;AND RESTORE
SETZM ICMDTY ;INDICATE NO INTERRUPTED COMMAND
MOVE A,ITRAPJ ;RESTORE TRAP STUFF
MOVEM A,TRAPJ ;...
MOVE A,ITRAPS ;...
MOVEM A,TRAPSP ;...
MOVE A,INIPTR ;RESET CMDPTR
MOVEM A,CMDPTR ;...
MOVE P,IPDLP ;RESTORE PDL
SETOM CEXFLG ;YES, NOTE RESUMING EXECUTION
MOVE A,INTPC ;GET PC
SETZM INTPC ;ZERO INTERRUPT PC
JRST 0(A) ;RETURN TO POINT OF INTERRUPTION
;LABELED-TAPE VOLUME-SWITCH INTERRUPT
VSINT: MOVEM 17,INT3AC+17 ;SAVE ACS
MOVEI 17,INT3AC
BLT 17,INT3AC+16
MOVE P,[IOWD NINTPD,INT3PD]
MOVE A,MTJFN ;GET JFN
CALL GMTINF ;UPDATE VOLID
SETZM RSEQ ;RESET RECORD SEQUENCE NUMBER
JRST CEINT1
;UNEXPECTED TRAP LOGIC
;SET FENCE FOR TRAPS
; A/ WHERE TO GO IF UNEXPECTED TRAP
SETTRP: POP P,CX ;GET LOCAL PC OFF STACK
PUSH P,TRAPJ ;SAVE PREVIOUS FENCE
PUSH P,TRAPSP
MOVEM A,TRAPJ ;SAVE DISPATCH
MOVEM P,TRAPSP ;SAVE STACK FENCE
SETTR1: PUSHJ P,0(CX) ;CONTINUE ROUTINE
SKIPA ;NO SKIP RETURN
AOS -2(P)
POP P,TRAPSP ;RESTORE PREVIOUS FENCE
POP P,TRAPJ
RET
;UNEXPECTED TRAP HANDLERS
;ILLEG INSTRUCTION
ITRAP: JSR EINT1 ;SWITCH CONTEXT
SKIPE TRAPJ ;TRAP FENCE?
JRST ITRAP1 ;YES - SKIP SYSTEM MESSAGE
TMSGC <?>
CALL JSERRM ;DO JSYS ERROR MESSAGE
ITRAP1: SKIPE A,TRAPJ ;HAVE TRAP FENCE?
JRST [ MOVEM A,INT1AC+CX ;YES, SETUP DISPATCH ADDRESS
CALL TCRLF
MOVE A,TRAPSP ;AND RESET STACK TO FENCE
MOVEM A,INT1AC+P
MOVEI A,SETTR1 ;DEBREAK ADDRESS
JRST BADIXP]
TMSG < Command aborted
>
MOVE A,[ICBLK,,CBLK] ;[376] INIT COMMAND STATE BLOCK
BLT A,CBLK+.CMGJB ;[376]
MOVEI A,BMBCMD ;DEBREAK TO BOMB COMMAND
BADIXP: MOVEM A,LPC1 ;SET DEBREAK ADDRESS
BADIX: MOVSI 17,INT1AC ;RESTORE ACS
BLT 17,17
DEBRK%
BADINT: TMSG <?PC = >
HRRZ B,LPC1
MOVEI C,^D8
CALL TTNOUT ;PRINT PC
CALL TCRLF
JRST ITRAP1
;HERE IF NO RECOVERY
BADEX: HALTF%
JRST .-1 ;CANT CONTINUE
;MEMORY READ TRAP
MEMRTP: JSR EINT1 ;SWITCH CONTEXT
TMSGC <?Unexpected memory read trap in DUMPER
>
BADIVA: TMSG <?VA = >
MOVEI A,.FHSLF ;GET ADDRESS OF BAD REFERENCE
GTRPW%
HRRZ B,A
MOVEI C,^D8
CALL TTNOUT ;REPORT IT
CALL TCRLF
JRST BADINT ;CONTINUE AS FOR ITRAP
;MEMORY WRITE, EXECUTE TRAPS
MEMWTP: JSR EINT1 ;SWITCH CONTEXT
TMSGC <?Unexpected memory write trap in DUMPER
>
JRST BADIVA
MEMXTP: JSR EINT1 ;SWITCH CONTEXT
TMSGC <?Unexpected memory execute trap in DUMPER
>
JRST BADIVA
;MACHINE SIZE EXCEEDED OR DISK QUOTA EXCEEDED
MSETRP: JSR EINT1 ;SWITCH CONTEXT
TMSGC <?Disk full or quota exceeded.>
SKIPE RETSW ;RETRIEVING?
JRST ITRAP1 ;YES, TAKE TRAP
TMSG < Type <CR> to attempt to continue >
CALL RDLIN
MOVE A,LPC1 ;GET FAILING PC
TXNN A,PC%USR ;[377] FAILED IN MONITOR
JRST BADIX ;[377] YES, DEBREAK
MOVE A,-1(A) ;GET FAILING JSYS
CAMN A,[PMAP%] ;FAILED IN PMAP?
SOS LPC1 ;YES, CHANGE PC TO RETRY PMAP FROM START
JRST BADIX ;DEBREAK WITHOUT CHANGING PC
;PDL OVERFLOW
PDLOV: JSR EINT1 ;SWITCH CONTEXT
TMSGC <?PDL overflow trap in DUMPER
>
JRST BADINT
;SETUP LEVEL 1 PSI CONTEXT
; JSR EINT1
EINT1A: MOVEM 17,INT1AC+17 ;SAVE ACS
MOVEI 17,INT1AC
BLT 17,INT1AC+16
MOVE P,[IOWD NINTPD,INT1PD] ;SETUP LOCAL STACK
JRST @EINT1
LEVTAB: LPC1
LPC2
LPC3
CHNTAB: PHASE 0
0
CECHN:! 3,,CEINT ;^E
QSRCHN:!3,,QSRINT ;IPCF Msg from QUASAR recv'd
VSCHN:! 3,,VSINT ;LABELED TAPE VOLUME SWITCH
CFCHN:! 3,,CFINT ;FILE INFORMATION
0
0
0
0
1,,PDLOV ;STACK OVERFLOW
0
2,,MEMERR ;FILE DATA ERROR
1,,MSETRP ;QUOTA EXCEEDED
0
0
1,,ITRAP ;ILLEG INSTRUCTION TRAP
1,,MEMRTP ;MEM READ
1,,MEMWTP ;MEM WRITE
1,,MEMXTP ;MEM XCT
0
1,,MSETRP ;MACHINE SIZE EXCEEDED
REPEAT ^D35-.ICMSE,<0>
DEPHASE
;PSI RECEIVED ON IO ERROR CHANNEL
MEMERR: MOVEM P,INT2AC+17
MOVEI P,INT2AC
BLT P,INT2AC+16
MOVE P,[IOWD NINTPD,INT2PD] ;SETUP LOCAL STACK
PUSH P,40
MOVE A,LASTID
CAMN A,LSTERO
JRST MEMXIT
MOVEM A,LSTERO
BTMSGC <?Disk error in file >
HLRZ A,LASTID
GTSTS%
TLNN B,(1B10)
JRST [ BTMSG <(Unknown file name)>
JRST MEMERZ]
HRROI B,NAMBUF
CALL BTMSGQ ;TYPE FILE NAME
HRRZ B,LASTID ;GET PAGE NUMBER
CAIN B,-1 ;ON OPENF?
JRST [ BTMSG <, page table>
JRST MEMERZ]
BTMSG <, page >
HRRZ B,LASTID
MOVEI C,^D10
CALL TTNOUT ;TYPE PAGE NUMBER
CALL LPNOUT ;PRINT "
MEMERZ: BTMSG <
>
MEMXIT: POP P,40
MOVSI P,INT2AC
BLT P,P
DEBRK%
SUBTTL LOAD AND CHECK
LIT1: FLDDB. (.CMFIL,CM%SDH,,<file group descriptor>,,LIT2)
LIT2: FLDDB. (.CMCMA,,,,,LIT3)
LIT3: FLDDB. (.CMCFM)
CHCK: SETOM CHECK ;CHECK command
SETZM RETSW ;NOT RETRIEVING
SETOM NJFN1 ;FAKE ACTIVE JFN
HRROI A,[ASCIZ/ALL TAPE FILES/]
CALL NOISE
JRST LOAD2
$RETRI: SKIPN WHEEL
ERROR BMBCM1,<?RETRIEVE requires WHEEL or OPERATOR capabilities enabled>
SETOM RETSW ; Flag we're doing retrievals
TXZ F,USRDAT ; No user data from arc/col/mig tapes
TXOA F,LFILF ; Cause file names to print AND SKIP
$LOAD: SETZM RETSW ;NOT RETRIEVING
SETZM CHECK
SETZM LDSALL ;Not searching all savesets
SETOM LODARC ;Default is to load archive info
SKIPN RETSW ;[361] Are we doing retrievals?
JRST [ MOVX A,S.REST ;[361] Nope, flag we are doing a RESTORE
MOVEM A,STABLK ;[361] Store it.
JRST .+1] ;[361]
HRROI A,[ASCIZ/TAPE FILES/]
SKIPE RETSW ;Doing retrievals?
HRROI A,[ASCIZ/FILES/] ;YES
CALL NOISE
CALL GETCON ;SAVE CONNECTED DIRECTORY
SKIPE ICMDTY ;SKIP IF NOT UNDER ^E
SKIPN Q1,NIJFN ;PICK UP OLD POINTER, IF ANY
MOVSI Q1,-NJFNL+1 ;INIT PTR TO JFN LIST
LOAD1: MOVEI A,[EXP CSCD,CSWD,WSWD,WSWD] ;POINT TO ROUTINES
CALL FILDFI ;SETUP DEFAULT FILE SPEC
HRROI A,[ASCIZ/DSK*/]
SKIPE RETSW ;RETRIEVING?
MOVEM A,GJBLK+.GJDEV ;YES, DEFAULT STRUCTURE TO DSK*:
MOVX A,GJ%OFG ;SET PARSE-ONLY FOR GTJFN
HLLM A,GJBLK+.GJGEN
MOVEI A,CBLK
MOVEI B,[FLDDB. .CMSWI,,LSWTB,,,FILCDB]
SKIPE RETSW ;RETRIEVING?
MOVEI B,FILCDB ;YES, DON'T ALLOW SWITCHES
COMND%
TXNE A,CM%NOP
ERRORJ BMBCM1,<?Not a switch or filespec>
LOAD C,CM%FNC,0(C) ; Get code of block used
CAIE C,.CMSWI ; A switch?
JRST LOADF ; No, must be a file name
HRRZ B,0(B) ; Get dispatch
JRST 0(B) ; Do it
; Switch table
LSWTB: NLSWTB,,NLSWTB
TB $NOARC,<NOTAPE-INFORMATION>
REPEAT 0,<
TB $SRALL,<SEARCH-ALL-SAVESETS>
>;END REPEAT 0
TB $LOARC,<TAPE-INFORMATION>
NLSWTB==.-LSWTB-1
$SRALL: SETOM LDSALL ; Search all savesets on tape
JRST LOAD1
$LOARC: SETOM LODARC ; Do load tape info
JRST LOAD1
$NOARC: SKIPE RETSW ; Doing a retrieval?
ERROR BMBCM1,<?Cannot suppress tape information for a retrieval>
SETZM LODARC ; Flag NO tape info
JRST LOAD1
LOADF: CALL ADLIST ;ADD FILE TO JFNSTACK
JUMPGE Q1,[ERROR (BMBCM1,<?Too many items in filespec list>)]
MOVEM B,JFNLST(Q1) ;SAVE A JFN
SETZM JF2LST(Q1)
AOBJN Q1,.+1
SKIPE RETSW ; Doing retrievals?
JRST LOAD2 ; Yes, we already have output names
HRROI A,[ASCIZ/TO/]
CALL NOISE
CALL OFNAME ;SETUP OUTPUT DEFAULTS
MOVX B,GJ%OFG
HLLM B,GJBLK+.GJGEN
MOVX B,.GJNHG
TXNE F,SSA ;SUPERSEDE ALWAYS?
HRRM B,GJBLK+.GJGEN ;YES, DEFAULT GEN IS NEXT HIGHER
MOVEI B,LIT1
MOVEI A,CBLK ;POINT TO COMMAND BLOCK
COMND% ;GET MORE FILESPECS OR TERMINATOR
TXNE A,CM%NOP
ERRORJ BMBCM1,<?Invalid file group descriptor>
LOAD C,CM%FNC,0(C) ;GET CODE USED
CAIN C,.CMCMA ;COMMA?
JRST LOAD1 ;YES, ANOTHER SOURCE SPEC
CAIE C,.CMCFM ;TERMINATED?
JRST [ CALL ADFILE ;ADD JFN TO JFN STACK
MOVEM B,JF2LST-1(Q1) ;NO, OUTPUT FILESPEC. SAVE JFN
MOVEI B,[FLDDB. (.CMCMA,,,,,[FLDDB. .CMCFM])]
COMND%
TXNE A,CM%NOP ;COMMA OR CR?
ERROR BMBCM1,<?Not a comma or carriage return>
LOAD C,CM%FNC,0(C) ;YES, SEE WHICH
CAIE C,.CMCFM
JRST LOAD1 ;COMMA, DO MORE
JRST .+1] ;CR, DONE
CALL JFNCFM ;FIX UP JFN STACK FOR CONFIRM
MOVEM Q1,NIJFN ;SAVE IN CASE OF ^E
HRRZM Q1,NJFN1 ;SAVE NUMBER ACTIVE JFNS
MOVNI Q1,0(Q1) ;SAVE NUMBER OF JFNS SETUP
MOVEM Q1,NJFN
JRST LOAD3
LOAD2: CALL CONFRM
LOAD3: TXNN F,TNSF ;SKIP IF TAPE NUMBER SET
SETZM RTAPNO
MOVSI B,-1 ;GET LARGE NEGATIVE NUMBER
MOVEM B,TOTFIL ;INDICATE DON'T HAVE FILE NUMBER YET
SETZM LSTDIR ;NO LAST DIRECTORY
SETOM CDIRN ;NO CONNECTED DIR NOW
TXZ F,TF2 ;CLEAR THIS (NO FILE YET)
SKIPN RETSW ; Some more special code for retrieves?
JRST LODFI1 ; No, go on with the load
CALL QSRINI
ERROR (CDONE,<Retrievals cannot be processed at this time>)
CALL NXTRET ; Get the first of them
ERROR (CDONE,<No retrievals match the specified file descriptor>)
LOAD21: JUMPE P6,LDFLND ; Done?
CALL RETTAP ; Ask for the tape to be mounted
JUMPE P6,LDFLND ; May have been unavailable
; ..
;BEGIN LOADING OF A TAPE
LODFI1: SETOM CEXFLG ;[326] ALLOW INTERRUPT
CALL MTOPNR ;[326]
LODFI2: TXZN F,TNSF ;[326] SKIP IF TAPE NUMBER SET
AOS RTAPNO ;COUNT TAPES
CALL TCRLF
CALL MTRED
JRST [ TMSG < in tape header, record skipped
>
JRST LODHX1]
MOVN A,TYP ;GET RECORD TYPE
CAIE A,TPHDX ;TAPE HEADER?
CAIN A,CTPHX ; OR CONTINUATION
CAIA ;YES, PROCEED
ERROR LODHX2,<%Tape does not start with header, continuing...>
SKIPN RETSW ; Retrievals are quiet
CALL TYHEDR ;TYPE HEADER INFO
MOVEI B,XBUFF
LOAD A,SSNO,(B) ; Saveset # non-0 for arch./col. tape
JUMPN A,[ SKIPN WHEEL ; Must be an enabled WHEEL
ERROR BMBCMD,<?WHEEL or OPERATOR capabilities required to
restore from an archive or virtual disk tape>
SKIPE RETSW ; Doing a retrieval?
JRST .+1 ; Yes, proceed
TMSG <$This tape is an archive or virtual disk tape.
It should not be used to restore files.
This action may breach the security of the system.
>
HRROI A,[ASCIZ /$Are you sure you should do this? /]
CALL YESNO
JUMPE A,BMBCM1 ; Said no, exit
SETZM LODARC ; No archive info from the tape
TMSGC <%Files being restored without tape information
>
JRST .+1]
HRRZ A,TAPNO ; Tape # in RH on tape
SKIPN RTAPNO ;TAPE # KNOWN?
MOVEM A,RTAPNO ;NO, THEN THIS IS IT
SKIPN RETSW ;NO TAPE# CHECK IF RETRIEVING
CAMN A,RTAPNO ;RIGHT TAPE # MOUNTED?
JRST LODHX1 ;YES, PROCEED WITH LOAD
TXNN F,TF2 ;WRONG TAPE #, IN MIDDLE OF FILE?
JRST LODHX5 ;NO
TMSGC <?Tapes not in order, cannot restore continued file >
HRROI B,TFNAME ;FILE NAME
CALL TMSGQ ;TYPE FILE NAME
CALL MTCLS ;CLOSE MTA
TMSGC <%Mount correct tape>
SKIPL MTTYP ;MT DEVICE?
JRST [ TMSG < and type CONTINUE> ;YES
HALTF% ;WAIT FOR USER TO MOUNT TAPE
JRST .+1]
SETZM MTDSG ;FORCE NTAPE TO PROMPT FOR TAPE SPEC
CALL NTAPER ;GET SPEC
JRST BMBCMD ;CAN'T
JRST LODFI1 ;TRY AGAIN
LODHX5: TMSGC <%Tapes not in order, continuing
>
MOVE A,TAPNO
MOVEM A,RTAPNO
LODHX1: MOVSI A,-1
SKIPE RETSW ;RETRIEVING?
TXNE F,TF2 ; AND NOT IN THE MIDDLE OF A FILE?
CAIA
MOVEM A,TOTFIL ;YES TO BOTH, DON'T KNOW FILE# YET
; ..
;LOAD THE NEXT FILE
LODFIL: SKIPE ABTFLG ; QUASAR say to abort this retrieve?
CALL ABTRET ; Yes, do that
JFCL
TXNN F,TF2 ;SKIP TAPE CHECK IF CONTINUED FILE
SKIPN RETSW ; In a RETRIEVE?
JRST LDFIL1 ; No, skip tape check
LOAD A,TPNM2,(P6) ; Get desired tape #
SKIPGE .ARODT(P6) ; Use alternate set?
LOAD A,TPNM1,(P6)
CALL NSVOL ;CONVERT POSSIBLE INTEGER VOLID TO 6BIT
CAME A,VOLID6 ; This the tape?
JRST LOAD21 ; No, next request on another tape
LDFIL1: SKIPN NJFN1 ;ANY ACTIVE JFNS LEFT?
TXNE F,TF2 ; OR CONTINUED FILE?
CAIA ;YES TO EITHER
JRST LDFLND ;NO, ALL DONE
CALL MTRED
JRST [ TMSG < while searching for file
>
JRST LODFIL]
;LOOK FOR BEGINNING OF NEXT FILE OR END OF TAPE
LODHX2: MOVN A,TYP ;GET TYPE CODE
CAIN A,TPTRX ;TAPE TRAILER?
JRST LODEND ;YES
CAIN A,SSNDX ;[340] SAVESET END?
JRST [ SKIPE LDSALL ;SEARCH-ALL-SAVESETS?
JRST LODFIL ;YES, CONTINUE
SKIPN RETSW ;[340] DOING RETRIEVALS?
SKIPG MTTYP ;[340] UNLABELED?
JRST LODFIL ;[340] YES, CONTINUE
TMSGC <
End of saveset
> ;[340]
CALL MTCLS ;[340] CLOSE TAPE
JRST CDONE] ;[340]
CAIE A,CTPHX
CAIN A,TPHDX ;HEADER?
JRST [ SKIPE LDSALL ;SEARCH-ALL-SAVESETS?
CALL TYHEDR ;YES, TYPE HEADER INFO
SKIPE LDSALL ;TEST AGAIN
SETZM LSTDIR ;YES, SET NO LAST DIRECTORY
SKIPN LDSALL ;TEST ONE LAST TIME
SKIPE RETSW ;YES, DOING RETRIEVALS?
JRST [ MOVSI B,-1 ; Yes, use large neg # to cause
MOVEM B,TOTFIL ; of file numbers
JRST LODFIL] ; Otherwise just keep going
CALL BACKSP ;[340] BACK OVER SAVESET HEADER
TMSGC <
End of saveset
> ;[340]
CALL MTCLS ;[340] CLOSE TAPE
JRST CDONE]
CAIN A,USRX ;USER BLOCK?
JRST LODUSR ;YES
CAIN A,FLTRX ;FILE TRAILER?
JRST [ SKIPGE PAGNO ;YES, FILE CONTINUED ON NEXT VOLUME?
SOS TOTFIL ;YES, IT WILL HAVE THE SAME SEQ# THERE
JRST LODFIL]
CAIE A,CTPHX ;GO ON IF CONTINUED SAVE
CAIE A,FLHDX ;FILE HEADER?
JRST LODFIL ;NO, ASSUME DATA RECORD BEING SKIPPED
CALL LODSBR ;YES, LOAD IT
JRST LODFIL ;LOADED OK - GET NEXT FILE
JRST LODHX2 ;TRAILER RECORD MISSING - ANALYZE THIS RECORD
;HERE WHEN RESTORE/RETRIEVE IS COMPLETED
LDFLND: SKIPE MTJFN ;HAVE JFN ON TAPE?
JRST [ SKIPE NWTBIT ;YES, OVERLAPPING?
SKIPLE MTTYP ; AND UNLABELED?
SKIPA ;NOT BOTH
CALL BACKSP ;YES, UNDO ONE READ AHEAD
SKIPE RETSW ;[335] Retrieval?
CALL REWCV ;[335] Yes, rewind current volume
SKIPE RETSW ; Retrieval?
CALL UNLOAD ; Yes, spin off the tape
CALL MTCLS
JRST .+1]
SETZ A,
CALL SETMNT ;DISMOUNT MT IF I MOUNTED ONE
JRST CDONE
;HERE WHEN TAPE TRAILER RECORD HAS BEEN READ
LODEND: SETOM CDIRN
SKIPL PAGNO ;SKIP IF TRAILER NOT END OF SAVESET
SKIPE RETSW ; Retrieval?
CAIA ; Cont. saveset or retrieval--go on
JRST [ SKIPG MTTYP ;[340] UNLABELED?
CALL BACKSP ;[340] YES, BACK OVER TAPE TRAILER
CALL MTCLS ;[340] CLOSE TAPE
HRROI B,[ASCIZ/
End of saveset
/]
SKIPE LDSALL ;SEARCH-ALL-SAVESETS?
HRROI B,[ASCIZ/
End of last saveset
/] ;YES, END OF SEARCH
CALL TMSGQC
JRST CDONE]
TXNN F,TF2 ; File completed?
SKIPN RETSW ; And doing retrieval?
CAIA
JRST [ JUMPN P6,LODENX ; Yes, done with this tape--more ret's?
JRST LDFLND] ; No, all done
MOVEI B,XBUFF
LOAD B,SSNO,(B) ; Saveset #, non-0 for arch/col tape
JUMPN B,[HRROI B,[ASCIZ /%Saveset/]
TXNE F,TF2
HRROI B,[ASCIZ /%File/]
CALL TMSGQC
TMSG < continued on next tape.
>
SKIPN RETSW ; Retrieval run?
JRST LODEN1 ; No, skip retrieval block update
MOVE C,FORMAT ; To identify old arch. tapes
MOVEI B,1 ; Cont'd on saveset 1,TFN n
SKIPGE .ARODT(P6)
JRST [ STOR B,TSN1,(P6) ; Using alternate set
CAIL C,FMTV4 ; Old archive tape?
JRST LODEN1 ; No
SETONE TFN1,(P6) ; Yes, TFN=-1
JRST LODEN1]
STOR B,TSN2,(P6) ; Using alternate set
CAIL C,FMTV4 ; Old archive tape?
JRST LODEN1 ; No
SETONE TFN2,(P6); Yes, TFN=-1
JRST LODEN1]
HRROI B,[ASCIZ/$ End of tape, mount next reel /]
SKIPGE MTTYP ;MTA?
CALL TMSGQC ;YES, PROMPT FOR NEXT TAPE SPEC
TXNN F,TF2 ;SKIP IF FILE BEING RESTORED
;IS CONTINUED ON NEXT REEL
JRST LODEN1
TMSGC <%File >
HRROI B,TFNAME ;FILE NAME
CALL TMSGQ
TMSG < continued on next reel
>
LODEN1: SKIPLE MTTYP ;LABELED TAPE?
JRST LODFI2 ;YES, VOLUME-SWITCH IS AUTOMATIC
SKIPE RETSW ;RETRIEVING
SKIPN MNTDSG ; FROM MOUNTED TAPE?
JRST [ CALL UNLOAD ;NO
CALL MTCLS ;CLOSE MTA
CALL NTAPER ;GET NEXT VOLUME
JRST BMBCMD ;CAN'T
JRST LODFI1] ;OPEN MTA AND CONTINUE
TMSGC <Key in the ID of the next retrieval tape in the set>
CALL GTVOLA ;PROMPT AND GET VOLID
LODEN2: MOVE A,VOLID6 ;GET VOLID
CALL MREQ ;TRY TO MOUNT IT
JRST [ HRROI A,[ASCIZ/$Try again? /] ;[357]ERROR
CALL YESNO
JUMPN A,LODEN2 ;TRY AGAIN
HRROI P1,[ASCIZ/Tape currently unavailable
/] ;DON'T TRY AGAIN
CALL RETFAI ;RETRIEVE FAILED FOR THIS FILE
JRST LOAD21] ;GO CHECK FOR MORE RETRIEVALS
CALL MTBOT ;RESET RECORD#
JRST LODFI1 ;TAPE MOUNTED, CONTINUE RESTORE
LODENX: LOAD A,TPNM2,(P6) ; Get desired tape #
SKIPGE .ARODT(P6) ; Should we use alternate set?
LOAD A,TPNM1,(P6) ; Yes
CAME A,VOLID6 ; MATCH THE CURRENT VOLUME?
JRST LOAD21 ; No, go ask for the proper one
TMSGC <%End of tape reached and requested file not found
>
HRROI P1,[ASCIZ /End of tape reached and requested file not found/]
CALL RETFAI
JRST LOAD21
;HAVE USER INFO BLOCK
LODUSR: SKIPE WHEEL ;WHEEL LOADING?
SKIPE CHECK
JRST LODFIL ;NO, DON'T CREATE DIRECTORIES
SKIPE BUFF+.CDNUM ;INFORMATION PRESENT?
TXNN F,USRDAT ;LOAD DDB REQUESTED?
JRST LODFIL ;NO, IGNORE
SKIPG FORMAT ; TENEX tape?
ERROR (LODFIL,<?Attempt to create directories from a TENEX tape>)
SKIPN B,JF2LST ;HAVE OUTPUT DEFAULT?
JRST LODUSD ;GET NAME FROM TAPE (OR DSK:)
HRROI A,DIRNAM
HRRZS B ;JFN ONLY
MOVX C,<FLD(.JSAOF,JS%DEV)+JS%PAF>
JFNS% ;GET DEVICE NAME:
LODUSA: MOVEI B,"<" ;OPEN BRACKET
IDPB B,A ;STASH
MOVE B,A ;SETUP OUTPUT PNTR IN B
MOVE A,[POINT 7,BUFF+UHNAM] ;BEG OF NAME ON TAPE
MOVE C,FORMAT ;SEE WHICH FORMAT
CAIGE C,FMTV3 ;HAVE FULL DIR SPEC?
JRST LODUS2 ;NO - JUST COPY NAME
LODUS1: ILDB C,A ;YES - LOCATE DIRECTORY NAME
CAIE C,"<"
JRST LODUS1 ;LOOP TILL OPEN BRACKET FOUND
LODUS2: ILDB C,A ;GET CHAR IN NAME
CAIE C,">" ;LOOK FOR CLOSE BRACKET OR NULL
JUMPN C,[IDPB C,B ;COPY CHAR IN NOT NULL
JRST LODUS2]
MOVEI C,">" ;TERMINATE DIRECTORY NAME
IDPB C,B
MOVEI C,0 ;ADD NULL TO STRING
IDPB C,B ;...
HRROI B,BUFF
ADDM B,BUFF+.CDPSW ;SET PASSWORD STRING ADDRESS
SKIPE BUFF+.CDLEN ;CHECK FOR LENGTH
ADDM B,BUFF+.CDDAC ;SET DEFAULT ACCOUNT ADDRS
MOVX A,RC%EMO ;CHECK FOR ALREADY EXISTING DIR
HRROI B,DIRNAM ;...
RCDIR%
ERJMP .+3 ;ERROR, ASSUME DOESN'T EXIST
TXNN A,RC%NOM!RC%AMB ;EXISTS?
HRRM C,BUFF+.CDNUM ;YES - USE EXISTING NUMBER
IFN T20V6<
MOVE B,FORMAT ;GET FORMAT NUMBER
CAIG B,FMTV4 ;PRE-PASSWORD ENCRYPTION VERSION
SETZM BUFF+.CDPEV ;YES, MAKE ENCRYPTION VERSION # ZERO
>;END IFN T20V6
MOVE B,CRDWRD ;CRDIR FLAG WORD
LODUST: SKIPE BUFF+.CDLEN ;OLD FORMAT?
TXO B,CD%SDQ!CD%DAC!CD%CUG ;NEW BITS
MOVX A,CD%NSQ!CD%NED!CD%FED ;DO NOT UPDATE SUPERIOR'S QUOTA &
IORM A,BUFF+.CDLEN ; SET ON-LINE & OFF-LINE EXPIRATION
HRROI A,DIRNAM ;LOCATION OF DIRECTORY TO CREATE
CRDIR%
ERJMP LODUS9 ;CHECK LOSAGE
LODUS3: HRROI B,DIRNAM
CALL TMSGQ ;TYPE NAME
TMSG < created
>
JRST LODFIL
LODUSD: MOVE C,FORMAT ;SEE IF DEVICE NAME ON TAPE
CAIGE C,FMTV3 ;...
JRST LODUSF ;USE DSK:
MOVE A,[POINT 7,DIRNAM] ;INIT POINTER
MOVE B,[POINT 7,BUFF+UHNAM]
LODUSE: ILDB C,B ;GET A CHAR
JUMPE C,LODUSF ;NO DEVICE - USE DSK:
IDPB C,A ;COPY CHARACTER
CAIE C,":" ;COLON?
JRST LODUSE ;NO - GET MORE
JRST LODUSA ;YES - DONE
LODUSF: MOVE C,[ASCII "DSK:"]
MOVEM C,DIRNAM ;V2 OR EARLIER - USE DSK:
MOVE A,[POINT 7,DIRNAM,27]
JRST LODUSA ;PROCEED
;HERE ON CRDIR FAILURE - CHECK REASON AND TRY AGAIN IF INCORRECT
;DIRECTORY NUMBER
LODUS9: MOVEI A,.FHSLF ;CURRENT PROCESS
GETER% ;GET LAST ERROR
HRRZS B ;ONLY ERROR CODE
CAIN B,ARGX27 ;OFF-LINE EXPIRATION LIMIT?
JRST LODUS3 ;YES..ALL OK, SYSTEM DEFAULT WAS USED
SKIPN BUFF+.CDNUM ;HERE BEFORE?
JRST LODU91 ;YES - FAIL NOW
CAIE B,CRDIX2 ;ILLEGAL NUMBER?
CAIN B,CRDIX8
SKIPA B,CRDWRD ;GET CRDIR FLAG WORD
JRST LODU91 ;REAL ERROR
TXZ B,CD%NUM ;TRY TO NOT SPECIFY NUMBER
SETZM BUFF+.CDNUM
HRRZS BUFF+.CDLEN ;RESET HEADER
JRST LODUST ;TRY AGAIN
LODU91: TMSGC <?Directory >
HRROI B,DIRNAM
CALL TMSGQ
TMSG < not created because:
>
CALL JSERRM
JRST LODFIL ;TRY TO CONTINUE
CRDWRD: XWD 777740,BUFF ;CRDIR FLAGS AND BUFFER ADDRS
LODSBR: MOVEI A,[CALL CANTLD ;PRINT MESSAGE
TMSGC <%File skipped
>
SKIPN RETSW ; Retrieval?
JRST LODCLZ ; No, normal way out
CALL REFUSE ;TELL QUASAR TO HOLD ONTO THIS ONE
CALL NXTRET ; Get the next one
SETOM VOLID6
JRST LODCLZ] ;TRAP ACTION
CALL SETTRP ;SET TRAP FENCE
TXNN F,TF2 ;IF THIS IS NOT A CONTINUED FILE,
AOS TOTFIL ; COUNT THIS FILE
CALL NOFCHK ;CHECK FILE NUMBER
TXZ F,TF2 ;MISSING FILES-- CAN'T BE CONTINUED
TXNE F,TF2 ;SKIP IF FILE NOT CONTINUED
JRST [ SKIPGE A,PAGNO ;GET PAGE NO
CAME A,INIPGN ;SHOULD MATCH
CALL MISFPG ;MISSING PAGES IN FILE
MOVE A,INICNT ;GET SAVED PAGE COUNT
JRST LODSB1 ]
SKIPGE PAGNO ;CONTINUED FILE-DONT LOAD
JRST [ SKIPE RETSW ; Retrieval?
RET ; Yes, skip it quietly
TMSGC <%Partial file >
HRROI B,BUFF
CALL TMSGQ
TMSG < skipped
>
RET] ;GO BACK, SKIP THIS FILE
HRRZ A,BUFF+FHFDB+.FBBYV ;GET PAGE COUNT FOR FILE
LODSB1: MOVEM A,CNTR ;KEEP TRACK OF PAGES WRITTEN
CALL LODTST ;SEE IF THIS FILE SHOULD BE LOADED, GET JFN
JRST [ TXNN F,TF2 ;NO LOAD, IN MIDDLE OF FILE?
RET ;NO, RETURN NOW
SKIPN RETSW ;RETRIEVING?
CALLRET MISFPG ;NO, TELL USER ABOUT MISSING FILE PAGES
CALL REQUE ;REQUEUE REQUEST
ERROR BMBCMD,<?Wrong tape mounted, cannot retrieve continued file
>]
MOVE A,JFN ;PICK UP JFN
MOVX B,OF%WR
TXNE F,TF2 ; Continued file?
TXO B,OF%RD ; Yes, update it
SKIPE CHECK
MOVX B,OF%RD+OF%PDT
OPENF%
ERJMP [MOVEI A,.FHSLF ;[371] Current process
GETER% ;[371] Get last error
HRRZ A,B ;[371] Only error code
SKIPE CHECK ; On CHECK
CAIE A,OPNX31 ; OFFLINE files are ok
CAIA
JRST .+1
CALL CANTOP
SKIPN RETSW ;RETRIEVING?
RET ;NO
CALL REFUSE ;YES, TELL QUASAR TO HOLD ONTO THIS ONE
CALL NXTRET ;GET NEXT REQUEST
SETOM VOLID6 ;NONE
RET]
;MAIN LOAD LOOP - READ RECORD, MAP PAGE INTO FILE
LODLUP: SKIPE ABTFLG ; QUASAR say to abort?
JRST [ MOVE A,JFN ; Abort this file
TXO A,CZ%ABT
CLOSF% ; Do that
JFCL
SETZM JFN
RET] ; Done here
CALL MTRED
JRST [ TMSG < in data or trailer of file >
MOVEI A,.PRIOU
MOVE B,JFN
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%TMP+JS%PAF>
JFNS%
CALL TCRLF
JRST LODLUP]
CALL NOFCHK ;CHECK OUT FILE NUMBER
JRST LODEOF ;NO GOOD-- GIVE UP ON THIS FILE
SKIPE TYP ;DATA RECORD?
JRST LODEFL ;NO
SOS CNTR ;COUNT DOWN THIS PAGE
HRLZ B,JFN ;CONSTRUCT IDENT FOR PAGE
HRR B,PAGNO
SKIPE CHECK ;CHECKING?
JRST CHKLUP ;YES
MOVE A,[XWD .FHSLF,BUFPAG] ;PUT PAGE INTO FILE
MOVX C,PM%RD!PM%WR!PM%EX
PMAP%
JRST LODLUP
;HERE WHEN ENCOUNTERED NON-DATA RECORD, LOOK FOR FILE TRAILER
LODEFL: MOVX A,-FLTRX
CAME A,TYP
JRST LODEOF
SETZM INIPGN
SKIPL A,PAGNO ;SKIP IF FILE NOT COMPLETE
TXZA F,TF2 ;BE SURE BIT OFF
JRST [ TXO F,TF2 ;NOTE FILE IS CONTINUED
MOVEM A,INIPGN ;REMEMBER PAGE #
MOVE A,CNTR ;GET CURRENT PAGE COUNTER
MOVEM A,INICNT ;REMEMBER IT FOR SECOND PART
JRST .+1]
SKIPE CHECK ;ONLY CHECKING FILES?
JRST CHKFDB ;YES, GO DO IT
;LOOP TO TRANSFER FDB INFORMATION FROM TAPE TO FILE
MOVSI P1,-.FBLN0
FIXFDB: MOVE A,JFN ;SETUP FDB PROPERLY
MOVE C,BUFF(P1)
SKIPN WHEEL
SKIPA B,NWMASK(P1)
MOVE B,MASK(P1)
TXNE F,ICMODF ;INTERCHANGE MODE?
MOVE B,ICMASK(P1) ;YES, DIFFERENT MASK
HRL A,P1
TXO A,CF%NUD ;NO UPDATE DIRECTORY
TXNE F,ICMODF ; Interchange?
JRST FIXFD0 ; Yes, bypass TENEX stuff
SKIPG FORMAT ; TENEX format tape?
CALL @MSK10X(P1) ; Do any necessary conversion
FIXFD0: SKIPE B
CHFDB%
ERJMP [ERRORJ (.+1,<%CHFDB failure>)]
AOBJN P1,FIXFDB
;MAKE FILE INVISIBLE IF NECESSARY
HRLI A,.FBCTL
MOVX B,FB%INV ;GET MASK FOR INVISIBLE BIT
MOVE C,BUFF+.FBCTL ;GET .FBCTL WORD FROM FDB ON TAPE
MOVE D,FORMAT
CAIG D,2 ;OLD-FORMAT TAPE?
JRST [ TLNN C,(1B11) ;YES, OLD INVISIBLE BIT SET?
TDZA C,C ;NO, RESET FB%INV
MOVX C,FB%INV ;YES, SET FB%INV
JRST .+1]
SKIPE RETSW ;RETRIEVING?
SETZ C, ;YES, MAKE SURE FILE IS VISIBLE
CHFDB% ;SET FILE VISIBLE
ERJMP .+1 ;IGNORE ERROR (MIGHT BE ON TOPS-20 V3A)
;SET AUTHOR, WRITER STRINGS
TXNE F,ICMODF ;SKIP IF NOT INTERCHANGE MODE
JRST FIXFD1 ;DON'T SET AUTHOR OR WRITER
MOVE A,FORMAT ;GET TAPE FORMAT
CAIGE A,FMTV3 ;SKIP IF FMTV3 OR LATER
CALL GTUNS ;CONVERT DIRECTORY #'S TO
;STRINGS FOR OLD TAPES
MOVE A,JFN ;GET FILE'S JFN
HRLI A,.SFAUT ;SET AUTHOR IS FUNCTIN
HRROI B,BUFF+.FBLN0 ;POINT TO NAME
SFUST%
ERJMP .+1 ;IGNORE ERROR (MAYBE WRONG SYSTEM)
SKIPN WHEEL ;SET LAST WRITER ONLY IF
;PRIVELEGED OR OPERATOR
JRST FIXFD1
HRLI A,.SFLWR ;SET LAST WRITER IS FUNCTION
HRROI B,BUFF+.FBLN0+10 ;POINT TO NAME
SFUST%
ERJMP .+1
FIXFD1: TXNE F,TF2 ;[336] FILE COMPLETELY RESTORED?
JRST LODCLZ ;NOT FINISHED
CALL ARCFIX ;[336] PUT ARCHIVE INFO IN FDB
;C(P5) := INDEX INTO JFNLST
; SETUP IN LODTST
MOVE A,JFNLST(P5) ;THE SOURCE FILESPEC WHICH MATCHED
TXNN A,GJ%DEV+GJ%UNT+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER ;ANY STARS IN IT?
JRST [ SETZ A, ;NO, THEN DONE WITH IT
EXCH A,JFNLST(P5)
RLJFN%
JFCL
SOS NJFN1 ;NOTE ONE LESS ACTIVE JFN IN LIST
JRST .+1]
SKIPN RETSW ; Doing a retrieval?
JRST FIXFD3 ; No, by pass following
MOVX A,GJ%OLD+GJ%XTN ;GET DESIRED FLAGS
MOVEM A,RETBLK+.GJGEN ;SET IN GTJFN BLOCK
MOVEI A,RETBLK ; Point to special blk to restore these
HRROI B,FILNM(P6) ; Point to file name
GTJFN% ; Get a handle on the file
ERJMP [CALL BADOFP ;BUILD ERROR MESSAGE
CALL WASHOU ; Say it failed & why
CALL NXTRET
SETOM VOLID6 ;CASE OF NO MORE RET'S
JRST LODCLZ]
PUSH P,A ; Save JFN
MOVE A,JFN ; File pages are currently in
TXO A,CO%NRJ ; Save JFN
CLOSF%
JFCL
POP P,A
MOVE C,JFN
MOVEI B,.ARRST ; Want to restore the file please
ARCF% ; Do it
ERJMP [MOVEI A,.FHSLF
GETER% ; Get the error #
HRRZS B
CAIN B,ARCFX9 ; File already online?
JRST [ HRROI P1,[ASCIZ/ File was already online.
/]
CALL WASHOU ; Delete request & tell user
CALL NXTRET
SETOM VOLID6 ;CASE OF NO MORE RET'S
JRST LODCLZ]
HRLI B,.FHSLF
SETZ C,
HRROI A,TEMPS
ERSTR%
JFCL
JFCL
HRROI P1,TEMPS
CALL RETFAI
JRST LODCLZ]
PUSH P,A ; Save JFN
HRLI A,.FBBK0+CF%NUD_-^D18 ;[342] Backup word
HRLZI B,-1 ;[342] Change left half only
SETZ C, ;[342] Set to zero
CHFDB% ;[342]
ERJMP .+1 ;[342]
GTAD%
MOVE C,A ; Make the file look just read
POP P,A ; Recover JFN
HRLI A,.FBREF
SETO B, ; Entire word
CHFDB%
ERJMP .+1 ; If it fails, no worse than never trying
HRRZ A,A ;[347] Get the JFN
MOVSI B,.FBLN0 ;[347] Want all of the FDB
MOVEI C,BUFF ;[347] And put it in BUFF
GTFDB% ;[347]
HRRZS A
RLJFN%
JFCL
SETZM JFN ;DONE WITH THIS JFN
CALL RETOK ; Tell the user file is back
CALL USAINI ; Init USAGE block
MOVX A,.UTRET ; Is a retrieval
HRRM A,USABLK ; Insert type
LOAD A,AR%PSZ,BUFF+.FBBBT ; Get # pages returned online
MOVEM A,USABLK+10 ; Put it in the blk
LOAD A,AR%RSN,BUFF+.FBBBT
MOVEM A,USABLK+26 ; Put reason it was offline in blk
MOVEI A,BUFF+.FBLN0+10+10 ; Point to ARCF blk
CALL USATAP ; Do tape info
HRROI A,USADIR ; User who requested retrieval
MOVE B,TPRQUS
DIRST%
ERJMP [TMSGC <?DIRST failed while building USAGE block
>
JRST .+1]
MOVEI A,TPACT ; Account for this
MOVEM A,USABLK+2 ;[347] Point to the account
;[347] rearranged arg block for USAGE
HRROI A,USASTR ;[347] Lets use the right one here!
HRROI B,TAPNAM ;[347] And put the string where it belongs!
MOVEI C,^D12 ; Max # of characters
MOVEI D,":" ; End on colon
SOUT% ; Get structure file was on
SETZ C,
; DPB C,B ; End string & get rid of colon
DPB C,A ; End string & get rid of colon
MOVEI A,USASTR ;GET ASCIZ STRUCTURE NAME
HRLI A,(POINT 7,0)
MOVEI B,USASSI ;PUT SIXBIT STRUCTURE NAME INTO
CALL SEVSIX ; USASSI
MOVEI A,.USENT ; Make an entry
MOVEI B,USABLK
USAGE%
ERJMP [ TMSGC <%USAGE entry failed in FIXFDB
>
JRST .+1]
CALL NXTRET ; Get the next one
SETOM VOLID6 ; Say no next
FIXFD3: SKIPE RETSW
SOS NJFN1 ; One more completed
TXNE F,LFILF ;TYPE FILE NAMES ?
TXNE F,LTTYF ;AND NOT LOGGINT TO TTY?
JRST LODCLZ
TMSG < [OK]
>
LODCLZ: SETZM WORKING ;[361] No longer RESTORing file
SKIPN A,JFN ;JFN STILL ACTIVE?
RET ;NO
SKIPLE CNTR ;DID WE FIND ALL THE PAGES?
TXNE F,TF2 ;NO-- BUT IS IT A CONTINUED FILE?
JRST LODCZ1 ;YES, YES-- ALL PAGES OR CONTINUED FILE
TMSGC <%File >
MOVX A,.PRIOU
MOVE B,JFN ;JFN OF FILE
SETZ C,
JFNS% ;NAME OF FILE
TMSG < has page(s) missing
>
LODCZ1:
CLOSF%
ERJMP [SKIPN CHECK ;CHECK?
CALL JSERR1 ;NO--SHOULD HAVE HAD OPEN FILE
MOVE A,JFN
RLJFN% ;COULD BE OFF-LINE FILE FOR CHECK
ERCAL JSERR1 ;NO, SOMETHING WRONG
JRST .+1]
SETZM JFN
RET
LODEOF: TXNE F,ICMODF ;SKIP IF NOT INTERCHANGE MODE
JRST LODEO1
TMSGC <%File trailer missing for file >
HRROI P1,[ASCIZ/ File trailer missing for file
/]
MOVEI A,.PRIOU
MOVE B,JFN ;JFN OF FILE
SETZ C,
SKIPN RETSW ; Doing a retrieval?
JFNS% ;NAME OF FILE
SKIPE RETSW
CALL PRRTFL ; If a retrieve, print ret blk name
CALL TCRLF
SKIPE RETSW
CALL RETFAI ; This one failed
LODEO1: CALL LODCLZ ;CLOSE FILE
RETSKP ;SKIP RETURN TO INDICATE TRAILER MISSED
; Routines for TENEX FDB conversion
TIM10X: PUSH P,C
PUSH P,D
HRRZS C ; Need to convert time
MULI C,-1
DIVI C,^D60*^D60*^D24
HRRM C,-1(P) ; Save with old date
POP P,D
POP P,C
RET
CLRMSK: SETZB B,C ; Clear the mask word
RET
ARCFIX: SKIPE LODARC ;SUPPRESS ARCHIVE INFO, OR
SKIPE RETSW ; Doing a retrieval?
RET ; Yes, don't do this stuff then
SKIPE WHEEL ;[336] PRIVILEGED?
JRST ARCFX1 ;[336] YES, IGNORE SPECIAL TESTS
MOVE B,BUFF+.FBCTL ;[336] GET ARCHIVE AND OFFLINE STATUS
TXNN B,FB%ARC+FB%OFF ;[336] ARCHIVED OR OFFLINE?
JRST ARCFX1 ;[336] NO TO BOTH
TXNE B,FB%OFF ;[336] OFFLINE?
JRST [ TMSGC <%Cannot load file > ;[336] YES
MOVEI A,.PRIOU ;[336]
MOVE B,JFN ;[336] GET JFN
SETZ C, ;[336] DEFAULT FORMAT
JFNS% ;[336] NAME OF FILE
TMSG < because:
WHEEL or OPERATOR capabilities required to restore OFFLINE files.
> ;[336]
MOVE A,JFN ;[336] GET FILE JFN
TXO A,CZ%ABT ;[336] ABORT
CLOSF% ;[336]
JFCL ;[336] IGNORE ERRORS
SETZM JFN ;[336] NO LONGER VALID
ADJSP P,-1 ;[336] ADJUST STACK
RET] ;[336] RETURN FROM LODSBR
TMSGC <%File > ;[336]
MOVEI A,.PRIOU ;[336]
MOVE B,JFN ;[336] GET JFN
SETZ C, ;[336] DEFAULT FORMAT
JFNS% ;[336] NAME OF FILE
TMSG < restored without tape information because:
WHEEL or OPERATOR capabilities required to set ARCHIVE status.
> ;[336]
ARCFX1: MOVE A,JFN ;[336] Must close file for FLUSH to work
TXO A,CO%NRJ ; But need the JFN
CLOSF%
ERCAL JSERR1 ; Should work ok
SKIPN WHEEL ;[336] PRIVILEGED?
JRST ARCFI2 ;[336] NO, CAN'T DO ARCF STUFF SO DON'T TRY
MOVE B,FORMAT ; What style tape is this?
CAIGE B,FMTV4 ; Greater than release 3?
JRST OLDAFX ; No, fixup from old style
HLLZ D,BUFF+.FBBBT ; Get archive bits
TXZ D,AR%1ST ; This has been done already
JUMPE D,ARCFI1 ; None set, skip this part
HRRZ A,JFN ; JFN for this file
MOVEI B,.ARRAR ; Request for archive
MOVEI C,.ARSET ; Set it
TXNE D,AR%NDL ; No flush please?
TXO C,AR%NDL ; Yes, flag that
TXNE D,AR%RAR ; Was it requested?
ARCF% ; Yes, reset that
ERCAL ARCFF
MOVEI B,.ARRIV
MOVEI C,.ARSET
TXNE D,AR%RIV ; Involuntary request?
ARCF% ; Yes
ERCAL ARCFF
MOVEI B,.ARNAR
MOVEI C,.ARSET
TXNE D,AR%NAR ; Resist archive?
ARCF% ; Yes,
ERCAL ARCFF
MOVEI B,.AREXM
TXNE D,AR%EXM ; Exempt from archiving?
ARCF% ; Yes, set that
ERCAL ARCFF
ARCFI1: MOVE A,[BUFF+.FBLN0+20,,ARSSTB]
BLT A,ARSSTB+.ARPSZ ; Copy tape info
SETZ B, ; No flags yet
SKIPE ARSSTB+.ARTP1 ; 1st tape exist?
TXO B,AR%O1 ; Yes, set that
SKIPE ARSSTB+.ARTP2 ; 2nd tape exist?
TXO B,AR%O2 ; 2nd exists
JUMPE B,ARCFI2 ; Neither tape there, skip this
MOVE C,BUFF+.FBCTL
TXNE C,FB%OFF ; Was it offline?
TXO B,AR%OFL ; Yes, do that too
TXNE C,FB%ARC ; Was it archived?
TXO B,AR%ARC ; Yes, do that too
MOVEM B,ARSSTB+.AROFL ; Put bits into block
HRRZ A,JFN
MOVEI B,.ARSST ; Set the status
MOVEI C,ARSSTB
ARCF% ; Set it
ERCAL ARCFF
ARCFI2: MOVE A,JFN
RLJFN% ; Done with it & CLOSF in LODCLZ will lose
JFCL
SETZM JFN ; No longer valid
RET ; Done here
ARCFF: TMSGC <%ARCF failure, >
CALLRET JSERRM
;CONVERT DIRECTORY NUMBER TO STRING FOR OLD TAPES
GTUNS: HLRZ B,BUFF+.FBUSE ;LAST WRITER FIELD OF OLD .FBUSE
;WORD OF FDB
HRLI B,USRLH ;SAY IT IS A USER #
HRROI A,BUFF+.FBLN0+10 ;STORE IN LAST WRITER FIELD
SETZM 0(A) ;IN CASE FAILURE - USE NULL
DIRST%
ERJMP .+1
HRRZ B,BUFF+.FBUSE ;AUTHOR FIELD OF OLD .FBUSE
;WORD OF FDB
HRLI B,USRLH ;SAY IT IS A USER NUMBER
HRROI A,BUFF+.FBLN0 ;STORE IN AUTHOR FIELD
SETZM 0(A) ;USE NULL IF FAILURE
DIRST%
ERJMP .+1
RET
; NOFCHK -- CHECK FILE NUMBER FOR PROPER SEQUENCE
NOFCHK: HLLZ A,PAGNO ;GET PAGE NUMBER/FILE NUMBER WORD
TXCE A,PGNCFL!PGNNFL ;OLD FORMAT TAPE (WITH JFN IN LH!)?
TXZN A,PGNCFL!PGNNFL ; OR WITH -1 IN LH?
RETSKP ;OLD TAPE-- MUST ASSUME OK
SKIPGE TOTFIL ;FIRST TIME HERE?
JRST [ HLRZM A,TOTFIL ;YES, INITIALIZE FILE COUNTER
MOVEI A,1 ;GET NUMBER FOR FIRST FILE AND TAPE
CAMN A,RTAPNO ;IF NOT THE FIRST TAPE IN SEQUENCE
CAMN A,TOTFIL ;OR IF THIS IS REALLY THE FIRST FILE
RETSKP ;THEN EVERYTHING IS FINE
JRST NOFCHE] ;OTHERWISE FILES REALLY MISSING
HRLZ B,TOTFIL ;GET FILE COUNT TO LH
TXZ B,PGNCFL!PGNNFL ;CLEAR FLAG BIT PART
CAMN A,B ;FILE COUNT MATCH TAPE FILE NUMBER?
RETSKP ;YES-- ALL OK
HLRZM A,TOTFIL ;NO-- ADJUST COUNTER
NOFCHE: TMSGC <%Tape has file(s) missing
>
RET ;RETURN +1 FROM NOFCHK TO INDICATE FILE
; SEQUENCING ERROR
; Here to do archive info if old style archive tape (only BBN should
; have this kind of tape)
OLDAFX: HLLZ D,BUFF+.BBNBT ;[336] Get bits etc, were in BK0
TXZ D,1B0 ; Partially dumped flag already done
JUMPE D,OLDAF1 ; No bits to handle
TXZE D,1B6 ; Old AR%1ST
JRST [ HRLI A,.FBBBT ; Must set it
MOVX B,AR%1ST
MOVE C,B
CHFDB%
ERJMP [ERRORJ (.+1,<%CHFDB failure in OLDAFX>)]
JRST .+1]
HRRZ A,JFN
MOVEI B,.ARRAR ; Put in the request
MOVEI C,.ARSET
TXNE D,1B3 ; Old AR%NDL (was AR%NFH)
TXO C,AR%NDL ; Was on, restore it
TXNE D,1B1 ; Old AR%RAR bit
ARCF% ; Set it
ERJMP [ERRORJ (.+1,<%ARCF failure in OLDAFX>)]
MOVEI B,.ARRIV ; Migration request?
MOVEI C,.ARSET
TXNE D,1B2 ; Old AR%RIV
ARCF% ; Do it if necessary
ERJMP [ERRORJ (.+1,<%ARCF failure in OLDAFX>)]
MOVEI B,.ARNAR ; Do resist
MOVEI C,.ARSET
TXNE D,1B4 ; Old AR%NAR
ARCF% ; Set if necessary
ERJMP [ERRORJ (.+1,<%ARCF failure in OLDAFX>)]
MOVEI B,.AREXM ; File exempt
TXNE D,1B5 ; Old AR%EXM
ARCF%
ERJMP [ERRORJ (.+1,<%ARCF failure in OLDAFX>)]
; Now convert tape info to correct form for new style ARCF
OLDAF1: MOVEI C,ARSSTB ; Where the data will be
MOVX A,AR%O1+AR%O2+AR%ARC ; Do both tapes & will be archived
MOVEM A,.AROFL(C) ; Into flags word
SKIPN A,BUFF+.BBNTP ; Get old tape #'s
JRST ARCFI2 ; No tape #'s to do
HLRZM A,.ARTP1(C) ; Tape 1 ID
HRRZM A,.ARTP2(C) ; Tape 2 ID
MOVE A,BUFF+.BBNTS ; Get Save Set Numbers
HLLM A,.ARSF1(C) ; Save set # 1
HRLM A,.ARSF2(C) ; Save set # 2
MOVE A,BUFF+.BBNTF ; (old .FBBK3) Get TFN's
HLRM A,.ARSF1(C) ; Tape file # 1
HRRM A,.ARSF2(C)
MOVE A,BUFF+.FBNET ; (old .FBBK4) Get tape date & time
MOVEM A,.ARODT(C)
MOVX A,AR%OFL
MOVE B,BUFF+.FBCTL
TXNE B,1B12 ; Old FB%OFF
IORM A,.AROFL(C) ; Should be flushed too
HRRZ A,JFN
MOVEI B,.ARSST ; Set archive status
ARCF%
ERJMP [TMSGC <%ARCF failed to set tape information in OLDAFX
>
JRST .+1]
JRST ARCFI2 ; Done here
;TEST NEXT FILE ON TAPE FOR INCLUSION IN CURRENT LOAD SPEC
; RETURN +1: DON'T LOAD
; RETURN +2: LOAD
LODTST: TXNN F,ICMODF ;[324] INTERCHANGE, FIXUP NAME FIRST
SKIPG FORMAT ;[324] NEW FORMAT VERSION PUNCTUATION?
CALL FIXFMM ;NO, FIXUP FIRST
MOVE A,[XWD BUFF,LSTRD] ;[361] Copy last filename read from tape
BLT A,LSTRD+100-1 ;[361] from tape buffer
SKIPE CHECK ;check?
JRST [ MOVE A,[XWD BUFF,ONMBUF] ;YES-- COPY FILE NAME
BLT A,ONMBUF+100-1 ; FROM TAPE BUFFER
MOVX A,GJ%OLD+GJ%XTN ;GET FLAGS
MOVEM A,RETBLK+.GJGEN ;SET IN GTJFN BLOCK
MOVEI A,RETBLK ;POINT AT USEFUL EXTENDED BLOCK
HRROI B,ONMBUF ;LOOKUP EXACTLY AS ON TAPE
GTJFN%
ERJMP CANNOT
MOVEM A,JFN
HRROI A,TFNAME ;GET READY
MOVE B,JFN ;TO COPY FILE SPEC
SETZ C, ;SO CAN TYPE IT OUT
JFNS% ;IN CASE OF ERRORS
CALL FILSZE ;COMPUTE FILE SIZE
JRST LODCHK]
SKIPE RETSW ;RETRIEVING?
JRST LODRET ;YES, SPECIAL HANDLING
HRROI B,BUFF
CALL TSTNAM ; See name matches specs given
JRST [ MOVEM A,JFN ; Save it for
JRST LODTNO] ; fail path
MOVEM A,JFN ;TSTNAM RETURNS JFN IN A
;MATCHED ALL FIELDS, THIS FILENAME OK TO LOAD. NOW CHECK DATES
MOVE A,BUFF+FHFDB+.FBCRE ;GET MODIFIED DATE
CAMG A,MBTAD ;NOT 'BEFORE'?
CAMGE A,MSTAD ;NOT 'AFTER'?
JRST LODTNO
MOVE A,BUFF+FHFDB+.FBWRT ;GET WRITE TAD
CAMG A,WBTAD ;NOT 'BEFORE'?
CAMGE A,WSTAD ;NOT 'SINCE'
JRST LODTNO ;YES, FAIL
CAMGE A,BUFF+FHFDB+.FBREF ;GET MOST RECENT OF WRITE, READ
MOVE A,BUFF+FHFDB+.FBREF
CAMG A,ABTAD ;NOT 'BEFORE'
CAMGE A,ASTAD ;NOT 'SINCE'
JRST LODTNO ;YES, FAIL
;NOW COOK UP APPROPRIATE OUTPUT NAME
; P5/ INDEX TO JFNLST AND JF2LST TABLES
CALL GOFNAM ;GET OUTPUT NAME INTO ONMBUF
SETOM WORKING ;[361] Actually have name now
TXNN F,TF2 ;CONTINUED FILE?
JRST LODNM6 ;NO-- ALL OK
PUSH P,A ;SAVE CURRENT POINTER
MOVE A,OGNPTR ;YES-- GET GENERATION POINTER
ILDB B,A ;GET START OF GENERATION
CAIE B,"." ;SPECIFIED?
JRST LODNM5 ;NO-- SKIP CHECK FOR NEXT HIGHEST VERSION
MOVEI C,^D10 ;YES, GET IT
NIN% ;IN DECIMAL
ERJMP LODNM5 ;NO SUCH LUCK
AOJN B,LODNM5 ;IF NOT -1, DON'T CHANGE IT
MOVE A,OGNPTR ;GEN IS -1 (NEXT HIGHEST): MUST USE HIGHEST SO
MOVEM A,(P) ; DON'T SPECIFY GEN, GTJFN WILL GET HIGHEST
IDPB B,A ;MARK END OF FILENAME WITHOUT GENERATION
LODNM5: POP P,A ;RESTORE POINTER TO FILE STRING
LODNM6: CALL GOFPAT ;GET PROTECTION, ACCOUNT, ;T
; ..
; ..
LODNM7: HRROI A,TFNAME ;TAPE FILE NAME BUFFER
MOVE B,JFN
SETZ C,
JFNS% ;STORE FILE NAME FOR LATER
MOVE A,JFN ;DONE WITH LOCAL JFN ON NAME FROM TAPE
RLJFN%
JFCL
;CHECK SUPERSEDE RULE
TXNE F,SSA!TF2 ;SUPERCEDE ALWAYS OR MIDDLE OF FILE?
JRST LODNM3 ;YES, NO CHECK
LODNM8: ILDB D,OGNPTR ;GET FIRST BYTE OF GENERATION
SETZ A, ;STORE A NULL
DPB A,OGNPTR ; SO WE LOOKUP HIGHEST EXISTING GENERATION
MOVX A,GJ%OLD+GJ%XTN ;GET DESIRED FLAGS
MOVEM A,RETBLK+.GJGEN ;AND SET IN GTJFN BLOCK
MOVEI A,RETBLK ;POINT AT BLOCK WITH G1%IIN FLAG SET
HRROI B,ONMBUF ; . .
GTJFN% ;GET MOST RECENT VERSION
ERJMP [DPB D,OGNPTR ;ISN'T ONE, RESTORE BYTE OF GENERATION
JRST LODNM3] ; AND GO LOAD FILE
DPB D,OGNPTR ;RESTORE THE BYTE WE BIT
MOVEM A,JFN
TXNE F,SSN ;SUPERSEDE NEVER?
JRST LODTNO
MOVSI B,.FBLN0
MOVEI C,FDB
GTFDB% ;GET FDB OF EXISTING FILE
ERCAL JSERR1 ;[307] SCREWUP...
MOVE B,FDB+.FBWRT ;GET WRITE DATE OF EXISTING FILE
CAML B,BUFF+FHFDB+.FBWRT ;WHICH FILE IS NEWER?
JRST LODTNO ;DISK FILE IS NEWER, DON'T LOAD FROM TAPE
LOAD B,FB%GEN,BUFF+FHFDB+.FBGEN ;GET GEN NUMBER OF TAPE FILE
LOAD C,FB%GEN,FDB+.FBGEN ;GET GEN NUMBER OF EXISTING DISK FILE
CAML B,C ;NEWER (TAPE) FILE HAS HIGHER GEN NO?
JRST LODNM9 ;YES, OK
TMSGC <%File > ;No, must delete disk file to prevent
MOVEI A,.PRIOU ; GENERATION MIS-ORDERING
MOVE B,JFN
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS% ;TYPE WARNING MESSAGE
TMSG < deleted while superseding
>
MOVE A,JFN
DELF% ;DELETE (NO EXPUNGE) DISK FILE
ERCAL JSERR1
JRST LODNM8 ;SEE IF OTHER DISK FILES NEED DELETING
LODNM9: MOVE A,JFN ;NOW DONE WITH LOCAL JFN
RLJFN%
JFCL
;NOW GET JFN FOR ACTUAL DISK FILE TO BE WRITTEN
LODNM3: MOVX A,GJ%XTN ;SET TO GET JFN FOR FILE TO BE WRITTEN
TXNN F,TF2 ;CONTINUED FILE?
TXO A,GJ%FOU ;NO-- USE NEXT HIGHEST GEN IF 0 SUPPLIED
MOVEM A,RETBLK+.GJGEN ;SET IN BLOCK
MOVEI A,RETBLK
HRROI B,ONMBUF ;POINT TO FILENAME STRING
LODN31: GTJFN%
ERJMP LODN32 ;[371] ERROR-- CHECK IT OUT
JRST LODN39 ;GOT IT-- GO ON
;ERROR FROM GTJFN-- SEE IF BECAUSE OF INVALID ACCOUNT
LODN32: MOVEI A,.FHSLF ;[371] CURRENT PROCESS
GETER% ;[371] GET LAST ERROR
HRRZ A,B ;[371] ONLY ERROR CODE
CAIN A,GJFX44 ;[321] FAILED-- ACCOUNT STRING DOES NOT MATCH
JRST LODN33 ;[321] YES-- CONTINUE ON
CAIE A,VACCX0 ;FAILED-- INVALID ACCT?
JRST CANNOT ;NO-- GIVE UP
LODN33: MOVE D,OACPTR ;[321] YES-- GET POINTER TO ACCT
ILDB B,D ;[321] GET FIRST CHARACTER OF ACCT
CAIE B,";" ;[321] IS ACCT SPECIFIED?
JRST CANNOT ;NO-- GIVE UP
HRROI B,[ASCIZ /%Invalid account for this file /] ;[321]
CAIN A,GJFX44 ;[321] ACCOUNT DOESN'T MATCH
HRROI B,[ASCIZ /%Account doesn't match for file /] ;[321]
CALL TMSGQC ;[321] TYPE MESSAGE
HRROI B,ONMBUF ;POINT TO FILE SPEC
CALL TMSGQ ;TYPE FILE SPEC
TMSG <, system default used
>
SETZ A, ;USE
DPB A,D ; SYSTEM DEFAULT
JRST LODNM3 ; AND TRY AGAIN
LODN39: MOVEM A,JFN
;SEE IF THIS FILE GOING TO DIFFERENT DIRECTORY THAN LAST FILE
LODNMA: SKIPE RETSW ; Doing retrievals?
JRST LODNM4 ; Yes, forget this message
HRROI A,DIRNAM
MOVE B,JFN
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS%
HRROI A,DIRNAM
HRROI B,LSTDIR
STCMP% ;CHECK DIR NAME STRINGS
JXE A,SC%LSS+SC%SUB+SC%GTR,LODNM4
HRROI B,DIRNAM ;STRINGS DIFFERENT, SET NEW CURRENT DIR
HRROI A,LSTDIR
SETZ C,
SOUT%
TXNE F,LDIRF ;[365] YES, TYPE DIRECTORY NAMES
TXNE F,LTTYF ;[365] AND NOT LOGGING TO TTY?
JRST LODNM4 ;[365] CONTINUE ELSEWHERE
TMSG <Loading file(s) into >
MOVEI A,.PRIOU
MOVE B,JFN
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS% ;TYPE NEW DIRECTORY
CALL TCRLF
;type file name if requested
LODNM4: TXNN F,LFILF ;TYPE FILE NAMES?
JRST LODNMX ;NO
HRROI B,BUFF ;YES, SOURCE
CALL TMSGQ
TMSG < (TO) >
SKIPE RETSW
JRST [ HRROI B,FILNM(P6)
CALL TMSGQ
JRST LODNMX]
MOVE B,JFN
MOVEI A,.PRIOU
MOVX C,<FLD(.JSSSD,JS%DEV)+FLD(.JSSSD,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS% ;DESTINATION
JRST LODNMX
; SPECIAL LODTST CODE FOR RETRIEVALS
LODRET: LOAD A,TPNM2,(P6)
SKIPGE .ARODT(P6)
LOAD A,TPNM1,(P6) ; Use alternate tape
CALL NSVOL ;CONVERT TO SIXBIT
CAME A,VOLID6 ;DOES VOLID MATCH CURRENT TAPE?
TXNE F,TF2 ;MISMATCH OK IF CONTINUED FILE
CAIA
RET ; No, skip it
LOAD A,TSN2,(P6)
SKIPGE .ARODT(P6)
LOAD A,TSN1,(P6)
MOVEI C,XBUFF
LOAD B,SSNO,(C) ; Get saveset # from tape
CAIE A,0(B) ; Savesets match?
RET ; No, skip it
LOAD A,TFN2,(P6)
SKIPGE .ARODT(P6)
LOAD A,TFN1,(P6) ; Use alternate
HLRZ B,PAGNO
TXZ B,(1B0+1B1) ; Clear info bits
CAIE A,0(B) ; Tape file #'s match?
RET ; No, skip file
HRROI A,TEMPS ; Place to build a string
HRROI B,FILNM(P6) ; Point to file name we want
MOVEI C,6+1+1+^D39+1 ; Maximum device size
MOVEI D,">" ; Stop at the directory field
SOUT%
HRROI B,[ASCIZ/RETRIEVE.TEMP-FILE;T/]
SETZB C,D
SOUT%
TXNN F,TF2 ; Continued file?
JRST LODRE1 ; No, just make the temp file
MOVX A,GJ%OLD+GJ%SHT
HRROI B,TEMPS
GTJFN% ; Exist?
ERJMP LODRE1 ; No, just create it
MOVEM A,JFN ; Save the JFN
JRST LODNMA
LODRE1: MOVX A,GJ%FOU+GJ%SHT
HRROI B,TEMPS
JRST LODN31
LODCHK: TXNN F,LFILF ;SKIP IF WANT FILE NAMES
JRST LODNMX ;NOPE
HRROI B,BUFF ;SOURCE
CALL TMSGQ ;TYPE NAME
CALL TCRLF
LODNMX: MOVE A,JFN ;RETURN THE OUT JFN
RETSKP ;PASSES ALL TESTS, LOAD IT
;RETURN NO-LOAD AND RELEASE LOCAL JFN
LODTNO: MOVE A,JFN
RLJFN%
JFCL
RET
;ROUTINE TO CHANGE ";" TO "."
FIXFMM: PUSH P,A ;SAVE REGS
PUSH P,B ;""
PUSH P,C
PUSH P,D
PUSH P,D+1
TXZ F,FST%PN ; Clear first seen flag
MOVE A,[POINT 7,BUFF] ;WHERE THE NAME IS
MOVE B,[POINT 7,TEMPS] ; Where to build temp
FIXF1: ILDB C,A ;GET BYTE
JUMPE C,FIXF2 ;JUMP IF END
CAIN C,"V"-100 ;QUOTE?
JRST [ ; Quoted, force into line
IDPB C,B
ILDB C,A
IDPB C,B
JRST FIXF1] ; Loop for more
IDIVI C,^D36 ; Find which word&bit to check
MOVSI D+1,(1B0)
MOVNS D
ROT D+1,0(D) ; Put in correct position
TDNN D+1,QUTBIT(C) ; Special character?
JRST FIXNO ; No, just copy it
MOVEI C,"V"-100
IDPB C,B
LDB C,A
IDPB C,B ; And special character
JRST FIXF1
FIXNO: LDB C,A ; Retrieve character
TXNE F,ICMODF ;[324] Interchange mode
JRST FIXIC ;[324] No ";" conversion
CAIN C,";"
TXOE F,FST%PN ; Set ";" seen flag, skip if done once
CAIA
MOVEI C,"." ; Replace first with "."
FIXIC: IDPB C,B ;[324]
JRST FIXF1
FIXF2: SETZ C,
IDPB C,B ; End new string
MOVE A,[POINT 7,BUFF]
MOVE B,[POINT 7,TEMPS]
FIXF21: ILDB C,B
IDPB C,A
JUMPN C,FIXF21
POP P,D+1
POP P,D
POP P,C
POP P,B
POP P,A
RET
; Special character table; if bit is on, character needs to be quoted for
; use on TOPS20
QUTBIT: EXP 377777777777 ; ^@ to #
EXP 777100022600 ; $ to G
EXP 000000377777 ; H to k
EXP 777777600000 ; l to rubout
CHKLUP: MOVE A,B
MOVE B,[XWD .FHSLF,BF2PAG]
MOVX C,PM%WR
PMAP%
TXNN F,ICMODF ;SKIP IF INTERCHANGE FORMAT
JRST CHKLP1 ;CHECK EVERYTHING
SOSGE FPGCNT ;DECREMENT PAGE COUNT
JRST CHKLP2 ;DONE WITH ALL FULL PAGES
CHKLP1: MOVSI P1,-1000
CMPLUP: MOVE A,BUFF(P1)
SKIPA B,BUFF2(P1) ;GET FILE WORD
ERJMP CMPERR ;IF PAGE NONEXISTANT, COMPARE ERROR
CAME A,B
JRST CMPERR
AOBJN P1,CMPLUP
CMPLP2: JRST LODLUP
CMPERR: TMSGC <%Compare error>
CMPER1: TMSG <, page >
HRRZ B,PAGNO
MOVEI C,^D10
CALL TTNOUT
TMSG <, file >
MOVE B,JFN
SETZ C,
JFNS%
CALL TCRLF
JRST LODLUP
CHKLP2: SKIPN P1,RMRPGE ;SKIP IF PARTIAL PAGE
JRST CMPLP2 ;ALL DONE
MOVNS P1 ;SET UP FOR AOBJN LOOP
HRLZS P1
SETZM RMRPGE ;DONT TRY AGAIN
JRST CMPLUP ;CHECK PARTIAL PAGE
CHKFDB: MOVNI A,1
MOVE B,[XWD .FHSLF,BF2PAG]
SETZ C,
PMAP%
TXNE F,TF2 ;CONTINUED FILE?
JRST LODCLZ ;YES, ONLY CHECK AUTHORS WHEN ALL DONE
MOVE A,JFN
MOVE B,[XWD 25,0]
MOVEI C,BUFF2
GTFDB%
MOVSI P1,-25
CHKFDL: MOVE A,BUFF(P1)
XOR A,BUFF2(P1) ;COMPARE WORDS
AND A,CKMASK(P1) ;BUT CHECK ONLY CERTAIN BITS
TXNE F,ICMODF ;INTERCHANGE MODE?
AND A,ICMASK(P1) ;YES, FEWER BITS PERTINENT
JUMPN A,FDBERR ;JUMP IF COMPARED BITS DIFFERENT
CHKFD0: AOBJN P1,CHKFDL
MOVE A,FORMAT ;GET CURRENT FORMAT
CAIL A,FMTV3 ;SKIP IF OLD TAPE
TXNE F,ICMODF ;SKIP IF NOT INTERCHANGE FORMAT
JRST LODCLZ ;DON'T CHECK AUTHER &LAST WRITER
HRR A,JFN ;JFN OF FILE
HRLI A,.GFAUT ;FUNCTION IS GET AUTHOR
HRROI B,FBUF1 ;STORE STRING HERE
GFUST%
ERJMP [SETZM FBUF1
JRST .+1]
HRROI A,FBUF1 ;AUTHOR
HRROI B,BUFF+.FBLN0 ;COMPARE TO TAPE
STCMP%
SKIPE A ;SKIP IF STRINGS ARE SAME
CALL [ TMSGC <%File author differs for file >
MOVE B,JFN
MOVEI A,.PRIOU
SETZ C,
JFNS%
CALLRET TCRLF ]
HRR A,JFN
HRLI A,.GFLWR ;GET LAST WRITER
HRROI B,FBUF1
GFUST%
ERJMP [SETZM FBUF1
JRST .+1]
HRROI A,FBUF1 ;LAST WRITER
HRROI B,BUFF+.FBLN0+10 ;CHECK AGAINST TAPE
STCMP%
SKIPE A ;SKIP IF SAME
CALL [ TMSGC <%File last-writer differs for file >
MOVE B,JFN
MOVEI A,.PRIOU
SETZ C,
JFNS%
CALLRET TCRLF ]
JRST LODCLZ
FDBERR: TMSGC <%Difference in >
MOVE B,FDBNAM(P1)
MOVEI A,0
ROTC A,6
JUMPE A,FDBER9
ADDI A,40
PBOUT%
JRST .-5
FDBER9: TMSG < of file >
MOVE B,JFN
MOVEI A,.PRIOU
SETZ C,
JFNS%
CALL TCRLF
JRST CHKFD0
;FAILED TO GTJFN FOR FILE TO BE LOADED
CANNOT: TMSGC <%Cannot get JFN for file >
JRST CANT1
CANTOP: MOVE A,JFN
RLJFN%
JFCL
TMSGC <%Cannot open file >
JRST CANT1
CANTLD: TMSGC <%Cannot load file >
CANT1: HRROI B,ONMBUF ;FILESPEC STRING
SKIPE RETSW ; %%% Repair when QUASAR interface ready
HRROI B,TAPNAM
CALL TMSGQ
TMSG < because:
>
CALL JSERRM
RET
PRRTFL: HRROI B,FILNM(P6) ; Point into retrieve blk
SETZB C,D ; %%% Repair
SOUT%
RET
;TYPE HEADER INFORMATION
TYHEDR: MOVEI A,.PRIOU
CALL PRHEDR ;HEADER TO PRIMARY OUT
CALL TCRLF
MOVE B,FORMAT
CAIN B,CURFMT ;CURRENT FORMAT?
JRST TYH1 ;YES
TMSGC <%Tape is format version >
MOVE B,FORMAT
MOVEI C,^D10
CALL TTNOUT
TMSG <, not current
>
TYH1: RET
;CONSTRUCT HEADER INFORMATION
; A/ OUT DESIGNATOR
PRHEDR: STKVAR <OUTD>
MOVEM A,OUTD ;SAVE DESIGNATOR
SKIPL MTTYP ;MT DEVICE?
CALL GTVOL ;YES, GET VOLID IN VOLID6
MOVE A,OUTD ;RESTORE DESIGNATOR
HRROI B,[ASCIZ /
DUMPER tape/]
SETZ C,
SOUT%
MOVEI B,XBUFF ;VIRTUAL DISK TAPE?
JE SSCOD,(B),[HRROI B,[ASCIZ/ # /] ;NO, DISPLAY TAPE #
SOUT%
HRRZ B,TAPNO
MOVEI C,^D10
NOUT% ;PUT TAPE # IN MESSAGE
JFCL
SETZ C,
JRST .+1]
SKIPE VOLID6 ;KNOW VOLID?
JRST [ HRROI B,[ASCIZ/ Volid /] ;YES
SOUT%
HRROI B,VOLID ;DISPLAY VOLID
SOUT%
JRST .+1]
HRROI B,[ASCIZ /, /]
SOUT%
MOVEM A,OUTD ;SAVE OUT DESIG
CALL SETHDR ;CHECK FORMAT TYPE AND GET TEXT ADR
HRRI C,BUFF(A) ;[317]
HRLI C,(POINT 7,) ;[317] MAKE BYTE POINTER
MOVE A,OUTD
MOVEI D,NSSNBF-1 ;[317] MAXIMUM SAVE SET NAME LENGTH
ILDB B,C ;[317] GET A BYTE
JUMPE B,.+3 ;[317] TERMINATE ON NULL
BOUT% ;[317] SEND IT
SOJG D,.-3 ;[317] DO MORE
SETZ C, ;[317] CLEAR FOR NEXT SOUT
SKIPN FORMAT ;BBN FORMAT?
RET ;YES, NO MORE INFORMATION
HRRZ B,BUFF+BFMSGP ;NO, GET MSG OFFSET
CAIG B,BFTAD ;BEYOND TAD WORD?
RET ;NO, THEREFORE NO TAD WORD
HRROI B,[ASCIZ /, /]
SOUT%
MOVE B,BUFF+BFTAD ;GET BEGINNING TAD
MOVX C,OT%DAY+OT%FDY+OT%NSC+OT%NCO
ODTIM% ;PUT IT IN MESSAGE
RET
;ROUTINE TO LOOK AT TAPE HEADER AND DETERMINE FORMAT TYPE
;RETURN +1 ALWAYS, A/ OFFSET ADR TO TITLE STRING
SETHDR: MOVE B,BUFF ;GET FIRST WORD OF BUFFER
SETZ A, ;ASSUME OLD FORMAT
SETZM FORMAT ;""
TLNE B,(177B6) ;IS IT ASCII?
RET ;YES
MOVEM B,FORMAT ;SAVE DATA FORMAT
MOVE A,BUFF+BFMSGP ;GET OFFSET FOR THE TITLE
RET ;RETURN
SUBTTL MAGTAPE BUFFERED IO ROUTINES
; MTOPNR - OPEN MAGTAPE FOR READING OR SKIPPING RECORDS
; MTOPNW - OPEN MAGTAPE FOR WRITING RECORDS
; MTOPNX - OPEN MAGTAPE FOR REWIND OR STATUS-GATHERING OPERATION
; RETURNS +1: ALWAYS
MTOPNX: MOVEI A,OF%RD ;OPEN FOR READ
JRST MTOP0 ;DON'T HAVE TO SET DATA MODE
MTOPNR: SKIPA A,[OF%RD] ;OPEN FOR READ ACCESS
MTOPNW: MOVEI A,OF%WR ;OPEN FOR WRITE ACCESS
TLO A,(1B0) ;INDICATE NEED TO SET DATA MODE
MTOP0: MOVEM A,TMODE ;SAVE MODE REQUEST
MTOP1: SKIPE A,MTJFN ;HAVE JFN?
JRST [ GTSTS% ;YES
TXNE B,GS%OPN ;IS IT OPEN?
CALL MTCLS ;YES, CLOSE AND DISCARD
JRST .+1]
SKIPE A,MTJFN ;SKIP IF NO JFN ASSIGNED
CALL RLSJFN ;RELEASE JFN
MOVE A,MTDSG ;GET LAST MTA DESIGNATOR
JUMPE A,MTOP4 ;NO TAPE COMMAND GIVEN SO FAR
MOUNT
ERROR MTOFAI,<?Failed to MOUNT MTA, >
HRROI B,MTDEV
MOVX A,GJ%SHT
GTJFN%
ERROR MTOFAI,<?Failed to find magtape, >
MOVEM A,MTJFN ;SAVE JFN
MOVX B,<FLD 17,OF%MOD> ;REQUEST DUMP MODE
HRR B,TMODE ;READ/WRITE AS SPECIFIED BY CALLER
IFN DSKDMP, <MOVX B,OF%RD+OF%WR> ;ALLOW UPDATE
OPENF%
ERROR MTOFAI,<?Failed to open magtape, > ;NO
IFN DSKDMP, <MOVE B,SEQ ;# RECORDS DOWN "TAPE"
IMULI B,NHEAD+PGSIZ ;RECORD SIZE
SFPTR% ;SET PTR BACK THERE
CALL JSERRM>
SKIPLE MTTYP ;LABELED TAPE?
JRST [ MOVEI B,.MOPST ;YES
MOVEI C,VSCHN
MTOPR% ;SET UP TO GET VOLUME-SWITCH INTERRUPTS
ERCAL R ;IGNORE FAILURE
MOVEI B,.MOSDS
MOVE C,TMODE
TXNE C,OF%WR ;OPEN FOR WRITE?
MTOPR% ;YES, SET DEFERRED VOLUME-SWITCH
ERCAL R ;IGNORE FAILURE
JRST .+1]
SKIPG MTTYP ;UNLABELED?
JRST [ MOVEI B,.MOSDN ;YES, SET DENSITY PER REQUEST
MOVE C,DENSIT
MTOPR%
ERJMP [TMSGC <%Unable to SET TAPE DENSITY, job default used
>
JRST .+1]
MOVEI B,.MOSPR ;SET PARITY PER REQUEST
MOVE C,PARITY
MTOPR%
ERJMP .+1
JRST .+1]
SKIPGE TMODE ;WANT TO SET DATA MODE?
CALL SETMOD ;YES, DO IT
;SET BLOCKING-FACTOR
TXNE F,ICMODF ;FOR INTERCHANGE FORMAT,
JRST [ MOVEI A,1 ; USE BLOCKING FACTOR
MOVEM A,TAPBKF ; OF 1 ALWAYS
JRST MTOPB9]
MOVE A,TMODE ;GET I/O MODE
TXNE A,OF%WR ;WRITE?
SKIPE TAPBKF ;YES-- TAPE BLOCKING FACTOR ALREADY KNOWN?
JRST MTOPB9 ;YES-- (OR READ) USE EXISTING TAPBKF
MOVE A,MTJFN ;GET TAPE JFN
MOVEI B,.MORDN ;READ DENSITY
MTOPR% ; THAT HAS BEEN SET
ERJMP MTOPB4 ;NOT AVAILABLE-- DON'T CHECK BLOCKING-FACTOR LIMITS
MOVSI B,-DNBKTZ ;AOBJN POINTER TO DNBKTB (DENSITY/BLOCKING-FACTOR
; LIMIT TABLE)
MTOPB3: HRRZ A,DNBKTB(B) ;GET A DENSITY
CAMN A,C ;MATCH TAPE DENSITY?
JRST [ HLRZ A,DNBKTB(B) ;YES-- USE LIMIT FOR THIS DENSITY
JRST MTOPB6]
AOJN B,MTOPB3 ;NO-- LOOP THROUGH TABLE FOR TAPE DENSITY
;TAPE DENSITY NOT FOUND IN TABLE
MTOPB4: MOVE A,SETBKF ;USE BLOCKING FACTOR SET BY USER (OR DEFAULT)
MTOPB6: CAMLE A,SETBKF ;USER SET A LOWER BLOCKING-FACTOR?
MOVE A,SETBKF ;YES-- USE USER'S VALUE
MOVEM A,TAPBKF ;REMEMBER THE BLOCKING-FACTOR
CAME A,SETBKF ;ARE WE USING USER'S VALUE?
CALL [ TMSGC <%BLOCKING-FACTOR too high for current tape density
%Tape will be written with BLOCKING-FACTOR of >
MOVE B,TAPBKF ;NO-- TELL USER WHAT WE WILL USE
MOVEI C,^D10 ; IN DECIMAL
CALL TTNOUT
CALLRET TCRLF ]
MTOPB9:
;INITIALIZE FLAGS AND VARIABLES
TXZ F,LRERR+ICMT1 ;[340] CLEAR FLAGS
SETZM MTRACT
SETZM MTBUFF ;INIT VARIABLES
SETZM BLKCNT ;INDICATE MTBUF EMPTY
MOVE B,NWTBT0 ;INIT NORMAL OVERLAP MODE
IFN DSKDMP, < MOVEI B,1 ;1 RECORD AT TIME
MOVEM B,TAPBKF ; FOR DUMP TO DISK
SETZ B,> ; AND NO OVERLAPPING
MOVEM B,NWTBIT
CALLRET SETIOW ;SETUP DUMPI/O COMMAND LIST AND RETURN
;SETMOD - SET MTA DATA MODE
; F/ T36MOD - IF SET, USE 36-BIT MODE; IF RESET, USE CORE-DUMP MODE
; MTJFN/ MAGTAPE JFN
;RETURNS +1: ALWAYS
;NOTE: IN SOME INSTANCES INVOLVING LABELED TAPES, IT IS NOT POSSIBLE
;TO SET THE DATA MODE WITH THE .MOSDM MTOPR. THE ACTION TAKEN HERE
;IS TO ISSUE AN ERROR MESSAGE IF THE DATA MODE REQUESTED DOESN'T MATCH
;THE JOB DEFAULT DATA MODE.
SETMOD: SETO A, ;SPECIFY THIS JOB
HRROI B,D ;-# OF WORDS ,, ADDR OF 1ST WORD
MOVEI C,.JIDM ;OFFSET TO JOB DEFAULT DATA MODE
GETJI% ;FIND OUT JOB DEFAULT DATA MODE
SETO D, ;CAN'T GET IT (SHOULDN'T HAPPEN)
CAIN D,.SJDDM ;IS MODE "SYSTEM DEFAULT" ?
MOVEI D,.SJDMC ;YES, EVERYONE KNOWS THAT'S CORE DUMP
MOVEI C,.SJDMC ;ASSUME USER WANTS CORE-DUMP
TXNE F,T36MOD ;WANTS INDUSTY-COMPATIBLE?
MOVEI C,.SJDM8 ;YES
CAMN C,D ;DOES REQUEST MATCH JOB DEFAULT?
RET ;YES, DON'T HAVE TO CHANGE ANYTHING
;REQUESTED DATA MODE DOESN'T MATCH JOB DEFAULT - MUST ISSUE MTOPR
MOVE A,MTJFN ;GET TAPE JFN
MOVEI B,.MOSDM ;FUNCTION = SET DATA MODE
MTOPR% ;DO IT
ERJMP [TMSGC <%Unable to SET TAPE DATA MODE, job default used
> ;FAILED
JRST .+1]
RET
;OPEN FAILURE
MTOFAI: CALL JSERRM ;SAY WHY
HRROI A,[ASCIZ\$Try again? \];[357]
CALL YESNO
JUMPN A,MTOP1 ;YES
JRST CLRST ;NO
MTOP4: MOVX A,GJ%SHT
HRROI B,[ASCIZ /MTA-DUMPER:/]
GTJFN% ;TRY DEFAULT LOGICAL NAME
ERJMP MTOP3 ;N.G.
CALL CHKMTJ ;SETUP
JRST MTOP3 ;NOT A MAGTAPE
JRST MTOP1 ;TRY AGAIN
MTOP3: TMSG <Tape specification needed,
>
PUSH P,TMODE ;SAVE MODE (NTAPE CALLS MTOPNX)
CALL NTAPE
JRST BMBCMD ;CAN'T
POP P,TMODE
JRST MTOP1
;DENSITY/BLOCKING-FACTOR LIMIT TABLE
; *** THESE LIMITS WERE ESTABLISHED UNDER THE FOLLOWING ASSUMPTIONS:
; 1) 2 RECORDS NEED TO BE WRITTEN AFTER EOT (REFLECTIVE STRIP).
; 2) 14 RETRYS OF EACH RECORD MAY BE NEEDED.
; 3) EACH RETRY ERASES (3 INCHES) RECORD IN ERROR, THEN REWITES RECORD.
; 4) 500 INCHES OF TAPE ARE AVAILABLE AFTER REFLECTIVE STRIP.
; (THIS IS NOT TRUE. ONLY 300 INCHES (25 FEET) AVAILABLE,
; BUT ALL THOSE RETRIES ARE WORST CASE. 300 INCH LIMITS
; ARE IN PARENTHESES.)
DNBKTB: XWD ^D1,.SJDN2 ;200 BPI: LIMIT 1 (1)
XWD ^D3,.SJDN5 ;556: 3 (1)
XWD ^D4,.SJDN8 ;800: 4 (2)
XWD ^D8,.SJD16 ;1600: 8 (4)
XWD ^D35,.SJD62 ;6250: 35 (17)
DNBKTZ==.-DNBKTB
;CLOSE MAGTAPE JFN
; CALL MTCLS
; RETURN +1 ALWAYS
MTCLS: SKIPN A,MTJFN ;HAVE JFN?
RET ;NO, RETURN
CLOSF% ;YES, CLOSE AND DISCARD
ERJMP [MOVE A,MTJFN ;WON'T CLOSE
TXO A,CZ%ABT ;SO FORCE IT!
CLOSF%
JFCL
JRST .+1]
SETZM MTJFN
RET
;REWIND, UNLOAD FUNCTIONS
REWCV: SKIPG MTTYP ;REWIND CURRENT VOLUME
JRST REWVS ;UNLABELED, DO .MOREW
MOVEI B,.MORVL ;LABELED, SPECIAL MTOPR
JRST REWU1
UNLOAD: SKIPL MTTYP ;MT DEVICE?
RET ;YES, DON'T UNLOAD
SKIPA B,[EXP .MORUL] ;UNLOAD FUNCTION
REWVS: MOVEI B,.MOREW ;REWIND VOLUME-SET
REWU1: SKIPE A,MTJFN
MTOPR%
ERJMP [CAIN B,.MORUL ;ERROR, UNLOADING?
JRST .+1 ;YES, IGNORE
TMSGC <%Error rewinding tape, >
CALL JSERRM ;TELL USER
JRST .+1]
; CALLRET MTBOT ;SAY NOW AT BOT AND RETURN
;SET PARAMETERS FOR BOT OR NEW TAPE
MTBOT: SETZM TAPBKF ;INDICATE NO BLOCKING-FACTOR FOR TAPE YET
SETZM RSEQ ;RESET SEQUENCE NUMBERS
SETZM SEQ
RET ;RETURN FROM MTBOT
;MARK END OF TAPE
ENDTAP: CALL MTFILL ;FILL LAST PHYSICAL RECORD OUT SO THAT
;TAPE TRAILER IS A SINGLE PHYS RECORD
MOVX A,-TPTRX
MOVEM A,TYP ;BUILD TAPE-TRAILER RECORD
SKIPLE MTTYP ;LABELED TAPE?
JRST [ SKIPL PAGNO ;YES, CONTINUED SAVESET?
RET ;NO, ALL DONE
CALL MTOUT ;WRITE TRAILER
CALLRET MTFILL] ;FORCE IT OUT AND RETURN
CALL MTOUT ;WRITE TRAILER RECORD
TXNE F,ICMODF ;INTERCHANGE MODE?
CALL ICOFIN ;YES, FINISH BUFFERS
CALL MTFILL ;FORCE TRAILER RECORD TO BE WHOLE PHYSICAL RECORD
CALL ENDFIL
CALL ENDFIL ;WRITE 2 EOF'S
MOVEI D,3
TXNE F,ICMODF ;INTERCHANGE?
MOVEI D,2 ;YES, BACK OVER EOF'S ONLY
ENDTA1: CALL BACKSP ;BACK OVER 2 EOF'S AND TRAILER RECORD
SOJG D,ENDTA1
RET
;WRITE FILE MARK
ENDFIL: PUSH P,A
PUSH P,B
MOVEI B,.MOEOF ;REQUEST WRITE EOF
CALL XMTOPR
MOVE A,TAPBKF ;COUNT EOF AS PHYSICAL RECORD
ADDB A,RSEQ ; . .
MOVEM A,SEQ ;KEEP READ SEQ UP TO DATE
POP P,B
POP P,A
RET
;FORWARD SPACE ONE RECORD (NO CHECK FOR EOT)
FWRSP: MOVEI B,.MOFWR ;MTOPR CODE FOR FORWARD SPACE REC
CALL XMTOPR
SKIPN A,BLKCNT ; Read part of a record
MOVE A,TAPBKF ; No, # seq's per record
SKIPE BLKCNT ;READ PART OF A RECORD?
SUBI A,1 ;YES-- ACCOUNT FOR PART OF
ADD A,BLKCNT ; RECORD LEFT UNREAD
ADDB A,RSEQ ;UPDATE RECORD NUMBER
SETZM BLKCNT ;NOW AT BEGINNING OF RECORD
MOVEM A,SEQ ; Keep tape seq uptodate
RET
;BACKSPACE ONE RECORD
BACKSP: MOVEI B,.MOBKR
CALL XMTOPR ;DO BACKSPACE
MOVE A,MTJFN
GDSTS%
TXNE B,MT%BOT ;NOW AT BOT?
ERROR MTBOT,<%Beginning of tape encountered>
;YES-- GIVE WARNING, RESET SEQ #'S, AND RETURN FROM BACKSP
MOVN A,TAPBKF ;GET NEGATIVE BLOCKING FACTOR, A RECORD'S
; WORTH OF SEQUENCE NUMBERS
SKIPE BLKCNT ;READ PART OF A RECORD?
SUBI A,1 ;YES-- ACCOUNT FOR PART OF RECORD ALREADY READ
ADD A,BLKCNT ; . . .
ADDB A,RSEQ ;UPDATE RECORD NUMBER
SETZM BLKCNT ;NOW AT BEGINNING OF RECORD
MOVEM A,SEQ ;KEEP TAPE SEQ UP TO DATE
RET
;MTOPR FUNCTION - CHECK PREVIOUS OPERATION FIRST
; B/ FUNCTION FOR MTOPR
XMTOPR: PUSH P,B ;SAVE FUNCTION CODE
MOVE A,MTJFN
SKIPN NWTBIT
JRST XMTOP1 ;NOT OVERLAPPING
MOVE B,TMODE ;CHECK CURRENT MODE
TXNN B,OF%WR ;WRITE?
JRST [ CALL MTBKRA ;NO, READ-- BACK OVER READ-AHEAD
JRST XMTOP1]
GDSTS% ;[366] WRITE-- SEE IF ANY ERROR CONDITIONS EXIST
TXNE B,<MT%ILW!MT%DVE!MT%DAE> ;[372] TEST FOR ERRORS
CALL WFERR ;WRITE-- RECOVER FROM ANY ERRORS THAT HAVE OCCURED
XMTOP1: POP P,B ;RECOVER FUNCTION CODE
MOVE A,MTJFN
MTOPR% ;DO FUNCTION
RET
;FILL REST OF PHYSICAL RECORD WITH FILLER RECORDS
MTFILL: TXNN F,ICMODF ;[334] NO FILLERS IN INTERCHANGE MODE
SKIPN BLKCNT ;[334] JUST WROTE A PHYSICAL RECORD?
RET ;YES-- RETURN NOW FROM MTFILL
MOVX A,-FILLX ;GET FILLER TYPE
MOVEM A,TYP ;SET RECORD TYPE
CALL MTOUT ;WRITE FILLER RECORD
JRST MTFILL ;SEE IF DONE YET
;MAGTAPE OUTPUT ROUTINE. REQUESTS ONE TRANSFER AHEAD
MTOUT: SAVEAC <A,B>
CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
SKIPG BLKCNT ;TIME FOR A NEW BUFFER?
CALL SETNXB ;YES, SET UP ADDRESS AND BLOCK COUNT
JXN F,ICMODF,[MOVE A,MTBPTR ;GET POINTER TO CURRENT BUFFER
CALL ICOCNV ;INTERCHANGE MODE, DO CONVERSION
RET ;NO OUTPUT
JRST MTOUT1] ;DATA NOW IN BUFFER, GO WRITE IT
AOS A,RSEQ
MOVEM A,SEQ ;KEEP READ SEQ UP TO DATE
SETZM CHKSUM
HRRZ B,CURBUF ;POINT TO CURRENT BUFFER
CALL COMCKB ;CHECKSUM IT
SETCAM A,CHKSUM
MOVE A,MTBPTR ;GET CURRENT BUFFER POINTER
HRLI A,XBUFF ;COPY HEADER FIRST
MOVEI B,NHEAD(A)
BLT A,-1(B) ;...
HRL B,CURBUF ;SET UP BLT PNTR
MOVEI A,PGSIZ(B) ;LAST ADDRS
BLT B,-1(A) ;MOVE IT
MTOUT1: MOVEI A,NHEAD+PGSIZ ;ADVANCE BUFFER POINTER
ADDM A,MTBPTR ; TO NEXT RECORD
SOSLE BLKCNT ;FILLED THIS PHYSICAL RECORD?
RET ;NO, ALL DONE FOR NOW
MTOUT2: MOVEI A,MTBUF1-1 ;SETUP DUMPO START ADDRESS
SKIPE MTBUFF
MOVEI A,MTBUF2-1
HRRM A,MTCOMS
MOVEI B,MTCOMS
TDO B,NWTBIT ;SET OVERLAP IO BIT OR 0
MOVE A,MTJFN
DUMPO%
ERJMP [CALL WFERR ;WRITE ERROR, RECOVER IT
SKIPE NWTBIT ;OVERLAPPING?
JRST MTOUT2 ;YES, TRY TRANSFER AGAIN
JRST .+1] ;NO, ACTUAL TRANSFER RECOVERED
RET
;WRITE ERROR HANDLER. ANY DATA ERROR IS HANDLED BY RE-WRITING THE
;SAME RECORD. CERTAIN OTHER FLAG CONDITIONS (E.G. EOT) ARE
;IGNORED EXCEPT FOR PASSING STATUS BACK TO MAIN FORK. TAPE
;IS *NEVER* BACKSPACED.
;IF NO ERRORS ARE DETECTED, THEN NO ACTION IS TAKEN.
WFERR: CALL TSTINT ;[375] CHECK FOR INTERRUPT REQUEST
MOVEI A,.FHSLF ;[371] CURRENT PROCESS
GETER% ;[371] GET LAST ERROR
HRRZ A,B ;[371] ONLY ERROR CODE
CAIN A,DUMPX3 ;BUFFER TOO BIG?
ERROR CLRST,<?Not enough monitor table space for current BLOCKING-FACTOR>
CAIN A,OPNX8 ;[331] TAPE DRIVE OFF LINE?
JRST [ SKIPGE MTTYP ;[331] IS THIS A MTA DEVICE?
JRST WFERR1 ;[331] YES, GIVE USUAL ERROR MESSAGE
SETZM MTDSG ;[331] NO - MOUNTED, CLEAR TAPE DESIGNATOR
ERROR CLRST,<?Drive off line, DISMOUNT tape and try again>] ;[331]
CALL XGDSTS ;GET AND CLEAR ERROR FLAGS
TXNE B,MT%ILW ;ILLEG WRITE?
JRST [ HRROI A,[ASCIZ /$Tape is write-protected, type <CR> when ready to try again. /] ;[333]
SKIPGE MTTYP ;MTA DEVICE?
JRST WFTRYM ;YES, ASK TO TRY AGAIN
TMSGC <?Tape is write-protected
?DISMOUNT tape, then MOUNT it with /WRITE-ENABLED switch>
SKIPN COLSW ;[353]
SKIPE ARCSW ;[353]
CALL ARDELF ;[353]
JRST CLRST]
TXNE B,MT%DVE ;DRIVE OFF-LINE?
WFERR1: JRST [ HRROI A,[ASCIZ /$Drive probably off-line, type <CR> when ready to try again. /] ;[333][331]
CALLRET WFTRYM]
TXNE B,MT%EOT ;EOT?
SETZM TAPLFT ;YES, FLAG MAIN FORK
SKIPN COLSW ;COLLECTION/MIGRATION?
SKIPE ARCSW ;ARCHIVAL?
JRST[ SKIPE NWTBIT ;GET TYPE FROM OTHER BUFFER UNLESS
SKIPE MTBUFF ;NOT OVERLAPPING
SKIPA C,MTBUF1+XTYP
MOVE C,MTBUF2+XTYP
CAME C,[-TPTRX] ;TRAILER RECORD?
JRST .+1 ;NO, PROCEED AS USUAL
TMSGC <?Write error on trailer record!
?This >
CALL PRTTYP
TMSG < tape is valid for the current and all previous runs
?BUT, it should NOT be used for any future runs!!!
?****** MARK THIS TAPE AS FULL *********
>
RET]
CAIE A,IOX5 ;[364] DEVICE OR DATA ERROR?
TXNE B,MT%DAE ;DATA ERROR?
JRST [ TMSGC <%Write error on tape, record >
MOVEI B,XSEQ ;SEQ WORD IN RECORD
TXNE F,ICMODF ;UNLESS INTERCHANGE MODE
MOVEI B,G$SEQ ;IN WHICH CASE IT IS THIS
SKIPE NWTBIT ;GET SEQ FROM OTHER BUFFER UNLESS
SKIPE MTBUFF ;NOT OVERLAPPING
SKIPA B,MTBUF1(B)
MOVE B,MTBUF2(B)
MOVEI C,^D10
CALL TTNOUT ;REPORT IT
TMSG <, writing duplicate record.
>
CALLRET WFTRY]
RET ;UNKNOWN ERROR, IGNORE
;TRY ERRONEOUS TRANSFER AGAIN. THIS WILL BE A DUPLICATE RECORD IF
;PREVIOUS ATTEMPT FAILED BECAUSE OF DATA ERROR.
WFTRYM: PUSH P,A ;HERE IF MSG IN A TO TYPE FIRST
MOVEI A,.PRIOU
DOBE% ;WAIT FOR ANY MAIN FORK OUTPUT TO FINISH
POP P,B
CALL TMSGQC
CALL RDLIN ;GET CR FROM USER
;HERE TO TRY AGAIN WITHOUT MSG
WFTRY: SKIPE NWTBIT ;WRITE FROM OTHER BUFFER UNLESS
SKIPE MTBUFF ;NOT OVERLAPPING
SKIPA A,[MTBUF1-1]
MOVEI A,MTBUF2-1
HRRM A,MTCOMS
MOVEI B,MTCOMS
TDO B,NWTBIT ;SET BIT IF OVERLAPPING
MOVE A,MTJFN
DUMPO%
ERJMP WFERR ;FAILED AGAIN
RET ;RETRY REQUESTED OK
;MAG TAPE READ - REQUESTS ONE BUFFER IN ADVANCE
MTRED: PUSH P,A
PUSH P,B
CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
TXZE F,ICMT1 ;INTERCHANGE MODE REPEAT RECORD?
JRST [ CALL ICICN1 ;YES
JRST MTRED5 ;GET ANOTHER RECORD
JRST MTRED2] ;DATA NOW IN BUFF
MTRED5: TXZE F,LRERR ;LAST RECORD HAD ERROR?
JRST MTRED3 ;YES, CURRENT RECORD WAITING IN BUFF
MOVEI A,NHEAD+PGSIZ ;BUMP ADDRESS
ADDM A,MTBPTR ; OF CURRENT RECORD
SOSLE BLKCNT ;ANY RECORDS LEFT IN THIS PHYSICAL RECORD?
JRST MTRED4 ;YES-- USE IT
;READ NEXT RECORD FROM TAPE
CALL SETNXB ;SET NEXT BUFFER ADDRESS
MOVEI P1,NRETRY ;INIT RETRY COUNT
MTRED1: MOVEI B,MTBUF1-1 ;SELECT BUFFER
SKIPE MTRACT ;NOW TO DO READ-AHEAD?
JRST [ SKIPN MTBUFF ;YES-- USE OTHER BUFFER
MOVEI B,MTBUF2-1
JRST MTRD12]
SKIPE MTBUFF
MOVEI B,MTBUF2-1
MTRD12: HRRM B,MTCOMS
MOVEI B,MTCOMS
SKIPE TAPBKF ;DON'T OVERLAP IF RECORD LENGTH NOT YET KNOWN
TDO B,NWTBIT
MOVE A,MTJFN
DUMPI% ;REQUEST INPUT
ERJMP MTRERR ;READ ERROR
SKIPE NWTBIT ;OVERLAPPING?
SKIPE MTRACT ;YES-- NO READ-AHEAD YET?
JRST MTRED4 ;NO-- NOW RETURN DATA TO BUFF
SKIPN TAPBKF ;BLOCKING-FACTOR KNOWN?
JRST MTRED4 ;NO-- DON'T READ-AHEAD UNTIL WE FIND IT
SETOM MTRACT ;YES-- TIME TO DO READ-AHEAD
JRST MTRED1 ; SO GO BACK AND DO IT
MTRED4: HRLZ A,MTBPTR ;POINT TO CURRENT RECORD
TXNE F,T36MOD ;36-BIT MODE?
CALL W36CNV
TXNE F,ICMODF ;INTERCHANGE MODE?
JRST [ CALL ICICNV ;YES, REFORMAT RECORD
AOSA RSEQ ;RECORD BEING SKIPPED, ADJUST SEQ
JRST MTRED2 ;DATA NOW IN BUFF
TXNE F,SKPBFL ;[322] SKIP 0 (OR -N)?
JRST MTRED3 ;[322] RETURN
JRST MTRED5] ;GET ANOTHER RECORD
HRRI A,BUFF-NHEAD ;COPY BUFFER
BLT A,BUFF+PGSIZ-1
CALL COMCHK ;CHECK CHECKSUM
JUMPN A,MTRCSE ;JUMP IF CHECKSUM ERROR
MTRED2: AOSGE A,RSEQ ;BUMP RECORD NUMBER, IN SEQUENCE RECOVERY?
JRST [ CALL MTRRCK ;YES
JRST MTRERX ;FAILURE, RETURN ERROR
JRST MTRED3] ;OK
CAMN A,SEQ ;SAME AS TAPE?
JRST MTRED3 ;YES-- OK
CALL MTRSQE ;NO-- CHECK IT OUT
JRST [ SETZM BLKCNT ;DUPLICATE RECORD--
JRST MTRED5] ; IGNORE IT
MTRED3: MOVN A,TYP ;GET CURRENT RECORD TYPE
CAIN A,FILLX ;FILLER?
JRST MTRED5 ;YES-- IGNORE IT
TXZ F,LREOF ;[340] CLEAR EOF FLAG
MTRED6: POP P,B ;[340]
POP P,A
RETSKP
;ERROR RETURN
MTRERX: TXO F,LRERR ;NOTE BUFFER NOT RETURNED, DATA IN BUFF IS NEXT RECORD
POP P,B
POP P,A
RET
;CONVERT FROM 36-BIT TAPE FORMAT
W36CNV: SAVEQ
HLRZ B,A ;CONVERT BUFFER IN PLACE
HRLI B,(POINT 8,0)
HLRZ C,A
HRLI C,(POINT 4,0)
MOVEI Q1,^D<<NHEAD+PGSIZ>*9/2> ;SOURCE BYTE COUNT
W36C1: ILDB D,B ;ONE SOURCE BYTE...
ROT D,-4 ; ... BECOMES TWO DEST BYTES
IDPB D,C
ROT D,4
IDPB D,C
SOJG Q1,W36C1
RET
;ERROR HANDLING STRATEGY:
;1. DEVICE ERRORS WHICH DO NOT READ ANY DATA (E.G. OFF-LINE) WAIT
; FOR CONFIRMATION FROM USER THEN TRY AGAIN.
;2. DEVICE DATA ERRORS ARE RETRIED HERE BECAUSE WE HAVE
; SUPPRESSED THE MONITOR ERROR CORRECTION LOGIC.
;3. CHECKSUM IS CHECKED ONLY IF DEVICE REPORTS NO ERRORS IN DATA.
; CHECKSUM ERROR PRODUCES LOCAL RETRY SINCE THE MONITOR DID NOT
; KNOW OF THE ERROR.
;4. ANY HARD DATA ERROR WILL SET A FLAG WHICH CAUSES THE NEXT RECORD
; TO BE READ AND ITS SEQUENCE NUMBER CHECKED. IF IT IS THE
; SAME AS THE EXPECTED SEQUENCE NUMBER OF THE ERRONEOUS RECORD,
; THEN THE ERROR WAS ALSO DETECTED ON WRITE AND A DUPLICATE
; RECORD WAS THEN WRITTEN. THIS CONSTITUTES FULL
; RECOVERY AND IS SO REPORTED.
;ERROR REPORTED BY MAGTAPE
MTRERR: MOVEI A,.FHSLF ;[371] CURRENT PROCESS
GETER% ;[371] GET LAST ERROR
HRRZ A,B ;[371] ONLY ERROR CODE
CAIN A,DUMPX3 ;BUFFER TOO BIG?
JRST [ HLRE A,MTCOMS ;YES, GET CURRENT WORD COUNT
ADDI A,PGSIZ+NHEAD ;COUNT DOWN A BUFFER'S WORTH
HRLM A,MTCOMS ;PUT IT BACK
CAMGE A,[EXP -<PGSIZ+NHEAD>] ;CAN WE STILL READ A WHOLE RECORD?
SKIPE TAPBKF ;YES, ALSO LOOKING FOR BLOCKING-FACTOR?
ERROR CLRST,<?Not enough monitor table space> ;NO
JRST MTRED1] ;YES, TRY DUMPI AGAIN
CAIE A,GJFX52 ;END OF LABELED TAPE?
CAIN A,IOX24 ;END OF LABELED TAPE?
JRST MTREOT ;[340]
CAIN A,MREQ16 ;[325] OPERATOR REFUSE VOLUME SWITCH
JRST [ TMSGC <?Cannot switch to next tape volume because:
> ;[325] ERROR PREFIX
CALL JSERRM ;[325] GIVE ERROR MESSAGE
CALL MTCLS ;[325] CLOSE THE TAPE
SETZM MTDSG ;[325] REQUIRE RESPEC OF TAPE UNIT
JRST BMBCMD] ;[325]
CAIN A,IOX4 ;[325] EOF
;*** THE NEXT 3 LINES ARE A HACK UNTIL MONITOR SETS MT%EOF WITH IOX4
JRST [ CALL XGDSTS ;*
SETZM MTRACT ;*
JRST MTREOF] ;*
CAIN A,IOX5 ; OR ERROR ?
SKIPA ;ONE OF THE ABOVE
JRST [ TMSGC <?Unexpected error reading tape
?>
CALL JSERRM ;CAN'T HANDLE THIS ONE
TMSGC <Type <CR> to try again. >
CALL RDLIN ;GET CR FROM USER
JRST MTRED1]
CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
CALL XGDSTS ;GET AND CLEAR ERROR FLAGS
TXNE B,MT%DVE!MT%DAE!MT%EOF!MT%IRL ;ANY TRANSFER-ABORT CONDITIONS?
SETZM MTRACT ;YES, NOTE NO OUTSTANDING REQUEST
TXNE B,MT%DVE ;OFF-LINE?
JRST [ CALL MTRSQR ;MAKE SURE SEQ RECOVERY FINISHED
TMSGC <$Device error, possible incorrect density.
Type <CR> to try again. > ;[333]
CALL RDLIN ;GET CR FROM USER
JRST MTRED1]
TXNE B,MT%DAE ;DATA ERROR?
JRST [ CALL MTRSQR ;MAKE SURE SEQ RECOVERY FINISHED
TMSGC <?MAGTAPE data error>
CALL TSEQN ;REPORT SEQ NUMBER
JRST MTREX1] ;YES, GO SETUP RETRY
TXNE B,MT%EOF ;EOF?
MTREOF: JRST [ MOVE B,TAPBKF ;YES
SKIPG MTTYP ;LABELED, IGNORE INTER-FILE GAP
ADDM B,RSEQ ;UNLABELED, COUNT EOF AS PHYSICAL RECORD
TXON F,LREOF ;SET EOF AND CHECK FOR TWO SEQUENTIAL
JRST [ MOVX B,-SSNDX ;[340] SIMULATE SAVESET END
MOVEM B,TYP ;[340]
SETZM BLKCNT ;[340] ZERO RECORDS IN BLOCK
JRST MTRED6] ;[340] AND EXIT
MOVX B,-TPTRX ;TWO EOF'S, SIMULATE EOT RECORD
MOVEM B,TYP
MOVE B,RSEQ
MOVEM B,SEQ
JRST MTRED3] ;AND EXIT
TXNE B,MT%IRL ;RECORD LENGTH DISAGREES?
JRST MTRERL ;YES
CALL MTRSQR ;FINISH SEQ RECOVERY
TMSGC <?MAGTAPE unknown error>
CALL TSEQN ;REPORT SEQ NUMBER
;ATTEMPT TO RECOVER ASSUMING ERROR WAS ALSO SEEN ON WRITE AND
;THAT DUPLICATE RECORD WAS WRITTEN. IF NEXT RECORD HAS SAME
;SEQUENCE NUMBER AS WAS EXPECTED FOR BAD RECORD, THEN PROBLEM
;HAS BEEN RECOVERED.
MTREX1: SKIPN RSEQ ;AT BOT?
JRST [ TMSGC <%Tape may be wrong format>
JRST .+1]
MOVSI A,(1B0) ;SET FLAG IN SEQ
IORM A,RSEQ
MOVEI P1,NRETRY ;REINIT RETRY COUNT
JRST MTRED1 ;GO READ NEXT RECORD
;END OF LABELED TAPE ENCOUNTERED. SIMULATE TAPE TRAILER RECORD
MTREOT: CALL XGDSTS ;[340] CLEAR STATUS
MOVX B,-TPTRX ;[340] TAPE TRAILER
MOVEM B,TYP ;[340] SAVE RECORD TYPE
JRST MTRED3 ;[340] NORMAL RETURN
;RECORD LENGTH ERROR REPORTED. MONITOR DOES NOT RETRY ON THIS
;BECAUSE SOME PROGRAMS DON'T KNOW HOW LONG THEIR RECORDS ARE.
;WE DON'T KNOW WHAT THE BLOCKING FACTOR WILL BE, SO THE MAXIMUM SIZE
;RECORD IS READ THE FIRST TIME AND WILL COME THROUGH HERE.
;IF WE HAVE ALREADY READ AT LEAST ONE RECORD, WE KNOW THE BLOCKING
;FACTOR AND THE RECORD LENGTH, SO ANY A RECORD LENGTH ERROR
;IS A GENUINE ERROR AND WE WILL TRY TO RE-READ THE RECORD.
;AC C/ XWD # FRAMES READ, 0 (FROM GDSTS)
MTRERL: SKIPE TAPBKF ;BLOCKING-FACTOR KNOWN?
JRST MTRRL1 ;YES-- MUST BE REAL ERROR
HLRZ A,C ;GET WORDS ACTUALLY READ
IDIVI A,NHEAD+PGSIZ ;COMPUTE NUMBER OF RECORDS READ
JUMPN B,MTRRL1 ;NOT AN INTEGRAL NUMBER OF RECORDS-- REAL ERROR
MOVEM A,TAPBKF ;SAVE RECORD BLOCKING FACTOR
MOVEM A,BLKCNT ;ALSO SET AS CURRENT BLOCK COUNT IN BUFFER
CALL SETIOW ;SET DUMPI COMMAND LIST FOR RIGHT SIZE
JRST MTRED4 ;IGNORE THE ERROR, PROCESS RECORD
;HERE WITH REAL RECORD LENGTH ERROR
MTRRL1: HRRZ A,MTCOMS
MOVE A,1(A) ;GET FIRST WORD READ FROM TAPE
TDZ A,[1B0+1B8+1B16+1B24+17] ;CLEAR TRASH
CAMN A,[BYTE (8) "V","O","L","1"] ;IS IT A VOL1?
JRST [ HRROI B,[ASCIZ/?Labeled tapes must be MOUNTed/] ;YES
SKIPL MTTYP ;SELECT APPROPRIATE DIAGNOSTIC
HRROI B,[ASCIZ/?Cannot read labeled tapes in BYPASS mode/]
CALL TMSGQC
CALL MTCLS ;CLOSE THE TAPE
JRST BMBCMD]
SOJG P1,MTRTRY ;COUNT ATTEMPTS AND TRY AGAIN
CALL MTRSQR ;FINISH SEQ RECOVERY
TMSGC <?MAGTAPE record length error>
CALL TSEQN ;REPORT SEQ NUMBER
JRST MTREX1 ;TRY TO RECOVER BY SEQ NUMBER
;HERE WHEN TRYING TO RECOVER ERROR BY SEQUENCE NUMBER
;AFTER NEXT RECORD HAS BEEN READ. THIS RECORD WILL BE USED IN ANY CASE.
MTRRCK: MOVSI C,(1B0)
ANDCAB C,RSEQ ;CLEAR RETRY FLAG
MOVE B,SEQ ;GET SEQ NUM OF RECORD JUST READ
TXNE F,SKPBFL ;[322] SKIPPING BACKWARDS?
JRST [ MOVEM B,RSEQ ;[322] RESET NUMBER
RETSKP] ;[322] SUCESSFUL RETURN
CAME B,C ;DESIRED NUMBER?
JRST [ MOVEM B,RSEQ ;NO, RESET NUMBER
RET]
TMSG <, recovered.
>
RETSKP
;HERE WHEN WE WANT TO REPORT ANOTHER ERROR.
;IF ALREADY IN SEQUENCE RECOVERY, TYPE ", RECORD IGNORED." TO
;COMPLETE LAST ERROR MESSAGE.
MTRSQR: SKIPL RSEQ ;IN SEQUENCE RECOVERY?
RET ;NO-- ALL OK
TMSG <, record ignored.
>
RET ;RETURN FROM MTRSQR
;HERE IF SEQUENCE NUMBERS DISAGREE UNEXPECTEDLY.
;IF ACTUAL IS BLOCKING-FACTOR LESS THAN EXPECTED, PROBABLY GOT ERROR ON WRITE
;WHICH DIDN'T APPEAR ON READ, SO DUPLICATE RECORD WAS WRITTEN.
;THE DUPLICATE RECORD IS IGNORED (+1 RETURN).
;IF ACTUAL IS 1 AND EOF JUST READ, PROBABLY NEW SAVESET. PROCEED QUIETLY.
;ANYTHING ELSE IS AN ERROR.
MTRSQE: MOVE C,RSEQ
MOVE B,SEQ ;GET NUMBER JUST READ
MOVEM B,RSEQ ;RESET NUMBERS
SUB C,B ;COMPUTE DIFFERENCE
CAMN C,TAPBKF ;ACTUAL 1 LESS THAN EXPECTED?
JRST [ TMSGC <%Duplicate record encountered, record >
MOVE B,RSEQ ;REPORT NUMBER
MOVEI C,^D10
CALL TTNOUT
TMSG <, ignored.
>
RET] ;RETURN +1 FROM MTRSQE TO IGNORE RECORD
TXNE F,LREOF ;LAST RECORD FILE MARK?
JRST [ CAIN B,1 ;YES-- NEW SAVESET?
RETSKP ;YES-- ASSUME OK
JRST .+1] ;NO-- REAL SEQUENCE ERROR
TMSGC <?Sequence error, record >
MOVE B,RSEQ ;REPORT NUMBER
MOVEI C,^D10
CALL TTNOUT
TMSG <, continuing.
>
RETSKP
;HERE ON CHECKSUM ERROR. CHECKSUM ERROR MAY ARISE ONLY WITHOUT
;CONCURRENT DEVICE DATA ERROR. SINCE NO DEVICE ERROR APPEARED, THEN
;DEVICE HAS GONE AHEAD TO READ NEXT RECORD AND WE WILL HAVE TO
;BACKSPACE 2.
MTRCSE: CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
CALL XGDSTS ;WAIT FOR BACKUP OPERATION
SOJG P1,MTRTRY ;TRY AGAIN WITH 2-RECORD BACKSPACE
TMSGC <?Checksum error>
CALL TSEQN
CALL MTBKRA ;BACK UP OVER READ-AHEAD (IF ANY)
JRST MTREX1 ;TRY SEQ NUMBER RECOVERY
;HERE TO BACKSPACE BEFORE RETRY
MTRTRY: CALL MTBKRA ;BACK OVER READ-AHEAD, IF ANY
CALL MTRBKR ;BACK FOR RETRY
JRST MTRED1 ;START FROM TOP
;BACK OVER READ-AHEAD, IF ANY
MTBKRA: SKIPN MTRACT ;READ-AHEAD OUTSTANDING?
RET ;NO, DO NOTHING
SETZM MTRACT ;RESET FLAG
CALL XGDSTS ;WAIT FOR THINGS TO SETTLE DOWN
; CALLRET MTRBKR ;BACK OVER RECORD AND RETURN FROM MTBKRA
;BACKSPACE A RECORD
MTRBKR: MOVE A,MTJFN ;GET MTA JFN
MOVEI B,.MOBKR ;BACKSPACE RECORD FUNCTION
MTOPR% ; . . .
RET ;RETURN FROM MTRBKR
;REPORT SEQUENCE NUMBER
TSEQN: TMSG < record >
MOVE B,RSEQ
TXZ B,1B0 ;CLEAR FLAG IF ANY
AOS B ;COMPUTE EXPECTED SEQ NUMBER
MOVEI C,^D10
CALLRET TTNOUT
;COMPUTE CHECKSUM FOR RECORD. CHECKSUM WORD IS INCLUDED IN
;COMPUTATION. ON WRITE, IT IS SET TO 0 BEFORE THE CHECKSUM IS
;COMPUTED, THEN THE CHECKSUM IS STORED COMPLEMENTED. HENCE ON
;READ, THE CHECKSUM COMPUTATION SHOULD PRODUCE 0.
COMCHK: MOVEI B,BUFF-NHEAD ;ENTER HERE FOR STANDARD BUFFER
HRLI B,-1000-NHEAD
MOVEI A,0
COMCHA: JCRY0 COMCH1
COMCH1: ADD A,0(B)
JCRY0 [AOJA A,.+1]
AOBJN B,COMCH1
CAMN A,[EXP -1]
AOS A
RET
;ROUTINE TO CHECKSUM DISJOINT BUFFER (PAGE ADDRS IN B)
COMCKB: MOVE C,[-NHEAD,,XBUFF]
MOVEI A,0 ;INIT CHECKSUM
JCRY0 COMCB1
COMCB1: ADD A,0(C)
JCRY0 [AOJA A,.+1]
AOBJN C,COMCB1
HRLI B,-PGSIZ ;SET UP FOR REMAINDER OF RECORD
JRST COMCHA
;GET ERROR FLAGS AND THEN CLEAR SYSTEM COPY OF THEM
XGDSTS: MOVE A,MTJFN
GDSTS% ;GET ERROR BITS
PUSH P,B ;SAVE STATUS BITS
MOVEI B,.MOCLE
MTOPR% ;CLEAR ERROR FLAGS
POP P,B
RET
;SETUP DUMPI/O COMMAND LIST
SETIOW: MOVSI A,-PGSIZ-NHEAD ;SETUP BLOCK SIZE
TXNE F,ICMODF ;INTERCHANGE MODE?
MOVSI A,-PGSIZ-NIHEAD ;YES
SKIPN B,TAPBKF ;GET BLOCKING-FACTOR
JRST [ MOVSI A,-MTBFSZ ;NONE SET YET, USE MAX BUFFER SIZE
JRST SETIO1]
IMUL A,B ;RECORD-SIZE TIMES BLOCKING-FACTOR
JXN F,T36MOD,<[IMULI A,^D9 ;ADJUST FOR TAPE FORMAT
IDIVI A,^D8
JRST .+1]>
SETIO1: MOVEM A,MTCOMS ;CONSTRUCT DUMPI/O COMMAND LIST
SETZM MTCOMS+1
RET ;RETURN FROM SETIOW
;SET NEXT BUFFER ADDRESS AND BLOCK COUNT
SETNXB: SKIPE NWTBIT ;OVERLAPPING I/O?
SETCMM MTBUFF ;YES, SWITCH BUFFERS
MOVEI A,MTBUF1 ;SELECT BUFFER
SKIPE MTBUFF ; . . .
MOVEI A,MTBUF2 ; . . .
MOVEM A,MTBPTR ;SAVE AS CURRENT BUFFER POINTER
MOVE A,TAPBKF ;SET BLOCK COUNT
MOVEM A,BLKCNT ; FOR THIS PHYSICAL RECORD
RET ;RETURN FROM SETNXB
SUBTTL INTERCHANGE CONVERSION
;ROUTINES TO CONVERT BACKUP/INTERCHANGE FORMAT RECORD INTO DUMPER
;FORMAT.
; A/ SOURCE BUFFER ADR,,0
ICICNV: SAVEAC <Q1,Q2>
HLRZ Q1,A ;KEEP SOURCE BUFFER ADR
MOVE A,[BUFF-NHEAD,,BUFF-NHEAD+1]
SETZM -1(A) ;CLEAR DEST BUFFER FIRST
BLT A,BUFF+PGSIZ-1
MOVE A,G$SEQ(Q1) ;MOVE COMMON ITEMS - SEQ NUMBER
MOVEM A,SEQ
MOVE A,G$RTNM(Q1) ;TAPE NUMBER
MOVEM A,TAPNO
MOVE A,G$TYPE(Q1) ;DISPATCH ON TYPE
CAIN A,T$LBL
JRST T.LBL ;LABEL
CAIN A,T$BEG
JRST T.BEG ;BEGINNING OF SAVE SET
CAIN A,T$END
JRST T.END ;END OF SAVE SET
CAIN A,T$FIL
JRST T.FIL ;FILE DATA
CAIN A,T$UFD
JRST T.UFD ;DIRECTORY INFO
CAIN A,T$CON
JRST T.CON ;CONTINUATION
CAIN A,T$COM ;[334] COMMENT
RET ;[334] IGNORE IT
TMSG <%Unrecognized record type on INTERCHANGE tape, record skipped
>
RET
;HERE FOR SECOND AND SUBSEQUENT PROCESSING OF SAME SOURCE RECORD
ICICN1: SAVEAC <Q1,Q2>
SOS RSEQ ;KEEP SAME SEQ NUM
MOVEI Q1,MTBUF1 ;SETUP BFR ADR AGAIN
SKIPE MTBUFF
MOVEI Q1,MTBUF2
MOVE A,[BUFF,BUFF+1]
SETZM -1(A) ;CLEAR DATA AREA
BLT A,BUFF+PGSIZ-1
MOVE A,G$TYPE(Q1) ;GET TYPE
CAIE A,T$FIL ;FILE?
RET ;NO, ???
MOVE A,G$FLAG(Q1)
TXNE A,GF$SOF ;START OF SHORT FILE?
JRST TFIL0 ;YES, GET DATA
TXNE A,GF$EOF ;LAST RECORD?
JRST TFIL8 ;YES
RET ;UNKNOWN, ???
; END OF SAVESET.
;RECORD TYPES IGNORED, LBL, UFD, END
T.END:
T.UFD:
T.LBL: RET
;BEGINNING, END, OR CONTINUATION OF SAVESET
T.CON:
T.BEG: MOVX A,-TPHDX ;MEANS TAPE HEADER
MOVEM A,TYP
MOVE A,S$DATE(Q1) ;TAD OF SAVE
MOVEM A,BUFF+BFTAD
MOVEI A,BFMSG ;USUAL MESSAGE PTR
MOVEM A,BUFF+BFMSGP
MOVEI A,CURFMT ;USUAL FORMAT
MOVEM A,BUFF
MOVEI D,NIHEAD(Q1) ;SET TO SCAN DATA AREA
TBEG1: SKIPN 0(D) ;MORE TO COME?
JRST TBEG2 ;NO
HLRZ A,0(D) ;GET BLOCK TYPE
CAIN A,O$SSNM ;SAVESET NAME?
JRST TBEG3 ;YES
HRRZ A,0(D) ;NO, STEP TO NEXT BLOCK
ADDM A,D
JRST TBEG1
TBEG3: HRROI A,BUFF+BFMSG
HRROI B,1(D) ;COPY SAVESET NAME STRING
SETZ C,
SOUT%
TBEG2: RETSKP
;FILE DATA RECORD
T.FIL: MOVE A,G$FLAG(Q1)
TXNE A,GF$SOF ;FIRST RECORD?
JRST TFIL1 ;YES
TFIL0: MOVX A,GF$SOF
ANDCAB A,G$FLAG(Q1) ;NOTE NOT FIRST RECORD NOW
SKIPG G$SIZ(Q1) ;ANY DATA IN RECORD?
JRST [ TXNN A,GF$EOF ;NO, EOF?
RET ;NO, IGNORE RECORD
JRST TFIL8] ;YES, HANDLE EOF
MOVEI A,NIHEAD(Q1) ;LOCATION OF DATA
ADD A,G$LND(Q1) ;PLUS OFFSET IF ANY
HRLZ A,A ;SOURCE FOR BLT
HRRI A,BUFF ;DEST FOR BLT
MOVEI B,BUFF
ADD B,G$SIZ(Q1) ;NUMBER OF WORDS TO TRANSFER
BLT A,-1(B) ;COPY DATA
SETZM TYP ;DUMPER FILE TYPE
MOVE A,F$RDW(Q1) ;WORD NUMBER
IDIVI A,PGSIZ ;CONVERT TO PAGE NUMBER
MOVEM A,PAGNO
MOVX A,PM%RD+PM%WT
MOVEM A,ACCESS ;USUAL ACCESS
TFIL9: MOVE A,G$FLAG(Q1)
TXNE A,GF$EOF ;LAST RECORD?
TXO F,ICMT1 ;YES, REPEAT IT
RETSKP
;FIRST RECORD OF FILE
TFIL1: MOVX A,-FLHDX ;SAY DUMPER FILE HEADER
MOVEM A,TYP
MOVEI D,NIHEAD(Q1) ;SET TO SCAN DATA
HRLI D,-F$NND ;SIZE OF NON-DATA AREA
TFIL2: HLRZ A,0(D) ;GET BLOCK TYPE
CAIN A,O$NAME ;NAME?
JRST TFIL2N ;YES
CAIN A,O$FILE ;ATTRIBUTES?
JRST TFIL2F ;YES
TFIL7: HRRZ A,0(D) ;STEP BLOCK
HRL A,A
ADDM A,D
SKIPE 0(D) ;END OF DATA?
JUMPL D,TFIL2 ;OR END OF BLOCK?
SKIPLE G$SIZ(Q1) ;YES, DATA IN THIS BLOCK ALSO?
TXO F,ICMT1 ;YES, REPEAT IT
JRST TFIL9 ;CHECK FOR LAST REC AND RETURN
;FILE NAME BLOCK
TFIL2N: MOVE A,[POINT 7,BUFF+FHNAM] ;SET TO CONSTRUCT NAME IN BUFF
MOVEI B,.FCDIR
CALL SCNBF ;FIND DIRECTORY BLOCK
JRST TFIL3 ;NONE
MOVEM B,Q2 ;SAVE PTR TO IT
MOVEI B,DIRBP ;DO DIR PUNCTUATION
IDPB B,A
HRLI Q2,(POINT 7,0) ;SET TO COPY STRING
TFIL32: ILDB B,Q2
JUMPE B,TFIL31 ;END ON NULL
CAIN B,"," ;PPN SEPARATOR?
MOVEI B,"-" ;YES, TRANSLATE
IDPB B,A
JRST TFIL32
TFIL31: MOVEI B,DIREP
IDPB B,A ;CLOSE DIR PUNCT
TFIL3: MOVEI B,.FCNAM
CALL SCNBF ;FIND NAME BLOCK
JRST TFIL4 ;NONE
HRROI B,0(B)
SETZ C,
SOUT% ;COPY IT
TFIL4: MOVEI B,EXTPCT
IDPB B,A ;PUNCTUATE EXTENSION
MOVEI B,.FCEXT
CALL SCNBF ;FIND EXTENSION BLOCK
JRST TFIL5 ;NONE
HRROI B,0(B)
SETZ C,
SOUT% ;COPY IT
TFIL5: MOVEI B,GENPCT
IDPB B,A ;PUNCTUATE GENERATION
MOVEI B,.FCGEN
CALL SCNBF ;FIND GEN
JRST TFIL6 ;NONE
HRROI B,0(B)
MOVEM B,Q2 ;SAVE PTR TO GEN STRING
SETZ C,
SOUT% ;COPY IT
MOVE A,Q2 ;GET PTR TO GEN STRING
MOVEI C,^D10
NIN% ;CONVERT GEN TO NUMBER
ERCAL JSERR1
STOR B,FB%GEN,BUFF+FHFDB+.FBGEN ;PUT IN FDB
TFIL6: JRST TFIL7 ;DONE WITH NAME
;ROUTINE TO SCAN NAME BLOCK LOOKING FOR SPECIFIED SUB-BLOCK
; B/ DESIRED BLOCK TYPE
; D/ PTR TO BLOCK
;RETURN +1,
; B/ PTR TO DATA
SCNBF: STKVAR <TT1>
MOVEM D,TT1 ;SAVE MAIN PTR
MOVN C,0(D) ;GET LENGTH OF BLOCK
HRL D,C ;SET LIMIT
AOBJN D,.+1 ;STEP PAST HEADER
SCNBF1: HLRZ C,0(D) ;GET SUB-BLOCK TYPE
CAMN C,B ;REQUESTED ONE?
JRST [ MOVEI B,1(D) ;YES, RETURN PTR TO DATA
MOVE D,TT1 ;RESTORE D
RETSKP]
HRRZ C,0(D) ;BUMP SUB-BLOCK
HRL C,C
ADDM C,D
SKIPE 0(D) ;END OF DATA?
JUMPL D,SCNBF1 ;JUMP UNLESS END OF BLOCK
MOVE D,TT1 ;RESTORE D
RET ;TYPE NOT FOUND
;ATTRIBUTE BLOCK
TFIL2F: MOVEI C,1(D) ;POINT TO DATA PORTION
MOVE A,A$WRIT(C) ;COPY ITEMS - WRITE DATE
MOVEM A,BUFF+FHFDB+.FBWRT
MOVE A,A$BSIZ(C)
STOR A,FB%BSZ,BUFF+FHFDB+.FBBYV
PUSH P,C ;SAVE C
SKIPN A ;IS BYTE SIZE ZERO?
MOVEI A,^D36 ;YES-- ASSUME 36 BIT BYTES
MOVEI B,^D36 ;BITS IN A WORD
IDIV B,A ;BYTES IN A WORD
POP P,C ;RESTOR C
MOVE A,A$LENG(C)
MOVEM A,BUFF+FHFDB+.FBSIZ
ADDI A,-1(B) ;ROUND UP
IDIV A,B ;WORDS IN FILE
ADDI A,PGSIZ-1 ;ROUND UP
IDIVI A,PGSIZ ;FULL PAGES IN FILE
STOR A,FB%PGC,BUFF+FHFDB+.FBBYV
MOVE A,[BUFF+FHFDB,,ICFDB]
BLT A,ICFDB+.FBLN0-1 ;SAVE FDB FOR EOF
JRST TFIL7
;LAST RECORD OF FILE, DATA ALREADY COPIED
TFIL8: MOVE A,[ICFDB,,BUFF] ;COPY FDB SAVED FROM FIRST RECORD
BLT A,BUFF+.FBLN0
MOVX A,-FLTRX ;FILE TRAILER
MOVEM A,TYP
RETSKP
;DUMPER FORMAT TO INTERCHANGE FORMAT CONVERSION ON OUTPUT
; A/ DUMP BUFFER ADDRESS
ICXBUF=ICOBUF+NHEAD ;DATA AREA OF LOCAL BUFFER
ICOCNV: SAVEAC <Q1>
MOVEM A,Q1 ;SAVE BUFFER ADDRESS
TXZ F,TF1 ;NOTE NO OUTPUT DATA YET
TXZN F,ICMT1 ;HAVE PREVIOUS BUFFER?
JRST ICOCNX ;NO, RETURN IMMEDIATELY
MOVEI A,1(Q1) ;CLEAR DEST BUFFER
HRL A,Q1
SETZM -1(A)
BLT A,NIHEAD+PGSIZ-1(Q1)
MOVE A,ICOBUF+XTAPNO ;COPY STANDARD ITEMS - TAPE NUMBER
MOVEM A,G$RTNM(Q1)
MOVX A,GF$NCH ; - FLAGS, NO CHECKSUM
MOVEM A,G$FLAG(Q1)
MOVN A,ICOBUF+XTYP ;DISPATCH ON TYPE
CAIN A,DATAX ;DATA RECORD?
JRST ICODAT
CAIE A,CTPHX
CAIN A,TPHDX ;TAPE HEADER?
JRST ICOTPH
CAIN A,FLHDX ;FILE HEADER?
JRST ICOFLH
CAIN A,FLTRX ;FILE TRAILER?
JRST ICOFLT
CAIN A,TPTRX ;TAPE TRAILER?
JRST ICOTPT
CAIN A,USRX ;USER DATA?
JRST ICOUSR
CAIN A,FILLX ;[334] FILLER?
JRST ICOFLL ;[334]
JRST ICOCNX ;(IMPOSSIBLE)
;STANDARD RETURNS, VALID DATA IN DEST BUFFER
ICOCNY: TXO F,TF1 ;NOTE DATA IN BUFFER
AOS A,RSEQ ;COMPUTE NEXT SEQ NUMBER
MOVEM A,G$SEQ(Q1) ;LEAVE IT IN BUFFER
;NO DATA IN DEST BUFFER
ICOCNX: HRLZ A,CURBUF ;CURRENT DATA BUFFER
HRRI A,ICOBUF+NHEAD ; TO TEMP BUFFER
BLT A,ICOBUF+NHEAD+PGSIZ-1 ;COPY BUFFER
MOVE A,[XBUFF,,ICOBUF] ;NOW COPY HEADER
BLT A,ICOBUF+NHEAD-1
TXO F,ICMT1 ;NOTE ICOBUF VALID
TXNN F,TF1 ;DEST BUFFER VALID?
RET ;NO
RETSKP ;YES
;FINISH PENDING OUTPUT - DONE AT END OF TAPE
ICOFIN: CALL MTOUT ;CAUSE PENDING RECORD TO BE WRITTEN
TXZ F,ICMT1 ;NO PENDING RECORD NOW
RET
;FILLER, FILE TRAILER, USER DATA - PRODUCE NO OUTPUT
ICOFLL: ;[334]
ICOFLT:
ICOUSR: JRST ICOCNX
;TAPE HEADER
ICOTPH: MOVX A,T$BEG ;SAVESET BEGIN
ICOTP1: MOVEM A,G$TYPE(Q1)
MOVE A,ICXBUF+BFTAD ;TAD
MOVEM A,S$DATE(Q1)
MOVX A,BKFMT ;BACKUP FORMAT VERSION
MOVEM A,S$FMT(Q1)
;S$BVER, S$MON, S$SVER, S$APR, S$DEV, S$MTCH NOT PROVIDED
HRROI A,NIHEAD+1(Q1) ;DEST FOR SAVESET NAME
HRROI B,ICXBUF+BFMSG ;SOURCE OF SAVESET NAME
SETZ C,
SOUT% ;COPY SAVESET NAME TO DEST BFR
SUBI A,NIHEAD-1(Q1) ;COMPUTE NUMBER WORDS USED
MOVEM A,NIHEAD(Q1) ;SETUP ONE-WORD HEADER
MOVEM A,G$LND(Q1) ;NOTE SIZE OF NON-DATA AREA
MOVX A,O$SSNM ;INCLUDE CODE
HRLM A,NIHEAD(Q1)
JRST ICOCNY ;RETURN VALID BUFFER
;TAPE TRAILER
ICOTPT: MOVX A,T$END ;SAVESET END
JRST ICOTP1 ;SAME AS HEADER
;DATA RECORD
ICODAT: MOVX A,T$FIL ;TYPE CODE
MOVEM A,G$TYPE(Q1)
MOVEI A,PGSIZ ;ASSUME FULL PAGE OF DATA HERE UNLESS...
CAMLE A,ICOLEN ;NOT THAT MUCH LEFT IN FILE
MOVE A,ICOLEN ;USE WHATEVER IS LEFT
MOVEM A,G$SIZ(Q1) ;SET DATA WORD COUNT THIS RECORD
MOVN A,A
ADDM A,ICOLEN ;UPDATE REMAINING COUNT
MOVX A,GF$EOF
MOVN B,TYP ;CHECK TYPE OF NEXT RECORD
CAIN B,FLTRX ;IS IT FILE TRAILER?
IORM A,G$FLAG(Q1) ;YES, NOTE THIS LAST RECORD OF FILE
HRRZ A,ICOBUF+XPAGNO ;COMPUTE RELATIVE WORD NUMBER
IMULI A,PGSIZ
MOVEM A,F$RDW(Q1)
MOVSI A,ICXBUF ;COPY DATA TO DEST BUFFER
HRRI A,NIHEAD(Q1)
BLT A,NIHEAD+PGSIZ-1(Q1)
JRST ICOCNY ;RETURN BUFFER
;FILE HEADER
ICOFLH: MOVX A,T$FIL ;RECORD TYPE
MOVEM A,G$TYPE(Q1)
MOVEI A,F$NND ;NOTE SIZE OF NON-DATA AREA THIS RECORD
MOVEM A,G$LND(Q1)
MOVX A,GF$SOF ;FLAGS - START OF FILE
IORM A,G$FLAG(Q1)
MOVEI D,NIHEAD+1(Q1) ;BEG OF AREA FOR FILENAME
MOVX A,O$NAME ;INDICATE NAME BLOCK
HRLM A,-1(D)
MOVX A,F$NND/2 ;STANDARD SIZE
HRRM A,-1(D)
MOVE B,[POINT 7,ICXBUF+FHNAM] ;PTR TO NAME
ICOFH1: ILDB C,B ;FIND START OF DIRECTORY
CAIE C,DIRBP
JRST ICOFH1
MOVX A,.FCDIR ;INDICATE DIR BLOCK
HRLM A,0(D)
MOVEI A,DIREP
CALL ICOFHC ;COPY DIRECTORY STRING
MOVX A,.FCNAM ;INDICATE NAME BLOCK
HRLM A,0(D)
MOVEI A,EXTPCT
CALL ICOFHC ;COPY NAME STRING
MOVX A,.FCEXT
HRLM A,0(D) ;INDICATE EXT BLOCK
MOVEI A,GENPCT
CALL ICOFHC ;COPY EXT STRING
MOVX A,.FCGEN ;INDICATE GENERATION BLOCK
HRLM A,0(D)
MOVEI A,ATTPCT
CALL ICOFHC ;COPY GENERATION STRING
MOVEI D,NIHEAD+F$NND/2+1(Q1) ;BEG OF AREA FOR ATTRIBUTES
MOVX A,O$FILE ;INDICATE ATTRIBUTE BLOCK
HRLM A,-1(D)
MOVX A,F$NND/2 ;STANDARD SIZE
HRRM A,-1(D)
MOVE A,ICXBUF+FHFDB+.FBWRT
MOVEM A,A$WRIT(D) ;COPY WRITE DATE
MOVEI A,LN$AFH ;[352] THIS THE LENGHT?
MOVEM A,A$FHLN(D) ;[352] SET LENGTH
LOAD B,FB%BSZ,ICXBUF+FHFDB+.FBBYV ;GET FILE BYTE SIZE
JUMPE B,[ ;IF BYTE SIZE IS ZERO, USE 36
LOAD A,FB%PGC,ICXBUF+FHFDB+.FBBYV ;GET PAGE COUNT
IMULI A,PGSIZ ;GET ACTUAL SIZE IN WORDS
MOVEM A,ICXBUF+FHFDB+.FBSIZ ;AND USE AS FILE BYTE COUNT
MOVEI B,^D36 ;GET BYTE SIZE
JRST .+1]
MOVEM B,A$BSIZ(D)
MOVEI A,^D36
IDIV A,B ;COMPUTE ACTUAL BYTES/WD
MOVE B,ICXBUF+FHFDB+.FBSIZ ;GET FILE BYTE COUNT
MOVEM B,A$LENG(D) ;SET BYTE COUNT
IDIV B,A ;CONVERT BYTE COUNT TO 36-BIT BYTES
SKIPE C ;REMAINDER?
AOS B ;YES, ACCOUNT FOR PARTIAL WORD
MOVEM B,ICOLEN ;KEEP LOCAL COUNT
MOVEM B,A$ALLS(D) ;USE IT AS ALLOCATION ALSO
MOVX A,.DMIMG ;USE STANDARD MODE
MOVEM A,A$MODE(D)
JRST ICOCNY
;LOCAL ROUTINE TO COPY FILESPEC STRING
; A/ TERMINATING CHARACTER FOR CURRENT FIELD
; B/ SOURCE STRING PTR
; D/ DEST ADDRESS
ICOFHC: SAVEAC <Q1>
MOVEM A,Q1 ;SAVE TERMINATOR
MOVEI A,1(D) ;CONSTRUCT STRING PTR
HRLI A,(POINT 7,0)
ICOFC1: ILDB C,B ;GET CHAR
CAIN C,.CHCNV ;[337] QUOTING CHAR?
JRST [ IDPB C,A ;[337] YES, APPEND IT TO DEST
ILDB C,B ;[337] AND CHAR FOLLOWING
IDPB C,A ;[337]
JRST ICOFC1] ;[337] BACK FOR MORE
CAME C,Q1 ;TERMINATOR?
JUMPN C,[IDPB C,A ;NO, APPEND IT TO DEST
JRST ICOFC1]
SUBI A,-1(D) ;YES, COMPUTE WORDS IN BLOCK
HRRM A,0(D) ;PUT COUNT IN BLOCK HEADER
ADDI D,0(A) ;BUMP DEST PTR
RET
SUBTTL UTILITY SUBROUTINES
;READ LINE INTO LINBUF
; CALL RDLIN
; RETURN +1 ALWAYS
RDLIN: CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
HRROI A,LINBUF
MOVE B,[RD%BRK+RD%BEL+RD%RAI+NLINB*5]
SETZ C,
RDTTY%
JSERR
MOVEI B,.CHCRT ;TIE OFF LINE IN CASE ESC OR ^Z
IDPB B,A
MOVEI B,.CHLFD
IDPB B,A
RET
;ROUTINE TO ACCEPT YES/NO ANSWER FROM USER. REQUIRES USER TO
;TYPE Y OR N. RETURNS "TRUE" (NON-0) ON Y, "FALSE" (0) ON N IN AC1.
;CALL WITH PROMPT STRING IN A
YESNO: MOVEM A,CBLK+.CMRTY ;SAVE PROMPT STRING
YESNO0: PUSH P,CBLK+.CMRTY ;SAVE PROMPT STRING
CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
POP P,B ;GET POINTER TO PROMPT
MOVEI A,YESNO1 ;REPARSE ADDRESS
CALL CMDINI ;INIT FOR COMND JSYS
YESNO1: MOVEI B,[FLDDB. .CMKEY,,YNTBL]
COMND%
TXNE A,CM%NOP
ERROR YESNO0,<?YES or NO only>
HRRZ D,0(B) ;GET DATA
MOVEI B,[FLDDB. .CMCFM]
COMND%
TXNE A,CM%NOP ;CONFIRMED?
ERROR YESNO0,<?Not confirmed>
MOVE A,D ;GET DATA BACK
RET ;RETURN FROM YESNO, 1= YES, 0= NO IN A
YNTBL: XWD YNTBLZ,YNTBLZ
TB 0,<NO>
TB 1,<YES>
YNTBLZ==.-YNTBL-1
TDRNAM: TXNE F,LDIRF ;YES, TYPE DIR NAMES REQUESTED?
TXNE F,LTTYF ;AND NOT LOGGING TO TTY?
RET ;NO
HRROI B,DIRNAM ;YES, TYPE DIR NAME
CALL TMSGQ
TXNN F,DIRCHG ;SKIP IF DIRECTORY NAMES CHANGE
JRST TDRNA1 ;NO
TMSG < (AS) >
HRROI B,ODRNAM ;OUTPUT DIRECTORY NAME
CALL TMSGQ
TDRNA1: CALLRET TCRLF
; NSVOL - CONVERT INTEGER ARCHIVE TAPE NUMBERS TO SIXBIT
; A/ INTEGER TAPE NUMBER OR SIXBIT VOLID
; RETURNS +1: ALWAYS, A/ SIXBIT VOLID
NSVOL: TLNE A,-1 ;IS IT SIXBIT ALREADY?
RET ;YES, RETURN
MOVE B,A ;COPY INTEGER TO B
SETZ A,
NSVOL1: IDIVI B,12 ;DIVIDE BY 10
ADDI C,20 ;CONVERT REMAINDER TO SIXBIT DIGIT
LSH A,-6 ;MAKE ROOM
DPB C,[POINT 6,A,5] ;STORE IT
JUMPN B,NSVOL1 ;LOOP UNTIL NO DIGITS LEFT
RET
; TYP6 - TYPE SIXBIT QUANTITY IN A
TYP6: MOVE B,A
TYP61: SETZ A,
LSHC A,6 ;GET SIXBIT CHAR
ADDI A,40 ;CONVERT TO ASCII
PBOUT% ;TYPE IT
JUMPN B,TYP61 ;LOOP IF MORE CHARACTERS TO TYPE
RET
;PRINT STANDARD ERROR MSG AND RETURN
JSERRR: POP P,BADPC ;[307] DESTRUCTIVELY SAVE CALLER'S PC
PUSH P,A ;[307] SAVE A
JRST JSERR2 ;[307] TAKE ALTERNATE ENTRY TO JSERR1
JSERR1: PUSH P,A
MOVE A,-1(P) ;[307] GET CALLER'S PC
MOVEM A,BADPC ;[307] SAVE IT
JSERR2: CALL NOCTRO ;[307] TURN OFF CONTROL O
HRROI A,[ASCIZ /
?JSYS error at PC /] ;[307] TYPE FIRST PART OF HEADER
PSOUT% ;[307]
PUSH P,B ;[307] SAVE B AND C
PUSH P,C ;[307]
HRRZ B,BADPC ;[307] PICK UP CALLER PC
MOVEI A,.PRIOU ;[307] USE TTY AS OUTPUT
MOVX C,NO%MAG+^D8 ;[307] LOAD NOUT% BITS
NOUT% ;[307] TYPE THE FAILING JSYS PC+1
ERJMP [HRROI A,[ASCIZ/????/] ;[307] FAILED, TYPE QUESTION MARKS
PSOUT% ;[307]
JRST .+1] ;[307]
HRROI A,[ASCIZ/: /] ;[307]
PSOUT% ;[307] TYPE SECOND PART OF ERROR HEADER
JRST JSERM1
;ENTRY TO PRINT ERROR MESSAGE ONLY
JSERRM: PUSH P,A
PUSH P,B ;[307]
PUSH P,C
JSERM1: MOVEI A,.PRIOU ;[307]
HRLOI B,.FHSLF ;[307]SAY THIS FORK,,LAST ERROR
SETZ C,
ERSTR%
JFCL
JFCL
HRROI A,[ASCIZ /
/]
PSOUT%
POP P,C
POP P,B
POP P,A
RET
;TURN OFF CONTROL O (IN CASE IT IS ON) FOR ERROR MESSAGE
NOCTRO: PUSH P,A
PUSH P,B
MOVEI A,.PRIOU ;PRIMARY OUTPUT
RFMOD%
TLZ B,(TT%OSP) ;TURN OFF
SFMOD%
POP P,B
POP P,A
RET
;HERE IF CHANGED REELS IN MIDDLE OF RESTORING FILE AND PAGE #'S
;MISSING OR DON'T MATCH
MISFPG: TMSGC <%File >
HRROI B,TFNAME ;FILE NAME
CALL TMSGQ
TMSG < continued from previous reel has missing page(s)
>
RET
;SUBROUTINE TO SET UP DEFAULT FILE SPECS FOR THE SOURCE FILE SPECS IN
;THE SAVE AND RESTORE COMMANDS. THE CALLER SUPPLIES IN T1 THE ADDRESS
;OF A LIST OF FOUR ROUTINES TO BE CALLED DEPENDING ON WHETHER OR NOT
;WE ARE IN INTERCHANGE MODE, OR A WHEEL. THE ROUTINES ARE ONE OF:
;
; CSCD SET UP CONNECTED STRUCTURE AND DIRECTORY AS DEFAULTS
; CSWD SET UP CONNECTED STRUCTURE, BUT WILD DIRECTORY
; WSCD SET UP WILD STRUCTURE, BUT CONNECTED DIRECTORY
; WSWD SET UP WILD STRUCTURE AND DIRECTORY AS DEFAULTS
;
;THE BLOCK POINTED TO BY AC T1 GIVES WHICH ROUTINE TO CALL. THE OFFSETS
;INTO THE BLOCK CORRESPOND TO THE FOLLOWING CASES:
;
; 0 NOT WHEEL, NOT INTERCHANGE MODE
; 1 WHEEL, NOT INTERCHANGE MODE
; 2 NOT WHEEL, INTERCHANGE MODE
; 3 WHEEL, INTERCHANGE MODE
FILDFI: SKIPE WHEEL ;PRIVILEGED?
ADDI T1,1 ;YES, CHANGE POINTER TO RIGHT ROUTINE
TXNE F,ICMODF ;INTERCHANGE MODE?
ADDI T1,2 ;YES, CHANGE POINTER SOME MORE
CALL @(T1) ;SET UP STRUCTURE AND DIRECTORY POINTERS
HRROI A,[ASCIZ/*/] ;GET WILDCARD STRING
MOVEM A,GJBLK+.GJNAM ;DEFAULT NAME TO FULL WILDCARD
MOVEM A,GJBLK+.GJEXT ;AND EXTENSION
MOVEI A,.GJALL ;DEFAULT VERSION TO *
HRRM A,GJBLK+.GJGEN
MOVE A,[.PRIIN,,.PRIOU] ;PRIMARY INPUT AND OUTPUT
MOVEM A,GJBLK+.GJSRC
MOVX A,G1%IIN ;FIND INVISABLE FILES
MOVEM A,GJBLK+.GJF2
RET
;ROUTINE TO SET UP DEFAULTS TO BE MY CONNECTED DIRECTORY AND STRUCTURE.
CSCD: MOVE A,CONSTR ;GET POINTER TO CONNECTED STRUCTURE
MOVEM A,GJBLK+.GJDEV ;STORE IT
MOVE A,CONDIR ;AND POINTER TO CONNECTED DIRECTORY
MOVEM A,GJBLK+.GJDIR ;STORE IT TOO
RET ;DONE
;ROUTINE TO SET DEFAULT TO CONNECTED STRUCTURE, BUT WILD DIRECTORY
CSWD: MOVE A,CONSTR ;GET POINTER TO CONNECTED STRUCTURE
MOVEM A,GJBLK+.GJDEV ;SET IT
HRROI A,[ASCIZ/*/] ;THEN GET WILD DIRECTORY STRING
MOVEM A,GJBLK+.GJDIR ;AND SET IT
RET ;DONE
;ROUTINE TO SET DEFAULT TO WILD STRUCTURE, CONNECTED DIRECTORY
WSCD: HRROI A,[ASCIZ/DSK*/] ;POINT TO WILD STRUCTURE STRING
MOVEM A,GJBLK+.GJDEV ;SET IT
MOVE A,CONDIR ;GET POINTER TO CONNECTED DIRECTORY
MOVEM A,GJBLK+.GJDIR ;SET IT TOO
RET ;DONE
;ROUTINE TO SET DEFAULT TO WILD STRUCTURE AND DIRECTORY
WSWD: HRROI A,[ASCIZ/DSK*/] ;POINT TO WILD STRUCTURE
MOVEM A,GJBLK+.GJDEV ;SET IT
HRROI A,[ASCIZ/*/] ;POINT TO WILD DIRECTORY TOO
MOVEM A,GJBLK+.GJDIR ;SET IT
RET ;DONE
;SUBROUTINE TO OBTAIN THE CURRENTLY CONNECTED STRUCTURE AND DIRECTORY.
;POINTERS TO THE STRINGS ARE RETURNED IN LOCATIONS CONSTR AND CONDIR,
;OR ZERO IF WE FAIL. ALWAYS RETURNS +1.
GETCON: SETZM CONSTR ;CLEAR THIS IN CASE OF FAILURE
SETZM CONDIR ;AND THIS TOO
GJINF% ;READ INFORMATION ABOUT THIS JOB
HRROI A,CONBUF ;POINT TO STORAGE
DIRST% ;STORE CONNECTED STRUCTURE AND DIRECTORY
ERCAL JSERRR ;[307] FAILED
MOVE A,[POINT 7,CONBUF] ;GET POINTER TO THE STRING
GETCN1: ILDB B,A ;READ NEXT CHARACTER
JUMPE B,R ;RETURN IF STRING ENDS TOO EARLY
CAIE B,DEVPCT ;END OF DEVICE?
JRST GETCN1 ;NO, KEEP GOING
SETZ C, ;YES, GET A NULL
DPB C,A ;OVERWRITE COLON TO TERMINATE DEVICE
HRROI B,CONBUF ;GET POINTER TO DEVICE STRING
MOVEM B,CONSTR ;AND REMEMBER IT
ILDB B,A ;GET NEXT CHARACTER
CAIE B,DIRBP ;DIRECTORY COMING UP?
RET ;NO, RETURN
MOVEM A,CONDIR ;YES, REMEMBER POINTER TO IT
GETCN2: ILDB B,A ;SEARCH FOR END OF DIRECTORY
JUMPE B,R ;DONE IF STRING ENDS
CAIE B,DIREP ;FOUND ENDING PUNCTUATION?
JRST GETCN2 ;NO, KEEP GOING
DPB C,A ;REPLACE BRACKET WITH NULL
RET ;DONE
;USE INPUT FIELDS AS DEFAULTS FOR OUTPUT SIDE
; Q1-1/ INDEX TO JFNLST AND JF2LST TABLES
OFNAME: MOVSI D,-NFFLD ;SETUP NUMBER OF FIELDS TO CONSTRUCT
OFNAM1: MOVE B,JFNLST-1(Q1) ;GET INPUT JFN
HRRO A,FSTRT(D) ;SETUP ADR OF DEFAULT STRING
MOVEM A,GJBLK+.GJDEV(D) ;IN GTJFN BLOCK ALSO
MOVE C,FFLDT(D) ;REQUEST FIELD FROM JFNS
JFNS% ;SETUP DEFAULT STRING
OFNAM2: AOBJN D,OFNAM1 ;DO ALL FIELDS
SETZM GJBLK+.GJPRO ;CLEAR PROTECTION WORD WRONGLY SET ABOVE
RET ;HAVE DEFAULT OUTPUT NAME
;NOW COOK UP APPROPRIATE OUTPUT NAME
; P5/ INDEX TO JFNLST AND JF2LST TABLES
OUTFIL: MOVSI Q1,-NFFLD ;SETUP NUMBER OF FIELDS TO CONSTRUCT
SKIPN D,JF2LST(P5) ;HAVE AN OUTPUT SPEC?
JRST [ SETZM GJBLK+.GJDEV ;NO, USE DEFAULT DEVICE
MOVX D,GJ%DEV+GJ%UNT+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER ;ASSUME ALL STARS
JRST .+1]
OUTFI1: MOVE B,D ;USE OUTPUT JFN UNLESS...
HLLZ A,FSTRT(Q1) ;GET STAR BIT FOR THIS FIELD
TDNE D,A ;OUTPUT STAR HERE?
HRRZ B,JFN ;YES, USE INPUT FIELD
HRRO A,FSTRT(Q1) ;SETUP ADR OF DEFAULT STRING
MOVEM A,GJBLK+.GJDEV(Q1) ;IN GTJFN BLOCK ALSO
MOVE C,FFLDT(Q1) ;REQUEST FIELD FROM JFNS
JFNS% ;SETUP DEFAULT STRING
OUTFI2: AOBJN Q1,OUTFI1 ;DO ALL FIELDS
SETZM GJBLK+.GJPRO ;CLEAR PROTECTION WORD WRONGLY SET ABOVE
RET
;HERE GET FULL OUTPUT FILE SPEC, DEVICE THROUGH GENERATION
;STORE IN ONMBUF
GOFNAM: HRROI A,ONMBUF ;STORE NAME HERE
MOVX D,GJ%DEV+GJ%UNT ;DEVICE
MOVX C,<FLD(.JSAOF,JS%DEV)+JS%PAF>
CALL .JFNS ;DO JFNS
MOVX D,GJ%DIR ;DIRECTORY
MOVX C,<FLD(.JSAOF,JS%DIR)+JS%PAF>
CALL .JFNS
MOVX D,GJ%NAM ;NAME
MOVX C,<FLD(.JSAOF,JS%NAM)+JS%PAF>
MOVEM A,ONMPTR ;SAVE NAME POINTER
CALL .JFNS
MOVX D,GJ%EXT ;EXTENSION
MOVX C,<FLD(.JSAOF,JS%TYP)+JS%PAF>
CALL .JFNS
MOVX D,GJ%VER ;GENERATION #
MOVX C,<FLD(.JSAOF,JS%GEN)+JS%PAF>
MOVEM A,OGNPTR ;SAVE GENERATION POINTER
; CALLRET .JFNS ;GET GEN # AND RETURN FROM GOFNAM
.JFNS: TDNN D,JF2LST(P5) ;OUTPUT * HERE?
SKIPN B,JF2LST(P5) ;NO, USE OUTPUT FIELD
HRRZ B,JFN ;PICKUP INPUT FIELD
JFNS%
RET
;GET REST OF OUTPUT FILE NAME: PROTECTION, ACCOUNT, AND ;T
GOFPAT: TXNE F,ICMODF ;INTERCHANGE MODE?
JRST GOFPT1 ;YES, DON'T USE TAPE PROTECTION
MOVX D,GJ%PRO ;PROTECTION
MOVX C,<FLD(.JSAOF,JS%PRO)+JS%PAF>
TXNE F,RESPRO ;USE SYSTEM DEFAULT?
CALL .JFNSX ;NO-- GET SPECIFIED VALUE
GOFPT1: MOVX D,GJ%TFS ; ;T
MOVX C,<JS%TMP+JS%PAF>
CALL .JFNSX ;GET ;T
MOVEM A,OACPTR ;REMEMBER WHERE ACCOUNT STARTS
MOVX D,GJ%ACT ;ACCOUNT
MOVX C,<FLD(.JSAOF,JS%ACT)+JS%PAF>
TXNE F,RESACC ;USE SYSTEM DEFAULT?
CALL .JFNSX ;NO-- GET SPECIFIED VALUE
RET ;RETURN FROM GOFPAT
.JFNSX: TXNE F,ICMODF ;INTERCHANGE MODE?
TDNE D,JF2LST(P5) ;YES-- BUT IS OUTPUT SPECIFIED?
SKIPA ;OUTPUT SPECIFIED OR NOT INTERCHANGE-- OK
RET ;INTERCHANGE MODE AND NO OUTPUT SPEC-- USE SYSTEM DEFAULT
TDNE D,JF2LST(P5) ;OUTPUT SPECIFIED HERE?
SKIPN B,JF2LST(P5) ;YES, USE OUTPUT FIELD
HRRZ B,JFN ;PICKUP INPUT FIELD
JFNS%
RET
;FILESPEC FIELD TABLES
FSTRT: GJ%DEV+GJ%UNT+DEFDEV ;STAR FOR DEVICE ,, DEFAULT DEVICE STRING
GJ%DIR+DEFDIR ;STAR FOR DIRECTORY
GJ%NAM+DEFNAM ; " NAME
GJ%EXT+DEFEXT ; " EXTENSION
GJ%VER+DEFVER ; " VERSION
FFLDT: 1B2 ;JFNS PRINT DEVICE
1B5 ;JFNS PRINT DIRECTORY
1B8 ; " NAME
1B11 ; " EXTENSION
1B14 ; " VERSION
NFFLD==.-FFLDT
;HERE TO FIGURE FILE SIZE IN PAGES AND REMAINDER
FILSZE: LOAD A,FB%BSZ,BUFF+FHFDB+.FBBYV
MOVEI B,44 ;BITS IN A WORD
IDIV B,A ;BYTES IN A WORD
MOVE C,BUFF+FHFDB+.FBSIZ ;BYTES IN FILE
IDIV C,B ;WORDS IN FILE
SKIPE D ;SKIP IF NO REMAINDER
AOS C
IDIVI C,PGSIZ ;PAGES IN FILE
MOVEM C,FPGCNT ;FILE PAGE COUNT
MOVEM D,RMRPGE ;REMAINDER PAGE
RET
;HERE FOR CHECKSUM OF PAGE
PGECSM: TXNE F,CS%SEQ ;SKIP IF NOT SEQUENTIAL CHECKSUM
JRST SEQCSM ;DO SEQUENTIAL CHECKSUM
HRRZ D,PAGNO ;GET PAGE #
SUB D,LSTPGE ;SEE IF HOLE
SOJLE D,PCHKS1 ;JUMP IF NO HOLE
MOVNI C,(D) ;YES, GET -PAGE #
HRL C,D ;MAKE IT PAGE #,,-PAGE #
PUSH P,C ;STUFF WORD ONTO STACK
MOVSI C,-1
HRRI C,-BUFF(P) ;ARRANGE TO POINT AT IT
CALL CHKSOM ;CHECKSUM 1 WORD
POP P,(P) ;RESTORE STACK
PCHKS1: MOVSI C,-1000 ;SETUP AOBJN POINTER TO WHOLE PAGE
CALL CHKSOM ;CHECKSUM IT
MOVE A,PAGNO ;GET PAGE #
HRRZM A,LSTPGE ;STORE
RET ;DONE WITH PAGE
;HERE FOR SEQUENTIAL CHECKSUM
SEQCSM: SOSGE FPGCNT ;DECREMENT WHOLE PAGE CONT
JRST SEQCS1 ;NO WHOLE PAGES LEFT
MOVSI C,-1000 ;WORDS TO CHECKSUM
CALLRET CHKSOM ;CHECKSUM PAGE
SEQCS1: SKIPN C,RMRPGE ;GET REMAINDER TO CHECK
RET ;NOTHING TO CHECK
MOVNS C ;NEGATE WORDS TO CHECK
HRLZS C ;...
SETZM RMRPGE ;DON'T CHECK AGAIN
CALLRET CHKSOM ;CHECK SUM PAGE
;HERE TO CHECKSUM COUNT OF WORDS IN C
CHKSOM: MOVE D,CHKCN0
CHKSM1: ROT D,1
ADD D,BUFF(C)
AOBJN C,CHKSM1 ;LOOP ON WORD COUNT
MOVEM D,CHKCN0
RET
;ROUTINES TO MANIPULATE JFN STACK
;ADD JFN TO JFN STACK
;ALL AC'S PRESERVED
; B HAS JFN IN RIGHT HALF
ADLIST: PUSH P,D ;SAVE AC
HLRZ D,CURPTR ;CHECK FOR STACK OVERFLOW
CAIN D,-1 ;SKIP IF NOT FULL
ERROR START,<?JFN stack overflow>
MOVE D,CURPTR ;PICK UP STACK POINTER
PUSH D,B ;PUT JFN ON STACK
MOVEM D,CURPTR ;STORE UPDATED STACK POINTER
POP P,D ;RESTORE D
RET ;RETURN
;HERE TO RELEASE JFN STORED ON STACK
; A HAS JFN IN RH
RLSJFN: HRRZS A ;CLEAR LEFT HALF
GTSTS% ;GET JFN STATUS
TXNN B,GS%NAM ;SKIP IF JFN OWNED
RET ;NOTHING TO DO
TXNN B,GS%OPN ;SKIP IF JFN IS OPEN
JRST [ RLJFN% ;RELEASE IT IF NOT
ERROR START,<?Cannot release JFN>
RET]
CLOSF% ;CLOSE AND RELEASE JFN
ERROR START,<?Cannot close and release JFN>
RET
;HERE TO ADD A FILE--BE SURE IT IS A DISK FILE
ADFILE: CALL ADLIST ;ADD TO JFN STACK
CALL CHKDVC ;CHECK FOR DEVICE DISK
RET
;ROUTINE TO TAKE JFN'S OFF STACK
; D HAS FINAL DESIRED POINTER
; RETURNS FINAL DESIRED POINTER IN D
;ASSUMES A,B,C,D ARE FREE
RSTSTK: CAMN D,CURPTR ;SEE IF ANYTHING THERE
RET ;NOPE
PUSH P,D ;SAVE FINAL POINTER
MOVE D,CURPTR ;CURRENT POINTER
RSTST1: POP D,A ;GET JFN OFF STACK
CALL RLSJFN ;RELEASE JFN
CAME D,(P) ;COMPARE POINTERS
JRST RSTST1 ;NOT DONE
POP P,D ;GET FINAL POINTER
MOVEM D,CURPTR ;USE AS CURRENT POINTER
RET ;RETURN
;CHKDVC - CHECK THAT JFN IN B SPECIFIES A DISK FILE
CHKDVC: PUSH P,A ;SAVE AC'S
PUSH P,B
HRRZ A,B ;GET JFN TO CHECK
DVCHR%
ERJMP CHKDV1 ;PROBABLY STDVX1 (NO SUCH DEVICE)
LOAD A,DV%TYP,B
CAIE A,.DVDSK ;SHOULD ALWAYS BE A DISK FILE TYPE
CHKDV1: ERROR BMBCM1,<?Device must be DISK>
POP P,B
POP P,A
RET
;HERE TO RESET BACK TO INIPTR
INIRST: CALL UNMAPB ;[345] RESET BUFFERS
MOVE D,INIPTR ;FINAL POINTER
CALL RSTSTK ;RESET STACK TO START OF WORLD
MOVEM D,RPSPTR ;RESET REPARSE POINTER
MOVEM D,CMDPTR ;COMMAND POINTER
RET
TTNOUT: MOVEI A,.PRIOU
NOUT%
JSERR
RET
BTNOUT: TXNN F,LTTYF ;LISTING TO TTY?
CALL TTNOUT ;NO, DO TTY FIRST
LPNOUT: SKIPN LPTJFN ;SKIP IF LISTING
RET
HRROI A,LPTBUF ;PUT NUMBER IN LOCAL BUFFER FIRST
NOUT%
JSERR
PUSH P,B
PUSH P,C
HRROI B,LPTBUF
CALL LPMSGQ ;TRANSMIT TO LPT
POP P,C
POP P,B
RET
TMSGQC: PUSH P,B
MOVEI 1,.PRIOU
DOBE%
RFPOS%
TRNE B,-1
CALL TCRLF
POP P,B
TMSGQ: MOVEI A,.PRIOU
SETZ C,
SOUT%
RET
TCRLF: HRROI B,[ASCIZ/
/]
CALLRET TMSGQ
BTMSQC: PUSH P,B
TXNE F,LTTYF
SKIPN A,LPTJFN
JRST BTMSC1
DOBE%
RFPOS
TRNN B,-1
JRST BTMSC2
BTMSC1: LPMSG <
>
BTMSC2: MOVE B,(P)
TXNN F,LTTYF
CALL TMSGQC
POP P,B
CALLRET LPMSGQ
BTMSGQ: PUSH P,B
TXNN F,LTTYF ;NOT TO TTY IF LOGGING IS TO TTY
CALL TMSGQ
POP P,B
LPMSGQ: SKIPN LPTJFN
RET
MOVE A,LPTLIN
CAIL A,PAGLEN ;AT END OF LISTING PAGE?
CALL LNEWPG ;YES, START A NEW ONE
MOVE A,LPTJFN
SETZ C,
PUSH P,B ;SAVE PTR
SOUT%
POP P,B ;RECOVER PTR
HLRZ A,B ;NORMALIZE IT
CAIN A,-1
HRLI B,(POINT 7,0)
LPTM1: ILDB A,B ;ACCOUNT LINE POSITION
JUMPE A,R ;NULL, DONE
CAIN A,.CHLFD ;EOL
JRST [ SETZM LPTPOS ;RESET
AOS LPTLIN ;COUNT LINES
JRST LPTM1]
CAIN A,.CHTAB ;TAB?
JRST [ MOVEI A,7 ;YES, BUMP
IORM A,LPTPOS
JRST .+1]
AOS LPTPOS ;COUNT ONE SPACE
JRST LPTM1
;START NEW LISTING PAGE
LNEWPG: SKIPE LPTJFN
SKIPE LPTPOS ;DON'T OUTPUT HEADER UNLESS AT START OF LINE!
RET
PUSH P,B
MOVE A,LPTJFN
MOVEI B,.CHFFD ;SEND A FORMFEED
BOUT%
HRROI B,LSTHDR ;SEND PAGE HEADER
SETZ C,
SOUT%
HRROI B,[ASCIZ / Page /]
SOUT% ;SEND PAGE NUMBER
AOS B,LPTPAG ;GET AND INCR PAGE COUNT
MOVEI C,^D10
NOUT%
JSERR
HRROI B,[ASCIZ /
/]
SETZ C,
SOUT% ;FINISH HEADER
MOVEI B,2 ;INIT LINE COUNT TO NUMBER LINES
MOVEM B,LPTLIN ; PRINTED ABOVE
POP P,B
RET
;TAB TO SPECIFIED COLUMN IN LISTING FILE
; B/ COLUMN
TAB: SKIPN LPTJFN
RET
MOVE A,LPTLIN
CAIL A,PAGLEN ;AT END OF LISTING PAGE?
CALL LNEWPG ;YES, START A NEW ONE
SUB B,LPTPOS ;COMPUTE NUMBER SPACES NEEDED
JUMPLE B,R ;MAYBE NONE
ADDM B,LPTPOS ;UPDATE POSITION
MOVE A,LPTJFN
MOVN C,B
HRROI B,SPACES
SOUT% ;OUTPUT THEM
RET
SPACES: ASCII / /
ASCII / /
;HERE TO PRINT CHECKSUM OF FILE
PRTCSM: MOVEI B,CSCOL ;CHECKSUM COLUMN
CALL TAB ;TAB TO CHECKSUM
HLRZ B,CHKCN0
HRRZ C,CHKCN0
ADD C,B ;MAKE IT 18-BITS WORTH
HLRZ B,C ;...
ADDI B,(C) ;...
MOVEI C,^D8 ;OCTAL RADIX
TXO C,NO%LFL+NO%ZRO
TLO C,6 ;6 COLUMNS
CALL LPNOUT
TXNE F,CS%SEQ ;SKIP IF SEQUENTIAL CHECKSUM
RET
LPMSG < P> ;FLAG AS BY-PAGES CHECKSUM
RET
; Here to say HELLO to QUASAR, get our PID etc.
QSRINI: SAVEQ
SETZM NXTRTP ; No next
CALL GQPID ;GET QUASAR'S PID IN QSRPID
RET ;FAILED
GJINF% ; GET JOB #
MOVE D,C ; SAVE THE JOB #
MOVEI A,3 ; LENGTH OF BLK
MOVEI B,C ; LOCATION OF BLK
MOVEI C,.MUSPQ ; SET PID QUOTA
MOVEI D+1,^D15 ; MAX NUMBER OF PIDS
MUTIL%
ERJMP [TMSGC <%Failed to set PID quota for DUMPER
>
JRST .+1]
MOVEI A,3
MOVEI B,C
MOVEI C,.MUCRE ; Create a PID for me
MOVEI D,.FHSLF ; No flags etc
MUTIL%
ERJMP [SETZM MYPID
TMSGC <?Unable to create a PID for DUMPER
>
RET]
MOVEM Q1,MYPID ; Remember mine too
MOVEI A,3
MOVEI B,C
MOVEI C,.MUPIC ; Set my PID on an interrupt channel
MOVE D,MYPID
MOVEI Q1,QSRCHN
MUTIL%
ERJMP [TMSGC <?Unable to set DUMPER PID on interrupt channel
>
RET]
MOVEI A,3
MOVEI B,C
MOVEI C,.MUSSQ ; Set receive/send quotas
MOVE D,MYPID
MOVEI Q1,030030 ;[313][355]30 for each to prevent over checkpointing
MUTIL%
ERJMP [TMSGC <%Unable to set send/receive quotas to 30
>
JRST .+1]
SETZ A, ; No bits
CALL HELLO ; Say we are here
RET ; SAY INIT FAILED
RETSKP
RETCLN: CALL GDBYE ; Say good-bye to QUASAR
JFCL ; UNABLE TO TELL QUASAR GOODBYE
CALL RELPID ; PID IS NO LONGER NEEDED
; Now process all built up retrieval message files
RETCL1: MOVX A,GJ%OLD+GJ%IFG+GJ%SHT
HRROI B,[ASCIZ/SYSTEM:*.RET-MSGS.*/]
GTJFN%
RET
PUSH P,A ; Save the JFN
HRRZS A ; Ditch the bits
MOVX B,<FLD(7,OF%BSZ)+OF%RD>
OPENF%
FATAL <RETCLN: Failed to open retrieval msg file>
MOVE B,[1,,.FBSIZ]
MOVEI C,C
GTFDB% ; Get # of bytes in the file
MOVNS C ; Faster with neg count
PUSH P,C ; Save file count
MOVE B,[SNDBDY,,SNDBDY+1]
SETZM -1(B)
BLT B,SNDBDY+NSNDBD-1 ; Clear the space
HRROI A,SNDBDY
MOVEM A,SNDTXT
HRROI B,[ASCIZ/ The following files have been restored/]
SETZB C,D
SOUT%
CALL IFHOST ; Output a host name if applicable
HRROI B,[ASCIZ/:
/]
SOUT%
POP P,C ; Recover file count
MOVE B,A ; Move pointer
HRRZ A,0(P) ; And JFN
SIN% ; Eat the file
HRROI A,TOLST
MOVEM A,SNDTO
HRRZ B,0(P)
MOVX C,<FLD(.JSAOF,JS%NAM)>
JFNS% ; Who gets this msg
HRROI B,[ASCIZ/Files restored to disk/]
MOVEM B,SNDSUB
MOVEI A,SNDTO ; Point to the sndmsg blk
CALL MLTLST
HRRZ A,0(P)
TXO A,CO%NRJ
CLOSF%
JFCL
TXZ A,CO%NRJ
DELF%
ERCAL JSERR1 ; Report error
ADJSP P,-1
JRST RETCL1 ; Do all there are
; Here to get ptr to next file to restore
; Returns: +1 no more retrievals; +2 1/ Ptr to retrieval blk
; **** Note **** RETWAT is a tag that QSRINT looks for - if DUMPER is
; in the WAIT JSYS at RETWAT-1, then QSRINT bumps the PC by one to cause
; the WAIT to terminate when the DEBRK in QSRINT is done. This skips over
; the JRST NXTRE1
NXTRET: SKIPN P6,NXTRTP ; Next request ready for us?
WAIT% ; No, wait until QUASAR gets to us
RETWAT: JRST NXTRE1 ; If here, we have a ptr in C
JFCL ; Is this needed????
SETZ A, ; In case we get none
SKIPN P6,NXTRTP ; Make sure we've a copy of the ptr
RET ; No more to do
NXTRE1: HRROI B,FILNM(P6) ; Point to file name
CALL TSTNAM ; Ok?
JRST [ RLJFN%
JFCL
CALL REFUSE ; Don't want this one
JRST NXTRET] ; Try again
RLJFN%
JFCL
MOVX A,GJ%OLD+GJ%XTN ;GET FLAGS
MOVEM A,RETBLK+.GJGEN ;SET IN BLOCK
MOVEI A,RETBLK ; Use blk with invisible etc.
HRROI B,FILNM(P6) ; Point to name
GTJFN%
ERJMP NXTRE2 ;GTJFN FAILED
MOVSI B,.FBLN0 ;[332] GET ENTIRE FDB
MOVEI C,FDB ;[332]
GTFDB%
MOVE B,A ;[332] COPY JFN
HRROI A,RCDSTR ;[332] SET TO BUILD STR:<DIR>, FOR RCDIR
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF> ;[332]
JFNS% ;[332]
MOVE A,B ;[332] COPY JFN BACK
RLJFN% ;DUMP JFN
JFCL
MOVE C,FDB+.FBCTL ;[332] GET CONTROL WORD
TXNN C,FB%OFF ; File offline?
JRST [ CALL RETOK ;YES, RELEASE RETRIEVAL REQUEST
JRST NXTRET] ; Try again
MOVX A,RC%EMO ;[332] MATCH EXACTLY
HRROI B,RCDSTR ;[332] POINTER TO STR:<DIR>
RCDIR% ;[332]
MOVE A,C ;[332] COPY DIRECTORY NUMBER
GTDAL% ;[332] GET DISK ALLOCATION
HRRZS FDB+.FBBBT ;[332] OFFLINE FILE SIZE
ADD B,FDB+.FBBBT ;[332] ADD REQUESTED FILE SIZE
CAMG B,A ;[332] ENOUGH WORKING QUOTA?
CAMLE B,C ;[332] ENOUGH PERMANENT QUOTA?
JRST [ HRROI P1,[ASCIZ/ Insufficient disk quota to RETRIEVE file.
/] ;[332] NO
JRST NXTRE3] ;[332] TELL USER AND GET NEXT REQUEST
MOVE A,P6 ; Hand the pointer back
RETSKP ; Return with ptr
NXTRE2: MOVEI A,.FHSLF ;[371] CURRENT PORCESS
GETER% ;[371] GET LAST ERROR
HRRZ A,B ;[371] ONLY THE ERROR CODE
CAIN A,GJFX16 ;INVALID DEVICE?
JRST [ TMSGC <%Structure not mounted, skipping file > ;YES
HRROI B,FILNM(P6)
CALL TMSGQ ;DISPLAY FILENAME
CALL TCRLF ;CRLF
CALL REFUSE ;REQUEUE THE REQUEST
JRST NXTRET] ;GET NEXT RETRIEVAL REQUEST
CALL BADOFP ;SOME OTHER ERROR, COMPOSE MESSAGE
NXTRE3: CALL WASHOU ;[332] TELL USER AND REQUESTOR
CALL RELQSR ;RELEASE THE RETRIEVAL REQUEST
JFCL
JRST NXTRET
; RETTAP - GET RETRIEVAL TAPE MOUNTED
; P6/ ADDRESS OF INFORMATION BLOCK OF FILE TO BE RETRIEVED
RETTAP: SAVEQ
CALL REWCV ;[335] REWIND CURRENT VOLUME
CALL UNLOAD
CALL MTCLS
RETTA1: LOAD A,TPNM2,(P6)
SKIPGE .ARODT(P6)
LOAD A,TPNM1,(P6) ; Use alternate tape #
CALL NSVOL ;CONVERT TO SIXBIT IF NECESSARY
MOVE Q1,A ;COPY VOLID TO A SAFE PLACE
MOVEI A,.SFMTA
TMON% ;TAPE DRIVE ALLOCATION ENABLED?
JUMPN B,RETTA3 ;YES, CALL FOR TAPE MOUNT THRU QUASAR
TMSGC <%Please mount tape >
MOVE A,Q1 ;GET VOLID
CALL TYP6 ;TYPE VOLID
HRROI A,[ASCIZ \ Is this tape available? \]
CALL YESNO ; Tape may be broken, lost, etc.
JUMPN A,[CALL NTAPER ;SAID YES, GET TAPE SPEC
JRST BMBCMD ;CAN'T
MOVEM Q1,VOLID6 ;SET CURRENT VOLID
JRST RETTA4]
RETTA2: HRROI P1,[ASCIZ/Tape currently unavailable
/]
CALL RETFAI ; Say that failed
JUMPE P6,R ; None left in Q
LOAD A,TPNM2,(P6) ; Get tape # on this one
SKIPGE .ARODT(P6)
LOAD A,TPNM1,(P6)
CALL NSVOL ;CONVERT TO SIXBIT IF NECESSARY
CAMN A,Q1 ; Same as last one?
JRST RETTA2 ; Yes, assume tape still unavailable
JRST RETTA1 ; Try this tape
RETTA3: MOVE A,Q1 ;GET VOLID
CALL MREQ ;SEND MOUNT REQUEST AND GET ANSWER
JRST [ HRROI A,[ASCIZ/$Try again? /] ;[357]FAILED
CALL YESNO
JUMPN A,RETTA3 ;WANTS TO TRY AGAIN
JRST RETTA2] ;DON'T TRY AGAIN
RETTA4: SETOM RTAPNO ;TAPE IS READY, SET TAPE # UNKNOWN
CALL MTOPNX
CALL REWCV ;REWIND IT
CALLRET MTCLS ;CLOSE AND RETURN TO CALLER
; Here to report file retrieved (to user)
RETOK: HRROI A,TOLST
MOVE B,TPRQUS ; Get requesting user
DIRST%
ERJMP R ; ? No such user?
MOVEI A,[0,,0 ; Either use old or create one
.NULIO,,.NULIO ; No I/O
-1,,[ASCIZ /SYSTEM/]
0
-1,,TOLST ; User name
-1,,[ASCIZ/RET-MSGS/] ; Type
0
0
0]
HRROI B,CRLF ; Use defaults
GTJFN%
FATAL <RETOK: Failed to get user retrieval file>
MOVX B,<FLD(7,OF%BSZ)+OF%APP>
OPENF%
FATAL <RETOK: Failed open retrieval msg file>
HRROI B,FILNM(P6) ; Point to the file
SETZB C,D
SOUT%
MOVEI B,.CHTAB
BOUT%
SETO B, ; time stamp it
SETZ C,
ODTIM%
HRROI B,CRLF
SOUT%
CLOSF%
ERJMP [TMSGC <%Failed to close retrieval msg file
>
JRST .+1]
CALL RELQSR ; Release the ret request
JFCL
RET
; Here to say we're done with a request block
RELQSR: SETZM NXTRTP ; Nothing there now
CALL ZIPMSS ; Setup to send
MOVE B,[REL.SZ,,.QOREL] ; Set to release the one we've done
MOVEM B,.MSTYP(P1) ; Length and type
MOVE B,TPTSK ; Include the task name
MOVEM B,REL.IT(P1) ; Internal task name
MOVE P1,[REL.SZ,,QSRMSS]
CALL SNDQSR ; Send the release
JRST [ TMSGC <%Failed to release task
>
RET] ; Just abort now
RETSKP
; Here to say "no thanks" to QUASAR's choice of retrieve requests
REFUSE: GTAD% ; Get timestamp
MOVE B,TPBLK+.ARODT
TXNE B,%EQUFT ; Using alternate tape?
TXO A,%EQUFT ; Yes, send it back that way
CALL REQUE
JFCL
RET
; Here to abort current retrieval; Assumes retrieval described by
; info in TPBLK
ABTRET: TMSGC <%Retrieve aborted
>
CALL RELQSR ; Tell QUASAR we're "done"
JFCL
CALL NXTRET ; Step to the next retrieval
SETOM VOLID6 ; None left
RETSKP
; Here when a retrieval failed; P1 has string ptr to error message
; Assumes current blk
RETFAI: SKIPGE .ARODT(P6) ; Already on 2nd set of tapes?
JRST [ CALL WASHOU ; Yes, Bomb this retrieve request
CALL RELQSR ; Release the task
JFCL
CALL NXTRET ; Get the next one
SETOM VOLID6 ; No next
RET]
MOVX A,%EQUFT ; Flag we want alternate tapes
CALL REQUE ; And requeue the request
JFCL
CALL NXTRET ; Get the next one
SETOM VOLID6 ; No next
RET
; BADOFP - COMPOSE ERROR MESSAGE FOR BAD OFFLINE FILE POINTER
; A/ ERROR CODE
; RETURNS +1: ALWAYS, P1/ -1 ,, ADDRESS OF ERROR MESSAGE
BADOFP: MOVE D,A ;SAVE ERROR CODE
HRROI A,TEMP ;BUILD MESSAGE HERE
HRROI B,[ASCIZ/ Cannot access OFFLINE file pointer - /] ;[343]
SETZ C,
SOUT%
MOVSI B,.FHSLF ;GET DUMMY HANDLE
HRR B,D ; ,, ERRORCODE
ERSTR% ;TACK ON ERROR STRING
JFCL
JFCL
HRROI B,CRLF ;[332]
SOUT% ;[332]
HRROI P1,TEMP ;RETURN ADDRESS OF TEXT TO CALLER
RET
; Here to report terrible failure to requestor
; Error message ptr in P1
WASHOU: TMSGC <%Failed to restore > ;[332]
MOVE Q1,P6
HRROI B,FILNM(Q1) ; Point to file name
CALL TMSGQ
TMSG < because:
> ;[332]
MOVE B,P1
CALL TMSGQ
HRROI A,TOLST
MOVEM A,SNDTO ; Pointer to TO list
HRROI B,[ASCIZ /PS:</]
SETZB C,D
SOUT%
MOVE B,TPRQUS ; Get user that requested it
DIRST%
ERJMP [MOVE A,SNDTO
HRROI B,[ASCIZ/*SYSTEM:RETRIEVAL.FAILURES/]
SETZB C,D
SOUT%
JRST WASHO1]
MOVEI C,">"
IDPB C,A
IDPB D,A ; End the thing
WASHO1: HRROI B,[ASCIZ/Files not retrieved/]
MOVEM B,SNDSUB ; Subject
HRROI A,SNDBDY
MOVEM A,SNDTXT ; Ptr to text part
HRROI B,FILNM(Q1) ; Point to file name
SETZB C,D
SOUT%
CALL IFHOST ; Host name (maybe)
HRROI B,[ASCIZ/ was not retrieved because:
/]
SOUT%
MOVE B,P1 ; Error message
SOUT%
MOVEI A,SNDTO ; Point to blk
CALL SNDMSG ; Send the failure message off
SOS NJFN1 ; Discount one of them
; SET THE BIT IN THE FILE'S FDB SAYING THAT THE RETRIEVAL FAILED
SETZM GJBLK ;ZERO GTJFN ARG BLOCK
MOVE A,[GJBLK,,GJBLK+1]
BLT A,GJBLK+.GJBFP
MOVX A,GJ%OLD+GJ%XTN
MOVEM A,GJBLK+.GJGEN ;OLD FILE, LONG GTJFN BLOCK
MOVX A,G1%IIN
MOVEM A,GJBLK+.GJF2 ;INCLUDE INVISIBLE FILES
MOVE A,[.NULIO,,.NULIO]
MOVEM A,GJBLK+.GJSRC ;JUST USE STRING
MOVEI A,GJBLK ;GET ARG BLOCK ADDRESS
HRROI B,FILNM(Q1) ;GET POINTER TO FILESPEC
GTJFN% ;GET JFN ON FILE
ERJMP WASHO2
MOVEI B,.ARRFL
ARCF% ;SET AR%RFL (RETRIEVE FAILED) IN FDB
ERJMP .+1
RLJFN% ;DUMP JFN
JFCL
WASHO2: RET
; Here to build message to user about files which have been archived
; JFN to current file in A
ARMSUS: PUSH P,B ; Save flag (0=> file flushed)
TLC A,-1
TLCN A,-1 ; Make sure of good ptr
HRLI A,(POINT 7)
PUSH P,A
SKIPN LTARDR ; Have a previous one?
JRST ARMSU2 ; No, start things going
HRROI B,TEMP
EXCH A,B
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS%
HRROI A,LTARDR
HRROI B,TEMP
STCMP% ; Compare them
JXE A,SC%LSS+SC%SUB+SC%GTR,ARMSU1
MOVEI A,SNDTO
CALL SNDMSG ; Send it off
ARMSU2: MOVE A,[POINT 7,LTARDR] ; Pointer to dir name for msg
MOVEM A,SNDTO
MOVE B,0(P) ; JFN of current file
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS% ; Save this directory
HRROI A,[ASCIZ /Collected files/]
SKIPG COLSW
HRROI A,[ASCIZ /Migrated files/]
SKIPE ARCSW
HRROI A,[ASCIZ /Archived files/]
MOVEM A,SNDSUB
HRROI A,SNDBDY ; Set up things
MOVEM A,SNDTXT ; Point to where text starts
HRROI B,[ASCIZ / The following files have been collected/]
SKIPG COLSW
HRROI B,[ASCIZ / The following files have been migrated/]
SKIPE ARCSW
HRROI B,[ASCIZ / The following files have been archived/]
SETZB C,D
SOUT%
CALL IFHOST ; Do host name (maybe)
HRROI B,[ASCIZ/:
/]
SOUT%
MOVEM A,CURSNP ; Save the pointer
ARMSU1: MOVE A,CURSNP
MOVE B,0(P)
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS%
SKIPN ARCSW ; The following only on archive runs
JRST ARMSU3
HRROI B,[ASCIZ/ File archived/]
SKIPN -1(P)
HRROI B,[ASCIZ/ File archived, contents deleted/]
SETZB C,D
SOUT%
ARMSU3: HRROI B,CRLF
SETZB C,D
SOUT%
MOVEM A,CURSNP ; Update the ptr
POP P,A
POP P,B ; Flag
RET
;SEVSIX - ROUTINE TO CONVERT 7-BIT ASCII TO 6-BIT
; A/ POINTER TO ASCIZ STRING
; B/ ADDRESS OF WORD IN WHICH TO STORE 6-BIT STRING
;RETURNS: +1, ALWAYS
SEVSIX: SETZM (B) ;ZERO WORD FIRST
HRLI B,(POINT 6,0) ;SET UP SIXBIT POINTER
MOVEI D,6 ;MAXIMUM OF 6 CHARACTERS
SEVLOP: ILDB C,A ;GET 7-BIT CHARACTER
JUMPE C,R ;RETURN IF END OF STRING
CAIL C,"a" ;LOWER CASE ALPHA?
TRZ C,40 ;YES, CHANGE TO UPPER CASE
SUBI C,40 ;CONVERT TO 6-BIT
IDPB C,B ;STORE CHARACTER
SOJG D,SEVLOP ;JUMP IF MORE CHARACTERS
RET
; Here to build scratch file to give to SND (actually do the SNDMSG)
; A has location of pointer to to SNDMSG block
; Which is 0: TO list ptr to be converted to directory # for MLTOWN
; 1: Subject ptr
; 2: Text body ptr
SNDMSG: PUSH P,A ; Save location of blk ptr
MOVX A,RC%EMO ; Exact match only
MOVE B,@0(P) ; Get pointer to directory string
SETZ C,
RCDIR%
TXNE A,RC%NOM+RC%AMB+RC%NMD ; Any form of failure?
JRST [ TMSGC <%RCDIR in SNDMSG failed
>
RET]
POP P,B ; Blk ptr location
MOVEM C,0(B) ; Directory #
MOVE A,B
CALL MLTOWN ; Do the work
RET
; Here to output a host name if applicable - A setup with output
; designator
IFHOST: PUSH P,A ; Save state of byte ptr
SKIPLE LHOSTN ; Any host #?
JRST [ HRROI B,[ASCIZ/ on /]
SOUT% ; Yes, add it
MOVE B,LHOSTN
CVHST%
ERJMP [MOVE A,0(P) ; Take back the " on "
JRST .+1]
JRST .+1]
POP P,0(P) ; Byte ptr no longer needed
RET
; Here to see if a file name matches specs given by user
; Accepts pointer to file name on tape in B
; Returns JFN for file on tape in A
TSTNAM: MOVX A,GJ%OFG+GJ%SHT ;SET TO PARSE NAME
GTJFN%
ERCAL JSERRR ;[307] SHOULDN'T FAIL, BUT BE READY
PUSH P,A
HRLZ P5,NJFN ;SCAN ALL SPECS GIVEN TO LOAD
TSTNA3: SKIPN B,JFNLST(P5) ;JFN STILL HERE?
JRST [ AOBJN P5,TSTNA3 ;NO, IT WAS COMPLETED
POP P,A ;RETURN JFN IN A
RET] ;DONE ALL FILESPECS, FAILED TO MATCH
MOVEI A,.WLJFN ;WANT TO COMPARE FILE SPECS
HRRZ C,0(P) ;GET CURRENT FILE JFN
WILD% ;FIND DIFFERENCES BETWEEN THE SPECS
ERJMP TSTN3A ;FAILED
TXNE A,WL%DEV!WL%DIR!WL%NAM!WL%EXT!WL%GEN ;ANY MISMATCHES?
JRST [ AOBJN P5,TSTNA3 ;YES, STEP TO NEXT FILESPEC
POP P,A ;DONE ALL FILESPECS, FAILED TO MATCH ANY
RET]
POP P,A ; Return JFN in A
RETSKP ; Is OK
;********TEMPORARY FOR REL 3A RUNNABILITY (several pages)
TSTN3A:MOVSI Q1,-NFFLD ;SCAN ALL FIELDS OF FILESPEC
AOBJN Q1,.+1 ;SKIP DEVICE FIELD
TSTNA2: HRROI A,FBUF1 ;GET STRINGS FOR NEXT FIELD
MOVE B,0(P) ;JFN FOR FILE ON TAPE
MOVE C,FFLDT(Q1)
JFNS% ;FOR FILE ON TAPE...
HRROI A,FBUF2
MOVE B,JFNLST(P5)
MOVE C,FFLDT(Q1)
JFNS% ;FOR LOAD FILESPEC
MOVE A,[POINT 7,FBUF1]
MOVE B,[POINT 7,FBUF2]
CALL CHKWLD ;SEE IF THIS FILE SPEC MATCHES
JRST [ AOBJN P5,TSTNA3 ;NOT EQUAL, STEP TO NEXT FILESPEC
POP P,A
RET] ;DONE ALL FILESPECS, FAILED TO MATCH ANY
TSTNA1: AOBJN Q1,TSTNA2 ;STEP TO NEXT FIELD
POP P,A
RETSKP ; Is ok
SUBTTL ROUTINE TO CHECK SPECS AGAINST A WILDCARD STRING
;THE FOLLOWING ROUTINE WAS RIPPED OUT FROM THE MONITOR MODULE
;LOOKUP. WHENEVER A JSYS IS WRITTEN TO DO THIS FUNCTION, THIS
;ROUTINE SHOULD BE REPLACED WITH THAT JSYS CALL.
; THIS SUBROUTINE COMPARES A STRING TO A GENERALIZED WILD-CARD
;MASK. A IS A POINTER TO THE STRING AND B IS A POINTER TO THE
;MASK.
; RETURNS +1 IF THE MASK CANNOT MATCH THE STRING. RETURNS +2
;IF IT DOES MATCH
CHKWLD: SAVEQ ;SAVE PERMANENT ACS
STKVAR <SVPTR,SVMSK> ;POINTERS TO LAST STAR POSITION
SETZ Q2, ;NO PREVIOUS ON THE FIRST BYTE
SETZM SVMSK ;NO PREVIOUS
MRTEST: MOVE Q3,Q2 ;SAVE PREVIOUS CHARACTER
ILDB Q2,B ;GET NEXT MASK CHARACTER
JUMPE Q2,EMASK ;END OF MASK
CAIN Q2,"%" ;A SINGLE CHARACTER WILD CARD?
JRST SNGL ;YES
CAIN Q2,"*" ;ANY WILD MATCH?
JRST ANY ;YES
CALL GETSRC ;GET NEXT STRING BYTE
RET ;END OF STRING AND FAILURE
CAIN Q2,(C) ;MATCH?
JRST MRTEST ;YES. GO ON
FAIL: SKIPN B,SVMSK ;NO. HAVE A PREVIOUS "*" ?
RET ;NO. CANT MATCH THESE TWO
IBP SVPTR ;STRETCH THE MASK
MOVE A,SVPTR ;MAKE IT CURRENT POINTER
JRST MRTEST ;AND TRY AGAIN
;GET SOURCE BYTE
GETSRC: ILDB C,A ;GET IT
JUMPE C,R ;IF END OF STRING, FAIL RETURN
RETSKP ;GOT ONE
;END OF MASK ROUTINE
EMASK: CAIN Q3,"*" ;DID MASK END IN A "*"
RETSKP ;YES. IT IS A MATCH
CALL GETSRC ;NO. AT END OF SOURCE TOO?
RETSKP ;YES. A MATCH
JRST FAIL ;NO. TRY TO STRETCH THE MASK
;FOUND A "%" IN THE MASK
SNGL: CALL GETSRC ;GET A SOURCE BYTE
RET ;NO MORE BYTES
JRST MRTEST ;GO GET MORE
;FOUND A "*" IN THE STRING
ANY: MOVEM A,SVPTR ;SAVE POINTER TO STRING
MOVEM B,SVMSK ;SAVE MASK POINTER
JRST MRTEST ;GO DO THE REST
;******END OF TEMP
; GMTINF - GET INFO ABOUT MT DEVICE
; A/ MT JFN
; RETURNS +1: ALWAYS
; A/ LABEL TYPE, VOLID/ ASCIZ VOLID, VOLID6/ SIXBIT VOLID
GMTINF: STKVAR <<MTIAB,3>>
MOVEI B,2
MOVEM B,MTIAB ;SET SIZE IN ARG BLOCK
MOVEI B,.MORLI ;FUNCTION CODE
MOVEI C,MTIAB ;ARG BLOCK ADDRESS
MTOPR% ;GET LABEL INFORMATION IN ARG BLOCK
MOVE D,1+MTIAB ;GET LABEL TYPE
; GET VOLID OF TAPE USING .MOINF MTOPR
MOVEI B,2
MOVEM B,MTIAB ;SET # OF ARGS TO RETURN
MOVEI B,.MOINF ;FUNCTION CODE
MTOPR%
MOVE A,.MOIID+MTIAB ;GET SIXBIT VOLID
MOVEM A,VOLID6 ;SAVE IT
MOVE B,[POINT 7,VOLID] ;GET DESTINATION POINTER
GMTIN1: JUMPN A,[LDB C,[POINT 6,A,5] ;GET CHARACTER FROM VOLID
LSH A,6 ;SHIFT THE REST OVER
ADDI C,40 ;CONVERT SIXBIT CHARACTER TO ASCII
IDPB C,B ;STORE ASCII CHAR
JRST GMTIN1] ;LOOP UNTIL LAST NON-BLANK
IDPB A,B ;TERMINATE WITH A NULL
MOVE A,D ;GET LABEL TYPE
RET
SUBTTL TAPE MOUNT/DISMOUNT LOGIC
; MREQ - PERFORM MOUNT DIALOGUE WITH QUASAR
; A/ SIXBIT VOLID
; RETURNS +1: ERROR, MESSAGE TYPED
; +2: SUCCESS, MTDSG/ MT DEVICE DESIGNATOR
MREQ: SAVEQ
MOVE Q1,A ;SAVE VOLID
SETZB A,MTDSG
CALL SETMNT ;DUMP CURRENTLY-MOUNTED TAPE
TMSGC <[Mounting tape volume >
MOVE A,Q1
CALL TYP6 ;TYPE VOLID
TMSG <]
>
DMOVE A,[EXP .MURSP,.SPQSR] ;GET PID OF REAL QUASAR
DMOVEM A,MPDB
MOVEI A,3 ;ARG BLOCK LENGTH
MOVEI B,MPDB ;ARG BLOCK ADDRESS
MUTIL% ;GET PID INTO MPDB+.IPCFR
ERJMP [HRROI B,[ASCIZ/?Cannot get PID for QUASAR/]
CALLRET TMSGQC]
; BUILD IPCF MOUNT MESSAGE FOR QUASAR
; (MESSAGE LENGTH AND MOUNT-REQUEST ENTRY LENGTH FILLED IN LATER)
MOVE Q3,[IOWD 1000,MBUF] ;GET STACK POINTER
MOVSI B,-TMSKSZ ;GET AOBJN POINTER TO SKELETON
PUSH Q3,TMSKEL(B) ;TRANSFER SKELETON WORD TO MESSAGE
AOBJN B,.-1 ;LOOP UNTIL ALL OF SKELETON IS MOVED
; SKIPE DENSIT ;ANY DENSITY SPECIFIED?
; JRST [ PUSH Q3,[2,,.TMDEN] ;YES, CREATE DENSITY SUBENTRY
; PUSH Q3,DENSIT
; JRST .+1]
PUSH Q3,[2,,.TMVOL]
PUSH Q3,Q1 ;CREATE VOLID ENTRY IN IPCF MESSAGE
; NOW FIX UP THE COUNT FIELDS IN THE IPCF MESSAGE
HRRZ A,Q3 ;GET ADDRESS OF LAST WORD OF MESSAGE
SUBI A,MBUF-1 ;COMPUTE SIZE OF MESSAGE
STOR A,MS.CNT,MBUF+.MSTYP ;STORE IN GALAXY HEADER
SUBI A,.MMHSZ ;COMPUTE SIZE OF MOUNT ENTRY
STOR A,AR.LEN,MBUF+.MMHSZ ;STORE IN MOUNT ENTRY LENGTH FIELD
MOVEI A,MBUF+.MMHSZ+.MEHSZ ;POINT AT FIRST SUBENTRY
TMX2: AOS MBUF+.MMHSZ+.MECNT ;COUNT THIS SUBENTRY
LOAD B,AR.LEN,(A) ;GET SIZE OF SUBENTRY
ADD A,B ;POINT AT NEXT SUBENTRY
CAIGE A,(Q3) ;ANOTHER SUBENTRY?
JRST TMX2 ;YES, CONTINUE SCAN
; SEND IPCF MESSAGE TO QUASAR
MOVEI B,MPDB-1 ;SET UP PDB FOR MSEND
PUSH B,[IP%CPD+IP%CFV] ;FLAGS
PUSH B,[0] ;SENDER'S PID (WILL BE CREATED)
ADJSP B,1 ;RECEIVER'S PID FILLED IN ALREADY
PUSH B,[1000,,<MBUF_-9>] ;PACKET DESCRIPTOR
MOVEI A,4 ;GET SIZE OF PDB
MOVEI B,MPDB ;GET ADDRESS OF PDB
MSEND% ;SEND REQUEST TO QUASAR
ERRORJ TCRLF,<?Could not send IPCF mount request>
; MOUNT MESSAGE HAS BEEN SENT, NOW RECEIVE THE REPLY
MOVE A,MPDB+.IPCFS
MOVEM A,MPDB+.IPCFR ;SET RECEIVER'S PID
MREQ2: MOVX A,IP%CFV
MOVEM A,MPDB+.IPCFL ;STORE FLAGS
MOVE A,[1000,,<MBUF/1000>]
MREQ3: MOVEM A,MPDB+.IPCFP ;POINTER TO MESSAGE BUFFER
MOVEI A,.IPCFC+1 ;PDB LENGTH
MOVEI B,MPDB ;PDB ADDRESS
MRECV% ;RECEIVE MESSAGE
ERJMP [MOVEI A,.FHSLF ;[371] CURRENT PROCESS
GETER% ;[371] GET LAST ERROR
HRRZ A,B ;[371] ONLY ERROR CODE
CAIE A,IPCF16 ;ERROR BECAUSE OF WRONG DATA MODE?
ERRORJ TCRLF,<?Error receiving mount response> ;NO
SETZM MPDB+.IPCFL ;YES, CLEAR IP%CFV
MOVE A,[1000,,MBUF] ;GET POINTER FOR NON-PAGE-MODE
JRST MREQ3] ;TRY AGAIN
MOVE A,MPDB+.IPCFC
TXNN A,SC%WHL+SC%OPR ;IS SENDER LEGIT?
JRST MREQ2 ;NO, TRY AGAIN
LOAD Q3,MS.TYP,MBUF+.MSTYP ;GET MESSAGE TYPE
JN MF.FAT,MBUF+.MSFLG,CKMNT1 ;JUMP IF MOUNT FAILED
CAIE Q3,.QOMNA ;IS IT A RESPONSE TO MOUNT REQUEST?
JRST MREQ2 ;NO, IGNORE IT
CALL MRKPID ;DELETE MOUNTING PID
MOVEI A,[ 1
.MNRDV,,CKMDV]
CALL SCNMBK ;SUCCESSFUL MOUNT, GET DESIGNATOR
MOVE A,MTDSG
CALL SETMNT ;REMEMBER I HAVE MOUNTED A TAPE
HRROI A,MTDEV ;DESTINATION STRING POINTER
MOVE B,MTDSG
DEVST% ;CONVERT DESIGNATOR TO STRING
ERCAL JSERRR ;[307] FAILED, TYPE JSYS ERROR AND RETURN
MOVEI B,":"
IDPB B,A ;BUILD FILESPEC
SETZ B,
IDPB B,A
MOVX A,GJ%SHT
HRROI B,MTDEV ;GET POINTER TO FILESPEC
GTJFN% ;GET JFN ON MT DEVICE
ERCAL JSERRR ;[307] FAILED, TYPE JSYS ERROR AND RETURN
CALL CHKMTJ ;CHECK OUT MT DEVICE
JRST [ SETZ A, ;MT DEVICE IS BAD (SHOULDN'T HAPPEN)
CALLRET SETMNT] ;DISMOUNT AND TRY AGAIN
TMSGC <[Volume >
MOVE A,Q1 ;GET VOLID
CALL TYP6 ;TYPE IT
TMSG < mounted]
>
RETSKP ;EVERYTHING OK, RETURN +2
CKMDV: MOVE A,1(A) ;GET DESIGNATOR
MOVEM A,MTDSG ;STORE IT
ASND% ;ASSIGN MT DEVICE TO THIS JOB
JFCL
RET
; MOUNT FAILED
CKMNT1: CALL MRKPID ;DELETE MOUNTING PID
CAIN Q3,MT.TXT ;TEXT MESSAGE?
JRST [ MOVEI A,MBUF+.OHDRS+ARG.DA ;YES, GET ADDRESS OF TEXT
CALLRET CKMTX] ;TYPE ERROR MESSAGE AND TAKE +1 RETURN
MOVEI A,[2
.MNREC,,CKMEC
.MNRTX,,CKMTX]
CALLRET SCNMBK ;ANALYZE REPLY AND RETURN +1
CKMTX: HRRO Q1,A ;GET STRING POINTER TO TEXT
TMSG <?>
MOVE B,Q1 ;GET STRING POINTER IN B FOR TMSGQ
CALL TMSGQ ;DISPLAY IT
CALLRET TCRLF ;TYPE CRLF AND RETURN
CKMEC: MOVE Q1,(A) ;GET ERROR CODE
TMSGC <?Cannot mount tape, >
MOVEI A,.PRIOU
MOVE B,Q1 ;GET ERROR CODE
HRLI B,.FHSLF ;APPEASE ERSTR WITH FORKHANDLE
SETZ C, ;NO LIMIT
ERSTR% ;TYPE ERROR MESSAGE
JFCL
JFCL
CALLRET TCRLF
; ROUTINE TO DELETE MOUNTING PID IN MPDB+.IPCFR
MRKPID: MOVEI A,.MUDES
MOVEM A,MPDB+1 ;BUILD MUTIL ARGUMENT BLOCK
MOVEI A,2 ;ARG BLOCK LENGTH
MOVEI B,MPDB+1 ;ARG BLOCK ADDRESS
MUTIL% ;DESTROY THE PID I USED TO DO THE MOUNT
JFCL
RET
; SKELETON IPCF MESSAGE FOR TAPE MOUNT
TMSKEL: 0,,.QOMNT ;GLX HEADER - LENGTH,,TYPE
0 ;GLX HEADER - FLAGS
0 ;GLX HEADER - ACK CODE
0 ;MOUNT MESSAGE FLAGS
SIXBIT/RETRVL/ ;MOUNT REQUEST NAME
1 ;MOUNT ENTRY COUNT
0,,.MNTTP ;MOUNT ENTRY LENGTH,,TYPE
0 ;MOUNT ENTRY FLAGS
0 ;SUBENTRY COUNT (FILLED IN LATER)
2,,.TMSET ;SETNAME SUBENTRY
SIXBIT/RETRVL/
2,,.TMDRV ;DRIVE-TYPE SUBENTRY
.TMDR9
4,,.TMRMK
ASCIZ/RETRIEVAL TAPE/
TMSKSZ==.-TMSKEL ;LENGTH OF SKELETON
; SCNMBK - SCAN REPLY TO MOUNT REQUEST AND CALL BLOCK-PROCESSORS
; A/ ADDRESS OF BLOCK-TYPE/PROCESSOR-ADDRESS LIST
; RETURNS +1: ALWAYS
SCNMBK: SAVEQ
MOVE Q1,MBUF+.OARGC ;GET # OF BLOCKS IN LIST
MOVEI Q2,MBUF+.OHDRS ;GET ADDRESS OF FIRST BLOCK
MOVE Q3,A ;COPY CALLER'S LIST ADDRESS
SCNMB1: SOJL Q1,R ;EXIT IF NO MORE BLOCKS TO SCAN
MOVEI A,1(Q2) ;GET ADDRESS OF DATA IN BLOCK
HRRZ B,(Q2) ;GET BLOCK TYPE CODE
HLRZ C,(Q2) ;GET BLOCK LENGTH
ADD Q2,C ;POINT Q2 AT NEXT BLOCK
MOVN C,(Q3) ;GET NEGATIVE # OF LIST ENTRIES
MOVSS C ;MOVE TO LEFT HALF FOR AOBJN POINTER
HRRI C,1(Q3) ;MAKE POINTER TO CALLER'S LIST
SCNMB2: HLRZ D,(C) ;GET TYPE CODE FROM LIST
CAMN B,D ;DOES IT MATCH THE CODE FOR THIS BLOCK?
JRST [ HRRZ D,(C) ;YES, GET PROCESSOR ROUTINE ADDRESS
CALL (D) ;INVOKE PROCESSOR
JRST SCNMB1] ;GO SCAN NEXT BLOCK
AOBJN C,SCNMB2 ;CONTINUE LIST SCAN
JRST SCNMB1 ;UNRECOGNIZED BLOCK TYPE, IGNORE IT
; GQPID - GET QUASAR'S PID IN "QSRPID"
; RETURNS +1: FAILED, MESSAGE TYPED
; +2: SUCCESS
GQPID: SKIPN .JBOPS ;PRIVATE GALAXY?
JRST [ SAVEQ ;NO
MOVEI Q1,.MURSP ;MUTIL FUNCTION CODE
MOVEI Q2,.SPQSR ;INDEX INTO SYSTEM PID TABLE
MOVEI A,3 ;ARG BLOCK LENGTH
MOVEI B,Q1 ;ARG BLOCK ADDRESS
MUTIL%
ERROR R,<?Cannot get PID for QUASAR>
MOVEM Q3,QSRPID ;STORE QUASAR'S PID
RETSKP]
MOVE B,[[EXP IP%CPD,0,0,<20,,PDB+4>,.IPCIW,0],,PDB]
BLT B,PDB+5 ;MOVE PDB AND PART OF MESSAGE TO BUF
GJINF% ;GET USER# IN A
MOVE B,A ;COPY INTO B
MOVE A,[POINT 7,PDB+6] ;GET POINTER
MOVEI C,"["
IDPB C,A
DIRST% ;ADD USER NAME
JFCL
HRROI B,[ASCIZ/]QUASAR/]
SETZ C, ;STOP ON NULL
SOUT% ;ADD PID NAME
MOVEI A,4
MOVEI B,PDB
MSEND% ;SHIP OFF QUESTION TO INFO
JSHLT
SETZM PDB ;CLEAR FLAGS WORD FOR RECEIVE
MOVE C,PDB+1 ;GET MY PID SO I CAN RECEIVE
MOVE D,[20,,PDB+4] ;SIZE,,MSGADDR
DMOVEM C,PDB+2 ;SET WORDS 2 & 3 OF PDB
MRECV% ;RECEIVE INFO'S REPLY
JSHLT
MOVEI A,2 ;ARG BLOCK LENGTH
MOVEI B,C ;ARG BLOCK ADDRESS
MOVEI C,.MUDES ;MUTIL FUNCTION CODE
MOVE D,PDB+.IPCFR ;PID
MUTIL% ;DELETE PID USED FOR TALKING TO INFO
JFCL
LOAD A,IP%CFE,PDB+.IPCFL ;ERROR FROM INFO?
JUMPN A,[TMSGC <?Can't get PID for > ;YES
HRROI B,PDB+6
CALL TMSGQ ;DISPLAY PID NAME
RET]
MOVE A,PDB+5 ;GET PRIVATE QUASAR'S PID
MOVEM A,QSRPID ;STORE IT
RETSKP
; SETMNT - SET OR CLEAR CURRENTLY-MOUNTED TAPE
; THIS APPLIES ONLY TO TAPES THAT DUMPER HAS MOUNTED VIA QUASAR
; A/ MT DEVICE DESIGNATOR OR 0 TO CLEAR
SETMNT: PUSH P,A ;SAVE NEW DESIGNATOR
CALL MTCLS
SKIPE A,MNTDSG ;HAVE DESIGNATOR CURRENTLY?
RELD% ;YES, DUMP IT
JFCL
POP P,MNTDSG ;SET NEW DESIGNATOR
; CREATE OR DELETE LOGICAL NAME FOR MOUNTED TAPE
MOVEI A,.CLNJ1 ;ASSUME DELETING LOGICAL NAME
SKIPE B,MNTDSG ;SETTING NEW DEVICE?
JRST [ HRROI A,MTDEV ;YES
DEVST% ;COMPOSE LOGICAL NAME
JFCL ; DEFINITION STRING
MOVEI B,":"
IDPB B,A
SETZ B,
IDPB B,A
MOVEI A,.CLNJB ;SET TO CREATE LOGICAL NAME
JRST .+1]
HRROI B,[ASCIZ/RETRVL/] ;LOGICAL NAME = RETRVL:
HRROI C,MTDEV ;POINTER TO DEFINITION, MTn:
CRLNM% ;CREATE OR DELETE LOGICAL NAME
JFCL
RET
SUBTTL Routines to communicate with QUASAR
; Here on PSI for IPCF message arrived
QSRINT: MOVEM 17,INT3AC+17
MOVEI 17,INT3AC
BLT 17,INT3AC+16
MOVE P,[IOWD NINTPD,INT3PD]
PUSH P,40
RECALL: CALL RCVQSR ;[314] Read the message
JRST [ POP P,40 ;[314]
MOVSI 17,INT3AC ;[314]
BLT 17,17 ;[314]
DEBRK%] ;[314] Done here
MOVE A,.MSFLG(P1) ; Get flags
MOVE B,.MSCOD(P1) ; Get ack code
TXNE A,MF.ACK ; Guy want an ACK?
CALL DOACK ; Ack him now
TXNE A,MF.NOM ; No message?
JRST QSRRET ; Yes, just eat that
TXNN A,MF.WRN ; Warning message?
TXNE A,MF.FAT ; Fatal message
JRST QSTEXT ; Is a message, print it
LOAD A,MS.TYP,.MSTYP(P1), ; Get type code
CAIN A,.QONEX ; Next job msg?
JRST QSNXT ; Yes
CAIN A,.QOABO ; Abort msg?
JRST QSABT ; Yes
CAIN A,.QORCK ; Checkpoint?
JRST QSCKPT ; Yes
CAIN A,.QOSUP ; Setup message?
JRST QSSETU ; Yes
TMSGC <%Unknown message type received from QUASAR>
QSRRET: JRST RECALL ;[314] loop to check queues
QSNXT: MOVE A,.EQITN(P1) ; Get task name
MOVEM A,TPTSK ; And remember it
MOVX A,RC%EMO ; Exact match pls
HRROI B,.EQOWN(P1) ; Point to owner of request
SETZ C, ; No stepping info
RCUSR%
ERJMP .+2 ; Bombed
TXNE A,RC%NOM+RC%AMB+RC%NMD+RC%WLD ; Failure or wild?
JRST [ TMSGC <%File will not be processed because user directory is not longer valid.
>;[344]
TMSGC <%User: >
HRROI B,.EQOWN(P1) ;[344] Name of (Non)-User
CALL TMSGQ ;[344]
TMSG <, File: > ;[344]
LOAD B,EQ.LOH,.EQLEN(P1);[344]
ADD B,P1 ;[344] Point to the FP
LOAD C,FP.LEN,(B) ;[344] Get FP length
ADD B,C ;[344] Point to FD
HRROI B,.FDFIL(B) ;[344] Point to filespec
CALL TMSGQ ;[344] Output filespec
CALL TCRLF ;[344] Spacing for readability
CALL RELQSR ;[344] Release the request
JFCL ;[344]
JRST QSRRET] ;[344] Leave it
MOVEM C,TPRQUS ; Remember who
HRLI A,.EQLIM+1(P1) ; From there
HRRI A,.ARTP1+TPBLK ; To there
BLT A,TPBLK+.ARSF2 ; Move tape info
MOVE A,.EQLIM(P1) ; Get time & flag
MOVEM A,.ARODT+TPBLK
MOVEI P1,QSRMSR
HRROI A,TAPNAM ; Move file name to there
LOAD B,EQ.LOH,.EQLEN(P1)
ADD B,P1 ;POINT TO THE FP
LOAD C,FP.LEN,(B) ;GET FP LENGTH
ADD B,C ;POINT TO FD
HRROI B,.FDFIL(B) ;POINT TO FILESPEC
SETZB C,D
SOUT% ; Move file name
HRROI A,TPACT ; Where account should be
HRROI B,.EQACT(P1) ; Where it is now
SETZB C,D
SOUT% ; Move account too
MOVEI A,TPBLK
MOVEM A,NXTRTP
AOS NJFN1 ; We have something to do now
QSNXT1: HLRZ A,CHNTAB+QSRCHN ; Get level we're at
HRRZ B,@LEVTAB-1(A) ; Get return PC
CAIN B,RETWAT ; Waiting on us?
AOS @LEVTAB-1(A) ; Yes, make him go again
JRST QSRRET
QSSETU: MOVE A,SUP.TY(P1) ; Get object type
CAIE A,.OTRET ; Of type we expect?
JRST [ TMSGC <%Received invalid object type in SETUP message
>
JRST QSRRET]
MOVE A,SUP.FL(P1) ; Get flags
TXNE A,SUFSHT ; Shutdown rather than start up?
JRST QSNXT1 ; Right, leave as though we got a null
; request
MOVE B,SUP.UN(P1) ; Get the unit #
MOVE C,SUP.NO(P1) ; And NODE name
CALL ZIPMSS ; Setup to send
MOVE A,[RSU.SZ,,.QORSU] ; Respond to setup
MOVEM A,.MSTYP(P1) ; Length and type
MOVE A,[.OTRET] ; Object type
MOVEM A,RSU.TY(P1)
MOVEM B,RSU.UN(P1) ; Unit number
MOVEM C,RSU.NO(P1) ; Node name
MOVX A,%RSUOK ; Say SETUO KO
MOVEM A,RSU.CO(P1) ; Response code
SETZM RSU.DA(P1) ; No attributes
MOVE P1,[RSU.SZ,,QSRMSS]
CALL SNDQSR ; Send it
JRST [ TMSGC <%SETUP REPLY message send failed
>
JRST QSRRET]
JRST QSRRET
QSABT: TMSGC <%Abort received
>
AOS ABTFLG ; Note we got the abort poke
JRST QSRRET
QSCKPT: JRST QSRRET ;TAKE NO ACTION
QSTEXT: TXNE A,MF.FAT ; Fatal msg?
JRST [ PUSH P,A
TMSGC <?Fatal: >
POP P,A
JRST .+1]
TXNE A,MF.WRN ; Warning?
JRST [ PUSH P,A
TMSGC <%Warning: >
POP P,A
JRST .+1]
HRROI B,.OHDRS+ARG.DA(P1) ;GET ADDRESS OF TEXT
CALL TMSGQ ;PRINT IT
HRROI B,CRLF
CALL TMSGQ
JRST QSRRET ; Done here
; Here to send a message ; P1 HAS LENGTH,,MSG ADDR
SNDQSR: MOVEI B,PDB-1 ; WHERE TO BUILD PDB
PUSH B,[0] ; PID's are known
PUSH B,MYPID ; SENDER'S PID
PUSH B,QSRPID ; RECEIVER'S PID
PUSH B,P1 ; WHERE ACTUAL MSG IS
MOVEI A,.IPCFP+1 ; PDB LENGTH
MOVEI B,PDB
MSEND% ; SEND MSG
RET ; FAILED, TELL CALLER
RETSKP
; Here to receive a message; P1 HAS ADDR OF DATA
RCVQSR: MOVEI B,PDB-1
PUSH B,[IP%CFB] ;[314] DO NOT BLOCK
PUSH B,[0] ; SENDER'S PID
PUSH B,MYPID
PUSH B,[NQSRML,,QSRMSR]
RCVQS1: MOVEI A,4
MOVEI B,PDB
MRECV% ; READ IT
ERJMP [MOVEI A,.FHSLF ;[371] CURRENT PORCESS
GETER% ;[371] GET LAST ERROR
HRRZ A,B ;[371] ONLY THE ERROR CODE
CAIN A,IPCFX2 ;[314] No more messages
RET ;[314] Go and DEBRK
CAIE A,IPCF16 ; SENT IN PAGE MODE?
CALL JSERRR ;[307] 1 FAILED, TYPE ERROR AND RETURN
MOVX A,IP%CFV ; SAY PAGE MODE
MOVEM A,PDB+.IPCFL
MOVE A,[1000,,<QSRMSR/PGSIZ>]
MOVEM A,PDB+.IPCFP
JRST RCVQS1]
MOVEI P1,QSRMSR ; Point to RECEIVed message
MOVE A,PDB+.IPCFS ; GET SENDER'S PID
CAMN A,QSRPID ; MATCH QUASAR'S?
RETSKP ; YES, RETURN WITH MSG IN HAND
TMSGC <%Message received not from QUASAR
>
JRST RCVQSR ; TRY AGAIN
; Here to reque a retrieval request
REQUE: SETZM NXTRTP ; Current block now invalid
PUSH P,P1
CALL ZIPMSS ; Setup to send
MOVE B,[REQ.SZ,,.QOREQ]
MOVEM B,.MSTYP(P1) ; Length, type
MOVE B,TPTSK ; External task
MOVEM B,REQ.IT(P1) ; Internal task name
MOVEM A,REQ.IN(P1) ; Timestamp
HRLI B,.ARTP1(P6) ; COPY TAPE INFO FROM
HRRI B,REQ.IN+1(P1) ; TO
BLT B,REQ.IN+1+.ARSF2(P1) ; Copy in tape info
MOVE P1,[REQ.SZ,,QSRMSS]
CALL SNDQSR ; Send it to QUASAR
JRST [ TMSG <?SNDQSR failed in REQUE
>
POP P,P1
RET]
POP P,P1
RETSKP
; Here to send goodbye message
GDBYE: MOVX A,HEFBYE ; SAY GOOD-BYE
CALL HELLO ; AND DISSAPPEAR
RET
RETSKP
; Here to ACK a message
DOACK: MOVE B,.MSCOD(P1) ; Get ack code
MOVEM B,.MSCOD+ACKBLK
PUSH P,P1
MOVE P1,[MSHSIZ,,ACKBLK]
CALL SNDQSR ; Send it
JRST [ TMSGC <%ACK send failed
>
POP P,P1
RET]
POP P,P1
RET
; Here to release MYPID
RELPID: SKIPN A,MYPID ; Have PID?
RET ; No, done
MOVEM A,PDB+1
MOVEI A,.MUDES ; Delete the PID
MOVEM A,PDB
MOVEI A,2
MOVEI B,PDB
MUTIL%
ERROR R,<%Failed to release PID>
SETZM MYPID
SETZM QSRPID ; Forget about QUASAR too
RET
; Here to send hello message; A Has flags desired to be on
HELLO: HRRZS A ; No LH flags
PUSH P,P1 ; SAVE THIS
CALL ZIPMSS ; Setup for sending
MOVE B,[HEL.SZ,,.QOHEL] ; HELLO MSG
MOVEM B,.MSTYP(P1) ; Drop in length & type
MOVE B,[SIXBIT /DUMPER/]
MOVEM B,HEL.NM(P1) ; Program name
HRLI A,%%.QSR ; Internal version,,flags
MOVEM A,HEL.FL(P1) ; Version and flags
MOVE B,[1,,1] ; 1 object type, 1 concurrent job
MOVEM B,HEL.NO(P1)
MOVE B,[.OTRET] ; Which is a retrieval
MOVEM B,HEL.OB(P1) ; Object type
MOVE P1,[HEL.SZ,,QSRMSS]
CALL SNDQSR ; SEND IT
JRST [ PUSH P,A
TMSGC <%SNDQSR failed in HELLO
>
POP P,A
CALL JSERR1 ; REPORT ERROR
POP P,P1
RET]
POP P,P1
RETSKP
; Here to clear send page & set up P1 pointing to it
ZIPMSS: SETZM QSRMSS
MOVE P1,[QSRMSS,,QSRMSS+1]
BLT P1,QSRMSS+777 ; Clear the entire page
MOVEI P1,QSRMSS
RET
; Here to initialize the USAGE block before making an entry
USAINI: MOVE A,[VUSABL,,USABLK]
BLT A,USABLK+NUSABL-1
RET
; drop tape info into USAGE blk, A should point to ARCF style blk
USATAP: LOAD B,TPNM1,(A) ; Get Tape 1 ID
MOVEM B,USABLK+12
LOAD B,TSN1,(A)
MOVEM B,USABLK+14 ; Saveset 1
LOAD B,TFN1,(A)
MOVEM B,USABLK+16 ; Tapefile 1
LOAD B,TPNM2,(A) ; Get tape 2 ID
MOVEM B,USABLK+20
LOAD B,TSN2,(A)
MOVEM B,USABLK+22 ; Saveset # 2
LOAD B,TFN2,(A)
MOVEM B,USABLK+24
RET
VUSABL: USENT. (.-.,1,0) ; Type to be filled in, version
USACT. (USAACT,,^D39) ; [347] Account string (used to be at +4)
USSSI. (USASSI) ; [347] Structure name (used to be at +2)
USDIR. (USADIR,,^D39) ; [347] Directory name (used to be at +3)
USUSG. (.-.,US%IMM,6) ; # pages 000000-999999
USTP1. (.-.,US%IMM,6) ; Tape 1 ID
USTS1. (.-.,US%IMM,4) ; Tape 1 saveset #
USTF1. (.-.,US%IMM,6) ; Tape 1 tape file #
USTP2. (.-.,US%IMM,6) ; Tape 2 ID
USTS2. (.-.,US%IMM,4) ; Tape 2 saveset #
USTF2. (.-.,US%IMM,6) ; Tape 2 tape file #
USRSN. (.-.,US%IMM,1) ; Reason offline line code
MASK: 0
FB%PRM+FB%NOD+FB%FCF ; CTL (FB%INV IS SPECIAL-CASED)
0 ; EXL
0 ; ADR
0 ; PRT
777777777777 ; CRE
0 ;OLD AUTHOR WRITER WORD
0 ; GEN
0 ; ACT
777717000000 ; BYV
777777777777 ; SIZ
777777777777 ; CRV
777777777777 ; WRT
777777777777 ; REF
777777777777 ; CNT
-1 ;[320] BK0
0 ; BK1
0 ; BK2
AR%1ST+AR%WRN ; BBT
0 ; NET
777777777777 ; USW
0 ; GNL
0 ; NAM
0 ; EXT
0 ;.FBLWR POINTER
0 ; TDT
0 ; FET
0 ; TP1
0 ; SS1
0 ; TP2
0 ; SS2
IFN .-MASK-.FBLEN,<PRINTX ** FDB MASK ARRAY SIZE WRONG **>
NWMASK: 0
FB%TMP+FB%PRM+FB%NOD+FB%FCF ;(FB%INV IS SPECIAL-CASED)
0
0
0
0
0
0
0
777717000000
777777777777
777777777777
777777777777
777777777777
0
0
0
0
0
0
777777777777
0
0
0
0 ;.FBLWR POINTER WORD
0 ; TDT
0 ; FET
0 ; TP1
0 ; SS1
0 ; TP2
0 ; SS2
IFN .-NWMASK-.FBLEN,<PRINTX ** FDB NWMASK ARRAY SIZE WRONG **>
;FDB MASK FOR INTERCHANGE MODE RESTORE
ICMASK: 0 ;FBHDR
0 ;FBCTL
0 ;FBEXL
0 ;FBADR
0 ;FBPRT
0 ;FBCRE
0 ;FBAUT
0 ;FBGEN/FBDRN
0 ;FBACT
007700,,0 ;FBBYV
-1 ;FBSIZ
0 ;FBCRV
-1 ;FBWRT
0 ;FBREF
0 ;FBCNT
REPEAT 3,<0> ;FBBK0-FBBK2
0 ; BBT
0 ; NET
0 ;FBUSW
0 ;FBGNL
0 ;FBNAM
0 ;FBEXT
0 ;FBLWR
0 ; TDT
0 ; FET
0 ; TP1
0 ; SS1
0 ; TP2
0 ; SS2
IFN .-ICMASK-.FBLEN,<PRINTX ** FDB ICMASK ARRAY SIZE WRONG **>
;FDB MASK FOR CHECK
CKMASK: 0 ;FBHDR
FB%TMP+FB%PRM+FB%NOD+FB%INV+FB%FCF ;FBCTL
0 ;FBEXL
0 ;FBADR
0,,777777 ;FBPRT
-1 ;FBCRE
0 ;FBAUT
0 ;FBGEN/FBDRN
0 ;FBACT
777717,,0 ;FBBYV
-1 ;FBSIZ
-1 ;FBCRV
-1 ;FBWRT
-1 ;FBREF
-1 ;FBCNT
REPEAT 3,<0> ;FBBK0-FBBK2
0 ; BBT
-1 ; NET
-1 ;FBUSW
0 ;FBGNL
0 ;FBNAM
0 ;FBEXT
0 ;FBLWR
0 ; TDT
-1 ; FET
0 ; TP1
0 ; SS1
0 ; TP2
0 ; SS2
IFN .-CKMASK-.FBLEN,<PRINTX ** FDB CKMASK ARRAY SIZE WRONG **>
MSK10X: R ; Header
R ; FDBCTL
R ; FDBEXT
R ; FDBADR
R ; FDBPRT
TIM10X ; FDBCRE (time format)
R ; FDBUSE
R ; FDBVER
R ; FDBACT
R ; FDBBYV
R ; FDBSIZ
TIM10X ; FDBCRV (time)
TIM10X ; FDBWRT (time)
TIM10X ; FDBREF (time)
R ; FDBCNT
CLRMSK ; FDBBK0
REPEAT 4,<R> ; FDBBK1-FDBBK4
R ; FDBUSE
REPEAT <.FBLEN-<.-MSK10X>>,<R> ; Pad out rest of table
FDBNAM: SIXBIT /HEADER/
SIXBIT /.FBCTL/
SIXBIT /.FBEXT/
SIXBIT /.FBADR/
SIXBIT /.FBPRT/
SIXBIT /.FBCRE/
SIXBIT /.FBAUT/
SIXBIT /.FBVER/
SIXBIT /.FBACT/
SIXBIT /.FBBYV/
SIXBIT /.FBSIZ/
SIXBIT /.FBCRV/
SIXBIT /.FBWRT/
SIXBIT /.FBREF/
SIXBIT /.FBCNT/
SIXBIT /.FBBK0/
SIXBIT /.FBBK1/
SIXBIT /.FBBK2/
SIXBIT /.FBBBT/
SIXBIT /.FBNET/
SIXBIT /.FBUSW/
SIXBIT /.FBGNL/
SIXBIT /.FBNAM/
SIXBIT /.FBEXT/
SIXBIT /.FBLWR/
SIXBIT /.FBTDT/
SIXBIT /.FBFET/
SIXBIT /.FBTP1/
SIXBIT /.FBSS1/
SIXBIT /.FBTP2/
SIXBIT /.FBSS2/
END <3,,ENTVEC>