Trailing-Edge - PDP-10 Archives - decuslib20-06 - decus/20-156/tapsav.mac
There are no other files named tapsav.mac in the archive.
;Edit number 517 by SST.D-BIGELOW on 30-Mar-84
;	Increase size of stack so we don't get a PDL overflow in the sort
;	routine with 200+ files.
;<SST.D-BIGELOW>TAPSAV.MAC.7, 11-Oct-83 13:21:19, Edit by SST.D-BIGELOW
; 516	Rewrite density routine to put it in the directory block to make it
;	available even when tape isn't mounted.
;<SST.D-BIGELOW>TAPSAV.MAC.2,  6-Oct-83 10:40:30, Edit by SST.D-BIGELOW
; 515	Modify crash calls to use internal routine and avoid conflict with
;	UUOCON crash routine.  Change macro name to crunch.  Change name of
;	array string to array strng.
;<SST.D-BIGELOW>TAPSAV.MAC.8,  2-Aug-83 13:26:58, Edit by SST.D-BIGELOW
; 514	Add command for partial (wildcard) directories.  Make directory
;	inform of tape density when tape is mounted.  Minor version 12.
;<SST.D-BIGELOW>TAPSAV.MAC.3, 17-Jun-83 10:13:48, Edit by SST.D-BIGELOW
; 513	Widen the page length column width to allow for >1,000 page files.
;<SST.D-BIGELOW>TAPSAV.MAC.3, 22-Feb-83 09:46:17, Edit by SST.D-BIGELOW
; 512	Make the TSDIR: message a little bit fancier.
;<SST.D-BIGELOW>TAPSAV.MAC.2, 17-Jan-83 08:07:48, Edit by SST.D-BIGELOW
; 511	Change listing default back to on, and print a fancy message when
;	TSDIR: is not defined telling user it was defined to be DSK:.
;<SST.D-BIGELOW>TAPSAV.MAC.2, 21-Oct-82 19:28:07, Edit by SST.D-BIGELOW
; 510	Modify HELP command -- it was too long for the print buffer of 64
;	words in UUOCON.
;<SST.D-BIGELOW>TAPSAV.MAC.9, 20-Oct-82 09:27:54, Edit by SST.D-BIGELOW
; 507	Convert directory header to print format, and make the default
;	listing mode be no files.  Convert files command to list command.
;<SST.D-BIGELOW>TAPSAV.MAC.7, 20-Oct-82 09:09:41, Edit by SST.D-BIGELOW
; 506	Add ^A interrupt for listing current file in progress.
;<SST.D-BIGELOW>TAPSAV.MAC.2, 19-Oct-82 12:05:38, Edit by SST.D-BIGELOW
; 505	Add ^E interrupt processing to allow the options of turning on/off
;	the file listing mode, as well as allowing exiting or aborting.
;<SST.D-BIGELOW>TAPSAV.MAC.2, 23-Sep-82 14:34:46, Edit by SST.D-BIGELOW
; 504	Implement setting and restoring tape record size defaults.  Make
;	tape records 14 pages long.  Add version typeout.
;<SST.D-BIGELOW>TAPSAV.MAC.37, 22-Jun-82 12:49:49, Edit by SST.D-BIGELOW
;	Make storage allocation take place starting at an even page boundry.
;<SST.D-BIGELOW>TAPSAV.MAC.35, 31-Mar-82 08:44:42, Edit by SST.D-BIGELOW
;	Add supersede check when restoring files.  Files on tape were always
;	superseding files on disk, which should be made an option.
;<SST.D-BIGELOW>TAPSAV.MAC.21, 28-Mar-82 09:12:54, Edit by SST.D-BIGELOW
;	Set up the interrupt system to intercept all program errors not caught
;	by ERJMPs and close out the directory file.  Include ^C interception.
;<SST.D-BIGELOW>TAPSAV.MAC.2, 26-Mar-82 12:56:15, Edit by SST.D-BIGELOW
;	Change to minor version G - implement page mapping for directory,
;	and re-arrange the program storage.
;<SST.D-BIGELOW>TAPSAV.MAC.3,  9-Mar-82 19:52:11, Edit by SST.D-BIGELOW
;	Remove the ".0" from the tape directory file type specification.
;	It was causing generation 1 to be overwritten every time.
;<WCC.D-BIGELOW.SOURCE>TAPSAV.MAC.6,  8-Mar-82 19:48:51, Edit by SST.D-BIGELOW
;	Check for a valid directory before typing out the tape announcement.
;	Avoid the message "Please run TAPSAV-0" from the CHKVER routine when
;	looking at a null TAPEDIR file.
;<SST.D-BIGELOW>TAPSAV.MAC.2,  2-Nov-81 16:50:27, Edit by SST.D-BIGELOW
;	Print the message "% No files in request" when saving or restoring
;	no files.  Prevent unnecessary waits for spacing operations.
;<WCC.D-BIGELOW.SOURCE>TAPSAV.MAC.4, 26-Oct-81 23:50:16, Edit by SST.D-BIGELOW
;	Fix a long-standing bug in the backspace file routine, which wasn't
;	really backing up one file.  This is only used in conjunction with
;	the TU45 spurious off-line condition.
;<SST.D-BIGELOW>TAPSAV.MAC.3, 21-Oct-81 08:07:55, Edit by SST.D-BIGELOW
;	Make the directory command print the last write date rather than the
;	creation date.  Be consistent with a VDIR command.  Make this minor
;	verson 6 (F).
;<SST.D-BIGELOW>TAPSAV.MAC.2, 19-Oct-81 16:50:15, Edit by SST.D-BIGELOW
;	Change the supersede check to reference the last write date rather
;	than the creation date.
;<SST.D-BIGELOW>TAPSAV.MAC.3,  4-Oct-81 18:11:37, Edit by SST.D-BIGELOW
;	Prevent saves of tape directories by skipping files called *.TAPEDIR.
;	This prevents disaster if you save and later restore the directory
;	to the tape being used.
;<SST.WORK2>TAPSAV.MAC.3,  3-Aug-81 17:36:18, Edit by SST.D-BIGELOW
;	Add number ranges (m:n) to the getlst subroutine to allow restoration
;	of several files at once.  Also add more features to the error
;	processing so that label errors won't abort a restore.
;<SST.D-BIGELOW>TAPSAV.MAC.2, 16-May-81 10:53:19, Edit by SST.D-BIGELOW
;	Rewrite the save file error routine to type out the error messages in
;	a proper format.  Also rewrite that and several other routines to use
;	the print routine in UUOCON.  Avoid some duplicated code.
;	Eliminate the sort routine to use UUOCON's routine instead.  Also use
;	the UUOCON crash routine.
;	Fix some bugs in the restore routine - use the PRINT routines to type
;	out error and jfn information and clear tape errors before attempting
;	to close the tape file.  Crash if it fails, since a crash will soon
;	follow anyway if the close didn't work.
;	Change tape error handling routine.  Prevent [OK] and [FAILED] messages
;	from appearing on wrong sorts of errors.  Also make sure tape jfn is
;	given up to avoid "Invalid simultaneous access" problems.
;	Don't preserve generation numbers on tape anymore - they aren't of
;	great use and can cause problems on a restore to an area with
;	existing superseded files.
;	Add more information to typeout when listing filenames on a restore
;	or on a save.  Also tighten up some general code.
;	Try to make tape label read errors more recoverable - intercept errors
;	when opening, closing and reading headers from a tape file.
;	Formatting change only - use new TV macro to create structure
;	diagrams for directory and file header blocks.
;	Change date setting and size setting algorithms -- they don't work
;	if executed before the file is closed.
;	Implement "supersede across" command to allow superseding of files
;	even when savesets don't match.
;	Make this the start of version 2C.  The standardized edit history
;	format starts here.  Add version number typout to the tape header,
;	and preserve byte size and count of all files.
Subttl	Table of contents for Tapsav

;	   -- Section --					   -- Page --
;  1.   Edit history.................................................. 1
;  2.	Table of contents............................................. 2
;  3.	Program initialization........................................ 3
;  4.	Flags and Macros.............................................. 4
;  5.	Symbols and storage........................................... 5
;  6.	Interrupt system storage...................................... 6
;  7.	Directory header block structure.............................. 7
;  8.	File header block offsets..................................... 8
;  9.	Table data.................................................... 9
;  10.	COMND function blocks......................................... 10
;  11.	Start of main routine......................................... 11
;  12.	Create command................................................ 12
;  13.	Delete and undelete commands.................................. 14
;  14.	Directory commands............................................ 15
;  15.	Exit command.................................................. 20
;  16.	Faketape - fake a mounted tape................................ 21
;  17.	Help command.................................................. 22
;  18.	Files and Nofiles commands.................................... 23
;  19.	Restore command............................................... 24
;  20.	Rebuild command............................................... 30
;  21.	Save command.................................................. 34
;  22.	Supersede command............................................. 41
;  23.	Tape command.................................................. 42
;  24.	Title command................................................. 43
;  25.	Subroutines
;	  25.1   Settap............................................... 44
;	  25.2   Tape herald typout................................... 46
;	  25.3   Density.............................................. 48
;	  25.4   GETLST - get a list of file numbers.................. 49
;	  25.5   GETMAT - Find directory matches for JFN in P1........ 51
;	  25.6   Tape operations...................................... 53
;	  25.7   Interrupt system control............................. 55
;	  25.8   Directory handling................................... 59
;	  25.9   Setting and clearing tape defaults................... 60
;	  25.10   Miscellaneous....................................... 61
;		     (End of table of contents)
Subttl	Program initialization

Search	Symbol		;universal file sets up macro definitions
Sall			;supress macro expansions

;Version information
	Vmajor==2		;major version

.TTL.	Tapsav,Utility for disk-tape file transfers

;Special routines to include

.IF Omit,Macro,<
	Use	SORTER		;sort routines
	Omit	MEMORY		;memory control not needed
	Omit	COMMAN		;old-style comnd jsys routines used
	Omit	STRING		;no use of string package

Include	F..UUO			;nclude local uuo package
Include	F..CMD			;include CMD jsys routine

;Program description
;Title:	TAPSAV
;Author:Douglas Bigelow, Wesleyan Computing Center
;Date started:	1-Nov-80
;	This program is designed for quick and convenient file transfers
;	between tape and disk, and as a user's substitute for DUMPER.
;	The primary features include a directory maintained on disk for
;	quick directories and a very simple tape format, designed for
;	maximum ease in restoration should any problems occur on the tape.
;	Error handling in the program is extensive, and the program is
;	reasonably immune from problems due to unexpected termination.
;	A directory may be rebuilt at any time from the tape alone, making
;	this program unaffected by disk disasters.
Subttl	Flags and Macros

Bitpos==0			;start with bit zero

	Switch	F.gtap		;got the tape setup
	Switch	F.gdir		;got the disk directory
	Switch	F.dfil		;typing deleted files
	Switch	F.unde		;files are being undeleted
	Switch	F.aeot		;at end of tape
	Switch	F.tofl		;tape may be off-line
	Switch	F.list		;list filenames on save or restore
	Switch	F.oldf		;older copy of disk file is on tape
	Switch	F.sall		;supersede always
	Switch	F.snev		;supersede never
	Switch	F.sold		;supersede older
	Switch	F.ncss		;never check saveset when superseding
	Switch	F.fakt		;fake tape mounted
	Switch	F.fgen		;file generation number given
	Switch	F.dscd		;discard file being restored
	Switch	F.pdir		;partial directory in progress

F.mask==F.dfil+F.unde		;flags to clear at each command

;Macro definitions

Define	Setup(comand,dispat),<
	xwd	[asciz\comand\],dispat	;;command table entry

Define	Setsec(comand,dispat),<
	xwd	[cm%fw!cm%inv
		 asciz\comand\],dispat	;;secret command entry

Define	Magblk(ac),<
	move	ac,recpag	;;get location
	hrli	ac,444400	;;and pointer

Define	Crunch,<
	call	cra..		;;call our own crash routine
Subttl	Symbols and storage

;General symbols
	J==P4			;JFN stack pointer
	Prgver==137		;location of version number
	Strsiz==20		;string size
	Pagsiz==1000		;size of page
	Recsiz==4*pagsiz	;size of file/tape record
	Stksiz==10*pagsiz	;size of stack
	Jstksz==30*pagsiz	;size of jfn stack
	Dirpag==100		;starting page of directory area
	Dirloc==dirpag*pagsiz	;beginning of directory area
	Magsiz==14000		;14 page default record size

;File flags
	G.dfil==1b0		;file is deleted

	Array	Owner[strsiz]		;owner name
	Array	Tsdir[strsiz]		;tape directory filename
	Array	Volume[strsiz]		;tape volume name
	Array	Strng[strsiz]		;string storage
	Array	Dsknam[strsiz]		;name of disk file
	Array	Tapnam[strsiz]		;name of tape file
	Array	Intacs[2]		;storage for a and b
	Array	Savset[4]		;save set name
	Array	Acs[20]			;ac storage during interrupts
	Array	Filcpy[50]		;directory header of file
	Integer	Djfn,Ojfn,Fjfn,Tjfn	;jfn storage
	Integer	Wldjfn			;wildcard jfn
	Integer	High,Low		;low and high number ranges
	Integer	Intptr			;interrupt stack pointer
	Integer	Jobdef			;Default magtape record size
	Integer	Resdir			;restoration directory
	Integer	Topdir			;top of directory area
	Integer	Dirpnt			;disk filespec pointer
	Integer	Tappnt			;tape filespec pointer
	Integer	Savsp			;backup copy of stack pointer
	Integer	Jstk..			;address of jfn stack
	Integer	Stak..			;address of pdl
	Integer	Recpag			;address of magtape record page
	Integer	Densit			;current density

;Generate all program storage here
	Xlist			;but don't expand it
	List			;restore normal listing mode
Subttl	Interrupt system storage

Levtab:	lev1pc

Lev1pc:	z
Lev2pc:	z
Lev3pc:	z

Chntab:	1,,cntrlc		;0 - control-c interrupt
	2,,intrpt		;1 - control-e interrupt
	2,,lstfil		;2 - control-a interrupt
	block	^d6		;3 - 8
	1,,panic		;9
	0			;10
	1,,panic		;11
	1,,panic		;12
	block	2		;13 - 14
	1,,panic		;15
	1,,panic		;16
	1,,panic		;17
	block	2		;18 - 19
	1,,panic		;20
	block	^d15		;21 - 35

Onchns:	1b0!1b1!1b2!1b9!1b11!1b12!1b15!1b16!1b17!1b20
Subttl	Directory header block structure

;                             Directory header block
;                         1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3
;     0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
;    |-----------------------------------------------------------------------|
;+0  |                               Tape label                              |
;    |-----------------------------------------------------------------------|
;    :                                   :                                   :
;    :                                   :                                   :
;    |-----------------------------------------------------------------------|
;+2  |                           Name of tape owner                          |
;    |-----------------------------------------------------------------------|
;    :                                   :                                   :
;    :                                   :                                   :
;    |-----------------------------------------------------------------------|
;+12 |                     User-defined tape description                     |
;    |-----------------------------------------------------------------------|
;    :                                   :                                   :
;    :                                   :                                   :
;    |-----------------------------------------------------------------------|
;+32 |                         Tapsav version number                         |
;    |-----------------------------------------------------------------------|
;+33 |                         Creation date of tape                         |
;    |-----------------------------------------------------------------------|
;+34 |                         Last tape access date                         |
;    |-----------------------------------------------------------------------|
;+35 |                        Number of tape accesses                        |
;    |-----------------------------------------------------------------------|
;+36 |         No. files on tape         |         No. files deleted         |
;    |-----------------------------------------------------------------------|
;+37 |                         Tape density (numeric)                        |
;    |-----------------------------------------------------------------------|
;+40 |                        Last currently used word                       |
;    |-----------------------------------------------------------------------|
;Directory header block offsets
	S.tlab==dirloc+0	;tape label offset
	S.onam==dirloc+2	;owner name
	S.ulab==dirloc+12	;user label
	S.tver==dirloc+32	;version number
	S.cdat==dirloc+33	;creation date
	S.adat==dirloc+34	;last access date
	S.nacc==dirloc+35	;number of accesses
	S.nfil==dirloc+36	;number of files
	S.dens==dirloc+37	;tape density
	S.last==dirloc+40	;last currently used word
	S.ffil==dirloc+100	;location of first file
	S.hsiz==100		;length of header
	S.fsiz==50		;length of a file directory entry
Subttl	File header block offsets

;                               File header block
;                         1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3
;     0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
;    |-----------------------------------------------------------------------|
;+0  |             File flags            |        File number on tape        |
;    |-----------------------------------------------------------------------|
;+1  |                    Filename, protection and account                   |
;    |-----------------------------------------------------------------------|
;    :                                   :                                   :
;    :                                   :                                   :
;    |-----------------------------------------------------------------------|
;+25 |         Byte size of file         |       Size of file in pages       |
;    |-----------------------------------------------------------------------|
;+26 |                       Date of last write to file                      |
;    |-----------------------------------------------------------------------|
;+27 |                         Date of file creation                         |
;    |-----------------------------------------------------------------------|
;+30 |                       Name of save set (4 words)                      |
;    |-----------------------------------------------------------------------|
;    :                                   :                                   :
;    :                                   :                                   :
;    |-----------------------------------------------------------------------|
;+34 |              File check words (contains *TSV* / version)              |
;    |-----------------------------------------------------------------------|
;    :                                   :                                   :
;    :                                   :                                   :
;    |-----------------------------------------------------------------------|
;+36 |                        Number of bytes in file                        |
;    |-----------------------------------------------------------------------|
;+37 |                        Last currently used word                       |
;    |-----------------------------------------------------------------------|
	D.flag==0		;flag location		;filename and protection (24 words)
	D.size==25		;size of file
	D.wdat==26		;date of last write
	D.cdat==27		;date of creation
	D.ssnm==30		;save set name (4 words)
	D.fchk==34		;file check words (contains *TSV* / version #)
	D.nbyt==36		;number of bytes in file
	D.last==37		;last currently used word
Subttl	Table data

Comtab:	xwd	comsiz,comsiz	;length of table
	setup	Create,%crea	;;create a new tape
	setup	Delete,%dele	;;delete tape files
	setup	Directory,%dire	;;directory command
	setup	Exit,%exit	;;terminate program
	setup	Faketape,%faktp	;;fake a mounted tape
	setsec	Files,%list	;;list filenames on save or restore
	setup	Help,%help	;;help command
	setup	List,%list	;;list command
	setsec	Nofiles,%nolst	;;don't list filenames
	setup	Nolist,%nolst	;;don't list filenames
	setup	Rebuild,%rebu	;;rebuild the directory
	setup	Restore,%rest	;;restore files to disk
	setup	Save,%save	;;save files on tape
	setup	Sdirect,%sdir	;;super directory
	setup	Supersede,%supr	;;specify when to supersede
	setup	Tape,%tape	;;specify a tape unit
	setup	Title,%title	;;title command
	setup	Undelete,%unde	;;undelete command
	comsiz==.-comtab-1	;size of table

Yestab:	xwd	yessiz,yessiz	;number of entries
	setup	Maybe,0		;;maybe means no
	setup	No,0		;;so does no
	setup	Yes,-1		;;only positive response
	yessiz==.-yestab-1	;size of table

Suptab:	xwd	supsiz,supsiz	;number of entries
	setup	Across,(F.ncss)	;;supersede across saveset boundries
	setup	Always,(F.sall)	;;supersede always
	setup	Never,(F.snev)	;;supersede never
	setup	Older,(F.sold)	;;supersede older
	supsiz==.-suptab-1	;size of table

Inttab:	xwd	intsiz,intsiz	;number of entries
	setup	Abort,%Abort	;;abort processing
	setup	Help,%hlpin	;;help with interrupt commands
	setup	List,%list	;;list filenames
	setup	Nolist,%nolst	;;don't list filenames
	setup	Resume,%resum	;;resume processing
	intsiz==.-inttab-1	;size of table
Subttl	COMND function blocks

Ospec:	flddb.	(.cmfil,cm%sdh,,<Optional output file>,<tty:>)	;output spec
Fspec:	flddb.	(.cmfil,cm%sdh,,<Name of file>)	;filename
Lspec:	flddb.	(.cmcfm,cm%sdh,,<CR to end list>,,fspec) ;<cr> or filename
Nspec:	flddb.	(.cmnum,cm%sdh,12,<File number>,,lspec)	;number or filename
Mspec:	flddb.	(.cmnum,cm%sdh,12,<End of number range>) ;end of number range
Pspec:	flddb.	(.cmtok,cm%sdh,<point 7,[asciz .:.]>,<Colon for number range>,,cspec)	;colon or cr
Wspec:	flddb.	(.cmcfm,cm%sdh,,<CR for all files>,,w2spec)
W2spec:	flddb.	(.cmfil,cm%sdh,,<Optional wildcard filespec>)
Tspec:	flddb.	(.cmtxt,cm%sdh,,<Optional save set name>)
Sspec:	flddb.	(.cmswi,,swttab,,,cspec)	;switch or <CR>
S2spec:	flddb.	(.cmswi,,swttab)
Cspec:	flddb.	(.cmcfm)			;<CR>
Dspec:	flddb.	(.cmdev)			;device

Swttab:	xwd	1,1		;only one entry
	setup	Saveset:,0	;switch /Saveset:
Subttl	Start of main routine

Tapsav:	reset			;clear everything
	jrst	setmem		;set up memory and return
Memset:	movx	f,f.sold!f.list	;set up flags
	hrlzi	p,-stksiz	;size of stack
	hrr	p,stak..	;and location
	call	inipi		;initialize priority interrupt system
	call	setdef		;set special defaults for tapes
	call	cmdini##	;initialize the command scanner
	movem	p,savsp		;save current stack pointer
	gjinf			;get job info
	movem	b,resdir	;store connected directory number
	print	asc<Tapsav %V%C>	;print the version
	call	settap		;see if a tape is available

;Main loop
Nxtcmd:	flgoff	f.mask		;global flags to clear
	hrr	j,jstk..	;and location
	setzm	(j)		;clear bottom of stack
	hrli	j,-jstksz	;size of stack
	type	<>		;add a cr
	bpl	a,<Tapsav-->	;program prompt
	call	dpromp		;type it out
	movei	a,[flddb. .cmkey,,comtab,<Command,>]
	call	rfield		;get a command
	hrrz	a,(b)		;get the address
	call	(a)		;execute it
	call	clrcle		;clear control-E interrupt
	jrst	nxtcmd		;and loop
Subttl	Create command

;Create a new tape

%Crea:	noise	<a new TAPSAV tape>
	confrm			;confirm it
	skpon	f.fakt		;fake tape mounted?
	skpon	f.gtap		;got a tape spec?
	 jrst	needtp		;nope, give up
	skpon	f.gdir		;existing directory for tape?
	 jrst	crea.b		;nope, proceed
	type	<% This will overwrite the old directory>
	bpl	a,<% Are you sure? >
	call	dpromp		;prompt
	movei	a,[flddb. .cmkey,,yestab,<Answer,>]
	call	cfield		;get answer and confirm
	hrrz	a,(b)		;get key
	jumpn	a,crea.a	;yes, so proceed
	type	<% Directory creation aborted>
	ret			;give up

;Here to close out the old directory
Crea.a:	call	dircls		;close out the old directory
;Now open up the new one

Crea.b:	movx	a,gj%sht!gj%fou	;new generation
	bpm	b,tsdir		;what the name is
	gtjfn%			;get a jfn
	 crunch			;can't
	movem	a,djfn		;save the jfn
	call	diropn		;open and map the directory
	movei	t1,s.ffil	;point to first free location
	movem	t1,topdir	;save it
	movem	f,dirloc	;test the page
	 erjmp	quoerr		;quota full

;Here to proceed
	call	taprew		;make sure tape is at bot
	bpm	t1,volume	;point to volume name
	bpm	t2,s.tlab	;destination
	call	movstr		;move the string
	bpm	t1,owner	;point to owner name
	bpm	t2,s.onam	;store it
	call	movstr		;move string
	gtad			;get time and date
	movem	a,s.cdat	;store creation date
	movem	a,s.adat	;and access date
	setzm	s.nfil		;no files yet
	movei	a,1		;set up for..
	movem	a,s.nacc	;one tape access
	call	title		;get a title for the tape
	move	t1,densit	;get density
	movem	t1,s.dens	;and store it
	setzm	s.last		;clear last location
	move	a,[s.last,,s.last+1]
	blt	a,s.ffil-1	;clear rest of block
	move	a,prgver	;get version
	movem	a,s.tver	;and store it
	hrlz	a,djfn		;get jfn,,page 0
	movx	b,uf%now+1	;update one page now
	ufpgs%			;write out that page
	 jfcl			;ignore errors
	call	therld		;type herald on tty
	ret			;and return
Subttl	Delete and undelete commands

;Undelete specified files from tape

%Unde:	flgon	f.unde		;say we are undeleting

;Delete specified files from tape

%Dele:	noise	<specified file(s) from tape>
	confrm			;confirm it
	skpon	f.gdir		;got a directory?
	 jrst	needdr		;nope, warn and return
	call	getlst		;get list of files

;Process the list
Dele.a:	call	getnxt		;get next file number
	 ret			;end, return
	call	delfil		;delete a file
	jrst	dele.a		;loop for all files

;File deletion subroutine - file number in T1
Delfil:	imuli	t1,s.fsiz	;multiply number by file size
	addi	t1,s.ffil-s.fsiz	;get location of file block
	move	t2,d.flag(t1)	;get flag word
	skpoff	f.unde		;are we undeleting?
	 jrst	delf.a		;yes
	txon	t2,g.dfil	;set the bit
	 aos	s.nfil		;and increment deleted count if changed
	movem	t2,d.flag(t1)	;store new flag word
	ret			;return to caller

;Here if we are undeleting
Delf.a:	txze	t2,g.dfil	;clear the bit
	 sos	s.nfil		;and decrement deleted count if changed
	movem	t2,d.flag(t1)	;reset flag word
	ret			;return to caller
Subttl	Directory commands

;Do a directory of the tape to output file

%Sdir:	flgon	f.dfil		;include deleted files in directory

%Dire:	flgoff	f.pdir		;assume not partial
	noise	<of tape to file>	;next comes the filespec
	movei	a,ospec		;output spec w/ default
	movx	b,gj%fou	;new spec
	movem	b,cjfnbk	;store that, without messages
	call	rfield		;get the file
	movem	b,ojfn		;save the output jfn
	noise	<for wildcard files>
	movei	a,wspec		;partial filespec
	movx	b,gj%ifg!gj%ofg	;wild cards allowed
	movem	b,cjfnbk	;store it
	call	rfield		;get the spec
	hrrz	a,c		;get table used
	cain	a,wspec		;cr?
	 jrst	pdi.a		;yes, no limiting factors
	flgon	f.pdir		;partial directory in progress
	movem	b,wldjfn	;store the jfn
	setzm	savset		;no saveset specified
	movei	a,sspec		;switch next
	call	rfield		;read it
	hrrz	a,c		;get table used
	cain	a,cspec		;cr?
	 jrst	pdi.a		;yes, no save set
	movei	a,tspec		;now text spec
	call	cfield		;get saveset name
	setzm	atmbuf+3	;15 chars max
	bpm	t1,atmbuf	;source
	bpm	t2,savset	;dest
	call	movstr		;move it

Pdi.a:	move	a,ojfn		;get jfn
	skpoff	f.gdir		;got a directory?
	  rljfn			;nope
	   jfcl			;ignore errors
	  skpon	f.pdir		;got a wildcard jfn?
	    move a,wldjfn	;get jfn
	    rljfn		;delete it
	  jrst	needdr		;don't continue
	movx	b,7b5!of%wr	;write to file
	openf			;open the file
	 crunch			;can't
	hrrz	a,ojfn		;get output jfn
	setjfn	(a)		;set it
	print	asc<%C** TAPSAV %V directory created %D **%C>
	setjfn	.priou		;restore old output jfn
;Continue with the herald

	call	herald		;type the herald
	setz	p3,		;clear page counter
	hlrz	p1,s.nfil	;get number of files in directory
	imuli	p1,s.fsiz	;multiply by size of file
	addi	p1,s.hsiz+dirloc	;add header size
	movei	p2,s.hsiz-s.fsiz+dirloc	;location of first file block -1
	skipn	s.nfil		;any files?
	 jrst	dir.a		;nope, don't print header
	move	a,ojfn		;output
	fmsg	<
Number	Filename		 Size	 Last written	 Saveset
------	--------		 ----	 ------------	 -------
>				;heading

;Loop typing out file names

Dir.a:	addi	p2,s.fsiz	;get file address
	caml	p2,p1		;past last file?
	jrst	dir.d		;yes, no more files
	skpoff	f.dfil		;print deleted files?
	 jrst	dir.b		;yes, so skip following check
	move	a,d.flag(p2)	;get flag word
	txne	a,g.dfil	;is it deleted?
	 jrst	dir.a		;yes, so don't print it

;;continued on next page
;;continued from previous page

Dir.b:	skpon	f.pdir		;partial?
	 jrst	dir.b1		;no, continue
	movx	a,gj%sht!gj%ofg	;parse-only jfn
	bpm	b,	;point to name
	gtjfn%			;get the jfn
	 erjmp	dir.b1		;can't
	hrrz	c,a		;copy the jfn
	movx	a,.wljfn	;code for compare jfns
	move	b,wldjfn	;get wildcard jfn
	wild%			;compare them
	exch	a,c		;get jfn back
	rljfn%			;release the jfn
	txne	c,wl%nam!wl%ext	;name or extension different?
	 jrst	dir.a		;yes, discard this jfn
	skipn	savset		;saveset used?
	 jrst	dir.b1		;no, skip this check
	bpm	a,savset	;one string
	bpm	b,d.ssnm(p2)	;saveset name
	stcmp%			;compare
	jumpn	a,dir.a		;discard, no match

;;continued on next page
;;continued from previous page

Dir.b1:	hrrz	a,d.size(p2)	;get page size
	add	p3,a		;add to cumulative count
	move	a,ojfn		;output
	hrrz	b,d.flag(p2)	;file number
	movx	c,no%lfl!no%ast!fld(4,no%col)!fld(12,no%rdx)
	nout			;type file number
	 crunch			;can't
	move	a,ojfn		;get output jfn
	fmsg	<.  >		;spacer
	bpm	a,strng		;type to string
	bpm	b,	;point to name
	movei	c,100		;maximum length
	movei	d,";"		;terminating on a ;
	sout			;type it
	setz	t1,		;clear a register
	dpb	t1,a		;clear the byte
	move	a,ojfn		;output jfn
	bpm	b,strng		;point to string
	movei	c,100		;max length
	setz	d,		;end of string
	movei	t1,100		;max length
	sub	t1,c		;minus characters left
	move	a,ojfn		;output
	movei	b,"	"	;tab character
	caig	t1,11		;short filename
	bout			;needs two tabs
	caig	t1,21		;medium filename
	bout			;needs two tabs
	bout			;even long name needs one
	move	a,ojfn		;output
	hrrz	b,d.size(p2)	;size of file
	movx	c,no%lfl!no%ast!fld(5,no%col)!fld(12,no%rdx)
	nout			;type it
	 crunch			;can't
	move	a,ojfn		;output
	movei	b,"	"	;tab
	move	a,ojfn		;output
	move	b,d.wdat(p2)	;last write date
	movx	c,ot%nsc	;no seconds necessary
	odtim			;type date

;;continued on next page
;;continued from previous page

	move	a,ojfn		;output
	fmsg	<  >		;save set name follows
	bpm	b,d.ssnm(p2)	;get saveset name
	setz	c,		;terminate on a null
	sout			;type it
	move	a,d.flag(p2)	;get flags again
	txnn	a,g.dfil	;deleted?
	 jrst	dir.c		;no
	move	a,ojfn		;output jfn
	fmsg	<   (deleted)>

Dir.c:	move	a,ojfn		;get file
	fmsg	<
>				;end of line
	jrst	dir.a		;loop for more

;Here to close the output file
Dir.d:	move	a,ojfn		;output
	fmsg	<
[ Total of >
	move	b,p3		;get pages used
	movei	c,12		;print in decimal
	nout			;output
	 crunch			;can't do it
	fmsg	< pages on tape >
	bpm	b,s.tlab	;point to tape label
	setz	c,		;type until null
	sout			;type string
	fmsg	< ]
>				;end of line
	move	a,ojfn		;get jfn
	closf			;close
	 crunch			;can't
	ret			;return
Subttl	Exit command

;Terminate the program

%Exit:	noise	<from program>
	confrm			;wait for cr
Exit.a:	skpoff	f.gdir		;do we have a directory?
	 call	dircls		;close out the directory
	call	clrdef		;restore tape defaults
	haltf			;stop
	jrst	tapsav		;but allow restarts
Subttl	Faketape - fake a mounted tape

;No need to mount the tape

%Faktp:	noise	<tape id:>
	movei	a,[flddb. .cmtxt]	;text
	call	rfield		;get the text
	dmove	t1,atmbuf	;get two words
	dmovem	t1,volume	;and store them
	call	sett.a		;get the tape directory
	flgon	f.fakt		;say tape is fake
	ret			;and return
Subttl	Help command

;List the available commands

%Help:	noise	<with program commands>
	confrm			;wait for cr
	print	asc<%C** Tapsav %V **%C>
	hrroi	a,hlpmsg	;get help message
	psout%			;type it

;Help message storage
Hlpmsg:	asciz	\
Create		Create a new tape.
Delete		Delete specified files from tape.
Directory	Print or type a directory of the tape.
Faketape	Fake a mounted tape for directory manipulation.
Help		Type this message.
List		List filenames on a save or restore.
Nolist		Don't list filenames on a save or restore (default.)
Rebuild		Rebuild the directory for a damaged tape.
Restore		Restore specified files from tape to disk.
Save		Save specified disk files on tape.
Sdirect		"Super" directory - include deleted files.
Supersede	Specifies when to supersede files on tape during save.
	Across	Supersede across saveset boundries
	Always	Always supersede files on tape.
	Never	Never supersede files on tape.
	Older	Supersede only obsolete files on tape.
Tape		Specify a magtape device for transfers.
Title		Specify a title for the tape.
Undelete	Undelete specified files on tape.
Subttl	Files and Nofiles commands

;Controls filename listing mode on saves or restores

%List:	noise	<filenames on save or restore>
	confrm			;wait for cr
	flgon	f.list		;turn on the flag
	ret			;that's all

%Nolst:	noise	<of filenames on save or restore>
	confrm			;await cr
	flgoff	f.list		;turn off listing mode
	ret			;return
Subttl	Restore command

;Restore specified files from tape

%Rest:	noise	<specified file(s) to disk area:>
	movei	a,[flddb. .cmdir,,,,<dsk:>]	;get a directory specification
	call	cfield		;get field and confirm it
	movem	b,resdir	;save destination directory
	skpon	f.gdir		;got a directory?
	 jrst	needdr		;nope, need one
	skpoff	f.fakt		;fake tape mounted?
	 jrst	needtp		;yes, can't restore from it
	call	taprew		;rewind the tape
	bpm	a,dsknam	;point to receiving area
	move	b,resdir	;get directory number
	dirst			;convert directory number to string
	 crunch			;can't
	movem	a,dirpnt	;save the current pointer position
	bpl	t1,<TS:;Pos:>	;to be used for tape jfn
	bpm	t2,tapnam	;destination
	call	movstr		;copy string
	movem	t2,tappnt	;save tape pointer
	call	getlst		;get a list of files
	move	t1,jstk..	;get beginning of stack
	aoj	t1,		;plus one
	hrrz	t2,j		;get ending address
	sort	t1,(t2)		;sort into descending order
	setz	p2,		;previous file holder
	skipn	(j)		;any files pending?
	 jrst	[type	<
[ No files specified for restore command ]>
		 jrst	taprew]	;no, so quit now
	type	<
[ Starting transfer to disk... ]>
	call	setcle		;set up for control-E command
;Loop restoring files one by one
Rest.a:	call	getnxt		;get a file number
	 jrst	taprew		;rewind tape and return
	camn	t1,p2		;same as last file restored?
	 jrst	rest.a		;yes, don't restore twice
	move	p2,t1		;save for next time
	move	p1,t1		;save the file number
	imuli	p1,s.fsiz	;multiply by file header size
	addi	p1,s.ffil-s.fsiz	;add location of first file, offset
	bpm	t1,	;pointer to filename
	move	t2,dirpnt	;directory completion pointer
	call	movstr		;tack file onto directory name
	skpoff	f.sall		;always supersede?
	 jrst	res.a2		;yes, so don't check
	movx	a,gj%sht!gj%old	;old file
	bpm	b,dsknam	;point to name
	gtjfn%			;get a jfn
	 jrst	res.a2		;none, don't check further
	skpoff	f.snev		;supersede never?
	 jrst	[flgon	f.dscd	;yes, discard this file
		 jrst	res.a1]	;and skip date check
	movei	b,t3		;address
	movei	c,1		;one word returned
	rftad%			;read last write date
	caml	t3,d.wdat(p1)	;compare dates
	 flgon	f.dscd		;file on disk is older, abort this transfer

;Here to discard the jfn
Res.a1:	rljfn%			;discard jfn
	 jfcl			;ignore errors
	clrskp	f.dscd		;are we discarding this file?
	 jrst	rest.a		;yes, go get the next
;Continue by getting the real jfn

Res.a2:	movx	a,gj%fou!gj%sht	;new file to be created
	bpm	b,dsknam	;pointer to file
	gtjfn			;get a jfn
	 erjmp	rest.d		;can't - error
	movem	a,fjfn		;save the jfn
	move	a,tappnt	;tape string pointer
	hrrz	b,d.flag(p1)	;get file number
	movei	c,12		;decimal
	nout			;type number to string
	 crunch			;can't
	setz	b,		;clear a byte
	idpb	b,a		;append to end of string
	movx	a,gj%sht	;short form
	bpm	b,tapnam	;point to tape
	gtjfn			;get a jfn to the tape
	 crunch			;can't
	movem	a,tjfn		;save the jfn

;Here we open the devices
	hrrz	a,fjfn		;get file jfn
	movx	b,of%wr		;write mode
	openf			;open that file
	 crunch			;can't

;Open the tape
	move	a,tjfn		;get tape jfn
	movx	b,of%rd		;read access to tape
	openf			;open file to tape
	 erjmp	res.e2		;intercept errors
	move	a,tjfn		;tape jfn
	bpm36	b,filcpy	;point to filcpy
	movni	c,s.fsiz	;file size
	sin			;read the header record
	 erjmp	res.e1		;intercept errors
	hrroi	a,	;point to directory copy of name
	hrroi	b,filcpy	;point to tape copy of flag word
	addi	b,	;adjust to point to name of file
	stcmp			;compare strings
	jumpe	a,res.a3	;match if zero
	type	<% Directory doesn't match tape - try REBUILD>
	call	dircls		;close the directory file
	seto	a,		;all files
	closf			;close
	ret			;and return
;Here to type out the transfer information

Res.a3:	skpon	f.list		;listing filenames?
	 jrst	rest.b		;nope, continue
	typncr	<	>	;tab first
	bpm	a,tapnam	;get tape name
	psout%			;type it
	hrrz	a,fjfn		;get file jfn
	print	a,asc< (to) %J>	;type it out

;Here we do the entire tape transfer
Rest.b:	hrrz	a,tjfn		;tape jfn
	magblk	b		;set up magtape block pointer
	movni	c,recsiz	;length
	sin			;get the logical record
	 erjmp	rest.c		;check end of file
	hrrz	a,fjfn		;file jfn
	magblk	b		;set up magtape block pointer
	movni	c,recsiz	;size of record
	sout			;send the data
	 ercal	[crunch]		;crash on output error
	jrst	rest.b		;loop
;Here on supposed end of file

Rest.c:	move	a,tjfn		;get jfn
	gtsts			;get status
	txnn	b,gs%eof	;end of file?
	 jrst	rest.e		;problem, check it out
	addi	c,recsiz	;find out how many bytes were transferred
	jumpe	c,res.c1	;none if zero
	hrrz	a,fjfn		;get file jfn
	magblk	b		;set up magtape block pointer
	movns	c		;make count negative
	sout			;output it
	 ercal	[crunch]		;can't

;Now close the tape and the file
Res.c1:	move	a,tjfn		;get tape jfn
	closf			;close it
	 crunch			;can't
	hrrz	a,fjfn		;get file jfn
	txo	a,co%nrj	;save it when closed
	closf%			;close the file
	 crunch			;can't
	dmove	t1,d.wdat(p1)	;get file dates
	hrrz	a,fjfn		;file jfn
	movei	b,t1		;arg block
	movei	c,2		;two arguments
	sftad			;set file parameters
	skipn	c,d.nbyt(p1)	;get file byte count
	 jrst	res.c2		;must be an early version
	seto	b,		;set all bits of word c
	move	a,fjfn		;get file jfn
	hrli	a,.fbsiz	;and say which word to change
	chfdb%			;set it
	move	c,d.size(p1)	;now get size word
	movx	b,fb%bsz	;field to modify
	move	a,fjfn		;jfn again
	hrli	a,.fbbyv	;word to change
	chfdb%			;change it

;Here to release the jfn
Res.c2:	move	a,fjfn		;file jfn
	rljfn%			;release it
	 crunch			;can't
	skpon	f.list		;are we listing?
	 jrst	rest.a		;now do the next file
	type	<	[OK]>	;end the file
	jrst	rest.a		;loop for next
;Here if we couldn't open the file

Rest.d:	typncr	<% Can't get a JFN on >
	bpm	a,dsknam	;point to file name
	psout			;type it
	type	<>		;add a crlf
	jrst	rest.a		;try next file

;Here if we had a tape problem
Rest.e:	skpon	f.list		;listing?
	 jrst	res.e1		;nope
	type	<	[Failed]>	;end the line
Res.e1:	move	a,tjfn		;tape jfn
	movei	b,.mocle	;clear errors
	closf%			;close the tape
	 jrst	[move	a,tjfn		;get jfn again
		 txo	a,cz%abt	;abort close
		 closf%			;try again
		  crunch		;give up
		 jrst	.+1]		;return
Res.e2:	move	t1,fjfn		;get jfn
	print	t1,asc<%P Tape error: %E%C%P Transfer aborted on file %J%C>
	hrrz	a,fjfn		;get file jfn
	txo	a,cz%abt	;set abort bit
	closf%			;close file in abort mode
	 jfcl			;ignore errors
	jrst	rest.a		;get next file
Subttl	Rebuild command

;Rebuild a damaged directory

%Rebu:	noise	<the tape directory>
	confrm			;wait for cr
	skpon	f.gtap		;got a tape?
	 jrst	needtp		;nope
	skpoff	f.fakt		;fake tape mounted?
	 jrst	needtp		;yes, can't use it
	call	taprew		;rewind the tape
	skpoff	f.gdir		;have a directory?
	 call	dircls		;yes, close it
	movx	a,gj%sht!gj%fou	;new file
	bpm	b,tsdir		;name of file
	gtjfn%			;get a jfn
	 crunch			;can't
	movem	a,djfn		;store it
	call	diropn		;open the directory
	movei	t1,s.ffil	;point to first free location
	movem	t1,topdir	;save it
	movem	f,dirloc	;test the page
	 erjmp	quoerr		;quota full

;Rebuild the tape header
	call	title		;get a title for the tape
	bpm	t1,volume	;volume name
	bpm	t2,s.tlab	;in directory
	call	movstr		;copy the string
	bpm	t1,owner	;owner name
	bpm	t2,s.onam	;in directory
	call	movstr		;copy
	gtad			;current date
	movem	a,s.cdat	;new creation date
	movem	a,s.adat	;and access date
	setzm	s.nacc		;no accesses yet
	aos	s.nacc		;except this one
	setzm	s.nfil		;we don't about any files yet
	movei	t1,s.ffil	;location of first file
	movem	t1,topdir	;store it
	move	t1,prgver	;version number
	movem	t1,s.tver	;store it
	hrlz	a,djfn		;get jfn,,page 0
	movx	b,uf%now+1	;update one page now
	ufpgs%			;write out that page
	 jfcl			;ignore errors
;Now we prepare to look at the tape file by file

	call	tapwat		;make sure tape has finished
	movx	a,gj%sht	;short form
	bpl	b,<TS:>		;tape
	gtjfn			;get a jfn
	 crunch			;can't
	movem	a,tjfn		;save the jfn
	call	setcle		;set up for control-E

;Loop for all files

Rebu.a:	movei	t1,s.fsiz-1	;get size of file entry
	add	t1,topdir	;get last location we will use
	movem	f,(t1)		;test that location
	 erjmp	quoerr		;for room on disk during mapping
	move	a,tjfn		;get the jfn
	movx	b,of%rd		;read access
	openf			;open file on tape
	 crunch			;can't
	move	a,tjfn		;get jfn
	move	b,topdir	;get address
	hrli	b,(point 36,)	;make a byte pointer
	movni	c,s.fsiz	;file header size
	sin			;input the info
	 erjmp	rebu.b		;check end of file
	skipn	s.nfil		;only check on first file
	jrst	rebu.e		;check special features
Reb.a1:	hrlzi	t1,1		;move 1 into left half
	addm	t1,s.nfil	;bump file count
	move	t1,topdir	;get pointer
	movei	t1,s.fsiz	;get file size
	addm	t1,topdir	;point to next file in sequence
	hrrz	a,tjfn		;get jfn
	txo	a,co%nrj	;don't release the jfn
	closf			;close the file
	 crunch			;can't
	jrst	rebu.a		;loop for all files
;Here when the sin call failed

Rebu.b:	move	a,tjfn		;tape jfn
	movei	b,.mocle	;clear tape errors
	movei	a,.fhslf	;our handle
	geter			;get last error
	hrrzs	b		;clear handle
	cain	b,iox4		;end of file?
	 jrst	rebu.c		;yes, ok
	caie	b,iox5		;device or data error?
	 jrst	rebu.d		;nope, something else
	move	a,tjfn		;get jfn
	gdsts			;get device status
	txne	b,mt%dve!mt%dae	;confirm the error
	 jrst	rebu.d		;yes, it was real

;Here if we merely found nothing left to read
Rebu.c:	move	a,tjfn		;get jfn
	closf			;close the tape
	 crunch			;can't
	call	taprew		;rewind the tape
	call	therld		;type herald on tty
	ret			;and return

;Here if error was real
Rebu.d:	move	t1,topdir	;point to directory entry
	movx	t2,g.dfil	;get deleted file flag
	movem	t2,d.flag(t1)	;store it
	setzm	d.cdat(t1)	;clear date
	setzm	d.size(t1)	;and size fields
	dmove	t2,[asciz .BAD-FILE.]
	dmovem	t2,d.ssnm(t1)	;saveset name
	bpm	t2,	;destination
	bpl	t1,<Bad-data.Tape-error>
	call	movstr		;copy the string
	type	<% Data error on tape, file skipped..>
	jrst	reb.a1		;continue with tape
;Here to check if we're really restoring a TAPSAV tape.  Also check
;version compatability at the same time.  Note that the information we
;need is only available on tapes written by versions 2A and older.

Rebu.e:	move	t1,topdir	;get start of file area
	dmove	t1,d.fchk(t1)	;get tapsav signal word and version number
	camn	t1,[ascii .*TSV*.]
	 jrst	reb.e2		;passed first test
	type	<
% If this is a Tapsav tape, it's version 2A or earlier...>
	bpl	a,<% Does that sound reasonable? >
	call	dpromp		;prompt the user
	movei	a,[flddb. .cmkey,,yestab,<Answer,>]
	call	cfield		;get answer and confirm
	hrrz	a,(b)		;get code
	jumpn	a,reb.a1	;yes, so continue
	type	<% OK, we'll give up on this one...>
Reb.e1:	move	a,tjfn		;get tape jfn
	closf			;close it
	 crunch			;can't
	call	taprew		;rewind the tape
	ret			;return from rebuild routine

;Here to check out the version - now in T2
Reb.e2:	ldb	a,[point 9,t2,11]	;get major version number
	call	chkver		;check the version
	 jrst	reb.e1		;incompatable
	jrst	reb.a1		;passed all tests - continue with rebuild
Subttl	Save command

;Save specified files onto tape

%Save:	noise	<specified file(s) into save set:>
	movei	a,tspec		;save set spec
	call	cfield		;get save set name
	setzm	atmbuf+3	;fifteen chars max
	bpm	t1,atmbuf	;source
	bpm	t2,savset	;destination
	call	movstr		;copy it
	skpon	f.gdir		;got a directory?
	 jrst	needdr		;no, can't save
	skpoff	f.fakt		;fake tape mounted?
	 jrst	needtp		;yes, can't write on it

;Loop to pick up all files
Save.a:	bpl	a,<  File-->	;prompt
	call	dpromp		;type it out
	movx	a,gj%ifg!gj%old	;flags
	movem	a,cjfnbk	;set up flags
	movei	a,lspec		;.cmfil specification
	call	rfield		;read the field
	hrrz	a,c		;clear left half
	cain	a,lspec		;found a crlf alone?
	 jrst	save.b		;yes, end of list
	confrm			;confirm the file
	push	j,b		;save the jfn
	jrst	save.a		;loop for more

;Here we start the saving process
Save.b:	skipe	(j)		;any files?
	 jrst	sav.b1		;yes
	type	<
[ No files specified for save command ]>
	ret			;done

Sav.b1:	type	<
[ Starting transfer to tape... ]>
	call	setcle		;set up for control-E interrupt
	skpon	f.aeot		;are we at eot already?
	call	tapeot		;space to logical end of tape
	flgon	f.aeot		;flag that fact
	call	tapwat		;wait for tape to stop
;Loop for all files popped off stack

Save.d:	pop	j,fjfn		;get file jfn
	skipn	a,fjfn		;check it out
	 ret			;done if zero

;And loop for all wild permutations of this jfn
Save.e:	flgoff	f.oldf		;clear old file flag
	hrrz	p1,fjfn		;get jfn minus flags
	call	getmat		;find all matches in directory
	skipn	p2,t1		;no matches if zero
	 jrst	sav.e2		;nothing to delete

;Delete all old files with same name in directory
Sav.e1:	pop	j,t1		;get a file number
	call	chksup		;check for superseded file
	call	delfil		;delete if not more recent
	sojg	p2,sav.e1	;loop for all copies
	skpoff	f.oldf		;tape copy more recent than disk copy?
	 jrst	sav.g1		;yes, don't save this one
;Check for files of the name *.TAPEDIR, and skip them.

Sav.e2:	hrroi	a,strng		;point to a spare area
	hrrz	b,fjfn		;get file jfn
	movx	c,js%typ	;file type bit
	jfns%			;retrieve the extension
	bpm	a,strng		;point to it
	bpl	b,<TAPEDIR>	;this is what we're looking for
	stcmp%			;compare strings
	jumpn	a,sav.e3	;no match, proceed
	skpon	f.list		;listing file transfers?
	 jrst	sav.g1		;nope, skip
	hrrz	a,fjfn		;get the jfn
	print	a,asc<%T%J (to) TS:%T[Skipped]%C>	;print the line
	jrst	sav.g1		;skip this file

;Now open the file
Sav.e3:	hrrz	a,fjfn		;get jfn
	movx	b,of%rd		;read access
	openf			;open the file
	 erjmp	sav.i1		;bad file, report it
	skpon	f.list		;are we listing?
	 jrst	sav.e4		;nope
	hrrz	a,fjfn		;get file jfn
	print	a,asc<%T%J (to) TS:>	;type the info

Sav.e4:	move	p1,topdir	;point to top of directory area
	movei	t1,s.fsiz-1	;get size of file entry
	add	t1,p1		;get last location we will use
	movem	f,(t1)		;test that location
	 erjmp	quoerr		;for room on disk during mapping
	hlrz	t1,s.nfil	;get number of files
	aoj	t1,		;bump the number
	movem	t1,d.flag(p1)	;store it
	hrroi	a,	;point to name
	hrrz	b,fjfn		;file jfn
	movx	c,1b8!1b11!1b17!js%act!js%paf	;flags
	jfns			;place name into directory area
	bpm	t1,savset	;get savset name
	bpm	t2,d.ssnm(p1)	;where to put it
	call	movstr		;move it

;;continued on next page
;;continued from previous page

	hrrz	a,fjfn		;get jfn again
	move	b,[2,,.fbbyv]	;two words starting with byte size word
	movei	c,t1		;where to put info
	gtfdb%			;store info
	movem	t1,d.size(p1)	;store size word
	movem	t2,d.nbyt(p1)	;store number of bytes
	hrrz	a,fjfn		;jfn again
	movei	b,t1		;address of arg block
	movei	c,2		;two words
	rftad			;read time of last write
	dmovem	t1,d.wdat(p1)	;store file dates
	move	t1,[ascii .*TSV*.]
	move	t2,prgver	;get version number
	dmovem	t1,d.fchk(p1)	;save tapsav info for restore command
	setzm	d.last(p1)	;clear first non-used location
	hrli	t1,d.last(p1)	;first address to clear
	hrri	t1,d.last+1(p1)	;next
	blt	t1,s.fsiz-1(p1)	;clear to last location
	movx	a,gj%sht	;short form
	bpl	b,<TS:>		;open tape
	gtjfn			;get a jfn
	 crunch			;can't
	movem	a,tjfn		;store tape jfn
	movx	b,of%wr		;write access
	openf			;open channel to tape
	 crunch			;can't
	move	a,tjfn		;get tape jfn again
	bpm36	b,d.flag(p1)	;point to address
	movni	c,s.fsiz	;file header size
	sout			;send string to tape
	 erjmp	save.j		;magtape error

;Loop for all bytes in record
Save.f:	hrrz	a,fjfn		;get file jfn
	magblk	b		;set up magtape block pointer
	movni	c,recsiz	;size of logical record
	sin			;read it
	 erjmp	save.g		;check out the error
	hrrz	a,tjfn		;get tape jfn
	magblk	b		;set up magtape block pointer
	movni	c,recsiz	;record size
	sout			;send record
	 erjmp	save.j		;can't
	jrst	save.f		;loop for all bytes
;Here on an input error

Save.g:	hrrz	a,fjfn		;get file jfn
	gtsts			;get status
	txnn	b,gs%eof	;end of file?
	 jrst	save.i		;file error
	addi	c,recsiz	;find out how many bytes were sent
	jumpe	c,sav.g0	;none
	hrrz	a,tjfn		;tape jfn
	magblk	b		;set up magtape block pointer
	movns	c		;make count negative
	sout			;send it
	 erjmp	save.j		;can't

;Here if record was blank
Sav.g0:	hrrz	a,fjfn		;get jfn
	txo	a,co%nrj	;save jfn
	closf			;close the file
	move	a,tjfn		;get tape jfn
	closf			;close it
	 crunch			;can't
	movsi	t1,1		;time to update the directory now
	addm	t1,s.nfil	;update number of files
	movei	t1,s.fsiz	;get file header size
	addm	t1,topdir	;and update top of directory
	flgoff	f.tofl		;turn off off-line flag
	skpon	f.list		;listing?
	 jrst	sav.g1		;nope
	type	<	[OK]>	;note successful completion

;Now get the next wild permutation of the file
Sav.g1:	move	a,fjfn		;get jfn
	gnjfn			;get next
	 erjmp	save.d		;no more, pop next jfn from stack
	jrst	save.e		;more to come
;Here when we couldn't open the disk file

Save.i:	skpon	f.list		;listing mode?
	 jrst	sav.i1		;nope
	type	<	[Failed]>	;notify
Sav.i1:	hrrz	a,fjfn		;get jfn
	print	a,asc<%P File access error: %E%C%P Transfer aborted on file %J%C>
	move	a,fjfn		;get file jfn
	txo	a,co%nrj	;don't release the jfn
	closf%			;close the file
	 jfcl			;ignore errors
	jrst	sav.g1		;try the next
;Here when we had a tape error

Save.j:	skpon	f.list		;listing mode?
	 jrst	sav.j1		;nope
	type	<	[Failed]>	;notify of problem
Sav.j1:	hrrz	a,fjfn		;get file jfn
	print	a,asc<%P Tape write error on file %J%C>
	skpoff	f.tofl		;tape off-line flag set?
	 crunch			;yes, give up
	move	a,tjfn		;get tape jfn
	gdsts			;get status
	txnn	b,mt%dve	;tape off-line?
	 crunch			;nope, real error
	flgon	f.tofl		;say tape is off-line
	move	a,tjfn		;get tape jfn
	movei	b,.mocle	;clear errors function
	move	a,tjfn		;get tape jfn again
	closf			;close the tape
	 crunch			;can't close it
	type	<% Tape may be off-line, retrying file..>
	hrrz	a,fjfn		;get file jfn
	txo	a,co%nrj	;don't release the jfn
	closf			;close that too
	 crunch			;can't close file
	call	tapbak		;back up one file
	jrst	save.e		;and try again
Subttl	Supersede command

;Set flags specifying when to supersede files on tape.

%Supr:	noise	<files>
	movei	a,[flddb. .cmkey,,suptab,<When to supersede,>]
	call	cfield		;get field
	hrlz	a,(b)		;get switch selected
	txnn	a,f.ncss	;supersede across?
	 flgoff	f.sall!f.snev!f.sold	;no, so turn off others
	ior	f,a		;turn on one selected
	ret			;and return
Subttl	Tape command

;Specify a tape device

%Tape:	noise	<device name>
	movei	a,dspec		;device
	call	cfield		;get and confirm
	bpm	a,strng		;point to string
	devst			;convert name to string
	 ssterr	(Illegal device name,RETN)
	movei	b,":"		;get a device terminator
	idpb	b,a		;tack it onto the string
	setz	b,		;followed by a null
	idpb	b,a
	movei	a,.clnj1	;delete the old definition of ts:
	bpl	b,<TS>
	setz	c,		;clear ac c
	crlnm			;delete it
	 jfcl			;probably wasn't there
	movei	a,.clnjb	;define a logical name
	bpl	b,<TS>		;the name
	bpm	c,strng		;its definition
	crlnm			;create it
	 crunch			;can't
	jrst	settap		;proceed with setup
Subttl	Title command

;Specify a title for the tape

%Title:	noise	<for the tape>	;if user wants help
	confrm			;await cr
	skpon	f.gdir		;got a directory?
	 jrst	needdr		;nope, need one
Title:	typncr	<Please type tape label - up to 80 characters
	bpm	a,s.ulab	;destination
	movx	b,rd%bel!rd%crf+^D79	;flags and length
	bpl	c,<*>		;prompting text
	rdtty			;read in from terminal
	 erjmp	[type	<% Illegal response, please try again and end with CR>
		 jrst	title	]
	setz	t1,		;clear a word
	dpb	t1,a		;end string with a null
	ret			;return to caller
Subttl	Subroutines -- Settap

;Check to see if a tape named TS: is mounted - if so, use it

Settap:	bpl	a,<tsdir:>	;tape directory area
	stdev			;is it defined?
	 call	defdir		;nope, complain
	bpl	a,<ts:>		;now the tape name
	stdev			;get a device designator
	 ret			;name not assigned
	ldb	t1,[point 9,b,17]	;get device type
	caie	t1,.dvmta		;magtape?
	 prgerr	(<Device TS: is not a tape>,RETN)
	move	a,b		;move to correct place
	dvchr			;get device characteristics
	txnn	b,dv%av		;device available?
	 prgerr	(<Device TS: is not available to this job>,RETN)
	movx	a,gj%sht	;gtjfn short form
	bpl	b,<ts:>		;source in b
	gtjfn			;get a handle
	 crunch			;why not?
	hrrm	a,tjfn		;save tape jfn
	flgon	f.gtap		;say got the tape
	movei	b,.morli	;tape info
	movei	c,t1		;address of info block
	movei	t1,4		;number of args
	setz	t2,
	setzm	volume		;clear volume word
	hrroi	t3,volume	;point to volume
	hrroi	t4,owner	;point to owner
	mtopr			;find out
	caie	t2,.ltt20	;tops-20 labels?
	 prgerr	(<TS: is not a TOPS-20 labeled tape>,EXIT)
	skipn	volume		;non-zero volume name?
	 prgerr	(<Unable to obtain tape volume name>,EXIT)
	move	a,tjfn		;jfn again
	movx	b,of%rd		;read mode
	openf%			;open it
	 crunch			;can't
	movx	b,.mordn	;tape density
	mtopr%			;get info
	move	t1,[exp 0,^D200,^D556,^D800,^D1600,^D6250](C)	;density
	movem	t1,densit	;store density
	move	a,tjfn		;jfn again
	txo	a,cz%abt	;abort close
	closf%			;close
	 crunch			;can't

;fall through to sett.a
;Enter here to fake a tape

Sett.a:	skpoff	f.gdir		;do we have a directory already?
	 call	dircls		;yes, close it out
	bpl	t1,<tsdir:>	;directory to search
	bpm	t2,tsdir	;place to put string
	call	movstr		;move it
	bpm	t1,volume	;volume name
	call	skpspc		;append this string, skipping over spaces
	bpl	t1,<.TAPEDIR>	;suffix
	call	movstr		;add it on
	movx	a,gj%sht!gj%old	;look for old file
	bpm	b,tsdir		;where to look for spec
	gtjfn			;get a jfn
	 jrst	[type	<% No directory for tape TS:>
		 ret]		;must create the tape at some point
;Here we continue by opening the directory and grabbing the contents

	movem	a,djfn		;store directory jfn
	call	diropn		;open the directory
	hlrz	t1,s.nfil	;get number of files
	imuli	t1,s.fsiz	;times size of file entry
	addi	t1,dirloc+s.hsiz	;plus start of file area
	movem	t1,topdir	;equals first free location
	ldb	a,[point 9,s.tver,11]	;get version number on tape
	call	chkver		;check out version compatability
	 jrst	dircls		;quit, they don't match
	typncr	<
[ Tape >
	bpm	a,s.tlab	;get tape volume
	psout			;type to tty
	typncr	< mounted -- >
	bpm	a,s.ulab	;get user label
	psout			;type that too
	type	< ]
>				;end of abbreviated herald

;Here if the version is ok
	gtad			;get date and time
	movem	a,s.adat	;update access date
	aos	s.nacc		;and number of accesses
	skipe	t1,densit	;get density
	 movem	t1,s.dens	;and store it if non-zero
	ret			;return
Subttl	Subroutines -- Tape herald typout

Herald:	move	a,ojfn		;set up output jfn
	fmsg	<
[ Tape >				;beginning
	move	a,ojfn		;set up output jfn
	bpm	b,s.tlab	;tape label
	setz	c,		;type until null
	move	a,ojfn		;set up output jfn
	fmsg	< mounted>
	call	typden		;type density if available
	move	a,ojfn		;set up output jfn
	fmsg	< -- >
	bpm	b,s.ulab	;user label
	setz	c,		;type until null
	sout			;type it
	move	a,ojfn		;set up output jfn
	fmsg	< ]
[ Created >			;next line
	move	a,ojfn		;set up output jfn
	move	b,s.cdat	;creation date
	movx	c,ot%ntm	;no time necessary
	odtim			;type it out
	move	a,ojfn		;set up output jfn
	fmsg	<, last accessed >
	move	a,ojfn		;set up output jfn
	move	b,s.adat	;access date
	movx	c,ot%ntm	;no time, again
	odtim			;type date
	move	a,ojfn		;set up output jfn
	fmsg	<, accessed >
	move	b,s.nacc	;get accesses
	move	a,ojfn		;set up output jfn
	movei	c,12		;decimal
	 crunch			;no good
	move	a,ojfn		;set up output jfn
	fmsg	< times ]
[ >				;end of line

;;continued on next page
;;continued from previous page

	move	a,ojfn		;set up output jfn
	hlrz	b,s.nfil	;get number of files
	movei	c,12		;in decimal
	nout			;type it
	move	a,ojfn		;set up output jfn
	fmsg	< files on tape (>
	hrrz	b,s.nfil	;now get deleted files
	move	a,ojfn		;set up output jfn
	movei	c,12
	move	a,ojfn		;set up output jfn
	fmsg	< deleted) ]
>				;end of line

;Special case subroutine to type herald on tty
Therld:	movei	a,.priou	;primary output
	movem	a,ojfn		;store as output jfn
	movx	b,7b5!of%wr	;write access
	openf			;open the file
	 crunch			;can't
	call	herald		;write out the herald
	move	a,ojfn		;get jfn
	closf			;close file
	 crunch			;can't
Subttl	Subroutines -- TYPDEN - type density of tape

Typden:	skipn	t1,s.dens	;get tape density
	 ret			;not there
	fmsg	< at >		;seperator
	move	a,ojfn		;output
	move	b,t1		;density
	movei	c,12		;decimal
	nout%			;type it
	fmsg	< bpi>		;end it
	ret			;done
Subttl	Subroutines -- GETLST - get a list of file numbers

Getlst:	setz	p1,		;assume no file jfn to be found
	setzm	savset		;clear savset name
	bpl	a,<  File-->	;prompt
	call	dpromp		;type it out
	movx	a,gj%ifg!gj%ofg!gj%flg	;flags
	movem	a,cjfnbk	;set up flags
	movei	a,nspec		;.cmfil specification
	call	rfield		;read the field
	hrrz	a,c		;clear left half
	cain	a,lspec		;found a crlf alone?
	 ret			;yes, end of list
	caie	a,nspec		;got a number?
	 jrst	getl.a		;nope, a file jfn
	setz	t1,		;file count
	jumple	b,getl.b	;number too low
	hlrz	t2,s.nfil	;get highest file number
	camle	b,t2		;too high?
	 jrst	getl.b		;yes
	movem	b,low		;store low number
	sos	low		;decrement it
	movem	b,high		;low is also high
	movei	a,pspec		;colon or cr
	call	rfield		;read field
	hrrz	a,c		;get table used
	cain	a,cspec		;cr found?
	 jrst	getl.z		;yes, process one file
	movei	a,mspec		;get end of range number
	call	cfield		;get it and confirm it
	jumple	b,getl.b	;invalid if not positive
	camle	b,t2		;too high?
	 move	b,t2		;yes, substitute highest legal number
	movem	b,high		;store high end

;Process the list of numbers
Getl.z:	aos	t2,low		;get the number
	camle	t2,high		;reached the end?
	 jrst	getl.b		;yes, done
	push	j,t2		;stack the number
	aoja	t1,getl.z	;count it and loop
;Here if we got a file

Getl.a:	move	p1,b		;save the jfn
	movei	a,sspec		;switch specification
	call	rfield		;read the field
	hrrz	a,c		;which block was used?
	cain	a,cspec		;was it a <CR>?
	 jrst	gtl.a1		;yes, no saveset specified
	movei	a,tspec		;save set spec
	call	cfield		;and confirm it
	setzm	atmbuf+3	;fifteen characters max
	bpm	t1,atmbuf	;source
	bpm	t2,savset	;destination
	call	movstr		;move the string
Gtl.a1:	call	getmat		;get all matches in directory

;Converge from different paths here

Getl.b:	typncr	<	[ >
	movei	a,.priou	;primary output
	move	b,t1		;file count
	movei	c,12		;decimal
	nout			;type number
	 crunch			;can't
	typncr	< found ]
>				;end count
	skipe	a,p1		;get jfn if one was present
	rljfn			;release it
	 jfcl			;can't
	jrst	getlst		;continue
Subttl	Subroutines -- GETMAT - Find directory matches for JFN in P1

Getmat:	setz	t1,		;clear match counter
	move	t2,topdir	;get top of directory

Getm.a:	subi	t2,s.fsiz	;back up one file
	caige	t2,s.ffil	;below first file?
	 ret			;yes, return
	move	t3,d.flag(t2)	;get flag word
	skpon	f.unde		;are we undeleting?
	txnn	t3,g.dfil	;or is this a normal file?
	 caia			;yes, so proceed
	jrst	getm.a		;don't use deleted files
	hrroi	b,	;point to name
	movx	a,gj%ofg!gj%sht	;flags
	gtjfn			;get a jfn
	 crunch			;can't
	push	p,a		;save that jfn
	skipn	savset		;saveset name given?
	 jrst	getm.c		;no, so don't check
	skpoff	f.ncss		;never check savesets flag set?
	 jrst	getm.c		;yes, don't check
	bpm	a,savset	;point to saveset name
	bpm	b,d.ssnm(t2)	;name in file header
	stcmp			;compare them
	jumpe	a,getm.c	;passed test if zero
	pop	p,a		;get jfn
	rljfn			;release it
	jrst	getm.a		;loop for next
;Here if we passed the save set test

Getm.c:	hrrz	c,(p)		;remove wild card flags
	move	b,p1		;get jfn we're testing
	txo	b,gj%ver	;say generation is wild
	movei	a,.wljfn	;function code
	wild%			;compare
	exch	a,(p)		;exchange flags and old jfn
	rljfn			;get rid of jfn
	 jfcl			;can't, too bad
	pop	p,a		;restore flags
	txz	a,wl%dev!wl%dir	;we don't care about directory
	jumpn	a,getm.a	;no match
	hrrzs	t3		;save only file number part of flag word
	push	j,t3		;push that on stack
	aoja	t1,getm.a	;bump counter and loop until done

;Getnxt - returns the next file in the list obtained by Getlst
Getnxt:	pop	j,t1		;pop off a file number
	jumpe	t1,r##		;no more if zero
	retskp			;success return
Subttl	Subroutines -- Tape operations

;Operations available:
;	TAPEOT - position tape to eot
;	TAPREW - rewind the tape
;	TAPWAT - wait for current operation to end

Tapeot:	movei	t1,.mofwf	;end of tape function
	jrst	tap..		;skip
Taprew:	movei	t1,.morvl	;rewind volume
	flgoff	f.aeot		;not at end of tape
	jrst	tap..		;skip
Tapbak:	movei	t1,.mobkf	;backspace file
	flgoff	f.aeot		;not at end of tape
	jrst	tap..		;skip
Tapwat:	movei	t1,.monop	;wait for completion
Tap..:	movx	a,gj%sht	;short form
	bpl	b,<TS:>		;tape device
	gtjfn			;get a jfn
	 crunch			;can't
	movem	a,tjfn		;save jfn
	movx	b,of%rd		;read access
	openf			;open the tape
	 crunch			;can't

;;continued on next page
;;continued from previous page

;Check out which function, and handle eot specially

	movei	t2,1		;assume execute function once
	caie	t1,.mofwf	;forward file?
	 jrst	tapgo		;nope, something else
	move	a,tjfn		;tape jfn
	movei	b,.morvl	;rewind first
	skipn	t2,s.nfil	;any files on tape?
	 jrst	tapstp		;nope, don't go forward
	hlrzs	t2		;count into right hand side

Tapgo:	move	a,tjfn		;get jfn back
	move	b,t1		;and function code
	mtopr			;do the operation
	sojg	t2,tapgo	;repeat as many times as requested

;Here when done
Tapstp:	move	a,tjfn		;get jfn
	closf			;close the file
	 crunch			;can't
	ret			;return to caller
Subttl	Subroutines -- Interrupt system control

;Routine to initialize the pi system

Inipi:	movei	a,.fhslf	;init levtab and chntab
	move	b,[levtab,,chntab]
	movei	a,.fhslf	;turn on desired channels
	move	b,onchns	;all panic channels + control characters
	eir			;activate interrupt system
	move	a,[.ticcc,,0]	;enable for control-c
	 erjmp	.+1		;ignore errors here
	ret			;done

;Routine to disable the pi system

Dispi:	movei	a,.fhslf	;disable the pi system
	movei	a,.fhslf	;disable all channels
	movei	b,0
	move	a,[.ticcc,,0]	;disable control-c
	 erjmp	.+1		;ignore errors here
	ret			;done

;Routines to turn control-E interrupts on and off

Setcle:	move	a,[.ticce,,1]	;enable for control-e
	 erjmp	.+1		;ignore errors here
	move	a,[.ticca,,2]	;enable for control-a
	 erjmp	.+1		;ignore errors here
	ret			;return

Clrcle:	move	a,[.ticce,,1]	;disable control-e
	 erjmp	.+1		;ignore errors here
	move	a,[.ticca,,2]	;disable control-a
	 erjmp	.+1		;ignore errors here
	ret			;done
;Routine to handle control-C interrupt

Cntrlc:	skpoff	f.gdir		;have a directory?
	 jrst	ctrl.a		;yes, special handling
	call	clrdef		;restore tape defaults
	haltf%			;quit
	debrk%			;but continue if continued
	 erjmp	tapsav		;if failed

Ctrl.a:	movem	a,acs		;save the ac
	move	a,[xwd 2,acs+1]	;get a blt pointer
	blt	a,acs+16	;save acs 1-17
	call	dircls		;close out the directory
	call	clrdef		;restore tape defaults
	haltf%			;and quit
	movx	a,gj%sht!gj%old	;flags
	bpm	b,tsdir		;name of directory
	gtjfn%			;get a jfn
	 crunch			;can't
	movem	a,djfn		;save it
	call	diropn		;if continued
	call	setdef		;set special tape defaults
	move	a,[xwd acs+1,2]	;get pointer
	blt	a,p		;and restore the acs
	move	a,acs		;restore a
	debrk%			;and continue

;Routine to handle all program crashes

Cra..:	hrrz	a,(p)		;get our pc
	soj	a,		;offset by the call
	print	a,asc<%QError at PC %O -- %E%C>
	jrst	pan.a		;join panic routine

;Routine to handle all panic interrupts

Panic:	hrrz	a,lev1pc	;get pc
	soj	a,		;back it up
	move	p,stak..	;set up stack in case of PDLOV interrupt
	print	a,asc<%QPanic channel interrupt at PC %O -- %E%C>
Pan.a:	skpoff	f.gdir		;do we have a disk directory?
	 call	dircls		;yes, close it
	call	clrdef		;restore tape defaults
	haltf%			;quit
	jrst	tapsav		;if continued
;Routine to handle ^E interrupt

Intrpt:	dmovem	a,intacs	;save some acs
	movem	p,intptr	;save stack pointer

Intr.a:	prompt	<Interrupt command-->
	movei	a,[flddb. .cmkey,,inttab,<Interrupt command,>]
	call	rfield		;get a command
	hrrz	a,(b)		;isolate address
	call	(a)		;call routine
	jrst	intr.a		;next command

;Here to process a resume command

%Resum:	noise	<suspended operation>
	confrm			;get confirmation
	dmove	a,intacs	;restore the acs
	move	p,intptr	;get old stack pointer back
	debrk%			;dismiss the interrupt

;Here to process an quit command

%Abort:	noise	<current operation>
	confrm			;confirm the option
	type	<% This will abort and restart the program>
	prompt	<% Are you sure? >
	movei	a,[flddb. .cmkey,,yestab,<Answer,>]
	call	cfield		;get response
	hrrz	a,(b)		;isolate key
	jumpe	a,r		;no, so just return
	skpoff	f.gdir		;have a directory?
	 call	dircls		;close it out
	call	clrdef		;clear tape defaults
	jrst	tapsav		;restart the program

;Here to process a help command

%Hlpin:	noise	<with interrupt commands>
	confrm			;confirm the command
	hrroi	a,intmsg	;get the message
	psout%			;type it
	ret			;and return

Intmsg:	asciz	\
** ^E Interrupt commands:

	Abort		Abort current activity and restart the program.
	Help		Type this message
	List		Set filename listing mode on saves and restores.
	Nolist		Clear filename listing mode.
	Resume		Resume the operation suspended by the ^E command.
;Routine to handle ^A interrupt

Lstfil:	dmovem	a,intacs	;save some acs
	hrrz	a,fjfn		;get file jfn
	gtsts%			;get the status
	txnn	b,gs%nam	;name associated?
	 jrst	lstf.a		;no, illegal jfn
	print	a,asc<%C[Current file is %J]%C>
	jrst	lstf.b		;resume

Lstf.a:	type	<
[No file jfn currently assigned]>

Lstf.b:	dmove	a,intacs	;restore acs
	debrk%			;and dismiss interupt
Subttl	Subroutines -- Directory handling

;Open and close directory files, complete with mapping

;Routine to open and map a directory file

Diropn:	move	a,djfn		;get jfn
	movx	b,of%rd!of%wr	;read and write
	openf			;open the file
	 crunch			;can't
	hrlz	a,djfn		;jfn,,page 0
	move	b,[.fhslf,,dirpag]	;directory page in this fork
	movx	c,pm%cnt!pm%rwx!pm%pld!fld(400,pm%rpt)
	pmap%			;map in the file
	flgon	f.gdir		;we have a directory
	ret			;return

;Routine to close and unmap the directory file

Dircls:	hlrz	t1,s.nfil	;get number of files
	imuli	t1,s.fsiz	;times size of file entry
	addi	t1,s.hsiz	;plus size of header
	seto	a,		;unmap pages
	move	b,[.fhslf,,dirpag]	;where to unmap from
	movx	c,pm%cnt!fld(400,pm%rpt)
	pmap%			;unmap the directory
	 ssterr	(<Unable to unmap directory file>,EXIT)
	move	a,djfn		;get jfn
	txo	a,co%nrj	;keep the jfn
	closf%			;close the directory file
	 ssterr	(<Unable to close directory file>,EXIT)
	flgoff	f.gdir		;no directory anymore
	move	c,t1		;get number of bytes
	seto	b,		;set all bits of word c
	move	a,djfn		;get directory jfn
	hrli	a,.fbsiz	;and say which word to change
	chfdb%			;set it
	movx	c,fld(^d36,fb%bsz)	;thirty six bits
	movx	b,fb%bsz	;field to modify
	move	a,djfn		;jfn again
	hrli	a,.fbbyv	;word to change
	chfdb%			;change it
	move	a,djfn		;get jfn again
	rljfn%			;and release it
	 jfcl			;ignore errors
	ret			;done
Subttl	Subroutines -- Setting and clearing tape defaults

Setdef:	setzm	jobdef		;clear current default
	seto	a,		;this job
	hrroi	b,jobdef	;set -1,,jobdef
	movei	c,.jirs		;record size
	getji%			;get record size
	 ret			;return on failure
	seto	a,		;this job
	movei	b,.sjrs		;set record size
	movei	c,magsiz	;to 14 pages long
	setjb%			;set the job
	ret			;and return

Clrdef:	skipn	c,jobdef	;get record size
	 ret			;none set
	seto	a,		;this job
	movei	b,.sjrs		;record size
	setjb%			;reset old value
	ret			;and return
Subttl	Subroutines -- Miscellaneous

;Skpspc subroutine - transfer a string skipping over spaces
Skpspc:	movei	t4,40		;load a space
	jrst	mov.a		;and skip

;Movstr subroutine - transfer a string from one place to another
Movstr:	seto	t4,		;copy all characters
Mov.a:	ildb	t3,t1		;source
	came	t3,t4		;match character to skip?
	 idpb	t3,t2		;no, send to destination
	jumpn	t3,mov.a	;move until null found
	move	a,t2		;get destination pointer
	bkjfn			;back it up one byte
	 crunch			;can't do it
	movem	a,t2		;restore to place
	ret			;and return

;Routine to tell the user we need a TSDIR device
Defdir:	seto	a,		;this job
	hrroi	b,t1		;one word into t1
	movei	c,.jilno	;logged-in directory number
	getji%			;get job info
	 erjmp	dfd.a		;if we can't
	move	b,t1		;copy number
	hrroi	a,strng		;point to string
	dirst%			;translate number
	 erjmp	dfd.a		;can't
	movei	a,.clnjb	;create a logical name
	bpl	b,<tsdir>	;point to name
	hrroi	c,strng		;point to definition
	crlnm%			;create it
	 erjmp	dfd.a		;can't
	print	t1,asc<%C%P TSDIR: undefined, TAPSAV defining it to be %U%C>
	ret			;done

;Here if we couldn't define the name
Dfd.a:	print	asc<%C%P Unable to define TSDIR: -- %E%C>
	jrst	exit.a		;quit

;Routine to tell user we need a tape spec first
Needtp:	type	<% No tape device specified yet>
	ret			;return to caller

;Routine to tell user we need an initialized tape
Needdr:	type	<% No tape directory - is the tape created yet?>
	ret			;return to caller
;Routine to check version compatability
;Call with AC A containing version to check

Chkver:	jumpn	a,chkv.a	;treat version 0 specially
	print	asc<%QInvalid tape directory, please REBUILD%C>
	ret			;quit

Chkv.a:	cain	a,vmajor	;same as our major version?
	 retskp			;yes, success
	print	a,asc<%QVersion incompatibility -- please run SYS:TAPSAV-%N%C>
	ret			;return to caller

;Routine to report errors during directory updates

Quoerr:	print	asc<%QError during directory update -- %E%C>
	skpoff	f.gdir		;do we have a directory?
	 call	dircls		;close out the directory
	jrst	tapsav		;start over
;Routine to check relative file dates of disk and tape

Chksup:	skpoff	f.sall		;supersede always?
	 ret			;yes
	skpoff	f.snev		;supersede never?
	 jrst	[ flgon	f.oldf	;file on tape is always considered newest
		  retskp ]	;return
	hrrz	a,fjfn		;get file jfn
	movei	b,t3		;arg block
	movei	c,1		;number of args
	rftad			;read creation date
	movei	t2,s.fsiz	;file header block size
	imul	t2,t1		;times file number
	addi	t2,s.ffil-s.fsiz	;point to block
	camle	t3,d.wdat(t2)	;which copy is older?
	 ret			;the tape copy is
	flgon	f.oldf		;the disk copy is
	retskp			;so take the skip return
;Memory management and large storage handling

Setmem:	hlrz	a,.jbsa##	;get starting address
	addi	a,1000		;round to next page
	trz	a,777		;and make it start on the boundry
	movem	a,recpag	;page for data records from tape
	addi	a,recsiz	;next starting location
	movem	a,stak..	;store address for pdl
	addi	a,stksiz	;next starting location
	movem	a,jstk..	;where jfn stack starts
	addi	a,jstksz	;size of stack
	movem	a,.jbff##	;new first free location
	jrst	memset		;return

;End of program
	end	tapsav