Google
 

Trailing-Edge - PDP-10 Archives - bb-r775c-bm_tops20_ks_upd_3 - sources/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>