Google
 

Trailing-Edge - PDP-10 Archives - BB-KL11K-BM_1990 - t20src/dumper.mac
There are 42 other files named dumper.mac in the archive. Click here to see a list.
; Edit= 563 to DUMPER.MAC on 7-Oct-89 by WEINER
;Merge 4.1 and 7.0 DUMPER sources. Define FTVERS outside DUMPER.MAC to build
;version other than 6. 
; Edit= 562 to DUMPER.MAC on 28-Sep-89 by GSCOTT
;Allow RESTORE to nul: for new autopatch procedure.
; Edit= 561 to DUMPER.MAC on 13-Sep-89 by GSCOTT, for SPR #22070
;Set "file write count" to 1 on SAVE/FULL so that SAVE/INCREMENTAL:n works
;right when n is greater than 1. 
; Edit= 560 to DUMPER.MAC on 20-Jan-89 by EVANS
;Set FB%NDL in MASK (for priv'ed user), not NWMASK.
; Edit= 559 to DUMPER.MAC on 29-Dec-88 by RASPUZZI
;Make DUMPER save secure bit (FB%SEC) for secure files and also restore said
;bit when the time comes to restore secure files.
; Edit= 558 to DUMPER.MAC on 18-Nov-88 by EVANS, for SPR #22259
;Don't try to set tape data mode on rewind. Prevent unnecessary error on
;MTOPR% failure.
; Edit= 557 to DUMPER.MAC on 13-Oct-88 by EVANS
;**PERFORMANCE** - Change PBSIZ (buffer size) from 200 to 40. 
; Edit= 556 to DUMPER.MAC on 27-Sep-88 by EVANS, for SPR #21314
;Zero-out the buffer after an ending record in INTERCHANGE mode, so we don't
;leave garbage for a short record following to pick up.
; Edit= 555 to DUMPER.MAC on 20-Sep-88 by GSCOTT, for SPR #21608
;Check MT%DVE before other MT%xxx bits in REAERR.
; Edit= 554 to DUMPER.MAC on 12-Aug-88 by EVANS, for SPR #21638
;Be sure to use correct FDB-length when looking for ARCHIVE info on a 4.1
;DUMPER tape being restored by 6.0 DUMPER.
; Edit= 553 to DUMPER.MAC on 1-Aug-88 by EVANS, for SPR #21897
;Be sure "Tape offline" message gets to OPR, and batch jobs can get a "%" if
;user desires error character.
; Edit= 550 to DUMPER.MAC on 5-Apr-88 by EVANS, for SPR #21569
;Add the FB%NDL (never delete) bit to the mask at NWMASK:. 
; *** Edit 549 to DUMPER.MAC by EVANS on 1-Mar-88, for SPR #21906
; Prevent endless loop if GDSTS% fails after calling BAKOUT.
; *** Edit 548 to DUMPER.MAC by EVANS on 28-Jan-88, for SPR #21703
; Print the sequential tape number at the beginning of a new tape.
; *** Edit 547 to DUMPER.MAC by EVANS on 2-Apr-87
; Set AC1 to zero so OUTMSG doesn't get confused. 
; *** Edit 546 to DUMPER.MAC by EVANS on 31-Mar-87
; Fix edit 544 
; *** Edit 545 to DUMPER.MAC by EVANS on 31-Mar-87, for SPR #21413
; Set tape format explicitly for MTOPR% - don't get a tape format from the job
; *** Edit 544 to DUMPER.MAC by EVANS on 24-Feb-87, for SPR #21537
; Add a percent-sign to the "Tape went offline" error string.
; *** Edit 543 to DUMPER.MAC by EVANS on 20-Nov-86, for SPR #21408
; Don't ignore DUMPO% error - inform the user something is wrong. 
; *** Edit 542 to DUMPER.MAC by WAGNER on 11-Jun-86, for SPR #21118
; Fix DUMPER such that it can find the maximum blocking factor for tapes with
; density of 6250. 
; *** Edit 541 to DUMPER.MAC by WAGNER on 3-Jun-86, for SPR #21242
; Increase storage for up to 100 VOLIDS in a tape set, from old limit of 10. 
; *** Edit 540 to DUMPER.MAC by WAGNER on 28-Apr-86, for SPR #21225
; Fix DUMPER to not get and write a VOLID if tape was set UNAVAILABLE, in
; routines NOEOTW and SVSETA. 
; *** Edit 539 to DUMPER.MAC by MAYO on 10-Mar-86, for SPR #21064
; Non-existant devices in a SAVE command should not generate the ?Device must
; be DISK error. It is probably just an offline disk.
; *** Edit 538 to DUMPER.MAC by MAYO on 31-Jan-86, for SPR #21078
; Replace 534 with something more verbose; type tape number and proper VOLID at
; NXTTAP.
; *** Edit 537 to DUMPER.MAC by MAYO on 31-Jan-86
; Enable preloading when using PMAP.
; *** Edit 536 to DUMPER.MAC by MAYO on 22-Jan-86, for SPR #20905
; If cleaning up a failing command, and the command was a RETRIEVAL with a
; request still active, requeue a request for the Alternate tape.
; *** Edit 535 to DUMPER.MAC by MAYO on 2-Dec-85
; Prevent two EOFs from being read as EOT on labeled tapes. Also, allow mail to
; be sent to a file's author, not last writer, if compiled with a different
; FTLWR.
; *** Edit 534 to DUMPER.MAC by MAYO on 25-Nov-85
; Save the VOLID of the tape when doing Retrievals with tape allocation
; disabled. Otherwise, tapes get unloaded and remounted for every file
; retrieved.
; Edit 533 to DUMPER.MAC by MAYO on 18-Oct-85
; Set .FBBK1 to the tape volid if the monitor allows it during SAVE/INCR. 
; Edit 532 to DUMPER.MAC by MAYO on 6-Aug-85
; Fix typo at NEWDCR+16 (T4 instead of P4)
; Edit 531 to DUMPER.MAC by MAYO on 6-Aug-85
; Rewrite code at ENDFIL:+11 to make SAVE/INCR:n not save extra files.
; Edit 530 to DUMPER.MAC by MAYO on 6-Aug-85
; GETTAD should skip on a bad parse
; Edit 529 to DUMPER.MAC by MAYO on 6-Aug-85
; Insure we get correct tape after refusing a tape mounted out of order.

	TITLE	DUMPER - The TOPS-20 backup/retrieval utility

	SEARCH	MONSYM,MACSYM,QSRMAC,GLXMAC
	.DIRECT	FLBLST		;DON'T EXPAND TEXT
	SALL			;KEEP LISTING READABLE

CPYRIG:	ASCIZ +

	DUMPER - TOPS-20 Backup/Archival Utility
	Copyright (C) 1985 by Digital Equipment Corporation, Maynard, Mass

	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
	OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

+
;	See the end of the file for several essays that may prove useful
;	 to people interested in maintaining, altering, or customising
;	 DUMPER.
	SUBTTL	Version info and edit history


	.MAJOR==FTVERS
	.MINOR==0
	.EDIT=^D563
	.WHO=0

COMMENT +
 #  who	  date		   Edit description, decreasing order
--- --- ---------	-----------------------------------------------------
    SM	 6-Aug-85	DUMPER released as part of 6.1; see top of file for
			 edit history after release.

528 SM	21-Jun-85	DUMPER doesn't always write LEOT when switching to the
			 next tape.  Teach it to do so, so other programs can
			 read DUMPER tapes.

527 SM	18-Jun-85	Don't call REWCV/FNDEND at ARCHVA:.  That causes an EOT
			 mark to be written when not wanted. Instead, set mode
			 to read and use REWCV1/FNDEND. Also, Interchange files
			 are never invisible, fix F.INTR at FIXFDE:...

526 SM	17-Jun-85	Failure at ARC1 shouldn't abort Archive run.  Also,
			 teach DUMPER to scream and halt at CRDI26,27,28 errors,
			 going on after a long error message ONLY.

525 SM	30-May-85	Allow SET DENSITY midtape if it changes nothing.

524 SM	24-May-85	Replace edit 523 with something faster and better.

523 SM	21-May-85	Don't try to set ARCF bits from an Interchange tape.

522 SM	 3-Apr-85	Ignore Permament quota on a RETRIEVE, check Working
			 quota only.

521 SM	 2-Apr-85	Files weren't set invisible on RESTORE.  Fix the
			 typo in FIXFDE (should use T1 not P1).

520 SM	28-Feb-85	Have EXACT mode apply to RESTORE as well, and have it
			 preserve Generation numbers.

519 SM	20-Feb-85	Invent NXTINC to force file to be picked up on the
			 next SAVE/INC.  Call it in ARC1.

518 SM	19-Feb-85	When GNJFN fails in SAVE, make sure error was "No more
			 files" - if it wasn't, issue error and stop save.

517 SM	 1-Feb-85	Make SAVE tapeswitch code simpler.  Neaten LIST and
			 PRINT.  REWIND cleanup.

516 SM	28-Jan-85	Add code to notice if DUMPER was built for TOPS-20 v6
			 and is being run under v5.  Code is under FTMONI.
			 Make sure to get JFNs after RESTORE.

515 SM	22-Jan-85	The return of FILEST after CONTST, by popular demand.
			 More info typed when processing savesets.  JFNs now
			 properly dropped on RESTORE to overquota directories.
			 Cosmetic changes. Have GETREC set up LSTSEN.  Notice
			 volid changes more often.  Clean up old readahead
			 chains.  Use CZ%ABT when dropping tape.  Stop reading
			 tape when JFNLST is exhausted. Add PRINT/FAST.

514 SM	21-Jan-85	If doing FILES, make sure against margin before typing
			 output.  Have YESNO avoid ?errors under BATCH.

513 SM	31-Dec-84	Obey FB%NOD on normal saves and any kind of incremental.
			 Ignore it on any kind of archival.  Also, have ^A's
			 "typeout of last file seen on tape" not type file
			 attribute information or repetitive information.

512 SM	27-Dec-84	Have RESTORE command store the last filename read
			 from tape in a buffer (LSTSEN).  Teach ^A to type
			 this buffer.

511 SM	18-Dec-84	EXACT mode goes in under FTEXAC.  Make /TAPE-INFO the
			 default.  Make ANNSEQ return filename like ^A would.
			 Have PRINT type out saveset headers to user.

510 SM	14-Dec-84	Interrupts for ^A and data error should not be on the
			 same level.  Move data error up one.

509 SM	 6-Dec-84	Fix Sequential Checksum.

508 SM	29-Nov-84	When dumping files, notice FB%DIR and skip the file.

507 SM	12-Nov-84	If error is GJFX3 (no more JFNS), give special error,
			 since ERSTR would only say "can't find error message
			 file"

506 SM	 5-Nov-84	Allow saves of offline files;  do not save nonexistant
			 files.

505 SM	10-Oct-84	Provide code to properly support /TAPE-INFO on RESTORE.

504 SM	 8-Oct-84	Only obey FB%NOD during incremental saves.  Fix
			 meaningless PASS2 error.

503 SM	28-Sep-84	Always allow retry on MT Offline.  ^E to get out.

502 SM	26-Sep-84	Teach QUASAR timer to go off only when needed.
			 Invent FTASKR.

501 SM	21-Sep-84	^A during INITIAL scan shouldn't report a page number.
			 Neaten up /FULL handling.

500 SM	22-Aug-84 	DUMPER writing finished.
+
	SUBTTL	Definitions
; AC def's
	F==0			;FLAGS (F.????)
	T1==1			;THE USUAL SCRAP
	T2==2
	T3==3
	T4==4
	Q1==5
	Q2==6
	Q3==7
	P1==10
	P2==11
	P3==12
	P4==13
	P5==14
	BS=16			;BACKOUT STACK
	P=17			;STACK POINTER

;Constants
	CURFMT==6		;CURRENT FORMAT NUMBER, DO NOT CHANGE
			;6 GAINED "TONEXT" RECORD TYPE
			;5 GAINED PASSWORD ENCRYPTION AND OTHER CRDIR%oids
			;4 IS THE LOWEST LEGAL TAPE TYPE

IFNDEF FTVERS,<		;[563]Default to version 6 and let him know
	FTVERS==6		;VERSION OF THE MONITOR INTENDED FOR
	IF1,<PRINTX Assembling DUMPER for TOPS-20 Release 6 or greater>
>			;[563]

;Conditional assembly flags.  Use only 0 or -1 unless otherwise noted.
;-1 usually means "ON"
	FTDEB==0		;DEBUGGER CODE IF -1 (LITTLE IMPACT)
	FTINVI==-1		;USER REQUESTED ARCHIVED FILES GO INVISIBLE
				 ;AFTER ARCHIVAL, IF -1 (SLOWS ARCHIVING)
	FTUSAG==-1		;DO USAGE RECORDS IF -1 (SLOWS ARCHIVING)
	FTCHKS==-1		;DO INTERNAL CHECKSUMMING (SLOWS EVERYTHING)
	FTMONI==-1		;CHECK MONITOR VERSION AT STARTUP, IF -1
	FTCKPN==-1		;CHECKPOINT LIST FILE EACH PAGE, IF -1
	FTASKR==1		;WHEN RETRIEVING A FILE WITH A NAME DIFFERENT
				 ; THAN THE NAME ON TAPE, 0 ask the Operator
				 ; if it should be restored;  1 retrieve it;
				 ; -1 do not retrieve it

	FTMAIL==-1		;ALLOW MAIL COMMAND AND SUPPORT, IF -1 (NEW)
	FTLWR==-1		;SEND ARCHIVE MAIL TO FILE'S LAST WRITER IF -1
				 ;If 0, send to author
	FTEXAC==-1		;ALLOW EXACT MODE COMMAND (NEW)
	FTIND==0		;(DO NOT) ALLOW INDUSTRY COMMAND (HISTORICAL)

	MAXJFN==777		;Max jfns allowed
	 MXJFPG=<MAXJFN+777>/1000
	REEVAL==0		;REEVAL .gt. 0 to try and do output opts.
				 ;(Increases CPU time, may decrease elasped)
	WAITTM==^D15		;Minutes to wait for QUASAR to get back to us.
	BDTMAX==^D35		;Number of bad tapes to remember
	TAKLEN==^D10		;Number of nested take files allowed
	BFRSIZ==^D3300		;PARSE BUFFER SIZE (LARGE FOR LONG SAVE CMDS)
	ATMSIZ==^D50		;ATOM BUFFER SIZE
	 BFRLEN=BFRSIZ*5-1	;CHARS ALLOWED IN CMD BUFFER
	 ATMLEN=ATMSIZ*5-1	;CHARS ALLOWED IN ATOM BUFFER

 IFL REEVAL,<PRINTX ?Illegal value of REEVAL
	PASS2			;;This would be fatal
	END>
 IFN FTUSAG,< SEARCH ACTSYM >
 IFN FTMAIL,< .REQUIRE SYS:ARMAIL
		EXTERN	MLINIT,MLTOWN,MLTLST,MLDONE,.MLNFL >

; flags in AC F
	F.PRIV==1B0		;WHEEL OR OPR
	F.SUBJ==1B1		;IF ON A PTY
	F.INTR==1B2		;INTERCHANGE MODE IS ON
	F.NSEQ==1B3		;IGNORE SEQUENCE NUMBERS/CHECKSUMS WHEN READING
	F.BACK==1B4		;READING BACKWARDS, ERRORS ARE SPECIAL
	F.FAKE==1B5		;MADE A FAKE RECORD - SKIP CERTAIN OPERATIONS
	F.EOF==1B6		;SAW EOF RECENTLY
	F.EOT==1B7		;SAW EOT (DOING POST-EOT PROCESSING)
	F.OEOF==1B8		;PASSED AN EOF RECENTLY
	F.NORD==1B9		;NO READING NOW (EOT OR WRITING)
	F.NVOL==1B10		;DON'T VOLSWITCH WHILE READING (GETREC)
	F.CIRC==1B11		;RECORD IS INTERCHANGE-CONVERTED
	F.ILAB==1B12		;READING A LABELED TAPE THE HARD WAY
	F.BLKF==1B13		;WROTE AND NO REWIND (MAYN'T CHANGE WRIBKF)
	F.NBOT==1B14		;NOT AT BOT ANYMORE
	F.DERR==1B15		;SAW A DATA ERROR, REPORT SOON
	F.36MD==1B16		;INDUSTRY MODE (NOT IN USE)
	F.WILD==1B17		;USE WILD SPECS
	F.NO==1B18		;A "NO" COMMAND
	F.FILT==1B19		;FILES COMMAND
	F.DIRT==1B20		;DIRECTORY COMMAND
	F.CSEQ==1B21		;CHECKSUMMING SEQUENTIALLY
	F.CHKS==1B22		;CHECKSUMMING, ANY FLAVOR
	F.CREA==1B23		;CREATE DIRECTORES ON RESTORE
	F.DDIR==1B24		;PLEASE SAVE DIRECTORY INFO THIS TIME
	F.NDIR==1B25		;DO NOT SAVE DIRECTORY INFO THIS TIME
	F.GOT1==1B26		;GOT A FILE WHILE READING OR WRITING
	F.RACC==1B27		;ACCOUNTING: USER OR SYSTEM DEFAULT
	F.RPRO==1B28		;PROTECTION: USER OR SYSTEM DEFAULT
	F.SSA==1B29		;SUPERSEDE ALWAYS
	F.SSN==1B30		;SUPERSEDE NEVER
	F.RETR==1B31		;RETRIEVAL IN PROGRESS
	F.CHCK==1B32		;CHECK IN PROGRESS
	F.SARC=1B33		;RESTORE SUPRESSING ARCHIVE INFO
	F.WAIT==1B34		;WAITING ON QUASAR
	F.ABT==1B35		;ABORT COMMAND GIVEN

; flags for the terminal and list file I/O handler (in LSTFLG)
	LS.TTY==1B0		;output to TTY
	LS.LST==1B1		;output to list file

; flags for the SAVE command (in DMPFLG)
	D.COL==1B0		;COLLECTION/MIGRATION
	D.ARC==1B1		;ARCHIVAL
	D.MIG==1B2		;MIGRATION
	D.AOEF==1B17		;ARCHIVE ONLINE EXPIRED FILES (COLLECTION)
	D.FINC==1B18		;FULL INCREMENTAL
	D.INC==377777		;INCREMENTAL NUMBER

; flags for the PRINT command
	P.FAST==1B0		;FAST mode


; offsets in the first page of a buffer in freespace.  Do not change the
;  order here.
	NXTBUF==0	;next buffer
  ;offset 1 not used currently
	SIZBUF==2	;number of pages in this buffer
	PNTBUF==3	;pointer into MAPFRE used by DELPGS
	TRPBUF==4	;text to type at RELPGT time or 0
	TREBUF==5	;where to add text to
	ERRCNT==6	;times tried to write this buffer
	DATAST==20	;first word available for data

;Command bytes used by RELPGT (in text pointed to by buffer's TRPBUF)
	 TR.END==0	;end of texts
	 TR.FIL==1	;filename follows
	 TR.DIR==2	;Directory name follows
	 TR.TXT==3	;Random text follows
	 TR.FDT==4	;Directory or file text follows

; offsets in the header of a DUMPER logical record (6 words)
	.CHKSM==0	;LOGICAL RECORD CHECKSUM
	.FLAG==1	;FLAG WORD
	.TAPNO==2	;TAPE NUMBER
	.PAGNO==3	;PAGE NUMBER
	.TYP==4		;TYPE OF RECORD
	.SEQ==5		;SEQUENCE NUMBER

;  .PAGNO flags
	PG.CON==1B0	;Means TONEXT
	PG.NFN==1B1	;Always set (historical)
;  .FLAG flags
	FL.HIS==(170000);Always set in .FLAG (historical)
	FL.NCK==1B0	;No real checksum in .CHKSM

; types of records (these are negated on tape)
	DATA==0		;FILE CONTENTS PAGE
	SAVEST==1	;SAVESET HEADER (NOT CONTINUED)
	FILEST==2	;FILE HEADER
	FILEEN==3	;FILE END
	TAPEEN==4	;END OF SAVESETS (TAPE TRAILER)
	DIRECT==5	;DIRECTORY INFOMATION
	CONTST==6	;CONTINUED SAVESET HEADER
	FILL==7		;FILLER RECORD, IGNORED, NOT RETURNED AS SUCH BY GETREC
	SAVEEN==FILL	;GETREC PASSES THIS BACK WHEN EOF IS READ (SAVESET END)
	TONEXT==10	;TO NEXT TAPE RECORD (CONTINUED FILE)
	 MAXTYP==10	;LARGEST VALUE

;SAVESET HEADER INFO (SAVEST, CONTST)
	SV.FMT==0	;FORMAT OF TAPE
	SV.PNT==1	;POINTER TO SAVESET NAME (SV.MSG)
	SV.TAD==2	;GTAD OF SAVE
	SV.VOL==3	;VOLID OF TAPE (NOT USED)
	SV.EDT==4	;EDIT NUMBER OF DUMPER
	SV.MSG==20	;SAVESET NAME

;Page boundaries
	%PGEAT==100	;Start of page assignments
  ;Allocate page macro
	DEFINE	ALP(name,num<1>),<
	 name==%PGEAT
	 %PGEAT==%PGEAT+num>

	ALP	DIRPAG
	 DIRBUF=DIRPAG*1000			;MUST BEGIN ON PAGE BOUNDARY
	  ;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
	ALP	FDBPAG
	 FDBBUF=FDBPAG*1000
		FDBFFF==0			;OFFSET TO FDB IN FILEEN
		FDBOFF==200			;OFFSET TO FDB IN FILEST
		FDB=FDBBUF+FDBOFF
	ALP	JF1PAG,MXJFPG
	 JFNLST=JF1PAG*1000		;WHERE JFNS GO
	ALP	JF2PAG,MXJFPG
	 JF2LST=JF2PAG*1000
	ALP	SSNPAG			;SAVESET HEADERS BUILT HERE
	 SSNBUF=SSNPAG*1000	 ;ADDRESS OF SAME
	 SCRPAG==SSNPAG		;page whose contents don't matter
	 SCRBUF==SCRPAG*1000
	ALP	MBFPAG
	 MBUF=MBFPAG*1000
	ALP	QS1PAG
	 QSRMSS=QS1PAG*1000
	ALP	QS2PAG
	 QSRMSR=QS2PAG*1000
;**;[557] Change PBSIZ		DEE		13-OCT-88
	 PBSIZ==40		;[557] Change from 200 to 40
	ALP	PAGPAG,PBSIZ
	 PAGBUF=PAGPAG*1000

; the bounds of pages available to the free space manager
	ALP	FRESPC,0	;start at wherever we are
	PAGMAX==675		;mayn't use this or beyond

	 NUMPAG=PAGMAX-FRESPC+1	;number of pages in freespace

	IFL NUMPAG-60,<PRINTX ?Not enough DUMPER freespace
			PASS2
			END>

;Useful symbols
	JFNSAL=1B2+1B5+1B8+1B11+1B14+JS%PAF	;JFNS%, do all fields
	PAGSIZ=1000		;For DDT, mostly
 IFG FTVERS-5,<
	CD.LEN=.CDPPN+1
 >
 IFLE FTVERS-5,<
	CD.LEN=.CDDFE+1
	VI%DEC==0
 >

	FILNM=.ARPSZ+1
	NHEAD==6		;HEADER LENGTH FOR DUMPER
	NIHEAD==40		;HEADER LENGTH FOR INTERCHANGE
	MAXBKF==^D15		;MAX. BLOCKING FACTOR

; for list file formatting
	PAGLIN==^D56		;LINES/PAGE

	FLCOL==^D5		;COLUMN FOR FILE NAME
	DDCOL==^D50		;COLUMN FOR PASSWORD ENCRYPTION VERSION
	WTCOL==^D60		;COLUMN FOR WRITE DATE
	SZCOL==^D80		;COLUMN FOR SIZE
	CSCOL==^D100		;COLUMN FOR CHECKSUM

	FFLCOL==^D2		;SAME, FOR PRINT/FAST
	FWTCOL==^D52
	FSZCOL==^D68
	FCSCOL==^D73		;SHOULD END AT COLUMN 79
	SUBTTL	Defines
;Useful Defines

;Defines needed to make DUMPER work under monitor v5.any or less
 IFLE	<FTVERS-5>,<		;;;If for monitor v5

	DEFINE	ERJMPR(addr),<	;;;V5 doesn't have ERJMPR
	 ERCAL	[MOVEI	T1,addr	;;;We do the equivalent
		 HRRM	T1,(P)	;;;Which is to return the err code in T1
		 JRST	FNDERR]>;;;and dispatch to addr through FNDERR

	DEFINE	DOJSS(jsi,addr),<;;Doesn't have ERJMPS either
	 DMOVEM	T1,JSITMP	;;;So for any jsys we save T1 and T2
	 jsi			;;;then do the jsys
	  ERCAL	[MOVEI	T1,addr	;;;and when it fails
		 HRRM	T1,(P)	;;;set up to dispatch to the right place
		 DMOVE	T1,JSITMP;;with the AC's unchanged
		 RET]>		;;;This does the dispatch

	OPDEF	ERJMPS	[ERJMP]	;;;For cases that don't matter
 >
 IFG	<FTVERS-5>,<		;;;DOJSS is needed for v5
	DEFINE	DOJSS(jsi,addr),<
	 jsi			;;;Do the jsys
	  ERJMPS addr>		;;;on error dispatch with AC's preserved
 >

;TYPE addr types the string at that address. Literals are acceptable.
	DEFINE	TYPE(locstr),<
	 CALL	[PUSH 	P,T1
		 HRROI	T1,locstr
		 JRST	OUTMSA] >

;TYPCHR "chr" types the character out.
	DEFINE	TYPCHR(chr),<
	 CALL	[PUSH	P,T1
		 MOVEI	T1,<chr>
		 JRST	OUTMSC] >


;TYPEAT addr is just like TYPE, but the addr contains a byte pointer to
; the text
	DEFINE	TYPEAT(locptr),<
	 CALL	[PUSH	P,T1
		 MOVE	T1,locptr
		 JRST	OUTMSG] >

;SELECT sets the output flags as listed, return flagword in the AC
	DEFINE	SELECT(flags,ac<T1>),<
	 MOVX	ac,flags
	 MOVEM	ac,LSTFLG >

;JSERRD for jsys errors that just shouldn't happen
	DEFINE	JSERRD(text, where<BAKOUT>, entri<ERJMPS>),<
	 entri	[CALL	ANNERR		;;ANNOUNCE COMMAND IF TAKING
		 HRROI	T1,[ASCIZ\?text\]
		 CALL	LSTERR		;;REPORT WHAT ERROR WAS
		 JRST	where] >	;;GO WHEREVER REQUESTED

;ERROR for general errors that just shouldn't happen.  However be very careful
; where you let it jump to.  BAKOUT is not always a good choice!
	DEFINE	ERROR(text, where<BAKOUT>),<
	 JRST	[CALL	ANNERR
		 TYPE	[ASCIZ\?text\]
		 JRST	where] >

;WARN types a message with the approprate leadin character.
	DEFINE	WARN(locstr),<
	 CALL	[CALL	IFCRLF
		 TYPE	[ASCIZ ~%'locstr~]
		 RET] >

;DISPAT jumps off to one of three points depending on label type.
	DEFINE	DISPAT(mtaloc<.+1>,mtuloc<.+1>,mtlloc<.+1>),<
	 MOVE	T1,MTTYP
	 JRST	@[EXP mtaloc, mtuloc, mtlloc]+1(T1) >

;IFMTA jumps to the given address if the tape is MTA, not MT
	DEFINE	IFMTA(mtaloc<.+2>),<
	 SKIPGE	MTTYP
	 JRST	mtaloc >

;SKPMTA skips if the device is MTA
	OPDEF	SKPMTA	[SKIPL	MTTYP]

;SKPNLB skips if tape is not labeled
	OPDEF	SKPNLB	[SKIPLE	MTTYP]

;IFMT jumps if the tape is MT, not MTA
	DEFINE	IFMT(mtloc<.+2>),<
	 SKIPL	MTTYP
	 JRST	mtloc >

;IFLAB jumps to the given address if the tape is labeled
	DEFINE	IFLAB(labloc<.+2>),<
	 SKIPLE	MTTYP
	 JRST	labloc >

;Command table macro
	DEFINE	CTB (addr,txt,fla<0>),<
	 IF1, <	%%C==0>
	 IF2, <	IFDEF addr, <	%%C=addr>
		IFNDEF addr, <	%%C=NOCMD
				PRINTX ?txt not in
			     >
	      >
	 XWD [ IFN fla,<EXP	CM%FW!fla>
		ASCIZ \txt\],%%C
				      >

;TB does up a keyword table without the fanciness of the CTB macro
	DEFINE	TB(val,text),<
	 [ASCIZ\text\],,val >

;GUIDES does the GUIDE call and dispatches to NOCMD if it fails.  Don't
; call this in a literal.
	DEFINE	GUIDES(text,whr<NOCMD>),<
	 JRST	[HRROI	T1,[ASCIZ ~text~]
		 CALL	GUIDE
		  JRST	whr
		 JRST	.+1] >

;CONFIRM does a confirm.  Dispatches to NOCMD on error, hurts no AC's.
	DEFINE	CONFIRM(whr<NOCMD>),<
	 CALL	CONFRM
	  JRST	whr >

	DEFINE	PRINTY(arg),<IF2, PRINTX arg>
	SUBTTL	Interchange 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
	SUBTTL	Variables
;Variables cleared at START time
CLRDAT:!
OKIAE:	BLOCK	1			;-1 IF ^A, ^E SHOULD WORK
INTRQ:	BLOCK	1			;-1 IF USER REQUESTS INTERRUPT VIA ^E
					;0 IF NO INTERRUPT IN PROGRESS
					;1 IF NEW COMMAND DUE TO INTERRUPT
CMDWAS:	BLOCK	1			;POINTER TO WHAT CMD WAS INTERRUPTED
CURCMD:	BLOCK	1			;POINTER TO CURRENT COMMAND INFO
MTJFN:	BLOCK	1			;MAGTAPE JFN
OPNFOR:	BLOCK	1			;0 OR OPENF% BITS FOR MTA OPEN
OPNREQ:	BLOCK	1			;REQUESTED VALUE FOR OPNFOR
OLDBKF:	BLOCK	1			;SAVED BLOCKING FACTOR FOR WRITING
LSTJFN:	BLOCK	1			;LIST JFN
SUPMRK:	BLOCK	1			;NONZERO IF NO RECORDING OF TAPE IN FILE
INIJFN:	BLOCK	1			;INITIAL FILESPEC JFN
JFN:	BLOCK	1			;FILE JFN IN PROGRESS
MSTAD:	BLOCK	1			;MODIFIED AFTER TEST
WSTAD:	BLOCK	1			;WRITTEN AFTER TEST
ASTAD:	BLOCK	1			;REF'D AFTER TEST
EXACT:	BLOCK	1			;IN EXACT MODE (DUMP)
NFJFN:	BLOCK	1			;NUMBER OF FILE INPUT JFNS
SAVENO:	BLOCK	1			;SAVESET # (IF ARCHIVE) OR 0
ARCTSN:	BLOCK	1			;LAST ARCHIVE SAVESET NUMBER READ
TRAPTO:	BLOCK	1			;WHERE TO GO WHEN INPUT GETS INTERRUPTED
NXTRTP:	BLOCK	1			;NEXT RETRIEVAL REQUEST IN QUEUE
RETFIN:	BLOCK	1			;NONZERO IF DONE WITH RETRIEVAL
BDTCNT:	BLOCK	1			;NUMBER OF KNOWN MISSING RETRIEVAL TAPES
INFILE:	BLOCK	1			;-1 IF BETWEEN FILEST & FILEEN (DUMP)
PASWDC:	BLOCK	1			;NONZERO IF PASSWORD PROBLEMS OK
LSTSEN:	BLOCK	FDBOFF+1		;HOLDS FILENAME DURING RESTORES
;**;[558] Add one line at LSTSEN:+1		DEE	18-NOV-88
REWFLG: BLOCK	1			;[558]We are rewinding
 CLREND==.-1

;Variables that can be trash at start time (ie, always inited specially before
; use.)
CFNBFR:	BLOCK	40			;USED BY ^A
BDTLST:	BLOCK	BDTMAX+1
MBTAD:	BLOCK	1			;MODIFIED BEFORE TEST
WBTAD:	BLOCK	1			;WRITTEN BEFORE TEST
ABTAD:	BLOCK	1			;ANY FILE REF BEFORE TEST
PRITTY:	BLOCK	1			;PRINTING TO A TTY IF NONZERO
;MTDSG to MTDEV are generally meaningless unless MTJFN is nonzero
MTDSG:	BLOCK	1			;DEVICE DESIGNATOR
NVOLID:	BLOCK	1			;# OF EXTRA VOLIDS (FOR ARCHIVAL)
;**;[541] CHANGE 1 LINE AT VOLID6:+0.L	DSW	6/3/86
VOLID6:	BLOCK	^D101			;[541]SIXBIT TAPE VOLID OR 0, UP TO 100
					 ;TAPES, CURRENT AT OFFSET 0
VOLID:	BLOCK	2			;ASCIZ VOLID OF TAPE
MTTYP:	BLOCK	1			;LABEL TYPE
					 ;(-1 MTA, 0 UNLABELED MT, 1 LABELED MT)
MTAUNT:	BLOCK	1			;UNIT NUMBER OF DRIVE (CHKJFN)
MTDEV:	BLOCK	6			;DEVICE NAME
MNTDSG:	BLOCK	1			;MOUNT REQUEST DESIGNATOR
ORGTAP:	BLOCK	1			;TAPE WE STARTED SAVING THIS FILE ON
TAPENO:	BLOCK	1			;CURRENT TAPE NUMBER
P2JFN:	BLOCK	1			;PASS 2 JFN
ARCCNT:	BLOCK	1			;# OF ARCHIVED FILES ON TAPE THIS SAVE
ARCINF:	BLOCK	.ARPSZ+1		;FOR ARCF% INFO
FSTARC:	BLOCK	25			;1ST FILE THIS TAPE ARCHIVED
SAVETP:	BLOCK	1			;SAVESET TYPE
TAKSTK:	BLOCK	1			;TAKE STACK POINTER
TAKSTR:	BLOCK	TAKLEN+1		;TAKE JFN STACK
RPSSTK:	BLOCK	1			;REPARSE OP STACK POINTER
RPSSTR:	BLOCK	420			;REPARSE STACK (LOC 0 HAS RPSSTK FOR ^E)
RPSISR:	BLOCK	20			;REPARSE UNDER ^E COMMANDS
STRING:	BLOCK	<TMPLEN==100>		;FOR STRING HACKS, ETC
TABTMP:	BLOCK	6			;FOR TABOUT
 IFN FTMAIL,<
FILNMM:	BLOCK	1			;PNTR TO FILES TO SEND MAIL ABOUT
FILNMS:	BLOCK	205			;LIST OF FILES FOR MAIL (TEXT FIELD)
MALBLK:	BLOCK	3			;FOR MLTOWN (MAIL)
MALTO:	BLOCK	30			;MAIL TO FIELD (MAIL)
DOTLOC:	BLOCK	101			;PLACES DOTS EXIST IN DIRECTORY (MAIL)
 >
JSITMP:	BLOCK	2			;AC SAVE FOR V5 DOJSS MACRO
IFCTMP:	BLOCK	2			;AC SAVES FOR IFCRLF
ICOTMP:	BLOCK	2			;AC SAVES FOR DMPICO
GEITMP:	BLOCK	2			;AC SAVES DURING GETREC
LSTFLG:	BLOCK	1			;FLAGS FOR THE TTY/LIST FILE SYSTEM
PRIFLG:	BLOCK	1			;PRINT COMMAND FLAGS
LSTPOS:	BLOCK	1			;POSITION IN LIST FILE
LSTLIN:	BLOCK	1			;LINE NUMBER ON PAGE IN LIST FILE
LSTPGN:	BLOCK	1			;PAGE NUMBER IN LIST FILE
LSTFIL:	BLOCK	25			;FILENAME TO LIST TO
FORMAT:	BLOCK	1			;TAPE FORMAT NUMBER
DMPFLG:	BLOCK	1			;SAVE COMMAND FLAGS
UNLFLG:	BLOCK	1			;"SAVE" SHOULD UNLOAD TAPES WHEN DONE
NODFLG:	BLOCK	1			;IGNORE FB%NOD WHEN SET
I3ACS:	BLOCK	20			;INTERRUPT AC STORAGE (LEVEL 3)
I2ACS:	BLOCK	20			;.. (LEVEL 2)
ICMACS:	BLOCK	20			;NEW COMMAND AC STORAGE (FOR ^E)
OUTMST:	BLOCK	1			;POINTER TO LAST TEXT OUTPUT
OUTMSX:	BLOCK	1			;USED BY TYPE AND TYPCHR
CHKTMP:	BLOCK	2			;STORE FOR CHKSUM
ADDTMP:	BLOCK	2			;STORE FOR ADDREC
CURBLK:	BLOCK	1			;POINTER TO CURRENT PHYS. RECORD
LASTYP:	BLOCK	1			;LAST RECORD TYPE READ (GETREC)
REASEQ:	BLOCK	1			;LAST READ SEQUENCE NUMBER (GETREC)
LSTSEQ:	BLOCK	1			;REASEQ VALUE AFTER KILCHN
ARSETS:	BLOCK	1			;#OF TIMES A FILE WAS ARCHIVED (0,1,2)
ARSSTB:	BLOCK	7			;FOR SETTING ARCF% INFO (DUMP/ARC1)
DIRDMD:	BLOCK	1			;# OF DIRECTORIES DUMPED (DUMP, LOAD)
NOFILS:	BLOCK	1			;FILES IN THIS DIRECTORY (DUMP)
USRCNT:	BLOCK	1			;PAGES IN THIS DIRECTORY (DUMP)
TOTFIL:	BLOCK	1			;TOTAL FILES SAVED (DUMP, LOAD)
TOTCNT:	BLOCK	1			;TOTAL PAGES SAVED (DUMP, LOAD)
TOTSKP:	BLOCK	1			;TOTAL FILES SKIPPED (NOT LOADED)
TOTDEL:	BLOCK	1			;TOTAL FILES DELETED WHILE LOADING
WRISEQ:	BLOCK	1			;CURRENT SEQUENCE NUMBER
ENDPNT:	BLOCK	1			;LAST BLOCK IN DMPCHA LIST
BLKCNT:	BLOCK	1			;DEC'D AS LOGICAL RECORDS ARE TOUCHED
BLKPNT:	BLOCK	1			;POINTER INTO BUFFER FOR RECORDS
DMPCHA:	BLOCK	1			;HEAD OF DUMP CHAIN
LSTDMP:	BLOCK	1			;LAST DUMPED RECORD
 ;KEEP THE NEXT TWO TOGETHER AND IN ORDER
CURHEA:	BLOCK	1			;ADDR OF CURRENTLY READ HEADER
CURDAT:	BLOCK	1			;ADDR OF CURRENTLY READ 1000WORD DATA
WRIBKF:	BLOCK	1			;TAPE BLOCKING FACTOR - WRITE
REABKF:	BLOCK	1			;TAPE BLOCKING FACTOR - READ
CURREN:	BLOCK	1			;PAGE OF FILE IN PROGRESS
FFREE:	BLOCK	1			;NEXT KNOWN HOLE
PBHOLD:	BLOCK	1			;# UNPROCESSED PAGES IN PAGPAG
WRDPNT:	BLOCK	1			;ADDR OF NEXT FILE PAGE TO DO
FILIOC:	BLOCK	1			;FILES EXAMINED SINCE LAST TAPE OUT
RECCMD:	BLOCK	2			;IOWD WORD FOR I/O AND A 0
BUFPAG:	BLOCK	1			;PAGES NEEDED PER PHYS. RECORD
BUFFRE:	BLOCK	1			;OFFSET TO UNUSED SPACE IN BUFFER
SAFECT:	BLOCK	1			;NUMBER OF BFRS SAFE TO GEN
BFRCNI:	BLOCK	1			;COUNT OF BUFFERS SINCE LAST IDLE
BFRCNT:	BLOCK	1			;TOTAL BUFFERS
LVPC3:	BLOCK	1			;PC FOR INTERRUPTS
LVPC2:	BLOCK	1			;..
LVPC1:	BLOCK	1			;..
MAPFRE:	BLOCK	NUMPAG/^D36+1		;MEMORY MANAGEMENT BIT ARRAY
STACK:	BLOCK	150			;STACK
INTSTK:	BLOCK	140			;STACK FOR ^E COMMANDS
QSRSTK:	BLOCK	100			;STACK FOR QSRINT
LINBUF:	BLOCK	<NLINB==30>		;FOR RANDOM USER STRINGS
STKSAV:	BLOCK	1			;STACK AT COMMAND BEGINNING
TAPHEA:	BLOCK	6			;ANY KIND OF HEADER
SAVHEA:	BLOCK	6			;FOR SAVING HEADER DURING TAOE SWITCH
 ;KEEP THE NEXT TWO ADJACENT/IN ORDER
DENSIT:	BLOCK	1			;DENSITY
PARITY:	BLOCK	1			;PARITY
FRCSET:	BLOCK	1			;-1 IF DENSITY/PARITY SET VIA CMD
CONBUF:	BLOCK	20			;HOLDS STR:<DIR> CONNECTED TO
BGNTAD:	BLOCK	1			;WHEN WE STARTED THE SAVE
 ;KEEP THE NEXT TWO ADJACENT/IN ORDER
CONSTR:	BLOCK	1			;POINTS TO CONNECTED STR (CONBUF)
CONDIR:	BLOCK	1			;POINTS TO CONNECTED DIR (CONBUF)
LSTDIR:	BLOCK	30			;LAST DIR SENT TO TAPE (DUMP, RESTOR)
DDOFLG:	BLOCK	1			;-1 IF NEW <INPUT> (DUMP/DMPFIL)
OUTFLS:	BLOCK	1			;POINT TO FILENAME IN OUTSPC
OUTDRS:	BLOCK	1			;POINTER TO END OF STR:<DIRECTORY>
OUTGEN:	BLOCK	1			;POINTER TO GEN IN OUTSPC (LOAD)
OUTACS:	BLOCK	1			;POINT TO ACCOUNT IN OUTSPC
OUTSPC:	BLOCK	50			;FILESPEC FOR TAPE (DUMP)
OUTDIR:	BLOCK	25			;DIRECTORY FOR TAPE (DUMP,RESTOR)
ICFDB:	BLOCK	.FBLN0+1		;INTERCHANGE COPY OF FDB
FILNAM:	BLOCK	50			;FILENAME (LOAD)
DMPNUM:	BLOCK	1			;<INPUT> DIRECTORY NUMBER
INDIR:	BLOCK	25			;INPUT DIR (DUMP)
DIRINF:	BLOCK	.CDMOD+1		;INCOMING DIR INFO (DUMP/COLLECT)
CHKCN0:	BLOCK	1			;FOR CHECKSUMMING AT SAVE TIME
LSTPGE:	BLOCK	1			;..
DEFSTR:	BLOCK	20
DEFDIR:	BLOCK	20
DEFNAM:	BLOCK	30
DEFEXT:	BLOCK	30
DEFGEN:	BLOCK	3
ATOM:	BLOCK	ATMSIZ
BFFR:	BLOCK	BFRSIZ
ATOM2:	BLOCK	ATMSIZ
BFFR2:	BLOCK	BFRSIZ
SSNTXT:	BLOCK	ATMSIZ+1		;SAVESET NAME

TPTSK:	BLOCK 1			; Internal task name on ret blk
TPRQUS:	BLOCK 1			; User who requested the retrieve
ABTFLG:	BLOCK 1			; Abort received from QUASAR
; Do not separate the following block
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 ^D48		; Space for file name (^V's incl)
TPACT:	BLOCK <2*^D39>/5	; Account of request

PDB:	BLOCK	.IPCAS+11
MPDB:	BLOCK	10
 IFN FTUSAG,<
USABLK:	BLOCK	<NUSABL==27>
USASTR:	BLOCK	15
USADIR:	BLOCK	20
USAACT:	BLOCK	10
USASSI:	BLOCK	2
 >
TMPVAR:	;Quick storage for various variables (faster than storing on stack)
FLGTMP:	BLOCK	1
NOITMP:	BLOCK	1
MAILFL:	BLOCK	1
DATSET:	BLOCK	1
HLPJFN:	BLOCK	1
TRAPSP:	BLOCK	1
REQTMP:	BLOCK	1
ATSAVE:	BLOCK	1
ATFILE:	BLOCK	1
DMPTMP:	BLOCK	1
STOPLD:	BLOCK	1
EOTLCK:	BLOCK	1
REWTMP:	BLOCK	1
DMPTIM:	BLOCK	1
SCNJFN:	BLOCK	1
DIR:	BLOCK	1
ARCGST:	BLOCK	1
ENDFDB:	BLOCK	1
FPGCNT:	BLOCK	1
RMRPGE:	BLOCK	1
SUMTMP:	BLOCK	1
FIXTMP:	BLOCK	1
TRNCNT:	BLOCK	1
RETSVN:	BLOCK	1
RETFLN:	BLOCK	1
INDEX:	BLOCK	1
AUTTMP:	BLOCK	1
MALJFN:	BLOCK	1
NUMDOT:	BLOCK	1
LSTTMP:	BLOCK	1
MATCH:	BLOCK	1
INTCHA:	BLOCK	1
INTTMP:	BLOCK	1
APRID:	BLOCK	1
ICOLEN:	BLOCK	1
GETTMP:	BLOCK	1
GE2TMP:	BLOCK	1
TMP:	BLOCK	1
QYNPMT:	BLOCK	1
QYNTMP:	BLOCK	1
QYNVAL:	BLOCK	1
INPTMP:	BLOCK	1
INIFLG:	BLOCK	1
LDLCOP: BLOCK 	1  ;[556] last data word copied from interchange record
	SUBTTL	Writables
;Writables - things that are a mix of data and variables
WRITEA:
ACKBLK:	MSHSIZ,,.QOHEL		; Size & hello
	MF.NOM			; No message, just an ACK
	0			; ACK code to be filled in

PD0BLK:	.MURSP
	.SPQSR
QSRPID:	0
PD1BLK:	.MUSPQ
	0
	^D15
PD2BLK:	.MUCRE
	.FHSLF
MYPID:	0
PD3BLK:	.MUPIC
	0
	QSRCHN
PD4BLK:	.MUSSQ
	0
	030030

MTIAB:	2			;FOR MTOPRs
	BLOCK	2

GUIINB:	<.CMNOI>B8
	BLOCK	1
KEYINB:	<.CMKEY>B8
	BLOCK	1

CMDBLK:	0,,TRAPRP
	.PRIIN,,.PRIOU		;< FOR BALANCE
	-1,,[ASCIZ/DUMPER>/]
	-1,,BFFR
	-1,,BFFR
	BFRLEN
	BFRLEN
	-1,,ATOM
	ATMLEN
	GTJBLK
GTJBLK:	BLOCK	16

EXABLK:	GJ%OFG+GJ%XTN
	.NULIO,,.NULIO
	0
	0
	0
	0
	0
	0
	0
	G1%SLN

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

TAPBLK:	0,,RPMTAN
	.PRIIN,,.PRIOU
	BLOCK	1
	-1,,BFFR2
	-1,,BFFR2
	BFRLEN
	BFRLEN
	-1,,ATOM2
	ATMLEN
	0

VOLBLK:	0,,VOLPRS
	.PRIIN,,.PRIOU
	BLOCK	1
	-1,,BFFR2
	-1,,BFFR2
	BFRLEN
	BFRLEN
	-1,,ATOM2
	ATMLEN
	0

QYNBLK:	0,,QYNRPS
	.PRIIN,,.PRIOU
	BLOCK	1
	-1,,BFFR2
	-1,,BFFR2
	BFRLEN
	BFRLEN
	-1,,ATOM2
	ATMLEN
	0
	SUBTTL	Startup code
;Code, etc.
;Entry vector
VECT:	JRST	ST					;START
	JRST	REE					;REENTRY
	BYTE (3).WHO (9).MAJOR (6).MINOR (18) <VI%DEC+.EDIT>	;VERSION
	 VECLEN=.-VECT

	DEFINE	CTA(name),<
	 name,,[SIXBIT/name/]
	>

;Conditional flags, for debugging and output
CTFOOF:	CTA	FTVERS
	CTA	FTDEB
	CTA	FTINVI
	CTA	FTUSAG
	CTA	FTCHKS
	CTA	FTMONI
	CTA	FTCKPN
	CTA	FTASKR
	CTA	REEVAL
	CTA	WAITTM
	 CTFLEN=.-CTFOOF
	PURGE	CTA

	DEFINE	CT(tex1,tex2),<
	 [ASCIZ/tex1/],,[ASCIZ/tex2/]
	>

CTFEXP:
 CT <>,<Runs under this release of TOPS-20 (or later)>
 CT <Debugging code off>,<debugging code on>
 CT <Archived files left visible>,<Archived files set invisible>
 CT <Archiving does not write usage records>,<Archiving writes usage records>
 CT <Checksumming off (tapes unreadable to old DUMPERs)>,<Normal checksumming>
 CT <Monitor version not checked>,<Monitor version checked at startup>
 CT <List files not checkpointed>,<List files checkpointed each page>
 CT <>,<Operator not consulted when Retrieval filename doesn't match>
 CT <Output optimization not attempted>,<Output optimization attempted>
 CT <RETRIEVE waits forever for a request>,<Minutes a RETRIEVE will wait>
	PURGE	CT

;Code
REE:	MOVEI	P,STACK-1
	SELECT	LS.TTY
	TYPE	CPYRIG
	TYPE	[ASCIZ/ Version /]
	MOVEI	T2,FTVERS
	CALL	DECOUT
	TYPCHR	"("
	MOVEI	T2,.EDIT
	ANDI	T2,377777
	CALL	DECOUT
	TYPE	[ASCIZ/) with the following compile time settings:
/]
	MOVSI	T4,-CTFLEN
OPTTYP:	HRRZ	T3,CTFOOF(T4)
	MOVE	T3,(T3)
	CALL	SIXOUT
	TYPCHR	.CHTAB
	HLRE	T2,CTFOOF(T4)
	CALL	DECOUT
	HRRO	T1,CTFEXP(T4)
	CAIN	T2,0
	HLRO	T1,CTFEXP(T4)
	SKIPN	(T1)
	JRST	NOEXPG
	TYPCHR	.CHTAB
	TYPEAT	T1
NOEXPG:	TYPE	CRLF
	AOBJN	T4,OPTTYP
	TYPE	CRLF
	;JRST	DUMPER

START:BEGIN:DUMPER:ST:		;COVER ALL GUESSES
 IFL FTMONI*<FTVERS-5>,<		;;TEST FOR RIGHT MONITOR
;This code causes DUMPER to be unrunnable if you try to use version 6 DUMPER
; on under a version 5 Monitor.  It is unrunnable anyway, but this provides
; a polite message saying so, instead of an illegal instruction trap.
 IF1,<PRINTX This version of DUMPER will not run under a Release 5 Monitor>
	HLLZ	T1,JSYST
	JUMPE	T1,MONV5	;IN CASE BUILD FAILED BUT SAVED ANYWAY
	SETO	T1,
JSYST:	CNFIG%			;JSYS NEW TO 6
	 ERJMP	.+1		;THIS WILL FAIL UNDER BOTH 5 AND 6
	MOVX	T1,.FHSLF	;BUT THE ERROR CODE WILL BE DIFFERENT
	GETER%
	MOVEI	T1,(T2)		;ISOLATE ERROR CODE
	CAIE	T1,ILINS2	;CHECK FOR UNDEFINED JSYS ERROR
	JRST	MONV6		;NO, JSYS EXISTS, VERSION IS 6 OR LATER
MONV5:	HRROI	T1,STOP5	;NO.  WRONG.  STOP.
	PSOUT%			;EXPLAIN THE PROBLEM
	HALTF%			;STOP
	JRST	MONV5		;CONTINUE CAN'T HELP
STOP5:	ASCIZ/
?This version of DUMPER has been built for a version 6 Monitor.
 The Monitor you are running is one previous to version 6.
 Please edit DUMPER.MAC, change FTVERS to match the major release number
  of your Monitor, compile it, and try again.
Or, run an older version of DUMPER.
/
MONV6:
 >
	MOVEI	P,STACK-1		;SET STACK UP
	MOVX	T1,LS.TTY
	MOVEM	T1,LSTFLG		;OUTPUT TO TTY: ONLY FOR NOW
	MOVEI	T1,1			;FIRST TAPE NUMBER
	MOVEM	T1,TAPENO
	MOVEM	T1,WRIBKF		;DEFAULT BLOCKING FACTOR
	HRLOI	T1,377777		;POSITIVE INFINITY
	MOVEM	T1,MBTAD		;THE THREE "AFTER" DATES
	MOVEM	T1,WBTAD		;THE "BEFORE" DATES ARE ZEROED BELOW
	MOVEM	T1,ABTAD
	MOVEI	T1,CURFMT
	MOVEM	T1,FORMAT		;ESTABLISH DEFAULT FORMAT
	HRROI	T1,[ASCIZ/DUMPER>/]	;SET STARTUP PROMPT
	MOVEM	T1,CMDBLK+.CMRTY	;..
	RESET%				;CLEAR THE UNIVERSE
	MOVX	F,F.DIRT+F.RACC+F.RPRO	;ALL FLAGS TO DEFAULTS
	CALL	SETPGS			;SET UP MEMORY MANAGEMENT
	SETZM	CLRDAT			;CLEAR VARIABLE SPACE
	MOVE	T1,[CLRDAT,,CLRDAT+1]
	BLT	T1,CLREND
	MOVEI	T1,TAKSTR
	MOVEM	T1,TAKSTK		;SET UP TAKE STACK
	SETO	T1,
	MOVE	T2,[-2,,Q1]
	MOVEI	T3,.JIDEN
	GETJI%				;GET JOB DEFAULT DENSITY AND PARITY
	 JSERRD	<>,.+2
	DMOVEM	Q1,DENSIT		;SAVE THEM
	SETZM	FRCSET			;DENSITY/PARITY ARE DEFAULT, NOT SET
	SETO	T1,			;ON A PTY?
	HRROI	T2,T1
	MOVEI	T3,.JICPJ		;WE CARE BECAUSE SOME MESSAGES WILL
	GETJI%				 ;THEN GET A "$" LEADER
	 ERJMPS	.+2			;DOESN'T HURT TO ASSUME "YES"
	CAIL	T1,0
	TXO	F,F.SUBJ		;ON A SUBJOB
	MOVEI	T1,.FHSLF		;Set up interrupts
	MOVE	T2,[LEVTAB,,CHNTAB]
	SIR%			;DECLARE INTERRUPT TABLES
	EIR%
	MOVE	T2,CHNMSK		;TURN ON THE CHANNELS
	AIC%				;ACTIVATE CHANNELS
	MOVE	T1,[.TICCE,,CECHN]
	ATI%				;ACTIVATE ^E INTERRUPT
	MOVE	T1,[.TICCA,,CFCHN]
	ATI%				;AND ^A

	MOVX	T1,.FHSLF
	RPCAP%
	TXNE	T3,SC%WHL+SC%OPR	;WHEEL OR OPR PRIVS ON?
	TXO	F,F.PRIV		;YES, PRIVS!

	HRROI	T1,[ASCIZ/MTA-DUMPER:/]	;GET MTA-DUMPER: IF THERE
	STDEV%
	 ERJMPS	PANIC			;IT ISN'T
	HRROI	T2,MTDEV
	CALL	CSTR			;COPY IY INTO PLACE
	CALL	CHKMTD			;AND GTJFN IT
	JUMPE	T1,[
		 WARN	<Bad definition for MTA-DUMPER:, ignored>
		 JRST	PANIC]		;OOPS
	TYPE	<[ASCIZ/[Using MTA-DUMPER:]
/]>

;Here after cleaning up after a bad error.  Commands done from
; ^E interrupt should never come here.
PANIC:	MOVEI	P,STACK-1		;GET A CLEAN STACK
	CALL	GCMD			;DO A COMMAND
	JRST	.-1			;DO ANOTHER COMMAND

GCMD:	SETZM	OKIAE			;OFF INTERRUPTS ON ^A, ^E
GCMDI:	SETZM	CURCMD			;NO COMMAND IN PROGRESS
	SKIPL	INTRQ			;SPARE INTERRUPT LEFT OVER?
	JRST	GCMDP			;NO
	SETZM	INTRQ			;YES, LOSE IT
	TYPE	[ASCIZ/ [Interrupt ignored] /]
GCMDP:	DMOVE	T1,[EXP CMDBLK,INIINB]	;DO THE COMMAND INIT
	CALL	PARSE			;PROMPT
	 JFCL				;SNH
	TXZ	F,F.NO+F.ABT		;NOT AN ABORT COMMAND
	SKIPN	INTRQ
	TXZ	F,F.NVOL+F.DERR+F.NDIR+F.FAKE+F.NSEQ+F.WILD
	MOVEM	F,FLGTMP
	MOVEM	P,STKSAV		;SAVE STACK IN CASE REPARSE
	MOVEI	T1,RPSSTR
	SKIPE	INTRQ			;GET PROPER REPARSE BACKOUT STACK
	MOVEI	T1,RPSISR
	MOVEM	T1,RPSSTK		;SAY NO REPARSE OPS NEED DOING YET
RPRS:	MOVEI	T2,CM1INB		;ASSUME NOT UNDER INTERRUPT
	SKIPE	INTRQ			;ARE WE UNDER AN INTERRUPT??
	MOVEI	T2,CM2INB		;YES, USE THE INTERRUPT COMMANDS LIST
	TXZ	F,F.NO			;"NO" ISN'T SET YET
PARCMD:	MOVEI	T1,CMDBLK
	CALL	PARSE			;PARSE A COMMAND
	 JRST	UKCERR			;UNKNOWN COMMAND
	MOVEM	T2,CURCMD		;STORE THE COMMAND INFO
	HRRZ	T1,(T2)
	JRST	(T1)
;Routine should return to CMDEND (if all OK), BAKOUT (if failing or ABORTed),
; or NOCMD (if the parse didn't work properly).

UKCERR:	CALL	ANNERR			;SOME SORT OF ERROR COMING UP
	MOVEI	T1,CM1LST		;SEE IF TRYING TO TYPE REAL COMMAND..
	SKIPN	INTRQ			;AT THE WRONG TIME
	MOVEI	T1,CM2LST		;IE, GET "OTHER" COMMAND LIST
	HRROI	T2,ATOM			;GET WHAT HE TYPED
	TBLUK%				;LOOK FOR IT IN THE NO-INTER TABLE
	TXNN	T2,TL%ABR!TL%EXM	;MATCH?
	JRST	UK1ERR			;NO, JUST BAD TYPING
	TYPE	[ASCIZ/?The /]
	HLRO	T1,(T1)
	TYPEAT	T1			;TYPE THE ILLEGAL COMMAND BACK
	TYPE	[ASCIZ/ command will not be legal until /]
	SKIPN	INTRQ			;UNDER ^E?
	JRST	BADTM1			;NO
	TYPE	[ASCIZ/ABORT (/]
	HRRZ	T1,CMDWAS		;TYPE THE INTERRUPTED COMMAND BACK
	HLRO	T1,(T1)
	TYPEAT	T1
	TYPE	[ASCIZ/) is typed./]
	JRST	NOCMD
BADTM1:	TYPE	[ASCIZ/a command is
 interrupted with Control-E./]
	JRST	NOCMD
UK1ERR:	TYPE	[ASCIZ/?Not a defined command/]
;NOCMD assumes nothing mapped needs unmapping.
; Come here when commands under the ^E interrupt fail.
NOCMD:	SETZM	OKIAE			;NO MORE ^A NOW
	CALL	UNDO			;GET THINGS LEFT BY PARSING
	CALL	WHERE			;IF INPUT FROM PRIMARY..
	 CALL	UNTAKE			;DON'T UNDO TAKE FILES ON HIM
	MOVE	F,FLGTMP
	JRST	GCMDP

;Here if ^U or rubout
TRAPRP:	CALL	UNDO		;UNDO THE EFFECTS OF THE PARTIAL PARSE
GRPRS:	MOVE	F,FLGTMP	;RECOVER FLAGS BEFORE PARSE
	MOVE	P,STKSAV	;RESTORE THE STACK
	JRST	RPRS		;AND GO REPARSE

;Here if a command fails midstream or gets an ABORT.  Clean up pages,
; drop PIDs, toss take files, and do everything else to make reality
; stable.
BAKOUT:	CALL	WHERE		;IF INPUT FROM PRIMARY, DON'T HURT TAKES
	 CALL	UNTAKE		;TOSS ANY COMMAND FILES
	;JRST	GETOUT		;FINISH UP
;GETOUT is where we go if a command failed in an "acceptable" way, ie an EOT
; command given while already at EOT.
GETOUT:	CALL	KILLIO		;STOP TAPE, DROP BUFFERS, MAPPED FILES.
	CALL	UNDO		;GET ANYTHING LEFT BY PARSING
	JRST	PANIC		;AND SET UP ANEW

KILLIO:	SETO	T1,		;UNMAP FILE PAGES
	MOVE	T2,[.FHSLF,,PAGPAG]
	MOVE	T3,[PM%CNT+PBSIZ]
	PMAP%
	 ERJMPS	.+1
;**;[536] At KILLIO:+5L, add 5 lines and label	SM	22-Jan-86
	TXZN	F,F.RETR	;[536] DID WE DIE ON RETRIEVAL?
	JRST	NORETD		;[536] NO, SKIP THIS
	CALL	UNLOAD		;[536] YES, TOSS TAPE NOW
	CAIE	P5,0		;[536] DID WE HAVE A REQUEST IN PROGRESS?
	CALL	RETFAI		;[536] YES, REQUEUE OR DROP REQUEST
NORETD:	SKIPE	T1,LSTDMP	;[536] IS THERE A LAST OUTPUT BUFFER?
	CALL	RELPGS		;YES, KILL IT
	SETZM	LSTDMP
	CALL	KILCHN		;LOSE QUEUED TAPE DATA
	SETZM	WRISEQ		;NO IDEA WHERE WE ARE
	SKIPE	T1,CURBLK	;IS THERE A CURRENT BUFFER ALLOCATED?
	CALL	RELPGS		;YES, BYEBYE
	SETZM	CURBLK
	SKIPE	T1,MYPID	;HAVE A PID?
	CALL	RELPID		;MAKE IT HISTORY
	SKIPE	T1,LSTJFN	;LIST FILE OPEN?
	CALL	DRPJFN		;YES, BYEBYE
	SETZM	LSTJFN
	SKIPE	T1,INIJFN	;NO INITIAL JFN
	CALL	DRPUFN
	SETZM	INIJFN
	SKIPE	T1,JFN		;ANYTHING HERE?
	CALL	DRPJFN
	SETZM	JFN
	SETZM	INIFLG		;NOT SCANNING OVER ANYTHING
	CALL	WAITFN		;WAIT FOR TAPE TO STOP MOVING
	CALL	CLRERR		;TOSS OLD ERRORS
	SKIPN	T1,MTJFN	;MAKE SURE READING FORWARD
	JRST	NOTAPF
	MOVX	T2,.MOSDR
	SETZ	T3,
	MTOPR%
	 ERJMPS	.+1		;OH WELL
NOTAPF:	TXZ	F,F.BACK	;NOT READING FORWARD
	SETZM	TRAPTO		;NO INPUT ROUTINE TO WATCH
	TXZE	F,F.RETR	;NOT RETRIEVING
	CALL	UNLOAD		;IF WE WERE, UNLOAD
	RET

KILCHN:	SKIPE	T1,DMPCHA	;DELETE OLD CHAIN
	CALL	CLRCH2
NTOSS:	SETZM	BLKCNT
	CALL	LOSSEQ		;TOSS SEQUENCE NUMBER
	TXZ	F,F.NVOL+F.FAKE+F.CIRC+F.EOF+F.NSEQ ;THESE FLAGS SHOULD GO
	RET

CLRCHN:	SKIPN	T1,DMPCHA
	RET
CLRCH2:	CALL	RELPGS
	JUMPN	T1,.-1
	SETZM	DMPCHA		;THIS MEANS NEXT READ GETS CUTE
	RET

;Here if command finishes normally and should clean out a readahead
; chain.  ^E possible commands should not come here.
CMDFIN:	CALL	KILCHN
;Here at command end (if it finishes normally).  Do normal cleanups.
CMDEND:	CALL	IFCRL2
	JRST	CLRERR		;AND RET TO CALLER
	SUBTTL	Interrupt code
;This code handles the interrupts (^A, ^E, timer, quasar) and the friends
; of ABORT and CONTINUE.

;TIMER% interrupt.  Break out if QUASAR takes too long to get back to us,
; and set the "finished" flag.
TIMINT:	TXZN	F,F.WAIT	;WAITING?
	DEBRK%			;NO, RETURN IMMEDIATELY
	MOVEM	T1,RETFIN	;SAVE T1
	SKIPE	NXTRTP		;DID WE GET A REQUEST?
	JRST	TIMIN2		;YES, JUST IN TIME
	HRROI	T1,[ASCIZ/
?Assuming no requests in the retrieval queue./]
	PSOUT%			;NO, COMPLAIN
TIMIN2:	HLRZ	T1,CHNTAB+TIMCHN
	AOS	@LEVTAB-1(T1)	;BREAK THE WAIT
	SKIPE	NXTRTP		;ANOTHER MESSAGE IN THE QUEUE?
	TDZA	T1,T1		;YES, RETURN SAYING NOT DONE
	SETO	T1,		;NO, AND WAITED LONG ENOUGH
	EXCH	T1,RETFIN	;GET T1 BACK; SET STATE OF "DONE" FLAG
	DEBRK%			;RETURN TO CALLER

;^A is a request for program information
;^A can happen at any time.  Unlike ^E, which merely sets a flag and
; returns, we have to actually do things without disturbing anything
; important.  Hence, we don't use TYPE or DECOUT or anything like
; that - we just do output to .PRIOU (it's faster anyway).
CFINT:	SKIPL	OKIAE		;DO WE WANT TO HANDLE ^A NOW?
	JRST	NOINTN		;NO INTERRUPTS LEGAL NOW
	MOVEM	17,I3ACS+17	;SAVE AC'S
	MOVEI	17,I3ACS
	BLT	17,I3ACS+16
	CALL	CFINFO		;CALL ROUTINE TO DO IT
RETIN3:	MOVSI	17,I3ACS	;RESTORE INTERRUPT ACS
	BLT	17,17
	DEBRK%

;CFINFO can be called at ^A interrupt time, or any other time.
; Don't add code that changes the state of anything here. Ie, calling
; IFCRLF is wrong because it changes IFCTMP, etc.
CFINFO:	MOVEI	T1,.PRIOU
	DOBE%
	RFPOS%
	HRROI	T1,CRLF
	TRNE	T2,-1
	PSOUT%
	HRRZ	T1,CURCMD	;TYPE THE NAME OF THE COMMAND IN PROGRESS
	HLRO	T1,(T1)
	LDB	T2,[POINT 7,(T1),6] ;IS THERE A COMMAND NAME?
	JUMPE	T2,CFNCMN	;NO, MUST BE INVISIBLE
	PSOUT%
	HRROI	T1,[ASCIZ/ in progress. /]
	PSOUT%
CFNCMN:
 IFN FTDEB,<
	CALL	PRCUSE		;WHAT PERCENT OF MEMORY IS USED UP?
	JUMPE	T2,CFNMEM
	MOVEI	T1,"("
	PBOUT%
	MOVEI	T3,^D10
	MOVX	T1,.PRIOU
	NOUT%
	 ERJMPS	.+1
	HRROI	T1,[ASCIZ/%) /] ;TYPE THE USAGE
	PSOUT%
>
CFNMEM:	CALL	CFNFIL
	SKIPN	LSTSEN
	JRST	CFNNLF
;Type out last file seen on tape (during RESTORE, PRINT, etc) here.
;Measure the string, ignoring the ;Pnnnnnn;Aaccountname stuff.
;As it gets measured, compare it to the result of the last filename typed
; via the ^A (stored in CNFBFR by CFNFIL). If it is the same, it isn't
; worth typing, so don't.
	SETZ	T3,
	MOVE	T1,[POINT 7,LSTSEN]
	MOVE	T4,[POINT 7,CFNBFR]
CNTFLN:	ILDB	T2,T1
	ILDB	Q1,T4		;EITHER BYTE POINTER OR 0
	CAIN	T2,";"
	SETZ	T2,
	CAIE	Q1,(T2)
	SETZ	T4,		;DIFFERENT. IT IS WORTH TYPING OUT.
	JUMPE	T2,CNTFL2	;END. GO TYPE IT (MAYBE)
	CAIE	T2,.CHCNV	;IS IT ^V?
	AOJA	T3,CNTFLN	;NO. COUNT AS A CHARACTER AND GO ON
	ILDB	T2,T1		;YES, NEXT COULD BE ANYTHING
	ILDB	Q1,T4
	CAIE	Q1,(T2)
	SETZ	T4,
	ADDI	T3,2
	JRST	CNTFLN
CNTFL2:	JUMPN	T4,CFNNLF		;T4 NONZERO IF STRINGS WERE THE SAME
	HRROI	T1,[ASCIZ/
 Last seen on tape: /]
	PSOUT%
	HRROI	T2,LSTSEN
	MOVX	T1,.PRIOU
	SOUT%
	 ERJMPS	.+1
CFNNLF:	HRROI	T1,CRLF
	PSOUT%
	RET

CFNFIL:	SETZM	CFNBFR
	SKIPN	T2,JFN
	RET
	HRROI	T1,[ASCIZ/(Initial) /]
	SKIPE	INIFLG			;SCANNING FILES VIA INITIAL?
	PSOUT%				;YES, SAY SO
	HRROI	T1,[ASCIZ/File: /]
	PSOUT%
	HRROI	T1,CFNBFR
	MOVE	T3,[JFNSAL]
	JFNS%
	 ERJMPS	CPOPJ
	HRROI	T1,CFNBFR
	PSOUT%
	SKIPGE	T2,CURREN
	RET
	HRROI	T1,[ASCIZ/ (/]
	PSOUT%
	MOVX	T1,.PRIOU
	MOVEI	T3,^D10
	NOUT%
	 ERJMPS	.+1
	MOVEI	T1,")"
	PBOUT%
	RET

;^E is a request for the prompt, with the option to CONTINUE or ABORT
CEINT:	AOSE	OKIAE		;DO WE CARE?
	JRST	NOINTN
	MOVEM	T1,INTRQ	;SAVE T1 FOR A MOMENT
	HRROI	T1,[ASCIZ/
Interrupting.../]
	PSOUT%			;DON'T USE TYPE, TOO MUCH TROUBLE
	SETO	T1,
	EXCH	T1,INTRQ	;RESTORE T1, SET INTRQ TO -1
	SKIPN	TRAPTO		;GO SOMEWHERE SPECIAL?
	DEBRK%			;NO, ALL DONE
	EXCH	T1,TRAPTO	;SAVE T1, GET TRAPTO
	TXO	T1,PC%USR	;IN USER MODE PLEASE (BREAK FROM JSYS)
	MOVEM	T1,LVPC3	;WHERE WE RETURN TO
	TXZ	T1,PC%USR
	EXCH	T1,TRAPTO	;RESTORE T1
	DEBRK%			;HOME

;Here when we get a ^E or ^A and don't want one.  Beep at user.
NOINTN:	MOVEM	T1,NOITMP
	MOVEI	T1,.CHBEL
	PBOUT%			;TAKE THAT!
	 ERJMPS	.+1
	MOVE	T1,NOITMP
	DEBRK%

;TSTINT is slightly tricky.
;Here to test for an interrupt.  Return +2 if no interrupt or there was
; one and the user went off and did commands and then continued.  +1 means
; the user did an ABORT command.  This may return through ABOCON.
TSTINT:	SKIPL	INTRQ		;^E INTERRUPT FLAGGED?
	JRST	CPOPJ1		;NO, SKIP HOME
	MOVEM	17,ICMACS+17	;YES, SAVE AC'S
	MOVEI	17,ICMACS
	BLT	17,ICMACS+16
	MOVNS	INTRQ		;MAKE POSITIVE <<
	HRROI	T1,[ASCIZ/DUMPER>>/]
	MOVEM	T1,CMDBLK+.CMRTY;PUT UP INTERRUPT PROMPT
	MOVE	T1,CURCMD
	MOVEM	T1,CMDWAS	;STORE THE INTERRUPTED COMMAND INFO
	MOVE	T1,RPSSTK	;SAVE THE OLD REPARSE OP STACK
	MOVEM	T1,RPSSTR	;IN AN UNUSED LOC
	MOVEI	T1,RPSISR	;AND SET UP THE INTERRUPT REPARSE OP STACK
	MOVEM	T1,RPSSTK	;..
	MOVEI	P,INTSTK	;GET A NEW STACK
	MOVE	T1,[.PRIIN,,.PRIOU]
	CALL	PUSTAK		;INPUT FROM THE TERMINAL
	CALL	GCMDI		;CALL THE COMMAND SCANNER
	 JRST	.-1		;DO COMAMNDS UNTIL CONTINUE OR ABORT

;CONTINUE and ABORT don't come to the above JRST .-1 because they restore
; the old stack pointer and hence act like the return from TSTINT.

$CONT:	HRRZ	T1,CMDWAS	;GET POINTER TO INTERRUPTED COMMAND NAME
	HLRO	T1,(T1)
	CALL	GUIDE		;GUIDE WITH COMMAND TO CONTINUE
	 JRST	NOCMD		;DIDN'T MATCH
	CONFIRM
	TYPE	[ASCIZ/ Continuing /]
	MOVE	T1,CMDWAS	;PUT THE INTERRUPTED COMMAND..
	MOVEM	T1,CURCMD	;BACK AS THE NEW ONE
	TXZ	F,F.ABT
	JRST	ABOCON

$ABORT:	HRRZ	T1,CMDWAS	;GET A POINTER TO INTERRUPTED COMMAND NAME
	HLRO	T1,(T1)
	CALL	GUIDE		;GUIDE WITH THE DOOMED COMMAND
	 JRST	NOCMD
	CONFIRM
	TYPE	[ASCIZ/ Aborting /]
	TXO	F,F.ABT

;Here with F.ABT on to return +1 with ^A, ^E still off (presumably to
; hit a JRST BAKOUT and abort the interrupted command), or F.ABT off to
; return +2 with ^A, ^E back on.  This code represents the return
; from CALLing TSTINT.
ABOCON:	SETZM	CMDWAS		;CLEAR THE INTERRUPED COMMAND INFO
	TYPEAT	GUIINB+.CMDAT	;TYPE COMMAND NAME (LAST GUIDE TEXT)
	TYPE	[ASCIZ/ command...
/]
	CALL	TAKEOF
	 JFCL			;MUST HAVE CLEARED THE JFN STACK FOR ERROR
	MOVE	T1,RPSSTR	;RECOVER LAST REPARSE OP STACK POINTER
	MOVEM	T1,RPSSTK	;.. <
	HRROI	T1,[ASCIZ/DUMPER>/]
	MOVEM	T1,CMDBLK+.CMRTY;PUT NORMAL PROMPT BACK
	MOVE	17,[ICMACS+1,,1];RESTORE AC'S 1-17 (KEEP CURRENT FLAGS IN 0!)
	BLT	17,16
	MOVE	17,ICMACS+17
	SETZM	INTRQ		;OFF GOES THE FLAG
	TXNE	F,F.ABT		;ABORT OR CONTINUE?
	RET			;ABORT, RETURN
	SETOM	OKIAE		;GIVE ^A, ^E BACK
	JRST	CPOPJ1		;AND RET +2

;Here on a file data interrupt.  Needed, because these can happen when we touch
; a page after PMAPing it in (ie, at COMCH1)
DAEINT:	SKIPG	JFN		;DO WE KNOW WHERE IT CAME FROM?
	DEBRK%			;NO.  DON'T TRY TO SAY
	DMOVEM	T1,I2ACS+1
	MOVEM	T3,I2ACS+3
	CALL	IFCRL2
	HRROI	T1,[ASCIZ/%Disk data error on /]
	PSOUT%
	MOVE	T2,JFN
	SETZ	T3,
	MOVEI	T1,.PRIOU
	JFNS%
	 ERJMPS	.+1
	HRROI	T1,CRLF
	PSOUT%
	DMOVE	T1,I2ACS+1
	MOVE	T3,I2ACS+3
	DEBRK%

; Here on PSI for IPCF message arrived
QSRINT:	MOVEM	17,I3ACS+17
	MOVEI	17,I3ACS
	BLT	17,I3ACS+16
	MOVEI	P,QSRSTK-1
RECALL:	CALL RCVQSR
	 JRST	RETQSR
	MOVE	T1,.MSFLG(P1)	; Get flags
	MOVE	T2,.MSCOD(P1)	; Get ack code
	TXNE	T1,MF.ACK	; Guy want an ACK?
	CALL DOACK		; Ack him now
	TXNE	T1,MF.NOM	; No message?
	JRST RECALL		; Yes, just eat that
	TXNN	T1,MF.WRN	; Warning message?
	TXNE	T1,MF.FAT	; Fatal message
	JRST QSTEXT		; Is a message, print it
	LOAD	T1,MS.TYP,.MSTYP(P1), ; Get type code
	CAIN	T1,.QONEX	; Next job msg?
	JRST QSNXT		; Yes
	CAIN	T1,.QOABO	; Abort msg?
	JRST QSABT		; Yes
	CAIN	T1,.QORCK	; Checkpoint?
	JRST RECALL		; Yes
	CAIN	T1,.QOSUP	; Setup message?
	JRST QSSETU		; Yes
	WARN	<Unknown message type received>
	JRST RECALL		;Loop to check queues

QSNXT:	MOVE	T1,.EQITN(P1)	; Get task name
	MOVEM	T1,TPTSK	; And remember it
	MOVX	T1,RC%EMO	; Exact match pls
	HRROI	T2,.EQOWN(P1)	; Point to owner of request
	SETZB	T3,TPRQUS	; No stepping info
	RCUSR%
	 ERJMPS FLOWN		; Bombed
	TXNN	T1,RC%NOM+RC%AMB+RC%NMD+RC%WLD ; Failure or wild?
	MOVEM	T3,TPRQUS	; No, Remember who
FLOWN:	HRLI	T1,.EQLIM+1(P1)	; From there
	HRRI	T1,.ARTP1+TPBLK	; To there
	BLT	T1,TPBLK+.ARSF2	; Move tape info
	MOVE	T1,.EQLIM(P1)	; Get time & flag
	MOVEM	T1,.ARODT+TPBLK
	MOVEI	P1,QSRMSR
	LOAD	T2,EQ.LOH,.EQLEN(P1)
	ADD	T2,P1		;POINT TO THE FP
	LOAD	T3,FP.LEN,(T2)	;GET FP LENGTH
	ADD	T2,T3		;POINT TO FD
	HRROI	T1,.FDFIL(T2)	;POINT TO FILESPEC
	HRROI	T2,TAPNAM	; Move file name to there
	CALL	CSTR
	HRROI	T1,.EQACT(P1)	; Where it is now
	HRROI	T2,TPACT	; Where account should be
	CALL	CSTR
	MOVEI	T1,TPBLK
	MOVEM	T1,NXTRTP
QSNXT1:	HLRZ	T1,CHNTAB+QSRCHN; Get level we're at
	TXZE	F,F.WAIT	;WAITING?
	AOS	@LEVTAB-1(T1)	; Yes, make him go again
	MOVEM	F,I3ACS		;MAKE SURE CHANGES TO F GET KEPT
RETQSR:	MOVSI	17,I3ACS
	BLT	17,17
	DEBRK%

QSSETU:	MOVE	T1,SUP.TY(P1)	; Get object type
	CAIE	T1,.OTRET	; Of type we expect?
	JRST	[
		 HRROI	T1,[ASCIZ/%Bad setup message
/]
		 PSOUT%
		 JRST	RECALL]
	MOVE	T1,SUP.FL(P1)	; Get flags
	TXNE	T1,SUFSHT	; Shutdown rather than start up?
	JRST	[SETOM	RETFIN	; Yes, flag, and...
		JRST	QSNXT1] ; ..leave as though we got a null request
	MOVE	T2,SUP.UN(P1)	; Get the unit #
	MOVE	T3,SUP.NO(P1)	; And NODE name
	CALL	ZIPMSS		; Setup to send
	MOVE	T1,[RSU.SZ,,.QORSU] ; Respond to setup
	MOVEM	T1,.MSTYP(P1)	; Length and type
	MOVE	T1,[.OTRET]	; Object type
	MOVEM	T1,RSU.TY(P1)
	MOVEM	T2,RSU.UN(P1)	; Unit number
	MOVEM	T3,RSU.NO(P1)	; Node name
	MOVX	T1,%RSUOK	; Say SETUO OK
	MOVEM	T1,RSU.CO(P1)	; Response code
	SETZM	RSU.DA(P1)	; No attributes
	MOVE	P1,[RSU.SZ,,QSRMSS]
	CALL	SNDQSR		; Send it
	JRST	RECALL

QSABT:	HRROI	T1,[ASCIZ/
%Abort received/]
	PSOUT%
	AOS	ABTFLG		; Note we got the abort poke
	JRST	RECALL

QSTEXT:	MOVEI	T1,"%"
	TXNE	T1,MF.FAT	; Fatal msg?
	MOVEI	T1,"?"
	PBOUT%
	HRROI	T1,[ASCIZ/QUASAR info - /]
	PSOUT%
	HRROI	T1,.OHDRS+ARG.DA(P1) ;GET ADDRESS OF TEXT
	PSOUT%			;PRINT IT
	HRROI	T1,CRLF
	PSOUT%
	JRST RECALL		; Done here

LEVTAB:	LVPC1
	LVPC2
	LVPC3

CECHN==1
QSRCHN==2
TIMCHN==3
CFCHN==4

CHNTAB:	0			;0 Free
	3,,CEINT		;1 ^E
	3,,QSRINT		;2 IPCF Msg from QUASAR recv'd
	3,,TIMINT		;3 TIMER channel to limit quasar infinit wait
	3,,CFINT		;4 ^A
	0			;5 free
	0			;6 Arith overflow
	0			;7 Float overflow
	0			;8 Reserved
	0			;9 PDL overflow
	0			;10 EOF
	2,,DAEINT		;11 File Data error	.ICDAE
	0			;12 Disk full
	0			;13 Reserved
	0			;14 Reserved
	0			;15 Ill Inst
	0			;16 Ill mem read
	0			;17 Ill mem write
	0			;18 Reserved
	0			;19 Inferior stopped
	0			;20 Sys res exhausted
	0			;21 Reserved
	0			;22 Non existant page
	0			;23 Free, 23-35
	0			;24
	0			;25
	0			;26
	0			;27
	0			;28
	0			;29
	0			;30
	0			;31
	0			;32
	0			;33
	0			;34
	0			;35

CHNMSK:	1B<CECHN>!1B<QSRCHN>!1B<CFCHN>!1B<.ICDAE>
				;NOT TIMCHN, WHICH WE TURN ON AND OFF
	SUBTTL	TAKE command
;TAKE and friends

$TAKE:	HLRZ	T1,TAKSTK	;GET THE TAKE STACK COUNT
	CAIL	T1,TAKLEN	;ALL FULL UP?
	 ERROR	<TAKEs nested too deeply, aborting.>
	GUIDES	<COMMANDS FROM FILE>
	MOVX	T1,GJ%OLD	;JUST AN OLD FILE, PLEASE
	MOVEM	T1,GTJBLK+.GJGEN
	SETZM	GTJBLK+.GJDEV
	SETZM	GTJBLK+.GJDIR
	SETZM	GTJBLK+.GJNAM
	HRROI	T1,[ASCIZ/CMD/]
	MOVEM	T1,GTJBLK+.GJEXT
	DMOVE	T1,[EXP CMDBLK,FICINB]	;INPUT FILE OR CONFRM
	CALL	PARSE
	 ERROR	<Not a Confirm or a File Specification>,NOCMD
	CAIN	T3,.CMCFM	;CONFIRM OR FILE?
	JRST	TAKEND
	CALL	RPSJFN		;SAVE JFN FOR REPARSE
	CONFIRM
	HRRZ	T1,T2		;GET JFN IN T1
	MOVE	T2,[7B5+OF%RD]	;TRY TO OPEN
	OPENF%
	 JSERRD	<Can't OPEN file>,NOCMD ;IF AN ERROR OCCURS, SAY WHY AND DIE
	HRLZS	T1		;JFN IN LH
	HRRI	T1,.NULIO	;OUTPUT (NOWHERE) IN RH
	CALL	PUSTAK
	JRST	CMDEND

;HERE WITH T1/ INJFN,,OUTJFN TO PUSH TO NEW INPUT & OUTPUT
PUSTAK:	MOVE	Q1,TAKSTK	;GET THE TAKE STACK
	EXCH	T1,CMDBLK+.CMIOJ;WHERE COMND LOOKS NOW
	PUSH	Q1,T1		;SAVE OLD SOURCE ON TAKE JFN STACK
	MOVEM	Q1,TAKSTK	;SAVE STACK POINTER
	RET

TAKEND:	SKIPN	INTRQ		;DOING ^E STUFF?
	JRST	TAKEN2		;NO, JUST ACT LIKE EOF
	MOVE	Q1,TAKSTK
	ADJSP	Q1,-1		;SIGH. TOSS THE PUSHED ^E LEVEL
	CALL	TAKEO2		;NOW TOSS THE LEVEL THE USER MEANT
	 JFCL			;FINE, HE'S JUST MAKING SURE
	MOVE	T1,[.PRIIN,,.PRIOU]
	CALL	PUSTAK		;AND LET HIM KEEP TAKING TO ME
	JRST	CMDEND
TAKEN2:	CALL	TAKEOS
	 ERROR	<No TAKE files active>,CMDEND
	JRST	CMDEND

TAKEOS:	TXOA	F,F.NO		;DON'T WANT ENDING MESSAGE
TAKEOF:	TXZ	F,F.NO		;ALLOW END MESSAGE
	MOVE	Q1,TAKSTK	;GET TAKE STACK
TAKEO2:	TLNN	Q1,-1
	RET			;NO OPERATION IF EMPTY STACK
	POP	Q1,T1		;RESTORE PREVIOUS JFNS
	MOVEM	Q1,TAKSTK
	EXCH	T1,CMDBLK+.CMIOJ;GIVE BACK LAST JFNS
	HLRZ	T2,T1		;GET COMMAND INPUT JFN IN T2
	CAIN	T2,.PRIIN	;IS IT MAIN (^E WOULD DO THIS)
	JRST	CPOPJ1		;YEAH, DON'T ANNOUNCE OR CLOSE
	TXZE	F,F.NO
	JRST	TAKEO3		;NO ENDING MESSAGE
	CALL	IFCRLF		;ANNOUNCE WHAT'S ENDING
	TYPE	<[ASCIZ/[Ending /]>
	CALL	TYJFNS
	TYPE	CBCR		;CLOSE BRACKET CRLF
TAKEO3:	MOVE	T1,T2
	CLOSF%			;CLOSE THE FILE OUT
	 JSERRD	<>,CPOPJ1	;FAILURE SEEMS UNLIKELY
	JRST	CPOPJ1		;+2 RET

;Here to blow away all take files
UNTAKE:	CALL	TAKEOF		;END THE CURRENT TAKE FILES
	 RET			;DONE
	JRST	UNTAKE		;GO UNTIL NONE LEFT
	SUBTTL	Simple commands
;Simple routines

;Put user declared saveset name into SSNTXT, where DUMP will get it.
$SSNAM:	DMOVE	T1,[EXP CMDBLK,TXTINB]
	CALL	PARSE
	 JSERRD	<>,NOCMD,JRST
	CONFIRM
	HRROI	T1,ATOM
	HRROI	T2,SSNTXT
	CALL	CSTR
	JRST	CMDEND

;PARITY
$PAR:	MOVEI	Q1,PARITY
	MOVEI	T2,PARTAB
	JRST	PARDEN
;DENSITY
$DEN:	MOVEI	Q1,DENSIT
	MOVEI	T2,DENTAB
PARDEN:	GUIDES	<OF MAGTAPE>
	MOVEI	T1,CMDBLK
	CALL	KEYWRD
	 ERROR	<Illegal selection>,NOCMD
	CONFIRM
	HRRZ	T2,(T2)		;GET DATA
	CAMN	T2,(Q1)		;IS THE USER CHANGING ANYTHING?
	JRST	CMDEND		;NO, DON'T MUCK WITH THE JFN
	TXNE	F,F.NBOT
	ERROR	<Can't change tape settings mid-tape, please rewind first>,NOCMD
	MOVEM	T2,(Q1)		;STORE WHEREVER CALLER REQUESTED
	SETOM	FRCSET
;Come here if you are changing the flavor of the OPENF% on the drive in some
; way.  It causes the drive to be dropped if it is opened.
RESEOP:	SKIPE	MTJFN		;GOT A JFN OUT THERE?
	SKIPN	OPNFOR		;OPEN IN A REAL WAY?
	JRST	CMDEND		;NOT THERE OR OPEN, FINE.
	SETZ	T1,		;WE DON'T WANT IT OPEN...
	CALL	GMOJFN		;SO NEXT OPENF% WILL USE NEW INFO
	 JFCL			;SNH
	JRST	CMDEND

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

PARTAB:	 NPARTB,,NPARTB
	TB .SJPRE,<EVEN>
	TB .SJPRO,<ODD>
	 NPARTB==.-PARTAB-1

;NO
$NO:	DMOVE	T1,[EXP CMDBLK,NOIINB]
	SKIPE	INTRQ		;INTERRUPTING A COMMAND?
	MOVEI	T2,NOCINB	;YES, LIMIT THE POSSIBILITIES
	CALL	PARSE
	 ERROR	<No such NO option>,NOCMD
	TXO	F,F.NO
	HRRZ	T2,(T2)
	JRST	(T2)

NOIINB:	<.CMKEY>B8+NOCINB
	EXP	NOCTAI
NOCINB:	<.CMKEY>B8
	EXP	NOCTAB

NOCTAI:	 NIOTB,,NIOTB
	CTB $AB4,	<ABEFORE>
	CTB $ASI,	<ASINCE>
	CTB $B4,	<BEFORE>
	CTB KILSDT,	<DATES>
 IFN FTEXAC,<
	CTB EXACTM,	<EXACT>
 >
 IFN FTIND,<
	CTB $INDMD,	<INDUSTRY>,CM%INV
 >
	CTB $INISP,	<INITIAL>
	CTB $INTER,	<INTERCHANGE>
	CTB $MB4,	<MBEFORE>
	CTB $MSI,	<MSINCE>
	CTB $SINCE,	<SINCE>
	 NIOTB=.-NOCTAI-1

NOCTAB:	 NNOTB,,NNOTB
	CTB $CSUM,	<CHECKSUM>
	CTB $CREAT,	<CREATE>
	CTB $LDIR,	<DIRECTORIES>
	CTB $LFIL,	<FILES>
	CTB $LIST,	<LIST>
	CTB $SIL,	<SILENCE>
	 NNOTB==.-NOCTAB-1

;TURN SIMPLE FLAGS ON OR OFF HERE
$SIL:	MOVX	T2,F.DIRT+F.FILT
	TXCA	F,F.NO		;SILENCE IS SORT OF BACKWARDS
$LDIR:	MOVX	T2,F.DIRT
	JRST	DOFLA2
$LFIL:	MOVX	T2,F.FILT
	JRST	DOFLA2
$CREAT:	MOVX	T2,F.CREA+F.DDIR
	HRROI	T1,[ASCIZ/DIRECTORIES FROM TAPE DATA/]
	;JRST	DOFLAG
DOFLAG:	CALL	GUIDE
	 JRST	NOCMD
DOFLA2:	CONFIRM
	TXNN	F,F.NO
	JRST	ONFLAG
	ANDCM	F,T2
	JRST	FLAGCH
ONFLAG:	TXNE	F,F.PRIV
	JRST	FLAGOK
	TXNE	T2,F.CREA	;TRYING TO TURN ON PRIVED THINGS?
OPRERR:	ERROR	<That requires WHEEL or OPR privs>,NOCMD
FLAGOK:	IOR	F,T2
	TXNE	T2,F.DIRT	;TYPE DIRECTORIES GOING ON?
	SETOM	DDOFLG		;YES, MAYBE FORCE OUT CURRENT DIRECTORY!
	TXNE	F,F.CREA	;ENABLING CREATE?
	SETZM	PASWDC		;YES, MAKE SURE THIS ERROR IS WARNED ABOUT
FLAGCH:	JRST	CMDEND

;INTERCHANGE
$INTER:	GUIDES	<FORMAT>
	CONFIRM
	TXNE	F,F.NO
	JRST	[TXNN	F,F.INTR;TURNING OFF?
		 JRST	CMDEND	;YES, IF ALREADY OFF, JUST LEAVE
		 JRST	CHNINT]	;CHANGING STATE, GO ON
	TXNE	F,F.INTR	;TURNING ON, IS IT ALREADY ON?
	JRST	CMDEND		;YES, JUST LEAVE
CHNINT:	TXNE	F,F.NBOT	;MAY NOT CHANGE MID-TAPE!
	ERROR	<May not change INTERCHANGE state mid-tape, please REWIND first>
	TXNN	F,F.NO		;PRECEDING "NO"?
	JRST	INTEYE
	TXZE	F,F.INTR
	SKIPN	T2,OLDBKF
	JRST	CMDEND
	MOVEM	T2,WRIBKF
	CAIN	T2,1
	JRST	CMDEND
	TYPE	<[ASCIZ/[Restoring BLOCKING-FACTOR to /]>
	CALL	DECOUT
	TYPE	CBCR
	JRST	CMDEND
INTEYE:	TXOE	F,F.INTR
	JRST	CMDEND
	MOVEI	T1,1
	EXCH	T1,WRIBKF	;SET BLOCKING FACTOR TO 1 FOR INTERCHANGE
	MOVEM	T1,OLDBKF	;AND SAVE OLD ONE
	JRST	CMDEND

 IFN FTEXAC,<
;EXACT MODE FLAG
EXACTM:	GUIDES	<MODE>
	CONFIRM
	SETOM	EXACT
	TXNE	F,F.NO
	SETZM	EXACT
	JRST	CMDEND
 > ;END IFN FTEXAC

 IFN FTIND,<
$INDMD:	GUIDES	<MODE>
	CONFIRM
	TXNE	F,F.NO
	TXZA	F,F.36MD
	TXO	F,F.36MD
	JRST	RESEOP
>

;Set up INITIAL filespec
$INISP:	GUIDES	<FILESPEC>
	TXNE	F,F.NO
	JRST	[SETZ	T2,
		 JRST	INIS2]
	SETZB	T1,12
	MOVX	T3,GJ%OLD+GJ%IFG
	CALL	SETWLD
	DMOVE	T1,[EXP CMDBLK,FILINB]
	CALL	PARSE
	 ERROR	<Illegal file specification>
	CALL	RPSJFN
INIS2:	CONFIRM
	EXCH	T2,INIJFN
	HRRZ	T1,T2
	CAIE	T1,0
	CALL	DRPUFN
	JRST	CMDEND

;Set up LIST file
$LIST:	SETZM	MAILFL
	TXNE	F,F.NO
	JRST	LISTOF
	GUIDES	<LOG INFORMATION ON FILE>
LISTCL:	DMOVE	T1,[EXP CMDBLK,LISINB]
	CALL	PARSE
	 JSERRD	<>,NOCMD,JRST
	CAIE	T3,.CMSWI
	JRST	NOLISM
	HRRZ	T2,(T2)
	JUMPE	T2,LISTCL
	TXNN	F,F.PRIV	;/MAIL NEEDS PRIVS
	JRST	OPRERR
	SETOM	MAILFL
	DMOVE	T1,[EXP CMDBLK,LI3INB]
	CALL	PARSE
	 JSERRD	<>,NOCMD,JRST
NOLISM:	CALL	RPSJFN
	CONFIRM
	CALL	CHKJFN		;MAKE SURE IT'S REASONABLE!
	TLNE	T3,-1		;ILLEGAL OR CURRENT MTA
	 ERROR	<Illegal LIST file choice>,NOCMD
	MOVE	T2,T1
	HRROI	T1,LSTFIL
	MOVE	T3,[JFNSAL]
	JFNS%
	MOVE	T1,T2		;TOSS THE JFN NOW
	CALL	DRPUFN
	JRST	CMDEND
LISTOF:	CONFIRM
	SETZM	LSTFIL
	JRST	CMDEND

LISINB:	<.CMOFI>B8+CM%DPP+LI2INB
	BLOCK	2
	-1,,[ASCIZ/LPT:DUMPER.LOG/]

LI2INB:	<.CMSWI>B8
	LI2TAB
LI2TAB:	 LI2LEN,,LI2LEN
 IFN FTMAIL,<
	[ASCIZ/MAIL/],,1
 >
	[ASCIZ/NOMAIL/],,0
	 LI2LEN=.-LI2TAB-1

LI3INB:	<.CMOFI>B8+CM%DPP
	BLOCK	2
	-1,,[ASCIZ/DUMPER-MAIL.TXT/]

;CHECKSUM
$CSUM:	TXNE	F,F.NO
	JRST	NCSUM
	GUIDES	<FILES>
	DMOVE	T1,[EXP CMDBLK,CSMTAB]
	CALL	KEYWRD
	 ERROR	<No such CHECKSUM option>,NOCMD
	CONFIRM
	HRRZ	T2,(T2)		;PICK UP ADDRESS OF FLAGS
	TXZ	F,F.CHKS+F.CSEQ	;TURN THEM ALL OFF
	IOR	F,(T2)		;ON THE ONES SELECTED
	JRST	CMDEND
NCSUM:	CONFIRM
	TXZ	F,F.CHKS+F.CSEQ
	JRST	CMDEND

CSMTAB:	 NCKLEN,,NCKLEN
	TB [F.CHKS],		<BY-PAGES>
	TB [F.CHKS+F.CSEQ],	<SEQUENTIAL>
	 NCKLEN==.-CSMTAB-1

;SUPERSEDE
$SUP:	DMOVE	T1,[EXP CMDBLK,STBL]
	CALL	KEYWRD		;PARSE KEYWORD
	 ERROR	<No such SUPERSEDE option>
	CONFIRM
	HRRZ	T2,(T2)		;GET FLAG ADDRESS
	TXZ	F,F.SSA+F.SSN	;MOVE THEM TO F
	IOR	F,(T2)
	JRST	CMDEND

STBL:	 NSTBL,,NSTBL
	TB [F.SSA],	<ALWAYS>
	TB [F.SSN],	<NEVER>
	TB [0],		<OLDER>
	 NSTBL==.-STBL-1

;ACCESSED-BEFORE
$AB4:	MOVEI	Q1,ABTAD
	JRST	DATEST
;ACCESSED-SINCE
$ASI:	MOVEI	Q1,ASTAD
	JRST	DATESF
;WRITTEN-BEFORE
$B4:	MOVEI	Q1,WBTAD
	JRST	DATEST
;WRITTEN-SINCE
$SINCE:	MOVEI	Q1,WSTAD
	JRST	DATESF
;MOVED-BEFORE
$MB4:	MOVEI	Q1,MBTAD
	;JRST	DATEST
DATEST:	TXNE	F,F.NO
	JRST	CLRSDO
	GUIDES	<DATE AND TIME>
	CALL	GETTAD
	 JRST	NOCMD
	MOVEM	T1,(Q1)
	JRST	DATEND
;MOVED-SINCE
$MSI:	MOVEI	Q1,MSTAD
	;JRST	DATESF
DATESF:	TXNE	F,F.NO
	JRST	CLRSDI
	GUIDES	<DATE AND TIME>
	CALL	GETTAD
	 JRST	NOCMD
	MOVEM	T1,(Q1)
	GTAD%
	CAMGE	T1,(Q1)
	WARN	<The date and time given has not yet occured>
DATEND:	SETOM	DATSET		;DATE HAS BEEN SET
	JRST	CMDEND
CLRSDI:	TDZA	T1,T1
CLRSDO:	HRLOI	T1,377777
	CONFIRM
	MOVEM	T1,(Q1)
	JRST	CMDEND

KILSDT:	CONFIRM
	SETZM	MSTAD
	SETZM	WSTAD
	SETZM	ASTAD
	HRLOI	T1,377777
	MOVEM	T1,MBTAD
	MOVEM	T1,WBTAD
	MOVEM	T1,ABTAD
	JRST	DATEND

$$SET:	DMOVE	T1,[EXP CMDBLK,SETTBL]
	CALL	KEYWRD		;PARSE KEYWORD
	 ERROR	<No such SET option>
	HRRZ	T2,(T2)
	JRST	(T2)		;AND GO ON

SETTBL:  NSETTB,,NSETTB
	TB SETBLK,	<BLOCKING-FACTOR>
	TB TAPNUM,	<TAPE-NUMBER>
	 NSETTB==.-SETTBL-1

TAPNUM:	GUIDES	<DECIMAL NUMBER>
	DMOVE	T1,[EXP CMDBLK,NUMINB]
	CALL	PARSE
	 JSERRD	<>,NOCMD,JRST
	CONFIRM
	CAIG	T2,0
	 ERROR	<Tape number must be positive>,NOCMD
	MOVEM	T2,TAPENO
	JRST	CMDEND

SETBLK:	GUIDES	<TO>
	DMOVE	T1,[EXP CMDBLK,NUMINB]
	CALL	PARSE
	 JSERRD	<>,NOCMD,JRST
	GUIDES	<RECORDS>
	CONFIRM
	SKIPE	T1,REABKF	;DO WE KNOW THE BLOCKING FACTOR?
	CAMN	T1,T2		;YES, IF NOT THE SAME DON'T TAKE
	TXNE	F,F.BLKF	;BLOCKING FACTOR UNCHANGABLE?
	JRST	ILCHBK
	CAIG	T2,MAXBKF	;MUST BE WITHIN LIMIT
	CAIGE	T2,1		;MUST BE 1 OR GREATER
	ERROR	<That BLOCKING-FACTOR is illegal>
	TXNE	F,F.INTR	;INTERCHANGE MODE?
	JRST	SETBKI		;YES, CAN'T USE YET, SAVE FOR LATER
	MOVEM	T2,WRIBKF	;REMEMBER BLOCKING-FACTOR
	JRST	CMDEND
SETBKI:	MOVEM	T2,OLDBKF	;TURNING OFF INTERCHANGE WILL BRING THIS IN
	TYPE	[
ASCIZ/ Not setting BLOCKING-FACTOR yet - INTERCHANGE mode is set.
 Turning INTERCHANGE off will give you your requested BLOCKING-FACTOR./]
	JRST	CMDEND

ILCHBK:	SKIPN	T2,T1		;IF 0, REABKF WAS NEVER SET (WE ONLY WROTE..
	MOVE	T2,WRIBKF	; AND NEVER READ).
ILCHB2:	ERROR	<Tape blocking factor is already set to >,.+1
	CALL	DECOUT
	TYPE	[ASCIZ/, please REWIND first/]
	JRST	BAKOUT

$PRO:	GUIDES	<OF RESTORED FILES FROM>
	DMOVE	T1,[EXP CMDBLK,ACCTAB]
	CALL	KEYWRD		;PARSE KEYWORD
	 ERROR	<No such PROTECTION option>,NOCMD
	CONFIRM
	HRRZ	T2,(T2)
	CAIN	T2,0
	TXZA	F,F.RPRO
	TXO	F,F.RPRO
	JRST	CMDEND

$ACC:	GUIDES	<OF RESTORED FILES FROM>
	DMOVE	T1,[EXP CMDBLK,ACCTAB]
	CALL	KEYWRD		;PARSE KEYWORD
	 ERROR	<No such ACCOUNT option>
	CONFIRM
	HRRZ	T2,(T2)
	CAIN	T2,0
	TXZA	F,F.RACC
	TXO	F,F.RACC
	JRST	CMDEND

;ARGUMENT KEYWORD TABLE FOR PROTECTION AND ACCOUNT
ACCTAB:	 NACCTB,,NACCTB
	TB 0,	<SYSTEM-DEFAULT>
	TB 1,	<TAPE>
	 NACCTB==.-ACCTAB-1

;FORMAT - use if midtape
$FMT:	GUIDES	<VERSION NUMBER IS>
	DMOVE	T1,[EXP CMDBLK,FMTINB]
	CALL	PARSE
	 ERROR	<Not a decimal number>
	CONFIRM
	CAIG	T2,CURFMT	;THIS IS THE MAX
	CAIGE	T2,4		;THIS IS THE MINIMUM
ILFMTV:	ERROR	<DUMPER doesn't support that tape format>
	MOVEM	T2,FORMAT	;SAVE SPECIFIED NUMBER
	JRST	CMDEND

FMTINB:	<.CMNUM>B8+CM%DPP
	^D10
	BLOCK	1
	-1,,[BYTE(7)"0"+CURFMT]	;May this convention (which will break
				;at CURFMT=10) outlive DUMPER.

;HELP command - type HLP:DUMPER.HLP at him.
TYPHLP:	CONFIRM
	HRROI	T2,[ASCIZ/HLP:DUMPER.HLP/]
	MOVX	T1,GJ%SHT+GJ%OLD
	GTJFN%
	 ERJMPS	[HRROI	T2,[ASCIZ/SYS:DUMPER.HLP/]
		 MOVX	T1,GJ%SHT+GJ%OLD
		 GTJFN%
		  ERJMPS	[ERROR	<Can't find help file>,NOCMD]
		 JRST	.+1]
	HRRZM	T1,HLPJFN
	HRRZ	T2,T1
	CALL	RPSJFN
	MOVE	T1,T2
	MOVX	T2,7B5+OF%RD
	OPENF%			;OK, READY TO DUMP OUT
	 JSERRD	<>,NOCMD
HLPLP:	MOVE	T1,HLPJFN	;SUCK IN A FEW SCORE BYTES
	HRROI	T2,STRING
	HRROI	T3,-TMPLEN*5+2
	SIN%
	 ERJMPS	.+2		;EOF, I'M SURE
	TDZA	T3,T3		;NO EOF, CLEAR FLAG
	MOVX	T3,1B0		;EOF, MARK IT
	IDPB	T3,T2		;THIS INSURES ENDING NULL
CHKCO:	MOVX	T1,.PRIOU
	RFMOD%			;^O WOULD INDICATE HE'S LOST INTEREST
	TXZE	T2,TT%OSP
	 JRST	[SFMOD%		;HE GOT BORED. TURN ^O OFF AND QUIT
		 JRST	QHELP]
NOCO:	HRROI	T1,STRING	;TYPE THE BUFFER AT HIM
	PSOUT%
	JUMPE	T3,HLPLP	;DID WE RAISE EOF?
	TYPE	CRLF
QHELP:	MOVE	T1,HLPJFN	;YES, DROP JFN
	CALL	DRPJFN
	SETZM	HLPJFN		;AND FORGET WE HAD IT
	JRST	CMDEND		;DONE

;Exit routine
LEAVE:	CONFIRM
	CALL	MTCLS
	HALTF%
	JRST	CMDFIN		;FOR A CONTINUE
	SUBTTL	TAPE command and friends
;TAPE command and friends

$TAPE:	GUIDES	<DEVICE>
	DMOVE	T1,[EXP CMDBLK,MTAINB]
	CALL	PARSE
	 JSERRD	<>,NOCMD,JRST
	CONFIRM
	HRROI	T1,ATOM		;GET DEVICE NAME
	CALL	CHKMTS		;SET UP MTDEV AND DO CHKMTD
	 JRST	NOCMD		;NOT QUITE LEGAL IT SEEMS
	JRST	CMDEND

;GMOJF(I,O) makes sure a drive is open for reading (GMOJFI) or writing (GMOJFO)
; If the drive is already open in the right mode, fine.  If not, it closes
; and reopens.  Since it uses GMTJFN, it will prompt for the device at need.
GMOJFI:	SKIPA	T1,[OF%RD]
GMOJFO:	MOVX	T1,OF%WR
;Pass the OPENF% flags (OF%RD, OF%WR) in T1 here to get tape open
; in that mode.  Closes the current tape if needed, requests device if
; needed, etc.  +2 ret if OK.
GMOJFN:	MOVEM	T1,OPNREQ
GMOJFQ:	CALL	GMTJFN		;GET A JFN
	 RET			;CAN'T, SINGLE RETURN
	MOVE	T2,OPNREQ	;HOW DO WE WANT IT?
	CAMN	T2,OPNFOR	;THE WAY IT IS NOW?
	JRST	GMOJF2		;YES, FINE
	SKIPN	OPNFOR		;NO.  IS IT OPEN AT ALL NOW?
	JRST	OPNTAP		;NO - JUST GO OPEN
	HRLI	T1,(CO%NRJ) 	;YES, MUST CLOSE (BUT KEEP JFN PLEASE!)
	CLOSF%
	 JSERRD	<>,.+1		;DOES NOT HAPPEN
	JUMPE	T2,GMOJF2	;DO WE JUST WANT A JFN BUT NOT OPEN?
OPNTAP:	TLO	T2,(17B9)	;NO, SET THE I/O MODE...
	HRRZS	T1		;ISOLATE JFN
	OPENF%			;AND DO IT
	 JSERRD	<Can't open magtape>,MTCLS
	ANDX	T2,OF%RD!OF%WR	;ONLY SAVING THESE FLAGS
GMOJF2:	SKIPN	OPNFOR		;WAS IT OPEN AT ALL BEFORE?
	CALL	MTBOT		;NO, ASSUME AT BEGINNING
	MOVEM	T2,OPNFOR	;GOT IT OPEN, SAVE OPEN STATE
	JUMPE	T2,CPOPJ1
;**;[545] Replace 16 lines with 8 at GMOJF2:+4L		DEE	31-MAR-87
	MOVEI	T3,.SJDMC	;[545] Assume CORE-DUMP data mode
IFN FTIND,<
	TXNE	T2,OF%WR	;[545] Did we open for writing?
	 TXNN 	F,F.36MD	;[545] Yes, want INDUSTRY mode?
  	  SKIPA			;[545] No, neither
	MOVEI	T3,.SJDM8	;[545] OK - set INDUSTRY mode
>	
;**;[558] Add 2 lines at GMOJF2:+9L		DEE		18-NOV-88
	SKIPE	REWFLG		;[558] Rewinding?
	JRST 	OPREAD		;[558] Yes, don't (re)set data mode
	MOVE	T1,MTJFN	;GET TAPE JFN
	MOVEI	T2,.MOSDM	;FUNCTION = SET DATA MODE
	MTOPR%			;DO IT
	 ERJMPS	[WARN	<Can't set tape DATA MODE, using job default.>
		 JRST	OPREAD]
OPREAD:	MOVE	T1,MTJFN
	IFLAB	LABOPN		;NOW SEE WHAT SORT OF TAPE IS OPEN
	SKIPN	FRCSET		;IS DENSITY SET VIA A COMMAND OR PRECEDENT?
	JRST	CHKBKF		;NO, SO LEAVE IT ALONE
	MOVEI	T2,.MOSDN	;UNLABELED, SET DENSITY PER REQUEST
	MOVE	T3,DENSIT
	DOJSS	MTOPR%,<[
		WARN	<Unable to set DENSITY, job default used.>
		 JRST .+1]>
	MOVE	T1,MTJFN
	MOVEI	T2,.MOSPR	;SET PARITY PER REQUEST
	MOVE	T3,PARITY
	DOJSS	MTOPR%, CHKBKF
	JRST	CHKBKF		;DONE
LABOPN:	MOVEI	T2,.MOSDS
	MOVE	T3,OPNFOR
	TXNE	T3,OF%WR	;OPEN FOR WRITE?
	MTOPR%			;YES, SET DEFERRED VOLUME-SWITCH
	 JSERRD	<LABOPN>
CHKBKF:	MOVE	T1,MTJFN
	MOVEI	T2,.MORDN	;GET DENSITY WE SET OR HAVE
	MTOPR%
	 ERJMPS	UNKDNS		;CANT?
	SETOM	FRCSET		;INSIST ON IT NOW
	MOVEM	T3,DENSIT	;MAKE IT THE NEW DEFAULT
UNKDNS:	MOVE	T1,OPNFOR
	TXNN	T1,OF%WR	;WRITING TO TAPE?
	JRST	CPOPJ1		;NO, DONE
	MOVSI	T2,-DNKLEN	;LOOK FOR TAPE DENSITY IN THE TABLE
CHKBK2:	HRRZ	T1,DNKTAB(T2)	;..
	CAIN	T1,(T3)		;..
	JRST	SETBK1		;FOUND IT
	AOBJN	T2,CHKBK2
	JRST	CPOPJ1		;NOT IN TABLE, TAKE NO ACTION
SETBK1:	HLRZ	T1,DNKTAB(T2)	;PICK UP MAX BLOCKING FACTOR
	CAML	T1,WRIBKF	;ACCEPTABLE?
	JRST	CPOPJ1		;YES
	MOVEM	T1,WRIBKF	;NO, CHANGE IT
	MOVE	T2,T1		;SO WE CAN TYPE IT
	WARN	<Tape BLOCKING-FACTOR too high, using >
	CALL	DECOUT
	JRST	CPOPJ1		;+2 HOME
OPNERR:	CALL	MTCLS
	HRROI	T1,MTDEV
	JRST	LSTERR		;ERROR MESSAGE AND +1 HOME

;Max blocking factor for density
DNKTAB:	1,,.SJDN2
	3,,.SJDN5
	4,,.SJDN5
	^D10,,.SJD16
	^D35,,.SJD62
	 DNKLEN=.-DNKTAB	;[542] LENGTH +1 FOR PROPER AOBJN INDEXING
;**;[542] CHANGE 1 LINE AT DNKTAB:+5.L	DSW	6/11/86
;This returns a MTA JFN in T1 with a +2 ret, or +1 if the user
; interrupted and aborted.
GMTJFN:	SKIPE	T1,MTJFN
	JRST	CPOPJ1
REQMTA:	CALL	GETNAM
	 RET
	HRROI	T1,ATOM2	;GET DEVICE NAME
	CALL	CHKMTS		;DO STUFF WITH IT
	 JRST	REQMTA		;NOT LEGAL, TRY AGAIN
	MOVE	T2,LSTTMP
	MOVEM	T2,LSTFLG	;RESTORE OLD OUTPUT FLAGS FROM GETNAM/QUEST
	JRST	CPOPJ1		;OK, RETURN JFN

;GET A TAPE NAME INTO ATOM2
GETNAM:	MOVEM	P,TRAPSP
	MOVEI	T1,INTREQ
	MOVEM	T1,TRAPTO
	HRROI	T1,[ASCIZ/Tape specification needed: /]
	MOVEI	T2,STRING
	MOVEI	T3,TAPBLK	;SET UP TO DO PROMPT
	CALL	QUEST
	MOVEM	P,REQTMP
RPMTAN:	MOVE	P,REQTMP
	DMOVE	T1,[EXP TAPBLK,MTAINB]
	CALL	PARSE		;HOPEFULLY
	 ERROR	<Illegal magtape designator>,GETNAM
	MOVEI	T2,CONINB
	CALL	PARSE		;GET CONFIRM
	 ERROR	<Not confirmed>,GETNAM
	SETZM	TRAPTO
	JRST	CPOPJ1

INTREQ:	SETZM	TRAPTO
	MOVE	P,TRAPSP	;RATHER LIKE A REPARSE
	CALL	TSTINT
	 RET			;ABORTED, AS EXPECTED
	JRST	GETNAM

;Here with a byte pointer in T1 to a device name (with or without colon).
; it stores in in MTDEV and does CHKMTD.
CHKMTS:	HRROI	T2,MTDEV	;INTO MTDEV
	CALL	CSTRB
	CAIN	T3,":"		;WHAT WAS LAST CHAR?
	JRST	CHKMTD		;ITS A COLON, ALL SET
	MOVEI	T3,":"
	IDPB	T3,T2		;PUT THE COLON IN
	SETZ	T3,
	IDPB	T3,T2		;AND AN ENDING NULL
;Here with a device name in MTDEV.  Returns with T1 and
; MTJFN set up if a reasonable device was given.  They are 0 if something
; unreasonable came in.  +1 always.  If MTJFN is set up, the following will
; also be set up:  MTDSG (designator), VOILD6 (sixbit volid if available),
; VOLID (asciz volid), MTTYP (magtape type), if applicable.
CHKMTD:	CALL	MTCLS		;CLOSE ANY PREVIOUS TAPE
CHKMTF:	HRROI	T1,MTDEV
	STDEV%
	 ERJMPS	NOTACM
	MOVE	T1,T2		;PUT DESIGNATOR IN T1
	MOVEM	T1,MTDSG	;AND SAVE IT
	DVCHR%			;WHAT SORT OF DEVICE?
	LDB	T4,[POINT 9,T2,17] ;IS IT?
	CAIE	T4,.DVMTA	;ONLY LEGAL CHOICE
	 JRST	NOTMTA		;SORRY, YOU CAN'T DO THAT
	HRREM	T3,MTAUNT	;SAVE THE UNIT NUMBER
	MOVE	T4,T1		;PUT THE DESIGNATOR IN T4 FOR GETTYP BELOW
	MOVX	T1,GJ%SHT	;LET'S TRY FOR A JFN
	HRROI	T2,MTDEV	;POINT TO DEVICE NAME
	GTJFN%			;GO FOR IT...
	 ERJMPS	NOTACM		;CAN'T HAVE IT, GO COMPLAIN
	SETZM	REABKF		;SAY WE HAVEN'T READ FROM THIS TAPE YET
	MOVEM	T1,MTJFN	;GOTCHA
	TXZ	F,F.EOF+F.NORD 	;ASSUME WE CAN READ, ETC.
	CALL	GETTYP		;GET TAPE TYPE AND VOLUME INFO SET UP
	 JRST	NOMTAR		;FAILED, GO COMPLAIN
	MOVE	T1,MTJFN	;RETURN JFN
	JRST	CPOPJ1
;Error stuff for CHKMTD
NOTMTA:	ERROR	<Device is not a magtape - >,.+1
	TYPE	MTDEV
	JRST	NOMTAR
NOTACM:	ERROR	<Can't get information on device >,.+1
	HRROI	T1,MTDEV
	CALL	LSTERR		;GIVE ERROR CODE
	;JRST	NOMTAR
NOMTAR:	CALL	MTCLS		;DROP IT, IT ISN'T GOOD
	SETZ	T1,		;RETURN 0 FOR FAILURE
	RET

;Here with JFN in T1 and designator in T4.  Get tape type and volid info
; as approprate.  Ret +1 or +2.
GETTYP:	SETOM	MTTYP		;ASSUME MTA FOR NOW
	SETZM	VOLID		;ASSUME NONE
	SETZM	VOLID6
	TXNN	T4,DV%PSD	;PSEUDODEVICE (MT NOT MTA)?
	JRST	CPOPJ1		;ITS AN MTA (ASSIGNED). DONE HERE.
	CALL	GETVOL		;GET THE VOL, AND SET UP MTIAB
	MOVEI	T2,.MORLI	;FIND OUT MT LABEL TYPE
	MOVEI	T3,MTIAB	;JFN STILL IN T1, GETVOL'S ARGBLK WILL WORK
	HRRZS	MTIAB		;JUST THE COUNT, PLEASE
	MTOPR%
	 ERJMPS	ILLTTP		;INFO NOT AVAILABLE
	MOVE	T1,MTIAB+1	;FETCH LABEL INFO
	MOVEI	T2,1		;ASSUME LABELED MT
	CAIE	T1,.LTANS	;ANSIASCII?
	CAIN	T1,.LTT20	;OR TOPS20?
	JRST	CHKMT2		;YES, STORE IT
	SETZ	T2,		;NOW ASSUME UNLABELED
	CAIE	T1,.LTUNL	;TEST IT
ILLTTP:	 ERROR	<Illegal tape type - UNLABELED or TOPS20 only>,CPOPJ
CHKMT2:	MOVEM	T2,MTTYP
	JRST	CPOPJ1

;Here with the JFN in T1.  Returns VOLID and VOLID6 set up.
GETVOL:	MOVEI	T2,.MOINF	;NEED SOME MT INFO
	MOVEI	T3,MTIAB	;ARG BLOCK AT MTIAB
	HRRZS	MTIAB		;JUST THE COUNT IN MTIAB, PLEASE
	MTOPR%			;GET VOLUME NAME
	 ERJMPS	.+2		;CANT
	SKIPA	T3,MTIAB+2	;FETCH VOLUME NAME
	SETZ	T3,		;CAN'T, RETURN NOTHING
;**;[538] Add label at GETVOL:+7L	SM	31-Jan-86
DOVOLS:	MOVEM	T3,VOLID6	;[538] STORE
	CALL	C6TO7
V6TO7S:	DMOVEM	T2,VOLID	;STORE THE ASCIZ STRING
	RET

DRPTAP:	SETZM	VOLID
	SETZM	VOLID6
	SETZM	MTDSG
	;JRST	MTCLS

;Here to close the tape if it is open
MTCLS:	SKIPN	MTJFN
	RET
	CALL	WAITFN
	SETZ	T1,
	EXCH	T1,MTJFN
PAT07A:	TXO	T1,CZ%ABT
	DOJSS	CLOSF%,<[
	  RLJFN%
	  JRST	.+1
	  JRST	.+1]>
	SETZM	MTJFN
	SETZM	OPNFOR
	RET
	SUBTTL	Unload, Rewind
;UNLOAD, REWIND
$UNL:	CONFIRM
	SKIPN	MTJFN
	ERROR	<No tape device specified yet>,NOCMD
	IFMTA	.+2
	ERROR	<Use the Monitor DISMOUNT TAPE command>,NOCMD
	CALL	GMOJFI		;MAKE SURE READING
	 JRST	BAKOUT		;SORRY, CANT
	CALL	UNLMTA		;UNLOAD THE MTA (MAY NOT BE LEGAL)
	CALL	DRPTAP		;AND LOSE THE TAPE
	JRST	CMDEND		;ALL DONE

;REWIND
$REW:	DMOVE	T1,[EXP CMDBLK,RWTINB]
	CALL	PARSE		;PARSE KEYWORD
	 ERROR	<Illegal Keyword>,NOCMD
	HRRZ	T2,(T2)		;GET DISPATCH ADDRESS
	JRST (T2)		;OFF TO KEYWORD HANDLER

RWTINB:	<.CMKEY>B8+CM%DPP
	EXP	RWTB
	BLOCK	1
	-1,,[ASCIZ/CURRENT-VOLUME/]

RWTB:	 RWTBL,,RWTBL
	[ASCIZ/CURRENT-VOLUME/],,REWC
	[ASCIZ/SWITCHING/],,REWS
	 RWTBL==.-RWTB-1

TPNINB:	<.CMNUM>B8+CM%SDH+CM%DPP+CM%HPP
	^D10
	-1,,[ASCIZ/decimal sequence number of volume within set/]
	-1,,[ASCIZ/1/]

REWC:	CONFIRM
	SETOM	OKIAE		;SO CAN USE "ABORT" DURING GMTJFN
;**;[558] Add one line at REWC:+2L		DEE		18-NOV-88
	SETOM	REWFLG		;[558] Say we are rewinding
	CALL	GMOJFI		;GET JFN ON DRIVE
	 JRST	NOCMD		;COULDN'T
;**;[558] Add one line at REWC:+6L		DEE		18-NOV-88
	SETZM	REWFLG		;[558] Zero some flags
	SETZM	OKIAE
	CALL	REWCV1		;REWIND TO BEGINNING OF CURRENT VOLUME
	SETZM	LSTSEN
	JRST	CMDEND

REWS:	GUIDES	<TO VOLUME NUMBER>
	DMOVE	T1,[EXP CMDBLK,TPNINB]
	CALL	PARSE
	 ERROR	<Need a decimal number here>,NOCMD
	CONFIRM
	SKIPG	Q3,T2
	ERROR	<Tape number must be positive>,NOCMD
	SETOM	OKIAE
	CALL	GMOJFI		;GET THE JFN
	 JRST	NOCMD		 ;CAN'T
	SETZM	OKIAE
	DISPAT	RSMTA,RSUMT,RSLMT ;DISPATCH ON TAPE TYPE (MTA,MT UNL,MT LAB)
RSMTA:	ERROR	<Use TAPE command to switch MTA devices>,NOCMD
RSLMT:	CAIE	Q3,1
	ERROR	<Labeled tapes can only be switched to volume 1>,NOCMD
	MOVEI	T2,.MOREW
	CALL	MTBACK
	JRST	RSBEGI
RSUMT:	MOVE	T1,MTJFN
	MOVEI	T2,.MOVLS	;VOLUME-SWITCH FUNCTION
	MOVEI	T3,Q1		;ARG BLOCK ADDRESS
	MOVEI	Q1,3		;PUT SIZE IN ARG BLOCK
	MOVEI	Q2,.VSMNV	;MOUNT ABSOULTE VOLUME # (IN Q3)
	MTOPR%
WAITTS:	 JSERRD	<Cannot switch to specified volume>,NOCMD
	CALL	MTBOT		;REWIND TAPE, RESET COUNTERS
RSBEGI:	MOVE	T1,MTJFN	;FOR GETVOL
	CALL	GETVOL
	SETZM	LSTSEN
	JRST	CMDEND		;DONE


;REWCV rewinds the current volume
REWCV:	SKIPN	MTJFN
	JRST	MTBOT
	PUSH	P,OPNFOR	;LABELED TAPES DEMAND READ MODE
	CALL	GMOJFI		;WHEN REWINDING, SO GET IT
	 JRST	BAKOUT
	CALL	REWCV1		;DO THE REWIND
	POP	P,OPNREQ	;RESTORE OLD MODE
	CALL	GMOJFQ		;AND OPEN IT AS IT WAS
	 JRST	BAKOUT
	RET			;DONE

REWCV1:	DISPAT	REWMTA,REWMT,REWMT
REWMT:	MOVEI	T2,.MORVL	;MT, USE REWIND VOLUME
	JRST	MTBACK		;GO DO
REWMTA:	MOVEI	T2,.MOREW	;ASSIGNED TAPE REWIND
	JRST	MTBACK

;UNLOAD unloads tapes if possible.
UNLOAD:	SKIPE	MNTDSG		;DID WE GET ONE THROUGH QUASAR?
	JRST	[SETZ	T1,
		 CALL	SETMNT	;YES, LOSE IT
		 JRST	MTBOT]
	IFMT	REWCV		;MT'S AREN'T UNLOADED, SO JUST REWIND
UNLMTA:	MOVEI	T2,.MORUL	;UNLOAD
MTBACK:	SKIPE	T1,MTJFN
	MTOPR%
WINDIN:	 JSERRD	<>,.+1
	;JRST	MTBOT

;Set parameters for BOT or new tape.  Hurts no AC's that don't deserve it.
MTBOT:	SETOM	ATSAVE		;FOR RETRIEVAL
	SETOM	ATFILE
	SETZM	REABKF		;IF READING, MUST REFIGURE DENSITY, ETC
	SETZM	WRISEQ		;RESET SEQUENCE NUMBERS
	SETZM	REASEQ
	SETZM	LSTSEQ
	TXZ	F,F.EOF+F.NORD+F.FAKE+F.CIRC+F.ILAB+F.BLKF+F.EOT+F.OEOF+F.NBOT
			 	;REWOUND TAPE, ALL OK
	RET			;RETURN FROM MTBOT

$EOT:	CONFIRM
	SETOM	OKIAE		;INTERRUPTABLE!
	CALL	GMOJFI		;GET DRIVE FOR READING AT LEAST
	 JRST	NOCMD		;ODD
	CALL	FNDENA		;GET TO THE END
	TYPE	[ASCIZ/ End of Tape./]
	JRST	CMDEND

;Find the TAPEEN record
FNDEND:	CALL	GMOJFI
	 JRST	BAKOUT
FNDENA:	TXO	F,F.NVOL!F.NSEQ	;DON'T VOLSWITCH PLEASE!
FNDEN2:	CALL	GETREC
	CAIN	T3,TAPEEN
	JRST	FNDEN3		;DONE
	CAIN	T3,SAVEST
	CALL	TYPHDR
	CAIE	T3,TONEXT	;ONLY PASSED BACK IF F.NVOL LIT
	JRST	FNDEN2
	CALL	UNLOAD
	ERROR	<This tape is FULL, please mark it>
FNDEN3:	TXZ	F,F.NVOL!F.NSEQ
	RET
	SUBTTL	SAVE command

;Quick SAVE-like commands (ARCHIVE, MIGRATE, COLLECT)
COLLEC:	MOVX	T1,D.COL
	JRST	DMPCOM
ARCHIV:	MOVX	T1,D.ARC
	JRST	DMPCOM
MIGRAT:	MOVX	T1,D.MIG
DMPCOM:	TXNN	F,F.PRIV
	JRST	OPRERR
	MOVEM	T1,DMPFLG
	CALL	SETSTP
	JRST	DMPENT

;SAVE dispatches here
DUMP:	SETZM	SAVETP		;ASSUME NORMAL SAVE
	SETZM	DMPFLG		;CLEAR FLAGS (ARCHIVAL,COLLECT,INCREMENTAL)
DMPENT:	GUIDES	<DISK FILES>
	SETZM	UNLFLG		;DON'T ASSUME UNLOAD
	MOVSI	Q1,-MAXJFN	;NUMBER OF JFNS ALLOWED
	CALL	GETCON		;GET DEFAULTS
	SKIPN	DMPFLG		;IF ALREADY FLAGGED, JUST GO FOR FILE
	SKIPA	Q2,[DMPINB]	;EITHER A SWITCH OR A FILESPEC
DUMPAG:	MOVEI	Q2,DM2INB	;HERE AFTER COMMA PARSE OR 1ST FILE (NO SWITCHS)
	MOVE	T1,CONSTR
	TXNE	F,F.PRIV	;PRIVS DECIDE OUR DEFAULTS
	SKIPA	T2,[POINT 7,[ASCIZ/*/]] ;WILD DIRECTORY
	MOVE	T2,CONDIR	;UNPRIVED, GET DEFAULT SET UP BY GETCON
DMPSWF:	MOVX	T3,GJ%OLD+GJ%IFG+GJ%XTN ;WILD, EXTRA FLAGS
	CALL	SETWLD		;SET UP FOR WILD FILE SPEC
	SKIPA	T2,Q2		;CONTAINS EITHER (FILE,SWITCH) OR (FILE)
DUMPPF:	MOVEI	T2,DM2INB	;BACK FROM SWITCH, JUST DO FILE NOW
	MOVEI	T1,CMDBLK
	SETZ	Q2,		;ASSUME YES FILENAME/NO ERROR
	CALL	PARSE
	 JRST	DFLERR		;ERROR MUST BE EXAMINED
	CAIE	T3,.CMSWI	;FILENAME OR SWITCH?
	JRST	FLJFNS		;FILE, DO JFNS STUFF
	HRRZ	T2,(T2)		;SWITCH. GO PROCESS AND RETURN TO DUMPPF
	JRST	(T2)

;List of "FILE NOT FOUND" error codes - 0 means end
OKGJXL:	BYTE (18)GJFX16,GJFX17,GJFX18,GJFX19,GJFX20,GJFX24
	BYTE (18)GJFX32,GJFX35,GJFX36,GJFX38,0

DFLERR:	MOVE	T3,[POINT 18,OKGJXL] ;LIST OF "OK" GTJFN ERRORS
DFLERS:	ILDB	T1,T3		;WE SCAN THEM
	CAIN	T1,0		;END OF LIST? IF 0, ILLEGAL ERROR, DIE
	JSERRD	<Not a Switch or File Specification>,NOCMD,JRST
	CAIE	T1,(T2)		;CHECK LEGALITY
	JRST	DFLERS		;NO, TRY AGAIN
	MOVE	Q2,T2		;SAVE ERROR FOR LATER (OTHERWISE 0)
	MOVX	T1,GJ%OFG	;SET UP TO PARSE-ONLY THE NOT-FOUND FILESPEC
	HLLM	T1,GTJBLK+.GJGEN; ..
	DMOVE	T1,[EXP CMDBLK,DM2INB]
	CALL	PARSE		;REPARSE THE BAD ATOM
	 JSERRD	<>
FLJFNS:	CALL	RPSJFN		;SAVE THE JFN FOR A REPARSE
	CALL	CHKDSK		;GET INFO ON JFN (AND PUT JFN IN T1)
MBDERR:	 ERROR	<Device must be DISK>,NOCMD
	MOVEM	T1,JFNLST(Q1)	;SAVE INPUT JFN
	TLNN	T3,(1B2)	;DID CHKDSK SAY "NO SUCH DEVICE?"
	JRST	SAVCPF		;NO, FINE
	WARN	<No mounted disk named >
	MOVE	T2,T1		;YES, TELL WHAT IS WRONG, AND GIVE JFN
	MOVX	T3,1B2+JS%PAF	;JUST TYPE DEVICE NAME AND COLON
	CALL	TYJFNF
	TYPE	[ASCIZ/, no files will be saved from it.
/]				;THE SAD TRUTH
SAVCPF:	MOVEM	Q2,JF2LST(Q1)	;SAVE 0 OR ERROR CODE
;MAKE UP "AS" JFN
	MOVX	T2,GJ%OFG
	HLLM	T2,GTJBLK+.GJGEN;PARSE ONLY
	CALL	OFNAME		;MAKE UP OUTPUT NAME DEFAULTS
	SETOM	DMPTMP		;SAY "NO CONFIRM YET"
	SKIPE	DMPFLG		;COLLECTION/MIGRATION/INCREMENTAL/ARCHIVAL?
	JRST	DUSEDF		;YES, ERROR CHECK, AND NO (AS) FILE
DMPOJN:	GUIDES	<AS>
	DMOVE	T1,[EXP CMDBLK,CCFINB]
	CALL	PARSE
	 JSERRD	<Illegal "AS" file specification>,NOCMD,JRST
	MOVEM	T3,DMPTMP
	CAIE	T3,.CMFIL	;DID I PARSE A FILESPEC?
	JRST	USDEFA		;NO, ASSUME DEFAULTS
 IFN FTEXAC,<
	SKIPN	EXACT		;EXACT MODE?
	JRST	DMPJF2		;NOT EXACT MODE, TAKE AS IS
	HRRZ	T1,T2		;DROP THE COMND% JFN
	RLJFN%			;..
	 ERJMPS	.+1
	MOVE	T1,GTJBLK+.GJGEN
	HRRM	T1,EXABLK+.GJGEN
	DMOVE	T1,GTJBLK+.GJDEV	;GIVE GTJFN THE SAME DEFAULTS
	DMOVEM	T1,EXABLK+.GJDEV
	DMOVE	T1,GTJBLK+.GJNAM
	DMOVEM	T1,EXABLK+.GJNAM
	MOVEI	T1,EXABLK	;DO AGAIN, WITH G1%SLN LIT, SO
	HRROI	T2,ATOM		;WE CAN FORCE NON-EXPANSION OF
	GTJFN%			;LOGICAL NAMES
	 JSERRD	<Can't re-GTJFN file for EXACT mode> ;WHY?
	MOVE	T2,T1
 > ;END IFN FTEXAC
	JRST	DMPJF2		;YES, GO USE
;Here to do things with the Archival/Incremental jfns.  They have very
; different rules.
DUSEDF:	MOVE	Q3,JFNLST(Q1)	;FETCH THE FLAGS
	MOVE	P4,[ASCIZ/*/]	;ONLY LEGAL STRING FOR A WILD FIELD
	MOVSI	T4,-4
WLDCHK:	TDNN	Q3,[EXP GJ%DIR, GJ%NAM, GJ%EXT, GJ%VER](T4)
	JRST	WLDCHE
	CAME	P4,@[EXP DEFDIR, DEFNAM, DEFEXT, DEFGEN](T4)
	ERROR	<Illegal use of wildcard in special SAVE>
WLDCHE:	AOBJN	T4,WLDCHK
USDEFA:	CALL	GDEFFL		;ASSUME THE DEFAULTS
	 JSERRD	<>,NOCMD,JRST	;CANT??!?
DMPJF2:	SKIPE	JF2LST(Q1)	;DID WE GET AN ERROR FOR AN INPUT FILE?
	JRST	[CALL DRPJF2	 ;YES, TOSS THE JFN
		 JRST DMPJFQ]	;AND GO ON
	CALL	RPSJFN		;DISCARD IF WE REPARSE
	MOVEM	T2,JF2LST(Q1)	;NO, SO KEEP THE OUTPUT FILE
DMPJFQ:	AOBJN	Q1,.+2
	ERROR	<JFN list overflow>,NOCMD
	MOVE	T3,DMPTMP	;GET LAST PARSE RESULT
NOASGV:	CAIN	T3,.CMCFM	;DID HE CONFIRM?
	JRST	DUMPGO		;YES, ALL DONE
	MOVE	T1,DMPFLG
	TXNE	T1,D.COL+D.ARC+D.MIG	;ARCHIVE/COLLECTION/MIGRATION?
	JRST	[CALL CONFRM
		  ERROR	<Only one file specification allowed>,NOCMD
		 JRST	DUMPGO]
	CAIN	T3,.CMCMA
	JRST	DUMPAG
	DMOVE	T1,[EXP CMDBLK,CCINB]
	CALL	PARSE
	 ERROR	<Comma or Carriage Return required>,NOCMD
	CAIE	T3,.CMCFM
	JRST	DUMPAG		;IT WAS COMMA.  GO GET ANOTHER PAIR.

;Here when the parsing's done
DUMPGO:	MOVX	T1,.FHSLF	;LET'S TRACK OUR CPU-TIME
	RUNTM%
	MOVEM	T1,DMPTIM	;WHEN WE STARTED
	MOVNS	Q1		;RH HAS FILE COUNT
	HRLZ	P5,Q1		;MAKE INTO AOBJN COUNT
	MOVEM	P5,NFJFN	;STORE
PAT05A:	AOSG	DATSET		;1ST SAVE SINCE SET SINCE/BEFORE STUFF?
	JRST	NODWRN		;FINE, DON'T BOTHER TO REMIND HIM
	SETO	T1,		;SEE IF STILL SET, IF SO, REMIND HIM
	AND	T1,ABTAD	;SEE IF ANY DATE COMMANDS ARE IN EFFECT..
	AND	T1,MBTAD	;+INFINITY MEANS NO DATE SET FOR ?BTAD DATES
	AND	T1,WBTAD
	TDC	T1,[377777,,-1]	;IF RESULT IS NONZERO, A DATE IS SET
	IOR	T1,ASTAD	;0 MEANS NO DATE SET, FOR ?STAD DATES
	IOR	T1,MSTAD
	IOR	T1,WSTAD
	CAIE	T1,0
	TYPE	[ASCIZ ~[Before and Since commands are still in effect]
~]
NODWRN:	HRROI	T1,SSNTXT
	SETZM	SSNBUF+SV.PNT
	SETZM	SSNBUF+SV.MSG	;CLEAR THIS BEFORE COPYING IN
	HRROI	T2,SSNBUF+SV.MSG
	CALL	CSTR		;STORE SAVESET NAME SET BY USER
	TXNE	F,F.CREA	;CREATE TYPED? (DO DIRECTORIES?)
	TXO	F,F.DDIR	;YES, DO DIRECTORIES
	TXZE	F,F.NDIR	;UNLESS ASKED NOT TO EXPLICITLY (/NOINC)
	TXZ	F,F.DDIR	;IN WHICH CASE, OFF THE FLAG
;From here down, F.DDIR is the general case, and F.NDIR is lit/cleared for
; each jfn.  F.NDIR decides if it is really meaningful to write full dir info
; to tape, or whether just the name will do.  This is used to prevent something
; like "SAVE DSK:<*>*.* (AS) DSK:<FOO>*.*" from saving meaningless
; directory info.
	SETZM	LSTSEN		;TELL ^A NO LAST FILE SEEN
	SETOM	OKIAE		;OK FOR THIS NOW!
	SETZM	TOTFIL		;COUNT FILES AND PAGES SAVED
	SETZM	TOTCNT		;..
	SETZM	DIRDMD
	SETZM	ARCCNT		;DIDN'T ARCHIVE ANY FILES YET
	SETZM	SAVENO		;ASSUME NOT SPECIAL
	SETZM	INFILE		;NOT BETWEEN FILEST & FILEEN
;POSITION TO PROPER PLACE.  ODD FOR ARCH TAPES, ETC
	MOVE	T1,DMPFLG
	TXNN	T1,D.ARC+D.COL+D.MIG
	JRST	NOTARC		;NOT ARCHIVAL/MIGRATION/COLLECT
ARCHVA:	CALL	GMOJFI		;FORCE READ MODE
	 JRST	BAKOUT
	CALL	REWCV1		;REWIND THE TAPE
	HRROI	T1,[ASCIZ/Is this a new tape? /]
	CALL	YESNO		;ASK THE USER
	JUMPE	T2,OLDTAP	;HE SAID NO
	HRROI	T1,[ASCIZ/Are you sure? /]
	CALL	YESNO
	JUMPN	T2,ARCBEG
	 ERROR	<Aborting>
OLDTAP:	TYPE	[ASCIZ/ Looking for last saveset
/]
	CALL	FNDEND		;FIND THE END OF THE TAPE
ARCNST:	AOS	T1,ARCTSN	;BUMP THE LAST SEEN ARCHIVE SAVESET #
	TRNN	T1,400000	;HAS IT GOTTEN ABSURDLY LARGE? SET TO 1 THEN
	JRST	ARCSET		;IT'S FINE
ARCBEG:	MOVEI	T1,1
	MOVEM	T1,ARCTSN	;TRACK FOR OUR OWN PURPOSES
ARCSET:	MOVEM	T1,SAVENO	;PUT WHERE IT WILL GO INTO THE HEADER
NOTARC:	GTAD%
	MOVEM	T1,BGNTAD	;WHEN WE STARTED THE SAVE
	MOVEM	T1,SSNBUF+SV.TAD ;SOME ROUTINES LOOK HERE
	CALL	IFCRL2
	CALL	GMOJFO		;WRITE MODE
	 JRST	BAKOUT
	CALL	PROVOL		;MAKE SURE WE HAVE A VOLID IF NEEDED
	CALL	LINE1A		;SET UP NICE HEADER TO USER
	TYPE	STRING		;SET BY LINE1A
	TYPE	CRLF		;FINISH THE LINE
	TXZ	F,F.GOT1	;DIDN'T GET A FILE YET
	CALL	SETLST		;SET UP THE LIST FILE IF WANTED
	 SETZM	LSTFIL		;FAILED, GIVE UP THE LIST FILE
	MOVE	P5,NFJFN	;GET AOBJN COUNT FOR JFNS
;LOOP OVER JFNS, MENTIONING ONES THAT DIDN'T MAKE IT
JFNLOP:	SETOM	CURREN		;NO PAGE NUMBER FOR ^A YET
	MOVE	T2,JF2LST(P5)
	TRNN	T2,1B18		;ERROR CODE (6xxxxx) OR JFN?
	JRST	REALFL		;REAL FILE
	WARN	<>		;MENTION NO FILE AND GO ON
	HRLI	T2,.FHSLF
	CALL	LSTERC		;TYPE LAST ERROR
	TYPE	[ASCIZ/ - /]
	MOVE	T2,JFNLST(P5)
	CALL	TYJFNS
	TYPE	CRLF
	JRST	JFNLPE
REALFL:	SETZM	LSTDIR		;NO LAST DIRECTORY SEEN YET
	MOVEI	T1,.WLJFN	;SEE IF <IN> IS WITHIN <OUT>
	MOVE	T2,JF2LST(P5)
	HRRZ	T3,JFNLST(P5)
	MOVEM	T3,JFN
	WILD%			;IF IT IS, REAL DIR INFO IS MEANINGFUL
	TXNN	T1,WL%DIR!WL%DEV ;DISK/DIRECTORY THE SAME?
	JRST	NODIRI		;YES, WE WILL SAVE
	TXNN	F,F.DDIR	;DO WE INTEND TO WRITE DIR RECORDS?
	JRST	NODIRQ		;NO - NO REASON TO WARN
	WARN	<Directory specifications differ - not saving directory info on:
 >
	CALL	GDIRNA
	TYPE	INDIR
NODIRQ:	TXOA	F,F.NDIR	;SAY "<IN> NOT WITHIN <OUT>"
NODIRI:	TXZ	F,F.NDIR	;<IN> IS WITHIN <OUT>
NODIRS:	MOVE	T1,JFNLST(P5)	;FETCH IN JFN
;Here to loop over a wild jfn, T1 has the jfn.
	SKIPN	T2,INIJFN	;IS THERE AN INITIAL JFN ACTIVE?
	JRST	OKTSFL		;NO, TAKE WHAT WE GET
	SETOM	INIFLG		;TELL ^A WE ARE SCANNING OVER THINGS
SCNINI:	HRRZ	T3,T1		;YES, DO THE TEST FOR INITIAL SPEC
	MOVEI	T1,.WLJFN
	WILD%
	JUMPE	T1,FININI	;MATCHED
	MOVE	T1,JFNLST(P5)	;GET JFN TO STEP
	GNJFN%			;STEP ON TO NEXT VICTIM
	 ERJMPR	ENDU		;END OF THE WILD JFN, SET UP FOR NEXT
	JRST	SCNINI
FININI:	HRRZ	T1,T2		;OK, TIME TO DROP AND CLEAR INIJFN
	CALL	DRPUFN
	SETZM	INIJFN		;AND TIME TO TAKE FILES
	SETZM	INIFLG		;TELL ^A WE ARE DONE SCANNING
	CALL	IFCRL2
	TYPE	<[ASCIZ/[Starting from /]>
	MOVE	T2,T3
	CALL	TYJFNS
	TYPE	CBCR
OKTSFL:	TXNN	F,F.DDIR	;DO WE WANT DIRECTORY INFO?
	JRST	DIRELP		;NO, SKIP SCAN DIRECTORY CODE
	;..
;Scan to find directories and dump them to tape
	;..
	MOVE	T2,JFNLST(P5)	;PICK UP JFN
	MOVX	T3,1B2+1B5+JS%PAF;WANT STR:<DIR>
	HRROI	T1,OUTSPC	;HERE FOR THE MOMENT
	JFNS%
	MOVX	T1,RC%AWL+RC%EMO;GET DIR NUMBER OF FIRST DIR SEEN
	HRROI	T2,OUTSPC
	RCDIR%			;..
	 JSERRD	<RCDIR>		;CODING ERROR, HERE OR MONITOR
	TXNE	T1,RC%NOM	;NO MATCH IS AN ERROR
	JRST	DIRELP		;NO DIRECTORIES QUALIFY!
DIRLOP:	MOVEM	T3,DMPNUM	;HERE WITH DIR # (IN T3) TO BE DONE
	SETZM	DIRBUF
	MOVE	T2,[XWD DIRBUF,DIRBUF+1]
	BLT	T2,DIRBUF+777
	TXNN	F,F.NDIR	;NOT WHEEL OR USER DATA NOT WANTED?
	TXNN	F,F.PRIV
	JRST	DMPUS1		;YES, DON'T DUMPER DIR INFO
	AOS	DIRDMD		;OK, WRITING ANOTHER DIRECTORY
	MOVEI	T1,DIRBUF+CDSG	;SET UP DIRBUF TO RECEIVE SUB GROUPS
	MOVEM	T1,DIRBUF+.CDCUG
	MOVEI	T1,DIRBUF+CDUG	;SET UP DIRBUF TO RECEIVE USER GROUPS
	MOVEM	T1,DIRBUF+.CDUGP
	MOVEI	T1,DIRBUF+CDDG	;SET UP BUFFER TO RECEIVE DIR GROUPS
	MOVEM	T1,DIRBUF+.CDDGP
	MOVEI	T1,UGLEN	;LENGTH OF BUFFERS FOR GROUPS
	MOVEM	T1,DIRBUF+CDUG
	MOVEM	T1,DIRBUF+CDDG
	MOVEM	T1,DIRBUF+CDSG
	HRROI	T1,DIRBUF+UHACT	;POINT TO ACCOUNT STRING SPACE
	MOVEM	T1,DIRBUF+.CDDAC
	MOVEI	T1,CD.LEN	;CURRENT MAX SIZE
	MOVEM	T1,DIRBUF+.CDLEN
	MOVE	T1,DMPNUM
	MOVEI	T2,DIRBUF
	MOVE	T3,[POINT 7,DIRBUF+UHPSW]
	GTDIR%
	 JSERRD	<Can't get directory info>
	MOVE	T2,[-DIRBUF]	;REDUCE POINTERS TO OFFSETS
	ADDM	T2,DIRBUF+.CDUGP;FOR USER GROUP INFORMATION BLOCKS
	ADDM	T2,DIRBUF+.CDDGP;SO WE CAN JUST ADD OFFSET IN LATER
	ADDM	T2,DIRBUF+.CDCUG;..
	MOVEI	T2,UHPSW	;SET PASSWORD OFFSET
	MOVEM	T2,DIRBUF+.CDPSW
	MOVEI	T2,UHACT	;SET POINTER TO ACCOUNT STRING
	MOVEM	T2,DIRBUF+.CDDAC
DMPUS1:	TXON	F,F.GOT1	;FIRST TAPE WRITE TIME?
	CALL	[CALL	INIREC	;YES, SET UP FOR IT
		 JRST	BGNHEA]
	HRROI	T1,DIRBUF+UHNAM	;POINT TO NAME BUFFER
	MOVE	T2,DMPNUM
	DIRST%
	 ERJMPS	.+1
	HRROI	T1,-DIRECT
	MOVEM	T1,TAPHEA+.TYP
	MOVEI	T1,TAPHEA
	MOVEI	T2,DIRBUF
	CALL	ADDREC
ADVDIR:	MOVE	T3,DMPNUM
	HRROI	T2,OUTSPC
	MOVX	T1,RC%STP+RC%AWL+RC%EMO
	RCDIR%
	TXNN	T1,RC%NMD	;ALL DONE?
	JRST	DIRLOP		;NO, GO DO NEXT
DIRELP:	MOVE	T1,JFNLST(P5)
	TXO	T1,GN%DIR!GN%NAM!GN%EXT	;SAY "ALL THINGS CHANGED" (1ST TIME)
	MOVEM	T1,SCNJFN
	SETZM	OUTDRS		;DON'T HAVE OUTDIR YET
	;..
;Here to start actually dumping files
	;..
FILLOP:	MOVE	T1,SCNJFN
	TXNN	T1,GN%DIR!GN%STR ;DID THE INPUT DIR CHANGE?
	JRST	NODIRC		;NO, SO OUTPUT CAN'T CHANGE!
	SETOM	DDOFLG		;TELL DMPFIL WE HAVE A NEW <INPUT>
	SETZM	DMPNUM		;DON'T KNOW THE DIR INPUT NUMBER YET
	SETZM	INDIR
	MOVE	T2,DMPFLG	;GET DUMPING FLAGS
	TXNN	T2,D.COL	;COLLECTION?
	JRST	TSTDIC
;If doing collection, we must see if "archive-expired-files" is desired for this
; directory.  Discovering that is tedious.
	CALL	GDIRNM		;SET UP INDIR AND DMPNUM (DIR# INTO T1)
	MOVEI	T2,.CDMOD+1
	MOVEM	T2,DIRINF+.CDLEN ;HOW MUCH WE NEED
	MOVEI	T2,DIRINF
	SETZ	T3,		;NO PASSWORD (WE ARE WHEEL)
	GTDIR%
	 ERJMPS	TSTDIC
	MOVE	T4,DIRINF+.CDMOD ;DECIDE IF ARCH'ING-ONLINE-EXPIRED FILES
	MOVX	T3,D.AOEF	;AND TURN THIS ON OR OFF
	ANDCAM	T3,DMPFLG
	TXNE	T4,CD%DAR
	IORM	T3,DMPFLG
;Here we isolate the output directory string if it has changed
TSTDIC:	MOVE	Q1,JF2LST(P5)	;SEE IF OUTPUT DSK:<DIR> CAN EVER CHANGE
	TXNE	Q1,GJ%DEV!GJ%DIR ;??
	JRST	MAYCHN		;YES, GO FIGURE
	SKIPE	LSTDIR		;IT CANT, DO WE HAVE IT ALREADY?
	JRST	NODIRC		;YES, SO DON'T BOTHER
MAYCHN:	CALL	GOFDRS		;NO, MUST FIGURE FOR TEST AND DMPFIL
	SKIPN	LSTJFN		;ARE WE DOING A LIST FILE?
	JRST	NODIRC		;NO, SO SKIP THE LISTFILE CONTORTIONS
	TXNN	Q1,GJ%DEV!GJ%DIR ;CAN OUTPUT DSK:<DIR> CHANGE?
	JRST	[AOS	LSTDIR	;NO, MAKE LSTDIR NONZERO
		 JRST	GDDIRC]	;AND GO ON (NEEDN'T COMPARE/COPY TO LSTDIR)
	HRROI	T1,OUTDIR	;COMPARE NEW DSK:<DIR> TO OLD ONE
	HRROI	T2,LSTDIR
	CALL	STCMPC		;..
	JUMPE	T3,NODIRC	;SAME, DON'T DO ANYTHING
	PUSH	P,LSTDIR	;DIFFERENT, SAVE THIS
	CALL	STCOPY		;MAKE THEM THE SAME
	POP	P,T1		;WAS THERE ANYTHING THERE?
	TLNE	T1,-1		;IF NOT, NO ENDUSR TO DO
	CALL	ENDUSR		;CLOSE OFF THE LAST DIRECTORY
GDDIRC:	CALL	BEGUSR		;BEGINNING OF DIRECTORY STUFF
NODIRC:	CALL	DMPFIL		;CHECK FILE FOR DUMPING, AND DUMP IF OK
	SETOM	CURREN		;FOR ^A - FILE NOT YET GOING
	MOVE	T1,JFNLST(P5)	;GET JFN TO STEP
	GNJFN%			;STEP ON TO NEXT VICTIM
	 ERJMPR	ENDU		;END OF THE WILD JFN, SET UP FOR NEXT
	MOVEM	T1,SCNJFN	;SAVE FLAGS SO WE KNOW IF A DIR CHANGED
	JRST	FILLOP		;ADVANCED, GO DO NEXT FILE

;Come to ENDU with the GNJFN error code in T1.  If it isn't GNJFX1 (No more
; files), the user needs to be told and we need to abort.
ENDU:	CAIE	T1,GNJFX1	;NO MORE FILES?
	JSERRD	<Can't step to next file>,BAKOUT,JRST
	SKIPE	LSTFIL		;DOING A LIST FILE?
	CALL	ENDUSR		;YES, FINISH LAST DIRECTORY
	TXNE	F,F.FILT+F.DIRT	;FILE OR DIRECTORY MODE?
	TXNN	F,F.GOT1	;YES, GET ANYTHING YET?
	JRST	JFNLPE		;NOT BOTH TRUE
	CALL	SAVTXT		;YES, WE WANT A <CRLF> AFTER EACH JFN
	MOVEI	T1,TR.FDT
	IDPB	T1,T2		;SAY EITHER FILE OR DIRECTORY
	HRROI	T1,CRLF
	CALL	CSTR
	MOVEM	T2,TREBUF(Q1)	;STORE END POINTER
	;MOVEI	T3,TR.END
	IDPB	T3,T2		;STORE END BYTE IN CASE WE DONT OVERWRITE
JFNLPE:	AOBJN	P5,JFNLOP	;ADVANCE TO NEXT JFN
;Done with all jfns.  Clean up and stop.
	SETZM	OKIAE		;INTERRUPTS NOT WELCOME
	SETZM	JFN		;GET RID OF THIS
	TXNN	F,F.GOT1	;DID WE GET ANYTHING?
	JRST	[WARN	<No files dumped>
		 JRST	DRPDMP]	;NO, GO CLEAN UP
	CALL	FINTAP		;YES, FINISH UP THE TAPE
	SKIPN	UNLFLG
	JRST	NUNLED
	IFMT	.+2
	CALL	UNLOAD
	CALL	MTCLS
NUNLED:	SKIPN	ARCCNT		;ANY ARCHIVAL PASS2 NEEDED?
	SKIPA	T4,DMPFLG	;NO, HOW ABOUT INCREMENTAL PASS2?
	TDZA	T4,T4		;NEED ARCHIVAL PASS2 - 0 FLAGS THIS
	TXNE	T4,D.FINC!D.INC	;TEST FOR INCREMENTAL, SKIP IF UNNEEDED
	SKIPA	T1,LSTJFN	;NEED A PASS2, SKIP TO CHECKPOINT LIST FILE
	JRST	NPASS2		;NO PASS2 OF ANY KIND NEEDED
	MOVEM	T4,TMP		;SAVE THE VALUE INDICATING KIND OF PASS2
	JUMPE	T1,NCHKLF	;IF NO LIST FILE, NO CHECKPOINT NEEDED
	TXO	T1,CO%NRJ	;CHECKPOINT, DON'T RELEASE
	CLOSF%
	 ERJMPS	.+1
	MOVE	T1,LSTJFN	;OK, REOPEN FOR FINAL STATS
	CALL	OPNLST		;..
	 JFCL			;LIST FILE DIDN'T REOPEN
NCHKLF:	SKIPN	TMP		;0 FOR ARCHIVAL, NONZERO FOR INCREMENTAL
	CALL	PASS2A		;DO ARCHIVAL.  THIS ALWAYS GIVES +2
	CALL	PASS2I		;DO INCREMENTAL
NPASS2:	SELECT	LS.TTY+LS.LST	;LS.LST IGNORED IF LSTJFN IS 0, SO THIS WORKS
	TYPE	[ASCIZ/

 Total files dumped: /]
	MOVE	T2,TOTFIL
	MOVE	T3,[NO%LFL+NO%OOV+^D10(6)]
	CALL	NUMOUT
	TYPE	[ASCIZ/
 Total pages dumped: /]
	MOVE	T2,TOTCNT
	CALL	NUMOUT
	SKIPN	T2,DIRDMD
	JRST	DRPDMP
	TYPE	[ASCIZ/
 Directories dumped: /]
	CALL	NUMOUT
	TYPE	CRLF
DRPDMP:	SELECT	LS.TTY
	CALL	ENDLIS
	CALL	DMPJFS
	MOVX	T1,.FHSLF
	RUNTM%
	SUB	T1,DMPTIM
	FLTR	T2,T1
	FDVR	T2,[1000.0]
	TYPE	[ASCIZ/
 CPU time, seconds: /]
	CALL	FLTOUT
	JRST	CMDEND

;Here to drop the jfns we had open
DMPJFS:	SKIPN	P5,NFJFN
	RET
DRPJFL:	SKIPE	T1,JFNLST(P5)
	CALL	DRPJFA		;TOSS THE JFN
	SETZM	JFNLST(P5)
	SKIPE	T1,JF2LST(P5)
	TRNE	T1,1B18		;ERROR CODE, NOT JFN?
	JRST	DRPJFE
	CALL	DRPJFA		;TOSS THE JFN
DRPJFE:	SETZM	JF2LST(P5)
	AOBJN	P5,DRPJFL
DRPJFF:	SETZM	NFJFN
	RET
BEGUSR:	SETZM	USRCNT
	SETZM	NOFILS
	SELECT	LS.LST		;OUTPUT TO LIST FILE ONLY
	TYPE	CRLF2
	TYPE	OUTDIR
	TYPE	CRLF2
	SELECT	LS.TTY
	RET

ENDUSR:	SELECT	LS.LST		;OUT TO LIST FILE ONLY
	TYPE	CRLF
	MOVEI	T2,FLCOL	;OUT TO THE FILE COLUMN
	CALL	TABOUT
	SKIPN	T2,NOFILS
	JRST	[TYPE	[ASCIZ/No files/]
		 JRST	EENDUS]
	CALL	DECOUT
	TYPE	[ASCIZ/ file/]
	CAIE	T2,1
	TYPCHR	"s"
	TYPE	[ASCIZ/, /]
	MOVE	T2,USRCNT
	CALL	DECOUT
	TYPE	[ASCIZ/ page/]
	CAIE	T2,1
	TYPCHR	"s"
EENDUS:	TYPE	CRLF
	SELECT	LS.TTY
	RET
;Here to see if the current file is a candidate for dumping and DUMP IT TO TAPE.
DMPFIL:	MOVE	T1,JFN
	MOVSI	T2,.FBLEN
	MOVEI	T3,FDB		;GET FILE FDB
	GTFDB%
	 JSERRD	<>,.+1
	MOVE	T2,FDB+.FBCTL	;GET FILE FLAGS
	SKIPN	T3,DMPFLG	;GET DUMP FLAGS. IF NONE, NORMAL SAVE...
	JRST	NODPOB		;SO OBEY FB%NOD
	TXNN	T3,D.INC+D.FINC	;FULL OR INCREMENTAL?
	TXZ	T2,FB%NOD	;NO, ARCHIVE-TYPE SAVE, IGNORE NODUMP
NODPOB:	TXNE	T2,FB%DIR!FB%NXF!FB%NEX!FB%DEL!FB%TMP!FB%NOD;REASONS NOT TO SAVE
	JRST	SKIPDP		;REJECTED
	MOVE	T1,FDB+.FBCRE	;FETCH MODIFICATION DATE
	CAMG	T1,MBTAD	;NOT 'BEFORE'?
	CAMGE	T1,MSTAD	;NOT 'SINCE'?
	JRST	SKIPDP		;REJECT
	MOVE	T1,FDB+.FBWRT	;GET WRITE DATE
	CAMG	T1,WBTAD	;BEFORE
	CAMGE	T1,WSTAD	;SINCE
	JRST	SKIPDP		;REJECT
	CAMGE	T1,FDB+.FBREF
	MOVE	T1,FDB+.FBREF	;GET LATEST OF (READ, WRITE)
	CAMG	T1,ABTAD	;BEFORE
	CAMGE	T1,ASTAD	;SINCE
	JRST	SKIPDP		;REJECT
	MOVE	T1,DMPFLG
	TXNN	T1,D.FINC	;FULL INCREMENTAL? SKIP THIS CHECK
	TXNN	T1,D.INC	;NORMAL INCREMENTAL ONLY DOES NEXT BIT
	JRST	INCROK
	HLRE	T3,FDB+.FBBK0	;GET TAPE COUNT AND FLAG
	JUMPL	T3,INCROK	;IF INCOMPLETELY DUMPED, MUST SAVE
	HLRZ	T2,FDB+.FBCNT	;GET # OF WRITES TO THIS FILE
	HRRZ	T4,FDB+.FBBK0	;GET WRITE COUNT AT LAST SAVE
	CAIN	T2,(T4)		;SAME WRITE COUNT AS LAST SAVE?
	CAIGE	T3,(T1)		;YES, SAVED ENOUGH TIMES?
	JRST	INCROK		;TEST FAILS, MUST SAVE FILE
	JRST	SKIPDP
INCROK:	SETZM	ARCGST		;SAY NO ARCF INFO YET
	TXNN	T1,D.COL!D.MIG!D.ARC ;ARCH/MIG/COLLECTION RUN?
	JRST	DUMPME		;NO, NO MORE TESTS, GO DUMP
	CALL	ARCTST		;TEST FOR ARCHIVING CRIETRIA
	 JRST	SKIPDP
;We have decided to dump the file.
;Get final bits of info and write file to tape
DUMPME:	MOVE	Q1,FDB+.FBHDR	;GET LENGTH
	ANDI	Q1,777		;JUST THE LENGTH, PLEASE
	HRROI	T2,FDB(Q1)	;POINTER FOR GFUST STRING
	MOVE	T1,JFN
	HRLI	T1,.GFAUT	;GET AUTHOR
	GFUST%
	 ERJMPS	[SETZM	(T2)
		 MOVE	T1,JFN
		 JRST	.+1]
	ADDI	Q1,10		;ADVANCE FOR LAST WRITER
	HRLI	T1,.GFLWR
	HRROI	T2,FDB(Q1)
	GFUST%
	 ERJMPS	[SETZM	(T2)
		 JRST	.+1]
	MOVE	T1,JFN
	MOVX	T2,.ARGST
	ADDI	Q1,10		;ADVANCE FOR ARCF% INFO
	MOVEI	T3,FDB(Q1)
	MOVE	T4,ARCGST	;DO WE HAVE THE ARCHIVING INFO ALREADY?
	MOVEM	T3,ARCGST	;YEA OR NEA, IT WILL END UP HERE
	JUMPN	T4,[		;YES - BLT IT IN
		 HRL	T3,T4
		 MOVEI	T4,.ARPSZ(T3)
		 BLT	T3,(T4)
		 JRST	ARCIDN]	;END UP WITH ARCGST POINTING TO NEW PLACE
	ARCF%			;NO - MUST GET
	 ERJMPS	[SETZM	(T3)
		 JRST	.+1]
ARCIDN:	ADDI	Q1,.ARPSZ+1	;IF MORE WERE STORED IT WOULD GO HERE
	MOVEM	Q1,ENDFDB	;REMEMBER WHERE IT ENDS
	MOVE	T1,JFN		;FETCH THE (NON-WILD) JFN
	MOVX	T2,OF%RD+OF%PDT	;BUT NOT OF%RDU, SINCE WE WANT TO SEE THE ERROR
	OPENF%			;OPEN IT UP
OPENIN:	 ERJMPR	OPNFRR		;CAN'T, TEST ERROR
	JRST	OPENOK		;GOT IT FIRST TRY
OPNFRR:	CAIN	T1,OPNX2	;IGNORE NONEXISTANT FILES
	JRST	SKIPDP		;..
	CAIN	T1,OPNX31	;OFFLINE FILES ARE OK..
	JRST	OPENOK		;SO ACT AS IF THIS WORKED
 IFG FTVERS-4,<
	CAIN	T1,OPNX9	;KEPT BECAUSE OF THAW-ACCESS READER?
	JRST	TRYTHW		;MAYBE, GO TRY
 >
OPNCRR:	WARN	<Can't read >
	CALL	TYJFN		;TYPE FILENAME JFN'D IN JFN
	CALL	LSTERD		;SAY WHY
	TYPE	CRLF
	JRST	SKIPDP
 IFG FTVERS-4,<
TRYTHW:	MOVE	T1,JFN		;TRY AN UNRESTRICTED READ!
	MOVX	T2,OF%RD+OF%RDU+OF%PDT
	OPENF%
	 ERJMPR	OPNCRR		;STILL WON'T WORK, QUIT
	WARN	<File >		;OK, BUT TELL USER THIS MAY CAUSE PROBLEMS
	CALL	TYJFN1
	TYPE	[ASCIZ/ needed to be opened UNRESTRICTED/]
 >
OPENOK:	TXON	F,F.GOT1	;WE FINALLY HAVE A FILE
	CALL	[CALL	INIREC	;SO SET UP FOR OUTPUT
		 JRST	BGNHEA]	;AND PUT UP THE SAVESET HEADER
	CALL	GOFNAM		;GENERATE THE OUTPUT NAME
	AOS	NOFILS		;INC NUMBER OF FILES THIS DIRECTORY
	AOS	TOTFIL		;AND GENERAL TOTAL
	MOVE	T1,DMPFLG	;ARCHIVE/COLLECTION/MIGRATION?
	TXNE	T1,D.COL!D.MIG!D.ARC
	CALL	ARC1		;YES, GO SET ARCHIVE-TYPE INFO
	HRROI	T1,OUTSPC	;GET FULL OUTPUT FILESPEC
	HRROI	T2,FDBBUF	;PUT INTO FILE HEADER REC
	CALL	CSTRB
	MOVE	T1,T2		;APPENDING TO FDBBUF
	CALL	GOFPAT		;GOFPAT ADDS ;Pnnnnnn;Afoobar;T as needed
	SETZ	T2,
	IDPB	T2,T1		;TIE OFF STRING
;Stuff for FILES and DIRECTORIES
	TXNN	F,F.DIRT+F.FILT	;ARE WE DOING THEM?
	JRST	NOFIDR		;NO, SKIP ALL THIS
	CALL	SAVTXT		;SET UP TO SAVE TEXT, SET UP Q1, T2
	SKIPE	DDOFLG		;FIRST TIME THIS DIRECTORY?
	TXNN	F,F.DIRT	;CARE ABOUT DIRECTORIES?
	JRST	[TXNN	F,F.FILT;NOT DOING DIRECTORY. DOING FILES?
		 JRST	NOFIDR	;NOT DOING ANYTHING
		 JRST	JFTYPE]	;WILL DO FILES
;At the beginning of a new directory.  We need to put the output for
; the "DIRECTORIES" command up.
	SETZM	DDOFLG		;ONCE PER NEW INPUT DIRECTORY
	HRROI	T1,[BYTE(7) TR.DIR," "]
	CALL	CSTRB
	TXNN	F,F.NDIR	;WILL <OUTPUT> EQUAL <INPUT>?
	JRST	USRSAM
	PUSH	P,T2		;SAVE THE BYTE POINTER
	CALL	GDIRNA		;GET THE INCOMING DIRECTORY NAME
	POP	P,T2		;RESTORE IT
	HRROI	T1,INDIR	;FETCH INDIR
	CALL	CSTRB
	HRROI	T1,[ASCIZ/ (as) /]
	CALL	CSTRB
USRSAM:	HRROI	T1,OUTDIR
	CALL	CSTRB
	HRROI	T1,CRLF
	CALL	CSTR
	TXNN	F,F.FILT	;FILES AS WELL?
	JRST	FINFDT		;NO, CLOSE OFF STRING
JFTYPE:	HRROI	T1,[BYTE(7) TR.FIL," "," "," ",0]
	CALL	CSTRB		;ADD FILE START AND SPACES
	MOVE	T1,T2		;JFNS WANTS IT IN T1
	MOVE	T2,JFN		;STORE FILENAME FOR "FILES" COMMAND
	MOVE	T3,[JFNSAL]
	JFNS%
	MOVE	T2,T1
;Make at least a token attempt to avoid typing "(as) filename"
	MOVE	T3,DMPFLG	;SEE IF ARCHIVE/COLLECT/MIGRATION/INCREMENTAL
	TXNE	T3,D.INC!D.COL!D.ARC!D.MIG ;IS INPUT FILENAME ALWAYS = OUTPUT?
	JRST	NOOUSP		;YES, DON'T ADD OUTPUT SPEC
	TXNE	F,F.NDIR	;OK, IS OUTPUT WILD OR = INPUT?
	JRST	NEEDAS		;NO, MUST TYPE NEW NAME
	MOVE	T3,JF2LST(P5)	;FETCH THE OUTPUT WILDS
	TXC	T3,GJ%NAM!GJ%EXT!GJ%VER ;INVERT FOR SINGLE TEST...
	TXNN	T3,GJ%NAM!GJ%EXT!GJ%VER ;WERE THEY ALL ON?
	JRST	NOOUSP		;ALL WERE ON - SKIP THE (as)
NEEDAS:	MOVE	T2,T1		;APPEND TO JFNS OUTPUT
	HRROI	T1,[ASCIZ/ (as) /]
	CALL	CSTRB
	HRROI	T1,OUTSPC	;THE OUTPUT FILENAME
	CALL	CSTR
	JRST	FINFDT		;AND DONE
NOOUSP:	SETZ	T1,
	IDPB	T1,T2
FINFDT:	MOVEM	T2,TREBUF(Q1)	;SO WE CAN APPEND TO IT LATER
	MOVEI	T1,TR.END	;IN CASE WE DON'T
	IDPB	T1,T2
NOFIDR:	TXNE	F,F.CHKS
	CALL	[SETZM	CHKCN0	;SET UP TO CHECKSUM THE FILE
		 SETZM	LSTPGE	;TRACK PAGE NUMBER
		 JRST	FILSZE]	;NEED FILE SIZE, SET IT UP
	HRLZ	T1,TOTFIL	;SET UP FILE NUMBER FOR HEADER
	TXO	T1,PG.NFN	;SET HISTORICAL BIT
	MOVEM	T1,TAPHEA+.PAGNO;STORE IN HEADER
	HRROI	T1,-FILEST	;SET UP A FILE HEADER
	MOVEM	T1,TAPHEA+.TYP
	MOVEI	T1,TAPHEA	;TO HEADER
	MOVEI	T2,FDBBUF	;AND TO 1000 WORD DATA
	CALL	ADDREC		;AND WRITE FILE HEADER TO TAPE
	MOVE	T1,VOLID6
	MOVEM	T1,ORGTAP	;SAVE TAPE FILE WAS STARTED ON
	SKIPN	LSTJFN		;LIST FILE?
	JRST	NOFLLI		;NO, SKIP THIS
	SELECT	LS.LST		;YES, WRITE TO IT
IFN FTMAIL,<
	SKIPE	MAILFL		;DOING A MAIL FILE?
	TYPE	[ASCIZ/*S/]	;SO WE CAN READ THE LIST FILE BACK AT NEED
 >
	MOVEI	T2,FLCOL
	CALL	TABOUT		;GET TO THE FILE COLUMN
	TYPE	OUTSPC		;WHERE WE STORED THE OUTPUT FILENAME
	SELECT	LS.TTY
NOFLLI:	SETZM	FFREE		;NO HOLE YET
	SETZB	T1,CURREN	;AT FIRST PAGE
	JRST	DMPIN
DMPPGS:	SOSLE	PBHOLD		;ANY MORE TO PROCESS?
	JRST	GNFPIN		;YES, DO THE NEXT PAGE
DMPIN:	CAMGE	T1,FFREE	;AT THE BRINK OF A HOLE (OR DON'T KNOW)?
	JRST	KWNPS		;NO, SO CURREN HAS THE NEXT FILE PAGE #
	HRL	T1,JFN		;DETERMINE NEXT FILE PAGE #
	FFUFP%			;..
	 ERJMPS	ENDFIL		;NO MORE PAGES OR FILE NOT REALLY OPEN
	HRRZM	T1,CURREN	;OK, WE HAVE THE ADDR OF THE NEXT PAGE
KWNPS:	MOVEI	T2,PBSIZ	;FIGURE PAGE WE WILL READ TO, PLUS ONE
	HRRZS	T1		;NEED JUST PAGE NUMBER
	ADD	T2,T1		;WARNING: RESULT CAN BE .GT. 0,,-1
	CAMGE	T2,FFREE	;IS THERE A HOLE BEFORE THEN (OR DON'T KNOW)?
	JRST	KHISTW		;HOLE IS FURTHER ON, DON'T LOOK FOR IT
	HRLZS	T1		;FFFFP WANTS PAGE # IN LF
	HRR	T1,JFN
	FFFFP%			;FIND FIRST FREE PAGE (HOLE)
	 JSERRD	<>		;DOESN'T HAPPEN
	CAIGE	T1,0		;-1 MEANS NO HOLE (FILE AT MAX SIZE)..
	SKIPA	T1,[1,,0]	;SO SAY HOLE IS AT MAXPAGE + 1
	HRRZS	T1		;CUT TO PAGE NUMBER
	MOVEM	T1,FFREE	;AND STORE FIRST FREE PAGE AHEAD
	SUB	T1,CURREN	;HOW MANY CAN WE GET?
	CAILE	T1,PBSIZ	;MORE THAN WE CAN TAKE?
KHISTW:	MOVEI	T1,PBSIZ	;YES, TAKE OUR MAX
	MOVEM	T1,PBHOLD	;THAT'S WHAT WE ARE GOING TO TAKE
	MOVE	T3,T1		;INTO T3 FOR PMAP%
	TXO	T3,PM%CNT+PM%RD+PM%PLD ;ITS A COUNT, READ ACCESS, AND PRELOAD
	MOVE	T2,[.FHSLF,,PAGPAG] ;INTO THIS FORK, PAGPAG
	MOVE	T1,CURREN	;FILE PAGE AS MENTIONED
	HRL	T1,JFN
	PMAP%			;FETCHEM!
	 JSERRD	<>
	MOVE	T1,CURREN	;GET CURRENT PAGE NUMBER
	SKIPA	T2,[PAGBUF]	;THIS IS WHERE PAGPAG STARTS
GNFPIN:	MOVE	T2,WRDPNT
	HRRM	T1,TAPHEA+.PAGNO ;STORE PAGE NUMBER
	MOVEI	T3,1000(T2)	;GET ADDRESS OF NEXT PAGE FOR NEXT TIME
	MOVEM	T3,WRDPNT	;STORE
	SETZM	TAPHEA+.TYP	;RECORD TYPE 0 (DATA)
	MOVEI	T1,TAPHEA	;T1/ RECORD HEADER, T2/ DATA PAGE
	CALL	ADDREC		;OUT TO TAPE
	TXNE	F,F.CHKS	;WANT CHECKSUM?
	CALL	CHKSFF		;YES, DO IT
	AOS	USRCNT		;PAGES THIS DIRECTORY
	AOS	TOTCNT		;TOTAL PAGES
	AOS	T1,CURREN	;ADVANCE TO NEXT PAGE
	TLNN	T1,-1		;UNLESS THERE ISN'T ONE (AT 0,,-1)
	JRST	DMPPGS
ENDFIL:	SETO	T1,
	MOVE	T2,[.FHSLF,,PAGPAG]
	MOVE	T3,[PM%CNT+PBSIZ]
	PMAP%
	MOVE	T4,DMPFLG
	TXNN	T4,D.FINC!D.INC	;SOME SORT OF INCREMENTAL?
	JRST	NOINCR
;Update .FBBK0 if doing incrementals
;Format of .FBBK0: qB0+tape_writes,,filewrites_at_last_save
; where q is 1 if incompletely dumped.
;This code will set .FBBK0 to:
;LH: Number of times THIS version of the file has been written to tape (less
;	this save, which we add in at the end of PASS 2 for this run)
;	Also, 1B0 is set (meaning PASS 2 should note this file)
;RH: How many times this version was modified when it was saved this time.
; If this is different at the next incremental, we know the file has been
; modified in place and needs to be saved n more times.
	HLRZ	T2,FDB+.FBCNT	;GET NUMBER OF WRITES-ON-DISK
	MOVE	T3,FDB+.FBBK0	;HOW MANY WRITES-ON-DISK AT LAST SAVE?
;**;[561] Add 1 line at ENDFIL+19			GAS	13-Sep-89
	TXNN	T4,D.FINC	;[561] Always set count to 1 on /FULL save
	CAIE	T2,(T3)		;IF THE SAME, DON'T RESTART "TIMES SAVED"
	MOVE	T3,T2		;DIFFERENT - SAY SAVED 0 TIMES (LH OF .FBBK0)
	TXO	T3,1B0		;SAY HALF-SAVED (2ND PASS NEEDED)
	MOVE	T1,JFN
	HRLI	T1,.FBBK0(CF%NUD);CHANGE .FBBK0, DON'T FORCE UPDATE
	SETO	T2,
	CHFDB%
	 ERJMPS	.+1
	ADD	T3,[1B0+1B17]	;APPEAR AS IF SAVED OK IN TAPE FDB
	MOVEM	T3,FDB+.FBBK0	;ABOVE CLEARS 1B0 AND INCREMENTS THE COUNT
	MOVE	T3,ORGTAP
	MOVEM	T3,FDB+.FBBK1
	SKIPE	SUPMRK		;TRY TO RECORD TAPE WE STARTED SAVING THIS FILE
	JRST	NOINCA		;ON, UNLESS WE KNOW WE CAN'T
	MOVE	T1,JFN
	HRLI	T1,.FBBK1(CF%NUD);CHANGE .FBBK1, NO UPDATE
	CHFDB%
	 ERJMPR	FALSMK		;NOT ALL MONITORS ALLOW THIS
	JRST	NOINCA
FALSMK:	CAIN	T1,CFDBX2
	SETOM	SUPMRK		;THIS MONITOR DOESN'T ALLOW, SO DON'T TRY
	JRST	NOINCA
NOINCR:	HRRZS	FDB+.FBBK0	;NO INCREMENTAL, JUST CLEAR TAPE_SAVE_COUNT
NOINCA:	MOVE	T1,JFN
	TXO	T1,CO%NRJ	;DROP THE FILE, KEEP THE JFN
	CLOSF%
	 ERJMPS	.+1
	SKIPN	LSTJFN
	JRST	NDMFLN
	SELECT	LS.LST
	MOVEI	T2,WTCOL
	CALL	TABOUT
	MOVE	T2,FDB+.FBWRT
	CALL	TADOUT
	MOVEI	T2,SZCOL
	CALL	TABOUT
	HRRZ	T2,FDB+.FBBYV
	CALL	DECOUT
	TXNE	F,F.CHKS	;DOING CHECKSUM?
	CALL	PRTCSM		;FINE, PRINT IT
	TYPE	CRLF
	SELECT	LS.TTY
NDMFLN:	MOVE	T1,[FDB,,FDBBUF];FOR LORD ONLY KNOWS WHAT REASON,..
	MOVE	T2,ENDFDB	;THE FILE TRAILER REC HAS A DIFFERENT
	BLT	T1,FDBBUF(T2)	;FORMAT THAN THE FILE LEADER, SO WE HAVE
	MOVEI	T1,FDBBUF+1(T2)	;TO SHIFT EVERYTHING UP
	SETZM	(T1)		;CLEAR THE REST
	HRLI	T1,1(T1)
	MOVSS	T1
	BLT	T1,FDBBUF+777
;FOR THE "FILES" COMMAND
	TXNN	F,F.FILT
	JRST	NOFILT
	CALL	SAVTXT		;WE WANT TO <CRLF> AT OUTPUT TIME
	HRROI	T1,[BYTE(7)TR.FIL,.CHCRT,.CHLFD,0]
	CALL	CSTR
	MOVEM	T2,TREBUF(Q1)
	MOVEI	T1,TR.END
	IDPB	T1,T2
NOFILT:	HRROI	T1,-FILEEN	;OUTPUT THE FILE TRAILER
	MOVEM	T1,TAPHEA+.TYP	;WRITING FILE TRAILER
	MOVEI	T1,TAPHEA
	MOVEI	T2,FDBBUF
	JRST	ADDREC

SKIPDP:	CALL	TSTINT
	 JRST	BAKOUT
 IFG REEVAL*<FTVERS-5>,<
	TXNE	F,F.GOT1	;ANY OUTPUT YET?
	SKIPN	DMPCHA		;ANYTHING WANTING TO GO OUT?
	RET			;NO OUTPUT PENDING, QUIT
	CALL	CHKBLK		;TAPE DRIVE IDLE?
	JUMPN	T3,CPOPJ	;..?
	JRST	DOOUT		;YES, RETURN THROUGH DOOUT
 >
 IFLE REEVAL*<FTVERS-5>,<
	RET
 >
;FLAGS AND COMMAND STUFF FOR DUMP
;NONE OF THESE SHOULD HURT REGISTERS BEYOND T1-T4 and F
;THESE RETURN TO DUMPPF

$UNLSW:	SETOM	UNLFLG
	JRST	DUMPPF
$NINC:	TXO	F,F.NDIR	;INHIBIT USER DATA
	JRST	DUMPPF
$ARC:	MOVX	T1,D.ARC
	JRST	SDMPSW
$COL:	MOVX	T1,D.COL
	JRST	SDMPSW
$FINC:	MOVX	T1,D.FINC
	TXO	F,F.DDIR	;THIS TAKES DIRECTORY DATA
	JRST	SDMPSW
$INC:	MOVEI	T2,1		;ASSUME ONE
	TXNN	T1,CM%SWT	;SWITCH TERMINATOR? (DOES A VALUE FOLLOW?)
	JRST	$INC2
	DMOVE	T1,[EXP CMDBLK,INCINB]
	CALL	PARSE
	 JSERRD	<>,NOCMD,JRST
$INC2:	SKIPG	T1,T2		;LEGAL?
	ERROR	<Tape count must be greater than zero>
	TDNE	T1,[-D.INC-1]	;LEGAL VALUE?
	MOVEI	T1,D.INC	;TOO BIG, GO FOR BIGGEST
	TXO	F,F.DDIR	;THIS WANTS DIRECTORY DATA
	JRST	SDMPSW
$MIG:	MOVX	T1,D.MIG
	;JRST	SDMPSW

SDMPSW:	TXNN	F,F.PRIV	;ALLOWED TO DO THIS?
	JRST	OPRERR		;ERROR, NEED OPR PRIVES FOR THESE
	SKIPE	DMPFLG		;ANYTHING ALREADY SET?
	 ERROR	<Switch combination illegal>
	MOVEM	T1,DMPFLG
	CALL	SETSTP
	JRST	DUMPPF

;Enter with T1/ DMPFLGs - set SAVETP for ADDREC
SETSTP:	SETZ	T4,
	TXNE	T1,D.COL
	MOVSI	T4,(1B2)
	TXNE	T1,D.ARC
	MOVSI	T4,(2B2)
	TXNE	T1,D.MIG
	MOVSI	T4,(3B2)
	MOVEM	T4,SAVETP	;STORE THIS FOR ADDREC
	RET

DMPINB:	<.CMSWI>B8+DM2INB
	EXP	DMPSWI
DMPSWI:	 NDSWTB,,NDSWTB
	CTB	$ARC,	<ARCHIVE>,	CM%INV
	CTB	$COL,	<COLLECT>,	CM%INV
	CTB	$FINC,	<FULL-INCREMENTAL>
	CTB	$INC,	<INCREMENTAL:>
	CTB	$MIG,	<MIGRATE>,	CM%INV
	CTB	$NINC,	<NOINCREMENTAL>
	CTB	$UNLSW,	<UNLOAD>
	 NDSWTB==.-DMPSWI-1

DM2INB:	<.CMFIL>B8
INCINB:	<.CMNUM>B8+CM%SDH+CM%DPP+CM%HPP
	^D10
	-1,,[ASCIZ/The number of tapes each file must be on/]
	-1,,[ASCIZ/1/]

CCFINB:	<.CMCMA>B8+.+1		;COMMA
	<.CMCFM>B8+.+1		;CONFIRM
	<.CMFIL>B8+CM%SDH+CM%HPP ;OR FILE
	BLOCK	1
	-1,,[ASCIZ/filename to use on tape/]

CCINB:	<.CMCMA>B8+.+1		;COMMA
	<.CMCFM>B8		;OR CONFIRM
;Support for DUMP

;BGNHEA starts the tape with the "SAVESET start" record.
BGNHEA:	TXNE	F,F.FILT+F.DIRT	;IF DOING ANY REPORTING, START WITH <CRLF>
	TYPE	CRLF
	SKIPA	T1,[-SAVEST]
;CONHEA writes a continued tape header out and does the normal
; things needed when starting a tape
CONHEA:	HRROI	T1,-CONTST
STHEAD:	MOVEM	T1,TAPHEA+.TYP	;PUT IN HEADER TYPE
	MOVEI	T1,CURFMT
	MOVEM	T1,SSNBUF+SV.FMT;FORMAT NUMBER IN
	MOVE	T1,BGNTAD	;PICK UP THE STARTING DATE
	MOVEM	T1,SSNBUF+SV.TAD;IN IT GOES
	MOVE	T1,VOLID6	;MOVE IN THE VOLID
	MOVEM	T1,SSNBUF+SV.VOL;..
	MOVEI	T1,.EDIT
	MOVEM	T1,SSNBUF+SV.EDT;REMEMBER WHICH VERSION WROTE THIS
	MOVEI	T1,SV.MSG
	MOVEM	T1,SSNBUF+SV.PNT;POINTER TO SAVESET NAME IN
	MOVEI	T1,TAPHEA	;NOW POINT TO HEADER
	MOVEI	T2,SSNBUF	;AND PAGE WITH SAVESET NAME
	JRST	ADDREC		;IT IN GOES

;GOFNAM creates the outgoing filename based on JFN and JF2LST(P5).
; Result to OUTSPC
GOFNAM:	CALL	GOFDIR		;GET STR:<DIR>, RETURN PNTR IN T1 TO END
	MOVEM	T1,OUTFLS	;SAVE NAME POINTER
	MOVE	T2,JF2LST(P5)	;CHECK MOST COMMON CASE
	TXC	T2,GJ%NAM+GJ%EXT+GJ%VER	;COMP TO TEST IF ALL ON
	TXNN	T2,GJ%NAM+GJ%EXT+GJ%VER	;ALL OFF NOW?
	JRST	[MOVE	T2,JFN	;YES, DO REST FROM INPUT JFN
		 MOVX	T3,1B8+1B11+1B14+JS%PAF ;NAME, EXT, VER WITH PUNCTUATION
		 JFNS%		;STRING IT OUT
		 RET]		;AND LEAVE FAST
	MOVX	T4,GJ%NAM	;NAME
	MOVX	T3,1B8+JS%PAF
	CALL	GOFJNS
	MOVX	T4,GJ%EXT	;EXTENSION
	MOVX	T3,1B11+JS%PAF
	CALL	GOFJNS
	MOVX	T4,GJ%VER	;GENERATION #
	MOVX	T3,1B14+JS%PAF
	;JRST	GOFJNS		;GET GEN # AND RETURN FROM GOFNAM
GOFJNS:	TDNN	T4,JF2LST(P5)	;OUTPUT * HERE?
	SKIPN	T2,JF2LST(P5)	;NO, USE OUTPUT FIELD
	HRRZ	T2,JFN		;PICKUP INPUT FIELD
	JFNS%
	RET

;Gens the output STR:<DIR> and stores it in OUTDIR and OUTSPC.
; Returns OUTDRS pointing to the end of the string in OUTSPC (and also in
; T1).  If OUTDRS is nonzero, it assumes it was already called and returns
; it in T1.  If calling at GOFDRS, it always sets up OUTDIR, OUTSPC, and
; OUTDRS regardless of the value of OUTDRS.
GOFDIR:	SKIPE	T1,OUTDRS	;ALREADY KNOWN?
	RET			;YES, FORGET IT
GOFDRS:	HRROI	T1,OUTDIR
	MOVX	T4,GJ%DEV+GJ%UNT;DEVICE
	MOVX	T3,1B2+JS%PAF
	CALL	GOFJNS		;DO JFNS
	MOVX	T4,GJ%DIR	;DIRECTORY
	MOVX	T3,1B5+JS%PAF
	CALL	GOFJNS
	HRROI	T1,OUTDIR
	HRROI	T2,OUTSPC
	CALL	CSTRB
	MOVEM	T2,OUTDRS
	MOVE	T1,T2
	RET

;Get File Protection, Account string, and ;T
GOFPAT:	TXNE	F,F.INTR	;INTERCHANGE MODE?
	JRST	GOFPT1		;YES, DON'T USE TAPE PROTECTION
	MOVX	T4,GJ%PRO	;PROTECTION FIELD
	MOVX	T3,1B17+JS%PAF
	TXNE	F,F.RPRO	;USE SYSTEM DEFAULT?
	CALL	GOYJNS		;NO, USE OURS
GOFPT1:	MOVX	T4,GJ%TFS	; ;T
	MOVX	T3,<JS%TMP+JS%PAF>
	CALL	GOXJNS		;GET ;T
	MOVEM	T1,OUTACS	;REMEMBER WHERE ACCOUNT STARTS
	MOVX	T4,GJ%ACT	;ACCOUNT
	MOVX	T3,1B20+JS%PAF
	TXNE	F,F.RACC	;USE SYSTEM DEFAULT?
	CALL	GOXJNS		;NO-- GET SPECIFIED VALUE
	RET

GOXJNS:	TXNE	F,F.INTR	;INTERCHANGE MODE?
	TDNE	T4,JF2LST(P5)	;YES-- BUT IS OUTPUT SPECIFIED?
	JRST	.+2		;OUTPUT SPECIFIED OR NOT INTERCHANGE-- OK
	RET	;INTERCHANGE MODE AND NO OUTPUT SPEC-- USE SYSTEM DEFAULT
GOYJNS:	TDNE	T4,JF2LST(P5)	;OUTPUT SPECIFIED HERE?
	SKIPN	T2,JF2LST(P5)	;YES, USE OUTPUT FIELD
	HRRZ	T2,JFN		;PICKUP INPUT FIELD
	JFNS%
	RET

;Make sure the CURRENT buffer is set up to type text at the time when it is
; deleted.  Return the pointer to write to in T2.  If RELPGT is called to
; kill the buffer, text set up for here is typed out.  Used by DMPFIL, DMPUSR.
;This returns Q1 pointing to the current buffer header (ie, contains CURBLK)
SAVTXT:	MOVE	Q1,CURBLK	;FIND CURRENT BUFFER
	SKIPE	T2,TREBUF(Q1)	;ANY TEXT STORED IN "TYPE WHEN DEL'ING" YET?
	RET			;YES, RETURN WHERE TO APPEND TO
	MOVE	T2,Q1		;NO
	ADD	T2,BUFFRE	;FIND OUT WHERE IT GOES
	SETZM	(T2)		;MAKE SURE NOTHING THERE YET
	HRLI	T2,(POINT 7)	;BYTE POINTER
	MOVEM	T2,TRPBUF(Q1)	;STORE START OF STRING
	MOVEM	T2,TREBUF(Q1)	;AND WHERE TO ADD TO
	RET

;Get file size for checksumming purposes
FILSZE:	MOVEI	T4,FDB
FILSZA:	LDB	T1,[POINT 6,.FBBYV(T4),11]
	MOVEI	T2,44		;BITS IN A WORD
	IDIV	T2,T1		;BYTES IN A WORD
	MOVE	T3,.FBSIZ(T4) 	;BYTES IN FILE
	IDIV	T3,T2		;WORDS IN FILE
	CAIE	T4,0		;SKIP IF NO REMAINDER
	ADDI	T3,1
	IDIVI	T3,1000		;PAGES IN FILE
	MOVEM	T3,FPGCNT	;FILE PAGE COUNT
	MOVEM	T4,RMRPGE	;REMAINDER PAGE
	RET

;Here for checksum of page.  Call with T2 pointing at the page, and
; TAPHEA+.PAGNO set up (Ie, call after ADDREC)
CHKSFF:	MOVEM	T2,SUMTMP
	TXNE	F,F.CSEQ	;SKIP IF NOT SEQUENTIAL CHECKSUM
	JRST	SEQCSM		;DO SEQUENTIAL CHECKSUM
	HRRZ	T4,TAPHEA+.PAGNO;GET PAGE #
	SUB	T4,LSTPGE	;SEE IF HOLE
	SOJLE	T4,PCHKS1	;JUMP IF NO HOLE
	MOVNI	T2,(T4)		;YES, GET -PAGE #
	HRL	T2,T4		;MAKE IT PAGE #,,-PAGE #
	HRROI	T3,T2		;POINT AT T2, ONE WORD
	CALL	CHKSOM		;CHECKSUM 1 WORD
PCHKS1:	MOVSI	T3,-1000	;SETUP AOBJN POINTER TO WHOLE PAGE
	HRR	T3,SUMTMP
	CALL	CHKSOM		;CHECKSUM FILE BUFFER
	HRRZ	T1,TAPHEA+.PAGNO;GET PAGE #
	MOVEM	T1,LSTPGE	;STORE
	RET			;DONE WITH PAGE
;HERE FOR SEQUENTIAL CHECKSUM
SEQCSM:	SOSGE	FPGCNT		;DECREMENT WHOLE PAGE CONT
	JRST	SEQCS1		;NO WHOLE PAGES LEFT
	MOVSI	T3,-1000	;WORDS TO CHECKSUM
	HRR	T3,SUMTMP
	JRST	CHKSOM		;CHECKSUM PAGE

SEQCS1:	SKIPN	T3,RMRPGE	;GET REMAINDER TO CHECK
	RET			;NOTHING TO CHECK
	MOVNS	T3		;NEGATE WORDS TO CHECK
	HRLZS	T3		;...
	HRR	T3,SUMTMP	;POINT AT BUFFER
	SETZM	RMRPGE		;DON'T CHECK AGAIN
	;JRST	CHKSOM		;DO CHECKSUM OF LAST PAGE

;Here to checksum words pointed to by T3 (aobjn word)
CHKSOM:	MOVE	T4,CHKCN0
CHKSM1:	ROT	T4,1
	ADD	T4,(T3)
	AOBJN	T3,CHKSM1	;LOOP ON WORD COUNT
	MOVEM	T4,CHKCN0
	RET

;Print the checksum to the list file
PRTCSM:	MOVEI	T2,CSCOL	;CHECKSUM COLUMN
PRTCS2:	CALL	TABOUT		;TAB TO CHECKSUM
	HLRZ	T2,CHKCN0
	HRRZ	T3,CHKCN0
	ADD	T3,T2		;MAKE IT 18-BITS WORTH
	HLRZ	T2,T3		;...
	ADDI	T2,(T3)		;...
	MOVE	T3,[NO%LFL+NO%ZRO+^D8(6)]
	CALL	NUMOUT
	TXNN	F,F.CSEQ	;SKIP IF SEQUENTIAL CHECKSUM
	TYPE	[ASCIZ/ P/]	;FLAG AS BY-PAGES CHECKSUM
	RET
;Archive specific stuff
ARCTST:	MOVE	T2,FDB+.FBCTL
	TXNE	T2,FB%OFF	; File offline?
	RET			; Yes, skip it
	MOVE	T4,DMPFLG
	TXNN	T4,D.ARC
	JRST	ARCTS1		; No, must be Migration/Collection
	MOVE	T2,FDB+.FBBBT
	TXNN	T2,AR%RAR	; Archive requested?
	RET			; No, skip it
	JRST ARCTS3		; Yes, go on with check

ARCTS1:	MOVE	T2,FDB+.FBBBT
	TXNE	T2,AR%RIV	; Migration request?
	JRST ARCTS3		; Explict request, cont. with test

	TXNE	T4,D.COL
	TXNE	T2,AR%RAR	; Archive requested already?
	RET			; Yes, skip it
	HLRZ	T2,FDB+.FBNET	; Get online expiration
	HLRZ	T1,BGNTAD	; Get day at start of COLLECTION run
	CAIGE	T1,(T2)		; File expired?
	RET			; No (& does have exp. date)
	JUMPN	T2,ARCTS2	; Expired date if non-zero--dump it
	MOVE	T1,FDB+.FBCRE	; Interval, find most recent date
	CAMG	T1,FDB+.FBCRV
	MOVE	T1,FDB+.FBCRV
	CAMG	T1,FDB+.FBWRT
	MOVE	T1,FDB+.FBWRT
	CAMG	T1,FDB+.FBREF
	MOVE	T1,FDB+.FBREF
	HRRZ	T2,FDB+.FBNET	; Get the interval
	HLRZS	T1
	ADD	T2,T1		; Form expiration date
	HLRZ	T1,BGNTAD	; Get day at start of COLLECTION run
	CAIG	T1,(T2)		; Expired?
	RET			; No, skip it
ARCTS2:	TXNN	T4,D.AOEF	;ARCHIVE ONLINE EXPRIED FILES?
	JRST	ARCTS3		;NO
	CALL	NSETS		;SET ARSETS TO # OF TIMES PUT ON TAPE
	JUMPN	T1,ARCTS3	;FINE, SKIP ON
	MOVE	T1,JFN		;ARCHIVE IT
	MOVEI	T2,.ARRAR
	MOVEI	T3,.ARSET
	ARCF%
	 ERJMPS CPOPJ
	RET			;OK, MARKED FOR ARCHIVE, RETURN

ARCTS3:	CALL	NSETS		;HOW MANY TIMES ARCHIVED? INTO T1
	MOVE	T2,FDB+.FBBBT
	TXNE	T2,AR%1ST	;IF AR%1ST ON, IGNORE INVALID TAPE INFO
	JUMPG	T1,[SOS	T1,ARSETS;CORRECT ARSETS FOR IGNORED SET
		JRST @.+1]
	JRST	@[EXP	CPOPJ1, ARCONE, CPOPJ](T1)
;Check for the 2nd tape being the same as the first, if so, don't archive the
; file to the same tape.  Defeating this check does no good, as ARCF% checks
; as well.
ARCONE:	MOVE	T2,ARCGST	;WHERE THE ARCHIVE INFO IS (FROM NSETS)
	MOVE	T2,.ARTP1(T2)	;FOR 2ND RUN, CHECK FIRST TAPE NAME
	CAME	T2,VOLID6	;1ST TAPE # = 2ND TAPE #?
	JRST	CPOPJ1		;NO, OK TO DUMP
	RET			;YES, DEFER DUMP TILL ANOTHER TAPE

;NSETS WILL COUNT UP THE NUMBER OF TIMES A FILE'S BEEN ARCHIVED TO TAPE (0,1,2)
; This also sets up ARCINF/ARCGST at need.
NSETS:	SKIPE	T2,ARCGST	;WHERE THE ARCF% INFO FOR THIS FILE IS
	JRST	NSETSS		;..
	MOVE	T1,JFN		;OH.  WELL, LET'S GET IT NOW
	MOVX	T2,.ARGST
	MOVEI	T3,ARCINF
	ARCF%
	 JSERRD	<NSETS>		;BETTER NOT HAPPEN
NSETSA:	MOVEI	T2,ARCINF
	MOVEM	T2,ARCGST
NSETSS:	SETZB	T1,ARSETS	;ASSUME NONE
	SKIPE	.ARTP1(T2)	;FIRST ONE THERE?
	AOS	T1,ARSETS	;YES, NOTE THAT
	SKIPE	.ARTP2(T2)	;HOW ABOUT THE 2ND TAPE?
	AOS	T1,ARSETS	;THAT ONE TOO
	RET


;FOR ARCHIVE/COLL./MIG. RUN, SET TAPE INFO AND AR%1ST
;Call with DUMP flags (DMPFLG) in T1
ARC1:	SETZM	ARSSTB+.AROFL	; Set up block
	MOVX	T2,AR%ARC	; Flag archive?
	TXNE	T1,D.ARC
	MOVEM	T2,ARSSTB+.AROFL; Yes
	MOVE	T3,TOTFIL	;SET UP THE SAVESET,,FILENUMBER WORD
	HRL	T3,ARCTSN	;.. INTO T3
	MOVE	T1,VOLID6	;STORE VOLID HERE...
	MOVE	T4,ARCGST	;AND POINT TO ARCF INFO IN FDB TAPE RECORD
	SKIPE	ARSETS		;SET BY CALL TO ARCTST.  FIRST ARCHIVE RUN?
	JRST	ARCP2		;NO
ARCP1:	MOVX	T2,AR%O1	;YES, IN 1ST TAPE SLOTS
	IORM	T2,ARSSTB+.AROFL;FLAG FIRST RUN
	MOVEM	T1,ARSSTB+.ARTP1;STORE VOLID NAME
	MOVEM	T3,ARSSTB+.ARSF1;AND SAVESET,,FILE #
	MOVEM	T1,.ARTP1(T4)	;AND STORE IN TAPE ARCF BLOCK AS THOUGH..
	MOVEM	T3,.ARSF1(T4)	;..THE ARCF WORKED OK
	JRST	ARCFR
ARCP2:	MOVX	T2,AR%O2
	MOVEM	T2,ARSSTB+.AROFL;FLAG SECOND RUN
	MOVEM	T1,ARSSTB+.ARTP2;STORE VOLID NAME
	MOVEM	T3,ARSSTB+.ARSF2;AND SAVESET,,FILE #
	MOVEM	T1,.ARTP2(T4)	;AND STORE IN TAPE ARCF BLOCK AS THOUGH..
	MOVEM	T3,.ARSF2(T4)	;..THE ARCF WORKED OK
ARCFR:	SETZM	ARSSTB+.ARODT
	MOVE	T1,JFN
	CALL	NXTINC		;NEXT INCREMENTAL SHOULD SEE CHANGE
	HRLI	T1,.FBBBT	;SET AR%1ST IN .FBBBT
	MOVX	T2,AR%1ST	;TO MARK ARC./COL./MIG. FOR THIS FILE
	MOVE	T3,T2		;IN PROGRESS
	CHFDB%
	 ERJMPS	ARC1ER
ARC1A:	MOVEI	T2,.ARSST	;CODE FOR SET ARCHIVE STATUS
	MOVEI	T3,ARSSTB	;ARG BLOCK FOR .ARSST
	ARCF%			;SET ARCHIVE STATUS
	 ERJMPS	ARC1ER
	MOVX	T2,AR%1ST+AR%RAR+AR%RIV  ;WRITE FDB ON TAPE AS IF THE ARCHIVE
	ANDCAM	T2,FDB+.FBBBT	;RUN HAD COMPLETED SUCCESSFULLY!
	AOS	T2,ARCCNT	;WE DID ANOTHER ONE, COUNT IT FOR PASS2A
	SOJN	T2,CPOPJ	;IF NOT 1ST TIME, DONE
	HRRZ	T2,T1		;IT IS, REMEMBER THE FILENAME FOR PASS2A
	MOVE	T3,[JFNSAL]	;ALL CHARACTISTICS
	HRROI	T1,FSTARC	;TO FSTARC
	JFNS%
	RET			;NOW PASS2A KNOWS WHERE TO START
ARC1ER:	WARN	<Can't set Archive status (>
	CALL	LSTERR
	TYPE	[ASCIZ/) on /]
	JRST	TYJFN

PASS2I:	MOVE	P5,NFJFN
	CALL	IFCRL2
	TYPE	[ASCIZ/ Starting Incremental Pass 2
/]
PASSIB:	MOVE	T2,JF2LST(P5)	;HAUL OUT PARSE ONLY JFN
	TRNE	T2,1B18		;ERROR, NOT REAL?
	JRST	PASSIE		;FINE, SKIP IT
	HRROI	T1,STRING	;WHERE TO STORE
	MOVE	T3,[JFNSAL]	;ALL ATTRIBUTES
	JFNS%			;GET THE NAME WRITTEN
	MOVX	T1,GJ%OLD+GJ%IFG+GJ%XTN
	MOVEM	T1,GTJBLK+.GJGEN
	MOVX	T1,G1%IIN
	MOVEM	T1,GTJBLK+.GJF2
	MOVE	T1,[.NULIO,,.NULIO]
	MOVEM	T1,GTJBLK+.GJSRC
	HRROI	T2,STRING
	MOVEI	T1,GTJBLK
	GTJFN%
	 JSERRD	<PASS2I>,BAKOUT
	MOVEM	T1,P2JFN
PASSIS:	HRRZ	T1,P2JFN
	MOVE	T2,[XWD 1,.FBBK0]
	MOVEI	T3,T3
	GTFDB%
	JUMPGE	T3,PASSIN
	ADD	T3,[1B0+1B17]	;CLEAR DUMP-IN-PROGRESS, INC TAPE COUNT
	MOVSI	T2,-1		;GET MASK FOR BITS TO CHANGE
	HRLI	T1,.FBBK0(CF%NUD) ;NO UPDATE DIRECTORY
	CHFDB%
PASSIN:	MOVE	T1,P2JFN
	GNJFN%
	 ERJMPS	PASSIE
	JRST	PASSIS
PASSIE:	AOBJN	P5,PASSIB
	TYPE	[ASCIZ/ End of Pass 2./]
	RET


;Do the archival pass2.  This is done at the end of the Archive saveset
; (also Collection/Migration.)  The Incremental pass2 is done elsewhere.
;Always gives a +2 return
PASS2A:	HRROI	T2,FSTARC	;FIRST FILE ARCHIVED, PLEASE
	MOVX	T1,GJ%OLD+GJ%XTN
	MOVEM	T1,GTJBLK+.GJGEN
	MOVX	T1,G1%IIN
	MOVEM	T1,GTJBLK+.GJF2	;INCLUDE INVISIBLES
	MOVE	T1,[.NULIO,,.NULIO]
	MOVEM	T1,GTJBLK+.GJSRC
	MOVEI	T1,GTJBLK
	GTJFN%
	 ERJMPS	[MOVX	T1,GJ%OLD+GJ%IFG+GJ%XTN
				;CAN'T.  START FROM THE BEGINNING...
		 MOVEM	T1,GTJBLK+.GJGEN;ALLOWING WILDCARDS
		 GTJFN%
		  JSERRD <PASS2A>,P2DON1	;THAT'S ABSURD
		 JRST	.+1]
	HLL	T1,JFNLST+0	;GIVE IT SAME WILDNESS AS INPUT JFN
	MOVEM	T1,P2JFN	;SAVE IT BY NAME
;The above works because we have restricted the legal wildcarding in the input
; jfn enough to MAKE it work.
	CALL	IFCRLF
	TYPE	[ASCIZ/ Archival Pass 2 started
/]
	MOVE	T4,T1		; Keep bits returned by GNJFN
SCNLU1:	HRRZS	T1		; Clear bits for GTFDB
	MOVE	T2,[1,,.FBBBT]	;GET FLAG BITS
	MOVEI	T3,T2		; INTO T2
	GTFDB%
	 ERJMPS	SCNLU2
	MOVEM	T2, FDB+.FBBBT	;YES, SAVE FLAG BITS
	TXNN	T2,AR%1ST	;ARCH./COLL. IN PROGRESS FOR THIS FILE?
	JRST	SCNLU3		;NO, NOTHING TO DO HERE
	HRRZ	T1,P2JFN
	MOVEI	T2,.ARGST	;GET TAPE INFO
	MOVEI	T3,ARCINF	;INTO ARCINF
	ARCF%
	 JSERRD	<>,SCNLU3
	MOVEM	T3,ARCGST
	MOVE	T3,NVOLID
MNYATP:	MOVE	T2,VOLID6(T3)	; TAPE ID OF CURRENT TAPE
	CAME	T2,ARCINF+.ARTP1; THERE AS TAPE 1?
	CAMN	T2,ARCINF+.ARTP2;OR AS TAPE 2?
	JRST	DOFXBK		; YES, DO FIXUP
	SOJGE	T3,MNYATP	;NO, MAYBE ANOTHER TAPE?
	JRST	SCNLU3		; NOT OF THIS RUN--SKIP IT

DOFXBK:	CALL	ARFXBK		;NOTE ARCHIVE RUN COMPLETED FOR FILE
SCNLU2:	SOSG	ARCCNT		;GOT THEM ALL?
	JRST	P2DON1		;IF SO, QUIT OUT
SCNLU3:	MOVE	T1,P2JFN
	GNJFN%			;STEP JFN
	 ERJMPS	P2DON1		;ALL DONE IF NO MORE
	JRST	SCNLU1

P2DON1:	HRRZ	T1,P2JFN
	RLJFN%			;THROUGH WITH PASS 2 JFN
	 JFCL
P2DONE:	TYPE [ASCIZ/ Pass 2 completed.

/]
	JRST	CPOPJ1		;*ALWAYS* GIVE +2

ARFXBK:	MOVE	T1,P2JFN
	CALL	NXTINC		;TRY TO INSURE NEXT SAVE/INCR GETS IT
	HRLI	T1,.FBBBT(CF%NUD);SET AR%1ST TO ZERO
	MOVX	T2,AR%1ST	;CLEAR JUST THIS BIT (NXTINC DOES T3/ 0)
	CHFDB%
	 JSERRD	<ARFXBK>
	ANDCAM	T2,FDB+.FBBBT
	CALL	NSETSA		;DETERMINE ARSETS= #SETS ARCH INFO
	CAIE	T1,2		;2ND RUN?
	RET			;NO, DONE
	MOVE	T3,FDB+.FBBBT	; Get backup bits
	TXNE	T3,AR%NDL	; Delete on disk not allowed?
	JRST	ARFXB1		; Right, skip delete
	MOVX	T1,DF%CNO!DF%NRJ;Delete disk contents only
	HRR	T1,P2JFN
	DELF%
	 ERJMPS [MOVX	T2,AR%NDL
		IORM	T2, FDB+.FBBBT
		JRST .+1]
ARFXB1:	MOVE	T1,P2JFN	;GET JFN
	MOVX	T2,.ARRAR	;CODE FOR SET/CLEAR ARCH REQUESTS
	MOVE	T4,FDB+.FBBBT
	TXNE	T4,AR%RIV
	MOVEI	T2,.ARRIV	; Migration request
	MOVEI	T3,.ARCLR	; Clear it
	ARCF%
	 ERJMPS	.+1
 IFN FTINVI,<
	TXNN	T4,AR%NDL	;FLUSH NOT ALLOWED?
	TXNN	T4,AR%RAR	; User request the archive?
	JRST	NOINVS
	MOVE	T1,P2JFN
	HRLI	T1,.FBCTL
	MOVX	T2,FB%INV	; Change invisible bit
	MOVE	T3,T2
	CHFDB%			;FLUSHED & USER REQUESTED ARCHIVE
	 ERJMPS .+1		;FAILURE SHOULD NOT BE DISASTROUS
NOINVS: >
 IFE FTUSAG,<
	RET
 >
 IFN FTUSAG,<
	CALL	USAINI		; Init USAGE block here
	HRRZ	T1,P2JFN
	MOVE	T2,[1,,.FBBBT]
	MOVEI	T3,STRING	;GET THIS FILES .FBBBT INTO STRING
	GTFDB%			;GET ENTIRE FDB FOR THIS
	MOVE	T4,DMPFLG
	MOVX	T1,.UTARC	;ASSUME ARCHIVAL
	TXNE	T4,D.MIG	;MIGRATION
	MOVX	T1,.UTMIG
	TXNE	T4,D.COL	;COLLECTION
	MOVX	T1,.UTCOL
	HRRM	T1,USABLK	; Store entry type
	HRRZ	T1,STRING	;Get # pages that were in the file
	MOVEM	T1,USABLK+10
	MOVEI	T1,ARCINF	; Point to tape info blk
	CALL	USATAP		; And spray it into the USAGE blk
	LDB	T2,[POINT 7,STRING,17]	;GET REASON OFFLINE
	MOVEM	T2,USABLK+26	; Add reason code to blk
	HRRZ	T2,P2JFN	; JFN of file in question
	HRROI	T1,USASTR	; Structure of the file
	MOVX	T3,1B2
	JFNS%
	HRROI	T1,USADIR
	MOVX	T3,1B5
	JFNS%
	MOVE	T1,T2		; JFN
	HRROI	T2,USAACT	; Account of the file
	GACTF%
	 JRST	GDONBE		;FAILED, OH WELL
	JRST	GDONBE		;WORKED, FINE
	MOVEM	T2,USABLK+2	;NUMERIC RESULT, SAY SO
	MOVX	T2,US%IMM
	IORM	T2,USABLK+1
GDONBE:	MOVE	T1,[POINT 7,USASTR]
	CALL	ASCSIX		;CONVERT TO 6BIT
	MOVEM	T2,USASSI
	MOVEI	T1,.USENT
	MOVEI	T2,USABLK
	USAGE%
	 ERJMPS	.+1
	RET

USAINI:	MOVE	T1,[VUSABL,,USABLK]
	BLT	T1,USABLK+NUSABL-1
	RET

;Drop tape info into USAGE blk.  T1 should point to ARCF style block.
USATAP:	MOVE	T2,.ARTP1(T1)	;TAPE 1 ID
	MOVEM	T2,USABLK+12
	HLRZ	T2,.ARSF1(T1)	;SAVESET NUMBER (TSN)
	MOVEM	T2,USABLK+14
	HRRZ	T2,.ARSF1(T1)	;FILE NUMBER (TFN)
	MOVEM	T2,USABLK+16
	MOVE	T2,.ARTP2(T1)	;TAPE 2 ID
	MOVEM	T2,USABLK+20
	HLRZ	T2,.ARSF2(T1)
	MOVEM	T2,USABLK+22
	HRRZ	T2,.ARSF2(T1)
	MOVEM	T2,USABLK+24
	RET

VUSABL:	USENT. (.-.,1,0)	; Type to be filled in, version
	USACT. (USAACT,,^D39)	;  Account string
	USSSI. (USASSI)		;  Structure name
	USDIR. (USADIR,,^D39)	;  Directory name
	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
 >

;Call with JFN in T1.  Tries to insure file is picked up on next incremental.
NXTINC:	PUSH	P,T1		;SAVE JFN
	HRLI	T1,.FBBK0(CF%NUD);NO IMMEDIATE UPDATE
	MOVSI	T2,377777	;RESET COUNT OF TIMES TAPED..
	SETZ	T3,		;TO ZERO
	CHFDB%
	 ERJMP	.+1		;OH WELL
	POP	P,T1		;RESTORE JFN AND LEAVE
	RET
	SUBTTL	Tape Output

;Here with a pointer to a header block in T1 and a 1000 word data buffer in T2.
; This adds the record represented by the above two pointers to the output
; list.
;Call INIREC once before calling this.
;ADDREC and friends all assume that MTJFN and friends are set up and valid.
; ie, they just take the JFN from MTJFN and don't call GMTJFN unless they
; run out of tape. Returns T1 and T2 as pointers to Header and 1000 word buffer
; and T3 as number of logical records that can still fit in this physical
; record.
;ADDREC maintains the value of INFILE
ADDREC:	DMOVEM	T1,ADDTMP
	CALL	TSTINT
	 JRST	BAKOUT		;ABORTING!
	TXO	F,F.NORD+F.BLKF	;MAYN'T READ OR CHANGE BLOCKING FACTOR
	SKIPG	BLKCNT		;TIME FOR A NEW BUFFER YET?
	CALL	ADDCHI		;YES, ADD CURRENT BUFFER TO CHAIN & DO OUTPUT
	MOVE	T1,ADDTMP	;POINTER TO HEADER BLOCK
	TXNN	F,F.INTR	;IF INTERCHANGE, LET ICONCV DO SEQUENCE NUMBERS
	TXNE	F,F.NSEQ	;SEQEUNCING IN EARNEST?
	TDZA	T4,T4		;NO SEQUENCE NUMBER IF N.SEQ OR F.INTR
	AOS	T4,WRISEQ	;DO NORMAL SEQUENCING
	MOVEM	T4,.SEQ(T1)	;PUT IN THE SEQUENCE NUMBER
	MOVE	T4,TAPENO	;GET THE TAPE NUMBER
	HRL	T4,SAVENO	;GET THE SAVESET NUMBER
	OR	T4,SAVETP	;AND THE SAVESET TYPE
	MOVEM	T4,.TAPNO(T1)	;PUT IT ALL IN
	DMOVE	T3,ADDTMP	;POINT TO HEADER & DATA
	SETZM	.CHKSM(T3)	;NO CHECKSUM YET
	MOVN	T1,.TYP(T3)
	MOVEM	T1,LASTYP	;STORE FOR DEBUGGING
	CAIN	T1,FILEST	;IF A CONTST WOULD REQUIRE A BOGUS FILEST..
	SETOM	INFILE		;MARK THE FACT
	CAIN	T1,FILEEN	;ENDING FILE?
	SKIPGE	.PAGNO(T3)	;NOT IF CONTINUED FLAG LIT
	TRNA
	SETZM	INFILE		;CLEAR THE FLAG
	TXNE	F,F.INTR	;INTERCHANGE DOES IT DIFFERENTLY
	JRST	[CALL	DMPICO
		 JRST	WRINTR]	;RECORD TRANSLATED, GO DECREMENT COUNT TO 0
 IFN FTCHKS,<
	MOVX	T1,FL.HIS
 >
 IFE FTCHKS,<
  IF1,<PRINTX DUMPERs previous to v500 cannot read the tapes this DUMPER writes>
	MOVX	T1,FL.NCK+FL.HIS
 >
	MOVEM	T1,.FLAG(T3)	;SET HIST. FLAGS (& NO CHECKSUM HERE IF NEEDED)
 IFN FTCHKS,<
	CALL	CHKSUM		;COMPUTE CHECKSUM
	SETCAM	T1,.CHKSM(T3)	;STORE RESULT
 >
	HRLZ	T3,T3
	HRR	T3,BLKPNT	;T3/ POINTER TO DATA,,WHERE IT GOES
	MOVEI	T4,5(T3)	;WHERE TO STOP
	BLT	T3,(T4)		;IN GOES THE HEADER
	MOVEI	T3,1(T4)
	HRL	T3,ADDTMP+1	;T3/ POINTER TO 1000 WORD DATA,, WHERE IT GOES
	MOVEI	T4,777(T3)	;WHERE TO STOP
BLTING:	BLT	T3,(T4)		;IN GOES THE 1000 WORD DATA
	ADDI	T4,1
	MOVEM	T4,BLKPNT	;WHERE NEXT DATA WOULD GO
WRINTR:	SOS	T3,BLKCNT	;LESS ONE LOG RECORD, RETURN # LEFT
	DMOVE	T1,ADDTMP	;RETURN WHERE HEADER, 1000 BFR IN T1,T2
	RET			;RECORD STORED, GO ON

;Here to set up a new phys. record (and dump one already set up, if any).
ADDCHI:	SKIPN	CURBLK		;DO WE HAVE A RECORD?
	JRST	NOTDMP		;NO, GET GET A RECORD AND GO BACK
	CALL	ADDCHA		;ADD NEW PHYS. REC. ONTO THE CHAIN
 IFG <REEVAL>*<FTVERS-5>,<	;;ONLY IF REEVAL .GT. 1 & V6 OR LATER MONITOR
	AOS	BFRCNT
	AOS	BFRCNI
	CALL	CHKBLK		;WOULD OUTPUT BLOCK NOW?
	JUMPE	T3,IDLE		;NO. WE BLEW IT. GO DO SOME OUTPUT.
				;DRIVE IS STILL BUSY.  GOOD.
	SOSLE	SAFECT		;SHOULD WE JUST BLOCK?
	JRST	NOTDMP		;SHOULD BE ABLE TO SQUEEZE ANOTHER BUFFER
	MOVE	T1,BFRCNT
	IDIVI	T1,REEVAL	;THE REEVAL-TH BUFFER?
	JUMPN	T2,NOMEM	;NO
	MOVX	T1,<1B1>
	MOVEM	T1,BFRCNI	;THIS REPRESENTS BRAVERY
	JRST	DODMP		;WE'D BETTER DO I/O NOW
IDLE:	MOVE	T1,BFRCNI	;HOW MANY CAUSED AN IDLE?
	SUBI	T1,1
	MOVEM	T1,SAFECT	;THAT MANY SHOULD BE SAFE
NOMEM:	SETZM	BFRCNI		;AND START COUNTING AGAIN
 > ;END IFG REEVAL
DODMP:	CALL	DOOUT		;WRITE OUT A PHYSICAL RECORD
	SKIPN	EOTLCK
	TXNN	F,F.EOT		;OUT OF TAPE?
	JRST	NOTDMP		;NO, RUN ON NORMALLY
;Here when, after writing a record, we discover that we are very near
; the end of the tape.  It's time to write a "to next tape" record and
; put up the next tape if possible.
ATEOT:	SETOM	EOTLCK		;SAY DOING THIS CODE (F.EOT MEANINGLESS)
	HRLZ	T1,ADDTMP	;TUCK HEADER AWAY
	HRRI	T1,SAVHEA
	BLT	T1,SAVHEA+NHEAD-1
	CALL	WAITFN		;MAKE SURE LSTDMP GETS WRITTEN
	SKIPE	T1,LSTDMP	;AND DELETE IT
	CALL	RELPGT
	SETZM	LSTDMP		;..
	PUSH	P,ENDPNT	;SAVE CHAIN HEAD AND TAIL, STARTING NEW CHAIN
	PUSH	P,DMPCHA	;NEW CHAIN CONTAINS TONEXT
	PUSH	P,WRISEQ	;SAVE SEQ
	PUSH	P,ADDTMP
	PUSH	P,ADDTMP+1	;SAVE HEADER POINTERS
	TXO	F,F.NSEQ
	SETZM	DMPCHA		;SAY "EMPTY CHAIN"
	HRROI	T1,-TONEXT
	MOVEM	T1,TAPHEA+.TYP	;RECORD OF TYPE "TO NEXT TAPE"
	MOVEI	T1,TAPHEA
	MOVEI	T2,SCRBUF
	CALL	ADDREC		;ADD THE "TO NEXT TAPE" RECORD
	CALL	FILBLK		;ADD FILLERS, STOP TAPE
	HRROI	T1,-TAPEEN	;FOR READAHEAD AND OLD DUMPERS
	MOVEM	T1,TAPHEA+.TYP
	MOVX	T1,PG.CON!PG.NFN;"TO NEXT TAPE" & "NO FILE #" FOR OLD DUMPER
	MOVEM	T1,TAPHEA+.PAGNO
	MOVEI	T1,TAPHEA
	MOVEI	T2,SSNBUF
	CALL	ADDREC		;ADD RECORD PRESERVING OUR VALUE IN .FLAG
	CALL	FILBLK
	IFLAB	NOEOTW		;IF LABELED, DON'T WRITE EOT
	CALL	WRIEOF		;EOF AND..
	CALL	WRIEOF		;EOF AGAIN FOR EOT (FOR OTHER SOFTWARE)
NOEOTW:	SKIPE	LSTJFN		;GOT A LIST FILE?
	CALL	NTLIST		;YES, DO STUFF FOR NEXT TAPE
	AOS	T1,NVOLID	;HOW MANY EXTRA VOLIDS? FOR PASS2A
	MOVE	T2,VOLID6
	MOVEM	T2,VOLID6(T1)	;COPY INTO SLOT
	CALL	NXTTAP		;GET THE NEXT TAPE UP! (CHANGES MANY THINGS)
	CALL	GMOJFO		;INSURE WE GOT A TAPE OF SOME KIND
	 JRST	BAKOUT		;WE CAN'T - VERY BAD!
	CALL	MTBOT		;AT BEGINNING OF NEW TAPE
	MOVE	T1,MTJFN	;FOR GETVOL
;**;[540] INSERT 1 LINE AT NOEOTW:+12.L	DSW	4/28/86
	SKPMTA			;[540] DON'T GET VOLID IF ASSIGNED TAPE
	CALL	GETVOL		;DISCOVER NEW VOLUME NAME
	CALL	PROVOL		;MAKE SURE WE HAVE ONE
	CALL	ANEWT		;ANNOUNCE NEW TAPE UP
	CALL	CONHEA		;WRITE THE CONTINUED TAPE HEADER
	SKIPN	INFILE		;NEED A BOGUS FILEST HERE?
	JRST	NOFILB
	HRROI	T1,-FILEST
	MOVEM	T1,TAPHEA+.TYP	;YES, SET ONE UP
	MOVX	T1,PG.CON!PG.NFN
	MOVEM	T1,TAPHEA+.PAGNO;SAY CONTINUED
	MOVEI	T1,TAPHEA	;..
	MOVEI	T2,FDBBUF	;IF INFILE=-1, THIS SHOULD STILL BE CORRECT
	CALL	ADDREC		;WRITE IT
NOFILB:	CALL	FILBLK		;PAD THE RECORD, DUMP IT
	TXZ	F,F.NSEQ	;BACK TO NORMAL SEQUENCE NUMBERING
	POP	P,ADDTMP+1
	POP	P,ADDTMP	;RESTORE HEADER/BUFFER POINTERS
	POP	P,WRISEQ	;BACK TO NORMAL SEQUENCE NUMBER
	POP	P,DMPCHA	;NOW CONTINUE THE OLD CHAIN
	MOVSI	T1,SAVHEA	;RESTORE SAVED HEADER
	HRR	T1,ADDTMP
	MOVEI	T2,NHEAD-1(T1)
	BLT	T1,(T2)		;..
	TXNE	F,F.INTR	;IF INTERCHANGE, DON'T FIX TAPE NUMBERS
	JRST	EFIXTN		;..
	MOVX	T3,FL.NCK	;CHANGING CHECKSUMS, SET THIS
	SKIPA	T1,DMPCHA	;FOR EACH ELEMENT IN THE CHAIN
FIXTPN:	MOVE	T1,NXTBUF(T1)	;(FOR NEXT ELEMENT)
	JUMPE	T1,EFIXTN	;IF IT EXISTS...
	MOVEM	T1,FIXTMP	;SAVE IT FOR ADVANCING LATER
	MOVE	T2,WRIBKF	;AND FOR EACH LOG. BUFFER IN EACH ELEMENT..
FTAPNO:	AOS	DATAST+.TAPNO(T1) ;UP THE TAPE NUMBER
	IORM	T3,DATAST+.FLAG(T1) ;TURN OFF CHECKSUMMING
	SETZM	DATAST+.CHKSM(T1) ;CLEAR FOR GOOD MEASURE
	ADDI	T1,NHEAD+1000	;AND ADVANCE TO NEXT LOG. BUFFER
	SOJG	T2,FTAPNO	;AND WHEN NO MORE LOGICAL BUFFERS
	MOVE	T1,FIXTMP	;RESTORE THE ELEMENT
	JRST	FIXTPN		;AND TRY TO ADVANCE TO THE NEXT ONE
EFIXTN:	POP	P,ENDPNT
	SETZM	EOTLCK		;EOT GONE NOW
	 ;AND CONTINUE CALL TO GET THE NEW BUFFER FOR CALLER
NOTDMP:	MOVE	T1,BUFPAG	;# OF PAGES NEEDED TO HOLD A PHYS. RECORD
	CALL	GETPGS
	 JRST	DODMP		;NO MEMORY, START WRITING BUFFERS
	MOVEM	T2,CURBLK	;THE BLOCK WE ARE WORKING ON NOW
	ADDI	T2,DATAST
	MOVEM	T2,BLKPNT	;WHERE TO START STORING DATA FOR TAPE
	MOVE	T1,WRIBKF	;NUMBER OF LOG. RECORDS THAT WILL FIT
	MOVEM	T1,BLKCNT
	RET

ADDCHA:	MOVE	T2,CURBLK	;TAKE THE BLOCK WE JUST FINISHED
	SKIPN	DMPCHA		;ARE THERE BUFFERS QUEUED?
	JRST	ADDCH1		;NO, GO SET DMPCHA AND ENDPNT
	MOVE	T3,ENDPNT	;GET THE END POINTER
	MOVEM	T2,NXTBUF(T3)	;AND ADD NEW BLOCK IN
	JRST	.+2		;GO SET ENDPNT
ADDCH1:	MOVEM	T2,DMPCHA
	MOVEM	T2,ENDPNT	;NEW BLOCK IS THE END POINT
	SETZM	CURBLK		;WE HAVE NO CURRENT BLOCK NOW
	RET

;These write the first buffer on the list (DMPCHA) out.  Errors are handled.
; They return when the buffer is queued for output, with the buffer so queued
; in T1.  This deletes buffers that have gotten out to tape safely.
DOOUT:	SKIPA	T2,[DM%NWT+RECCMD]
DOOUB:	MOVEI	T2,RECCMD
	SKIPN	T1,DMPCHA	;SET UP TO WRITE 1ST QUEUED BUFFER
	RET			;CHAIN IS EMPTY; WHY WERE WE CALLED?
	ADDI	T1,DATAST-1	;POINTER TO THE DATA, LESS ONE
	HRRM	T1,RECCMD	;THE LH HAS THE NEG. COUNT ALREADY
	TXO	F,F.NBOT	;NOT AT BOT ANYMORE
	MOVE	T1,MTJFN
	DUMPO%
	 ERJMPR	WRIERR		;SOMETHING WENT WRONG SOMEWHERE
IGNERR:	MOVE	T1,DMPCHA	;GET ENTRY JUST DUMPED
	EXCH	T1,LSTDMP	;STORE AS LAST DUMPED; GET LAST DUMPED
	CAIE	T1,0		;WAS THERE A LAST DUMPED RECORD?
	CALL	RELPGT		;YES, IT'S SAFELY OUT TO TAPE, DELETE IT
;Note RELPGT, not REPLGS.  The only difference is that, if there is any
; "type me at delete time" text in the buffer, it gets typed.
	MOVE	T1,DMPCHA	;NOW ADVANCE DMPCHA ONE
	MOVE	T2,NXTBUF(T1)	;..
	MOVEM	T2,DMPCHA	;..
	SETZM	FILIOC		;SAY "DID SOME TAPE OUTPUT"
	RET			;AND DONE
WRIERR:	CALL	TSTINT		;TRYING TO STOP?
	 JRST	BAKOUT		;HE ABORTED
	CAIN	T1,DUMPX3	;CAN'T PROCESS REQUEST?
	 ERROR	<Not enough monitor space for this BLOCKING-FACTOR>
	CAIN	T1,OPNX8	;OFFLINE?
	 JRST	OFFLIN		;GO HANDLE
	PUSH	P,T1		;SAVE THE ERROR CODE
	CALL	XGDSTS		;STATUS INTO T2
	POP	P,T1		;GET CODE BACK
	TXNE	T2,MT%ILW	;WRITE ON WRITE LOCKED DRIVE?
	 JRST	WRIPRO		;YES, GO HANDLE
	TXNE	T2,MT%DVE	;OFFLINE?
	 JRST	OFFLIN
	TXNE	T2,MT%EOT	;EOT WARNING?
	 JRST	EOTWRN		;YES, REMEMBER THE WARNING
	TXNE	T2,MT%DAE	;DEVICE/DATA ERROR THAT WAY
	 JRST	DATERR
	TXNE	T2,MT%NSH
	ERROR	<Illegal data mode or density for this controller>
;**;[543] Change one line at EOTWRN:-1:		DEE	20-NOV-86
	JSERRD <Fatal DUMPO% error>,BAKOUT,JRST ;[543]DON'T IGNORE DUMPO ERROR

EOTWRN:	CALL	CLRERR
	TXON	F,F.EOT		;FLAG WE'VE SEEN THIS
	JRST	DOOUB		;IT'S NEW, REDO LAST REQUEST
	JRST	IGNERR		;WE KNOW ALREADY, JUST GO ON

OFFLIN:	CALL	OFFLNE
	JRST	ERRGO

;**;[544]Change one line at OFFLNE:+1L		DEE	2-24-87
;**;[546]Change 1 line at OFFLNE:1L		DEE	1-APR-87
;**;[547]Add one line at OFFLNE:+1L		DEE	2-Apr-87
;**;[553] Rework OFFLNE:                      	DEE	28-Aug-88
OFFLNE:	CALL	CLRERR
	WARN	<>		;[553] Need a % sign
;**;[555] Change one line at OFFLNE+2		GAS	20-Sep-88
	HRROI	T1,[ASCIZ/Tape went offline or encountered device error/] ;[555]
	JRST	TRYAGA		

WRIPRO:	IFMTA	WRLMTA		;MTA WE HANDLE OURSELVES
	ERROR	<Tape is write protected.
>,.+1
	TYPE	[ASCIZ\ DISMOUNT tape and MOUNT it again with /WRITE-ENABLE\]
	JRST	BAKOUT		;HIGHLY FATAL
WRLMTA:	HRROI	T1,[ASCIZ/Tape is WRITE-PROTECTED/]
	CALL	TRYAGA
	JRST	ERRGO

ERRGO:	CALL	CLRERR
	SKIPN	T1,LSTDMP
	MOVE	T1,DMPCHA
	JRST	ERRGO2
DATERR:	CALL	CLRERR		;STOP TAPE, CLEAR ERRORS
	SKIPN	T1,LSTDMP	;REDO THE LAST BUFFER
	MOVE	T1,DMPCHA	;THERE ISN'T ONE? THEN VERY FIRST ATTEMPT FAILED
	WARN	<Data write error in record >
	MOVE	T2,DATAST+.SEQ(T1)
	CALL	DECOUT
	AOS	T2,ERRCNT(T1)	;HOW MANY TIMES HAS THIS FAILED?
	MOVEI	T3,^D14
	TXNE	F,F.EOT		;BEFORE OR AFTER PHYS EOT?
	MOVEI	T3,^D4		;AFTER, ALLOW LESS RETRIES
	CAIL	T2,(T3)		;BAD PROBLEMS WRITING TAPE?
	JRST	[WARN	<Excessive retries in writing record, continuing...>
		 JRST	DOOUT]	;ASSUME ONE WILL BE READABLE, AND GO ON
ERRGO2:	ADDI	T1,DATAST-1	;BUILD THE IOWD STUFF
	HRRM	T1,RECCMD
	MOVE	T2,[DM%NWT+RECCMD]
	MOVE	T1,MTJFN	;OK, WRITE THE FAILED RECORD
	DUMPO%
	 ERJMPR	WRIERR		;TRY AGAIN, THEN
	JRST	DOOUT		;AND TRY TO GET CHAIN GOING AGAIN

;Here to get next tape
NXTTAP:	AOS	TAPENO
NXTTPE:	CALL	IFCRL2
	TYPE	<[ASCIZ/ [ At End of tape /]>
;**;[538] At NXTTPE:+2L, Replace 2 lines with 9		SM	31-Jan-86
	MOVE	T2,TAPENO	;[538] Set up to type old tape number
	SUBI	T2,1		;[538] Account for increment above
	CALL	DECOUT		;[538] Spew it
	SKIPN	VOLID		;[538] Do we have a real volid?
	JRST	TYNVOL		;[538] No, no need to type it
	TYPE	[ASCIZ/ (/]	;[538] Yes, paren it so it stands out
	TYPE	VOLID		;[538] type it
	TYPCHR	")"		;[538] close paren
TYNVOL:	TYPE	[ASCIZ/ at /]	;[538] OK, lead in to current time
	SETO	T2,
	CALL	TADOUT
	TYPE	<[ASCIZ/ ] /]>
	SETZM	REASEQ
	SETZM	LSTSEQ
	SETZM	WRISEQ
	SETZM	REABKF
	IFMTA	NXTTPR
	TYPE	<[ASCIZ/[ Requesting next tape volume ]/]>
NXTTPR:	DISPAT	NXTMTA,NXTUMT,NXTLMT	;MTA, UNLABELED MT, LABELED MT
NXTMTA:	CALL	UNLMTA		;UNLOAD THE CURRENT TAPE
	PUSH	P,OPNFOR	;REMEMBER MODE OPENED IN
	CALL	DRPTAP		;CLOSE CURRENT TAPE
	CALL	REQMTA		;GET THE NEW TAPE REQUESTED
	 JRST	[TXNE	F,F.ABT
		 JRST	BAKOUT
		 JRST	NXTTPR]	;CAN'T GET NEW TAPE
	POP	P,OPNREQ	;RESTORE MODE AS REQUEST
	CALL	GMOJFQ		;AND REOPEN THE WAY IT WAS
	 JRST	[TXNE	F,F.ABT	;DID USER ABORT?
		 JRST	BAKOUT	;YES, JUST BUGOUT
		 JRST	NXTTPR]	;CAN'T!
	JRST	NVURFS		;CLEAR ERROR AND RETURN
NXTLMT:	MOVE	T1,OPNFOR	;OPEN FOR READ OR WRITE?
	TXNN	T1,OF%WR	;..?
	JRST	NVURFS		;READ, JUST GO ON, VOL SWITCH IS AUTOMATIC
	MOVEI	T3,[EXP 2,.VSFLS] ;DO THE VOL SWITCH WE DEFFERED
	JRST	NXTQMT
NXTUMT:	MOVEI	T3,[EXP 3,.VSMRV,1] ;ARG LIST TO GET TO NEXT VOLUME
NXTQMT:	MOVE	T1,MTJFN	;GET JFN
	MOVEI	T2,.MOVLS	;VOLUME-SWITCH MTOPR FUNCTION CODE
	MTOPR%
	 JSERRD	<Can't switch to next tape volume>,MTCLS
NVURFS:	CALL	MTBOT
	TYPE	CRLF
	JRST	CLRERR		;CLEAR ERRORS AND RETURN

;Set up before calling ADDREC for the first time this command.
INIREC:	MOVEI	T1,1006		;SIZE OF DUMPER RECORD
	TXNE	F,F.INTR
	MOVEI	T1,1040		;INTERCHANGE RECORDS ARE LARGER
	IMUL	T1,WRIBKF
	MOVN	T2,T1
	HRLZM	T2,RECCMD	;-SIZE OF PHYS. RECORD,,0
	ADDI	T1,DATAST+1	;HOW BIG A BUFFER DO WE NEED?
	MOVEI	T2,1(T1)	;POINT TO UNUSED SPACE IN BUFFER
	MOVEM	T2,BUFFRE	;SAVE FOR USE WITH STRINGS
	LSH	T1,-9		;DIVIDE BY 1000 FOR PAGE COUNT
	ADDI	T1,1		;AND ONE TO COVER REMAINDER
	MOVEM	T1,BUFPAG	;STORE NUMBER OF PAGES FOR USE WITH GETPGS
	MOVX	T1,<1B1>	;LARGE POSITIVE NUMBER
	MOVEM	T1,BFRCNI	;INIT THE "OUTPUT CLEVERNESS" CODE
	SETZM	EOTLCK		;NOT AFTER EOT
	SETZM	CURBLK		;NO CURRENT BUFFER YET
	SETZM	LSTDMP		;NO LAST BUFFER
	SETZM	BLKCNT		;NO LOG. REC'S MADE YET
	CALL	KILCHN
	TXO	F,F.NORD	;MAY NOT READ UNTIL REWIND NOW
	SETZM	BFRCNT		;SAY NONE OUTPUT YET
	SETZM	NVOLID		;NO EXTRA VOLIDS KNOWN YET
	SETZM	FILIOC		;SAY NO FILES EXAMINED YET
	MOVE	T1,REASEQ	;GET A SEQUENCE NUMBER THAT ISN'T LIKE PREVIOUS
	CAMGE	T1,WRISEQ
	MOVE	T1,WRISEQ	;TAKE MAX(REASEQ,WRISEQ,LSTSEQ)
	CAMGE	T1,LSTSEQ
	MOVE	T1,LSTSEQ
	JUMPE	T1,IN2REC	;FIRST REC# CAN BE 1
	ADDI	T1,MAXBKF+1	;INSURE GREATER THAN LAST RECORD, AND..
	TRO	T1,0777		;ROUND UP BY 1000, LESS 1
IN2REC:	MOVEM	T1,WRISEQ	;THIS IS INCREMENTED BEFORE USE
	RET


;Here to fill out the current record with null records and dump the whole
; chain.  This should return with the tape fully written and stopped.
FILBLK:	SKIPN	BLKCNT		;IS THE CURRENT RECORD FULL?
	JRST	ADDCUR		;FINE, ADD IT IF IT EXISTS
	HRROI	T1,-FILL
	MOVEM	T1,TAPHEA+.TYP	;HEADER OF TYPE FILL
FILBL2:	MOVEI	T1,TAPHEA	;POINTER TO FILLER RECORD
	MOVEI	T2,SCRBUF	;MEANINGLESS PAGE ADDRESS
	CALL	ADDREC		;PUT IT IN
	JUMPG	T3,FILBL2	;GO UNTIL FULL
ADDCUR:	SKIPE	CURBLK		;IS THERE A CURRENT BLOCK?
	CALL	ADDCHA		;ADD IT IN
DMPREM:	SKIPN	T1,DMPCHA	;ANYTHING IN THE CHAIN?
	JRST	FILDNE		;NO, FINISH UP
	CALL	TSTINT
	 JRST	BAKOUT
	CAMN	T1,ENDPNT	;ABOUT TO WRITE THE LAST RECORD?
	JRST	DMPFNL		;YES, DIFFERENT
	CALL	DOOUT		;OUT THE NEXT IN THE LIST
	JRST	DMPREM
DMPFNL:	CALL	DOOUB		;BLOCK FOR THE LAST WRITE
	MOVE	T1,ENDPNT
	CALL	RELPGT		;LAST RECORD SAFELY ON TAPE, KILL IT.
	SETZM	DMPCHA		;CHAIN IS EMPTY
FILDNE:	SETZM	CURBLK		;NO CURRENT BLOCK
	SKIPE	T1,LSTDMP
	CALL	RELPGS
	SETZM	LSTDMP
	RET
	SUBTTL	Tape Input

;GETREC returns T1/ addr of header T2/ addr of 1000 word buffer T3/ positive
; record type.  +1 always (dispatches to BAKOUT on serious errors).
;The following flags are used here:
; F.NORD - no reading is done (dispatch to GETOUT);  F.INTR - convert from
;   BACKUP mode;  F.BACK - reading backwards, errors are different;
; F.FAKE - set internally, fake record made up;  F.NSEQ - no checksumming done
; F.NVOL - no volume switching done, return TONEXT if seen.
; If reading backwards, TAPEEN and TONEXT are ignored.
SKPREC:	TXZ	F,F.FAKE
GETREC:	CALL	TSTINT		;INTERRUPT? GO HANDLE
	 JRST	BAKOUT		;USER DECIDED TO ABORT
	TXNE	F,F.NORD	;IS READING OK?
	JRST	[CALL	IFCRL2	;NO, ABORT THE COMMAND
		 TYPE	[ASCIZ/ End of tape./]
		 JRST	GETOUT]	;THIS IS QUITE LIKE BAKOUT
	SKIPN	REABKF		;FIRST TIME?
	JRST	FIRREA		;YES, GO DO FIRST READ
	SOSGE	BLKCNT		;ANY MORE RECORDS IN THIS BUFFER?
	JRST	ADVCHI		;GO IN A PHYS RECORD
	MOVE	T4,BLKPNT	;GET THE CURRENT POINTER
	MOVEM	T4,CURHEA	;SAVE
	TXNE	F,F.FAKE
	JRST	[SETZM	BLKCNT	;ONLY ONE LOG. RECORD HERE
		 JRST	NORINR]	;AND ITS NEVER INTERCHANGE FORMAT
 IFN FTIND,<
	TXNE	F,F.36MD	;INDUSTRY MODE CONVERSION NEEDED?
	CALL	W36CNV		;YES, GO TO IT
 >
	TXNN	F,F.INTR	;INTERCHANGE MODE?
	JRST	NORINR		;NO, FINE
	TXNN	F,F.CIRC	;YES, GOT A CONVERTED BUFFER ALREADY?
	JRST	[CALL	INTDMC	;NO, DO THE %$#@?! CONVERSION NOW
		  JRST	ADVCHI	;NEED NEXT BUFFER
		 JRST	SKPREC]	;GOT IT, REPROCESS
NORINR:	MOVEI	T4,6(T4) 	;NO, GET ADDRESS OF DATA...
	MOVEM	T4,CURDAT 	;STORE IT
	MOVEI	T4,1000(T4) 	;AND ADVANCE THE POINTER THIS WAY
	MOVEM	T4,BLKPNT
	MOVE	T1,CURHEA	;FETCH OUR HEADER
	MOVN	T2,.TYP(T1)	;FETCH THE TYPE
	CAIL	T2,0
	CAILE	T2,MAXTYP	;LEGAL?
	JRST	[WARN	<Bad record type>
		 CALL	ANNSEQ
		 JRST	SKPREC]
	MOVEM	T2,LASTYP
	JRST	@[EXP CHKCKS,SVSETC,FILSTC,OLDNXT,TAPSTP,CHKCKS
		  EXP SVSETA,TAPFIL,JMPTAP](T2)
SVSETA:	PUSH	P,T1
	MOVE	T1,MTJFN
;**;[540] INSERT 1 LINE AT SVSETA:+2.L	DSW	4/28/86
	SKPMTA			;[540] DON'T GET VOLID IF ASSIGNED TAPE
	CALL	GETVOL		;MAKE SURE WE KNOW THIS
	POP	P,T1
;Here on a SAVESET header read
SVSETC:	MOVE	T3,CURDAT
	MOVE	T4,SV.FMT(T3)	;FETCH FORMAT NUMBER
	TLNN	T4,-1		;CHECK FOR LEGALITY
	CAIGE	T4,4		;..
	 JRST	[WARN	<Illegal value for FORMAT, assuming 4>
		 MOVEI	T4,4
		 JRST	.+1]
	MOVEM	T4,FORMAT	;SAVE IT
	MOVE	T3,CURHEA
	MOVE	T3,.TAPNO(T3)
	HRRZM	T3,TAPENO	;SAVE TAPE NUMBER
	HLLZ	T4,T3		;COPY TO GET SAVE TYPE BITS
	TLZ	T4,077777	;CLEAR SAVESET NUMBER
	MOVEM	T4,SAVETP	;STORE SAVEST TYPE
	LDB	T4,[POINT 15,T3,17]
	MOVEM	T4,SAVENO	;SAVESET NUMBER
	CAIE	T4,0		;0 MEANS MUNDANE TAPE TYPE
	MOVEM	T4,ARCTSN	;ARCHIVE SAVESET NUMBER, LAST SEEN
	JRST	CHKCKS
;Here on a FILEST.  We copy the filename to LSTSEN for ^A.
FILSTC:	MOVEI	T3,LSTSEN
	HRL	T3,CURDAT
	BLT	T3,LSTSEN+FDBOFF-1
	JRST	CHKCKS
;Here on a FILL.  It could be an EOF mark (F.EOF lit), meaning end of saveset,
; or it could be trash, meaning the rest of the record is null.
TAPFIL:	TXNE	F,F.EOF		;EOF?
	JRST	CHKCKS		;YES, PASS IT BACK (IT'S SAVEEN)
TOSREC:	SETZM	BLKCNT		;NO, REST OF RECORD IS TRASH
	JRST	SKPREC		;SO TOSS IT
;Here on a tape end record - back up to before it
TAPSTP:	TXNE	F,F.BACK	;READING BACKWARDS?
	JRST	TOSREC		;YES, FINE, GO ON
	SKIPGE	.PAGNO(T1)	;IS THIS A KIND OF TONEXT?
	JRST	OTHNXT		;YES, TREAT IT AS SUCH
	TXO	F,F.NORD	;NO, NO MORE READS
	DMOVEM	T1,GEITMP	;SAVE T1 AND T2
	CALL	WAITFN		;WAIT TILL WE HIT END RECORDS
	IFLAB	NOBACK		;IF LABELED, THE READ PUT US 'TWEEN EOF+EOT
	CALL	BACKSP		;NOT, BACK OVER EXTRA RECORD
	CALL	BACKSP		;BACK OVER TAPPEN RECORD
NOBACK:	DMOVE	T1,GEITMP
	JRST	CHKCKS		;RESTORE T1 AND T2
;Here on a File end record - old DUMPERs did TONEXT this way
OLDNXT:	SKIPL	.PAGNO(T1)	;SEE IF "CONTINUE" LIT
	JRST	CHKCKS		;NO, GO ON
OTHNXT:	MOVEI	T2,TONEXT	;YES, ITS A TONEXT RECORD
	MOVEM	T2,LASTYP
;Here on a TONEXT record - either return record or get next tape
JMPTAP:	TXNE	F,F.BACK	;READING BACKWARDS?
	JRST	TOSREC		;YES, IGNORE THIS UTTERLY
	TXZN	F,F.NVOL	;DID HE SAY "DON'T VOLSWITCH?"
	JRST	UPTAPE		;NO, GO TO IT
;Here after processing by record type
CHKCKS:	TXZE	F,F.EOF		;SEE EOF THAT TIME?
	TXOA	F,F.OEOF	;YES, SAY LAST WAS EOF
	TXZ	F,F.OEOF	;NO, SAY NOT
	TXZE	F,F.FAKE
	JRST	GETRET		;ITS A FAKE RECORD, SKIP THE REST
	MOVE	T1,CURHEA
	MOVE	T4,.TAPNO(T1)	;DO WE KNOW THE TAPE NUMBER?
	SKIPG	TAPENO
	HRRZM	T4,TAPENO	;WE DO NOW
 IFN FTCHKS,<
PAT04A:	DMOVE	T3,CURHEA	;GET CURHEA AND CURDAT
	MOVE	T1,.FLAG(T3)	;WAS THIS RECORD CHECKSUMMED?
	TXNN	F,F.BACK+F.INTR+F.NSEQ	;NO CHECKSUM WHEN BACKING UP OR INTR.
	TXNE	T1,FL.NCK	;OR ASKED NOT TO BY WRITER OF TAPE
	JRST	GETRET		;SKIP CHECKSUM
	CALL	CHKSUM		;DO THE CHECKSUM
	JUMPE	T1,GETRET	;0 IF OK
	WARN	<Bad checksum>
	CALL	ANNSEQ		;ANNOUNCE ERROR
 >
GETRET:	CALL	TSTINT		;HANDLE ^E INTERRUPT
	 JRST	BAKOUT		;ABORTED!
	DMOVE	T1,CURHEA	;GET ADDRESSES
	MOVE	T3,LASTYP	;AND TYPE
	RET			;AND DONE

;First time code.  We purposely read a record with a huge count to force a
; "wrong count" error, since that way we can determine the record size.  This
; tells us if it's a DUMPER tape, BACKUP tape, or nonsense tape, and also gives
; us the blocking factor.  We also try to deal with bypassed labels on tapes
; here.  An error on reading the 1st record is bad news, since so much depends
; on it, hence we have separate error routines for this part.
FIRREA:	MOVEI	T1,<DATAST+1+MAXBKF*1006>/1000+1
				;NUMBER OF PAGES FOR MAX RECORD
	CALL	GETPGS		;GET THAT MANY
	 JRST	NOFREE		;NOT POSSIBLE
	EXCH	T2,DMPCHA	;STORE THE BUFFER LOCATION
	SKIPN	T1,T2		;WAS THERE AN OLD CHAIN?
	JRST	FIRRE2		;NO, FINE
	CALL	RELPGS		;YES! NEEDS DELETING
	JUMPN	T1,.-1		;CHASE CHAIN
FIRRE2:	MOVE	T2,DMPCHA	;GET NEW BUFFER LOCATION
	ADD	T2,[-MAXBKF*1006-1,,DATAST-1] ;GET THE IOWD FOR THE FIRST READ
	MOVEM	T2,RECCMD	;STORE FOR DUMPI
	MOVEI	T3,1(T2)	;ADDRESS OF FIRST BUFFER HEADER
	MOVEM	T3,CURHEA	;STORE FOR USE IN CASE OF ERROR, ETC.
IN1REC:	TXO	F,F.NBOT	;WON'T BE AT BOT SOON
	MOVE	T1,MTJFN
	MOVEI	T2,RECCMD	;IOWD LIST ADDRESS, NO OVERLAP
	MOVEI	T4,[EXP NS1ERR,OF1ERR,IN1ERR,EF1ERR,ET1ERR,NE1ERR,GETSIZ,NE1ERR]
				;T4 IS THE ERROR VECTOR
	DUMPI%			;WE *WANT* AN ILLEGAL LENGTH ERROR HERE!
TPWAIT:	 ERJMPR	REAERR		;GO PROCESS THE ERROR (JUMP VIA T4)
	JRST	ILCERR		;WHAT WE GOT ISN'T WRITTEN BY DUMPER

;These are the error condition handlers for the very first DUMPI% done for
; a tape.
OF1ERR:	CALL	OFFLNE
	JRST	IN1REC

NE1ERR:	JSERRD	<Unexpected tape reading error>,BAKOUT,JRST

EF1ERR:	CAIGE	T3,0		;DID REAERR CALL CLRERR?
	CALL	CLRERR		;NO, LETS DO IT NOW
	JRST	IN1REC		;AND TRY TO IGNORE

ET1ERR:	CAIGE	T3,0		;HAVE WE CLEANED UP?
	CALL	CLRERR		;NO, DO IT NOW
	TXNN	F,F.BACK
	ERROR	<EOT on first record, try a REWIND> ;NO, BOMB OUT
	CALL	IFCRLF		;FIRST READ WAS SKIP BACK AT BOT
	TYPE	[ASCIZ/ Beginning of tape./] ;SAY AT BOT
	JRST	GETOUT		;AND DIE GRACEFULLY

IN1ERR:	TXNN	T2,MT%IRL	;ALSO WRONG LENGTH, THE ERROR WE WANT?
	JRST	ILCERR		;NO, THE COUNT IS BAD
	TXO	F,F.DERR	;SAY TO REPORT ERROR AFTER NEXT DUMPI
	JRST	GETSIZ		;HANDLE THE ERROR WE WANTED NOW

NS1ERR:	MOVSI	T2,1006		;NOT ENOUGH SPACE
	ADDB	T2,RECCMD	;SO TRY A SMALLER READ, AND COMPLAIN
	WARN	<Not enough Monitor space for first read, trying smaller buffer>
	JUMPL	T2,IN1REC	;IF ITS STILL A LEGAL REQUEST, TRY AGAIN
	JSERRD	<>,BAKOUT,JRST	;COMPLAIN AND DIE

GETSIZ:	SKIPN	T1,TRNCNT	;FETCH THE NUMBER OF WORDS GOTTEN
	JRST	ILCERR
	IDIVI	T1,1000+NHEAD	;A DUMPER RECORD?
	JUMPE	T2,ISDMPR	;IF 0, YES, GO USE
	MOVE	T1,TRNCNT
	IDIVI	T1,1000+NIHEAD
	JUMPN	T2,ILTAPS
	CAIN	T1,1
	JRST	INTRIN
	ERROR	<INTERCHANGE tapes of BLOCKING-FACTORs other than 1 are illegal>
ILTAPS:	MOVE	T1,@CURHEA	;ITS NOT! TEST FOR LABELED TAPE/BYPASS
BYPASS:	AND	T1,[BYTE(8) 177,177,177]
	CAME	T1,[BYTE(8)"H","D","R"]
	CAMN	T1,[BYTE(8)"V","O","L"]	;SOME SORT OF LABELED TAPE HEADER?
	JRST	LABBYP
	CAME	T1,[BYTE(8)"E","O","F"]
	JRST	ILCERR
LABBYP:	TXNN	F,F.PRIV	;AH! ARE WE A WHEEL??
	ERROR	<Illegal to read a labeled tape this way> ;NO! LET'S DIE.
	TXOE	F,F.ILAB
	JRST	WEKNOW
	WARN	<This is a labeled tape with labels passed>
	TYPE	[ASCIZ/
?This represents a security violation on most systems, and a condition that
  DUMPER is NOT guaranteed to handle well.
/]
WEKNOW:	CALL	CLRERR		;CLEAR ERRORS
	JRST	IN1REC		;HE SAID GO ON

ILCERR:	TYPE	[ASCIZ/
?This doesn't appear to be a DUMPER or BACKUP tape (bad record length.)
 Type <CR> to rewind the tape and try again. /]
	CALL	RDLINI
	CALL	CLRERR
	CALL	REWCV
	JRST	IN1REC

INTRIN:	TXON	F,F.INTR	;IS INTERCHANGE SET?
	WARN <This appears to be a BACKUP tape, turning on INTERCHANGE mode.>
INTROK:	MOVEI	T1,1
	MOVEI	T2,1040
	JRST	ISOK1R
ISDMPR:	TXZE	F,F.INTR
	WARN <This appears to be a DUMPER tape, turning off INTERCHANGE mode.>
	MOVE	T2,T1
	IMULI	T2,1006
ISOK1R:
 IFN FTIND,<
	TXNE	F,F.36MD	;INDUSTRY 36 BIT MODE?
	JRST	[IMULI	T2,9	;YES, NEED 9/8THS THE SPACE
		 LSH	T2,-3	;DIVI BY 8
		 JRST	.+1]
 >
	MOVEM	T1,REABKF
	MOVEM	T1,WRIBKF	;IF WE WRITE THIS TAPE, KEEP SIZE
	MOVN	T3,T2
	HRLZM	T3,RECCMD	;SET UP FOR FUTURE INPUT
	IDIVI	T2,1000
	CAIE	T3,0
	ADDI	T2,1
	MOVEM	T2,BUFPAG
	MOVE	T1,CURHEA
	HRRZ	T1,.TAPNO(T1)
	MOVEM	T1,TAPENO
	SETZM	REASEQ		;NO LAST SEQUENCE NUMBER
	SETZM	WRISEQ
	JRST	ADVCHF

ADVCHD:
 IFN	FTDEB,<
	WARN	<[DEBUG] Duplicate record read and being skipped: >
	MOVE	T2,T3
	CALL	DECOUT
 >
ADVCHI:	TXZ	F,F.CIRC	;NO LONGER TRUE
	SKIPN	T1,DMPCHA	;GET OLD BUFFER
	JRST	[MOVE	T1,BUFPAG;THERE ISN'T ONE!
		 CALL	GETPGS	;MAKE A FAKE PREVIOUS RECORD
		  JRST	NOFREE	;FATAL
		 MOVEM	T2,DMPCHA	;TO START THE CHAIN WITH
		 HRROI	T3,-FILL;SET UP A "FILLER" RECORD
		 CALL	DMYREC	;MAKE IT A DUMMY RECORD
		 CALL	LOSSEQ	;LOSE THE SEQUENCE NUMBER
		 JRST	STAREC]	;OK, GO GET NEXT BUFFER FOR REAL STUFF
	MOVE	T2,DATAST+.SEQ(T1)	;GET OLD SEQUENCE NUMBER, LAST BUFFER
	MOVEM	T2,REASEQ	;SAVE FOR DUPLICATE CHECK
	CALL	RELPGS		;DELETE
	MOVEM	T1,DMPCHA	;NEW CURRENT BUFFER
ADVCHF:
STAREC:	SKIPN	DMPCHA		;ANYTHING PREVIOUS?
	JRST	ADVCHI		;NO, PUT IN A FAKE RECORD PREVIOUS
	MOVE	T1,BUFPAG
	CALL	GETPGS
	 JRST	NOFREE		;CAN'T HAPPEN
	MOVE	T1,DMPCHA
	MOVEI	T3,DATAST(T1)	;GET ADDR OF BFR ABOUT TO BE CONFIRMED
	MOVEM	T3,CURHEA	;SAVE (FOR ANNSEQ MOSTLY)
	MOVEM	T2,NXTBUF(T1)	;NEXT BUFFER CREATED AND LINKED
	ADDI	T2,DATAST-1	;POINT TO WHERE DATA SHOULD GO
	HRRM	T2,RECCMD	;COUNT ALREADY IN LH
REDMPI:	MOVE	T2,[DM%NWT+RECCMD]
	MOVE	T1,MTJFN
	MOVEI	T4,[EXP NOSRRR,OFLRRR,DATRRR,EOFRRR,EOTRRR,NMORRR,SIZRRR,UNXRRR]
	DUMPI%			;CONFIRM LAST & START THE NEXT PHYS REC
	 ERJMPR	REAERR		;HANDLE ERROR VIA T4
	TXZE	F,F.DERR	;DO WE HAVE A DATA ERROR TO REPORT?
	JRST	DATRRR		;YES, SAY SO
RETREC:	MOVE	T1,REABKF
	MOVEM	T1,BLKCNT
INTRE2:	MOVE	T2,DMPCHA	;RETURN THE CURRENT RECORD POINTER
	ADDI	T2,DATAST
	MOVEM	T2,BLKPNT	;READY TO GO
	TXNE	F,F.BACK+F.FAKE+F.NSEQ	;BACKING UP? OR FAKE? IGNORE SEQ #'S
	JRST	GETREC
	TXNN	F,F.INTR	;INTERCHANGE? SEQUENCE IS ELSEWHERE
	SKIPA	T1,.SEQ(T2)	;SEQUENCE IN DUMPER HEADR
	MOVE	T1,G$SEQ(T2)	;SEQUENCE IN INTERCHANGE HEADER
	JUMPE	T1,SEQOK	;IF 0, ACCEPT ANYTHING
	SKIPN	T3,REASEQ	;DO WE HAVE AN EXPECTATION?
	JRST	SEQOK		;NO, TAKE ANYTHING
	CAMN	T1,T3		;DUPLICATE RECORD?
	JRST	ADVCHD		;YES, TOSS RECORD!
	CAMG	T1,T3		;SAVESET NUMBERS DO *NOT* DECREASE
	JRST	SEQNOK		;SO CATCH THAT NOW
;Of course, they *could* when we read/write a new tape.  But that causes MTBOT
; to be called, and that resets REASEQ.
	ADD	T3,REABKF	;WHAT SHOULD THE NEW VALUE BE?
	TXNN	F,F.INTR	;INTERCHANGE, TAKE ANYTHING
	CAMN	T1,T3		;THE CORRECT VALUE?
	JRST	SEQOK		;FINE
	MOVN	T3,.TYP(T2)	;NO, BUT THAT'S OK FOR SAVEST, CONTST
	CAIE	T3,SAVEST
	CAIN	T3,CONTST
	JRST	SEQOK
SEQNOK:	WARN	<Sequence error, >	;OH WELL
	MOVE	T2,T1		;TYPE THE LAST SEEN
	CALL	DECOUT
	TYPE	[ASCIZ/ after /]
	MOVE	T2,REASEQ
	CALL	DECOUT
SEQOK:	MOVEM	T1,REASEQ
	JRST	GETREC		;OK

NOSRRR:	JSERRD	<>,BAKOUT,JRST

OFLRRR:	CALL	OFFLNE
	JRST	REDMPI

;Data error code follows.  We get here after REAERR, which for this error
; guarantees that the tape has stopped.  This means that both DMPCHA and
; its sucessor point at tape buffers.  Check to see if the sequence number
; is the same for both, ie, we knew about this bad spot on the tape when we
; wrote it and wrote a dup record.  If we did, toss the current record and
; advance, just as if the bad record had been all read.  If the numbers differ,
; it's a problem, and it gets reported.
DATRRR:	CALL	CLRERR
	MOVE	T1,DMPCHA
	MOVE	T3,NXTBUF(T1)
	MOVE	T2,DATAST+.SEQ(T1)
	CAMN	T2,DATAST+.SEQ(T3)
	JRST	ADVCHI		;DUP, TOSS OLD RECORD
	WARN	<Unrecovered data error>
	CALL	ANNSEQ
	JRST	RETREC		;OH, WELL, RETURN ERROR'D RECORD

EOFRRR:	HRROI	T3,-SAVEEN	;RETURN SAVESET END
	CALL	DMYREC
	JRST	EOIRRR
EOTRRR:	CALL	CLRERR		;TOSS ERRORS
	HRROI	T3,-TAPEEN
	CALL	DMYREC
EOIRRR:	SKIPN	T2,NXTBUF(T1)	;DOES THE NEXT RECORD EXIST?
	JRST	RETREC		;NO, FINE
	SETZM	NXTBUF(T1)	;YES, ITS MEANINGLESS, TOSS IT
	MOVE	T1,T2
	CALL	RELPGS
	JRST	RETREC		;DONE. MAYN'T READ PAST EOT
FAKREC:	HRROI	T3,-FILL	;SEND A FILLER RECORD
	CALL	DMYREC
	JRST	REDMPI		;GO TRY DUMPI AGAIN

DMYREC:	MOVE	T1,DMPCHA	;GET BUFFER TO BE RETURNED
	TXO	F,F.FAKE
	SETZM	DATAST+.SEQ(T1)	;NO SEQUENCE NUMBER
	SETZM	DATAST+.PAGNO(T1);NO FLAGS IN .PAGNO
	SETZM	DATAST+.FLAG(T1);NO FLAGS AT ALL
	MOVEM	T3,DATAST+.TYP(T1)	;LOAD IN TYPE AS FIRST RECORD
	RET

NMORRR:	JSERRD	<Can't switch to next tape volume>,BAKOUT,JRST

SIZRRR:	CAIGE	T3,0
	CALL	CLRERR		;CLEAR ERRORS IF REAERR DIDN'T
	MOVE	T1,DMPCHA
	MOVE	T1,DATAST(T1)	;FETCH FIRST WORD
	AND	T1,[BYTE(8)177,177,177]
	CAME	T1,[BYTE(8)"H","D","R"]
	CAMN	T1,[BYTE(8)"V","O","L"]
PAT03A:	TXNN	F,F.PRIV
	JRST	.+2
	JRST	FAKREC		;GOT A LABEL RECORD, RETURN FILLER
	WARN	<Bad physical record length>
	CALL	ANNSEQ		;BAD RECORD
	JRST	FAKREC		;RETURN FILLER

UNXRRR:	WARN	<Unexpected tape read error>
	CALL	ANNSEQ
	TYPE	[ASCIZ/ - /]
	CALL	LSTERO
	CALL	CLRERR
	JRST	BAKOUT
;Tape input, what to do with a TONEXT record
UPTAPE:	CALL	KILCHN
UPTAP2:	CALL	NXTTPE		;FETCH NEXT TAPE PLEASE
	CALL	GMOJFI		;MAKE SURE WE GOT IT
	 JRST	[TXNE	F,F.ABT
		 JRST	BAKOUT
		 JRST	UPTAP2]	;WE DIDN'T - TRY AGAIN
	SETZM	BLKCNT		;SAY NO LOGICAL BUFFERS
	SETZM	BUFPAG		;SAY TAPE NEVER READ
	PUSH	P,TAPENO	;SAVE CURRENT TAPE NUMBER
;This should guarantee that tapes in a set with different charactistics can
; be read.  Of course that's a terrible idea, but it should be allowed.
GETRRR:	CALL	GETREC		;YES, RECURSION
	CAIE	T3,SAVEST	;QUIETLY ALLOW THIS
	CAIN	T3,CONTST	;BUT HOPE FOR THIS
	JRST	GETRR2		;OK, GOT ONE OR THE OTHER
PAT01A:	ERROR	<Tape does not start with a CONTINUED SAVESET, as expected>
PAT01B:	JRST	GETRRR
GETRR2:	CALL	GANEWT
	POP	P,T1
PAT02A:	MOVEI	T2,1(T1)	;GET EXPECTED TAPE NUMBER
	CAMN	T2,TAPENO	;NEW TAPE NUMBER CORRECT?
	JRST	GETRET		;YES, RETURN FROM OUTER GETREC
	MOVEM	T1,TAPENO	;NO, CORRECT EXPECTATION & POSSIBLY TRY AGAIN
	IFMTA	BADUPT
	ERROR	<Tape number is incorrect (wrong tape mounted)>
BADUPT:	WARN	<Tape number is incorrect (wrong tape mounted)>
	CALL	UNLMTA
	HRROI	T1,[ASCIZ/Put up the correct tape/]
	CALL	TRYAGA
	JRST	UPTAPE
	SUBTTL	Tape I/O support

 IFG <REEVAL>*<FTVERS-5>,<
;Returns the result in T3. 1=drive busy, 0=drive idle
CHKBLK:	MOVE	T1,MTJFN
	MOVEI	T2,.MOIRB
	MTOPR%
	 ERJMPS	[SETZ T3,	;PROBABLY DEV OFF LINE OR SOMETHING
		 RET]
	RET
 >

;Wait for current tape activity to stop
WAITFN:	SKIPE	OPNFOR		;TAPE ISN'T MOVING IF NOT OPEN
	SKIPN	T1,MTJFN	;OR JFN'D
	RET			;SO QUIT
	MOVEI	T2,.MONOP
	MTOPR%
	 ERJMPS	.+1		;CAN'T, FINE
	RET

;Here with error code (from ERJMPR) in T1 and error vector pointer in T4.
; leap off accoring to error.  Come here by JRST.  This sets TRNCNT to the
; number of words transferred if MT%IRL is true (length error).
;This returns T3/ -1 if XGDSTS wasn't called, or the count of transferred
; bytes in T3 if it was.
REAERR:	SETO	T3,
	CAIN	T1,DUMPX3
	JRST	@0(T4)		;NO MONITOR SPACE FOR BLOCKING FACTOR
	CAIN	T1,OPNX8
	JRST	@1(T4)		;OFFLINE
	CAIE	T1,GJFX52
	CAIN	T1,IOX24
	JRST	@4(T4)		;EOT
	CAIN	T1,MREQ16
	JRST	@5(T4)		;CAN'T SWITCH TO NEXT TAPE
	CAIN	T1,IOX4
	JRST	REAEOF		;EOF
	CAIE	T1,IOX5		;TEST FOR REAL ERROR
	JRST	@7(T4)		;NONE! WHY ARE WE HERE?
	CALL	XGDSTS
	HLRZS	T3
	MOVEM	T3,TRNCNT	;NUMBER OF WORDS TRANSFERRED
;**;[555] Add two lines at REAERR+17. lines		GAS	20-Sep-88
	TXNE	T2,MT%DVE	;[555] Check device error first
	JRST	@1(T4)		;[555] Yes, device error
	TXNE	T2,MT%DAE
	JRST	@2(T4)		;DATA ERROR
	TXNE	T2,MT%IRL
	JRST	@6(T4)		;WRONG LENGTH
;**;[555] Delete two lines at REAERR+22. lines		GAS	20-Sep-88
	TXNN	T2,MT%EOF
	JRST	@7(T4)		;UNKNOWN
REAEOF:	CAIGE	T3,0		;DID WE CALL CLRERR (XGDSTS?)
	CALL	XGDSTS		;NO, DO IT NOW
	TXO	F,F.EOF		;WE HAVE EOF (END OF SAVESET)
	IFLAB	REAEO2		;ON LABELED TAPES, 2 EOFS DON'T COUNT
	TXZN	F,F.OEOF	;2 IN A ROW?
	JRST	@3(T4)		;JUST EOF SO FAR
	JRST	@4(T4)		;2ND IN A ROW - EOT
REAEO2:	TXZE	F,F.OEOF	;2ND IN A ROW ON LABELED TAPE?
	 WARN	<Empty saveset seen on tape> ;WORTH A WARNING
	TXNN	T2,MT%EOT	;DISPATCH ON TRUTH
	JRST	@3(T4)		;MERE EOF
	JRST	@4(T4)		;EOT

;CLRERR is actually just like XGDSTS, but it preserves T2
CLRERR:	PUSH	P,T2
	CALL	XGDSTS
	POP	P,T2
	RET

;Returns JFN in T1 and status in T2
XGDSTS:	SETZ	T2,
	SKIPN	T1,MTJFN
	RET			;JUST GO BACK
	GDSTS%			;GET ERROR BITS
;**;[549]Change one line at XGDSTS:+4L		DEE	1-MAR-88
	 ERJMP XGDBAD		;[549] Can't - some problem
	PUSH	P,T2		;SAVE STATUS BITS
	TXZN	T2,MT%EOT!MT%DVE!MT%DAE
	JRST	XGDST1
	DOJSS	SDSTS%, .+1
XGDST1:	MOVEI	T2,.MOCLE
	DOJSS	MTOPR%, .+1	;CLEAR ERROR FLAGS
	POP	P,T2
	RET


;**;[549] Add new routine XGDBAD: at XGDST1:+5L		DEE 	1-MAR-88

;[549] HERE IF GDSTS% FAILED - BIG PROBLEM, SO CLEAN UP AS BEST
;WE CAN AND START OVER

XGDBAD: MOVEI   T2,.MOCLE	;[549] Try to do what we came here for
	DOJSS 	MTOPR%, .+1	;[549] Clear error flags
	POP     P,T2	        ;[549] Restore
	ERROR	<Can't get tape drive status>,PANIC ;[549] Bomb out




;FINTAP writes the end of tape information.
; It first dumps out the current chain (DMPCHA).
FINTAP:	CALL	FILBLK		;END GETS A PHYS. BLOCK TO ITSELF
	IFLAB	FINLAB		;LABELED TAPES ARE GROUCHY AND SPECIAL
FIN2:	MOVX	T1,-TAPEEN
	MOVEM	T1,TAPHEA+.TYP
	MOVEI	T1,TAPHEA
	MOVEI	T2,SSNBUF	;LAST SAVESET INFO (FOR INTERCHANGE)
	CALL	ADDREC
	CALL	FILBLK		;WRITE OUT CHAIN
	CALL	WRIEOF
	CALL	WRIEOF
	CALL	WAITFN
	CALL	BACKSP
	CALL	BACKSP
	CALL	BACKSP		;BACK OVER END RECORDS
	JRST	FINIWR
FINLAB:	CALL	WRIEOF
	CALL	WRIEOF
FINIWR:	CALL	KILCHN
	TXO	F,F.NORD
	RET

;Write EOF
WRIEOF:	SKIPN	T1,MTJFN
	RET
	MOVEI	T2,.MOEOF
	MTOPR%
	 JSERRD	<>,BAKOUT
	RET

;Backspace a record
BACKSP:	SKIPN	T1,MTJFN
	RET
	MOVEI	T2,.MOBKR
	MTOPR%
	 JSERRD	<Can't backspace>,BAKOUT
	;JRST	LOSSEQ
;Here to remember the highest reading sequence number seen so far on this tape,
; but to have no expectation for the next thing read.
LOSSEQ:	SETZ	T2,
	EXCH	T2,REASEQ
	CAMLE	T2,LSTSEQ
	MOVEM	T2,LSTSEQ
	RET

;Forwardspace a record.  Returns T1/ tape jfn.
FWRDSP:	SKIPN	T1,MTJFN
	RET
	MOVX	T2,.MOFWR
	MTOPR%
	 JSERRD	<>,BAKOUT
	JRST	LOSSEQ

;Announce the record number (For GETREC)
ANNSEQ:	MOVE	T2,CURHEA
	MOVE	T2,.SEQ(T2)
	TYPE	[ASCIZ/, record /]
	SKIPN	JFN
	JRST	DECOUT
	CALL	DECOUT
	TYPE	[ASCIZ/, /]
	JRST	CFNFIL

;T3 contains the header address, T4 the 1000 word buffer.  Ret with T1
; containing the checksum.
CHKSUM:	DMOVEM	T3,CHKTMP
	HRLI	T3,-6
	HRLI	T4,-1000
	SETZ	T1,
	JCRY0	.+1
COMCH1:	ADD	T1,0(T4)
	JCRY0	[AOJA T1,.+1]
	AOBJN	T4,COMCH1
COMCH2:	ADD	T1,0(T3)
	JCRY0	[AOJA T1,.+1]
	AOBJN	T3,COMCH2
	CAMN	T1,[-1]
	SETZ	T1,
	DMOVE	T3,CHKTMP
	RET

 IFN FTIND,<
;CONVERT THE BUFFER AT CURHEA IN PLACE (FOR INDUSTRY MODE (F.36MD))
W36CNV:	PUSH	P,Q1
	MOVE	T2,CURHEA
	HRLI	T2,(POINT 8)
	MOVE	T3,T2
	HRLI	T3,(POINT 4)
	MOVEI	Q1,1006*9/2
W36C1:	ILDB	T4,T2		;ONE SOURCE BYTE...
	ROT	T4,-4		; ... BECOMES TWO DEST BYTES
	IDPB	T4,T3
	ROT	T4,4
	IDPB	T4,T3
	SOJG	Q1,W36C1
	POP	P,Q1
	RET
 >

;Here during a SAVE to see if a VOLID is needed, and if so, if it is available.
; If it isn't, the user is prompted.
PROVOA:	TXOA	T1,D.ARC	;MAKE SURE WE PASS THIS TEST
PROVOL:	MOVE	T1,DMPFLG	;MOUNTED TAPE, SHOULD HAVE IT
	SKPMTA			;SKIP IF MTA
	SKIPN	VOLID6		;MAKE SURE
VOLNRL:	TXNN	T1,D.ARC+D.MIG+D.COL ;IF NOT TRUE, VOLID ISN'T NEEDED
	RET			;HERE IF HAVE VOLID6 OR DON'T NEED IT
;Here we have to prompt for the volid - probably an unlabeled tape
REQVOL:	MOVEM	P,TRAPSP
ASKVOL:	MOVEI	T1,[
		 SETZM	TRAPTO
		 MOVE	P,TRAPSP
		 CALL	TSTINT
		  JRST	BAKOUT
		 JRST	ASKVOL]
	MOVEM	T1,TRAPTO
	HRROI	T1,[ASCIZ/Provide a VOLID for the tape: /]
	HRROI	T2,STRING
	MOVEI	T3,VOLBLK
	CALL	QUEST
	MOVEM	P,REQTMP
VOLPRS:	MOVE	P,REQTMP
	SETZM	ATOM2
	DMOVE	T1,[EXP VOLBLK,TXTINB]
	CALL	PARSE
	 JSERRD	<>,ASKVOL,JRST
	MOVEI	T2,CONINB
	CALL	PARSE
	 ERROR	<Not comfirmed>,ASKVOL
	SETZM	TRAPTO
	HRROI	T1,ATOM2
	CALL	ASCSIX
	JUMPE	T2,ASKVOL
	MOVEM	T2,VOLID6
	HRROI	T1,ATOM2
	HRROI	T2,VOLID
	JRST	CSTR
	SUBTTL	SKIP command
;Skip some number of savesets (forward or backward)
$SKIP:	GUIDES	<NUMBER OF SAVESETS>
	DMOVE	T1,[EXP CMDBLK,SKPINB]
	CALL	PARSE
	 JSERRD	<>,NOCMD
	MOVE	Q1,T2
	CONFIRM
	SETOM	OKIAE		;ALLOW INTERRUPTS
	CALL	GMOJFI
	 JRST	BAKOUT
	SETZM	BLKCNT		;FORCE TAPE READ
	TXO	F,F.NSEQ	;SEQUENCE NUMBERS, ETC. SHOULD BE IGNORED
	JUMPLE	Q1,SKPBAC
	CALL	GETREC
	IFLAB	SKPLFR		;LABELED TAPES ARE A TAD DIFFERENT
	CAIN	T3,SAVEST	;FIRST REC A SAVESET?
	AOJA	Q1,SKPFRF	;YES, TYPE BUT DON'T COUNT
SKPFRD:	CAIN	T3,TAPEEN	;EOT?
	JRST	[TYPE	[ASCIZ/ End of tape./]
		 JRST	SKPFIN]
	CAIE	T3,SAVEST
	JRST	SKPFR1
SKPFRF:	CALL	TYPHDR
	SOJLE	Q1,SKPUNF
SKPFR1:	SETZM	BLKCNT
	CALL	GETREC
	JRST	SKPFRD

SKPUNF:	CALL	BACKSP		;FIX FOR READAHEAD
	CALL	BACKSP
	JRST	SKPFIN

SKPLFR:	CAIN	T3,SAVEST
	CALL	TYPHDR
SKPL2:	CALL	GETREC
	SETZM	BLKCNT
	CAIN	T3,SAVEEN
	JRST	SKPLEF
	CAIN	T3,TAPEEN
	JRST	SKPFIN
	CAIN	T3,SAVEST
	CALL	TYPHDR
	JRST	SKPL2
SKPLEF:	SOJG	Q1,SKPL2
	TYPE	[ASCIZ/ Positioned after above saveset/]
	JRST	SKPFIN

SKPBAC:	SKPNLB			;SKIP IF NOT LABELED
	ERROR	<Can't backspace Labeled tapes> ;LABELED CAN'T DO THIS
	MOVE	T1,MTJFN
	MOVX	T2,.MOSDR	;SET TO READ BACKWARDS
	MOVEI	T3,1
	MTOPR%
	 JSERRD	<>
	TXO	F,F.BACK
	TXZ	F,F.NORD+F.EOF	;GOING BACKWARDS, SO EOT DOESN'T MATTER
SKPBK1:	CALL	XGDSTS		;SEE IF AT BOT
	TXNE	T2,MT%BOT+MT%EOT
	JRST	SKPBOT		;YES, JUST STOP
	SETZM	BLKCNT
	CALL	GETREC
	MOVE	T3,LASTYP
	CAIE	T3,SAVEST
	JRST	SKPBK1
	CALL	TYPHDR
	AOJLE	Q1,SKPBK1
	CALL	WAITFN
	CALL	XGDSTS		;SEE IF AT BOT
	TXNN	T2,MT%BOT+MT%EOT
	JRST	RAHEF
SKPBOT:	CALL	IFCRL2
	TYPE	[ASCIZ/ Beginning of tape./]
	CALL	MTBOT
	SKIPA	T1,MTJFN
RAHEF:	CALL	FWRDSP		;FIX FOR READ AHEAD, RET T1/ TAPE JFN
SKPBCK:	MOVX	T2,.MOSDR
	SETZ	T3,
	MTOPR%
	 JSERRD	<>
SKPFIN:	TXZ	F,F.NSEQ+F.BACK
	SETZM	REASEQ		;NO IDEA WHAT SHOULD COME NEXT
	JRST	CMDFIN

TYPHDR:	CALL	IFCRLF
	MOVE	T2,CURDAT
	SKIPN	T1,SV.PNT(T2)
	MOVEI	T1,SV.MSG
	ADDI	T1,(T2)
	SKIPN	(T1)
	JRST	[TYPE	[ASCIZ/UNNAMED saveset	/]
		 JRST	TYPHD2]
	TYPE	[ASCIZ/Saveset "/]
	TYPE	<(T1)>
	TYPE	[ASCIZ/"	/]
TYPHD2:	MOVEM	T3,TMP
	SKIPE	T2,SV.TAD(T2)
	CALL	TADOUT
	MOVE	T3,TMP
	TYPE	CRLF
	RET

SKPINB:	<.CMNUM>B8+CM%DPP
	^D10
	BLOCK	1
	-1,,[ASCIZ/1/]
	SUBTTL	Restore, Retrieve, Check

;Retrieve parsing and setup
RETRIE:	TXNN	F,F.PRIV
	JRST	OPRERR		;MUST BE PRIVED
	GUIDES	<FILES>
	TXO	F,F.RETR+F.FILT	;RETRIEVE, AND ASSUME FILES MODE
	TXZ	F,F.CHCK+F.SARC+F.GOT1	;NONE OF THESE
	HRROI	T1,[ASCIZ/DSK*/]
	HRROI	T2,[ASCIZ/*/]
	MOVX	T3,GJ%OFG
	CALL	SETWLD
	DMOVE	T1,[EXP CMDBLK,LO2INB]
	CALL	PARSE
	 ERROR	<Illegal file specification>,NOCMD
	CALL	RPSJFN
	MOVEM	T2,JFNLST	;ONLY 1 POSSIBLE
	SETZM	JF2LST		;..
	CONFIRM
	TXZE	F,F.INTR
	TYPE	[ASCIZ/Turning off INTERCHANGE mode. /]
	TXZE	F,F.CREA
	TYPE	[ASCIZ/Turning off CREATE mode./]
RETSET:	CALL	QSRINI		;HELLO QUASAR
	CALL	MTCLS		;DROP WHATEVER WE HAVE
	SETZM	VOLID6		;WE DON'T HAVE A TAPE ANYMORE
	SETZM	BDTCNT		;SAY NO BAD TAPE VOLIDS YET
	SETZM	TOTFIL		;FILES RETRIEVED
	SETZM	TOTCNT		;PAGES RETRIEVED
	CALL	SETLST		;SET UP LIST FILE IF DESIRED
	 SETZM	LSTFIL		;CAN'T
	MOVSI	Q1,-1		;RETRIEVE ONLY HAS ONE FILESPEC
	MOVEM	Q1,NFJFN	;FOR TSTNAM
	JRST	RETLP
LATER:	CALL	RETFAI
RETLP:	TXNN	F,F.PRIV	;PARANOIA CHECK
	JRST	BAKOUT
	CALL	NXTRET		;FETCH REQUEST FROM QUASAR
	 JRST	ENDRET		;ALL DONE
MNTRIG:	CALL	MNTRET		;GET THE TAPE & OPEN IT
	 JRST	LATER		;CAN'T
	SKIPE	ABTFLG		;QUASAR REQUEST ABORT?
	JRST	[CALL	ABTRET	;YES, BAG IT
		 JRST	RETLP]
RETLDS:	SKIPGE	.ARODT(P5)
	SKIPA	T1,.ARSF1(P5)
	MOVE	T1,.ARSF2(P5)
	HLRZM	T1,RETSVN
	HRRZM	T1,RETFLN	;GET FILE AND SAVESET NUMBERS
;Find out if we need to rewind this tape
	MOVE	T1,RETSVN
	CAMGE	T1,ATSAVE	;ARE WE AT/AFTER THE DESIRED SAVE?
	JRST	REWRET		;YES, JUST REWIND
	CAME	T1,ATSAVE	;AT IT OR IS IT BEYOND?
	JRST	NRWRET		;ITS AHEAD - JUST GO ON
	MOVE	T1,RETFLN	;AT IT - IS THE FILE AHEAD OR PAST?
	CAMLE	T1,ATFILE	;.. IF AHEAD, SKIP THE REWIND
	JRST	NRWRET		;..
REWRET:	CALL	REWCV		;BACK TO BOT
	CALL	KILCHN		;LOSE ANY READAHEAD
NRWRET:	TXO	F,F.NVOL	;WE'LL HANDLE VOLSWITCHES, PLEASE
RETFLS:	CALL	GETREC
	CAIN	T3,TAPEEN	;END OF TAPE?
	JRST	RETENT		;YES, GO HANDLE
	CAIN	T3,TONEXT	;NEXT TAPE NEEDED?
	JRST	[CALL	NXTRTT	;YES, GO FETCH AND SET UP
		 JRST	RETFLS]	;AND GO ON
	SKIPN	T4,SAVENO
	JRST	RETFLS		;NOT AN ARCHIVAL SAVESET
	MOVEM	T4,ATSAVE	;REMEMBER WHAT SAVESET AT
	SETOM	ATFILE		;NO FILE NUMBER YET
	CAME	T4,RETSVN	;GOT THE RIGHT SAVESET NUMBER?
	JRST	[MOVE	T1,RETSVN ;NO
		 CAIE	T1,1	;1 IS OK (OLD DUMPERS DID THIS)
		 CAIG	T4,(T1)	;GONE PAST?
		 JRST	RETFLS	;NO, READ ON
		 HRROI	P1,[ASCIZ/Missing required Saveset/]
		 JRST	LATER]
	CAIE	T3,FILEST	;BEGINNING OF FILE?
	JRST	RETFLS		;NO, GO AGAIN
	LDB	T4,[POINT 15,.PAGNO(T1),17]
	MOVEM	T4,ATFILE	;STORE FILE NUMBER
	CAME	T4,RETFLN	;GOT IT?
	JRST	[CAMG	T4,RETFLN ;NO, PAST IT?
		 JRST	RETFLS	;NO, READ ON
		 HRROI	P1,[ASCIZ/File missing from Saveset/]
		 JRST	LATER]
	HRRO	T1,CURDAT	;POINT TO FILENAME FOR SANITY CHECK
	HRROI	T4,STRING
	MOVEI	T2,";"
	CALL	CPYDLM
	SETO	T3,
	ADJBP	T3,T4
	SETZ	T2,
	DPB	T2,T3
	HRROI	T2,STRING
	HRROI	T1,FILNM(P5)	;POINT TO REQUESTED FILE
	CALL	STCMPC
	JUMPE	T3,RETFNO	;0 IF THE SAME
;This condition can happen - tape,saveset,file#s have been wrong in some
; versions of DUMPER.  Or, maybe just a renamed archived file.
	WARN	<Filename on tape is not the same as requested file,
 Tape file name: >
	HRRO	T1,CURDAT
	TYPEAT	T1
	TYPE	[ASCIZ/
 File requested: /]
	TYPE	FILNM(P5)
 IFE FTASKR,<		;;FTASKR=0,  ask the operator for advice
	HRROI	T1,[ASCIZ/Wrong file found, retrieve anyway? /]
	CALL	YESNO
	JUMPE	T2,REJECR
 >
 IFG FTASKR,<		;;FTASKR=1,  retrieve in all cases
	TYPE	[ASCIZ/
 -- retrieving anyway/]
 >
 IFL FTASKR,<		;;FTASKR=-1,  reject attempt in all cases
	JRST	REJECR
 >
RETFNO:	CALL	RETFIL		;GOTCHA! RETRIEVE FILE AND RELEASE
	JRST	RETLP

RETENT:	HRROI	P1,[ASCIZ/ At end of tape, requested file not found/]
	JRST	LATER		;REQUEUED OR LOST IT, GO GET NEXT

REJECR:	CALL	IFCRL2
	TYPE	[ASCIZ/ File will not be retrieved./]
	HRROI	P1,[ASCIZ/Wrong file seen/]
	JRST	LATER

RETFAI:	CALL	FALFIL		;TYPE OUT REQUEST FILE NAME
	SKIPGE	.ARODT(P5)
	JRST	[CALL	WASHO2	;TOTAL LOSS, DECLARE IT SO
		 JRST	RELREQ]	;AND SAY "DONE"
	GTAD%
	TXO	T1,%EQUFT	;MAYBE ON OTHER TAPE, GO TRY
	WARN	<Requeuing >
	TYPE	FILNM(P5)
REQSIL:	SETZM	NXTRTP		; Current block now invalid
	PUSH	P,P1
	CALL	ZIPMSS		; Setup to send
	MOVE	T2,[REQ.SZ,,.QOREQ]
	MOVEM	T2,.MSTYP(P1)	; Length, type
	MOVE	T2,TPTSK	; External task
	MOVEM	T2,REQ.IT(P1)	; Internal task name
	MOVEM	T1,REQ.IN(P1)	; Timestamp
	HRLI	T2,.ARTP1(P5)	; COPY TAPE INFO FROM
	HRRI	T2,REQ.IN+1(P1)	; TO
	BLT	T2,REQ.IN+1+.ARSF2(P1) ; Copy in tape info
	MOVE	P1,[REQ.SZ,,QSRMSS]
	CALL	SNDQSR		; Send it to QUASAR
	POP	P,P1
	RET


ENDRET:	SKIPE	T1,MYPID
	CALL	RELPID		;DROP QUASAR DIAOLGUE
	CALL	UNLOAD
	CALL	ENDLIS		;CLOSE OUT ANY LIST FILE
	CALL	MTCLS
PAT08A:	JRST	LODENT		;AND ACT LIKE RESTORE ENDING
;Errors that occur in here are the type that can't be fixed by trying the other
; tape.
RETFIL:	HRROI	T1,FILNM(P5)
	MOVEI	T2,">"
	HRROI	T4,OUTSPC
	CALL	CPYDLM
	HRROI	T1,[ASCIZ/RETRIEVAL.TEMP;T/]
	MOVE	T2,T4
	CALL	APPSTR
	SETZM	JFN
	HRROI	T2,OUTSPC
	MOVX	T1,GJ%FOU+GJ%SHT
	GTJFN%
	 ERJMPS	NOTMPR
	MOVEM	T1,JFN
	MOVX	T2,OF%WR
	OPENF%
	 ERJMPS	NOTMPR
	TXO	F,F.NVOL
	CALL	PLOP		;CALL DOWN FILE INTO JFN
	 JRST	NORETR		;CAN'T!
	SKIPE	ABTFLG
	JRST	[MOVE	T1,JFN	;ABORTED.  TOSS FILE.
		 TXO	T1,CZ%ABT
		 CLOSF%
		  ERJMPS ABTRET
		 JRST	ABTRET]
	MOVX	T1,GJ%OLD+GJ%XTN
	MOVEM	T1,RETBLK+.GJGEN
	MOVEI	T1,RETBLK
	HRROI	T2,FILNM(P5)
	GTJFN%
	 ERJMPS	NORETR		;GIVE UP
	EXCH	T1,JFN		;SAVE NEW JFN, GET OLD
	TXO	T1,CO%NRJ	;CLOSE RETAINING JFN
	HRRZ	T3,T1		;JFN IN T3 FOR ARCF
	CLOSF%			;..
	 ERJMPS	.+1		;SNH
	MOVE	T1,JFN		;NEW JFN IN T1
	MOVX	T2,.ARRST	;DO THE RETRIEVE FUNCTION
	ARCF%			;WHOMP!
	 ERJMPR	RETNON		;PROBABLY ON LINE ALREADY
	HRLI	T1,.FBBK0(CF%NUD)
	MOVSI	T2,-1
	SETZ	T3,		;CLEAR "TIMES SAVED"
	DOJSS	CHFDB%, .+1
	MOVE	T3,T1		;JFN TO T3
	GTAD%			;GET "NOW"
	EXCH	T1,T3		;JFN IN T1, DATE IN T3
	SETO	T2,		;CHANGE ENTIRE WORD
	HRLI	T1,.FBREF	;TO SAY LAST REF'D NOW
	DOJSS	CHFDB%, .+1
	HRRZS	T1
	RLJFN%
	 ERJMPS	.+1
	SETZM	JFN
	CALL	IFCRL2
	SKIPN	LSTJFN
	JRST	NOLSFR
 IFN FTMAIL,<
	SKIPN	MAILFL
	JRST	NOMLSF
	SELECT	LS.LST
	TYPE	[ASCIZ/*R/]
 >
NOMLSF:	SELECT	LS.TTY+LS.LST
NOLSFR:	TYPE	[ASCIZ/  /]
	TYPE	FILNM(P5)	;ALWAYS TYPE FILENAME
	TYPE	CRLF
	SELECT	LS.TTY
 IFN FTUSAG,<
	CALL	USAINI		; Init USAGE block
	MOVX	T1,.UTRET	; Is a retrieval
	HRRM	T1,USABLK	; Insert type
	MOVE	T1,CURDAT
	MOVE	T2,FDBFFF+.FBBBT(T1) ; Get # pages returned online
	HRRZM	T2,USABLK+10	; Put it in the blk
	LDB	T2,[POINT 3,T2,17]
	MOVEM	T2,USABLK+26	; Put reason it was offline in blk
	ADD	T1,AUTTMP	;SET UP BY PLOP/FILDWN
	ADDI	T1,FDBFFF+20
	CALL	USATAP		; Do tape info
	HRROI	T1,USADIR	; User who requested retrieval
	MOVE	T2,TPRQUS
	DIRST%
	 ERJMPS	.+1		; Maybe files only or something similiar
	MOVEI	T1,TPACT	; Account for this
	MOVEM	T1,USABLK+2
	HRROI	T1,TAPNAM
	HRROI	T4,USASTR
	MOVEI	T2,":"
	CALL	CPYDLM
	SETO	T1,
	ADJBP	T1,T4
	SETZ	T2,
	DPB	T2,T1
	CALL	GDONBE		;FINISH UP THE USAGE AND DO IT
 >
	CALL	RELREQ
	RET

RETNON:	MOVEM	T1,STRING	;SAVE ERROR CODE FOR A MOMENT
	HRRZ	T1,T3
	RLJFN%			;DROP JFN IN T3
	 ERJMPS	.+1
	MOVE	T1,STRING	;GET ERROR CODE BACK
	HRROI	P1,[ASCIZ/ File is already on-line/] ;ASSUME THIS ERROR
	CAIE	T1,ARCFX9	;AM I RIGHT?
NORETR:	CALL	BADOFP
	JRST	RETNOG
NOTMPR:	HRROI	T1,[ASCIZ/Can't open retrieval .TEMP file /]
	HRROI	T1,STRING
	CALL	CSTRB
	MOVE	T1,T2
	CALL	BADOF2		;ADD ERROR MESSAGE
RETNOG:	CALL	WASHOU		;BLOW AWAY
	CALL	RELREQ		;AND RETURN AS UNACCEPTABLE
	SKIPN	T1,JFN
	RET
	SETZM	JFN
	TXO	T1,CZ%ABT
	CLOSF%
	 ERJMPS	[MOVE	T1,JFN
		 RLJFN%
		 ERJMPS	.+1
		 JRST	.+1]
	RET
;Here if we plow into a TONEXT tape record during a retrieval.  Only
; Retrieval should be lighting F.NVOL before calling PLOP, so that should
; be the only way to get here outside of RETFIL.  We mount the next tape
; with an eye towards doing it the way we did last time, ie,
NXTRTT:	IFLAB	AUTOGO		;LABELED TAPES JUST KEEP GOING
	SKIPN	MNTDSG		;DID WE MOUNT A TAPE THIS WAY (QUASAR?)
	JRST	[CALL	NXTTAP	;NO, DO A NORMAL NEXT TAPE
		 JRST	AUTOGO]
	CALL	UNLOAD		;LOSE MOUNTED TAPE
	CALL	IFCRL2
	TYPE	<[ASCIZ/ [Need to mount next retrieval tape]
 Provide the volid of the next retrieval tape in the set./]>
NXTNFN:	SETZM	VOLID6
	CALL	REQVOL
	HRROI	T1,ATOM2
	CALL	ASCSIX
	MOVE	Q1,T2
	CALL	MNTNXT
	 JRST	NXTNFN
AUTOGO:	AOS	TAPENO
	CALL	MTBOT
	CALL	GETREC		;SKIP FIRST RECORD
	CAIE	T3,SAVEST
	CAIN	T3,CONTST
	TXOA	F,F.NVOL
	JRST	AUTOGO
	IFMTA	CPOPJ
	CALL	GETVOL		;LEARN THE NEW VOLID
	RET
;CHECK starts here and uses RESTORE code where possible.
CHECK:	GUIDES	<ALL TAPES FILES>
	CONFIRM
	TXO	F,F.CHCK
	TXZ	F,F.RETR+F.SARC
	MOVSI	T1,-1
	MOVEM	T1,NFJFN	;NOT QUITE TRUE, ACTUALLY
	JRST	CHCKST

;Just like RESTORE, but default to "accept any filename match"
TRANSF:	TXO	F,F.WILD
	;JRST	RESTOR
;Restore parsing
RESTOR:	GUIDES	<TAPE FILES>
	TXZ	F,F.CHCK+F.RETR	;NOT CHECK OR RETRIEVE
PAT06A:	TXZ	F,F.SARC	;DEFAULT: TAPE INFORMATION OK
	MOVSI	Q1,-MAXJFN
	TXNN	F,F.INTR+F.WILD	;DO WE NEED DEFAULTS?
	CALL	GETCON		;YES, GET CONNECTED STR:<DIR>
	JRST	LOADNF		;AND START GETTING FILES
LOADCT:	AOBJN	Q1,LOADNF	;DID LAST FILE FIT?
	ERROR	<JFN list overflow>,NOCMD
LOADNF:	TXNE	F,F.INTR+F.WILD	;INTERCHANGE MEANS WILD DISK ALWAYS
	JRST	[HRROI	T1,[ASCIZ/DSK*/] ;OR HE JUST WANTS DSK*:<*>
		 JRST	LDWDIR]
	DMOVE	T1,CONSTR	;NONINTERCHANGE, PICK UP DEFAULTS
	TXNE	F,F.PRIV	;PRIVED?
LDWDIR:	HRROI	T2,[ASCIZ/*/]	;YES, WILD DIRECTORY DEFAULT
	MOVX	T3,GJ%OFG	;THIS WILL BE PARSE ONLY
	CALL	SETWLD		;SET UP THE DEFAULTS
	DMOVE	T1,[EXP CMDBLK,LODINB]	;SWITCHES OR FILESPEC PARSE
LDFILO:	CALL	PARSE
	 ERROR	<Not a Switch or a file specification>,NOCMD
	CAIE	T3,.CMSWI	;SWITCH?
	JRST	LOADFL		;NO, HANDLE FILE
	HRRZ	T2,(T2)
	JRST	(T2)		;DISPATCH ON SWITCH

LODINB:	<.CMSWI>B8+LO2INB
	EXP	LODTAB

LO2INB:	<.CMFIL>B8

LODTAB:	 LODLEN,,LODLEN
	TB	NOARC,	<NOTAPE-INFORMATION>
	TB	LOARC,	<TAPE-INFORMATION>
	 LODLEN=.-LODTAB-1

NOARC:	TXOA	F,F.SARC
LOARC:	TXZ	F,F.SARC
	DMOVE	T1,[EXP CMDBLK,LO2INB]
	JRST	LDFILO

LDEINB:	<.CMFIL>B8+CM%SDH+CM%HPP+LD2INB
	BLOCK	1
	-1,,[ASCIZ/file group descriptor/]

LD2INB:	<.CMCMA>B8+CONINB

LOADFL:
 IFN FTEXAC,<
	SKIPN	EXACT		;EXACT MODE?
	JRST	LODFL2		;NOT EXACT MODE, TAKE AS IS
	HRRZ	T1,T2		;DROP THE COMND% JFN
	RLJFN%			;..
	 ERJMPS	.+1
	MOVE	T1,GTJBLK+.GJGEN
	HRRM	T1,EXABLK+.GJGEN
	DMOVE	T1,GTJBLK+.GJDEV	;GIVE GTJFN THE SAME DEFAULTS
	DMOVEM	T1,EXABLK+.GJDEV
	DMOVE	T1,GTJBLK+.GJNAM
	DMOVEM	T1,EXABLK+.GJNAM
	MOVEI	T1,EXABLK	;DO AGAIN, WITH G1%SLN LIT, SO
	HRROI	T2,ATOM		;WE CAN FORCE NON-EXPANSION OF
	GTJFN%			;LOGICAL NAMES
	 JSERRD	<Can't re-GTJFN file for EXACT mode> ;WHY?
	MOVE	T2,T1
 > ;END IFN FTEXAC
LODFL2:	CALL	RPSJFN
	MOVEM	T2,JFNLST(Q1)	;SAVE JFN
	SETZM	JF2LST(Q1)	;ASSUME SAME OUTPUT
	GUIDES	<TO>
	CALL	OFNAME
	MOVX	T2,GJ%OFG
	HLLM	T2,GTJBLK+.GJGEN
	MOVX	T2,.GJNHG
	TXNE	F,F.SSA
	HRRM	T2,GTJBLK+.GJGEN
	DMOVE	T1,[EXP CMDBLK,LDEINB]
	CALL	PARSE		;GET FILENAME, COMMA, OR CONFIRM
	 ERROR	<Illegal file specification>;MANAGED TO MISS THEM ALL
	CAIN	T3,.CMCMA	;COMMA?
	JRST	LOADCT		;INCREMENT AND GO 'ROUND AGAIN
	CAIN	T3,.CMCFM	;CONFIRM?
	JRST	LOADST		;YES, DONE PARSING
	CALL	RPSJFN		;FILESPEC, SAVE THE JFN
	CALL	CHKDSK
	 JRST	[CAIE	T3,.DVNUL ;[562] Is it NUL:?
		 JRST	MBDERR	;[562] Nope, device must be DSK or NUL
		 CALL	RPSGET	;[562] Get the output JFN off the stack
		  CALL	(T1)	;[562] Punt that JFN on NUL device
		 CALL	RPSGET	;[562] Get the other JFN off of the stack
		  CALL	(T1)	;[562] Punt that input JFN too
		 SETZB	T1,JFNLST(Q1) ;[562] No JFN to deal with here either
		 JRST	.+1]	;[562] And get comma or confirm
	MOVEM	T1,JF2LST(Q1)	;SAVE THE JFN IN THE LIST TOO
	DMOVE	T1,[EXP CMDBLK,LD2INB]	;NEED COMMA OR CONFIRM
	CALL	PARSE
	 ERROR	<Not a comma or a confirm>,NOCMD
	CAIE	T3,.CMCFM	;WHICH?
	JRST	LOADCT		;COUNT AND GO 'ROUND AGAIN
LOADST:	MOVNI	Q1,1(Q1)
	HRLZM	Q1,NFJFN	;SAVE THE COUNT
CHCKST:	TXZ	F,F.GOT1
	HLRO	T1,NFJFN
	MOVNM	T1,STOPLD	;# OF JFNS TO MATCH
	SETZM	SAVENO		;NO SAVESET NUMBER
	SETZM	TAPENO		;TAPE NOT KNOWN
	SETZM	LSTDIR		;LAST DIRECTORY LOADED INTO NOT KNOWN
	SETZM	TOTFIL		;NO FILES YET
	SETZM	TOTCNT		;NO PAGES YET
	SETZM	DIRDMD		;NO DIRECTORIES YET
	SETZM	TOTSKP		;NOTHING SKIPPED YET
	SETZM	TOTDEL		;NOTHING DELETED YET
	SETZM	PASWDC		;PASSWORD CREATE ERRORS GAIN IMMED. HALT
	SETOM	OKIAE		;INTERRUPTS OK NOW
	CALL	GMOJFI		;TAPE FOR READING
	 JRST	BAKOUT		;OH WELL
	CALL	GETREC		;GET FIRST RECORD
	CAIE	T3,SAVEST	;SAVESET OR CONTINUED SAVESET?
	CAIN	T3,CONTST	;..?
	SKIPA	T1,SAVENO	;YES, MIGHT BE ARCHIVAL, TEST
	JRST	RSTPOK		;ITS NOT - WIERD!
	JUMPE	T1,FSTSSH
	TXNN	F,F.PRIV
	 JRST	[CALL	REWCV
		 ERROR <May not read from this saveset without WHEEL or OPR>]
	TXNE	F,F.CHCK	;CHECK OPERATION?
	JRST	FSTSSH		;YES, ALLOW WITHOUT COMPLAINT
	WARN	<This tape is a Virtual disk tape.  It should not be used to
 restore files.  This action may violate system security.>
	HRROI	T1,[ASCIZ/Are you sure you should do this? /]
	CALL	YESNO
	JUMPE	T2,BAKOUT	;DECIDED AGAINST THIS
FSTSSH:	CALL	TYPHDR
HUNTIN:	SKIPG	STOPLD
	JRST	LODENT		;ZERO IF NONE LEFT
	CALL	GETREC
RSTPOK:	CAIN	T3,SAVEEN
	JRST	LODENT
	CAIE	T3,SAVEST	;NEXT SAVESET START
	CAIN	T3,TAPEEN	;OR END OF TAPE
	JRST	LODENT		;BOTH MEAN END, SO DONE
	CAIN	T3,DIRECT
	JRST	[TXNN	F,F.CHCK;CHECKING? DON'T CREATE
		 TXNN	F,F.CREA;CREATING DIRECTORIES?
		 JRST	HUNTIN	;IGNORE IT
		 JRST	CREADR]	;CREATE AND GO ON
	CAIE	T3,FILEST
	JRST	HUNTIN
	HRROI	T2,LSTSEN	;GET POINTER TO NAME (SET BY GETREC)
	TXNE	F,F.CHCK
	JRST	DFCHCK		;CHECK GOES ELSEWHERE
	CALL	TSTNAM		;MATCH ANYTHING?
	 JRST	[RLJFN%
		 JRST	HUNTIN	;NO
		 JRST	HUNTIN]
	MOVEM	T1,JFN		;^A WILL SEE THIS, OH WELL
	MOVE	T1,JFNLST(T4)	;GET BITS ON INPUT JFN, TO SEE IF WILD
	TXNN	F,F.RETR	;RETRIEVAL SHOULDN'T WORRY ABOUT THIS
	TXNE	T1,GJ%DEV+GJ%UNT+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER
	JRST	NOLWIL		;SOMETHING IS WILD IN IT, OR DOING RETRIEVAL
	HRRZS	T1		;THIS JFN CAN GO AWAY, SINCE NOTHING ELSE
	RLJFN%			;CAN MATCH IT IN THIS SAVESET
	 ERJMPS	.+1
	SETZM	JFNLST(T4)	;ZERO ITS SLOT
	SOS	STOPLD		;ONE LESS JFN TO CARE ABOUT
NOLWIL:	TXNE	F,F.INTR
	JRST	NOINDT		;INTERCHANGE CANT CHECK DATES
	MOVE	T3,CURDAT	;GET POINTER INTO DATA
	MOVE	T1,FDBOFF+.FBCRE(T3);CHECK CREATION DATES
	CAMG	T1,MBTAD
	CAMGE	T1,MSTAD
	JRST	NOLOAD
	MOVE	T1,FDBOFF+.FBWRT(T3);WRITE DATES
	CAMG	T1,WBTAD
	CAMGE	T1,WSTAD
	JRST	NOLOAD
	CAMGE	T1,FDBOFF+.FBREF(T3)
	MOVE	T1,FDBOFF+.FBREF(T3)
	CAMG	T1,ABTAD
	CAMGE	T1,ASTAD
	JRST	NOLOAD
NOINDT:	TXNN	F,F.FILT	;WANT FILENAME TYPEOUT?
	JRST	NFTTYP		;NO
	HRROI	T1,FILNAM	;STORE TAPE FILENAME HERE
	MOVE	T2,JFN
	MOVE	T3,[JFNSAL]
	JFNS%
NFTTYP:	MOVE	P5,MATCH	;GOFNAM WANTS THIS IN P5
	CALL	GOFNAM		;GEN OUTPUT NAME TO OUTSPC
	CALL	GOFPAT		;THESE WANT JFN SET UP
	SETZ	T1,
	EXCH	T1,JFN		;LOSE OLD JFN
	RLJFN%
	 JFCL
	TXNE	F,F.SSA		;SUPERCEDE ALWAYS?
	JRST	JUSTJF		;NO, GO GET OUTPUT JFN
	MOVE	T1,OUTFLS	;POINT AT FILENAME
	SETZ	T4,		;COPY NOWHERE
	MOVEI	T2,"."
	CALL	CPYDLM		;GET PAST FILENAME
	CALL	CPYDLM		;GET PAST EXTENSION
	ILDB	T4,T1		;GET NEXT CHARACTER
	MOVEM	T1,OUTGEN
	MOVEM	T4,GEITMP	;STORE CHARACTER
DELLOP:	DPB	T3,T1		;STORE A NULL
	MOVX	T1,GJ%OLD+GJ%XTN;SET UP TO FIND ANY
	MOVEM	T1,RETBLK+.GJGEN
	MOVEI	T1,RETBLK
	HRROI	T2,OUTSPC	;..
	GTJFN%			;ANY WITH THIS NAME?
	 ERJMPS	[DPB	T4,OUTGEN;NO, RESTORE GENERATION
		 JRST	JUSTJF]	;AND GO LOAD
	MOVEM	T1,JFN		;REMEMBER THIS
	DPB	T4,OUTGEN	;RESTORE GENERATION
	TXNE	F,F.SSN		;SUPERCEDE NEVER?
	JRST	SKPLOD		;YES, COUNT AS SKIPPED AND GO ON
	MOVSI	T2,.FBWRT+1
	MOVEI	T3,FDB
	GTFDB%
	 ERJMPS	SKPLOD
	MOVE	T3,CURDAT	;POINT TO TAPE FDB
	MOVE	T2,FDB+.FBWRT	;FETCH FILE LAST WRITE
	CAML	T2,FDBOFF+.FBWRT(T3);COMPARE WITH TAPE DATE
	JRST	SKPLOD		;REASON NOT TO LOAD
	HLRZ	T2,FDB+.FBGEN	;GET ON-DISK GENERATION
	HLRZ	T3,FDBOFF+.FBGEN(T3)	;GET TAPE GENERATION
	CAML	T3,T2		;DOES TAPE FILE HAVE A HIGHER GEN?
	JRST	DRKJFN		;YES, FINE
	WARN	<Deleting >
	CALL	TYJFN1		;TYPE JFN IN T1
	TYPE	[ASCIZ/ while superseding.
/]
	MOVE	T1,JFN
	DELF%
	 ERJMPS	.+2		;OH WELL
	AOS	TOTDEL
	SETZ	T3,
	MOVE	T1,OUTGEN
	MOVE	T4,GEITMP
	JRST	DELLOP

LDTRYF:	CAIE	T1,GJFX44	;ACCOUNT STRING MISMATCH
	CAIN	T1,VACCX0	;ACCOUNT INVALID
	SKIPA	T4,OUTACS	;ONE OF THEM, POINT TO ACCOUNT STRING
	JRST	LODNOT		;NOPE, GO COMPLAIN
	SETZ	T2,
	IDPB	T2,T4		;CLOBBER ACCOUNT STRING
	WARN	<Using system default account for >
	TYPE	OUTSPC
	JRST	JUSTJF

DRKJFN:	RLJFN%			;GOING TO USE THE TAPE FILE
	 JFCL
JUSTJF:	MOVE	T1,OUTDRS
	ILDB	T2,T1
	PUSH	P,T2		;PRESERVE THIS
	SETZ	T2,
	DPB	T2,T1		;AND DESTROY FOR CHECK
	MOVEM	T1,GEITMP	;SAVE THIS FOR A MOMENT
	HRROI	T1,OUTSPC
	HRROI	T2,LSTDIR
	CALL	STCMPC
	JUMPE	T3,SAMEAS
	CALL	STCOPY
	CALL	IFCRL2
	TYPE	[ASCIZ/ Loading files into /]
	TYPE	LSTDIR
	TYPE	CRLF
SAMEAS:	POP	P,T2
	DPB	T2,GEITMP
	SETOM	CURREN		;TELL ^A NO PAGE NUMBER YET
	MOVX	T1,GJ%XTN+GJ%FOU
	MOVEM	T1,RETBLK+.GJGEN
	MOVEI	T1,RETBLK
	HRROI	T2,OUTSPC	;SET UP TO WRITE FILE
	GTJFN%			;..
	 ERJMPR	LDTRYF		;SOME ERRORS WE CAN FIX
	MOVEM	T1,JFN
	MOVX	T2,OF%WR
	OPENF%
	 ERJMPS	LODNOT		;CAN'T LOAD THIS FILE
	TXNN	F,F.FILT	;TYPE FILENAME(S)?
	JRST	NLFTYP
	CALL	IFCRLF		;GET AGAINST THE LEFT MARGIN
	TYPE	[ASCIZ/  /]	;2 SPACES
	TYPE	FILNAM
	TYPE	[ASCIZ/ to /]
	TYPE	OUTSPC
NLFTYP:	CALL	PLOP
	 JRST	LODNOT		;FAILED TO LOAD
	TXNE	F,F.SARC!F.INTR	;SUPRESS TAPE INFO? OR NO ARCF INFO POSSIBLE?
	 JRST	[MOVE	T1,JFN	;YES, CLOSE UP AND FINISH NOW
		 SETZM	JFN
		 CLOSF%		;..
		 ERJMPS	LODNOT	;THIS CLOSF SHOULDN'T FAIL
		 JRST	RESTOK]	;ON TO NEXT
	CALL	ARCFIX		;DO ARCF TAPE INFO STUFF, AND CLOSE FILE
	 JRST	DNELDF		;MAYN'T DO OFFLINE FILES THIS WAY
	MOVE	T1,JFN		;RELEASE JFN (ARCFIX CLOSF'D)
	SETZM	JFN
	RLJFN%			;FINISH THE FILE
	 ERJMPS	.+1		;NOT A PROBLEM
RESTOK:	TXNE	F,F.FILT
	TYPE	<[ASCIZ/ [OK]
/]>
DNELDF:	MOVE	T3,LASTYP	;CONTINUE SCAN
	JRST	RSTPOK

DFCHCK:	SETZM	JFN
	MOVX	T1,GJ%SHT+GJ%OLD
	GTJFN%
	 ERJMPS	[WARN	<File >
		 TYPE	@CURDAT
		 TYPE	[ASCIZ/ not checked/]
		 CALL	LSTERD
		 TXO	F,F.GOT1
		 JRST	SKPDAT]
	MOVEM	T1,JFN
SKPDAT:	CALL	GETREC		;SKIP DATA
	JUMPE	T3,SKPDAT	;..
	CAIN	T3,FILEEN
	JRST	CHKFDB
	CAIE	T3,CONTST
	CAIN	T3,FILEST
	JRST	SKPDAT
	CALL	UNEXTY		;ODD RECORD, COMPLAIN
	MOVE	T3,LASTYP
	CAIE	T3,SAVEEN	;MAYBE MISSING FILEEN
	JRST	SKPDAT
	WARN	<Probably missing a file ending record>
	JRST	CHKFDB		;SO FAKE IT AND HOPE

CHKFDB:	SKIPN	T1,JFN		;GOT A FILE?
	JRST	CHKDON		;NO, JUST FINISH
	MOVSI	T2,.FBLN0
	MOVEI	T3,FDBBUF
	GTFDB%
	 ERJMPS	.+1
	MOVE	T2,CURDAT
	CALL	FILDWN		;SETS UP P1 AND T2 FOR US
	 JFCL			;ALWAYS SKIPS FOR US
	MOVEM	T2,AUTTMP	;STORE POINTER TO AUTHOR
	MOVE	T2,CURDAT
	;ADDI	T2,FDBFFF
	HRRZM	T2,INDEX
CHKFDL:	MOVE	T1,FDBBUF(P1)
	XOR	T1,@INDEX	;COMPARE WORDS
	AND	T1,CKMASK(P1)	;BUT CHECK ONLY CERTAIN BITS
	TXNE	F,F.INTR	;INTERCHANGE MODE?
	AND	T1,ICMASK(P1)	;YES, FEWER BITS PERTINENT
	JUMPN	T1,FDBERR	;JUMP IF COMPARED BITS DIFFERENT
CHKFD0:	AOS	INDEX
	AOBJN	P1,CHKFDL
	TXNE	F,F.INTR	;SKIP IF NOT INTERCHANGE FORMAT
	JRST	CHKDON		;DON'T CHECK AUTHOR & LAST WRITER
	HRR	T1,JFN		;JFN OF FILE
	HRLI	T1,.GFAUT	;FUNCTION IS GET AUTHOR
	HRROI	T2,STRING	;STORE STRING HERE
	GFUST%
	 ERJMPS [SETZM STRING
		JRST .+1]
	HRROS	T2,AUTTMP
	HRROI	T1,STRING
	CALL	STCMPC
	JUMPE	T3,CHKST2
	WARN	<File author differs for file >
	CALL	TYJFN
	TYPE	CRLF
	TXO	F,F.GOT1
CHKST2:	HRR	T1,JFN
	HRLI	T1,.GFLWR	;GET LAST WRITER
	HRROI	T2,STRING
	GFUST%
	 ERJMPS [SETZM STRING
		JRST .+1]
	HRROI	T1,STRING	;LAST WRITER
	HRROS	T2,AUTTMP
	ADDI	T2,10
	CALL	STCMPC
	JUMPE	T3,CHKDON
	WARN	<File last-writer differs for file >
	CALL	TYJFN
	TXO	F,F.GOT1
	TYPE	CRLF
CHKDON:	SKIPN	T1,JFN
	JRST	SCANON
	SETZM	JFN
	RLJFN%
	 ERJMPS	.+1
SCANON:	MOVE	T3,LASTYP
	JRST	RSTPOK		;GO CHECK NEXT FILE

FDBERR:	WARN	<Difference in >
	TXO	F,F.GOT1
	MOVE	T3,FDBNAM(P1)
	CALL	SIXOUT
FDBER9:	TYPE 	[ASCIZ/ of file /]
	CALL	TYJFN
	TYPE	CRLF
	JRST	CHKFD0
LODNOT:	WARN	<Not loading >
	TYPE	OUTSPC
	CALL	LSTERD
	JRST	NOLOAD
SKPLOD:	AOS	TOTSKP
NOLOAD:	SKIPE	T1,JFN		;ANY JFN LEFT?
	CALL	DRPJFA
	SETZM	JFN		;YES, DROP
	JRST	HUNTIN

LODENT:	SETZM	OKIAE		;NO INTERRUPTS NOW
	CALL	IFCRL2
	TXNN	F,F.CHCK	;CHECK DOESN'T USE JFNLST/JF2LST
	CALL	DMPJFS		;TOSS JFNS IN JFNLST/JF2LST
	TXNE	F,F.RETR
	JRST	LODSTN
	MOVE	T3,LASTYP
	CAIN	T3,SAVEEN	;STOP ON SAVESET END?
	JRST	LODSTS		;YES, DON'T BACKUP
	CAIE	T3,SAVEST	;STOP ON SAVESET BEGIN?
	JRST	LODSTT		;NO, MAYBE AT END OF TAPE
	CALL	BACKSP		;YES, BACKUP OVER READAHEAD
	CALL	BACKSP		;BACKSPACE TO SAVESET START
LODSTS:	TYPE	[ASCIZ/ End of Saveset./]
	JRST	LODSTN
LODSTT:	CAIE	T3,TAPEEN
	JRST	LODSTM
	TYPE	[ASCIZ/ End of Tape./]
LODSTN:	CALL	KILCHN
	SETZM	LSTSEN		;NO MORE LAST SEEN FILE
LODSTM:	TYPE	CRLF
	TXNE	F,F.CHCK
	JRST	CHKEND
	MOVE	T3,[NO%LFL+NO%OOV+^D10(6)]
	SKIPN	T2,TOTFIL
	JRST	[TXNN	F,F.RETR
		 JRST	NOFLSR
		 TYPE	[ASCIZ/ No files Retrieved/]
		 JRST	CMDEND]
	TYPE	[ASCIZ/

 Total files restored:	/]
	CALL	NUMOUT
	TYPE	[ASCIZ/
 Total pages restored:	/]
	MOVE	T2,TOTCNT
	CALL	NUMOUT
NOFLSR:	TXNE	F,F.RETR	;RETRIEVAL?
	JRST	CMDEND		;THE REST DOESN'T APPLY
	SKIPN	T2,DIRDMD
	JRST	TNODRC
	TYPE	[ASCIZ/
 Directories created:	/]
	CALL	NUMOUT
	SKIPG	T2,PASWDC
	JRST	TNODRC
	TYPE	[ASCIZ/
 Encryption errors:	/]
	CALL	NUMOUT
TNODRC:	SKIPN	T2,TOTSKP
	JRST	TNOFSK
	TYPE	[ASCIZ/
 Files skipped:		/]
	CALL	NUMOUT
TNOFSK:	SKIPN	T2,TOTDEL
	JRST	CMDEND
	TYPE	[ASCIZ/
 Number of files deleted: /]
	CALL	NUMOUT
	JRST	CMDEND
CHKEND:	TXNN	F,F.GOT1
	TYPE	[ASCIZ/ No differences seen./]
	JRST	CMDEND
PLOP:	SKIPE	ABTFLG		;FOR RETRIEVE
	JRST	CPOPJ1		;ACT AS IF FINISHED OK (WE FIX THIS LATER)
	CALL	GETREC
	JUMPN	T3,CKFEND
	HRLI	T2,PAGBUF	;PAGBUF=PAGPAG*1000
	MOVSS	T2
	MOVEI	T3,777(T2)
	BLT	T2,(T3)
	HRRZ	T2,.PAGNO(T1)
	MOVEM	T2,CURREN
	HRL	T2,JFN
	MOVE	T1,[.FHSLF,,PAGPAG]
	MOVX	T3,PM%RWX
	PMAP%
	 ERJMPS	CPOPJ
	AOS	TOTCNT
	JRST	PLOP
CKFEND:	CAIN	T3,FILEEN
	JRST	FILDWN
	CAIE	T3,CONTST	;CONTINUED SAVESET, FINE
	CAIN	T3,FILEST	;IGNORE THIS
	JRST	PLOP
	CAIE	T3,TONEXT
	JRST	TRWNE
	CALL	NXTRTT		;RETRIEVAL DOES THIS
	JRST	PLOP
TRWNE:	CALL	UNEXTY		;COMPLAIN AND GO ON
	JRST	PLOP

UNEXTY:	WARN	<Unexpected tape record type >
	MOVE	T2,T3
	CALL	DECOUT
	TYPE	[ASCIZ/, ignoring./]
	RET

;RESTORE, RETRIEVE - come here to fix FDB
;CHECK - come here to set up P1 (AOBJN FDB length) and T2 (pointer to author)
; Return +2 if all OK (F.CHCK set will always return +2)
FILDWN:	SETOM	CURREN
	TXNN	F,F.INTR	;INTERCHANGE?
	SKIPN	P1,FDBFFF+.FBHDR(T2)	;NO, GET FDB SIZE
	MOVEI	P1,.FBLN0	;INTERCHANGE OR NO SIZE, ASSUME THIS SIZE
	ANDI	P1,777
	MOVEM	P1,AUTTMP
	CAILE	P1,.FBLN0	;MAKE SURE LESS THAN OUR MAX
	MOVEI	P1,.FBLN0	;STRANGE.  USE OUR MAX
	MOVNS	P1
	HRLZS	P1		;AOBJN'D
	MOVEI	T4,FDBFFF(T2)	;POINT TO DATA
	TXNE	F,F.CHCK	;CHECKING?
	JRST	FILDCK		;YES, JUST GET INFORMATION
FIXFDB:	MOVE	T1,JFN		;GET JFN
	MOVE	T3,(T4)		;GET VALUE TO SET
	TXNN	F,F.PRIV	;PICK WHICH VALUES TO TRY TO SET
	SKIPA	T2,NWMASK(P1)
	MOVE	T2,MASK(P1)
	TXNE	F,F.INTR	;INTERCHANGE TAPE?
	MOVE	T2,ICMASK(P1)	;YES, SET DIFFERENT BITS
	JUMPE	T2,FIXFDE	;NO BITS IN MASK?
	HRL	T1,P1		;NO, WE HAVE SOMETHING TO SET
	TXO	T1,CF%NUD	;DON'T GO TO DISK FOR THIS
	CHFDB%
	 JSERRD	<>,.+1
FIXFDE:	ADDI	T4,1
	AOBJN	P1,FIXFDB
	MOVE	T4,CURDAT	;SET UP FOR INVISIBILITY
	MOVE	T1,JFN
	HRLI	T1,.FBCTL
	MOVX	T2,FB%INV
	TXNN	F,F.RETR!F.INTR	;ARE WE RETRIEVING? OR INTERCHANGE MODE?
	SKIPA	T3,FDBFFF+.FBCTL(T4)	;NO, GET ACCORDING TO OLD STATE
	SETZ	T3,		;YES, CLEAR ALWAYS
	DOJSS	CHFDB%, .+1	;TRY IT
FILDCK:	TXNE	F,F.INTR	;INTERCHANGE MODE?
	JRST	NOWRTR		;YES, DON'T SET AUTHOR
	MOVE	T2,FORMAT	;FORMAT MATTERS HERE
	CAIGE	T2,6		;V6 AND LATER - BASED ON FDB SIZE
	JRST	[HRROI	T2,FDBFFF+.FBLN0(T4)
		 JRST	AUTGT]
	MOVEI	T2,FDBFFF(T4)
	ADD	T2,AUTTMP	;OFFSET FROM ABOVE
AUTGT:	TXNE	F,F.CHCK
	JRST	NOWRTR
	HRROS	T2
	MOVE	T3,T2
	HRLI	T1,.SFAUT	;SET UP FOR AUTHOR STRING
	DOJSS	SFUST%, NOWRTR
	TXNN	F,F.PRIV	;NEED PRIVES TO SET WRITER
	JRST	NOWRTR
	HRLI	T1,.SFLWR
	HRROI	T2,10(T3)
	DOJSS	SFUST%, .+1
NOWRTR:	AOS	TOTFIL		;ASSUME IT MAKES IT
	JRST	CPOPJ1

;Here to put in tape (ARCF) info
ARCFIX:	MOVE	P1,CURDAT	;POINTER TO DATA BUFFER
	;ADDI	P1,FDBFFF	;POINT TO FDB
	TXNE	F,F.PRIV	;EL PRIVO?
	JRST	ARCFX1		;YES, IGNORE SPECIAL TESTS
	MOVE	T2,.FBCTL(P1)	;GET ARCHIVE AND OFFLINE STATUS
	TXNN	T2,FB%ARC+FB%OFF;ARCHIVED OR OFFLINE?
	JRST	ARCFX1		;NO TO BOTH
	TXNE	T2,FB%OFF	;OFFLINE?
	JRST	FLUSHL		;YES, ILLEGAL WITHOUT PRIVS - FLUSH ATTEMPT
	JRST	ARCNOT
ARCFX1:	MOVE	T1,JFN
	TXO	T1,CO%NRJ
	CLOSF%
	 ERJMPS	.+1
	TXNN	F,F.PRIV	;GOT PRIVS?
	JRST	CPOPJ1		;NO, CAN'T DO ARCF STUFF SO DON'T TRY
	HLLZ	T4,.FBBBT(P1)	; Get archive bits
	TXZ	T4,AR%1ST	; This has been done already
	JUMPE	T4,ARCFI1	; None set, skip this part
	HRRZ	T1,JFN		; JFN for this file
	MOVEI	T2,.ARRAR	; Request for archive
	MOVEI	T3,.ARSET	; Set it
	TXNE	T4,AR%NDL	; No flush please?
	TXO	T3,AR%NDL	; Yes, flag that
	TXNE	T4,AR%RAR	; Was it requested?
	ARCF%			; Yes, reset that
	 ERCAL	ARCFF
	MOVEI	T2,.ARRIV
	MOVEI	T3,.ARSET
	TXNE	T4,AR%RIV	; Involuntary request?
	ARCF%			; Yes
	 ERCAL ARCFF
	MOVEI	T2,.ARNAR
	MOVEI	T3,.ARSET
	TXNE	T4,AR%NAR	; Resist archive?
	ARCF%			; Yes,
	 ERCAL ARCFF
	MOVEI	T2,.AREXM
	TXNE	T4,AR%EXM	; Exempt from archiving?
	ARCF%			; Yes, set that
	 ERCAL ARCFF


;**;[554] Add 7 lines and some comments at ARCFI1:	DEE	12-AUG-88

;[554] For ARCHIVed files, a tape written by 4.1 DUMPER will have
;[554] 30 FDB words, 10 words for author name, 10 words for last
;[554] writer, then 7 words of archive information. A tape written
;[554] by 6.0 DUMPER has 37 words of FDB, then the author, last writer,
;[554] and archive information. So, check the tape format so we account
;[554] for the correct number of words from FDB-start when looking for
;[554] the archive information.

ARCFI1:	MOVEI	T4,20(P1)	;[554] Account for author and last writer strings
	MOVE	T2,FORMAT	;[554] See what format we are (4.1 saves only 30 FDB words)
	CAIN	T2,4		;[554] Well?
	IFSKP.
	  ADD     T4,AUTTMP	;[554] Not format 4, FDB length is here
	ELSE.
	  ADDI    T4,.FBLN0	;[554] Length of "old" FDB (30) is here
	ENDIF.
	SETZ	T2,		; No flags yet
	SKIPE	.ARTP1(T4)	; 1st tape exist?
	TXO	T2,AR%O1	; Yes, set that
	SKIPE	.ARTP2(T4)	; 2nd tape exist?
	TXO	T2,AR%O2	; 2nd exists
	JUMPE	T2,CPOPJ1	; Neither tape there, skip this
	MOVE	T3,.FBCTL(P1)
	TXNE	T3,FB%OFF	; Was it offline?
	TXO	T2,AR%OFL	; Yes, do that too
	TXNE	T3,FB%ARC	; Was it archived?
	TXO	T2,AR%ARC	; Yes, do that too
	MOVEM	T2,.AROFL(T4)	; Put bits into block
	HRRZ	T1,JFN
	MOVEI	T2,.ARSST	; Set the status
	MOVE	T3,T4
	ARCF%			; Set it
	 ERCAL ARCFF
	JRST	CPOPJ1		; Done here

ARCFF:	WARN	<ARCF failure on >
	TYPE	OUTSPC
	JRST	LSTERD

FLUSHL:	MOVE	T1,JFN
	TXO	T1,CZ%ABT
	SETZM	JFN
	CLOSF%
	 ERJMPS	.+1
	WARN	<Not loading >
	TYPE	OUTSPC
	TYPE	[ASCIZ/ - WHEEL or OPR needed for OFFLINE files/]
	RET

ARCNOT:	WARN	<Not setting Archive information for >
	TYPE	OUTSPC
	MOVE	T1,JFN
	TXO	T1,CO%NRJ
	CLOSF%
	 ERJMPS	.+1
	JRST	CPOPJ1
CREADR:	MOVE	T4,T2		;POINTER TO TAPE DATA
	SKIPN	.CDNUM(T4)	;INFORMATION PRESENT?
	JRST	HUNTIN		;NO, IGNORE
	SKIPN	T2,JF2LST	;HAVE OUTPUT DEFAULT?
	JRST	LODUSD		;GET NAME FROM TAPE (OR DSK:)
	HRROI	T1,OUTDIR
	HRRZS	T2		;JFN ONLY
	MOVX	T3,<1B2+JS%PAF>
	JFNS%			;GET DEVICE NAME:
LODUSA:	MOVEI	T2,"<"		;OPEN BRACKET
	IDPB	T2,T1		;STASH
	MOVE	T2,T1		;SETUP OUTPUT PNTR IN B
	MOVE	T1,[POINT 7,UHNAM(T4)] ;BEG OF NAME ON TAPE
LODUS1:	ILDB	T3,T1		;YES - LOCATE DIRECTORY NAME
	CAIE	T3,"<"
	JRST	LODUS1		;LOOP TILL OPEN BRACKET FOUND
LODUS2:	ILDB	T3,T1		;GET CHAR IN NAME
	CAIE	T3,">"		;LOOK FOR CLOSE BRACKET OR NULL
	JUMPN	T3,[IDPB T3,T2	;COPY CHAR IN NOT NULL
		JRST	LODUS2]
	MOVEI	T3,">"		;TERMINATE DIRECTORY NAME
	IDPB	T3,T2
	SETZ	T3,		;ADD NULL TO STRING
	IDPB	T3,T2		;...
	HRRO	T2,T4
	ADDM	T2,.CDPSW(T4)	;SET PASSWORD STRING ADDRESS
	SKIPE	.CDLEN(T4)	;CHECK FOR LENGTH
	ADDM	T2,.CDDAC(T4)	;SET DEFAULT ACCOUNT ADDRS
	MOVX	T1,RC%EMO	;CHECK FOR ALREADY EXISTING DIR
	HRROI	T2,OUTDIR	;...
	RCDIR%
	 ERJMPS	NEWDCR		;ERROR, ASSUME DOESN'T EXIST
	TXNN	T1,RC%NOM!RC%AMB;EXISTS?
	HRRM	T3,.CDNUM(T4)	;YES - USE EXISTING NUMBER
NEWDCR:	HLLZ	P3,.CDLEN(T4)	;THIS WILL BE T2
	HRR	P3,T4		;ADDRESS OF BLOCK IN RH
	TXO	P3,CD%LEN+CD%PSW+CD%LIQ+CD%PRV+CD%MOD+CD%LOQ+CD%NUM+CD%FPT
	TXO	P3,CD%DPT+CD%RET+CD%UGP+CD%DGP	;BITS ALWAYS ON
	TXZ	P3,CD%LLD
 IFG FTVERS-5,<
	TXO	P3,CD%SDQ+CD%CUG+CD%DAC+CD%PPN ;These may get turned off
 >
 IFLE FTVERS-5,<
	TXO	P3,CD%SDQ+CD%CUG+CD%DAC	;These may get turned off
 >
	MOVE	P4,.CDLEN(T4)	;GET LENGTH FOR BLOCK
	HRRZ	T1,P4		;INTO T1 (AND P4)
	CAIG	T1,0
	HRRI	P4,CD.LEN	;0 IS A BAD IDEA
 IFG FTVERS-5,<
	TXO	P4,CD%NSQ+CD%PEN+ CD%NED+CD%FED+CD%PED+CD%PMU
				;LATTER MAY GET OFF'D IF THEY CAUSE ERRORS
	TXZ	P4,CD%NCE+CD%RNA;NOT CD%NCE or CD%RNA yet
 >
 IFLE FTVERS-5,<
	TXO	P4,CD%NSQ+CD%NED+CD%FED
	TXZ	P4,CD%NCE
 >
 IFG FTVERS-5,<
	MOVE	T2,FORMAT	;GET FORMAT NUMBER
	CAIG	T2,4		;PRE-PASSWORD ENCRYPTION VERSION?
	SETZM	.CDPEV(T4)	;YES, MAKE ENCRYPTION VERSION # ZERO
	CAIL	T1,.CDPPN
	SKIPN	.CDPPN(T4)
	TXZ	P3,CD%PPN
	CAIL	T1,.CDPED
	SKIPN	.CDPED(T4)
	TXZ	P4,CD%PED
	CAIL	T1,.CDPMU
	SKIPN	.CDPMU(T4)
	TXZ	P4,CD%PMU
 >
	CAIL	T1,.CDSDQ	;DOES IT HAVE THIS?
	SKIPN	.CDSDQ(T4)
	TXZ	P3,CD%SDQ
	CAIL	T1,.CDCUG	;In general, check the FDB length to see if
	SKIPN	.CDCUG(T4)	; it is long enough to have foo.  If not,
	TXZ	P3,CD%CUG	; turn off the bits that imply foo is
	CAIL	T1,.CDDAC	; available.
	SKIPN	.CDDAC(T4)
	TXZ	P3,CD%DAC
	CAIL	T1,.CDDFE
	SKIPN	.CDDFE(T4)
	TXZ	P4,CD%FED
	CAIL	T1,.CDDNE
	SKIPN	.CDDNE(T4)
	TXZ	P4,CD%NED
	MOVEI	T2,777
	ANDM	T2,.CDCUG(T4)	;TOSS OUT ANY GARBAGE
	ADDM	T4,.CDCUG(T4)	;AND OFFSET POINTERS PROPERLY
	ANDM	T2,.CDUGP(T4)
	ADDM	T4,.CDUGP(T4)
	ANDM	T2,.CDDGP(T4)
	ADDM	T4,.CDDGP(T4)
CREAGA:	MOVEM	P4,.CDLEN(T4)
	MOVE	T2,P3		;SET UP ABOVE
	HRROI	T1,OUTDIR	;LOCATION OF DIRECTORY TO CREATE
	CRDIR%
	 ERJMPR	LODUS9		;CHECK LOSAGE
	TYPE	OUTDIR
	TYPE	[ASCIZ/ created
/]
	AOS	DIRDMD
	JRST	HUNTIN

LODUSD:	MOVE	T1,[POINT 7,OUTDIR]	;INIT POINTER
	MOVE	T2,[POINT 7,UHNAM(T4)]
LODUSE:	ILDB	T3,T2		;GET A CHAR
	JUMPE	T3,LODUSF	;NO DEVICE - USE DSK:
	IDPB	T3,T1		;COPY CHARACTER
	CAIE	T3,":"		;COLON?
	JRST	LODUSE		;NO - GET MORE
	JRST	LODUSA		;YES - DONE

LODUSF:	MOVE	T3,[ASCII "DSK:"]
	MOVEM	T3,OUTDIR	;V2 OR EARLIER - USE DSK:
	MOVE	T1,[POINT 7,OUTDIR,27]
	JRST	LODUSA		;PROCEED

;Here on CRDIR% failure - check reason and try again if correctable
LODUS9:	MOVE	T2,T1
	CAIE	T2,ARGX27	;OFF-LINE EXPIRATION LIMIT?
	JRST	CREDE0
	TXZE	P4,CD%FED
	JRST	CRETR2
	JRST	CREERR
CREDE0:	CAIE	T2,CRDIX2	;ILLEGAL NUMBER?
	CAIN	T2,CRDIX8
	TRNA
	JRST	CREDE1
	SETZM	.CDNUM(T4)
	TXZE	P3,CD%NUM
	JRST	CRETR2
	JRST	CREERR
CREDE1:	CAIE	T2,PPNX1	;BAD PPN?
	JRST	CREDE2
 IFG FTVERS-5,<
	TXZE	P3,CD%PPN
	JRST	CRETR2
 >
	JRST	CREERR
CREDE2:	CAIE	T2,CRDI16	;INVALID USER GROUPS?
	JRST	CREDE3
	TXZE	P3,CD%UGP!CD%CUG
	JRST	CRETR2
	JRST	CREERR
CREDE3:	CAIE	T2,CRDI24
	CAIN	T2,CRDI22	;CD%SDQ TO BLAME?
	TRNA
	JRST	CREDE4
	TXZE	P3,CD%SDQ
	JRST	CRETR2
	JRST	CREERR
CREDE4:
 IFG FTVERS-5,<
	CAIE	T2,CRDI27	;TEST FOR SERIOUS PASSWORD PROBLEMS
	CAIN	T2,CRDI26	;..
	JRST	PASLST
	CAIE	T2,CRDI28	;..
	JRST	CREDE5		;SOME OTHER ERROR, OK
PASLST:	TXZN	P4,CD%PED+CD%PMU ;IF WE RETRY, FLIP OFF ENCRYPT BITS
	JRST	CREERR		;ALREADY TRIED THAT, FAIL COMPLETELY
PAT09A:	SKIPE	PASWDC		;HAVE WE SEEN THIS BEFORE AND OK'D IT?
	JRST	CRETRP		;YES, GO ON WITHOUT LONG ERROR MESSAGE
	ERROR	<Problem with password in Creation of directory >
	TYPE	OUTDIR		;SCREAM BLOODY 'ELL. THIS COULD BE SERIOUS.
	TYPE	[ASCIZ/
 Error is: /]			;EXPLAIN PROBLEM
	CALL	LSTERO		;..
	TYPE	[ASCIZ/
 Attempting to Continue will probably restore files correctly, but the
  directory itself may have no usable password (LOGIN may be impossible).
 CONTINUE ONLY IF this is acceptable for all subsequent directory creations.
  If you Continue,  DUMPER will give the standard TOPS-20 error message for
  each occurance of a password problem in this RESTORE, but not stop.
 RESET if possibly garbled passwords are not acceptable./]
	HALTF%			;DON'T GO ON UNLESS ASKED
CRETRP:	AOS	PASWDC		;REMEMBER THIS SO WE DON'T ASK AGAIN
	JRST	CRETR2		;DO RETRY CODE WITHOUT ENCRYPT BITS
>
CREDE5:	CAIE	T2,CRDI13	;QUOTA?
	JRST	CREERR
	TXZN	P3,CD%LIQ+CD%LOQ
	JRST	CREERR
	;JRST	CRETR2
CRETR2:	WARN	<Failed to create >
	TYPE	OUTDIR
	HRROI	T1,[ASCIZ/
 error is: /]
	CALL	LSTERO
	TYPE	[ASCIZ/ - RETRYING
/]
	JRST	CREAGA

CREERR:	TXON	P4,CD%NCE	;LAST DITCH EFFORT - TRY THIS
	JRST	CRETR2
CRETFL:	ERROR	<Directory >,.+1
	TYPE	OUTDIR
	TYPE	[ASCIZ/ not created/]
	CALL	LSTERD
	TYPE	CRLF
	JRST	HUNTIN		;TRY TO CONTINUE
	SUBTTL	Print command

PRINT:	GUIDES	<DIRECTORY OF TAPE ONTO FILE>
	SETZM	PRIFLG		;NO PRINT OPTION FLAGS YET
	MOVX	T1,GJ%NEW
	MOVEM	T1,GTJBLK+.GJGEN
	SETZM	GTJBLK+.GJDEV
	SETZM	GTJBLK+.GJDIR
	SETZM	GTJBLK+.GJNAM
	HRROI	T1,[ASCIZ/LST/]
	MOVEM	T1,GTJBLK+.GJEXT
PRINTR:	DMOVE	T1,[EXP CMDBLK,PRIINB]
	CALL	PARSE		;GET OUTPUT FILENAME
	 JSERRD	<>,NOCMD
	CAIE	T3,.CMSWI
	JRST	PRINTJ
	HRRZ	T2,(T2)
	JRST	(T2)
PRINTJ:	CALL	RPSJFN
	CALL	CHKJFN
	TLNE	T3,-1		;ILLEGAL IN ANY WAY?
	 ERROR	<Illegal PRINT file choice>,NOCMD
	SETZM	PRITTY
	CAIN	T3,.DVTTY
	SETOM	PRITTY
	CONFIRM
	CALL	OPNLSF		;OPEN LIST FILE, 1ST PAGE
	 JRST	NOCMD
	MOVE	T1,PRIFLG
	TXNN	T1,P.FAST	;DOING A FAST PRINTING?
	JRST	PRINTK		;NO
	MOVSI	T1,(1B0)	;YES.  SET PAGE COUNT TO -INFINITY TO..
	MOVEM	T1,LSTLIN	;MAKE SURE NO LIST FILE PAGING OCCURS
PRINTK:	SETOM	OKIAE		;INTERRUPTS HO
	CALL	GMOJFI		;GET TAPE FOR READING
	 JRST	NOCMD
	TXO	F,F.NVOL	;WE WANT TO HANDLE THIS OURSELF
PRILOP:	SELECT	LS.TTY		;GETREC MAY NEED THE TERMINAL
	CALL	GETREC
PRILO2:	SELECT	LS.LST		;TALK TO LIST FILE
	MOVE	Q3,PRIFLG	;GIVE EACH ROUTINE THE PRINT FLAGS IN Q3
	JRST	@[EXP DATAPR,SAVSPR,FILBPR,FILEPR,TAPNPR
		  EXP DIREPR,CONTPR,PRILOP,TONEPR](T3)
; These are: Data record, Saveset beginning, File header, File trailer, EOT,
;   Directory record, Continued Saveset beginning, Saveset end, Next tape record
TONEPR:	TXO	F,F.NVOL	;THIS GOT TURNED OFF, PUT IT BACK ON
	TYPE	[ASCIZ/
End of tape /]
	MOVE	T2,TAPENO
	CALL	DECOUT
	TYPE	[ASCIZ/, Saveset continued on next tape
/]
	MOVE	T1,LSTJFN
	TXO	T1,CO%NRJ	;CLOSE WITHOUT LOSS OF JFN
	CLOSF%
	 ERJMPS	.+1		;SNH
	SELECT	LS.TTY		;UPTAPE MIGHT WANT THE TTY
	CALL	UPTAPE
	MOVE	T1,LSTJFN
	CALL	OPNLST		;OK, CONTINUE THE LIST FILE
	 JFCL
	MOVE	T3,LASTYP	;GET RECORD TYPE THAT UPTAPE READ
	TXNN	Q3,P.FAST
	JRST	PRILO2		;UPTAPE DOES A GETREC FOR US
	MOVSI	T1,(1B0)
	MOVEM	T1,LSTLIN	;OPNLST SET THIS. RESET IT FOR /FAST
	JRST	PRILO2

CONTPR:
SAVSPR:	HRLZ	T1,CURDAT	;FROM LAST RECORD IN
	HRRI	T1,SSNBUF	;TO NORMAL SAVESET BUFFER
	BLT	T1,SSNBUF+777	;COPY IT IN
	SKIPE	PRITTY		;PRINTING TO A TTY?
	JRST	SAVSP2		;YES. DON'T TYPE SAVESET HEADER
	SELECT	LS.TTY		;NO, LET USER SEE SAVESET HEADER
	CALL	LINE1A		;SET UP STRING WITH A HEADER
	TYPE	STRING
	TYPE	CRLF
	SELECT	LS.LST
SAVSP2:	MOVE	T1,PRIFLG	;IN "FAST" MODE?
	TXNE	T1,P.FAST	;..?
	JRST	SAVSPF		;YES
	SETOM	LSTLIN		;FORCE NEW PAGE HEADER, WHICH HAS..
	JRST	PRILOP		;THE NEW SAVESET INFO
SAVSPF:	TYPE	CRLF2		;FAST MODE, JUST DO A FAST HEADER, NO <FF>,
	CALL	LINE1A		;JUST WITH GENERAL TAPE INFO
	CALL	LINE1B
	JRST	PRILOP


DIREPR:	TYPE	[ASCIZ/
 DDB for /]
	TYPE	UHNAM(T2)
 IFG FTVERS-5,<
	MOVE	T1,.CDLEN(T2)	;GET LENGTH OF DDB
	ANDI	T1,377		;DISCARD ANY OTHER INFO
	CAIGE	T1,.CDPEV	;DOES IT HAVE PASSWORD ENCRYPTION INFO?
	JRST	PRILOP		;NO, DONE
	PUSH	P,.CDPEV(T2)	;SAVE THIS FOR A MOMENT
	MOVEI	T2,DDCOL
	CALL	TABOUT
	TYPE	[ASCIZ/PEV: /]
	POP	P,T2		;OK, GET ENCRYPTION NUMBER
	CALL	DECOUT
 >
	JRST	PRILOP

FILBPR:	MOVE	Q1,T2		;SAVE THE DATA POINTER
	MOVE	T1,CURHEA
	SKIPGE	.PAGNO(T1)	;CONTINUED FILE?
	TYPE	[ASCIZ/
File Continued from previous reel/]
	TYPE	CRLF
	MOVEI	T2,FLCOL
	TXNE	Q3,P.FAST
	MOVEI	T2,FFLCOL
	CALL	TABOUT
	MOVE	T2,Q1
	HRLI	T2,(POINT 7)
DIRF1:	ILDB	T1,T2
	CAIE	T1,";"		;END OF GENERATION? DONE
	JUMPN	T1,DIRF1
	SETZ	T1,
	DPB	T1,T2
	HRRO	T2,Q1		;POINTER TO FILENAME
	TYPEAT	T2		;DO IT
	TXNN	F,F.CHKS	;ANY CHECKSUMMING?
	JRST	PRILOP		;NO, AND THE REST IS DONE BY FILEPR
	SETZM	CHKCN0		;SET UP FOR CHECKSUMMING
	SETZM	LSTPGE
	MOVEI	T4,FDBOFF(Q1)	;POINT T4 TO FDB INFO FOR FILSZA
	CALL	FILSZA		;CALC SIZE
	JRST	PRILOP

DATAPR:	TXNN	F,F.CHKS
	JRST	PRILOP		;IF NOT CHECKSUMMING, IGNORE DATA
	MOVE	T1,CURHEA
	MOVE	T1,.PAGNO(T1)	;CHKSFF EXPECTS THIS IN TAPHEA+.PAGNO
	MOVEM	T1,TAPHEA+.PAGNO;DON'T DISAPPOINT IT
	MOVE	T2,CURDAT
	CALL	CHKSFF
	JRST	PRILOP

FILEPR:	MOVE	Q1,T2		;DATA POINTER
	MOVEI	T2,WTCOL
	TXNE	Q3,P.FAST
	MOVEI	T2,FWTCOL
	CALL	TABOUT
	MOVE	T2,.FBWRT(Q1)
	CALL	TADOUT
	MOVEI	T2,SZCOL
	TXNE	Q3,P.FAST
	MOVEI	T2,FSZCOL
	CALL	TABOUT
	HRRZ	T2,.FBBYV(Q1)
	CALL	DECOUT
	TXNN	F,F.CHKS
	JRST	PRILOP
	MOVEI	T2,CSCOL
	TXNE	Q3,P.FAST
	MOVEI	T2,FCSCOL
	CALL	PRTCS2
	JRST	PRILOP

TAPNPR:	TYPE	[ASCIZ/

 End of Tape./]
	SELECT	LS.TTY
	CALL	ENDLIS
	JRST	CMDFIN

PRIFST:	MOVX	T1,P.FAST
	IORM	T1,PRIFLG
	JRST	PRINTR

PRIINB:	<.CMOFI>B8+CM%DPP+PR2INB
	BLOCK	2
	-1,,[ASCIZ/TTY:/]
PR2INB:	<.CMSWI>B8
	EXP	PRITAB

PRITAB:	PRILEN,,PRILEN
	[ASCIZ/FAST/],,PRIFST
	 PRILEN=.-PRITAB-1
	SUBTTL	MAIL command
 IFN FTMAIL,<
MAIL:	TXNN	F,F.PRIV		;ENABLED?
	JRST	OPRERR			;NO, GO AWAY
	GUIDES	<from list file>
	DMOVE	T1,[EXP CMDBLK,MAIINB]
	CALL	PARSE
	 JSERRD	<>,NOCMD,JRST
	CALL	RPSJFN
	CONFIRM
	HRRZ	T1,T2
	MOVEM	T1,MALJFN
	MOVE	T2,[7B5+OF%RD]
	OPENF%
	 JSERRD	<Can't read LIST file>
	MOVX	T1,G1%IIN		;SET UP FOR LATER GTJFN
	MOVEM	T1,GTJBLK+.GJF2		;ALLOW INVISIBLE FILES
	MOVE	T1,[.NULIO,,.NULIO]	;ENTIRE FILENAME FROM T2
	MOVEM	T1,GTJBLK+.GJSRC
	SETZM	LSTDIR
SCNFIL:	MOVE	T1,MALJFN
SCNFIA:	BIN%
	 ERJMPS	MALEOF			;EOF? GO FINISH
	CAIE	T2,.CHCRT		;SKIP END OF LINE STUFF
	CAIN	T2,.CHLFD
	JRST	SCNFIA
	CAIE	T2,"*"			;"*" MEANS SOMETHING TO DO
	JRST	TOSLI2			;NO, SKIP THIS LINE
	BIN%
	 ERJMPS	MALEOF
	HRROI	T1,[ASCIZ/The following have been saved by DUMPER/]
	CAIE	T2,"S"
	HRROI	T1,[ASCIZ/The following have been restored by DUMPER/]
	MOVEM	T1,MALBLK+1	;SUBJECT FIELD
	MOVE	T1,MALJFN
SKPWHI:	BIN%
	 ERJMPS	MALEOF
	CAIE	T2,.CHTAB
	CAIN	T2," "
	JRST	SKPWHI
	MOVE	T3,[POINT 7,STRING]	;FOR FULL FILENAME
	IDPB	T2,T3
RINFIL:	BIN%				;COPY FILENAME OUT
	 ERJMPS	MALEOF
	CAIN	T2,"V"-100		;'WARE OF ^V
	JRST	[IDPB	T2,T3
		 BIN%
		  ERJMPS MALEOF
		 IDPB	T2,T3
		 JRST	RINFIL]
	CAIN	T2," "			;USUALLY TERMINATES ON <SPACE>
	JRST	GOTFIL
	CAIE	T2,.CHCRT		;ALLOW FOR <TAB>, <CR> TOO
	CAIN	T2,.CHTAB
	JRST	GOTFIL
	IDPB	T2,T3			;PART OF A FILENAME, COPY IT
	JRST	RINFIL
GOTFIL:	HRROI	T1,CRLF
	MOVE	T2,T3
	CALL	CSTR
	HRROI	T1,STRING
	SETZB	T4,MALTO	;COPY NOWHERE
	MOVEI	T2,74		;OPEN ANGLE
	CALL	CPYDLM
	SETZM	NUMDOT		;REMEMBER WHERE EACH DOT IS
	MOVE	T4,[POINT 7,MALTO]
CPYDIR:	ILDB	T3,T1
	JUMPE	T3,NOUSRN
	IDPB	T3,T4
	CAIN	T3,76
	JRST	ECPDIR
	CAIE	T3,"."
	JRST	CPYDIR
	AOS	T3,NUMDOT
	MOVEM	T4,DOTLOC-1(T3)
	JRST	CPYDIR
ECPDIR:	SETZ	T3,
	DPB	T3,T4
	HRROI	T2,MALTO
	CALL	CHKUSR
	 JRST	OKUSRN		;OK IF NO SKIP
	SOSGE	T1,NUMDOT
	JRST	NOUSRN
	MOVE	T4,DOTLOC(T1)
	JRST	ECPDIR
NOUSRN:	SETZM	MALTO		;TRY TO GET MAIL ADDRESS FROM LAST WRITER
	MOVX	T1,GJ%OLD+GJ%XTN
	MOVEM	T1,GTJBLK+.GJGEN
	HRROI	T2,STRING
	MOVEI	T1,GTJBLK
	GTJFN%
	 ERJMPS	TOSLIN		;CAN'T?!
 IFN FTLWR,<
	HRLI	T1,.GFLWR
 >
 IFE FTLWR,<
	HRLI	T1,.GFAUT
 >
	HRROI	T2,MALTO
	GFUST%
MLEXKL:	HRRZS	T1
	RLJFN%
	 ERJMPS	.+1
OKUSRN:	SKIPN	LSTDIR		;DO WE HAVE AN OLD MAIL ADDRESS TO CHECK?
	JRST	FIRMAL		;NO, THIS IS THE FIRST MAIL TRIED
	HRROI	T1,MALTO	;CHECK FOR SAMENESS
	HRROI	T2,LSTDIR
	CALL	STCMPC
	JUMPE	T3,EQUSNS	;SAME IF 0
SNDFUL:	CALL	GOMAIL		;HERE IF TIME TO SEND A BUFFERFUL OUT
	TRNA
FIRMAL:	CALL	MLINIT
	HRROI	T1,MALTO	;COPY NEW USERNAME
	HRROI	T2,LSTDIR	;TO HERE FOR COMPARES AND SENDS
	CALL	CSTR
	MOVE	T1,[POINT 7,FILNMS] ;INIT POINTER TO WHERE FILENAMES GO
	MOVEM	T1,FILNMM	;..
	MOVEM	T1,MALBLK+2	;THIS WILL BE THE SUBJECT TEXT
EQUSNS:	MOVE	T2,FILNMM	;SET UP TO ADD NEW FILENAME TO BUFFER
	HRREI	T1,-FILNMS-170(T2) ;IS BUFFER FULL (170 WORDS USED?)
	JUMPG	T1,SNDFUL	;YES, GO DUMP AND SET UP ANOTHER BUFFER
	HRROI	T1,STRING
	CALL	CSTRB
	MOVEM	T2,FILNMM	;STORE POINTER BACK FOR NEXT APPEND
TOSLIN:	MOVE	T1,MALJFN	;FROM MAIL INPUT FILE
TOSLI2:	SETZ	T2,		;TO NOWHERE
	MOVEI	T3,377777	;ALLOW FOR LOTS OF CHARACTERS
	MOVEI	T4,.CHLFD	;AND READ UNTIL <LF>
	SIN%			;GO
	 ERJMPS	MALEOF		;CERTAINLY EOF
	JRST	SCNFIL		;OK, GET NEXT LINE
MALEOF:	CLOSF%
	 ERJMPS	.+1
	SETZM	MALJFN
	SKIPE	LSTDIR
	CALL	GOMAIL
	CALL	MLDONE		;FINISH OUT MAIL
	JRST	CMDEND

GOMAIL:	TYPE	[ASCIZ/
	/]
	TYPE	LSTDIR
	TYPE	CRLF
	TYPEAT	MALBLK+2
DOMAIL:	HRROI	T3,LSTDIR
	MOVEM	T3,MALBLK+0
	MOVEI	T1,MALBLK
	MOVEI	T2,.MLNFL
	JRST	MLTLST

MAIINB:	<.CMIFI>B8+CM%DPP
	BLOCK	2
	-1,,LSTFIL
>
	SUBTTL	Terminal and List file output
;Terminal and list file, etc I/O subroutines

;Get text to proper places (Terminal, list file, etc).  OUTMSG if the pointer
; passed could be anything, including null.  OUTMSS if the pointer certainly
; contains some sort of pointer.  OUTMSA if the pointer is PSOUT% legal.
; OUTMTT if the string is in STRING.
; TYPE and TYPEAT come here.  Enter with T1 on the stack.
OUTMSG:	JUMPE	T1,OUTMS3	;NULL POINTER OR CHARACTER? NOOP IF SO.
OUTMSS:	TLNE	T1,-1		;POINTER OR CHARACTER?
	JRST	OUTMSA		;POINTER, GO USE
OUTMSC:	HRLZM	T1,OUTMSX	;CHARACTER.  TUCK INTO STORAGE..
	SKIPA	T1,[POINT 7,OUTMSX,10] ;AND FETCH A POINTER TO IT
OUTMTT:	HRROI	T1,STRING	;WHERE CALLER WROTE STRING
OUTMSA:	MOVEM	T1,OUTMST	;STORE THE POINTER TO THIS TEXT
	PUSH	P,T4		;SAVE T4
	MOVE	T4,LSTFLG	;ARE WE WRITING THIS ANYWHERE?
	TXNE	T4,LS.TTY	;OUT TO PRIMARY OUTPUT?
	PSOUT%			;YES
	TXNE	T4,LS.LST
	SKIPN	T1,LSTJFN	;FETCH LIST JFN
	JRST	OUTMSD		;NOT AVAILABLE, FINE
	PUSH	P,T2
	PUSH	P,T3
	MOVE	T3,LSTLIN
	AOSN	T3		;IF -1, REQUESTING A HEADER
	CALL	FSTPGN		;GIVE IT
	MOVE	T2,OUTMST	;POINTER TO TEXT
	SETZ	T3,		;GO UNTIL NULL SEEN
	SOUT%			;WRITE TO LIST FILE
	 ERJMPS	NOLSTF
	SKIPGE	T3,LSTPOS	;DID CALLER ALREADY FIGURE LSTPOS FOR US?
	JRST	[MOVNS	T3	;YES, JUST SET IT RIGHT
		 JRST	CNTSP2]
	MOVE	T1,OUTMST
	TLC	T1,-1		;UPDATE LSTPOS
	TLCN	T1,-1
	HRLI	T1,(POINT 7)
CNTSPC:	ILDB	T2,T1
	JUMPE	T2,CNTSP2
	CAIN	T2,.CHCRT
	JRST	[SETZ	T3,
		 JRST	CNTSPC]
	CAIN	T2,.CHLFD
	JRST	PAGTST		;<LF> DONE BELOW
	CAIN	T2,.CHTAB
	JRST	[TRO	T3,7
		 AOJA	T3,CNTSPC]
	CAIGE	T2," "
	ADDI	T3,1		;ASSUME CTRL CHARS ARE 2 WIDE (^x)
	AOJA	T3,CNTSPC

PAGTST:	AOS	T4,LSTLIN
	CAIL	T4,PAGLIN	;LINES/PAGE
	CALL	FSTPGN		;NEED A PAGE HEADER
	JRST	CNTSPC		;NOT A NEW PAGE YET, GO ON

FSTPGN:	PUSH	P,T1
	MOVE	T1,LSTJFN	;SET UP TO OUT A ^L
	MOVEI	T2,.CHFFD
	BOUT%
	 ERJMPS	.+1
 IFN FTCKPN,<
	MOVE	T1,LSTJFN
	TXO	T1,CO%NRJ	;CHECKPOINT THE FILE
	DOJSS	CLOSF%, .+1
	HRRZS	T1
	MOVE	T2,[7B5+OF%APP]
	DOJSS	OPENF%, .+1
 >
	CALL	LINE1A		;OUTPUT FIRST HEADER LINE
	CALL	LINE1B		;..
	CALL	LINE2		;OUTPUT SECOND HEADER LINE
	POP	P,T1
	RET

;LINE1A/B and LINE2 are not as symeterical as the names make them appear.
; LINE1A doesn't touch the line counts, hence
; is useful for to-the-terminal output.  LINE2 assumes LINE1A was called and
; does things like setting the line count for the list file.
;Set up STRING to contain a savest header
LINE1A:	HRROI	T2,STRING	;COPY LINE INTO STRING
	HRROI	T1,[ASCIZ/
 DUMPER tape #/]
	CALL	CSTRB
	MOVE	T1,TAPENO
	CALL	NOUTB
	SKIPN	SSNBUF+SV.TAD	;IS THERE A DATE?
	JRST	NODATL
	HRROI	T1,[ASCIZ/, /]
	CALL	CSTRB
	CALL	ODTIMB
NODATL:	HRROI	T1,[ASCIZ/. /]
	CALL	CSTRB
	SKIPN	T1,SAVETP
	JRST	NOSPCL
	LDB	T1,[POINT 3,T1,2];COPY THE TYPE BITS OVER
	HRRO	T1,[
		[ASCIZ/ COLLECTION save /]
		[ASCIZ/ ARCHIVE save /]
		[ASCIZ/ MIGRATION save /] ]-1(T1)
	CALL	CSTRB
NOSPCL:	SKIPN	T4,SSNBUF+SV.PNT
	MOVEI	T4,SV.MSG
	SKIPN	SSNBUF(T4)
	JRST	NONAME
	HRROI	T1,[ASCIZ/ "/]
	CALL	CSTRB
	HRROI	T1,SSNBUF(T4)
	CALL	CSTRB
	HRROI	T1,[ASCIZ/"/]
	CALL	CSTRB
NONAME:	SKIPN	VOLID
	RET
	HRROI	T1,[ASCIZ/  volid /]
	CALL	CSTRB
	HRROI	T1,VOLID
	JRST	CSTR

LINE1B:	SKIPN	T1,LSTJFN
	RET
	HRROI	T2,STRING
	SETZ	T3,
	SOUT%
	 ERJMPS	.+1
	RET

LINE2:	HRROI	T2,[ASCIZ/
     Filename                                               Last write date/]
	CALL	LSTSOT
	HRROI	T2,[ASCIZ/     Pages               Checksum      Page #/]
	CALL	LSTSO2
	AOS	T2,LSTPGN	;UP AND OUT IT
	CALL	LSTDEC
	HRROI	T2,CRLF2	;BLANK LINE OUTPUT
	CALL	LSTSOT		;THIS ALSO ZEROS T3 FOR US
	MOVEI	T1,3
	MOVEM	T1,LSTLIN
	RET

LSTDEC:	MOVEI	T3,^D10
	MOVE	T1,LSTJFN
	NOUT%
	 ERJMPS	.+1
	RET

LSTSOT:	SETZ	T3,
	MOVE	T1,LSTJFN
LSTSO2:	SOUT%
	 ERJMPS	.+1
	RET

CNTSP2:	MOVEM	T3,LSTPOS
	POP	P,T3
	POP	P,T2
OUTMSD:	POP	P,T4
OUTMS3:	POP	P,T1
	RET

;Error while writing list file - end the list file
NOLSTF:	CALL	ENDLIS
	MOVX	T4,LS.LST	;SAY NO MORE LIST FILE
	ANDCAM	T4,LSTFLG
	CALL	ANNERR		;ANNOUNCE ERROR
	TYPE	[ASCIZ/?Error writing LIST file, list file ended
/]				;RECURSION!
	SETZ	T3,
	JRST	CNTSP2

TADOUT:	PUSH	P,T1
	JUMPE	T2,[HRROI T1,[ASCIZ/(Never)/]
		   JRST OUTMSA]
	MOVX	T3,OT%NSC+OT%NCO+OT%SCL
	HRROI	T1,STRING
	ODTIM%
	 ERJMPS	.+1
	JRST	OUTMTT

;Here with a number in T2 to output. DECOUT loses T3.  DECOUT & NUMOUT
; act identically to TYPE (it calls OUTMSG).  NUMOUT can be treated
; exactly like NOUT% in terms of radixs and flags.
DECOUT:	MOVEI	T3,^D10		;RADIX 10
NUMOUT:	PUSH	P,T1		;MOSTLY BECAUSE OUTMSA WANTS IT
	HRROI	T1,STRING
	NOUT%
	 ERJMPS	OUTMTT
	JRST	OUTMTT

;here with a number in T2 to output as floating point, as xxxx.yy
FLTOUT:	PUSH	P,T1		;FOR OUTMSA
	HRROI	T1,STRING
	MOVX	T3,FL%ONE+FL%PNT+FL%OVL+2B17+4B23+2B29
	FLOUT%
	 ERJMPS	OUTMTT
	JRST	OUTMTT

;Does everything INICHR does, but types out a message as well.
INIMSG:	CALL	INICHR
	PUSH	P,T1
	JRST	OUTMSG

;Here to CR as needed and type out a dollarsign or space as a message
; leadin (depending on whether we are on a pseudoterminal or not).
INICHR:	CALL	IFCRLF
	PUSH	P,T1
	MOVEI	T1," "
	TXNE	F,F.SUBJ
	MOVEI	T1,"$"
	JRST	OUTMSC

;TABOUT only works for the list file (because OUTMSG only follows the line
; position of the list file)
; Give it the column to get to in T2.  This always outputs at least 1 space.
TABOUT:	PUSH	P,T1		;BECAUSE OUTMSA WANTS THAT
	MOVE	T1,[POINT 7,TABTMP] ;A PLACE TO WRITE TO
	MOVE	T3,LSTPOS	;FIND OUT WHERE WE ARE
	MOVEM	T3,LSTTMP	;SAVE IT
	MOVEI	T4,.CHTAB	;PREPARE TO WRITE SOME TABS
	TRZ	T3,7		;FIGURE THE EFFECT OF THE FIRST TAB
	ADDI	T3,8		;..
TABITH:	IDPB	T4,T1		;IN GOES THE TAB
	CAIL	T3,(T2)		;FAR ENOUGH?
	JRST	TTOFAR		;YES, MAYBE TOO FAR
	MOVEM	T3,LSTTMP	;TAB WAS OK, REMEMBER WHERE WE ARE
	ADDI	T3,8		;SIMULATE THE NEXT TAB
	JRST	TABITH		;AND GO DO IT
TTOFAR:	CAIG	T3,(T2)		;DID WE GO TOO FAR?
	JRST	TOKOUT		;NO, JUST RIGHT, FINISH UP
	MOVEI	T4," "		;TOO FAR, OVERWRITE LAST TAB WITH SPACE
	DPB	T4,T1		;..
	AOS	T3,LSTTMP	;ACCOUNT FOR SPACE
TSPOUT:	CAIL	T3,(T2)		;ENOUGH SPACES?
	JRST	TOKOUT		;YES, FINISH UP
	IDPB	T4,T1		;NO, SPACE GOES IN
	AOJA	T3,TSPOUT	;ADVANCE THE COUNT AND GO ON
TOKOUT:	MOVNM	T3,LSTPOS	;TELL OUTMSA WE FIGURED THE LENGTH FOR IT
	SETZ	T4,		;NULL TO END
	IDPB	T4,T1		;..
	HRROI	T1,TABTMP	;THE STRING WE WROTE
	JRST	OUTMSA		;GETS WRITTEN NOW

;Here to set up the list file
SETLST:	SKIPE	LSTJFN
	JRST	LSTAGA
	SKIPN	LSTFIL		;LIST FILE REQUESTED?
	JRST	CPOPJ1
	HRROI	T2,LSTFIL
	MOVX	T1,GJ%SHT
	GTJFN%
	 ERJMPS	NOLISK
OPNLSF:	SETZM	LSTPGN		;PAGE 0
OPNLST:	MOVE	T2,[7B5+OF%APP]
	DOJSS	OPENF%, NOLISF
	HRRZM	T1,LSTJFN
LSTAGA:	SETOM	LSTLIN		;LINE -1 MEANS FORCE A HEADER
	SETZM	LSTPOS		;COLUMN 0
	JRST	CPOPJ1
NOLISF:	HRRZS	T1
	RLJFN%
	 ERJMPS	.+1
NOLISK:	JSERRD	<Can't set up list file>,.+1,JRST
	RET

;Here to close out the list file
ENDLIS:	SKIPE	T1,LSTJFN	;LIST FILE HERE?
	CLOSF%			;YES, CLOSE IT
	 ERJMPS	.+1
	SETZM	LSTJFN
	RET

;Here when switching tapes with list file open
NTLIST:	PUSH	P,LSTFLG	;YES, SAVE LIST FLAGS,..
	SELECT	LS.LST		;AND OUT TO LIST ONLY
	TYPE	[ASCIZ/

 End of Tape /]			;NOTE ON LIST FILE WHERE TAPE ENDED
	MOVE	T2,TAPENO
	CALL	DECOUT
	TYPE	[ASCIZ/, continuing...
/]
	POP	P,LSTFLG	;RESTORE THIS
	SETOM	LSTLIN		;NEXT OUTPUT STARTS A NEW PAGE
	RET
	SUBTTL	Information routines
;Information subroutines

;SETWLD sets the GTJFN block to *.*.* including invisible files
;Pass in T1/ pointer to structure (no colon) and T2/ pointer to
; directory string (no punctuation), and T3/ flags for .GJGEN
SETWLD:	DMOVEM	T1,GTJBLK+.GJDEV;SET .GJDEV AND .GJDIR
	MOVE	T1,[.PRIIN,,.PRIOU]	;PRIMARY INPUT AND OUTPUT
	MOVEM	T1,GTJBLK+.GJSRC
	MOVX	T1,G1%IIN	;FIND INVIS FILES, DON'T EXPAND LOGICALS
	MOVEM	T1,GTJBLK+.GJF2
	HRRI	T3,.GJALL	;DEFAULT VERSION TO *
	MOVEM	T3,GTJBLK+.GJGEN
	HRROI	T1,[ASCIZ/*/]	;GET WILDCARD STRING
	MOVEM	T1,GTJBLK+.GJNAM;DEFAULT NAME TO FULL WILDCARD
	MOVEM	T1,GTJBLK+.GJEXT;AND EXTENSION
	RET

;TAKES Q1/ index into JFNLST and sets GTJBLK accordingly
OFNAME:	MOVE	T2,JFNLST(Q1)
	MOVSI	T4,-NFLDS
	TXNN	F,F.WILD	;DEFAULT TO CONNECTED DIRECTORY ALWAYS?
	JRST	OFNAM1		;NO, SET UP NORMALLY
	SETZM	GTJBLK+.GJDEV	;MAKE SURE THESE ARE NULL
	SETZM	GTJBLK+.GJDIR	;..
	ADD	T4,[2,,2]	;AND SKIP THE SETUP OF STR:<DIR>
OFNAM1:	HRRO	T1,FLDOFN(T4)
	SETZM	(T1)
	HLRZ	T3,FLDOFN(T4)
	CAIE	T3,0
	MOVEM	T1,GTJBLK(T3)
	MOVE	T3,FLDOF2(T4)
	JFNS%
	AOBJN	T4,OFNAM1
	RET

FLDOFN:	.GJDEV,,DEFSTR
	.GJDIR,,DEFDIR
	.GJNAM,,DEFNAM
	.GJEXT,,DEFEXT
	0,,DEFGEN
	 NFLDS=.-FLDOFN
FLDOF2:	EXP	1B2,1B5,1B8,1B11,1B14

;Here to open a JFN on the default file in GTJBLK. Returns +2 with
; the JFN in T1, or +1 if failing.
GDEFFL:	SETZ	T2,		;JUST USE DEFAULTS
GDEFFD:	PUSH	P,GTJBLK+.GJSRC	;SAVE THIS
	MOVE	T1,[.NULIO,,.NULIO] ;LEAVE USER OUT OF THIS
	MOVEM	T1,GTJBLK+.GJSRC ;SET SOURCE, DEST TO NULL
	MOVEI	T1,GTJBLK	;GET ADDRESS OF GTJGN BLOCK
	GTJFN%			;SYNTHESIZE JFN
	 ERJMPS	[SETZB	T1,T2
		 JRST	GDEFFA]	;FAILED
	MOVE	T2,T1		;RETURN IT IN T2 AND T1
GDEFFA:	POP	P,GTJBLK+.GJSRC
	JUMPN	T1,CPOPJ1
	RET

;CHKMTD just like CHKJFN, but skips if device is any MT/MTA
CHKMTJ:	PUSH	P,MTAUNT	;CALLER MIGHT CARE
	SETOM	MTAUNT		;BUT WE DON'T
	CALL	CHKJFN
	POP	P,MTAUNT
	CAIN	T3,.DVMTA
	JRST	CPOPJ1
	RET

;Just like CHKJFN, but skips if device is DISK or unknown
CHKDSK:	CALL	CHKJFN
	JUMPE	T3,CPOPJ1	;T3 = 0 MEANS DISK
	TLNE	T3,(1B2)	;T3/ 1B2 MEANS NO SUCH DEVICE (OFFLINE DISK)
	JRST	CPOPJ1
	RET

;CHKJFN does a DVCHR% on the JFN in T2.  It returns the following:
; T1/ JFN passed in
; T2/ device charactistics word or 0 if illegal
; T3/ device type (from T2) or 1B1 if its our magtape drive, or 1B2 if illegal
CHKJFN:	PUSH	P,T2
	HRRZ	T1,T2
	DVCHR%
	 ERJMPS	CHKJF2
	HRRE	T1,T3		;MAY WANT UNITS, STORE THEM
	LDB	T3,[POINT 9,T2,17] ;GET THE DEVICE TYPE IN T3
	SKIPN	MTJFN		;DO WE HAPPEN TO HAVE A DRIVE OPEN?
	JRST	CHKJF3		;NO, DON'T CHECK IF ITS REALLY OUR DRIVE
	CAIN	T3,.DVMTA	;MAGTAPE?
	CAME	T1,MTAUNT	;*OUR* MAGTAPE?
	JRST	CHKJF3
	MOVSI	T3,(1B1)	;1B1 MEANS ITS OUR DRIVE
	JRST	CHKJF3		;ITS OUR DRIVE, RETURN
CHKJF2:	MOVSI	T3,(1B2)	;ILLEGAL, 1B2
	SETZ	T2,
CHKJF3:	POP	P,T1		;JFN IN T1
	RET

;Put connected str and directory into place and return pointers to them
; in CONSTR and CONDIR.
GETCON:	SETZM	CONSTR		;CLEAR THIS IN CASE OF FAILURE
	SETZM	CONDIR		;AND THIS TOO
	SETO	T1,
	HRROI	T2,.JIDNO	;GET DIRECTORY NUMBER
	MOVEI	T3,T3		;INTO T3
	GETJI%
	 ERJMPS	CPOPJ		;DOESN'T HAPPEN
	MOVE	T2,T3		;MOVE TO T2 FOR DIRST%
	HRROI	T1,CONBUF	;POINT TO STORAGE
	DIRST%			;STORE CONNECTED STRUCTURE AND DIRECTORY
	 ERJMPS CPOPJ		;CAN'T (UNLIKELY)
	SKIPN	CONBUF		;MAKE SURE WE GOT SOMETHING
	RET			;DIDN'T, VERY STRANGE
	MOVE	T1,[POINT 7,CONBUF]	;GET POINTER TO THE STRING
	MOVEM	T1,CONSTR	;WHERE THE STRUCTURE NAME STRING STARTS
GETCN1:	ILDB	T2,T1		;READ NEXT CHARACTER
	CAIE	T2,":"		;END OF DEVICE?
	JRST	GETCN1		;NO, KEEP GOING
	SETZ	T3,		;YES, GET A NULL
	DPB	T3,T1		;OVERWRITE COLON TO TERMINATE DEVICE
	IBP	T1		;SKIP PAST ANGLE BRACKET
	MOVEM	T1,CONDIR	;REMEMBER POINTER TO DIRECTORY
GETCN2:	ILDB	T2,T1		;SEARCH FOR END OF DIRECTORY
	CAIE	T2,">"		;FOUND ENDING PUNCTUATION?
	JRST	GETCN2		;NO, KEEP GOING
	DPB	T3,T1		;REPLACE BRACKET WITH NULL
	RET			;DONE

;Get <input> directory number of not already known
GDIRNM:	SKIPE	T1,DMPNUM
	RET
	CALL	GDIRNA
	HRROI	T2,INDIR
	MOVX	T1,RC%EMO
	RCDIR%
	 ERJMPS	.+1
	MOVEM	T3,DMPNUM
	MOVE	T1,T3
	RET

;Get <input> if not already known
GDIRNA:	SKIPE	INDIR
	RET
	MOVE	T2,JFN
	MOVX	T3,1B2+1B5+JS%PAF
	HRROI	T1,INDIR
	JFNS%
	RET

TYJFN:	SKIPA	T2,JFN
TYJFN1:	MOVE	T2,T1
TYJFNS:	MOVE	T3,[JFNSAL]
TYJFNF:	HRROI	T1,STRING
	JFNS%
	 ERJMPS	CPOPJ
	PUSH	P,T1
	JRST	OUTMTT		;TYPE STRING

;Acts like CSTRB, except T1/ number to output (decimal)
NOUTB:	EXCH	T1,T2
	MOVEI	T3,^D10
	DOJSS	NOUT%, .+1
	EXCH	T1,T2
	RET

;ODTIM that acts like CSTRB - it gets the time from SSNBUF
ODTIMB:	MOVE	T1,T2
	MOVE	T2,SSNBUF+SV.TAD
	MOVX	T3,OT%NSC+OT%NCO+OT%SCL+OT%DAY
	DOJSS	ODTIM%, .+1
	MOVE	T2,T1
	RET

;Copy string and back up T2 on exit.  Return last character in T3.
CSTRB:	CALL	CSTR
BACKT2:	SETO	T3,
	ADJBP	T3,T2
	MOVE	T2,T3
	LDB	T3,T2
	RET

;Copy string T1 to T4 until null or char in T2 seen.  This obeys ^V!
CPYDLM:	TLCE	T1,-1
	TLCN	T1,-1
	HRLI	T1,(POINT 7)
	TLC	T4,-1		;TLC ONLY, SO T4/ 0 COPIES NOWHERE
	TLCN	T4,-1
	HRLI	T4,(POINT 7)
CPYDL2:	ILDB	T3,T1
	IDPB	T3,T4
	JUMPE	T3,CPOPJ
	CAIE	T3,(T2)
	JRST	CPYDL3
	SETZ	T3,
	IDPB	T3,T4
	RET
CPYDL3:	CAIE	T3,"V"-100
	JRST	CPYDL2
	ILDB	T3,T1
	IDPB	T3,T4
	JRST	CPYDL2

;Compare strings ref'd by T1 and T2; ret T3/ 0 if the same.
STCMPC:	TLCE	T1,-1
	TLCN	T1,-1
	HRLI	T1,(POINT 7)
	TLCE	T2,-1
	TLCN	T2,-1
	HRLI	T2,(POINT 7)
STCM1:	ILDB	T4,T1
	ILDB	T3,T2		;GET CHARS TO TEST
	CAIE	T3,(T4)		;SAME?
	SKIPA	T3,T1		;NO, RETURN T3 NONZERO
	JUMPN	T3,STCM1
	RET

;Here to make two strings the same after STCMPC said they weren't.  This
; expects T1,T2,T4 to not be touched since STCMPC.
STCOPY:	DPB	T4,T2
	JUMPE	T4,CPOPJ
	JRST	CSTRA

;More string copy stuff.  Takes T1 and T2 as the from and to, and returns
; T3 as 0.
APPSTR:	SETO	T3,
	ADJBP	T3,T2
	MOVE	T2,T3		;DESTINATION BACKED UP BY 1
CSTR:	TLCE	T1,-1
	TLCN	T1,-1
	HRLI	T1,(POINT 7)
	TLCE	T2,-1
	TLCN	T2,-1
	HRLI	T2,(POINT 7)
CSTRA:	ILDB	T3,T1
	IDPB	T3,T2
	JUMPN	T3,CSTRA
	RET

;Pointer to an ASCIZ string in T1, SIXBIT of first 6 characters back in T2
ASCSIX:	TLCE	T1,-1
	TLCN	T1,-1
	HRLI	T1,(POINT 7)
	MOVE	T3,[POINT 6,T2]
	SETZ	T2,
ASCSI1:	ILDB	T4,T1
	JUMPE	T4,CPOPJ
	CAIG	T4,"z"
	CAIG	T4," "
	JRST	ASCSI1
	CAIL	T4,"a"
	CAILE	T4,"z"
	TRNA
	SUBI	T4,"a"-"A"
	SUBI	T4," "
	IDPB	T4,T3
	TRNN	T2,77
	JRST	ASCSI1
	RET

;Convert integer volid number (in T1) to sixbit of digits (in T1).
NSVOL:	MOVE	T2,T1		;COPY INTEGER TO T2
	SETZ	T1,
NSVOL1:	IDIVI	T2,12		;DIVIDE BY 10
	IORI	T1,20(T3)	;PLUNK IN THE SIXBIT'D DIGIT
	ROT	T1,-6		;AND PUT IN PROPER PLACE
	JUMPN	T2,NSVOL1	;LOOP UNTIL NO DIGITS LEFT
	RET

;Output sixbit string in T3.  Hurts T2 and T3
SIXOUT:	PUSH	P,T1
	CALL	C6TO7
	DMOVEM	T2,STRING
	JRST	OUTMTT

;Take sixbit word in T3, returns asciz string in T2 and T3
C6TO7:	SETZ	T2,		;PREPARE TO CONVERT TO ASCIZ
	JUMPE	T3,CPOPJ	;IF NONE, ALREADY CONVERTED, SO TO SPEAK
	JRST	V6TO7B
V6TO7:	LSH	T2,1		;ROOM FOR ASCII BIT (OR, MAKE LEFT JUSTIFIED)
	TLNE	T2,774K		;DONE? (ANYTHING IN 1ST BYTE?)
	JRST	V6TO7D		;YES, GO STORE
V6TO7B:	LSHC	T2,6		;FETCH NEXT 6BIT BYTE INTO T2
	TRNE	T2,77		;IS IT REAL?
	ADDI	T2," "		;YES, CONVERT TO ASCII
	JRST	V6TO7
V6TO7D:	JUMPE	T3,CPOPJ	;IS 6TH BYTE NONEXISTANT?
	LSH	T3,-1		;NO, NEEDS CONVERTING
	ADD	T3,[BYTE(7) " ",0]
	RET

;Skip if string at T2 is NOT a valid username
CHKUSR:	MOVX	T1,RC%EMO
	RCUSR%
	 ERJMPS	CPOPJ1
	TXNN	T1,RC%NOM
	JRST	CPOPJ
	JRST	CPOPJ1

;Type new volid and time
GANEWT:	MOVE	T1,MTJFN
	CALL	GETVOL	
;**;[548] Add 7 lines at ANEWT:+1L		DEE	28-JAN-88
ANEWT:	TYPE	<[ASCIZ/ [ Beginning tape /]>
	MOVE T2, TAPENO		;[548] Get the tape number
	CALL DECOUT		;[548] Print it
	SKIPN VOLID		;[548] Is there a volume-id?
	JRST ANEWTU		;[548] Guess not
	TYPE [ASCIZ/ (/]	;[548] Yes, put it in parens
	TYPE VOLID		;[548] Print it
	TYPCHR ")"		;[548] Close paren
ANEWTU:	TYPE	[ASCIZ/, at /]
	SETO	T2,		;DO CURRENT TIME
	CALL	TADOUT		;..
	TYPE	SPCBCR
	RET
	SUBTTL	Memory management
;Memory management subroutines and friends

;Here we set up the values we need to make the memory manager routines run
; quickly.  MAPEND is the offset from MAPFRE to the last word in the map.
; LBIINI is the value that last word is set to to indicate what pages are
; available in that last set of 36.  The last word always flags at least
; one pair of pages (or it wouldn't be needed).
MAPEND=NUMPAG/^D36		;OFFSET TO LAST WORD IN MAP
%%C==<NUMPAG-<<NUMPAG/^D36>*^D36>>	;NUMBER OF BITS USED IN LAST WORD -1
LBIINI==1B0			;BUILD VALUE TO INIT LAST WORD WITH
REPEAT %%C,< LBIINI== <LBIINI_<-1>>!<1B0> > ;..

;Call here to set up the memory manager.
SETPGS:	SETOM	MAPFRE
	MOVE	T1,[MAPFRE,,MAPFRE+1]
	BLT	T1,MAPFRE+MAPEND-1	;MARK PAGES FREE SANS LAST SET
	MOVX	T1,LBIINI	;VALUE LAST WORD GETS
	MOVEM	T1,MAPFRE+MAPEND;INIT LAST SET SPECIALLY
	SETO	T1,
	MOVE	T2,[.FHSLF,,FRESPC]
	MOVE	T3,[PM%CNT!NUMPAG]
	PMAP%
	 ERJMPS	.+1
	RET

;Here to get a buffer (a set of contiguous pages) for any purpose.
;Enter with T1/ # of pages needed.  Return +2 with T2/ address of buffer
; or +1 if can't get pages
GETPGS:	CAIG	T1,0
	 ERROR	<GETPGS called with trash>,SPRREQ
	MOVEM	T1,GETTMP
GETPGA:	SETZ	T1,
GETPG1:	SKIPE	MAPFRE(T1)
	JRST	GETSCN
	CAIGE	T1,MAPEND	;AT END OF MAP?
	AOJA	T1,GETPG1	;NO, KEEP LOOKING
	RET			;NO PAGES AVAILABLE
GETSCN:	MOVE	T2,T1		;GEN. A BIT POINTER TO FIRST WORD..
	ADD	T2,[POINT 1,MAPFRE];WITH AN AVAILABLE PAGE
	IMULI	T1,^D36
	MOVEI	T3,NUMPAG
	SUBI	T3,(T1)		;THE NUMBER OF BITS TO CHECK
FNDCLU:	SOJL	T3,CPOPJ	;NO MORE BITS TO CHECK, FAILED
	ILDB	T1,T2		;IS THIS PAGE AVAILABLE?
	JUMPE	T1,FNDCLU	;0 MEANS TAKEN
	MOVEM	T2,GE2TMP	;SAVE POINTER TO POSSIBLE CANDIDATE
	MOVE	T4,GETTMP	;GET NUMBER OF PAGES NEEDED
MEACLU:	SOJE	T4,GOTCLU	;IF GOT ENOUGH, DONE
	SOJL	T3,CPOPJ	;END OF POSSIBILITIES? DONE.
	ILDB	T1,T2
	JUMPN	T1,MEACLU	;IF AVAILABLE, KEEP GOING
	JRST	FNDCLU		;NOT LONG ENOUGH.  KEEP LOOKING.
GOTCLU:	SETO	T1,		;BACK UP POINTER 1 FOR IDPB
	ADJBP	T1,GE2TMP
	MOVEM	T1,GE2TMP
	MOVE	T2,GETTMP	;# OF PAGES WANTED
	IDPB	T4,T1		;WRITE 0'S
	SOJG	T2,.-1		;..
	MOVEI	T2,FRESPC+NUMPAG;CAL. WORD ADDRESS
	SUBI	T2,(T3)
	MOVE	T3,GETTMP
	SUBI	T2,(T3)
	LSH	T2,9
	MOVE	T4,GE2TMP	;T3/ SIZE AND T4/ POINTER INTO MAPFRE
	DMOVEM	T3,SIZBUF(T2)	;STORE INTO SIZBUF AND PNTBUF
	SETZM	NXTBUF(T2)	;NO NEXT YET
	SETZM	TRPBUF(T2)	;NO SUCH POINTER YET
	SETZM	TREBUF(T2)
	SETZM	ERRCNT(T2)	;NO ERRORS ON WRITE YET
CPOPJ1:	AOS	(P)
CPOPJ:	RET

;RELPGT is just like RELPGS, except it types text pointed to by TRPBUF
; if nonzero.  This is for SAVE, which may have to type directory and
; filenames.
RELPGT:	SKIPE	T2,TRPBUF(T1)	;NO TEXT AT ALL?
	CAMN	T2,TREBUF(T1)	;OR BEGINNING=END?
	JRST	RELPGS		;NO TEXT, JUST DO RELPGS
RELP2:	ILDB	T3,T2		;FETCH COMMAND BYTE
	JRST	@[EXP RELPGS,TYFILE,TYDIRE,TYALLW,TYFLDR](T3)
TYFLDR:	TXNN	F,F.FILT+F.DIRT
TYFILE:	TXNE	F,F.FILT	;FILES MODE?
TYALLW:	TYPEAT	T2
	JRST	TTSCNO
TYDIRE:	TXNE	F,F.DIRT	;DIRECTORY MODE?
	TYPEAT	T2
TTSCNO:	ILDB	T3,T2		;FIND THE NULL
	JUMPN	T3,TTSCNO
	JRST	RELP2
;Enter with word address of buffer to free up
RELPGS:	PUSH	P,NXTBUF(T1)	;SAVE THE NEXT BUFFER ADDRESS
	DMOVE	T2,SIZBUF(T1)	;T2/ SIZE AND T3/ POINTER
	JUMPLE	T2,RELPG1	;IF PAGE IS DELETED ALREADY, SKIP ON
	SETOB	T1,SIZBUF(T1)	;A SOURCE OF 1'S, AND CLEAR SIZE
	IDPB	T1,T3
	SOJG	T2,.-1
RELPG1:	POP	P,T1		;RETURN ADDRESS OF NEXT BUFFER
	RET

;This returns the percentage of freespace currently used
PRCUSE:	SETZB	T2,T4		;CLEAR COUNT AND INDEX
CUPAG:	MOVE	T1,MAPFRE(T4)	;COUNT FREE PAGES IN THE MEMORY MANAGER
	MOVN	T3,T1
	TDZE	T1,T3		;2'S COMPLEMENT MAGIC
	SOJA	T2,.-2		;WE WANT A NEGATIVE COUNT
	CAIGE	T4,MAPEND	;END OF MAP?
	AOJA	T4,CUPAG	;NO, NEXT PIECE
	ADDI	T2,NUMPAG	;MAKE A POS. COUNT OF USED PAGES
	JUMPE	T2,CPOPJ	;IF NONE, DON'T BOTHER
	IMULI	T2,^D100	;CONVERT TO A PERCENTAGE
	IDIVI	T2,NUMPAG
	CAIE	T3,0
	ADDI	T2,1		;A REMAINDER IS GOOD ENOUGH REASON TO ROUND UP
	RET
	SUBTTL	Parsing subroutines
;Parsing subroutines

;KEYWRD parses a keyword.  Give it T1/ command block and T2/ addr of table.
; It returns as PARSE does (+1, +2).
KEYWRD:	MOVEM	T2,KEYINB+1
	MOVEI	T2,KEYINB
	;JRST	PARSE

; Sucessful parse returns usual flags in T1, usual stuff in T2, the
; type of block in T3, and the first block,,matching block in T4.
; Bad parse returns +1, good +2
;EOF at parse time causes a bop back to command processing.  This should
; be IMPOSSIBLE during the ^E commands, and if it happens all nell will
; break loose (since we go reset the stack).
PARSE:	COMND%
HITME:	 ERJMPR	PAREOF
	TXNE	T1,CM%NOP
	RET			;DIDN'T PARSE
	MOVE	T4,T3
	HRRZS	T3
	LDB	T3,[POINT 9,(T3),8]
	JRST	CPOPJ1

PAREOF:	CAIN	T1,DESX3	;DID WE LOSE THIS JFN?
	 JRST	[MOVEI	T1,TAKSTR	;YES, ASSUME ^C/START
		 MOVEM	T1,TAKSTK	;BLOW AWAY COMMAND STACK
		 MOVE	T1,[.PRIIN,,.PRIOU] ;AND TALK TO TERMINAL
		 MOVEM	T1,CMDBLK+.CMIOJ
		 JRST	PANIC]
	CAIE	T1,IOX4		;EOF?
	 JSERRD	<Can't parse command>,PANIC,JRST ;NO, COMPLAIN
	CALL	TAKEOF		;ASSUME EOF, DROP A COMMAND LEVEL
	 JSERRD	<Parse error>,PANIC,JRST ;IF THERE ISN'T A TAKE FILE, WEIRD
	JRST	PANIC		;IN ANY CASE, RESTART

;Here with a message pointer in T1 - type the message, wait for a <CR>, and
; return. ^E interrupts looked for (and a CONTINUE means no <CR> needed).
TRYAGA:	CALL	TSTINT
	 JRST	BAKOUT
	CALL	INIMSG
       	TYPE	[ASCIZ/, type <CR> to try again. /] 
	;JRST	RDLINI

;RDLINI checks for a ^E interrupt first and handles it
; (going to BAKOUT on an ABORT).  Ret +1.
; ^E will try to do good things here, but no promise can be given.
RDLINI:	CALL	TSTINT		;CHECK FOR INTERRUPT REQUEST
	 JRST	BAKOUT
	MOVEI	T1,RDLINF
	MOVEM	T1,TRAPTO
	HRROI	T1,LINBUF
	MOVE	T2,[RD%BRK+RD%BEL+RD%RAI+NLINB*5]
	SETZ	T3,
	RDTTY%
	 ERJMPS	RDLINF
	MOVEI	T2,.CHCRT	;TIE OFF LINE IN CASE ESC OR ^Z
	IDPB	T2,T1
	MOVEI	T2,.CHLFD
	IDPB	T2,T1
RDLINF:	SETZM	TRAPTO
	CALL	TSTINT
	 JRST	BAKOUT
	RET

;Here to push the JFN in T2 and the address of the "delete jfn" routine
; on the reparse stack.
RPSJFN:	MOVEI	T1,RPSJFD
	HRL	T1,T2
	;JRST	RPSMEM
;Here to save something on the reparse stack.  This stack is used when
; a command gets reparsed and things like JFNs need tossing out.
RPSMEM:	EXCH	T1,RPSSTK	;SAVE DATA, GET STACK POINTER
	PUSH	T1,RPSSTK	;PUT DATA ON REPARSE STACK
	EXCH	T1,RPSSTK	;GET T1 BACK, PUT STACK POINTER AWAY AGAIN
	RET
;Here to get something off the reparse stack. +1 ret with something in T1,
; +2 with nothing on stack anymore.
RPSGET:	EXCH	T2,RPSSTK
	TLNN	T2,-1		;EMPTY STACK?
	AOSA	(P)		;YES, SKIP RETURN
	POP	T2,T1
	EXCH	T2,RPSSTK
	RET

UNDO:	CALL	RPSGET
	JRST	GOUNDO		;RH OF T1 HAS THE ADDR OF A ROUTINE TO CALL
	RET			;NOTHING LEFT TO UNDO
GOUNDO:	CALL	(T1)		;GO DO ROUTINE
	JRST	UNDO		;GO UNTIL REPARSE STACK EMPTY
	JRST	UNDO		;IN CASE OF A SKIP RETURN

DRPJF2:	SKIPA	T1,T2		;DROP THE JFN IN T2
RPSJFD:	HLRZS	T1		;DROP THE JFN IN THE LF OF T1
;Here to drop the JFN in T1 as though we never touched it
DRPJFN:	JUMPE	T1,CPOPJ	;IF NO JFN, FINE
DRPJFA:	GTSTS%			;IS THE JFN OPEN AT ALL?
	JUMPL	T2,DRPOFN	;IF SO, CLOSF%
DRPUFN:	DOJSS	RLJFN%, DRPOFN	;IF NOT, RLJFN%, IF FAILS, CLOSF%
	RET
DRPOFN:	HRLI	T1,(CZ%ABT+CZ%NUD)
	CLOSF%			;THIS JFN NEVER HAPPENED
	 ERJMPS	.+1
	RET

;Parse a particular, common type of token.  These are common enough to
; warrant routines.

;CALL to confirm.  Skip ret if all OK.
CONFRM:	DMOVEM	T1,1(P)
	MOVEM	T3,3(P)
	DMOVE	T1,[EXP CMDBLK,CONINB]
	COMND%
	 ERJMPR	PAREOF
	TXNE	T1,CM%NOP
	 ERROR	<Not confirmed>,CPOPJ
	MOVE	T3,3(P)
	DMOVE	T1,1(P)
	JRST	CPOPJ1

;Here with a word address of a string to guide with in T1.  Skip if OK.
GUIDE:	HRROM	T1,GUIINB+.CMDAT
	DMOVEM	T2,1(P)
	DMOVE	T1,[EXP CMDBLK,GUIINB]
	COMND%
	 ERJMPR	PAREOF
	TXNE	T1,CM%NOP
	 ERROR	<Illegal guide word>,CPOPJ
	DMOVE	T2,1(P)
	JRST	CPOPJ1

;GET time/date from user, into T1
GETTAD:	DMOVE	T1,[EXP CMDBLK,GTDINB]
	CALL	PARSE
	 ERROR	<Illegal date/time given>,CPOPJ
	MOVE	T1,T2
	CONFIRM
	JRST	CPOPJ1

;YESNO returns -1 for YES and 0 for NO in T2.  It uses QUEST, and it checks
; for ^E (and does BAKOUT).  Give it T1/ pointer to question text.
YESNO:	MOVEM	P,TRAPSP
	MOVEM	T1,QYNPMT
	MOVEI	T1,YSQUIT	;ON AN INTERRUPT, TRAP TO YSQUIT
	MOVEM	T1,TRAPTO
	SETOM	QYNVAL		;IF INTERRUPTED/CONTINUED, ASSUME YES
YESNO2:	MOVE	T1,QYNPMT
	HRROI	T2,STRING
	MOVEI	T3,QYNBLK
	CALL	QUEST
	MOVEM	P,QYNTMP
QYNRPS:	MOVE	P,QYNTMP
	CALL	TSTINT
	 JRST	BAKOUT
	DMOVE	T1,[EXP QYNBLK,QYNINB]
	CALL	PARSE
	 JRST	BADYEN
	MOVE	T2,(T2)
	HRREM	T2,QYNVAL
	DMOVE	T1,[EXP QYNBLK,CONINB]
	CALL	PARSE
	 JRST	BADYEN
	TRNA
YSQUIT:	MOVE	P,TRAPSP
	SETZM	TRAPTO
	CALL	TSTINT
	 JRST	BAKOUT
	MOVE	T2,QYNVAL
	RET

BADYEN:	TXNN	F,F.SUBJ	;SUBJOB?
	ERROR	<Just need a YES or NO here> ;NO. ?ERROR IS OK.
	JRST	YESNO2		;IN ANY CASE ASK AGAIN


;QUEST takes the following:
; T1/ byte pointer to text to ask
; T2/ word address of some scratch space to build a prompt string
; T3/ address of COMND% block to use for prompting
;it returns with the init for prompting done and the address of the comnd
; block in T1.  Also turns on Question mode and meddles the OUTMSG flags.
QUEST:	PUSH	P,T3
	HRROM	T2,.CMRTY(T3)	;SET PROMPT LOCATION
	MOVX	T3,<BYTE(7)" ">
	TXNE	F,F.SUBJ
	MOVX	T3,<BYTE(7)"$">
	MOVEM	T3,(T2)
	HRLI	T2,(POINT 7,0,6)
	CALL	CSTR
	MOVE	T1,LSTFLG
	MOVEM	T1,LSTTMP
	SELECT	LS.TTY
	POP	P,T1
	MOVEI	T2,INIINB
	COMND%
	 ERJMPS	.+1
	MOVE	T1,(P)
	RET
;Info for the parsing routines

;These commands are not possible at the ^E caused prompt
CM1LST:	CM1LEN,,CM1LEN
	CTB	ARCHIV,	<ARCHIVE>
	CTB	CHECK,	<CHECK>
	CTB	$EOT,	<EOT>
	CTB	LEAVE,	<EXIT>
 IFN FTIND,<
	CTB	$INDMD,	<INDUSTRY>,	CM%INV
 >
	CTB	$INTER,	<INTERCHANGE>
 IFN FTMAIL,<
	CTB	MAIL,	<MAIL>
 >
	CTB	MIGRAT,	<MIGRATE>
	CTB	PRINT,	<PRINT>
	CTB	LEAVE,	<QUIT>,		CM%INV
	CTB	RESTOR,	<RESTORE>
	CTB	RETRIE,	<RETRIEVE>
	CTB	$REW,	<REWIND>
	CTB	DUMP,	<SAVE>
	CTB	$$SET,	<SET>
	CTB	$SKIP,	<SKIP>
	CTB	$TAPE,	<TAPE>
	CTB	TRANSF,	<TRANSFER>
	CTB	$UNL,	<UNLOAD>
	 CM1LEN=.-CM1LST-1

; These commands are only possible at the ^E caused prompt
CM2LST:	CM2LEN,,CM2LEN
	CTB	$ABORT,	<ABORT>
	CTB	$CONT,	<CONTINUE>
	 CM2LEN=.-CM2LST-1

; These commands are possible at any time
CMCLST:	CMCLEN,,CMCLEN
	CTB	$AB4,	<ABEFORE>
	CTB	$ACC,	<ACCOUNT>
	CTB	$ASI,	<ASINCE>
	CTB	$B4,	<BEFORE>
	CTB	$CSUM,	<CHECKSUM>
	CTB	$CREAT,	<CREATE>
	CTB	$DEN,	<DENSITY>
	CTB	$LDIR,	<DIRECTORIES>
 IFN FTEXAC,<
	CTB	EXACTM,	<EXACT>
 >
	CTB	$LFIL,	<FILES>
	CTB	$FMT,	<FORMAT>
	CTB	TYPHLP,	<HELP>
	CTB	$INISP,	<INITIAL>
	CTB	$LIST,	<LIST>
	CTB	$MB4,	<MBEFORE>
	CTB	$MSI,	<MSINCE>
	CTB	$NO,	<NO>
	CTB	$PAR,	<PARITY>
	CTB	$PRO,	<PROTECTION>
	CTB	$SIL,	<SILENCE>
	CTB	$SINCE,	<SINCE>
	CTB	$SSNAM,	<SSNAME>
	CTB	$SUP,	<SUPERSEDE>
	CTB	$TAKE,	<TAKE>
	 CMCLEN=.-CMCLST-1

QYNINB:	<.CMKEY>B8
	EXP	QYNLST
QYNLST:	 2,,2
	TB	0,	<NO>
	TB	-1,	<YES>

CM1INB:	<.CMKEY>B8+CMCINB
	EXP	CM1LST
CMCINB:	<.CMKEY>B8
	EXP	CMCLST
CM2INB:	<.CMKEY>B8+CM3INB
	EXP	CMCLST
CM3INB:	<.CMKEY>B8
	EXP	CM2LST

;Some parsing tokens
FICINB:	<.CMCFM>B8+FILINB
FILINB:	<.CMFIL>B8
GTDINB:	<.CMTAD>B8+GT2INB
	CM%IDA+CM%ITM
GT2INB:	<.CMTAD>B8
	CM%IDA
INIINB:	<.CMINI>B8
CONINB:	<.CMCFM>B8
TXTINB:	<.CMTXT>B8
MTAINB:	<.CMDEV>B8
NUMINB:	<.CMNUM>B8
	^D10
	SUBTTL	Error support
;ERROR and special output routines.

;ANNERR is good to call when you hit an error.  If you are in a TAKE file,
; it <CRLF>s at need and types the failing command back to the user.  It
; makes sure the next output starts at the margin and clears the input
; buffer.
ANNERR:	DMOVEM	T1,IFCTMP
	MOVX	T1,.CTTRM
	RFMOD%
	TXZE	T2,TT%OSP	;CLEAR ^O
	SFMOD%
	CFIBF%
	CALL	WHERE
	 JRST	.+2		;FROM FILE
	JRST	IFCRL2		;FROM TERMINAL
	MOVEM	T1,INPTMP
	CALL	IFCRL2
	TYPE	[ASCIZ/?In command /]
	TYPE	BFFR		;TYPE COMMAND
	CALL	IFCRL2
	TYPE	[ASCIZ/?In file /]
	MOVE	T2,INPTMP
	CALL	TYJFNS

	JRST	IFCRL2		;DO IFCRLF, RESTORING CALLER'S AC'S

CRLFEN:	DMOVEM	T1,IFCTMP
	MOVEI	T1,.PRIOU
	DOBE%
	RFPOS%
	ADD	T2,IFCTMP
	HRRZS	T2
	CAIGE	T2,^D80
	JRST	NOCRLF
	JRST	YSCRLF

IFCRLF:	DMOVEM	T1,IFCTMP
IFCRL2:	MOVEI	T1,.PRIOU
	DOBE%
	RFPOS%
	TRNE	T2,-1
YSCRLF:	TYPE	CRLF
NOCRLF:	DMOVE	T1,IFCTMP
	RET

;WHERE skips if the commands are coming in from .PRIIN
; The current input JFN is returned in T1
WHERE:	HLRZ	T1,CMDBLK+.CMIOJ ;GET THE INPUT SOURCE
	CAIN	T1,.PRIIN	;PRIMARY INPUT?
	AOS	(P)		;YES, SKIP RET
	RET

LSTERR:	TLCE	T1,-1		;ANY LEADER STRING BEYOND "?"
	TLCN	T1,-1
	HRLI	T1,(POINT 7)
	MOVEI	T2,2		;POINT TO 2ND CHARACTER
	ADJBP	T2,T1
	LDB	T2,T2		;FETCH
	TYPEAT	T1
	CAIE	T2,0		;JUST ONE CHAR (IE, "?") ?
LSTERD:	TYPE	[ASCIZ/ - /]	;IF YES, DON'T TYPE THIS
	JRST	LSTERO
;HERE WITH THE ERROR CODE (OR -1 FOR LAST) IN RH OF T2
LSTERC:	HRRZ	T1,T2		;IS IT -1 (LAST ERROR)?
	CAIE	T1,-1		;..
	JRST	LSTERK		;NO, SOMETHING EXPLICIT
LSTERO:	MOVX	T1,.FHSLF	;IT IS; WHAT WAS LAST ERROR?
	GETER%
	HRRZ	T1,T2		;IS IT GJFX3 (NO MORE JFNS?)
LSTERK:	CAIE	T1,GJFX3
	JRST	SOMERR
	TYPE [ASCIZ/No more JFNs available
 Please use fewer file specifications in this command/]
	RET
SOMERR:	SETZM	STRING
	HRROI	T1,STRING
	HRLI	T2,.FHSLF
	SETZ	T3,
	ERSTR%
	 JFCL
	 JFCL
	TYPE	STRING
	RET

FNDERR:	PUSH	P,T2
	MOVX	T1,.FHSLF
	GETER%
	HRRZ	T1,T2
	POP	P,T2
	RET

NOFREE:	ERROR	<No freespace>,SPRREQ
SPRREQ:	TYPE	[ASCIZ/
 Please submit an SPR detailing what you did./]
	JRST	BAKOUT
	SUBTTL	QUASAR routines

;Set up to work with Quasar - get PIDs and set quotas, and say hello
;Some QUASAR routines herein are called at interrupt level.  These do
; not use WARN or similiar macros, as they tend to destroy things best
; left alone.  If a routine is using raw PSOUTs to do output, it probably
; has a good reason.

QSRINI:	SETZM	NXTRTP		; No next
	SETZM	RETFIN
	SETZM	ABTFLG
	SETZM	MYPID
	CALL	GQPID		;GET QUASAR'S PID IN QSRPID
	GJINF%			; GET JOB #
	MOVEM	T3,PD1BLK+1
	DMOVE	T1,[EXP 3,PD1BLK]
	MUTIL%
	 ERJMPS [WARN	<Failed to set PID quota for DUMPER>
		JRST .+1]
	DMOVE	T1,[EXP 3,PD2BLK]
	MUTIL%
	 ERJMPS [ERROR	<Unable to create a PID for DUMPER>]
	MOVE	T3,MYPID
	MOVEM	T3,PD3BLK+1
	MOVEM	T3,PD4BLK+1
	DMOVE	T1,[EXP 3,PD3BLK]
	MUTIL%
	 ERJMPS [ERROR	<Unable to set DUMPER PID on interrupt channel>]
	DMOVE	T1,[EXP 3,PD4BLK]
	MUTIL%
	 ERJMPS	[WARN	<Unable to set send/receive quotas to 30>
		 JRST	.+1]
	TDZA	T1,T1
GDBYE:	MOVX	T1,HEFBYE	; SAY GOOD-BYE
HELLO:	HRLI	T1,%%.QSR	; Internal version,,flags
	CALL	ZIPMSS		; Setup for sending
	MOVEM	T1,HEL.FL(P1)	; Version and flags
	MOVE	T2,[HEL.SZ,,.QOHEL] ; HELLO MSG
	MOVEM	T2,.MSTYP(P1)	; Drop in length & type
	MOVE	T2,[SIXBIT /DUMPER/]
	MOVEM	T2,HEL.NM(P1)	; Program name
	MOVE	T2,[1,,1]	; 1 object type, 1 concurrent job
	MOVEM	T2,HEL.NO(P1)
	MOVX	T2,.OTRET	; Which is a retrieval
	MOVEM	T2,HEL.OB(P1)	; Object type
	MOVE	P1,[HEL.SZ,,QSRMSS]
	;JRST	 SNDQSR		; SEND IT

SNDQSR:	SETZM	PDB
	MOVEI	T2,PDB		; WHERE TO BUILD PDB
	PUSH	T2,MYPID	; SENDER'S PID
	PUSH	T2,QSRPID	; RECEIVER'S PID
	PUSH	T2,P1		; WHERE ACTUAL MSG IS
	MOVEI	T1,.IPCFP+1	; PDB LENGTH
	MOVEI	T2,PDB
	MSEND%			; SEND MSG
	 ERJMPS	[HRROI	T1,[ASCIZ/%SNDQSR failed/]
		 PSOUT%
		 RET]
	RET

; Here to receive a message; P1 HAS ADDR OF DATA
RCVQSR:	MOVEI	T2,PDB-1
	PUSH	T2,[IP%CFB]	;DO NOT BLOCK
	PUSH	T2,[0]		; SENDER'S PID
	PUSH	T2,MYPID
	PUSH	T2,[1000,,QSRMSR]
RCVQS1:	MOVEI	T1,4
	MOVEI	T2,PDB
	MRECV%			; READ IT
	 ERJMPR [CAIN	T1,IPCFX2;No more messages
		 RET		;Go and DEBRK
		MOVX	T1,IP%CFV	; SAY PAGE MODE
		MOVEM	T1,PDB+.IPCFL
		MOVE	T1,[1000,,<QSRMSR/1000>]
		MOVEM	T1,PDB+.IPCFP
		JRST	RCVQS1]
	MOVEI	P1,QSRMSR	; Point to RECEIVed message
	MOVE	T1,PDB+.IPCFS	; GET SENDER'S PID
	CAME	T1,QSRPID	; MATCH QUASAR'S?
	JRST	RCVQSR		;NO, TRASH
	JRST	CPOPJ1

NXTRET:	SKIPE	P5,NXTRTP	; Next request ready for us?
	JRST	NXTRE1		;yes. go do the request
	SKIPE	RETFIN		;DONE?
	RET			;yes, return to caller
 IFG WAITTM,<			;;Only if willing to time the wait
	MOVE	T1,[.FHSLF,,.TIMEL]
	MOVX	T2,WAITTM*^D60*^D1000 ;wait WAITTM minutes for galaxy to answer
	MOVEI	T3,TIMCHN
	TIMER%			;SET UP THE TIMER CHANNEL
	 ERJMPS	[WARN	<Can't time QUASAR wait>
		 JRST	NOTIME]
	MOVX	T1,.FHSLF	;on the timer channel
	MOVX	T2,1B<TIMCHN>
	AIC%
 >
NOTIME:	SKIPE	NXTRTP		; Did a message just come in
	JRST	WAITIN		;Yes
	TXO	F,F.WAIT
	WAIT%			; No, wait until QUASAR gets to us
WAITIN:	 JFCL			; Race insurance
	TXZ	F,F.WAIT	; Make sure this is off
 IFG WAITTM,<
	MOVE	T1,[.FHSLF,,.TIMBF]
	HRLOI	T2,377777	;POSITIVE INFINITY
	TIMER%
	 ERJMPS	.+1
	MOVX	T1,.FHSLF	; Turn off the timer channel
	MOVX	T2,1B<TIMCHN>
	DIC%
>
	SKIPN	RETFIN
	SKIPN	P5,NXTRTP	; Make sure we've a copy of the ptr
	RET			; No more to do
NXTRE1:	HRROI	T2,FILNM(P5)	; Point to file name
	CALL	TSTNAM		; Ok?
	 JRST [	RLJFN%
		 JFCL
		CALL REFUSE	; Don't want this one
		JRST NXTRET]	; Try again
	RLJFN%
	 JFCL
	MOVX	T1,GJ%OLD+GJ%XTN;GET FLAGS
	MOVEM	T1,RETBLK+.GJGEN;SET IN BLOCK
	MOVEI	T1,RETBLK	; Use blk with invisible etc.
	HRROI	T2,FILNM(P5)	; Point to name
	GTJFN%
	 ERJMPR NXTRE2		;GTJFN FAILED
	MOVSI	T2,.FBLN0	;GET ENTIRE FDB
	MOVEI	T3,FDB
	GTFDB%
	MOVE	T2,T1		;COPY JFN
	HRROI	T1,STRING	;SET TO BUILD STR:<DIR>, FOR RCDIR
	MOVX	T3,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
	JFNS%
	MOVE	T1,T2		;COPY JFN BACK
	RLJFN%			;DUMP JFN
	 JFCL
	MOVE	T3,FDB+.FBCTL	;GET CONTROL WORD
	TXNN	T3,FB%OFF	; File offline?
	JRST	[CALL RELREQ	;YES, RELEASE RETRIEVAL REQUEST
		 JRST NXTRET]	; Try again
	MOVX	T1,RC%EMO	;MATCH EXACTLY
	HRROI	T2,STRING	;POINTER TO STR:<DIR>
	RCDIR%
	MOVE	T1,T3		;COPY DIRECTORY NUMBER
	GTDAL%			;GET DISK ALLOCATION
	HRRZS	FDB+.FBBBT	;OFFLINE FILE SIZE
	ADD	T2,FDB+.FBBBT	;ADD REQUESTED FILE SIZE
	CAMLE	T2,T1		;ENOUGH WORKING QUOTA?
	 JRST	[HRROI P1,[ASCIZ/ Insufficient disk quota to RETRIEVE file./]
		JRST NXTRE3]	;TELL USER AND GET NEXT REQUEST
	JRST	CPOPJ1
NXTRE2:	CAIN	T1,GJFX16	;INVALID DEVICE?
	JRST  [WARN	<Structure not mounted, skipping file > ;YES
		TYPE	FILNM(P5)
		CALL REFUSE	;REQUEUE THE REQUEST
		JRST NXTRET]	;GET NEXT RETRIEVAL REQUEST
	CALL BADOFP		;SOME OTHER ERROR, COMPOSE MESSAGE
NXTRE3:	CALL WASHOU		;TELL USER AND REQUESTOR
	CALL RELREQ		;RELEASE THE RETRIEVAL REQUEST
	JRST NXTRET

BADOFP:	HRROI	T1,STRING
BADOF2:	HRLOI	T2,.FHSLF
	SETZ	T3,
	ERSTR%
	 JFCL
	 JFCL
	HRROI	P1,STRING
	RET

;Here with P1 pointing to an error string and P5 pointing to the
; retrieval block.  Say we can't retrieve.
FALFIL:	JUMPE	P1,CPOPJ
	WARN	<Failed to restore >
	TYPE	FILNM(P5)
	TYPE	[ASCIZ/ because:
 /]
	TYPEAT	P1
	RET


; Here to report terrible failure to requestor
; Error message ptr in P1.  Call WASHO2 if FALFIL already done.
WASHOU:	CALL	FALFIL
WASHO2:	TYPE	[ASCIZ/
 File will not be Retrieved./]
	SETZM	GTJBLK		;ZERO GTJFN ARG BLOCK
	MOVE	T1,[GTJBLK,,GTJBLK+1]
	BLT	T1,GTJBLK+.GJBFP
	MOVX	T1,GJ%OLD+GJ%XTN
	MOVEM	T1,GTJBLK+.GJGEN;OLD FILE, LONG GTJFN BLOCK
	MOVX	T1,G1%IIN
	MOVEM	T1,GTJBLK+.GJF2	;INCLUDE INVISIBLE FILES
	MOVE	T1,[.NULIO,,.NULIO]
	MOVEM	T1,GTJBLK+.GJSRC;JUST USE STRING
	MOVEI	T1,GTJBLK	;GET ARG BLOCK ADDRESS
	HRROI	T2,FILNM(Q1)	;GET POINTER TO FILESPEC
	GTJFN%			;GET JFN ON FILE
	 ERJMPS CPOPJ
	MOVEI	T2,.ARRFL
	DOJSS	ARCF%, .+1	;SET AR%RFL (RETRIEVE FAILED) IN FDB
	RLJFN%			;DUMP JFN
	 JFCL
	RET

;Enter with pointer to filename to test in T2
; returns parse only filespec in T1 and gives +2 if OK to Load, and sets
; MATCH to the index into JFNLST and JF2LST of the matching entry.
;Also returns RH T4 as index
TSTNAM:	MOVX	T1,GJ%OFG+GJ%SHT;SET TO PARSE NAME
	GTJFN%
	 ERJMPS	CPOPJ
	PUSH	P,T1
	MOVE	T4,NFJFN	;SCAN ALL SPECS GIVEN TO LOAD
TSTNA3:	SKIPN	T2,JFNLST(T4)	;JFN STILL HERE?
	JRST	TSTNA4
	HRRZ	T3,0(P)		;GET CURRENT FILE JFN
	MOVEI	T1,.WLJFN
	WILD%			;FIND DIFFERENCES BETWEEN THE SPECS
	TXNE	F,F.INTR	;INTERCHANGE?
	TXZ	T1,WL%DEV!WL%DIR;YES, DSK/DIR DON'T MATTER
	TXNE	T1,WL%DEV!WL%DIR!WL%NAM!WL%EXT!WL%GEN	;ANY MISMATCHES?
	JRST	TSTNA4
	HRRZM	T4,MATCH
	SETZM	OUTDRS		;FORCE GOFNAM, IF CALLED, TO USE THIS
	POP	P,T1
	JRST	CPOPJ1
TSTNA4:	AOBJN	T4,TSTNA3	;YES, STEP TO NEXT FILESPEC
	POP	P,T1		;DONE ALL FILESPECS, FAILED TO MATCH ANY
	RLJFN%
	 ERJMPS	.+1
	RET

; Here to say "no thanks" to QUASAR's choice of retrieve requests
REFUSE:	GTAD%			; Get timestamp
	MOVE	T2,TPBLK+.ARODT
	TXNE	T2,%EQUFT	; Using alternate tape?
	TXO	T1,%EQUFT	; Yes, send it back that way
	JRST	REQSIL

; Here to ACK a message

DOACK:	MOVE	T2,.MSCOD(P1)	; Get ack code
	MOVEM	T2,.MSCOD+ACKBLK
	PUSH	P,P1
	MOVE	P1,[MSHSIZ,,ACKBLK]
	CALL	SNDQSR		; Send it
	POP	P,P1
	RET

; Here to say we're done with a request block

RELREQ:	SETZM	NXTRTP		; Nothing there now
	CALL	ZIPMSS		; Setup to send
	MOVE	T2,[REL.SZ,,.QOREL] ; Set to release the one we've done
	MOVEM	T2,.MSTYP(P1)	; Length and type
	MOVE	T2,TPTSK	; Include the task name
	MOVEM	T2,REL.IT(P1)	; Internal task name
	MOVE	P1,[REL.SZ,,QSRMSS]
	JRST	SNDQSR		; Send the release

; Here to abort current retrieval; Assumes retrieval described by
; info in TPBLK

ABTRET:	WARN	<Retrieve aborted>
	SETZM	ABTFLG
	JRST	RELREQ		; Tell QUASAR we're "done"

; Here to release PID in T1
RELPID:	MOVEM	T1,PDB+1
	MOVEI	T1,.MUDES	; Delete the PID
	MOVEM	T1,PDB
	MOVEI	T1,2
	MOVEI	T2,PDB
	MUTIL%
	 ERJMPS	[WARN	<Can't release PID>
		 JRST	.+1]
	SETZM	MYPID
	SETZM	QSRPID		; Forget about QUASAR too
	RET


;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

GQPID:	SETZM	QSRPID
	DMOVE	T1,[EXP 3,PD0BLK]
	MUTIL%
	 ERJMPS	[ERROR	<Can't get QUASAR's PID>]
	RET

RETTYF:	SKIPE	P5,NXTRTP
	TYPE	FILNM(P5)
	RET

;Get the tape needed for the retrieval request
MNTRET:	SKIPGE	.ARODT(P5)
	SKIPA	T1,.ARTP1(P5)
	MOVE	T1,.ARTP2(P5)
	TLNN	T1,-1
	CALL	NSVOL		;CONVERT TO SIXBIT IF NECESSARY
	MOVE	Q1,T1		;COPY VOLID TO A SAFE PLACE
	CAMN	Q1,VOLID6	;DO WE HAVE THE TAPE UP ALREADY?
	JRST	[CALL	GMOJFI
		  JRST	.+1	;CAN'T, CLOSE AND DROP AND TRY AGAIN
		 JRST	CPOPJ1]	;YES, JUST RETURN
	SKIPG	T1,BDTCNT	;DO WE HAVE ANY KNOWN UNAVAILABLE TAPES?
	JRST	NOBADT		;NO, SO TRY IT
BDTSCN:	CAMN	Q1,BDTLST-1(T1)	;YES, IS THIS ONE KNOWN UNAVAILABLE?
	JRST	TPEUNA		;YES! DON'T EVEN TRY
	SOJG	T1,BDTSCN	;CHECK WHOLE LIST
NOBADT:	CALL	KILCHN		;TAPE OK. LOSE ANY OLD READAHEAD
	CALL	MTCLS		;OK, CLOSE WHATEVER WHAT WE NOW HAVE
	CALL	UNLOAD		;AND DROP
MNTNXT:	SETZM	FRCSET		;NEVER INSIST ON DENSITY SETTINGS IN RETRIEVAL
	MOVEI	T1,.SFMTA
	TMON%			;TAPE DRIVE ALLOCATION ENABLED?
	JUMPN	T2,RETTA3	;YES, CALL FOR TAPE MOUNT THRU QUASAR
	CALL	IFCRL2
	TYPE	[ASCIZ/Please mount tape /]
	MOVE	T3,Q1		;GET VOLID
	CALL	SIXOUT
	HRROI	T1,[ASCIZ/ Is this tape available? /] ;Might have snapped
	CALL	YESNO
	JUMPN	T2,[
		 CALL	GMOJFI	;SAID YES, GET TAPE SPEC
		  JRST	MNTRET	;CAN'T
;**;[538] MNTNXT:+7L Replace 1 line (from edit 534) with 2	SM 31-Jan-86
		 MOVE	T3,Q1	;[538] DOVOLS STORES VOLID6, VOLID FROM T3
		 CALL	DOVOLS	;[538] SET THEM
		 JRST	CPOPJ1]
RETTA2:	MOVE	T1,BDTCNT
	CAIL	T1,BDTMAX
	JRST	RETTAA
	HRROI	T1,[ASCIZ/Should I ask about this tape anymore in this run? /]
	CALL	YESNO
	JUMPN	T2,RETTAA
	AOS	T1,BDTCNT
	MOVEM	Q1,BDTLST-1(T1)
RETTAA:	HRROI	P1,[ASCIZ/Tape currently unavailable/]
	RET
TPEUNA:	HRROI	P1,[ASCIZ/Request on a tape known unavailable/]
	RET

RETTA3:	CALL	MREQ		;SEND MOUNT REQUEST AND GET ANSWER
	 JRST	[HRROI	T1,[ASCIZ/Try for same tape again? /]
		CALL	YESNO
		JUMPN	T2,RETTA3	;WANTS TO TRY AGAIN
		JRST	RETTA2]	;DON'T TRY AGAIN
	CALL	GMOJFI
	 JRST	RETTA2
	CALL	REWCV
	JRST	CPOPJ1
	SUBTTL	Mounting code
;Enter with Q1 as sixbit/volname/
MREQ:	CALL	IFCRLF
	TYPE	<[ASCIZ/[Mounting tape volume /]>
	MOVE	T3,Q1
	CALL	SIXOUT
	TYPE	CBCR
	DMOVE	T1,[EXP .MURSP,.SPQSR] ;GET PID OF REAL QUASAR
	DMOVEM	T1,MPDB
	MOVEI	T1,3		;ARG BLOCK LENGTH
	MOVEI	T2,MPDB		;ARG BLOCK ADDRESS
	MUTIL%			;GET PID INTO MPDB+.IPCFR
	 JSERRD	<Can't get QUASAR's PID>

; 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	T2,-TMSKSZ	;GET AOBJN POINTER TO SKELETON
	PUSH	Q3,TMSKEL(T2)	;TRANSFER SKELETON WORD TO MESSAGE
	AOBJN	T2,.-1		;LOOP UNTIL ALL OF SKELETON IS MOVED
	PUSH	Q3,[2,,.TMVOL]
	PUSH	Q3,Q1		;CREATE VOLID ENTRY IN IPCF MESSAGE

; NOW FIX UP THE COUNT FIELDS IN THE IPCF MESSAGE

	HRRZ	T1,Q3		;GET ADDRESS OF LAST WORD OF MESSAGE
	SUBI	T1,MBUF-1	;COMPUTE SIZE OF MESSAGE
	STOR	T1,MS.CNT,MBUF+.MSTYP ;STORE IN GALAXY HEADER
	SUBI	T1,.MMHSZ	;COMPUTE SIZE OF MOUNT ENTRY
	STOR	T1,AR.LEN,MBUF+.MMHSZ ;STORE IN MOUNT ENTRY LENGTH FIELD
	MOVEI	T1,MBUF+.MMHSZ+.MEHSZ ;POINT AT FIRST SUBENTRY
TMX2:	AOS	MBUF+.MMHSZ+.MECNT	;COUNT THIS SUBENTRY
	LOAD	T2,AR.LEN,(T1)	;GET SIZE OF SUBENTRY
	ADD	T1,T2		;POINT AT NEXT SUBENTRY
	CAIGE	T1,(Q3)		;ANOTHER SUBENTRY?
	JRST	TMX2		;YES, CONTINUE SCAN

; SEND IPCF MESSAGE TO QUASAR

	MOVEI	T2,MPDB-1	;SET UP PDB FOR MSEND
	PUSH	T2,[IP%CPD+IP%CFV]	;FLAGS
	PUSH	T2,[0]		;SENDER'S PID (WILL BE CREATED)
	ADJSP	T2,1		;RECEIVER'S PID FILLED IN ALREADY
	PUSH	T2,[1000,,<MBUF_-9>] ;PACKET DESCRIPTOR
	MOVEI	T1,4		;GET SIZE OF PDB
	MOVEI	T2,MPDB		;GET ADDRESS OF PDB
	MSEND%			;SEND REQUEST TO QUASAR
	 JSERRD	<Could not send IPCF mount request>

; MOUNT MESSAGE HAS BEEN SENT, NOW RECEIVE THE REPLY

	MOVE	T1,MPDB+.IPCFS
	MOVEM	T1,MPDB+.IPCFR	;SET RECEIVER'S PID
MREQ2:	SETZM	MPDB+.IPCFL
	MOVE	T1,[1000,,MBUF]
MREQ3:	MOVEM	T1,MPDB+.IPCFP	;POINTER TO MESSAGE BUFFER
	MOVEI	T1,.IPCFC+1	;PDB LENGTH
	MOVEI	T2,MPDB		;PDB ADDRESS
	MRECV%			;RECEIVE MESSAGE
	 ERJMPR [CAIE	T1,IPCF16	;ERROR BECAUSE OF WRONG DATA MODE?
		ERROR	<Error receiving mount response> ;NO
		MOVX	T1,IP%CFV	;YES, TRY THIS
		MOVEM	T1,MPDB+.IPCFL	;STORE FLAGS
		MOVE	T1,[1000,,MBUF/1000] ;GET POINTER FOR NON-PAGE-MODE
		JRST	MREQ3]	;TRY AGAIN
	MOVE	T1,MPDB+.IPCFC
	TXNN	T1,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	T1,[ 1
		  .MNRDV,,CKMDV]
	CALL	SCNMBK		;SUCCESSFUL MOUNT, GET DESIGNATOR
	MOVE	T1,MTDSG
	CALL	SETMNT		;REMEMBER I HAVE MOUNTED A TAPE
	HRROI	T1,MTDEV	;DESTINATION STRING POINTER
	MOVE	T2,MTDSG
	DEVST%			;CONVERT DESIGNATOR TO STRING
	 JSERRD	<Can't get tape name>
	MOVEI	T2,":"
	IDPB	T2,T1		;BUILD FILESPEC
	SETZ	T2,
	IDPB	T2,T1
	CALL	CHKMTD		;GET JFN AND TAPE INFO AND CHECK IT
	 ERROR	<Mount not acceptable>
	TYPE	<[ASCIZ/[Volume /]>
	MOVE	T3,Q1		;GET VOLID
	CALL	SIXOUT
	TYPE	[ASCIZ/ mounted/]
	TYPE	CBCR
	JRST	CPOPJ1		;ALL OK

CKMDV:	MOVE	T1,1(T1)	;GET DESIGNATOR
	MOVEM	T1,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	T1,MBUF+.OHDRS+ARG.DA ;YES, GET ADDRESS OF TEXT
		JRST	CKMTX]	;TYPE ERROR MESSAGE AND TAKE +1 RETURN
	MOVEI	T1,[2
		 .MNREC,,CKMEC
		 .MNRTX,,CKMTX]
	JRST	SCNMBK		;ANALYZE REPLY AND RETURN +1

CKMTX:	HRRO	Q1,T1		;GET STRING POINTER TO TEXT
	TYPE	[ASCIZ/
 Additional information - /]
	TYPEAT	Q1
	TYPE	CRLF
	RET

CKMEC:	MOVE	Q1,(T1)		;GET ERROR CODE
	TYPE	[ASCIZ/
?Cannot mount tape, /]
	MOVEI	T1,.PRIOU
	MOVE	T2,Q1		;GET ERROR CODE
	HRLI	T2,.FHSLF	;APPEASE ERSTR WITH FORKHANDLE
	SETZ	T3,		;NO LIMIT
	ERSTR%			;TYPE ERROR MESSAGE
	 JFCL
	 JFCL
	RET

; ROUTINE TO DELETE MOUNTING PID IN MPDB+.IPCFR

MRKPID:	MOVEI	T1,.MUDES
	MOVEM	T1,MPDB+1	;BUILD MUTIL ARGUMENT BLOCK
	MOVEI	T1,2		;ARG BLOCK LENGTH
	MOVEI	T2,MPDB+1	;ARG BLOCK ADDRESS
	MUTIL%			;DESTROY THE PID I USED TO DO THE MOUNT
	 JFCL
	RET

; 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,T1		;SAVE NEW DESIGNATOR
	CALL	MTCLS
	SKIPE	T1,MNTDSG	;HAVE DESIGNATOR CURRENTLY?
	RELD%			;YES, DUMP IT
	 JFCL
	POP	P,MNTDSG	;SET NEW DESIGNATOR

; CREATE OR DELETE LOGICAL NAME FOR MOUNTED TAPE

	MOVEI	T1,.CLNJ1	;ASSUME DELETING LOGICAL NAME
	SKIPE	T2,MNTDSG	;SETTING NEW DEVICE?
	JRST [	HRROI	T1,MTDEV;YES
		DEVST%		;COMPOSE LOGICAL NAME
		 JFCL		; DEFINITION STRING
		MOVEI	T2,":"
		IDPB	T2,T1
		SETZ	T2,
		IDPB	T2,T1
		MOVEI	T1,.CLNJB;SET TO CREATE LOGICAL NAME
		JRST	.+1]
	HRROI	T2,[ASCIZ/RETRVL/] ;LOGICAL NAME = RETRVL:
	HRROI	T3,MTDEV	;POINTER TO DEFINITION, MTn:
	CRLNM%			;CREATE OR DELETE LOGICAL NAME
	 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:	PUSH	P,Q1
	MOVE	Q1,MBUF+.OARGC	;GET # OF BLOCKS IN LIST
	MOVEI	Q2,MBUF+.OHDRS	;GET ADDRESS OF FIRST BLOCK
	MOVE	Q3,T1		;COPY CALLER'S LIST ADDRESS
SCNMB1:	SOJL	Q1,[POP P,Q1
		    RET]	;EXIT IF NO MORE BLOCKS TO SCAN
	MOVEI	T1,1(Q2)	;GET ADDRESS OF DATA IN BLOCK
	HRRZ	T2,(Q2)		;GET BLOCK TYPE CODE
	HLRZ	T3,(Q2)		;GET BLOCK LENGTH
	ADD	Q2,T3		;POINT Q2 AT NEXT BLOCK
	MOVN	T3,(Q3)		;GET NEGATIVE # OF LIST ENTRIES
	MOVSS	T3		;MOVE TO LEFT HALF FOR AOBJN POINTER
	HRRI	T3,1(Q3)	;MAKE POINTER TO CALLER'S LIST
SCNMB2:	HLRZ	T4,(T3)		;GET TYPE CODE FROM LIST
	CAMN	T2,T4		;DOES IT MATCH THE CODE FOR THIS BLOCK?
	JRST [	HRRZ	T4,(T3)	;YES, GET PROCESSOR ROUTINE ADDRESS
		CALL	(T4)	;INVOKE PROCESSOR
		JRST	SCNMB1]	;GO SCAN NEXT BLOCK
	AOBJN	T3,SCNMB2	;CONTINUE LIST SCAN
	JRST	SCNMB1		;UNRECOGNIZED BLOCK TYPE, IGNORE IT
	SUBTTL	Interchange code (to DUMPER)
;From BACKUP to DUMPER
; Enter with T4/ address of buffer.  Ret +1 if no data yielded, +2 with
;  DMPCHA chain changed to include converted buffers.  This code assumes
;  the DMPCHA points to the record block to be converted, and that it
;  contains only one record.
INTDMC:	SETZM	BLKCNT
	MOVE	T4,DMPCHA	;POINT TO BUFFER TO GET FIXED
	SKIPLE	T1,DATAST+G$TYPE(T4)	;GET BUFFER TYPE, SHOULD BE .GT. 0
	CAILE	T1,T$MAX	;AND ALL ARE .LE. T$MAX
	JRST	ILLINR
	XCT	[RET		;TYPE T$LBL, IGNORE
		 JRST	T%BEG	;T$BEG, BEGINNING OF SAVESET
		 RET		;T$END, IGNORE
		 JRST	T%FIL	;T$FIL, FILE DATA
		 RET		;T$UFD, IGNORE
		 JRST	T%EOV	;T$EOV, END OF VOLUME
		 RET		;T$COM, IGNORE
		 JRST	T%CON	;T$CON, CONTINUED SAVESET
		]-1(T1)
ILLINR:	WARN	<Illegal INTERCHANGE record type seen, ignored>
	RET

;End of volume
T%EOV:	MOVEI	T1,1
	MOVEM	T1,BLKCNT
	MOVEI	T1,<DATAST+1006>/1000+1
	CALL	GETPGS
	 JRST	NOFREE		;CAN'T HAPPEN
	MOVEM	T2,INTCHA
	ADDI	T2,DATAST
	HRROI	T1,-TONEXT
	CALL	INCREC
	JRST	INTRET

T%CON:	PUSH	P,[-CONTST]
	JRST	.+2
;Interchange saveset record comes here
T%BEG:	PUSH	P,[-SAVEST]
	MOVEI	T1,1
	MOVEM	T1,BLKCNT	;THIS WILL CREATE ONE RECORD
	MOVEI	T1,<DATAST+1006>/1000+1	;THESE NEED ONE RECORD (2 PAGES)
	CALL	GETPGS
	 JRST	NOFREE
	MOVEM	T2,INTCHA	;WHERE THE BUFFER LIVES
	ADDI	T2,DATAST	;POINT TO HEADER
	POP	P,T1
	CALL	INCREC		;MAKE UP A DUMMY HEADER AT T2
	ADDI	T2,6
	MOVEI	T1,CURFMT
	MOVEM	T1,SV.FMT(T2)
	MOVE	T4,DMPCHA
	MOVE	T1,DATAST+S$DATE(T4)
	MOVEM	T1,SV.TAD(T2)
	ADDI	T4,DATAST+NIHEAD
SVFIND:	SKIPN	T1,(T4)
	JRST	INTRET		;RETURN INTERCHANGE RECORD
	HLRZS	T1
	CAIN	T1,O$SSNM
	JRST	SVFIN2
	HRRZ	T1,(T4)
	ADDI	T4,(T1)
	JRST	SVFIND
SVFIN2:	MOVEI	T1,SV.MSG
	MOVEM	T1,SV.PNT(T2)
	HRROI	T1,1(T4)
	HRROI	T2,SV.MSG(T2)
	CALL	CSTR
	JRST	INTRET

T%FIL:	MOVE	T4,DMPCHA	;POINT TO OLD RECORD
	MOVE	T2,DATAST+G$FLAG(T4) ;FETCH FLAGS
	SETZ	T1,		;FOR 'NUMBER OF RECORDS WE WILL NEED'
	TXNE	T2,GF$SOF	;FILEHEADER?
	ADDI	T1,1		;YES, THAT TAKES A RECORD
	TXNE	T2,GF$EOF	;FILETRAILER?
	ADDI	T1,1		;YES, THAT TAKES A RECORD
	SKIPLE	DATAST+G$SIZ(T4) ;ANY DATA?
	ADDI	T1,1		;YES, THAT TAKES A RECORD
	MOVEM	T1,BLKCNT
	JUMPE	T1,CPOPJ	;IF NO RECORDS NEED CREATING, LEAVE NOW
	IMULI	T1,1006
	ADDI	T1,DATAST+777	;HOW MANY WORDS DO WE NEED? PLUS A PAGE
	LSH	T1,-9		;IDIV BY 1000 FOR PAGES
	CALL	GETPGS
	 JRST	NOFREE
	MOVEM	T2,INTCHA
	ADDI	T2,DATAST	;POINT TO WHERE FIRST HEADER WILL GO
	MOVEM	T2,CURHEA
;IS IT A FILE HEADER?
	MOVE	T4,DMPCHA
	ADDI	T4,DATAST
	MOVE	T1,G$FLAG(T4)
	TXNN	T1,GF$SOF	;SEE IF FILE HEADER
	JRST	T%FIES		;NO, CHECK FOR DATA
	HRROI	T1,-FILEST
	CALL	INCREC		;SET UP HEADER FOR FILE START
	ADD	T4,[-F$NND,,NIHEAD] ;NEG SIZE OF NONDATA AREA,,POINTER TO DATA
T%FIL2:	HLRZ	T1,(T4)		;GET TYPE
	PUSH	P,T4		;SAVE T4 IN CASE WE JUMP
	MOVE 	T2,CURHEA	;FOR INTNAM AND INTFIL
	CAIN	T1,O$NAME	;NAME?
	JRST	INTNAM		;GO DO (RETURN TO T%FILQ)
	CAIN	T1,O$FILE	;ATTRIBUTES?
	JRST	INTFIL		;GO DO (RETURN TO T%FILQ)
T%FILQ:	POP	P,T4
T%FIEB:	HRRZ	T1,(T4)		;GET BLOCK SIZE
	HRLS	T1		;IN BOTH HALVES
	ADD	T4,T1		;SKIP LAST BLOCK
	JUMPG	T4,T%FIEA	;.GT. 0 MEANS END OF ALL BLOCKS
	SKIPE	(T4)		;SEE IF DONE
	JRST	T%FIL2		;NO, KEEP GOING
T%FIEA:	MOVE	T2,CURHEA	;WHERE THAT LAST RECORD BEGAN
	ADDI	T2,1006		;SKIP ON TO POSSIBLE NEXT
	MOVEM	T2,CURHEA
T%FIES:	MOVE	T4,DMPCHA
	SKIPG	DATAST+G$SIZ(T4) ;ANY DATA HERE?
	JRST	T%CKEN		;NO, MAYBE AN END OF FILE RECORD THOUGH
	SETZ	T1,		;DATA IS RECORD TYPE 0
	CALL	INCREC		;SET UP THE HEADER
	MOVEI	T1,DATAST+NIHEAD(T4) ;POINT TO DATA
	ADD	T1,DATAST+G$LND(T4)	;PLUS ANY OFFSET
	HRLZS	T1		;IS THE "FROM" FOR THE BLT
	HRRI	T1,6(T2)	;"CURDAT" IS THE "TO" FOR THE BLT
	HRRZ	T3,T1		;CALC THE "UNTIL"
	ADD	T3,DATAST+G$SIZ(T4) ;BY ADDING NUMBER OF WORDS
;**;[556] Add one line at T%FIES:+10L		DEE		27-SEP-88
	MOVEM	T3,LDLCOP	;[556] save last data location copied to
	BLT	T1,-1(T3)	;COPY DATA
	MOVE	T1,DATAST+F$RDW(T4) ;GET WORD NUMBER OF DATA
	LSH	T1,-9
	MOVEM	T1,.PAGNO(T2)	;PUT INTO HEADER
	ADDI	T2,1006
T%CKEN:	MOVE	T1,DATAST+G$FLAG(T4)	;FETCH FLAGS AGAIN
	TXNN	T1,GF$EOF	;ENDING RECORD?
	JRST	INTRET		;NO, SO DONE, GO RETURN THE RECORD(S) CREATED

;**;[556] Add 13 lines and some comments at T%CKEN:+3	DEE	27-SEP-88

;[556] We have an ending record. Find the even page boundary, which is the
;[556] end of the buffer. Check to see if we filled the buffer with data.
;[556] If not, zero out the rest so we don't leave trash
;[556] in it, which can be confusing if a shorter record following hasn't
;[556] over-written stuff left in the buffer from a longer record.

	MOVE	T1,LDLCOP	;[556] What was the last data location used?
	ANDI 	T1,777000	;[556] Get even page boundary
	ADDI	T1,PAGSIZ-1	;[556] Get end of this page
	CAMG	T1,LDLCOP	;[556] Did we fill the page with data? (unlikely, but possible)
	IFSKP.			;[556] No, so pad with nulls
	  MOVE	P2,LDLCOP  	;[556] Get loc after last data
	  ADDI	P2,1		;[556]    ...   
	  SETZM	@P2         	;[556] Start nulls here 
	  HRL	T3,P2       	;[556] Switch beginning loc to LH
	  ADDI	P2,1		;[556] Get destination loc
	  HRR	T3,P2       	;[556] Destination end here
	  BLT	T3,(T1)		;[556] T1 has end of buffer
	ENDIF.			;[556] Done
	HRROI	T1,-FILEEN
	CALL	INCREC		;YES, SET UP FILE ENDING RECORD
	ADD	T2,[ICFDB,,6]	;FROM ICFDB TO "CURDAT"
	MOVEI	T1,.FBLN0-1(T2)	;COPY FDB DATA IN
	BLT	T2,(T1)
	;JRST	INTRET
;Here to replace the buffer at DMPCHA with the buffer at INTCHA, and return +2
; with F.CIRC lit.
INTRET:	MOVE	T1,INTCHA
	MOVEI	T3,DATAST(T1)
	MOVEM	T3,BLKPNT
	EXCH	T1,DMPCHA	;MAKE NEW BUFFER BEGINNING OF CHAIN
	PUSH	P,DATAST+G$SEQ(T1)	;SAVE OLD SEQUENCE NUMBER
	CALL	RELPGS		;DELETE OLD BUFFER
	MOVE	T4,DMPCHA
	MOVEM	T1,NXTBUF(T4)	;MAKE OLD NEXT THE NEW NEXT
	POP	P,DATAST+.SEQ(T4);AND COPY SEQUENCE NUMBER IN
	TXO	F,F.CIRC
	JRST	CPOPJ1

INTNAM:	MOVX	T1,<POINT 7>
	ADDI	T1,6(T2)	;POINT TO WHERE FILENAME GOES
	MOVEI	T2,.FCDIR
	CALL	SCNBF		;FIND DIRECTORY BLOCK
	 JRST	TFIL3		;NONE
	HRLI	T2,(POINT 7)
	MOVEM	T2,INTTMP	;SAVE PTR TO IT
	MOVEI	T2,"<"		;DO DIR PUNCTUATION
	IDPB	T2,T1
TFIL32:	ILDB	T2,INTTMP
	JUMPE	T2,TFIL31	;END ON NULL
	CAIN	T2,","		;PPN SEPARATOR?
	MOVEI	T2,"-"		;YES, TRANSLATE
	IDPB	T2,T1
	JRST	TFIL32
TFIL31:	MOVEI	T2,">"
	IDPB	T2,T1		;CLOSE DIR PUNCT
TFIL3:	MOVEI	T2,.FCNAM
	CALL	SCNBF		;FIND NAME BLOCK
	 JRST	TFIL4		;NONE
	EXCH	T2,T1
	HRROS	T1
	CALL	CSTRB
	MOVE	T1,T2
TFIL4:	MOVEI	T2,"."
	IDPB	T2,T1		;PUNCTUATE EXTENSION
	MOVEI	T2,.FCEXT
	CALL	SCNBF		;FIND EXTENSION BLOCK
	 JRST	TFIL5		;NONE
	EXCH	T1,T2
	HRROS	T1
	CALL	CSTRB
	MOVE	T1,T2
TFIL5:	MOVEI	T2,"."
	IDPB	T2,T1		;PUNCTUATE GENERATION
	MOVEI	T2,.FCGEN
	CALL	SCNBF		;FIND GEN
	 JRST	[SETZ	T2,	;NONE, LOSE THE DOT
		 DPB	T2,T1
		 JRST	T%FILQ]	;NONE
	EXCH	T1,T2
	HRROS	T1
	MOVEM	T1,INTTMP	;SAVE PTR TO GEN STRING
	CALL	CSTR
	MOVE	T1,INTTMP	;GET PTR TO GEN STRING
	MOVEI	T3,^D10
	NIN%			;CONVERT GEN TO NUMBER
	 ERJMPS	.+1
	MOVE	T1,CURHEA
	HRLM	T2,NHEAD+FDBOFF+.FBGEN(T1)
	JRST	T%FILQ

;ROUTINE TO SCAN NAME BLOCK LOOKING FOR SPECIFIED SUB-BLOCK
;T2/ DESIRED BLOCK TYPE
;T4/ PTR TO BLOCK
;RETURN +2,
;T2/ PTR TO DATA

SCNBF:	PUSH	P,T4
	MOVN	T3,(T4)		;GET LENGTH OF BLOCK
	HRL	T4,T3		;SET LIMIT
	AOBJN	T4,.+1		;STEP PAST HEADER
SCNBF1:	HLRZ	T3,(T4)		;GET SUB-BLOCK TYPE
	CAIN	T3,(T2)		;REQUESTED ONE?
	JRST	[MOVEI	T2,1(T4);YES, RETURN PTR TO DATA
		 POP	P,T4
		 JRST	CPOPJ1]
	HRRZ	T3,(T4)		;BUMP SUB-BLOCK
	HRL	T3,T3
	ADD	T4,T3
	SKIPE	(T4)		;END OF DATA?
	JUMPL	T4,SCNBF1	;JUMP UNLESS END OF BLOCK
	POP	P,T4
	RET			;TYPE NOT FOUND

;ATTRIBUTE BLOCK

INTFIL:	MOVEI	T3,1(T4)	;POINT TO DATA PORTION
	MOVE	T1,A$WRIT(T3)	;COPY ITEMS - WRITE DATE
	MOVEM	T1,NHEAD+FDBOFF+.FBWRT(T2)
	MOVE	T1,A$BSIZ(T3)
	DPB	T1,[POINT 6,NHEAD+FDBOFF+.FBBYV(T2),11]
	SKIPN	T2,T1
	MOVEI	T2,^D36
	MOVEI	T1,^D36
	IDIV	T1,T2
	PUSH	P,T1		;SAVE RESULT
	MOVE	T2,CURHEA
	MOVE	T1,A$LENG(T3)
	MOVEM	T1,NHEAD+FDBOFF+.FBSIZ(T2)
	POP	P,T2
	ADDI	T1,-1(T2)	;ROUND UP
	IDIV	T1,T2		;WORDS IN FILE
	ADDI	T1,777		;ROUND UP
	IDIVI	T1,1000		;FULL PAGES IN FILE
	MOVE	T2,CURHEA
	HRRM	T1,NHEAD+FDBOFF+.FBBYV(T2)
	MOVSI	T1,NHEAD+FDBOFF(T2)
	HRRI	T1,ICFDB
	BLT	T1,ICFDB+.FBLN0-1;SAVE FDB FOR EOF
	JRST	T%FILQ

INCREC:	SETZM	.SEQ(T2)
	MOVEM	T1,.TYP(T2)	;PUT IN TYPE
	MOVX	T1,FL.HIS+FL.NCK	;FLAGS - SAY NO CHECKSUM
	MOVEM	T1,.FLAG(T2)	;..
	MOVE	T1,TAPENO	;GET CURRENT TAPE NUMBER
	MOVEM	T1,.TAPNO(T2)	;PUT IT IN (NO FLAGS, 0 SAVESET, ETC.)
	RET
	SUBTTL	Interchange code (To BACKUP)
;Come here with BLKPNT pointing at enough space for an Interchange record
; and ADDTMP pointing at a record header and 1000word data buffer.
DMPICO:	DMOVEM	Q1,ICOTMP	;SAVE Q1 AND Q2
	MOVE	Q1,BLKPNT
	MOVEI	T1,1(Q1)	;CLEAR DEST BUFFER
	HRL	T1,Q1
	SETZM	-1(T1)
	BLT	T1,NIHEAD+1000-1(Q1)
	MOVE	Q2,ADDTMP	;POINTER TO INPUT BUFFER
	HRRZ	T1,.TAPNO(Q2)
	MOVEM	T1,G$RTNM(Q1)
	MOVX	T1,GF$NCH	; - FLAGS, NO CHECKSUM
	MOVEM	T1,G$FLAG(Q1)
	MOVN	T1,.TYP(Q2)
	JRST	@[EXP ICODAT,ICOTPH,ICOFLH,ICOFLT,ICOTPT
		EXP ICOCNX,ICOTPC,ICOCNX,ICOEOV](T1)
; There are: Data, Saveset start, file start, file end, tape end,
;		user data, cont. saveset, filler, to next tape

;STANDARD RETURNS
ICOCNY:	AOS	T1,WRISEQ	;COMPUTE NEXT SEQ NUMBER
	MOVEM	T1,G$SEQ(Q1)	;LEAVE IT IN BUFFER
ICOCNX:	DMOVE	Q1,ICOTMP	;RESTORE Q1,Q2
	RET

;END OF VOLUME (TO NEXT TAPE)
ICOEOV:	MOVX	T1,T$EOV
	JRST	ICOTP1
;TAPE TRAILER
ICOTPT:	MOVX	T1,T$END	;SAVESET END
	JRST	ICOTP1		;SAME AS HEADER
;CONTINUED TAPE HEADER
ICOTPC:	MOVX	T1,T$CON
	JRST	ICOTP1
;TAPE HEADER
ICOTPH:	MOVX	T1,T$BEG	;SAVESET BEGIN
ICOTP1:	MOVEM	T1,G$TYPE(Q1)
	MOVE	Q2,ADDTMP+1	;ADDRESS OF DATA
	MOVE	T1,SV.TAD(Q2)
	MOVEM	T1,S$DATE(Q1)
	MOVX	T1,BKFMT	;BACKUP FORMAT VERSION
	MOVEM	T1,S$FMT(Q1)
;S$BVER, S$MON, S$SVER, S$DEV, S$MTCH NOT PROVIDED
	SKIPN	T1,APRID
	JRST	[MOVEI	T1,.APRID
		 GETAB%
		  ERJMPS NOAPRI
		 MOVEM	T1,APRID
		 JRST	.+1]
	MOVEM	T1,S$APR(Q1)
NOAPRI:	HRROI	T2,NIHEAD+1(Q1)	;DEST FOR SAVESET NAME
	HRROI	T1,SV.MSG(Q2)
	CALL	CSTR
	SUBI	T2,NIHEAD-1(Q1)	;COMPUTE NUMBER WORDS USED
	HRLI	T2,O$SSNM
	MOVEM	T2,NIHEAD(Q1)	;SETUP ONE-WORD HEADER
	HRRZM	T2,G$LND(Q1)	;NOTE SIZE OF NON-DATA AREA
	JRST	ICOCNY		;RETURN VALID BUFFER

;DATA RECORD
ICODAT:	MOVX	T1,T$FIL	;TYPE CODE
	MOVEM	T1,G$TYPE(Q1)
	MOVEI	T1,1000		;ASSUME FULL PAGE OF DATA HERE UNLESS...
	CAMLE	T1,ICOLEN	;NOT THAT MUCH LEFT IN FILE
	MOVE	T1,ICOLEN	;USE WHATEVER IS LEFT
	MOVEM	T1,G$SIZ(Q1)	;SET DATA WORD COUNT THIS RECORD
	MOVNS	T1
	ADDM	T1,ICOLEN	;UPDATE REMAINING COUNT
	MOVE	Q2,ADDTMP
	HRRZ	T1,.PAGNO(Q2)	;GET THE PAGE NUMBER
	LSH	T1,9		;MAKE A WORD
	MOVEM	T1,F$RDW(Q1)
	HRLZ	T1,ADDTMP+1
	HRRI	T1,NIHEAD(Q1)
	BLT	T1,NIHEAD+1000-1(Q1)
	JRST	ICOCNY		;RETURN BUFFER

ICOFLT:	MOVX	T1,T$FIL
	MOVEM	T1,G$TYPE(Q1)
	MOVX	T1,GF$EOF
	IORM	T1,G$FLAG(Q1)	;YES, NOTE THIS IS THE LAST RECORD OF FILE
	JRST	ICOCNY

;FILE HEADER
ICOFLH:	MOVX	T1,T$FIL	;RECORD TYPE
	MOVEM	T1,G$TYPE(Q1)
	MOVEI	T1,F$NND	;NOTE SIZE OF NON-DATA AREA THIS RECORD
	MOVEM	T1,G$LND(Q1)
	MOVX	T1,GF$SOF	;FLAGS - START OF FILE
	IORM	T1,G$FLAG(Q1)
	MOVEI	T4,NIHEAD+1(Q1)	;BEG OF AREA FOR FILENAME
	MOVE	T1,[O$NAME,,F$NND/2]
	MOVEM	T1,-1(T4)
	MOVE	Q2,ADDTMP+1	;POINTER TO DATA SECTION
	MOVE	T1,Q2
	HRLI	T1,(POINT 7)
	ILDB	T2,T1
	CAIE	T2,"<"
	JRST	.-2
	MOVX	T2,.FCDIR	;INDICATE DIR BLOCK
	HRLM	T2,(T4)
	MOVEI	T2,">"
	CALL	ICOFHC		;COPY DIRECTORY STRING
	MOVX	T2,.FCNAM	;INDICATE NAME BLOCK
	HRLM	T2,(T4)
	MOVEI	T2,"."
	CALL	ICOFHC		;COPY NAME STRING
	MOVX	T2,.FCEXT
	HRLM	T2,(T4)		;INDICATE EXT BLOCK
	MOVEI	T2,"."
	CALL	ICOFHC		;COPY EXT STRING
	MOVX	T2,.FCGEN	;INDICATE GENERATION BLOCK
	HRLM	T2,(T4)
	SETZ	T2,
	CALL	ICOFHC		;COPY GENERATION STRING
	MOVEI	T4,NIHEAD+F$NND/2+1(Q1) ;BEG OF AREA FOR ATTRIBUTES
	MOVE	T1,[O$FILE,,F$NND/2]
	MOVEM	T1,-1(T4)
	MOVE	T1,FDBOFF+.FBWRT(Q2)
	MOVEM	T1,A$WRIT(T4)	;COPY WRITE DATE
	MOVEI	T1,LN$AFH	;THIS THE LENGHT?
	MOVEM	T1,A$FHLN(T4)	;SET LENGTH
	LOAD	T2,FB%BSZ,FDBOFF+.FBBYV(Q2) ;GET FILE BYTE SIZE
	JUMPE	T2,[		;IF BYTE SIZE IS ZERO, USE 36
		LOAD	T1,FB%PGC,FDBOFF+.FBBYV(Q2) ;GET PAGE COUNT
		LSH	T1,9	;GET ACTUAL SIZE IN WORDS
		MOVEM	T1,FDBOFF+.FBSIZ(Q2) ;AND USE AS FILE BYTE COUNT
		MOVEI	T2,^D36	;GET BYTE SIZE
		JRST .+1]
	MOVEM	T2,A$BSIZ(T4)
	MOVEI	T1,^D36
	IDIV	T1,T2		;COMPUTE ACTUAL BYTES/WD
	MOVE	T2,FDBOFF+.FBSIZ(Q2) ;GET FILE BYTE COUNT
	MOVEM	T2,A$LENG(T4)	;SET BYTE COUNT
	IDIV	T2,T1		;CONVERT BYTE COUNT TO 36-BIT BYTES
	CAIE	T3,0		;REMAINDER?
	ADDI	T2,1		;YES, ACCOUNT FOR PARTIAL WORD
	MOVEM	T2,ICOLEN	;KEEP LOCAL COUNT
	MOVEM	T2,A$ALLS(T4)	;USE IT AS ALLOCATION ALSO
	MOVX	T1,.DMIMG	;USE STANDARD MODE
	MOVEM	T1,A$MODE(T4)
	JRST ICOCNY

;LOCAL ROUTINE TO COPY FILESPEC STRING
; T1/ SOURCE STRING POINTER
; T2/ TERMINATING CHAR
; T4/ DEST ADDRESS
; returns T4 set up for next time
ICOFHC:	PUSH	P,T4		;SAVE BLOCK ADDRESS
	ADD	T4,[POINT 7,1]	;CREATE DEST STRING POINTER
ICOFH2:	ILDB	T3,T1
	CAIN	T3,"V"-100
	JRST	[IDPB	T3,T4
		 ILDB	T3,T1
		 IDPB	T3,T4
		 JRST	ICOFH2]
	CAIN	T2,(T3)
	JRST	ICOFH3
	IDPB	T3,T4
	JRST	ICOFH2
ICOFH3:	SETZ	T3,
	IDPB	T3,T4
	MOVEI	T3,(T4)		;WHICH WORD DID STRING END IN?
	POP	P,T2		;GET ADDRESS OF BLOCK BEGINNING
	SUBI	T3,-1(T2)	;GET BLOCK LENGTH
	HRRM	T3,(T2)		;AND STORE
	MOVEI	T4,1(T4)	;SET UP FOR NEXT TIME
	RET
	SUBTTL	Random data
;Useful asciz constants and other such things
CRLF2:	ASCIZ/

/				;ACTUALLY CR-LF-LF

CRLF:	ASCIZ/
/
CBCR:	ASCIZ/]
/
SPCBCR:	ASCIZ/ ]
/
;Masks and such for CHECK, RESTORE, RETRIEVE
;**;[560] Change one line at MASK: +1L		DEE	20-JAN-89
;**;[563] Change one line and insert one line at MASK: +1L	SMW	6-OCT-89
MASK:	0
IFGE FTVERS-6,	FB%SEC+FB%PRM+FB%NOD+FB%FCF+FB%NDL ;[559][560][563] CTL (FB%INV IS SPECIAL-CASED)
IFL FTVERS-6,	FB%PRM+FB%NOD+FB%FCF+FB%NDL ;[559][560][563] CTL (FB%INV IS SPECIAL-CASED)
	0			; EXL
	0			; ADR
	0			; PRT
	-1			; CRE
	0			; OLD AUTHOR WRITER WORD
	0			; GEN
	0			; ACT
	777717,,0		; BYV
	-1			; SIZ
	-1			; CRV
	-1			; WRT
	-1			; REF
	-1			; CNT
	-1			; BK0
	0			; BK1
	0			; BK2
	AR%1ST+AR%WRN		; BBT
	0			; NET
	-1			; 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 **>

;**;[550]Change one line at NWMASK: +1L		DEE	5-APR-88
;**;[559]Change one line at NWMASK: +1L		DEE	20-JAN-89
;**;[563]Change one line and insert one line at NWMASK: +1L	SMW	6-OCT-89
NWMASK:	0
IFGE FTVERS-6,	FB%SEC+FB%TMP+FB%PRM+FB%NOD+FB%FCF ;[559][550][560][563] (FB%INV IS SPECIAL-CASED)
IFL FTVERS-6,	FB%TMP+FB%PRM+FB%NOD+FB%FCF ;[559][550][560][563] (FB%INV IS SPECIAL-CASED)
	0
	0
	0
	0
	0
	0
	0
	777717,,0
	-1
	-1
	-1
	-1
	0
	0
	0
	0
	0
	0
	-1
	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,,-1			;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 **>

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/

;Off the listing to punch literals
LITS:	XLIST
	 LIT
	LIST
;Done!
VARS:	VAR			;SHOULD BE NULL

;***** NO CODE OR DATA AFTER THIS POINT PLEASE! *****

ENDPRG:
	IF2,<IFN <VARS-ENDPRG>,<
	 PRINTX %Variables defined via # should reside in TMPVAR:
	> >
	PURGE	%%C
	END	<VECLEN,,VECT>
COMMENT `
			DUMPER - a bit of philosophy

     For those who feel that  DUMPER  takes too long to run,  consider  the
following pointers.

     1. The first is simple  - insofar  as it is  possible,  run  DUMPER at
times of low system usage.  Not only will DUMPER not compete  against users
for the CPU and disk  channels,  but  DUMPER  will be able to keep the tape
drive  spinning  nearer its top  speed.  Experiment  with the SET  BLOCKING
command to  determine  what value  gives you the best  balance  of CPU use,
realtime speed, and tape.

     2. Avoid the use of LIST, FILES, DIRECTORIES, and INTERCHANGE commands
whenever possible. These all use extra CPU and do extra I/O to the terminal
or disk, hence slowing DUMPER down.

     3. If possible, EXPUNGE directories before saving them.

     4. Consider  changing   the  conditional  flags  in  DUMPER  to   drop
functionality  you don't  need.  If you don't use USAGE  records,  turn off
FTUSAG, for example. Especially consider turning off FTCHKS.

     Giving REEVAL a value above 1 turns on the output  optimization  code.
This may cause DUMPER to use more CPU when saving,  so most sites will want
it off. However, long saves *may* take slightly less wallclock time with it
on.  The code  endeavours to figure out about how long a DUMPO% takes,  and
tries to avoid blocking based on that. The value of REEVAL is the number of
DUMPO%s  done  before  DUMPER  reevaluates  how many  buffers it can create
before a DUMPO% finishes, so if you use it, set REEVAL fairly high (>150).

     However,  there is little  getting  past this:  DUMPER  has to look at
every file in the filespec  you give it during a SAVE.  This is often every
file on a structure.  It is unavoidable that the act of stepping a jfn over
so many  files is going to  consume  the CPU.  Attempts  have  been made to
minimise the impact, but DUMPER will slow your system down. `
COMMENT `
		  On transporting files between systems

     Different  versions of DUMPER have written records  differently.  This
may cause  problems for people writing tapes to take between  systems.  The
simplest way around this is to write tapes in INTERCHANGE mode,  which is a
format readable by all DUMPERs, and also TOPS-10's BACKUP program.

     This  solution is not  perfect.  Interchange  mode does not  perfectly
transmit  all  file  attributes,   and  it is  slower  that  normal  DUMPER
operation.  Of course, one could always send a copy of the newest DUMPER to
another system,  using  Interchange  mode if need be,  and then use that to
transfer files.
`
COMMENT `
			Of interest to MAINTAINERS

     Caution: error handling in this program is a bit strange.

     If an error  occurs,  DUMPER  will  generally  dispatch  off to either
BAKOUT or NOCMD to clean up and  prompt  again.  If a user does a ^E,  then
types a command  that  causes  an  error,  jumping  to BAKOUT  will  almost
certainly destroy whatever the interrupted command was doing. In putting in
a new ERROR or JSERRD or anything  similiar,  be very  careful in  deciding
whether to dispatch off to NOCMD or BAKOUT. In general,  fast commands that
can't be interrupted (ie, don't light OKIAE),  should always go to NOCMD on
an error.  File and tape moving  commands that cannot be gotten to from the
^E prompt can safely go to BAKOUT,  and probably  should,  as these tend to
map pages in freespace that will need cleaning out.

     This is a special case of the general  situation,  which can be summed
up thusly: "If we get here during an interrupted command we are in a lot of
trouble."  The  commands  that  can (or  cannot)  be done at the ^E  caused
prompt,  as well as those  that  can be done  at any  time,  are  carefully
assigned.  Anything that moves tape or disturbs the memory manager is a BAD
idea at the ^E prompt.

     Old DUMPERs used record offset 1 (now .FLAG) for a "page access" word.
In all cases it was set to a canned  value on write  and  ignored  on read.
This not being very  useful,  the word has been  usurped for a flag word in
tape  version 6.  However,  the bit values of H.HIST  must never be used as
flags, since old DUMPERs always set them.

     Record  type 7 WHEN  WRITTEN  ON TAPE is  always a Filler  record  and
implies that the rest of the physical record can be discarded.  GETREC does
not pass these records back. If GETREC does return record type 7, it is the
SAVEEN  (end of  saveset)  record.  Be careful  of the  difference.  SAVEEN
records are generated by reading into an EOF.

	Current record header format:
.CHKSM	checksum of entire record. Ignore if FL.NCK is set in .FLAG
.FLAG	flags (FL.???).  FL.HIS is always set for historical reasons.
.TAPNO	<STYP>B2 + <SavesetNumber>B17+<TapeNumber>
.PAGNO	<OLDFLG>B1 + <FileNumber>B17 + <PageNumberInFile>
.TYP	negated record type
.SEQ	sequence number (usually increases by one)

STYP = 0 Normal Save, 1 Collection, 2 Archival, 3 Migration
OLDFLG = 1B0 on an old style tape in a TAPEEN record if it isn't *really*
	 the end of the file, but in fact means to go to the next tape.

     The Saveset number is only filled in in  Archival/Collection/Migration
savesets.

     If, on reading a tape, a sequence number does not increase,  but stays
the same or goes  down (on tapes  with more  than one  logical  record  per
physical  record),  an error was  encountered  while  writing the tape that
didn't show up while reading it. The second physical record is ignored.

     Caution:  This code can be built to run on Monitors 4, 5 or 6.  It was
written  for  6,  and  hence  makes  much  use  of the  ERJMPR  and  ERJMPS
instructions.  V5 and  previous  monitors  don't  have  them,  so they  are
simulated  when  necessary.  Simulating  ERJMPR  is  easy.  ERJMPS  is less
trivial,  as AC's have to be saved before ERJMP clobbers them. This is done
by the DOJSS macro,  which does jsys%/ERJMPS for V6 and saves AC's and uses
ERCAL for V5.  Some code doesn't care if the ERJMPS  touches T1,  and these
have an explicit  ERJMPS (opdef'd to an ERJMP for V5) after them.  In those
cases where it really  does  matter  that the ERJMPS not disturb  the AC's,
DOJSS is used. Use *CARE* in adding ERJMPS to the code!

     Labels of the form PATnnx, where nn is a two digit number and x is any
letter,  are useful  locations for JFCLs,  TRNAs,  and JRSTs,  for patching
functionality  or sanity  checks in or out.  A  customer  who has a saveset
continuation tape that somehow got written with the wrong tape number might
want to change the instruction at PAT02A to a TRNA, for example.
`
COMMENT `
			Tape format

     Tapes are a group of Savesets,  ended by a end-of-tape  record (either
TONEXT,  indicating the data continued on another tape, or TAPEEN,  meaning
end of all data).

	They are written as
	saveset sequence
	EOF (on some types of tapes)
	saveset sequence
	EOF (on some types of tapes)
	...
	TAPEEN or TONEXT
	EOF
	EOF (logical EOT)

	Where a saveset sequence consists of
	Saveset header (SAVEST)
	File header (FILEST)				| for each
	File data (DATA)	|for each page of data	| file in the
	File trailer (FILEEN)				| saveset.

     A TONEXT  record can occur at ANY point,  indicating  the next tape is
needed to read the next  record.  The next tape  will  start  with a CONTST
record (continued saveset).

     And also: old tapes will have a FILEST record after a CONTST record if
mid-file,  which  should be ignored;  and FILEEN  tapes with  PG.CON set in
.PAGNO are treated as TONEXT records (and are handled that way by GETREC).

     Any physical record on tape is made up of 1-15 logical records (always
the same number of records per phys.  record for any given  tape).  SAVEST,
CONTST and TAPEEN  records are always the first in their  physical  records
(previous  physical  records being padded with FILLER  records if needed to
accomplish this).
`