savres.mac
.TITLE	SAVRES - Disc - Magtape Save/Restore Program - EXPERIMENTAL VERSION
.Enable	lc,gbl
.Nlist	bex

.Ident	/7.3d/		; 31-Aug-88
.Psect	SAVRES

.iif ndf xm xm	=	0	;non zero if XM virtual job desired
.iif ndf debug debug =	0	;non zero if debug messages wanted

							.if ne xm
savmsg::.asciz	/SAVREX V7.3d (31-Aug-88)/
							.iff
savmsg::.asciz	/SAVRES V7.3d (31-Aug-88)/
							.endc
							.even
.Sbttl	Documentation
	.if ne 0

Author:	Peter Miedecke
	Webster Electronics
	17 Malvern St
	Bayswater 3153
	Australia
	(03)729 8444

	February 1982

This program is written from the article "Developing Software to run
1/2-in. streaming tape drives", found in Electronic Design, 21-Jan-82.

Edit Log:

Vers	Date	Who/Description
-------------------------------

7.3d	Aug-88	Fix bug in MS streaming code (at bloody last!)

7.3c	Aug-88	Errors in error messages (TYPEX incorrectly formatted)

7.3b	Aug-88	Tidy error messages to put <cr><lf> first.
		Add .FETCH before rewind/unload
		Couple of bug fixes: PIO accessed as word not byte!

7.3a	?	Chris Kleinschmidt: put CLOSE as PURGE does nothing
		on MT units.

7.3	Feb-87	Put in /F - fast streaming - switch; if used, try using
		SPFUN -9 on the handler.
		Put in /V - verify after save or restore without
		asking, if only the one volume used.

7.2	Feb-87	Put in facility to test whether tape is properly loaded
	CGW	to cope with odd MS problem.  Since this uses a rewind
		and asks questions if this prangs, it is not able to be
		used with /N or /E.  Put version message out if he types
		a blank line at "From?" rather than all the bloody time.
		[Another bug found in SCTSX]

7.1	Feb-87	Allow files rather than devices to be saved & restored.
	CGW	Include switches for REWIND control:
			/N - no rewinds at start or end of tape
			/S - rewind at start only
			/E - rewind at end only
		[Caused bug to be found in SC handler]
		Add physical I/O (requires DUCM handler)

7.0	Nov-86	SAVTAP timing bug fix to remove hang;
     to	Feb-87	SAVTAP/SAVINI Speed-up of verification code (thanks to Chris
	CGW		Kleinschmidt).
		Put in RT-11 V5.4 stuff for DU table difference.
		Considerable code layout tidying (sorry, SRCCOM won't help!)
		Tidy ascii messages SAVRES/SAVREX.
		Make disc double buffered if room for 5 buffers so
			verify streams under TSX-plus.
		Rewrite tape double-buffering code to eliminate CRITICAL bits.
		Split SAVTAP into three separate overlays.  Overlay structure
			now:
				SAVRES	root
				SAVINI	initialization
				SAVSAV	save onto tape (SAVSAV+SAVTAP)
				SAVRST	restore from tape (SAVRST+SAVTAP)
				SAVVER	verify tape/disc (SAVVER+SAVTAP)
				SAVFLP	floppy save/restore

	* Apologies to my predecessors.  Had my understanding been greater *
	* at the time I started this project, I would not have felt the    *
	* need to wreak such havoc upon their code!		CGW	   *

6.4	Feb-86	Software selection of 100ips streaming on MS.
	CEC	Version number included in dummy filename on overwrite.
		Force rewriting of some blocks on end of tape to prevent
			magtape underrun.
		Leave channels unclosed on crash to prevent SC overwriting
			tape header.

6.3	Feb-86	Altered FILCHK algorithm to allow for bootable tapes.
	CEC

6.2	Nov-85	Corrected critical region violations in ring buffer variables,
	CEC		cmpdes manipulation on new input volume and tape
			overrun recovery.

6.1	Aug-85	Corrected typo in SAVTAP disc write completion routine.  Least
	CEC		significant word of disc block counter was being
			incremented instead of the most significant word.

6.0	Feb-85	Major release.
	CEC

5.7	Feb-85	System tape re-mount and automatic verify prompt after save.
	CEC

5.6	Feb-85	CEC/ altered SAVTAP algorithm
	
5.5	Feb-85	CEC/ improve verification bad block handling

5.4	Feb-85	CEC/ tape verification

5.3	Feb-85	CEC/ tape initial read/write check on saves

5.2	Feb-85	CEC/ enhance XM support

5.1	Feb-85	CEC/ make floppy overlay comptible with new stuff

5.0	Jan-85	CEC/ allow multiple tape volumes to be used

4.3	Jan-85	CEC/ allow DU winchesters to span partitions

4.2b	Sep-84	PBM/ allow the DU winchesters to be used by SAVRES

4.2a	Jun-84	TAE/ Slow down Tape Timeout Interval for 11/73

4.2	May-84	TAE/ correct bugs in "error recovery" in tape save/restore,
			buffer allocation/usage flags, pendw flag,
			end of volume processing, stream code, add error
			recovery code to all read/writes. Fix double-error
			problem (.wait added).
			Correct Floppy save/restore error recovery code,
			Completion routine bugs, DMBLK corruption.
			Change all readw/writew to completion routines
			so it will work under FB.
			Correct Synchronization problems between USED/PENDX
			and Completion Routines by using Interrupt lock.
			Correct other sundry maths.

4.1a	Jan-84	PBM/ make bad block recovery work on SAVRES to floppy
			discs as well. Add LD: and VU: to device help
			message.

4.1	Nov-83	PBM/ add the "Append or Overwrite" option on save to
			tape or cartridge. Enable discs with bad blocks
			to be saved or restored. Allow Virtual Units and
			Logical Discs to be used.

4.00e	Sep-83	PBM/ allow the use of NL: as a save/restore device

4.00d	Jul-83	PBM/ fix up blocks being mangled at eof
			the very last blocks were written correctly, but
			during a restore the buffer flushing at eof did not
			advance buffers, so causing some buffers to be written
			twice!

4.00c	Jul 83	PBM/ add INIT (and SCINIT) message to SAVE prompt

4.00b	Jul-83	PBM/ made tape write error message more informative

4.00a	Jun-83	PBM/ fixed vector restore bug for tape and cartridge
			most 4.00 in the field are 4.00a

4.00	May-83	PBM/ General clean up.
			Get rid of csi.
			Provide good help facility.
			Verify first block.
			Don't save/restore disc bad block area.
			Automatically fetch all needed handlers,
			and dynamically	allocate buffers.
			Make files created by SAVE on cartridge
 			or magtape have	filename, default is "SAVRES.FIL".

		Overlay to save memory:-
			SAVRES	-	root
			SAVINI	-	initialization
			SAVTAP	-	tape and cartridge
			SAVFLP	-	floppy

3.00	Jun 82	Neil Baylis/CSI and floppy disc handling
2.00	May 82	Neil Baylis/Logic speed-ups for 100 ips
1.01	Mar 82	PBM/Improved Disc handling
1.00	Feb 82	PBM/ Initial Version


This is the root section for the SAVRES program

	.endc
.Sbttl	Macros etc

;Macro to type a string followed by a <cr><lf>

.macro	type,text
	.save
	.psect	savmes
$$$=.
	.asciz	@text@
	.restore
	.print	#$$$
.endm	type

;Macro to type a string with no following <cr><lf>

.macro	typen,text
	.save
	.psect	savmes
$$$=.
	.ascii	@text@ <200>
	.restore
	.print	#$$$
.endm	typen

;Macro to type a string with full control in the string itself

.macro	typex	text
	.save
	.psect	savmes
$$$=.
	.ascii	text
	.restore
	.print	#$$$
.endm	typex


;get input and provide help, if requested

;format is

;	getin	input buffer, address if help, help text(up to three)

.macro	GETIN,inbuf,hlpadd,hlptx1,hlptx2,hlptx3,?d
	.narg	args

	.gtlin	#inbuf

	cmpb	inbuf,#'?
	bne	d
.iif gt args-2	.print	hlptx1
.iif gt args-3	.print	hlptx2
.iif gt args-4	.print	hlptx3
.iif gt args-5 .error	hlpadd	;too many arguments
	jmp	hlpadd
d:
.endm	getin


;Macro to tidy up help messages

.macro	x	string
.ascii	|'string'|<cr><lf>
.endm	x


.Mcall	.lookup,.enter,.print,.dstatus,.spfun,.readc,.writw,.readw,.writc
.Mcall	.exit,.fetch,.wait,.qset,.gtlin,.close,.ttyout,.settop,.releas
.Mcall	.gval,.assume,.br

;LUN assignments

DKLUN	==:	7
MTLUN	==:	1
FLPLUN	==:	1
AUXLUN	==:	2


;Asect locations

errbyt	==: 52

userrb	==: 53
 succs$	==:  1
 warn$	==:  2
 error$	==:  4
 sever$	==: 10
 fatal$	==: 20

jsw	==: 44
 virt$	=   2000
 edit$	=     20
 gtlin$ =     10


;Values for GVAL

sysver	==: 276		;Monitor version number
sysupd	==: 277		;Monitor release number


;Virtual Job Status Word bit if XM option selected

	.save
	.asect
. = jsw
	.word	edit$ ! gtlin$ * <virt$ * xm>
	.restore

;SPFUN values

; - Disc

sp.usz	==:	300		;Get unit size (DUCM)
sp.pio	==:	301		;Physical I/O  (DUCM)
sp.dat	==:	372		;Get data block from handler
sp.psz	==:	373		;Get partition size

; - Tape

sp.rdb	==:	370		;Read variable-length block
sp.wrb	==:	371		;Write, ibid
sp.unl	==:	372		;Unload
sp.rew	==:	373		;Rewind
sp.bks	==:	375		;Backspace (not supported by SC:)
sp.fws	==:	376		;Forward space
sp.wfm	==:	377		;Write file mark


.Sbttl	Initialization


START:	jmp	savini			;call initalization



							.if ne xm
savsuc:	.asciz	/*** Successful SAVREX Completion ***/
savfai:	.asciz	/SAVREX Failure/
	.even
							.iff
savsuc:	.asciz	/*** Successful SAVRES Completion ***/
savfai:	.asciz	/SAVRES Failure/
	.even
							.endc

.Sbttl	Subroutines

;Get Size of disc. Number of records, for the mag-tape, returned in
; RECS

DSKSIZ::
	mov	f.size(r2),r3
	mov	f.sizh(r2),r2
200$:
	cmp	endblk,r3	;Is endblk less than device size ?
	bhis	220$		;Branch if not
210$:	mov	endblk,r3
	inc	r3		;Correct device size
	bne	220$
	inc	r2
220$:	sub	begblk,r3	;Correct for beginning block
	sbc	r2
	sub	begblj,r2
	mov	r3,dskblk	;Save size for typeout
	mov	r2,dskblj

230$:	mov	#blkfac,r0	;And blocking factor

	call	div21

240$:	swab	r0		;make blocks words

	mov	r0,remain	;And save
250$:	mov	r3,recs		;Set up disc size

.if	ne,debug
	typen	<Recs: >
	call	typnum

	typen	< Rem:  >
	mov	remain,r3
	clr	r2
	call	typnum
	type	<>
.endc
	return


;	Convert TSIZE blocks to R0 words

CONVRT::
	mov	tsize,r0
	swab	r0
	bic	#377,r0		;safety?
	return

;clrdfl	-	clear filename defaults

;call:	r2		address of file block

clrdfl::
	clr	f.fil1(r2)
	clr	f.fil2(r2)
	clr	f.ext(r2)
	return

;typfil	-	type out device and file name

;call:	r2		address of file block

typfil::
	mov	(r2),-(sp)	;device

	cmpb	f.dtyp(r2),#50
	bne	1$		;not DU
	tst	duseen
	beq	1$		;not entire DU so proceed normally
	add	#^r  a,(r2)
1$:
	clr	r0
	call	wft

	mov	(sp)+,(r2)
	return

;Type out a single-precision decimal number (shorter than CVLLIB's version!)

;CALL:	R0	Number

WDT::
	mov	r2,-(sp)
	mov	r3,-(sp)
	clr	r2
	mov	r0,r3
	call	typnum
	mov	(sp)+,r3
	mov	(sp)+,r2
	return


;Type out a number, in Decimal or Octal  (TYPNUM or TYPOCT, respectively)

;CALL:	R2	High Order Number
;	R3	Low Order Number
;No acs destroyed

TYPNUM::
	mov	r4,-(sp)
	mov	#10.,r4
	br	typ

TYPOCT::
	mov	r4,-(sp)
	mov	#8.,r4
typ:
	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)

	CLR	R1		;Initialize digit counter

10$:	MOV	R1,-(SP)	;Save digit counter
	MOV	r4,R0		;Divide by 8 or 10
	call	DIV21
	MOV	(SP)+,R1	;Get back digit counter
	MOVB	R0,-(SP)	;Save remainder
	INC	R1
	mov	r2,-(sp)
	bis	r3,(sp)+
	BNE	10$		;More figures
20$:
	MOVB	(SP)+,R0	;Get back digit, in reverse order
	ADD	#'0,R0		;Convert to ASCII
	.TTYOUT			;And type out
	SOB	R1,20$		;More digits?
				;no
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r1
	mov	(sp)+,r0

	mov	(sp)+,r4
	return

INIPAS::
	CLR	RECS
	clr	d$blk
	clr	d$blkh
	CLR	DSKBLK
	CLR	REMAIN
	MOV	#1000.,BLKMON
	CLR	NXTIN
	CLR	NXTOUT
	CLR	USED
	CLR	PSTAT
	return

;device error routines

errfnf::typex	<<cr><lf>/Cannot find /<200>>
	.br	filerr

filerr::
	clr	r0
	call	wft	
	br	errext
.Sbttl	Successful exit

SUCCES::
	.print	#savsuc
	mov	pc,r0
	mov	spsav,sp
	.settop	#0
	.exit

.Sbttl	Error exit

ERREXT::call	close
	bisb	#error$,@#userrb	;Flag error to user
	clr	r0
	mov	spsav,sp
	.exit

.Sbttl	Severe Error exit

CRASH::
	mov	spsav,sp
	type	<>
	.print	#savfai
	bisb	#sever$,@#userrb 	;Flag severe error
	clr	r0
	.exit


.Sbttl	Unit Closing Routine

close::	mov	#8.,r2
	mov	#dklun,r3
1$:	.close	r3
	inc	r3
	sob	r2,1$
	.close	#mtlun
	return
.Sbttl	Data Areas

;Input file block

infil::	.blkw	7.

;Output file block

outfil::.blkw	7.

;REWIND flags (non-zero suppresses rewind)

rewflg::
rewsrt::.byte	0		;Rewinds at start
rewend::.byte	0		;Rewinds at end

;Physical I/O flag
pio::	.byte	0		;Non-zero to force use of physical I/O EMTs

;Other flags
stream::.byte	0		;Non-zero if try for streaming
averif::.byte	0		;Non-zero if try for auto-verify

	.even

;Offsets

f.dev	==:	0		;Device
f.fil1	==:	2		;Filename 1
f.fil2	==:	4		;Filename 2
f.ext	==:	6		;Extension
f.size	==:	8.		;Size
f.dtyp	==:	10.		;Device type,as returned by .dstatus
f.sizh	==:	12.		;Size, high order

flblen	==:	7.		;Length of fileblock


;Memory addresses

	.limit
bottom	==	. - 2		;Bottom free location
endmem::.word	0		;Last free location
free::	.word	0		;Next free address (for drivers and buffers)

mtbuff::.iif eq xm, .word 0
	.iif ne xm, .word mtbuf

spsav::	.word	0

;SAVRES Tape file name

savres::.rad50	/savresfil/

;DSTATUS Block

dstblk::.blkw	4

;EMT Area

area::	.blkw	8.

;Temporary, for anything

temp::	.word	0,0

;Magtape error block

tperr::	.blkw	4

	.even

retspc::	.blkw	4		;Ain't the comments here helpful?
iretsp::	.blkw	4
begblk::	.word	0
begblj::	.word	0
endblk::	.word	0
endblj::	.word	0
sfblk::		.word	0,0,0,0
dmflg::		.word	0
nvflag::	.word	0
volnum::	.word	0
wcnta::		.word	0
wcntb::		.word	0
flpblk::	.word	0
dmblk::		.word	0
flpsiz::	.word	0
dmsiz::		.word	0
dmsiy::		.word	0
aflg::		.word	0
bflg::		.word	0
tsize::		.word	0

;Terminal I/O Buffer

tloub::	.blkb	40.
tlinb::	.blkb	81.
	.even

;Disc Size, in Tape Blocks, as computed

recs::	.word	0

;Count of buffers

bfrec::	0		;No. of full buffers still to go
bfrem::	0		;No. of blocks when all full buffers done
.Sbttl	Disc double buffer headers:

dp::	0			;Pointer to current header in use
tp::	0			;Tape pointer, snuck in here!

dh1::
	d$fre::	0		;Status
	d$next::.word	dh2	;Next buffer header pointer
	d$last::.word	dh2	;Previous buffer header pointer
	d$buf::	0		;Pointer to first disc buffer
	d$lun::	0		;Logical unit number for this I/O
	d$blk::	0		;Low-order block number
	d$blkh::0		;High-order, ibid
	d$blks::0		;Blocks in this bufferful
	d$dcrt::0		;Disc completion routine address
	d$tcrt::0		;Tape completion routine address
	d$tblk::.word	0,0	;Tape error block

hdrsiz ==: < . - dh1 > / 2

;Offsets:

b.stat	== d$fre  - dh1
b.next	== d$next - dh1
b.last	== d$last - dh1
b.buf	== d$buf  - dh1
b.lun	== d$lun  - dh1
b.blk	== d$blk  - dh1
b.blkh	== d$blkh - dh1
b.blks	== d$blks - dh1
b.dcrt	== d$dcrt - dh1
b.tcrt	== d$tcrt - dh1
b.tblk	== d$tblk - dh1

dh2::
	.word	0,dh1,dh1,0
	.word	0,0,0,0,0,0,0,0

;Values in Status Word


;High byte:
b..emp	==:	-1	;Empty
b..que	==:	 0	;Queued
b..ful	==:	 1	;Full

;Low byte:	If empty or full
b..ok	==:	 0	;OK
b..err	==:	-1	;Error
b..eof	==:	 1	;EOF
;		If queued
b..qds	==:	 1	;Queued for disc
b..qmt	==:	-1	;Queued for tape
.Sbttl	Other Parameters

;Saved Disc Size, in blocks

dskblj::.word	0		;high order size
dskblk::.word	0

;DU partition spanning area

duseen::.word	0		;IO requires partition spanning

;Remainder, from BUFSIZ

REMAIN::	.WORD	0

;Block monitoring data

blkmom::	.word	0	;High order blkmon
BLKMON::	.WORD	1000.	;Start at block 1000.
BLKMF	==	1000.		;Every 1000. blocks

;Program Status

DEFEXT::	.WORD	0,0,0,0	;RT-11 Default extension
NXTIN::		.WORD	0	;Next input buffer
NXTOUT::	.WORD	0	;Next output buffer
USED::		.WORD	0	;Number of used buffers
PSTAT::		.WORD	0

timstn::	.word	timout	;1st 16 bits of tape timeout
TIMSTO::	.WORD	timval	;2nd 16 bits of Tape Timeout
timhi::		.word	timval	;High-order time (altered for 11/73)

;Status Bits

$STREAM	==:	1		;In streaming mode
$DKBSY	==:	2		;Disc is Busy
$MTBSY	==:	4		;Magtape is Busy
$rest	==:	10		;Restore operation
$noifil	==:	20		;no input filename wanted (V3 compatibility)
$noofil	==:	40		;no output filename
$ovwrt	==:	100		;overwrite tape (or cartridge) on SAVE
$dkerr	==:	200		;disc error has occurred
$mterr	==:	400		;magtape error has occurred
$mtvol	==:	1000		;magtape requires new volume
$oldtp	==:	2000		;SAVRES 4.2b or earlier tape format
$nwvol	==:	4000		;recursion prevention flag
$death	==:	10000		;die now

;Characters

cr	==:	15
lf	==:	12
esc	==:	33
tab	==:	11
dollar	==:	'$
.Sbttl	I/O Buffers

;The I/O buffers are dynamically set up at startup

BUFER::		.WORD	0	;start address of buffers
bufend::	.word	0	;end address of buffers
bufers::	.word	0	;number of buffers
buferl::	.word	0	;number of buffers - 1 (for any buffers
				; remaining)

BLKFAC	==	16.		;Blocking factor
BUFSIZ	==	BLKFAC. * 512.	;Size of buffer, in Bytes

;floppy buffers - also dynamically set up

buffra::	.word	0	;buffer a
buffrb::	.word	0	;buffer b

blkbuf::	.word	0	;floppy home block buffer

flbsiz	==	10		;size in blocks of floppy transfer

xmflag::.word	xm		;non zero if virtual

.if	ne xm
mtbuf::	.blkw	256.		;tape volume check buffer for XM virtual job
.endc

.even

savnm1	== ^r$$$		;dummy filename for overwrites
savnm2	== ^r$$$
savnm3	== ^r064

IOQUES	== 16.
IOQUE::	.BLKW	IOQUES*10.	;RT-11 I/O queue elements
.Sbttl	CVLSAV - Mini-CVLLIB for SAVRES

.Psect	CVLSAV


.Sbttl	WFT - Write a filename to terminal

		.If eq 1
Requires a fileblock (pointed to in R2) in the format
		.RAD50	/device/	up to 3 characters	;1 word
		.RAD50	/filename/	up to 6 characters	;2 words
		.RAD50	/extension/	up to 3 characters	;1 word
		.WORD	size					;1 word

and a pair of flags (in R0):

	Low order byte =  0 - No size printed
		       <> 0 - size printed
	Sign bit clear -  no spaces in subfields
		 set   -  spaces in subfields
		For example:
		if R0 be negative, "DK: TEST  .TMP" could be output, whereas
		when it is positive "DK:TEST.TMP" would result.

Called by
		MOV	#<fileblock>,R2
		MOV	#<string to receive ascii filename>,R1
		MOV	#<flags>,R0
		CALL	WFT
No registers are altered.

Wildcard characters "*" (unassigned Rad50 code) and "%" (Rad50 ".")
are permitted.
		.Endc

WFT::
	mov	r2,-(sp)
	mov	r1,-(sp)
	mov	r0,-(sp)

	mov	#tloub,r1	;Terminal output area
	mov	(r2)+,r0	;Device

	call	w50f		;Convert to 3 characters
	tst	(sp)		;See if want space suppression
	bpl	10$		;Yes.

	movb	#' ,(r1)+	;No.  Allow room for colon.
	tst	-2(r2)		;See if was null device
	beq	30$		;Was null - just leave as spaces
	mov	r1,-(sp)	;Trim back to char but keep track
	call	rtrim		; of where columns will line up
	movb	#':,(r1)
	mov	(sp)+,r1
	br	30$
10$:
	tst	-2(r2)		;Want space suppression.  If null, not even :
	bne	20$
	sub	#3,r1
	br	30$
20$:
	call	rtrim		;Suppress spaces and append colon.
	movb	#':,(r1)+

30$:
	mov	(r2)+,r0	;First filename word
	mov	r0,-(sp)	;Save to check for null filename
	call	w50f
	mov	(r2)+,r0	;Second filename word
	bis	r0,(sp)
	call	w50f
	tst	2(sp)		;Again, trim spaces if necessary
	bmi	40$
	call	rtrim
40$:
	movb	#'.,r0
	bis	(r2),(sp)+	;All bits which were set in filename or ext
	bne	45$
	movb	#' ,r0		;Space if completely null
45$:	movb	r0,(r1)+

	mov	(r2)+,r0	;Extension
	call	w50f
	tst	(sp)
	bmi	50$
	call	rtrim
50$:
	movb	#200,(r1)+
	.print	#tloub

	tstb	(sp)		;Want file size printed?
	beq	60$
	.ttyou	#'[
	mov	(r2),r0
	call	wdt
	.ttyou	#']
60$:
	mov	(sp)+,r0
	mov	(sp)+,r1
	mov	(sp)+,r2
	return

.Sbttl	RTRIM - Delete trailing spaces & tabs

		.if eq 1
Expects a pointer to a string in R1.  Backs up this pointer to point to
before any spaces or tabs.
		.endc

spc=40
tab=11

r:
	dec	r1
rtrim::
	cmpb	-1(r1),#spc
	beq	r
	cmpb	-1(r1),#tab
	beq	r
	return
.if ne debug

.Title	W8T & W8 - Write an unsigned octal number

W8T::				;Write number in R0 to terminal
	mov	r1,-(sp)
	mov	#tloub,r1
	call	w8
	movb	#200,(r1)
	.print	#tloub
	mov	(sp)+,r1
	return

W8::				;Write number in R0 to string
	mov	r0,-(sp)
	bne	10$
	  movb	#'0,(r1)+	;Send a zero if it is.
	  br	40$
10$:
	clr	-(sp)		;Flag for when finished with stack
20$:
	mov	r0,-(sp)
	clc			;In case negative
	ror	r0
	asr	r0
	asr	r0
	bne	20$
30$:
	mov	(sp)+,r0
	beq	40$
	bic	#177770,r0
	bis	#60,r0
	movb	r0,(r1)+
	br	30$
40$:
	mov	(sp)+,r0
	return
.endc
.Sbttl	W50F - Write a RADIX50 word to a string (filename set)

		.If eq 1
Writes to the string pointed to in R1 the Radix50 word contained in R0.
No registers other than R1 are altered.  The unused Radix50 code, 35,
is typed as an "*".  The Radix50 "." is interpreted as the filename
wildcard "%".
		.Endc

W50F::
	mov	r0,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)

	clr	r2		;Force unsigned division for first step.
	mov	r0,r3		;DIV21 expects dividend in R2,R3 divisor in R0
	mov	#50,r0
	call	div21
	call	$c50a		; and returns remainder in R0
	mov	r0,-(sp)

	mov	#50,r0
	call	div21		; and quotient in R2 ready for next time.
	call	$c50a
	mov	r0,-(sp)

	mov	r3,r0
	call	$c50a

	movb	r0,(r1)+
	movb	(sp)+,(r1)+
	movb	(sp)+,(r1)+

	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r0
	return


$c50a:	call	c50a
	cmp	r0,#'.		;Convert . to %
	bne	10$
	mov	#'%,r0
10$:	return

.Sbttl	W50T - Write a RADIX50 word

		.If eq 1
Writes to the terminal the Radix50 word contained in R0.  No registers
are altered.  The unused Radix50 code, 35, is typed as an "*".
		.Endc

W50T::
	call	w$t
	.word	w50
.Sbttl	RF - Read filename from the string pointed to in R1

		.If eq 1
Reads a filename from a string pointed to in R1 into a block of 5 words
pointed to in R2.  This block is used as:
	.word device,first-filename-word,second-filename-word,extension,size

R1 is left pointing to the delimiting character.

A CS return is taken if the filename syntax cannot be interpreted.

RF clears the fileblock before using it.
RFD clears only the filename and size, leaving the device and extention
	available for defaults.
		.Endc

RFD::				; **** RFD **** Read file, allowing defaults
	mov	r0,-(sp)
	mov	r2,r0
	tst	(r0)+		;Leave device as is
	clr	(r0)+		;Clear filename
	clr	(r0)
	clr	10(r2)		; and file size
	br	rfc

RF::				; **** RF **** Read file, clearing block first
	mov	r0,-(sp)

	mov	r2,r0		;Clear out the fileblock
	clr	(r0)+
	clr	(r0)+
	clr	(r0)+
	clr	(r0)+
	clr	(r0)
RFC:
	call	ltrim		;Scrub any leading spaces.
	call	r50f		;Read up to 3 radix50 characters
	bcc	10$		;If carry clear, didn't hit ":"
	cmpb	(r1),#':	;If it wasn't a colon, hopefully it was a "."
	sec			; so make it look like a delimiter.
	bne	10$

	mov	r0,(r2)		;Device
	inc	r1
	call	r50f		;Read first filename word
10$:
	mov	r0,2(r2)
	bcs	20$		;Don't try for a second if there isn't one

	call	r50f		;Read second filename word
	mov	r0,4(r2)
	bcc	ferr		;If didn't get delimiter then, it ain't right.
20$:
	cmpb	(r1),#'.	;See if dot for extension
	bne	30$		;No - try out for file size

	inc	r1		;Skip the dot
	call	r50f		;And read the extension
	mov	r0,6(r2)
	bcc	ferr		;Should have hit a delimiter here.
30$:
	cmpb	(r1),#'[	;See if size specified
	bne	40$		;No - just give him whatever the delim was

	inc	r1
	call	rds		;Read size as signed decimal integer
	mov	r0,10(r2)
	cmpb	(r1),#']
	bne	ferr
	inc	r1
40$:
	clc
	br	ret

ferr:
	sec
ret:
	mov	(sp)+,r0
	return
.Sbttl	RD2 - Read unsigned double-precis decimal number

		.if eq 1
Reads a double-precision decimal integer from the string pointed to by R1.

Overflow is counted as 32-bit overflow, not 31+sign, the result being counted
as an unsigned integer.  If negative, there has been signed overflow.
Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will be continued to the end of the
number.

The number is returned in R2 (hi-ord) and R3 (lo-ord).  R1 is reset to
point to the delimiting character.  No other registers are altered.
		.endc

RD2::
	MOV	R0,-(SP)
	MOV	R5,-(SP)
	clr	r5		;To track carry.

	CALL	LTRIM		;Ignore leading tabs/spaces
	CLR	R2
	CLR	R3
10$:
	MOVB	(R1)+,R0
	BIC	#^C177,R0
	SUB	#'0,R0		;Convert next character to numeric value
	CMP	R0,#9.		; and check range
	BHI	20$

	ASL	R3
	ROL	R2		; * 2
	adc	r5
	mov	r2,-(sp)
	mov	r3,-(sp)

	ASL	R3
	ROL	R2		; * 4
	adc	r5

	ASL	R3
	ROL	R2		; * 8
	adc	r5

	add	(sp)+,r3	; * 10
	adc	r2
	adc	r5
	add	(sp)+,r2
	adc	r5

	ADD	R0,R3
	ADC	R2		;Plus this digit
	adc	r5
	beq	10$
	mov	#1,r5		;In case he's REALLY keen!
	br	10$

20$:
	DEC	R1		;Point back to delimiting character

	tst	r5		;Overflow?
	beq	30$		;No.
	sec			;Yes.
30$:
	MOV	(SP)+,R5
	MOV	(SP)+,R0
	RETURN
.Sbttl	RD - Read an unsigned single-precision decimal number

		.if eq 1
Called by
		MOV	#string,R1
		CALL	RD

Returns the number in R0, and R1 points to the delimiter of the number.

Overflow is counted as 16-bit overflow, not 15+sign, the result being counted
as an unsigned integer.  If negative, there has been signed overflow.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will have been continued to the
end of the number.
		.endc

RD::
	mov	r2,-(sp)
	mov	r3,-(sp)
	clr	r2		;For overflow detection.
	clr	-(sp)

	call	ltrim
	clr	r0		;For result
10$:
	movb	(r1)+,r3	;Next character
	bic	#^c177,r3
	sub	#'0,r3
	cmp	r3,#9.
	bhi	20$

	asl	r0		; * 2
	adc	r2
	mov	r0,(sp)

	asl	r0
	adc	r2		; * 4

	asl	r0		; * 8
	adc	r2

	add	(sp),r0		; * 10
	adc	r2

	add	r3,r0
	adc	r2
	beq	10$
	mov	#1,r2
	br	10$

20$:
	dec	r1		;Point at delimiter
	tst	(sp)+
	mov	(sp)+,r3
	tst	r2		;Any overflow?
	beq	30$		;No.
	sec			;Yes.
30$:
	mov	(sp)+,r2
	return
.Sbttl	MUL21 - Multiply double * single precision

		.If eq 1
Called by
		MOV	<hi-ord 2/precis integer1>,R2
		MOV	<lo-ord 2/precis integer1>,R3

		MOV	<lo-ord 2/precis integer2>,R0

		CALL	MUL21
Returns
		R2/hi-ord 2/precis result
		R3/lo-ord 2/precis result

		CS if overflow occurred
		(R0 is unchanged)
{If overflow occurred, R2,R3 may contain only garbage}.
		.Endc

MUL21::
	CLR	-(SP)		;For checking for overflow
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R0,-(SP)	;Stack multiplier for right shifting
	BGE	10$		; and keep it positive
	NEG	(SP)
10$:
	MOV	R2,R0		;Use R0,R1 for the left shifting multiplicand
	MOV	R3,R1
	CLR	R2
	CLR	R3
	BR	30$

20$:
	ASL	R1		;Left shift multiplicand
	ROL	R0
	BVS	50$		;Overflow
30$:
	CLC
	ROR	(SP)
	BCC	40$
	ADD	R1,R3
	ADC	R2
	BVS	50$
	ADD	R0,R2
	BVS	50$
40$:
	TST	(SP)
	BNE	20$
	BR	60$
50$:
	INC	6(SP)		;Set overflow flag
60$:
	TST	(SP)+		;Scrap remains of multiplier
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	BGE	70$		;If negative multiplier, negate result
	NEG	R2
	NEG	R3
	SBC	R2
70$:
	TST	(SP)+		;Any Overflow, Clancy?
	BEQ	80$
	SEC
80$:
	RETURN
.Sbttl	DIV21 - Signed <double-precision>/<single-precision> integer divide

		.if eq 1
Called by
	MOV	<hi-ord dividend>,R2
	MOV	<lo-ord dividend>,R3
	MOV	<divisor>,R0
	CALL	DIV21
Returns
	R2/hi-order quotient
	R3/lo-order quotient
	R0/remainder

If divide-by-zero is attempted, the arguments are unaltered, and both
C (carry) and V (overflow) are set.  Normally carry is clear on return.
		.endc
DIV21::
	MOV	R0,-(SP)	;Quotient gets XOR of signs
	BEQ	70$		;Whoops - don't like this!
	BGT	10$
	NEG	R0		;But work internally with positive numbers
10$:	BIC	#77777,(SP)
	ADD	R2,(SP)

	MOV	R2,-(SP)
	BGE	20$
	NEG	R2
	NEG	R3
	SBC	R2
20$:
	MOV	#32.,-(SP)
	MOV	R0,-(SP)	;Save on stack for subtractions
	CLR	R0
30$:
	ASL	R3
	ROL	R2
	ROL	R0
	CMP	R0,(SP)
	BLO	40$
	SUB	(SP),R0		;Subtract out as shift numbers across
	INC	R3		; and mark subtraction in quotient
40$:
	DEC	2(SP)
	BGT	30$

	CMP	(SP)+,(SP)+

	TST	(SP)+
	BGE	50$
	NEG	R0		;Remainder gets sign of dividend
50$:
	TST	(SP)+
	BGE	60$
	NEG	R2
	NEG	R3
	SBC	R2
60$:
	.WORD	CLC!CLV
	RETURN

70$:
	TST	(SP)+
	.WORD	SEC!SEV		;Set both error flags
	RETURN
.Sbttl	W50 - Write a RADIX50 word to a string

		.If eq 1
Writes to the string pointed to in R1 the Radix50 word contained in R0.
No registers other than R1 are altered.  The unused Radix50 code, 35,
is typed as an "*".
		.Endc

W50::
	mov	r0,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)

	clr	r2		;Force unsigned division for first step.
	mov	r0,r3		;DIV21 expects dividend in R2,R3 divisor in R0
	mov	#50,r0
	call	div21
	call	c50a		; and returns remainder in R0
	mov	r0,-(sp)

	mov	#50,r0
	call	div21		; and quotient in R2 ready for next time.
	call	c50a
	mov	r0,-(sp)

	mov	r3,r0
	call	c50a

	movb	r0,(r1)+
	movb	(sp)+,(r1)+
	movb	(sp)+,(r1)+

	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r0
	return
.Sbttl	R50 - Read up to 3 Radix50 Characters into R0

		.If eq 1
Reads up to 3 ascii characters from the string pointed to in R1, converting
them to radix50 and returning them in R0.  Returns CS if NEXT character is
not a valid radix50 character (even if three characters have been read),
and CC otherwise.  R1 is left pointing to the next character.

There are three routines here: R50S, R50F and R50.
R50  - all radix50 characters including full stop and space.
R50S - symbol set, dot OK, space acts as a delimiter.
R50F - filename set, dot and space act as delimiters.
		.Endc

	.ENABL	LSB
R50S::
	mov	r2,-(sp)
	mov	#-1,-(sp)	;Flag for dot/space recognition.
	br	10$
R50F::
	mov	r2,-(sp)	;Save 1 ac first as need scrap heap at end
	mov	#1,-(sp)
	br	10$
R50::
	mov	r2,-(sp)
	clr	-(sp)
10$:
	mov	r3,-(sp)

	clr	-(sp)		;For result

	call	rnc		;Read next character from R1, converted to R50
	bcs	20$		;Hit a delimiter
	mov	#50*50,r2
	call	mul11		;Multiplier in R0, multiplicand in R2, returns
	mov	r3,(sp)		; double-length result in R2,R3

	call	rnc		;Second character
	bcs	20$
	mov	#50,r2
	call	mul11
	add	r3,(sp)

	call	rnc		;Third character
	bcs	20$
	add	r0,(sp)

	call	rnc		;And an extra just to check whether valid R50
20$:				; coming up next (but don't skip it)
	dec	r1
	mov	(sp)+,r0	;Result

	mov	(sp)+,r3
	mov	(sp)+,r2	;Scrap flag without affecting carry
	mov	(sp)+,r2
	return

rnc:
	movb	(r1)+,r0
	bic	#^c177,r0
	call	ca50		;Converts ascii to rad50, returning CS if
	bcs	30$		; invalid, and ZS if . or space.
	bne	30$
	tst	6(sp)		;See if he wants dot and space returned OK
	beq	30$		;Yes
	tst	r0		;Otherwise see if just "." is OK
	beq	25$		;Space always sets carry here
	tst	6(sp)
	blt	30$		;But get away with dot in R50S
25$:	sec			;No - mark them as delimiters
30$:	return

	.dsabl	lsb
.Sbttl	RDS - Read a signed single-precision decimal number

		.If eq 1
Called by
		MOV	#string,R1
		CALL	RDS

Returns the number in R0, and R1 points to the delimiter of the number.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will have been continued to the
end of the number.
		.Endc

.GLOBL	RSGN,RD

RDS::
	CLR	-(SP)		;For overflow indication
	CALL	RSGN		;Read any sign specified
	MOV	R0,-(SP)	;Zero if positive, negative if negative
	CALL	RD		;Read unsigned number
	BCC	10$
	INC	2(SP)
10$:
	TST	R0		;If negative, too big for signed number
	BGE	20$
	INC	2(SP)
20$:
	TST	(SP)+
	BEQ	30$
	NEG	R0
30$:
	TST	(SP)+		;Overflow?
	BEQ	40$
	SEC
40$:
	RETURN

.Sbttl	W$T - Common path output section for WxT

		.If eq 1
Called from routines requiring terminal output from R1 string setting
routines eg WDT.  Saves and resets R1 to point to buffer TLOUB, calls
the required routine, then prints the answer.

There is no preservation of carry across this routine.  Should this be
necessary, use W$CT instead.

The calling sequence is:

	CALL W$T
	.word ROUTINE required.

[V3	1-Apr-83]
Change from TLINB to TLOUB to separate TT input & output.
		.endc

.globl	tloub
.mcall	.print

W$T::
	mov	@(sp),(sp)	;Put address of ROUTINE instead of return addr
	mov	r1,-(sp)
	mov	#tloub,r1	;Address of temporary buffer for ROUTINE
	call	@2(sp)		;Address of ROUTINE here
	movb	#200,(r1)	;Make so prints with no crlf
	mov	(sp)+,r1
	mov	r0,(sp)		;Obliterate first level return address
	.print	#tloub
	mov	(sp)+,r0
	return
.Sbttl	C50A - Convert Radix50 char to Ascii

		.If eq 1
Expects a Radix50 character in R0.  Returns the corresponding Ascii value
in R0, destroying no other registers.  The unassigned Radix50 character,
35, is returned as "*", and any illegal value is returned as "?", with CS.
		.Endc

C50A::
	cmp	#47,r0		;See that it's within range.
	bcc	10$		;==bhis
	mov	#50,r0		;Return this for error char. with carry set.
10$:	movb	r50tab(r0),r0
	return


r50tab:
	.ascii	/ ABCDEFGHIJKLMNOPQRSTUVWXYZ$.*0123456789?/
	.even
.Sbttl	CA50 - Convert Ascii to Radix50

		.If eq 1
Converts a character in R0 from ascii to radix50.  The unused radix50
character, 35, is assigned to the character "*".  The wildcard "%"
character becomes the same as the character ".".  Illegal characters
cause a CS return.  In addition, the characters space and full-stop
(invalid within filenames) cause a CC but ZS return.
		.Endc

CA50::
	CMP	R0,#'z		;Convert lower case to upper case
	BHI	20$		;At this end, out of bounds anyway.
	CMP	R0,#'a
	BLO	10$
	SUB	#40,R0
10$:
	CMP	R0,#'Z
	BHI	20$		;Illegal
	CMP	R0,#'A
	BHIS	80$		;Alpha
	CMP	R0,#'9
	BHI	20$		;Illegal
	CMP	R0,#'0
	BHIS	70$		;Numeric

	CMP	R0,#40		;Space
	BEQ	40$
	CMP	R0,#'%		;Wildcard %
	BEQ	35$
	CMP	R0,#'*		;Asterisk
	BEQ	50$
	CMP	R0,#'$
	BEQ	60$
	CMP	R0,#'.
	BEQ	30$
20$:
	SEC			;Illegal Character - CS return
	RETURN

30$:
	MOV	#34,R0		;Full stop
	CLC
	SEZ
	RETURN

35$:	SUB	#11-40,R0	;% becomes .
40$:	SUB	#40-15,R0	;Space
50$:	SUB	#15-11,R0	;*
60$:	SUB	#11-22,R0	;$
70$:	SUB	#22-100,R0	;Numeric
80$:	SUB	#100,R0		;Alpha
	CLC			;Note space returns ZS from the subtraction
	RETURN
.Sbttl	LTRIM - Skip over leading spaces & tabs

		.if eq 1
Expects a pointer to a string in R1.  Updates this pointer to point past
any spaces or tabs.
		.endc

SPC=40
TAB=11

L:
	INC	R1
LTRIM::
	CMPB	(R1),#SPC
	BEQ	L
	CMPB	(R1),#TAB
	BEQ	L
	RETURN
.Sbttl	RSGN - For reading the sign preceding a number

		.if eq 1
Called by MOV #STRING,R1
	  JSR PC,RSGN

Ignores any leading spaces, tabs, or plus signs, and returns 0 in R0 if
the number of minus signs is even, -1 in R0 if odd.
		.ENDC

RSGN::
	clr	r0
10$:
	cmpb	(r1),#40
	beq	30$
	cmpb	(r1),#11
	beq	30$
	cmpb	(r1),#'+
	beq	30$

	cmpb	(r1),#'-
	beq	20$

	return

20$:
	com	r0
30$:
	inc	r1
	br	10$
.Sbttl	MUL11 - single * single and double * single signed multiply

		.if eq 1
Called by
		MOV	<single precis integer1>,R0
		MOV	<single precis integer2>,R2

		CALL	MUL11
Returns
		R2/hi-ord 2/precis result
		R3/lo-ord 2/precis result

		CS if result cannot be expressed in a single-precision no.

Multiplies two single-precision integers (in R0 and R2) returning
a double-precision result in R2 (hi-ord) and R3 (lo-ord).
R0 is unaltered.
		.endc

MUL11::
	MOV	R1,-(SP)	;Used to hold overflow from single-precis
	CLR	R1

	MOV	R0,-(SP)	;Hold multiplier, and use positive form
	BGE	10$
	NEG	R0
10$:
	MOV	R4,-(SP)	;Put double-precis multiplicand in R4,R5 for
	MOV	R5,-(SP)	; left-shifting.
	CLR	R4
	MOV	R2,R5
	BGE	20$
	DEC	R4
20$:
	CLR	R2
	CLR	R3
	BR	50$

30$:
	ASL	R5		;Shift multiplicand to left for next
	BVC	40$		; (potential) addition.  If overflow, remember
	INC	R1
40$:	ROL	R4

50$:	CLC
	ROR	R0		;Right-shift multiplier
	BCC	70$
	ADD	R5,R3
	BVC	60$
	INC	R1		;Again, keep track of overflow on addition
60$:	ADC	R2
	ADD	R4,R2

70$:	TST	R0
	BNE	30$

	MOV	(SP)+,R5
	MOV	(SP)+,R4
	MOV	(SP)+,R0
	BGE	80$
	NEG	R2		;If negative multiplier, negate result
	NEG	R3
	SBC	R2
80$:
	TST	R1		;Check for overflow into high-order word
	BEQ	90$
	SEC
90$:	MOV	(SP)+,R1
	RETURN

.end	start

savrex.mac
	.title	SAVREX - XM Version of SAVRES
	.ident	/06.1/
;+
; Stub for SAVREX
;-
xm	= 1			;enable XM support
.include	'savres'

savini.mac
.Title	SAVINI - SAVRES Initialization
.Enable	lc,gbl
.Nlist	bex

.Ident	/07.3/
.Psect	SAVINI

.Sbttl	Macro's etc

.iif ndf debug debug = 0		;non zero for debug messages

;Type string followed by <cr><lf>

.macro	type,text
	.save
	.psect	inimes
$$$=.
	.asciz	@text@
	.restore
	.print	#$$$
.endm	type


;Type string, not followed by <cr><lf>

.macro	typen,text
	.save
	.psect	inimes
$$$=.
	.ascii	@text@ <200>
	.restore
	.print	#$$$
.endm	typen


;Type string, including control characters if desired

.macro	typex,text
	.save
	.psect	inimes
$$$=.
	.ascii	text
	.restore
	.print	#$$$
.endm	typex


;Extend string in TYPEX

.macro	tx,text
	.save
	.psect	inimes
$$$=.
	.ascii	text
	.restore
.endm	tx


;get input and provide help, if requested

;format is

;	getin	input buffer, address if help, help text(up to three)

.macro	GETIN,inbuf,hlpadd,hlptx1,hlptx2,hlptx3,prompt,?d
	.narg	args

    .if b prompt
	.gtlin	#inbuf
    .iff
	.save
	.psect	mesage
$$$=.
	.ascii	/prompt/<200>
	.restore
	.gtlin	#inbuf,#$$$
    .endc
	cmpb	inbuf,#'?
	bne	d
.iif gt args-2	.print	hlptx1
.iif gt args-3	.print	hlptx2
.iif gt args-4	.print	hlptx3
.iif gt args-5 .error	hlpadd	;too many arguments
	jmp	hlpadd
d:
.endm	getin


;Macro to tidy up help messages

.macro	x	string
.ascii	|'string'|<cr><lf>
.endm	x


	.mcall	.lookup,.enter,.print,.dstatus,.spfun
	.mcall	.readc,.writw,.readw,.writc,.exit,.fetch
	.mcall	.wait,.qset,.gtlin,.close,.ttyout,.purge
	.mcall	.settop,.sreset,.gval,.assume,.br,.serr


cr	==:	15	;Carriage return
lf	==:	12	;Line feed
bel	==:	7	;Bell
esc	==:	33	;Escape

;Timeout Value

timout	==:	-1
timval	==:	 2	;Extra 16 bits of time

;.Gval offsets

$usrlc	==:	266	;Address of normal USR area
sysver	==:	276	;System version
sysupd	==:	277	;System release level
config	==:	300	;Configuration word
confg2	==:	370	;2nd configuration word
 cache$	==:	  1	;Bit set if cache memory exists (ie 11/73 or more)

;.Dstatus Value

varsz$	==:	400	;Set if device has variable size

;Offsets within fileblock

f.dev	==:	0		;Device
f.fil1	==:	2		;Filename 1
f.fil2	==:	4		;Filename 2
f.ext	==:	6		;Extension
f.size	==:	8.		;Size
f.dtyp	==:	10.		;Device type,as returned by .dstatus
f.sizh	==:	12.		;Size, high order
.Sbttl	Initialization


savini::
	mov	sp,spsav		;Save stack pointer

	mov	@#50,absbot
	add	#2,absbot
	.settop	#-2			;set up XM PLAS
	mov	r0,endmem		;and save for later

	.gval	#area,#config
	bit	#1000,r0
	bne	10$			;USR set NOSWAP, go ahead

	.gval	#area,#$usrlc		;Start of usr area
	tst	-(r0)			;one word below it
	mov	r0,endmem		;and save for later

	.settop				;ask for all of it
10$:


START1:
	.sreset				;Release all loaded handlers
	.serr
	mov	spsav,sp		;Cleanup stack
	clr	pstat			;and program status
	mov	absbot,free		;reset first free address

	.qset	#ioque,#ioques		;Allocate extra queue entries

	call	inipas			;Initialize for new pass
	clr	begblk			;Default start block zero
	clr	begblj
	mov	#-1,endblk		;Default end block 65535
	mov	#-1,endblj		;and beyond

	clr	rewflg			;Assume rewinds before & after
	clrb	pio			;Non-physical I/O unless specified
	clrb	stream			;Not streaming unless asked
	clrb	averif			;Nor automatically verifying

	mov	#timval,timhi		;Set up high-order timer
	.gval	#area,#confg2		;Second configuration word
	.assume	cache$ eq 1
	ror	r0			;Low-order bit set have cache
	bcc	setin			;No cache therefore not 11/73	
	mov	#timval*2,timhi		;Make longer time for 11/73
.Sbttl	Set up the Input Device

.Enabl	lsb

setin:
	getin	tlinb,setin,#hinput,#hdevic,prompt=<From?  >

	tstb	tlinb
	bne	5$

	.print	#savmsg
	typex	</Disc Save and Restore Utility./<cr><lf>>
	tx	</Enter "?" if you want help at any time/<cr><lf><0>>
	br	setin
5$:
	mov	#infil,r2		;file block
	mov	#tlinb,r1		;input device

	call	rf			;Read filename
	bcs	30$

	call	swtchk			;Check for switches

	tst	(r2)			;Any device specified?
	bne	10$
	mov	#^rdk,(r2)		;Default = DK.
10$:
	tst	2(r2)			;See if filename specified
	bne	20$			;Yes.
	bis	#$noifil,pstat		;say no input file
20$:
	call	devchk			;Find out its vital stats
					;See if valid, and get its size.
	bcc	50$			;Pranged somewhere.

30$:	type	<Cannot understand "From?" response.>
40$:	.print	#hdevic
	jmp	setin


50$:
	cmpb	#6,dstblk		;floppy?
	beq	60$

	cmpb	#11,dstblk		;MT?
	beq	60$			;yes

	cmpb	#35,dstblk		;MS?
	beq	60$			;yes

	cmpb	#25,dstblk		;NL:?
	bne	70$			;no

	typex	<<cr><lf>>
	tx	</*** You may NOT Restore from the NULL Device (NL:) ***/<0>>
	jmp	setin

60$:
	bis	#$rest,pstat		;say restore
70$:

.Dsabl	lsb
.Sbttl	Set up the Output File

.Enabl	lsb

setout:
	typen	<To?	>

	getin	tlinb,20$,#houtput,#hdevic

	mov	#outfil,r2		;file block
	mov	#tlinb,r1

	call	rf			;get device (and possibly filename)
	bcs	30$			;NBG

	call	swtchk			;Check for switches

	tst	(r2)			;Any device specified?
	bne	10$
	mov	#^rdk,(r2)		;Standard default
10$:
	tst	2(r2)			;Filename?
	bne	20$
	bis	#$noofil,pstat
20$:
	call	devchk			;Get file details, load handler etc
	bcc	40$
30$:
	type	<Cannot understand "To?" response!>
	.print	#hdevic
	jmp	setin


;device is ok. Check it.

40$:	cmpb	#6,f.dtyp(r2)		;SF?
	beq	70$

50$:	cmpb	#11,f.dtyp(r2)		;MT:
	beq	70$			;yes

	cmpb	#35,f.dtyp(r2)		;MS:?
	beq	70$			;yes

	cmpb	#25,f.dtyp(r2)		;NL:?
	bne	60$			;no

	typex	<<7><cr><lf>>
	tx	</*** WARNING - NL: (Null Device) being used ***/<0>>
	br	bufset			;whether save or restore, all is well

60$:	bit	#$rest,pstat		;it is a RESTORE?
	bne	bufset			;yes - all is well

	typex	</When you are saving the information from a />
	tx	</ disc you MUST specify/<cr><lf>>
	tx	</a floppy, cartridge or magtape />
	tx	</(SF:,SC:, MT: or MS:) as the device to which/<cr><lf>>
	tx	</you are saving the information./<0>>
	br	80$

70$:	bit	#$rest,pstat		;must be save, OK?
	beq	bufset			;yes

	typex	</If you are restoring information from />
	tx	</a floppy, cartridge or magtape,/<cr><lf>>
	tx	</(SF:,SC:,MT: or MS:) you MUST/>
	tx	</ restore it to a Disc (eg DM:, DU:)/<0>>
80$:
	type	<Please try again>
	jmp	start1

.Dsabl	lsb
.Sbttl	Dynamically Set Up I/O Buffers

.Enabl	lsb

bufset:	clr	r1			;buffer counter

	tst	xmflag
	beq	10$			;not a virtual job
	mov	bottom,free		;use extended memory

10$:	mov	free,r2			;first free location
	tst	mtbuff
	bne	20$			;tape buffer exists
	mov	r2,mtbuff
	add	#512.,r2		;allocate space for it

20$:	add	#37,r2			;make sure SC: streams on PRISMS
	bic	#37,r2			;and round to 32. byte boundary

	mov	r2,bufer		;first buffer
	cmp	r2,endmem
	bhi	60$			;none at all

	mov	endmem,r3		;address of last available location
	sub	r2,r3
	add	#2,r3			;size of buffer space
	clr	r2
	mov	#bufsiz+2,r0		;Extra word at end + space per buffer
	call	div21
	mov	r3,bufers		;buffers we can use
	mov	r3,buferl
	dec	buferl			;number -1 (for any buffers left test)
	ble	60$			;not enough

	mov	bufer,r0		;find last address in buffer space
30$:	add	#bufsiz,r0
	sob	r3,30$
	sub	#2,r0

40$:	mov	r0,bufend		;end of buffers

	cmp	#2,bufers		;enough buffers?
	blt	50$			;yes

	typen	<Warning - only space for >
	mov	bufers,r0
	call	wdt
	type	< buffers!>

50$:
;buffer messages - testing only

.if ne debug

	typen	<Free: >
	mov	free,r3
	clr	r2
	call	typoct

	typen	< Top: >
	mov	endmem,r3
	clr	r2
	call	typoct

	typex	<<cr><lf>/Buffers created: /<200>>
	mov	bufers,r3
	clr	r2
	call	typnum

	typex	<<cr><lf>/Start Buffer Address:	/<200>>
	mov	bufer,r3
	clr	r2
	call	typoct

	typex	<<cr><lf>/End   Buffer Address:	/<200>>
	mov	bufend,r3
	clr	r2
	call	typoct

	typex	<<cr><lf>/Tape   Volume Buffer:  /<200>>
	mov	mtbuff,r3
	clr	r2
	call	typoct
	call	tcrlf
.endc

;allocate floppy buffers

	mov	free,r2

	mov	r2,buffra		;buffer a

	add	#flbsiz*512.,r2		;buffer b
	mov	r2,buffrb

	add	#flbsiz*512.,r2		;home block buffer
	mov	r2,blkbuf

	add	#512.,r2		;will they fit?

	cmp	r2,endmem		;end of buffer less than end of memory?
	blo	teluser			;yes

	type	<Cannot get enough buffer space for Floppy buffers>
	jmp	crash

60$:	typen	<Space only for >
	mov	bufers,r0
	call	wdt
	type	< buffers>
	jmp	crash

.Dsabl	lsb
.Sbttl	Tell the User what we are about to do

.Enabl	lsb

teluse:	bit	#$rest,pstat		;restore?
	bne	50$			;Yes

	mov	#outfil,r2		;Work out any default names
	mov	#infil,r1
	call	defnam

	clr	r5			;ensure we go to savtap

	typex	</SAVE a Disc or File (/<200>>

	mov	#infil,r2
	call	typfil

	typen	<) onto >

	mov	#outfil,r2
	clr	r0
	call	wft
	call	tcrlf
30$:
	typen	<Are You SURE [Y/N]?>

	getin	tlinb,30$,#hsave,#helno

	cmpb	#'Y,tlinb		;Yes?
	beq	40$			;yes.....
	cmpb	#'N,tlinb
	bne	30$

	jmp	start1			;no - start again

40$:	mov	#outfil,r2
	cmpb	#6,f.dtyp(r2)		;floppy?
	beq	45$
	jmp	160$			;no  - wait for tape load
45$:
.if ne debug
	call	typfls
.endc
	mov	#infil,r2		;Check that input file already exists
	call	dfchk
	jmp	flpsav			;yes - save onto floppy disc


;Restore:

50$:	mov	#infil,r2
	mov	#outfil,r1
	call	defnam

	cmpb	f.dtyp(r2),#6		;floppy?
	bne	70$			;no default filename then
	call	clrdfl			;clear any file name
70$:
	mov	#1,r5
	cmpb	#6,infil+f.dtype	;no verify on floppies
	bne	80$
	clr	r5
	br	90$

80$:	typen	<VERIFY or >

90$:	typen	<RESTORE a Disc or File (>

	mov	#outfil,r2
	call	typfil

	typen	<) from >

	mov	#infil,r2
	call	typfil
100$:
	call	tcrlf
110$:
	tstb	averif		;If autoverify, he wants both.
	bne	145$

	tst	r5
	bne	120$
	typen	<Do you wish to RESTORE ONLY? [Y/N] >
	br	130$
120$:	typen	<Do you wish to VERIFY ONLY? [Y/N] >

130$:	getin	tlinb,110$,#hrestore,#helno

	cmpb	#'Y,tlinb		;Yes?
	beq	150$			;yes....
	cmpb	#'N,tlinb
	bne	110$
	dec	r5
	bpl	100$

140$:	jmp	start1			;no start them again

145$:	typen	<Do you wish to RESTORE then VERIFY? [Y/N] >
	getin	tlinb,145$,#hrestv,#helno
	cmpb	#'Y,tlinb
	beq	146$
	cmpb	#'N,tlinb
	bne	145$
	br	140$
146$:
	cmpb	#6,f.dtyp(r2)		;floppy?
	beq	151$
	jmp	savrst			;No - go and restore.

150$:	mov	#infil,r2
	cmpb	#6,f.dtyp(r2)		;floppy?
	bne	160$			;no
151$:
.if ne debug
	call	typfls
.endc
	mov	#outfil,r2		;File must exist for floppy restore
	call	dfchk
	jmp	flpres			;floppy restore
160$:
.if ne debug
	call	typfls
.endc
	tst	r5
	beq	190$
	mov	#outfil,r2		;See that disc file exists before
	call	dfchk			; trying to verify it.
	jmp	savver
190$:
	bit	#$rest,pstat
	beq	200$
	jmp	savrst			;Restore from tape
200$:
	mov	#infil,r2		;Save from tape: see that file exists
	call	dfchk

;Code from SAVTAP (SAVSAV) put here: message is really part of initialization,
; and as a matter of pride I am trying to reduce SAVRES to 5k.  Old-fashioned?

210$:
	tstb	rewsrt		;If suppressing initial rewind, no overwrite.
	bne	230$

	typen	<Overwrite the data on the output tape (or cartridge)[Y/N]?>
	getin	tlinb,210$,#hovwr

	cmpb	#'Y,tlinb	;overwrite tape?
	beq	220$
	cmpb	#'N,tlinb
	beq	230$
	br	210$		;wait for something meaningful

220$:	bis	#$ovwrt,pstat	;say overwriting

230$:	mov	#infil,r2
	.lookup	#area,#dklun,r2
	bcc	240$
	  jmp	dfne
240$:	tstb	pio		;If physical I/O, check that we can do it.
	beq	250$
	.spfun	#area,#dklun,#sp.pio,free,#1*400,#0	;Read block zero.
	bcs	badpio
250$:	jmp	savsav

badpio:	typex	<<cr><lf>#Disc on which physical I/O is requested#>
	tx	<<cr><lf>#must be partition zero of that disc.#<0>>
	jmp	start1

.Dsabl	lsb

.if ne debug
typfls:
	mov	#infil,r2
	typen	<Input file >
	clr	r0
	call	wft
	typen	<, size >
	mov	f.size(r2),r3
	mov	f.sizh(r2),r2
	call	typnum
	typex	<<cr><lf>/Output file /<200>>
	mov	#outfil,r2
	clr	r0
	call	wft
	typen	<, size >
	mov	f.size(r2),r3
	mov	f.sizh(r2),r2
	call	typnum
	.br	tcrlf
.endc
.Sbttl	TCRLF - Type a <cr><lf>


tcrlf:	type	<>
	return


.Sbttl	DFCHK - Check for actual existence of a file

;Called with R2/fileblock pointer

dfchk:
	tst	f.sizh(r2)		;If negative, means lookup failed
	bmi	dfne
	return
dfne:
	typex	<<cr><lf>/File /<200>>
	clr	r0
	call	wft
	typex	</ does not exist./<0>>
	jmp	start1			;Try again.


.Sbttl	DEFNAM - Set up default names

;Expects	r2 / fileblock which may need default name
;		r1 / other I/O fileblock

Defnam:
	mov	r1,-(sp)
	mov	r2,-(sp)
	tst	(r1)+		;Point to filenames
	tst	(r2)+
	tst	(r2)
	bne	20$		;Already have one.
	tst	(r1)
	bne	10$		;Use name from other file
	mov	#savres,r1	;Otherwise SAVRES.FIL
10$:	mov	(r1)+,(r2)+
	mov	(r1)+,(r2)+
	mov	(r1),(r2)
20$:	mov	(sp)+,r2
	mov	(sp)+,r1
	return
.Sbttl	DEVCHK - Check device for type, parameters, load handler etc

;Provided with pointer to file block in R2

.Enabl	lsb

Devchk:
	mov	r1,-(sp)
	mov	r3,-(sp)
	mov	r5,-(sp)
.if ne debug
	typen	<Checking device chracteristics on >
	clr	r0
	call	wft
	call	tcrlf
.endc
	.dstatus #dstblk,r2	;Get status as is
	bcc	5$

	dec	(r2)		;If fail, try less RAD50/  A/
	.dstatus #dstblk,r2
	inc	(r2)		;Reset before anyone notices!
	bcs	1$		;Whoops - still an invalid device.
	cmpb	dstblk,#50	;If OK now, make sure it's a DU-type device
	beq	5$
1$:	jmp	nbg		;Otherwise kill him now.

5$:
	mov	dstblk,f.dtyp(r2) ;Save device type in fileblock itself

	mov	#valdev,r1	;Check for valid devices
10$:
	cmpb	dstblk,(r1)+	;valid?
	beq	20$		;yes
	tstb	(r1)		;end-of-table?
	bne	10$
	br	50$

;Valid device.  Try to load it

20$:	tst	dstblk+4	;loaded?
	bne	30$		;yes

	tst	xmflag
	beq	21$		;ok to load anyone
	cmpb	dstblk,#11	;MT: or SC:
	beq	25$
	cmpb	dstblk,#35	;MS:
	beq	25$

21$:
.if ne debug
	typen	<Loading Handler for >
	clr	r0
	call	wft
	call	tcrlf
.endc
	.fetch	free,r2		;load handler
	bcs	25$		;NBG

	mov	r0,free		;set up next free location
	br	30$		;and thats it

25$:	typen	<Unable to load handler for >
	clr	r0
	call	wft
	call	tcrlf
	jmp	crash

30$:
	cmpb	#6,dstblk	;floppy?  (Can't have filename)
	bne	getsiz		;no all is well

	mov	r2,r1		;get pointer
	tst	(r1)+		;point at filename-extension

	tst	(r1)+		;filename?
	bne	50$		;yes!!!
	tst	(r1)+
	bne	50$

	tst	(r1)		;extension?
	bne	50$		;bummer!
	br	getsiz
50$:
	type	<Filename not permitted with floppy discs>
60$:	jmp	nbg

.Dsabl	lsb

;valid device types

valdev:	.byte	5			;DL: (also VU)
	.byte	6			;SF:
	.byte	11			;MT:, SC:
	.byte	23			;DM:
	.byte	25			;NL: !!!!
	.byte	35			;MS:
	.byte	46			;LD: (V5 logical discs)
	.byte	50			;DU:
	.byte	0			;end of table
	.even
.Sbttl	Get File/Device Size

.Enabl	lsb

getsiz:
	clr	f.size(r2)	;Clear size to start with
	clr	f.sizh(r2)

	cmpb	dstblk,#11	;MT, SC
	beq	10$
	cmpb	dstblk,#35	;MS
	bne	20$
10$:	jmp	endsiz		;Don't get size by EMTs from MT!


20$:
	cmpb	#25,dstblk	;NL:?
	bne	25$		;no.

	mov	#77777,f.sizh(r2) ;NL: - just make it very big
	jmp	endsiz
25$:
	tst	2(r2)		;If a filename, can't be across partitions.
	bne	30$

	tstb	pio		;Nor could physical I/O be reasonable for it.
	bne	physiz

	cmpb	#50,dstblk	;See if DU for special partition work.
	beq	dusiz
30$:
	tstb	pio		;Make sure he didn't specify /P when can't
	beq	40$		; use it.
	typex	<<cr><lf>#/P can only be used with devices, not files#<0>>
	jmp	start1
40$:
	jmp	nrmsiz

.Dsabl	lsb
.Sbttl	Sizing a Physical Disc

.Enabl	lsb

physiz:
	.lookup	#area,#dklun,r2	;Need it looked up to get partition details
	clr	-(sp)		;Get room for physical device size block
	clr	-(sp)		;(clear it - note V5.4 specs on unknown
				; SPFUNs damn them!)
	.spfun	#area,#dklun,#sp.usz,sp,#2,#0,#0
	bcs	20$

	cmp	(sp),#17	;See if within SAVRES limits
	bhi	10$
	mov	(sp)+,r0
	mov	r0,f.sizh(r2)
	bis	(sp),r0
	mov	(sp)+,f.size(r2)
	tst	r0
	beq	20$
	jmp	endsiz

10$:	typex	<<cr><lf>/Sorry - device too big (/<200>>
	mov	r2,-(sp)
	mov	f.size(r2),r3
	mov	f.sizh(r2),r2
	call	typnum
	mov	(sp)+,r2
	typex	</ blocks) for SAVRES V7: /<200>>
	br	30$
20$:	typex	<<cr><lf>/Cannot get physical size of /<200>>
30$:	clr	r0
	call	wft
	jmp	start1

.Dsabl	lsb
.Sbttl	Sizing a DU Disc

.Enabl	lsb

dusiz:
.if ne debug
	type	<Sizing DU device or file>
.endc
	mov	(r2),r3		;device specification - see if "A" appended
	mov	r2,-(sp)
	clr	r2		;clear high order word
	mov	#50,r0		;radix50
	call	div21		;r0 <- r3 mod 50
	mov	(sp)+,r2
	cmp	r0,#^r  a	;check for ALL specification
	beq	10$
	jmp	nrmsiz
10$:
	sub	r0,(r2)		;make device specification legal
	inc	duseen		;Remember (only for typing device name)

	.lookup	#area,#dklun,r2	;Need it looked up to get partition details

.if ne debug
	type	<Sizing DU physical disc>
.endc
	mov	#dutabl,r1	;Assume RT <= 5.4 unless proved otherwise
	.gval	#area,#sysver	;Check version
	cmpb	r0,#5
	blo	30$		;Earlier than V5 - short DU table
	bhi	20$		;Later than V5 - long DU table
	.assume	sysupd eq sysver+1 ;Don't use odd address GVAL under RT
	swab	r0		;    or system crashes.
	cmpb	r0,#4
	blo	30$		;Earlier than 5.4
20$:	cmp	-(r1),-(r1)	;Back off for leading 2 words in table
30$:
	.spfun	#area,#dklun,#sp.dat,r1,#1,#0

	mov	#dutabl,r1	;point to returned data
	clr	r5		;current partition
40$:
.if	ne debug
	typen	<Partition >
	mov	r5,r0
	call	wdt
	typen	<: unit=>
	mov	(r1),r0
	call	wdt
	typen	<, part=>
	movb	2(r1),r0
	call	wdt
	typen	<, port=>
	movb	3(r1),r0
	call	wdt
	call	tcrlf
.endc
	cmp	(r1)+,dutabl	;MSCP unit numbers must match
	bne	80$
	cmpb	(r1)+,r5	;expected partition number
	bne	90$
	cmpb	(r1)+,dutabl+3	;MSCP port numbers must match
	bne	100$
	inc	r5		;next partition
	cmp	r5,#7
	blos	40$

.if	ne debug
	type	<Sizing partitions>
.endc
	mov	(r2),duname	;open all units
	add	#^r  0,duname
	clr	r5		;partition count
	mov	#dklun,r1
	br	60$		;first unit already opened
50$:
	.lookup	#area,r1,#duname
	bcs	110$		;what happened ?
60$:	.spfun	#area,r1,#sp.psz,#dskblk,#1,#0
	cmp	dskblk,#177777
	blo	70$
	inc	r1		;next channel
	inc	r5		;add another partition
	inc	duname		;try next unit
	cmp	r5,#7
	blos	50$		;loop until all done
	clr	dskblk		;assume it's a 262,144 kB disc

70$:	mov	r5,f.sizh(r2)
	mov	dskblk,f.size(r2)
	br	endszp


80$:	type	<More than one DU unit set>
	br	120$
90$:	type	<DU partition out of sequence>
	br	120$
100$:	type	<More than one DU port set>
	br	120$
110$:	type	<Cannot access DU handler>
120$:	jmp	start1

.Dsabl	lsb
.Sbttl	Sizing Other Discs & Files

.Enabl	lsb

Nrmsiz:
	.lookup	#area,#dklun,r2
	mov	r0,r5		;Save size in case file
	bcc	nm1		;Successful lookup
	tst	2(r2)		;See if filename
	beq	nbg		;No - that's a funny device?
.if ne debug
	type	<File yet to be created>
.endc
	mov	#-1,f.sizh(r2)	;File does not exist: set high size to -1
	br	endszp
nm1:
	tst	2(r2)		;Filename specified?
	beq	devsiz		;No  - get device size
	mov	r5,dstblk+6	;Yes - use size from lookup
	br	dsiz1
devsiz:
	.spfun	#area,#dklun,#sp.psz,#dstblk+6,#1,#0 ;If err use orig dstblk+6
dsiz1:
	mov	dstblk+6,f.size(r2)
Endszp:
	.purge	#dklun
	.close	#dklun		;Just in case ...

Endsiz:
.if	ne debug
	typen	<Disc sized: >
	mov	r2,-(sp)
	mov	f.size(r2),r3
	mov	f.sizh(r2),r2
	call	typnum
	mov	(sp)+,r2
	type	< blocks>
.endc
	.purge	#dklun
	.close	#dklun		;Just in case ...

	tst	(pc)+
nbg:	sec
	mov	(sp)+,r5
	mov	(sp)+,r3
	mov	(sp)+,r1
	return

.Dsabl	lsb
.Sbttl	Switch Interpretation

.Enabl	lsb

swtchk:				;Entered with r1/pointer to string
	tstb	(r1)
	bne	10$
	  return
10$:	cmpb	(r1),#'/	;Must be preceded by "/"
	bne	90$
	inc	r1
	movb	(r1)+,r0
	cmpb	r0,#'z
	bhi	20$
	cmpb	r0,#'a
	blo	20$
	sub	#'a-'A,r0
20$:
	cmpb	r0,#'N		;/N - no rewinds
	bne	30$
	mov	#-1,rewflg
	br	swtchk
30$:
	cmpb	r0,#'S		;/S - rewind at start only
	bne	40$
	movb	#-1,rewend
	br	swtchk
40$:
	cmpb	r0,#'E		;/E - rewind at end only
	bne	50$
	movb	#-1,rewsrt
	br	swtchk
50$:
	cmpb	r0,#'P		;/P - physical I/O
	bne	60$
	movb	#-1,pio
	br	swtchk
60$:
	cmpb	r0,#'F		;/F - fast streaming (use SPFUN -9)
	bne	70$
	movb	#1,stream
	br	swtchk
70$:
	cmpb	r0,#'V		;/V - allow automatic verification
	bne	80$		;	(provided only 1 volume used)
	movb	#1,averif
	br	swtchk
80$:
	cmpb	r0,#'R		;/R - rewind and exit
	beq	rew
	cmpb	r0,#'U		;/U - unload and exit
	beq	unl

	cmpb	r0,#'?		;/? - type switch list
	beq	100$

;Note - no checking for multiple/incompatible switches as yet.

	mov	r0,-(sp)
	typen	<Illegal switch />
	.ttyou	(sp)+
	call	tcrlf
	br	100$
90$:
	typen	<Unrecognizable switch string: >
	.print	r1
100$:	.print	#hswit
	jmp	start1

.Dsabl	lsb

rew:	mov	#sp.rew,r5	;Rewind
	br	ru
unl:	mov	#sp.unl,r5	;Rewind and unload
ru:
	clr	f.fil1(r2)	;R2 points to fileblock.
	clr	f.fil2(r2)
	clr	f.ext(r2)
	.fetch	free,r2
	bcs	nofet
	mov	r2,free
	.lookup	#area,#mtlun,r2,#-1
	bcs	norew
	.spfun	#area,#mtlun,r5,#0,#0,#0
	bcs	norew
	.close	#mtlun
	bcs	norew
	.exit

nofet:	typex	<<cr><lf>#Cannot fetch handler for #<200>>
	br	nt
norew:	typex	<<cr><lf>#Error trying to rewind #<200>>
nt:	clr	r0
	call	wft
	.exit
.Sbttl	Data Areas

;DU partition table

duname::.word	0,0,0,0

dutabx::.blkw	2		;Required if RT 5.4 or later monitor
dutabl::.blkw	16.



absbot:	.word	0		;first free low memory address

.Sbttl	Help Text

.psect	inimes

hinput:
x
x <Type the name of the device or file to read data from.>
	.byte	0

houtpu:	x
x <Type the name of the device or file to write data to.>
	.byte	0

hdevic:
x <Valid ones are:>
x
x <DM0:-DM7:, DU0:-DU7:	Discs of various flavours>
x
x <SC:			Cartridge tape>
x <MS:			Magnetic tape>
x <MT0:			Another mag tape (slow)>
x <MT4:			ibid, (fast)>
x <DY:, SF:		Floppy discs>
x
x <A filename may be supplied to (or from) any device except floppy discs.>
x <If none is specified for either input or output, SAVRES.FIL will be used.>
x <For help concerning switches, type "/?".>
	.byte	0

hsave:	x
x <If you enter "Y" SAVRES will SAVE all the data from the disc or file you>
x <specified to "From?", onto the device you specified to "To?".  You may use>
x <a filename, if you want your saved data to have a filename other than>
x <the disc file name (or, if none, SAVRES.FIL).>
x
x <You should ensure that there is enough room on the tape.  To delete all>
x <data on a tape, initialize it before use; alternatively answer "Yes" to>
x <the later "Overwrite" question.  Otherwise your data will create a file>
x <on the tape following the data already there.>
x
x <Tapes are initialized by "INIT MT4:" or "INIT MS1:"; cartridges>
x <by "R SCINIT".>
	.byte	0

hrestore:
x <If you enter "Y" SAVRES will ask if you wish to>
x <	RESTORE data from tape to disc, or>
x <	VERIFY data comparing tape and disc.>
x <For data saved on tape using a filename other than the default, you must>
x <specify that name, as well as the device, to enable that data to be found.>
	.byte	0

hrestv:
x <If you enter "Y" SAVRES will restore all the data from the tape to the>
x <disc you specified.  After this it will rewind the tape and verify the>
x <restored image, provided the data fits within one volume of the tape.>
	.byte 0


helno:					;(we won't go)
x
x <If you enter anything other than "Y" or "YES" the computer>
x <will ask you all the questions again>
	.byte	0

hovwr:	x
x <If you answer "Y" any data on the output tape will be OVERWRITTEN.  If you>
x <answer "N" the saved data from the disc will be added at the end of any>
x <files already on the tape (if there is room!).>
x
x <However, answering "Y" and overwriting a cartridge (SC:) means that>
x <you will not be able to add information to the end of that cartridge.>
	.byte	0

hswit:	x
x <Switches for SAVRES are:>
x <	/N allowing no rewinds,>
x <	/S allowing rewinds only at the start,>
x <	/E allowing rewinds only at the end;>
x <	/V verify after save/restore without asking the user>
x <		(only if one volume only used)>
x <	/P use physical I/O spfuns to access whole physical disc>
x
x <	/R rewind the tape with no transfer of data, and>
x <	/U unload, ibid.>
x
x <	/F set MS: magnetic tape to fast streaming mode.>
	.byte 0

.end

savsav.mac
;Prefix file for SAVRES component SAVTAP, to generate SAVSAV.OBJ

..save=1	;Generate code for saving disc onto tape

savrst.mac
;Prefix file for SAVRES component SAVTAP, to generate SAVRST.OBJ

..rest=1	;Generate code for restoring from tape to disc

savver.mac
;Prefix file for SAVRES component SAVTAP, to generate SAVVER.OBJ

..veri=1	;Generate code for verifying tape against disc

savtap.mac
.TITLE	SAVTAP - SAVRES tape and cartridge handler
.Enable	lc,gbl
.Nlist	bex

.Ident	/07.3b/
.Psect	SAVTAP

.Sbttl	Tape (magtape and cartridge) overlay routines

.iif ndf debug debug =	0		;non zero, debug messages

;This programme may be assembled with conditionals in four flavours:
; no conditionals defined - single overlay for saving, restoring, & verifying
; ..save=1	assemble code for saving onto tape
; ..rest=1	assemble code for restoring from tape
; ..veri=1	assemble code for verifying tape

.iif ndf ..save, ..save=0
.iif ndf ..rest, ..rest=0
.iif ndf ..veri, ..veri=0

.if eq <..save ! ..rest ! ..veri>	;If none defined, define the lot
	..save=1
	..rest=1
	..veri=1
.endc


.Sbttl	Macros etc

;Note change in these macros formats.  When the macro-defined label number
;reached 30014: they blew up and I don't know why.  Changing to "$$$" format
;let them work!

;Type a string, with a <cr><lf> appended

	.macro	type text
	.save
	.psect	tapmsg,d
$$$=.
	.asciz	|text|
	.restore
	.print	#$$$
	.endm	type

;Type a string with no <cr><lf> appended

	.macro	typen text
	.save
	.psect	tapmsg,d
$$$=.
	.ascii	|text|<200>
	.restore
	.print	#$$$
	.endm	typen


;Type a string, with embedded control characters

	.macro	typex text
	.save
	.psect	tapmsg,d
$$$=.
	.ascii	text
	.restore
	.print	#$$$
	.endm	typex

;Extend the string in the TYPEX macro

	.macro	tx text
	.save
	.psect	tapmsg,d
	.ascii	text
	.restore
	.endm	tx


;GETIN - Get input and provide help, if requested

; Format:
;	getin	input buffer, address if help, help text(up to three)

	.macro	GETIN,inbuf,hlpadd,hlptx1,hlptx2,hlptx3,?d
	.narg	args

	.gtlin	#inbuf

	cmpb	inbuf,#'?
	bne	d
.iif gt args-2	.print	hlptx1
.iif gt args-3	.print	hlptx2
.iif gt args-4	.print	hlptx3
.iif gt args-5 .error	hlpadd	;too many arguments
	jmp	hlpadd
d:
	.endm	getin

;Macro to tidy up help messages

.macro	x	string
.ascii	|'string'|<cr><lf>
.endm	x

cr	==:	15
lf	==:	12
esc	==:	33
dollar	==:	'$


;Values in Status Word in Buffer Header

;High byte:
b..emp	==:	-1	;Empty
b..que	==:	 0	;Queued
b..ful	==:	 1	;Full

;Low byte:	If empty or full
b..ok	==:	 0	;OK
b..err	==:	-1	;Error
b..eof	==:	 1	;EOF
;		If queued
b..qds	==:	 1	;Queued for disc
b..qmt	==:	-1	;Queued for tape



.Mcall	.lookup,.enter,.print,.spfun,.readc,.writc,.exit,.readw,.writw
.Mcall	.wait,.gtlin,.close,.ttyout,.date,.gtim,.purge,.assume,.br,.ttyin


; Buffer status descriptor.
;	See appropriate routine for status description.

; Each buffer is allocated one status descriptor. These descriptors are linked
; into a ring to allow them allowing the next or previous descriptor to be
; located quickly.

b.stat	==: 0			;status
b.next	==: 2			;next descriptor
b.last	==: 4			;previous descriptor
b.buf	==: 6			;address of this buffer
b.lun	==: 10			;logical unit number (channel)
b.blk	==: 12			;block number, low order
b.blkh	==: 14			;block number, high order
b.blks	==: 16			;number of blocks in this buffer
b.dcrt	==: 20			;disc completion routine address
b.tcrt	==: 22			;tape completion routine address
b.tblk	==: 24	; * 2 words *	;tape BLOCK buffer for error returns

b.size	==: 30			;size of descriptor

;CSW flags

hderr$	==: 1			;Hard Error
eof$	==: 20000		;End of file
.Sbttl	SAVING - Initialization

.Enable	lsb

.if ne ..save

savsav::				;Save

; Allocate the descriptors for the tape buffers and link them into a ring.

10$:	mov	bufer,r2	;Area where buffers themselves will go
	mov	#descrp,r1	;Address of first buffer header
	mov	r1,tp		;Both disc and tape pointers point to
	mov	r1,dp		; first buffer header.

	mov	bufers,r0	;Number of available buffers

	mov	#dcrrtb,r5	;Disc read completion routine table
	mov	#tcrwtb,r4	;Tape write, ibid

20$:	mov	r2,b.buf(r1)	;set up descriptor
	mov	r1,b.next(r1)
	mov	r1,b.last(r1)

	mov	(r5)+,b.dcrt(r1)
	mov	(r4)+,b.tcrt(r1)

	sub	#b.size,b.last(r1)
	add	#b.size,b.next(r1)
	mov	#< <b..emp * 400> + <b..ok&377> >,b.stat(r1) ;buffer is free
	add	#b.size,r1	;next descriptor
	add	#<blkfac*512.>,r2
30$:	sob	r0,20$		;do all

	mov	#descrp,b.next-b.size(r1) ;ring buffer
	sub	#b.size,r1
	mov	r1,descrp+b.last

	mov	tp,r1		;Now set up buffer header addresses in
	mov	#dbhrtb,r2	; completion routine tables
	mov	#tbhwtb,r3
35$:	mov	r1,(r2)+
	mov	r1,(r3)+
	mov	b.next(r1),r1
	cmp	r1,tp
	bne	35$

.if ne	debug
	call	dmpbfr
.endc
	.date
	mov	r0,mtdate	;record date
	.gtim	#area,#mttime	;record time
	clr	mtflag		;Keeps track of MT error/eof
	clr	mtqued		;Number of MT records queued
	clr	mtblok		;MT buffer count (if zeroed, surely BEGBLK/
				; BLKMON must start at zero?)
	clr	problk		;Count of buffers processed
	mov	#blkmf,blkmon	;Initialize block monitoring
	clr	blkmom
40$:
	mov	#1,volnum	;next volume number
	cmpb	#25,outfil+f.dtyp
	beq	70$		;don't need next volume for null device
	bis	#$mtvol,pstat	;need first volume
70$:
	mov	#infil,r2
	call	dsksiz		;Get disc size

	mov	remain,bfrem	;plus words left over
	beq	90$		;division was nice
	inc	recs		;number of records for tape IO
90$:	mov	recs,bfrec	;records required for disc

	mov	dp,r1
	mov	begblk,b.blk(r1) ;Initalize disc block
	mov	begblj,b.blkh(r1)
	mov	#dklun,b.lun(r1)
	add	begblj,b.lun(r1)

.Dsabl	lsb
.Sbttl	.	Actual Saving

.Enabl	lsb

; Get next MT volume and synchronize buffers

10$:	call	wvol

; Set up timer

15$:	mov	#timout,timstn	;Initialize Timeout value
	mov	timhi,timsto	; and other 16 bits

; Check for timeout. Warn user if tape is slow.

20$:	dec	timstn		;Timed out waiting?
	bne	30$		;No
	dec	timsto		;The other 16 bits
	bne	30$		;No
	mov	timhi,timsto	;Reload

	typex	<<cr><lf>/Warning - the tape is running slowly./<0>>
30$:

;At the start, all the buffers are queued for the disc.  When one is full,
; queue it to the tape.  When it has been emptied (so to speak) re-queue
; it to the disc.

40$:	mov	dp,r1
	tstb	b.stat+1(r1)	;Check the next disc buffer
	ble	60$		;Either queued or empty

	.assume	b.stat eq 0	;Full disc buffer - send to tape if ok.
	.assume	b..ok eq 0
	tstb	(r1)
	beq	50$
	call	dskerr		;See if he allows disc error
50$:
	call	qwmtx		;Once it's read, queue it for tape
	mov	b.next(r1),dp	;Look for next disc buffer next time.
	br	30$

60$:
	mov	tp,r1		;Now look at tape buffers
	tstb	b.stat+1(r1)
	bpl	20$		;Either queued or full.

	.assume	b.stat eq 0	;Empty buffer available for disc.
	.assume b..ok  eq 0
	.assume	b..eof eq 1
	tstb	(r1)
	beq	80$
	bpl	10$		;New tape required
	.iif ne debug, call dmpbfr
	jmp	taperr
80$:
	mov	b.next(r1),tp	;Point to next buffer

	inc	problk		;Another bufferload successfully dispatched

	call	qrdsk		;If OK, re-queue it for disc.
	bcs	110$		;None left.
	mov	b.blk(r1),r3	;Get block monitoring info
	mov	b.blkh(r1),r2


; Go round and round until we've finished.

90$:	cmp	r2,blkmom
	blo	110$
	bhi	100$
	cmp	r3,blkmon
	blo	110$
100$:	call	typblk		;show what we're doing

110$:
	cmp	problk,recs	;All done?
	blo	15$		;No.

;End of I/O

.iif ne debug,	call dmpbfr
				;Wait for i/o to finish.
	call	tcrlf
	.wait	#mtlun
120$:
	mov	dskblk,r3	;Get number of blocks
	mov	dskblj,r2
	call	typnum
	type	< Blocks Transferred to Tape>

	bit	#$ovwrt,pstat	;do we have to write our own trailer labels
	beq	130$		;no

	clr	r1
	call	wreof		;yes - write them
130$:	call	close

	mov	#infil,r1
	mov	#outfil,r2
	call	tcrlf

	tstb	averif		;Auto-verifying takes precedence over others.
	beq	145$

	cmp	volnum,#2	;Make sure only used one volume
	blos	148$		;If so, rewind and off we go.

145$:
	tstb	rewend		;Suppressing trailing rewinds?
	bne	230$		;Yes - don't ask about verifying either.
146$:
	typen	<Verify the disc image? [Y/N] >
	getin	tlinb,146$,#verpas
	cmpb	tlinb,#'N
	beq	180$
	cmpb	tlinb,#'Y
	bne	146$
148$:
	mov	#flblen,r0
150$:	mov	(r1),r3		;swap names for verification
	mov	(r2),(r1)+
	mov	r3,(r2)+
	sob	r0,150$
	mov	#infil,r2
	call	savnam
	mov	#infil,r2
.if ne debug
	typen	<Verify from >
	clr	r0
	call	wft
	typen	< to >
	mov	#outfil,r2
	clr	r0
	call	wft
	call	tcrlf
	mov	#infil,r2
.endc
	cmp	volnum,#2
	bhi	160$

	mov	#rewind,r0	;first volume in drive, just rewind it
	call	rewofl
	br	170$

160$:	mov	#rwtape,r0	;unload the current volume
	call	rewofl

170$:	call	resnam		;restore the device name
	tstb	averif
	bne	175$
	jmp	savver		;verify the thing
175$:	jmp	versav		;same, but tell him where we're at

180$:	bit	#$ovwrt,pstat	;force unload if we're overwriting
	bne	200$
	call	tcrlf
190$:	typen	<Unload the tape? [Y/N] >
	getin	tlinb,190$,#tapunl
	cmpb	tlinb,#'N
	beq	210$
	cmpb	tlinb,#'Y
	bne	190$

200$:	mov	#rwtape,r0
	br	220$

210$:	mov	#rewind,r0
220$:	call	rewofl		;rewind and off-line tape
230$:	jmp	succes

.Dsabl	lsb

.endc				; if ne ..save
.Sbttl	Restore - Preliminaries

.if ne ..rest

savrst::

; Allocate the descriptors for the tape buffers and link them into a ring.

10$:	mov	bufer,r2	;Address for buffers to start
	mov	#descrp,r1	;first buffer header
	mov	r1,tp		;Both tape and disc pointers point to
	mov	r1,dp		; first buffer.

	mov	bufers,r0	;Number of available buffers

	mov	#tcrrtb,r5	;Tape read completion routine address table
	mov	#dcrwtb,r4	;Disc write, ibid

20$:	mov	r2,b.buf(r1)	;set up descriptor
	mov	r1,b.next(r1)
	mov	r1,b.last(r1)

	mov	(r5)+,b.tcrt(r1) ;Completion routine addresses
	mov	(r4)+,b.dcrt(r1)

	sub	#b.size,b.last(r1)
	add	#b.size,b.next(r1)
	mov	#< <b..emp * 400> + <b..ok&377> >,b.stat(r1) ;buffer is free
	add	#b.size,r1	;next descriptor
	add	#<blkfac*512.>,r2
30$:	sob	r0,20$		;do all

	mov	#descrp,b.next-b.size(r1) ;ring buffer
	sub	#b.size,r1
	mov	r1,descrp+b.last
	clr	mtflag		;Flag to keep eye on MT EOF/error
	clr	mtblok		;Count of successful MT I/O
	clr	mtqued		;Count of MT records queued

	mov	tp,r1		;Now set up buffer header addresses in
	mov	#tbhrtb,r2	; completion routine tables
	mov	#dbhwtb,r3
35$:	mov	r1,(r2)+
	mov	r1,(r3)+
	mov	b.next(r1),r1
	cmp	r1,tp
	bne	35$

.if ne	debug
	call	dmpbfr
.endc
	mov	#resmsg,vrmsg		;Restoring
	add	#blkmf,blkmon		;Initialize block monitor
	clr	blkmom

	mov	#outfil,r2
	tst	f.sizh(r2)		;File yet to be created?
	bmi	50$			;Yes - do that later.

	.lookup	#area,#dklun,#outfil,#0
	bcc	50$
	jmp	errfnf			;Lookup error

50$:	call	dsksiz			;Get size of output disc

	mov	remain,bfrem		;plus words left over
	beq	60$			;division was nice
	inc	recs			;number of records for tape IO
60$:	mov	recs,bfrec		;records required for disc

	mov	#1,volnum		;first volume
	bis	#$mtvol,pstat		;get it when necessary

	mov	dp,r1
	mov	#dklun,b.lun(r1)

.Dsabl	lsb
.Sbttl	.	Actual Restoring

.Enabl	lsb


;At the start all the buffers are queued to the tape.  When one becomes full,
; queue it to the disc.  When it is thereby "emptied", re-queue it to the
; tape.

10$:
	call	rvol		;Gets next tape.
	mov	mtblok,problk	;Number of bufferfuls thus far processed
	mov	tp,r1		;Synchronize buffers.
	mov	r1,dp
	call	qrmta		;Queue all buffers to tape
20$:
	mov	tp,r1		;Check next tape buffer
	.assume	b..ful eq 1
	tstb	b.stat+1(r1)
	ble	40$		;Either queued or empty

	.assume	b.stat eq 0	;Buffer full from tape - send to disc if ok.
	.assume	b..eof eq 1
	.assume	b..err eq -1
	tstb	(r1)		;Check for error or EOF
	beq	30$		;OK
	bpl	10$		;EOF -> next tape
	.iif ne debug, call dmpbfr
	jmp	taperr
30$:
	mov	b.next(r1),tp	;Advance to next buffer
	call	qwdskx		;Re-queue this one for the disc
	br	20$		;Check out next buffer

40$:
	mov	dp,r1		;Check the next disc buffer
	.assume	b..emp eq -1
	tstb	b.stat+1(r1)
	bpl	20$		;Either queued or full

	.assume	b.stat eq 0	;Empty buffer - re-fill from tape if ok.
	.assume	b..eof eq 1
	.assume	b..err eq -1
	tstb	(r1)		;Look for errors
	beq	45$		;OK
	call	dskerr		;Whoops - see if he'll allow it.
45$:
	inc	problk		;Another bufferload successfully done.

	mov	b.next(r1),dp	;Advance to next buffer

	call	qrmt		;Re-queue to read from MT
	bcs	70$		;If none left, just use those left.
	mov	b.blk(r1),r3	;Get block monitoring information
	mov	b.blkh(r1),r2


; Round until we've finished.

50$:	cmp	r2,blkmom
	blo	70$
	bhi	60$
	cmp	r3,blkmon
	blo	70$
60$:	call	typblk		;show where we're at
70$:
	cmp	problk,recs	;See if all done.
	blo	20$

.iif ne debug,	call	dmpbfr


;End of restoration (for further details, consult history books ...)

80$:	call	tcrlf
	mov	dskblk,r3	;Get number of blocks
	mov	dskblj,r2
	call	typnum
	type	< Blocks Transferred to Disc>

.if	ne,debug
	typen	< Remainder = >
	mov	remain,r3
	clr	r2
	call	typnum
.endc
	call	close

	tstb	averif		;Want to auto-verify?
	beq	85$
	cmpb	volnum,#2	;Must only have used 1 volume
	bhi	85$
	mov	#infil,r2	;tape filename block address
	mov	#rewind,r0
	call	rewofl		;rewind tape
	jmp	versav

85$:
	tstb	rewend		;Want trailing rewinds?
	bne	90$		;No.
	mov	#infil,r2	;tape filename block address
	mov	#rwtape,r0
	call	rewofl		;rewind and offline tape
90$:
	jmp	succes

.Dsabl	lsb

.endc				; if ne ..rest

.Sbttl	Verification - Preliminaries

.if ne ..veri

.Enabl	lsb

versav::
	type	<Verifying ...>
savver::
	mov	#vermsg,vrmsg	;verifying
	mov	bufers,r0
	cmp	r0,#2		;require at least two buffers
	bhis	80$
	typex	<<cr><lf>#Insufficient buffers available for verification#>
	tx	<<0>>
	jmp	errext

; It is not possible to verify the null device although it is possible to
; restore to the null device, thus references to the null device are trapped
; here.

80$:	cmpb	#25,outfil+f.dtyp
	bne	90$
	typex	<<cr><lf>#Cannot verify null device#<0>>
	jmp	errext

; Allocate the descriptors for the tape buffers and link them into a ring.

90$:	mov	#descrp,r0
	mov	r0,tp		;Pointer to first buffer header
	mov	bufer,r2

	mov	#tbhrtb,r3	;Table of buffer headers
	mov	#tcrrtb,r4	;Table of tape read completion routines

	mov	r2,d$buf	;allocate first buffer for disc
	mov	#<descrp-b.size>,r1 ;first buffer descriptor
	mov	#dh1,dp		;If one buffer, this is only header
	mov	#dh1,d$next	;If 1 buf, NEXT pointer points to self
	mov	#dh1,d$last	;LAST, ibid
	mov	bufers,r0	;Number of buffers
	cmp	r0,#4		;See if sufficient room for 2 disc bufs
	blo	110$		;Sorry - dipped out there.

	mov	#dh2,d$next	;TWO BUFFERS - set up link
	mov	#dh2,d$last
	add	#<blkfac*512.>,r2
	mov	r0,(r2)+	;End-of-buffer word
	dec	r0		;One fewer buffers for tape
	mov	r2,dh2+b.buf	;Address of the second buffer
	br	110$

100$:	add	#b.size,r1	;next descriptor
	add	#<blkfac*512.>,r2
	mov	r0,(r2)+	;Add unique word at end of buffer
	mov	r1,(r3)+	;Add header to table of headers
	mov	r2,b.buf(r1)	;set up descriptor
	mov	r1,b.next(r1)
	mov	r1,b.last(r1)
	mov	(r4)+,b.tcrt(r1);Put relevant completion routine addr in
	sub	#b.size,b.last(r1)
	add	#b.size,b.next(r1)
110$:	sob	r0,100$		;do all
	mov	#descrp,b.next(r1) ;ring buffer
	mov	r1,descrp+b.last

	mov	#dcrv1,dh1+b.dcrt ;Set up disc completion routine addresses
	mov	#dcrv2,dh2+b.dcrt
.if ne	debug
	call	dmpbfr
.endc
	mov	dp,r1		;Now set up disc buffer header addresses in
	mov	#dbhrtb,r2	; completion routine table
35$:	mov	r1,(r2)+
	mov	b.next(r1),r1
	cmp	r1,dp
	bne	35$

	mov	tp,r1		;Now set up tape buffer header addresses in
	mov	#tbhrtb,r2	; completion routine table
36$:	mov	r1,(r2)+
	mov	b.next(r1),r1
	cmp	r1,tp
	bne	36$

	clr	b.blk(r1)	;Make tape blocks start at zero
	clr	b.blkh(r1)

; Set up the rest of the variables for the verificaton.

	mov	#outfil,r2
	.lookup	#area,#dklun,r2
	bcc	120$
	jmp	errfnf		;oops

120$:	call	dsksiz		;size disc
	mov	remain,bfrem	;records on disc with remainder to allow for.
	beq	130$
	inc	recs		;records on tape
130$:	mov	recs,bfrec	;records on disc

	mov	#blkmf,blkmon	;Initialize block monitor
	clr	blkmom
	clr	d$blk		;block to access
	clr	d$blkh
	mov	#blkfac,d$blks	;Number of blocks in buffer
	mov	#dklun,d$lun
	mov	#1,volnum	;first volume desired
	mov	#$mtvol,pstat
	clr	tblock
	clr	mtflag		;Keeps track of MT eof/errors
	clr	mtblok		;Count of successful MT transfers
	clr	mtqued		;Count of MT requests queued
140$:
	.br	vergo

.Dsabl	lsb
.Sbttl	.	Actual Verification

.Enabl	lsb

vergo:
	call	rvol		;Get new tape
	mov	mtblok,problk	;Number of bufferloads successfully processed
	mov	tp,r1
	mov	dp,r2
	mov	b.blk(r1),b.blk(r2) ;Set initial block numbers from tape
	mov	b.blkh(r1),b.blkh(r2)
	call	qrmta		;Queue all MT buffers for reading
	mov	r2,r1
	call	qrdska		;ibid, disc
verify:
	.assume	b.stat eq 0
	mov	dp,r1		;check disc
	tstb	b.stat+1(r1)	;High byte: -1 empty, 0 queued, 1 full
	.assume	b..ful eq 1	;(make sure of this!)
	.assume	b..que eq 0
	bgt	10$		;could be promising
	beq	verify		;no good: let's wait
				;[Only get here with very small files]
	call	qrdsk		; Buffer is empty: go and fill it.
	br	verify


; Get here when next disc buffer is ready for verification

10$:	mov	tp,r5		;Current tape buffer header
	tstb	b.stat+1(r5)
	.assume	b..ful eq 1
	ble	verify		;not ready

	.assume b.stat eq 0	;Check for EOF or error
	.assume	b..ok  eq 0
	.assume	b..eof eq 1
	.assume	b..err eq -1
	tstb	(r5)
	beq	20$		;OK
	bpl	vergo		;EOF - get next volume

	.iif ne debug, call dmpbfr
	jmp	taperr		;Tape error
20$:
	mov	dp,r1		;Pointer to buffer header
	tstb	b.stat+1(r1)	;See if ready
	.assume	b..ful eq 1
	ble	verify
	.assume	b.stat eq 0
	.assume	b..eof eq 1
	.assume	b..err eq -1
	tstb	(r1)
	beq	30$		;No errors
	call	dskerr		;Whoops - see if tolerable or not.
30$:
	mov	b.buf(r1),r2	;Address of disc buffer
	mov	b.blks(r1),r0	;Blocks in buffer - convert to
	swab	r0		;words to compare

	mov	b.buf(r5),r1	;Tape address

	mov	r1,r3		;Hold initial buffer address
40$:	cmp	(r1)+,(r2)+	;Attempt to speed comparison
	beq	40$
	mov	r0,-(sp)
	mov	r1,-(sp)
	sub	r3,r1		;When hit error, see if end of buffer
	asr	r1
	dec	r1
	cmp	r0,r1
	blos	50$		;OK - it's at the end.
	mov	r1,r0		;Whoops! Give him where it pranged.
	mov	(sp)+,r1
	br	100$
50$:
	mov	(sp)+,r1
	mov	(sp)+,r0
60$:
	inc	problk		;Another bufferful bites the dust
	cmp	problk,recs	;See if all done.
	blo	65$
	jmp	150$		;All done.
65$:
	mov	tp,r1		;Queue next tape buffer
	mov	b.next(r1),tp
	call	qrmt

	mov	dp,r1
	mov	b.next(r1),dp	;Move to next buffer, queueing one used.
	mov	b.blk(r1),r3	;Save monitoring information
	mov	b.blkh(r1),r2
	call	qrdsk
	bcs	90$		;None to go.  Ignore block monitoring
70$:
	cmp	blkmom,r2	;Check out monitoring here.
	bhi	90$		;definitely not yet time to display
	blo	80$		;definitely time to display
	cmp	blkmon,r3
	bhi	90$		;not yet
80$:	call	typblk
90$:
	cmp	problk,recs	;See if all done
	blo	verify
	jmp	150$		;All done
.Sbttl	.	Comparison Error Detected on Verify

100$:				;(Entered with old R0 already on stack)
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)

	mov	dp,r1
	mov	b.blk(r1),r3	;block indicates next block
	mov	b.blkh(r1),r2

;R0 contains distance error occurred from start of buffer
	clr	r4		;Word # offset in block
	bisb	r0,r4
	bicb	r0,r0		;Block # offset
	swab	r0
	add	r0,r3		;Block # itself
	adc	r2

	typen	<Comparison error at block >
	call	typnum
	clr	r2
	mov	r4,r3		;(Re-vamp arithmetic for V7)
	typen	< word >
	call	typnum
	mov	2(sp),r2
	mov	-(r2),r3
	clr	r2
	typen	<.  Disc = >
	call	typoct
	mov	4(sp),r2
	mov	-(r2),r3
	clr	r2
	typen	<,  Tape = >
	call	typoct
	call	tcrlf
	inc	comerl
	bne	140$
	inc	comerh
140$:
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r1

	mov	#256.,r0		;Readjust pointers to start of next
	sub	r4,r0			; block within buffer
	asl	r0			; (256-word no) * 2
	add	r0,r1			;Tape
	add	r0,r2			;Disc

	mov	(sp)+,r0
	jmp	40$
.Sbttl	.	End of Verification

150$:
	call	tcrlf
	call	close

	tstb	rewend		;Want trailing rewind?
	bne	155$		;No.

	mov	#infil,r2	;rewind tape for user
	mov	#rwtape,r0
	call	rewofl
155$:
	mov	comerl,r3
	mov	comerh,r2
	mov	r2,r4
	bis	r3,r4
	bne	160$
	typen	<No errors in >
	br	170$
160$:
	typen	<Number of blocks with comparison errors detected: >
	call	typnum
	call	tcrlf
170$:	mov	dskblj,r2
	mov	dskblk,r3	;say what we did
	call	typnum
	type	< blocks compared.>

	tst	r4
	bne	180$
	jmp	succes
180$:	jmp	crash

	.psect	tapdat
comerl:	.word	0		;comparison error count
comerh:	.word	0
	.psect	savtap

.Dsabl	lsb

.endc				; if ne ..veri
.Sbttl	Ring Buffer Dump (if DEBUG <> 0)

.if	ne debug

dmpbfr:	mov	r5,-(sp)		;save temporary
	mov	r4,-(sp)
	mov	r3,-(sp)
	mov	r2,-(sp)
	mov	r1,-(sp)
	mov	r0,-(sp)

	type	<Disc Buffer Header Dump:>
	mov	dp,r5
	call	dmpring

	type	<Tape Buffer Header Dump:>
	mov	tp,r5
	call	dmpring

	mov	(sp)+,r0
	mov	(sp)+,r1
	mov	(sp)+,r2
	mov	(sp)+,r3
	mov	(sp)+,r4
	mov	(sp)+,r5
	return

dmpring:
	mov	r5,r4
	type	<Addr	Stat	Buff	Lun	Blk	Siz>
	clr	r2
dmpr0:	mov	r4,r3		;Address of current header
	call	typntb
	mov	r4,r1
	mov	(r1)+,r3	;Status
	call	typntb
	cmp	(r1)+,(r1)+	;Skip NEXT and LAST
	mov	(r1)+,r3	;Buffer address
	call	typntb
	mov	(r1)+,r3	;LUN
	call	typntb
	mov	(r1)+,r3	;Low-order block
	mov	(r1)+,r2	;High order
	call	typnum		;(decimal for this one)
	call	typtab
	clr	r2
	mov	(r1)+,r3	;Size of this buffer
	call	typoct
	call	tcrlf
	mov	b.next(r4),r4
	cmp	r4,r5
	bne	dmpr0
	return

typntb:	call	typoct
typtab:	.ttyou	#tab
	return
.endc
.Sbttl	New Output Tape

.if ne ..save

.Enabl	lsb

; Prompt the user for and obtain new output volume.  Tape I/O is re-queued
; by this routine.


WVOL:
	.wait	#mtlun
	clr	mtflag		;Reset EOF/error flag

	bit	#$death,pstat
	beq	10$
	jmp	crash
10$:
	cmp	volnum,#1
	beq	40$		;first volume, none prior to this
	bit	#$ovwrt,pstat
	beq	30$		;file structured
	clr	r1
	call	wreof
30$:
	.close	#mtlun
	mov	#outfil,r2
	call	savnam
	mov	#outfil,r2
	mov	#rwtape,r0
	call	rewofl		;rewind current
	call	resnam
	br	45$

40$:
	tstb	averif		;If doing autoverify, and vol 1, don't
	bne	50$		; ask for bloody tape.
45$:
	typen	<Mount volume >
	mov	volnum,r0
	call	wdt
	typen	< in >
	mov	outfil,r0
	call	w50t
	typen	<: and type the RETURN key to continue.>
	getin	tlinb,40$,#hload

50$:	mov	#outfil,r2
	call	taplod		;Check that tape is loaded correctly

	movb	rewsrt,r5	;0 if want leading rewind, -1 if not

	bit	#$ovwrt,pstat
	beq	60$		;file structured .enter
	tst	r5		;No checking if no initial rewind -
	bne	65$		; we starts where we is.
	call	wrchk		;check out tape
	br	70$

60$:	tst	r5
	bne	65$		;Unless initial rewind suppressed,
	call	filchk		; ensure tape not previously overwritten
65$:
.if ne debug
	typex	<<cr><lf>/.ENTER to mag tape: position=/<200>>
	mov	r5,r0
	call	wdt
	call	tcrlf
.endc
	.enter	#area,#mtlun,#outfil,,r5
	bcc	70$
	jmp	120$

70$:	mov	dp,r4		;Wait for all disc I/O
	mov	r4,r1
71$:	.wait	b.lun(r1)
	mov	b.next(r1),r1
	cmp	r1,r4
	bne	71$

	mov	dp,r1		;Re-synchronize tape/disc buffers
	mov	r1,tp

	mov	recs,bfrec
	sub	mtblok,bfrec	;Records left to be written

	mov	mtblok,r3	;8Kb blocks written
	mov	r3,mtqued	;Reset queued counter
	clr	r2
	mov	#blkfac,r0
	call	mul21		;now next disc block to write from
	mov	r3,b.blk(r1)
	mov	r2,b.blkh(r1)
	mov	r2,b.lun(r1)
	add	#dklun,b.lun(r1)

.if ne	debug
	typen	<Tape recs to write (total): >
	mov	recs,r3
	clr	r2
	call	typnum
	typex	<<cr><lf>/Tape recs written: /<200>>
	mov	mtblok,r3
	clr	r2
	call	typnum
	typex	<<cr><lf>/Disc recs to read: /<200>>
	mov	bfrec,r3
	clr	r2
	call	typnum
	typex	<<cr><lf>/Disc remainder: /<200>>
	mov	bfrem,r3
	clr	r2
	call	typnum
	typex	<<cr><lf>/Disc block to read: /<200>>
	mov	b.blk(r1),r3
	mov	b.blkh(r1),r2
	call	typnum
	call	tcrlf

	call	dmpbfr
.endc

	call	qrdska		;Queue all buffers for disc.

	call	wrid		;record volume id
	call	setstream	;set up streaming
	inc	volnum
	bic	#$mtvol,pstat	;new volume obtained
	mov	#1,tblock	;id block recorded already
	return

120$:	movb	@#errbyt,r5
	typen	<Cannot create >
	mov	#outfil,r2
	call	typfil
	typen	< (.ENTER error >
	mov	r5,r0
	call	wdt
	type	<)>
	JMP	CRASH

.Dsabl	lsb

.endc	; if ne ..save
.Sbttl	New Input Tape

.if ne <..rest ! ..veri>

.Enabl	lsb

;Note: unlike WVOL, RVOL does not synchronize buffers.  This is necessary
; due to its use from both Restore and Verify, which have different buffer
; patterns.

RVOL:
	.wait	#mtlun
	mov	mtblok,mtflag		;Save present record count

	bit	#$death,pstat
	beq	5$
	jmp	crash
5$:
	bit	#$oldtp,pstat
	beq	10$
	typex	<<cr><lf>#Unexpected End of Tape: data may have been lost#>
	tx	<<0>>
	call	rwtape
	jmp	errext

10$:
	clr	nvflag		;This should be a new volume
	br	40$


20$:	cmp	volnum,#1	;Old Format.  Must be first volume
	beq	30$
	jmp	150$
30$:
	typen	<RESTORE SAVRES 4.2b disc image ? [Y/N] >
	getin	tlinb,30$,#oldfmt
	bis	#$oldtp,pstat	;say old format
	cmpb	tlinb,#'Y
	beq	35$
	bic	#$oldtp,pstat	;say new format
	cmpb	tlinb,#'N
	bne	30$
35$:	jmp	150$		;start from the beginning


40$:	cmp	volnum,#1
	beq	70$		;first volume, none prior to this
;;	mov	#10.,r1
;;	call	backmt		;Dumb question: what's this for (CGW)?
;;	call	clrmt		;(If you can convince me of its value,
;;	call	backmt		; I'll put it back in)
;;	call	clrmt
50$:	.close	#mtlun		;forget about it
60$:	mov	#infil,r2
	call	savnam
	mov	#infil,r2
	mov	#rwtape,r0
	call	rewofl		;Rewind current.  If split across tapes,
	call	resnam		; rewind despite REWIND switches.

70$:	bit	#$oldtp,pstat
	bne	110$

	tstb	averif		;Auto verifying?
	beq	80$		;No.
	cmp	volnum,#1	;Must be volume 1
	beq	110$		;And off we go.

80$:	tst	nvflag
	bne	90$
	typen	<M>
	br	100$
90$:	typex	</You have mounted the wrong volume./<cr><lf>/Please m/<200>>
100$:	mov	#-1,nvflag
	typen	<ount volume >
	mov	volnum,r0
	call	wdt
	typen	< in >
	mov	infil,r0
	call	w50t
	typen	<: and type the RETURN key to continue.>
	getin	tlinb,80$,#hload

110$:	mov	#infil,r2		;Check for tape being loaded
	call	taplod

	movb	rewsrt,r5		;-1 if suppress initial rewind
.if ne debug
	typex	<<cr><lf>/Looking for file /<200>>
	clr	r0
	call	wft			;#infil in r2
	typen	<, position=>
	mov	r5,r0
	call	wdt
	call	tcrlf
.endc
	.lookup	#area,#mtlun,r2,r5
	bcc	120$
	jmp	errfnf			;lookup error

120$:	clr	mtblok			;ensure we restore the whole disc
	bit	#$oldtp,pstat
	bne	160$

	mov	#1,r0			;assume volume size check required
	cmpb	infil+f.dtyp,#25
	bne	130$
	clr	r0			;wrong again
130$:	call	rdid			;check volume id
	bne	140$
	jmp	20$			;old SAVRES format
140$:	bcc	160$
150$:	call	rewind			;just rewind
	jmp	50$

160$:
	call	dskwat			;Wait for disc I/O to finish

	mov	recs,bfrec		;Re-calculate disc records to go.
	sub	mtblok,bfrec

	mov	mtblok,r3		;Reset disc block for next I/O
	mov	r3,mtqued		; and reset tape "queued" counter
	clr	r2
	mov	#blkfac,r0
	call	mul21
	mov	dp,r1
	mov	r3,b.blk(r1)
	mov	r2,b.blkh(r1)

.if	ne debug
	typen	<Next block for disc I/O: >
	call	typnum
	call	tcrlf
.endc

;Ideas on read overrun/underrun (CGW, V7):

;If the block we are ready to process for the disc equals the block we are
; about to read from the tape, then we are synchronized and we have no
; problem.

;If the tape block number is greater than that for the disc ("underrun"), some
; records have been lost (fallen in the chasm between the tapes?).  In this
; situation he's buggered.

;If the tape block number is less than that for the disc ("overrun"), some
; additional records have been read (from that same chasm?) and transferred
; to or verified against the disc.  This comes from funnies which may
; occur at the end of a tape with different drives & tapes.  All we do
; here is ignore this, as we re-synchronize the disc to the tape anyway.
; I have put in a message just to see how often it actually occurs.

	cmp	mtblok,mtflag		;(old mtblok held in mtflag)
	bhi	undrun			;Whoops.
	beq	400$
	typex	<<cr><lf>/Tape overrun - ignored [mtblok=/<200>>
	clr	r2
	mov	mtblok,r3
	call	typnum
	typen	<, old mtblok=>
	mov	mtflag,r3
	call	typnum
	type	<]>
400$:
	call	setstream		;set up streaming
	inc	volnum
	bic	#$mtvol,pstat		;obtained new volume

.if ne	debug
	call	dmpbfr
.endc
	return



undrun:	typex	<<cr><lf><7>/ ** Tape Read Underrun **/<0>>
	jmp	crash

.Dsabl	lsb

.endc				; if ne <..rest ! ..veri>
.Sbttl	Wait for Disc I/O Completion

;This comes from having to use the DEC/SNH DU handler with no physical
; I/O capability.  I thought of scrubbing that in this version, insisting
; upon the Wilson/Webster DU handler with physical I/O.  Maybe in the
; next version?  However, when this is done, remember that then RECS, MTQUED,
; MTBLOK and PROBUF may need to be two words long to allow for BIG discs.

dskwat:
	mov	dp,r1
10$:	.wait	b.lun(r1)
	mov	b.next(r1),r1
	cmp	r1,dp
	bne	10$
	return
.Sbttl	Queue Disc Buffers for reading

;These three routines expect the address of either the first disc buffer
; header in the chain (QRdskA) or the particular buffer header (QRdsk, QRdskX)
; to be provided in R1

;QRdskA assumes the information in the first header is correct, queues that
; request, then works round the chain queueing the whole set of requests in
; seriatim.

;QRdskX assumes the information in the header is correct and queues only that
; header's request.

;QRdsk gets information from the last header, adjusts it accordingly, and
; queues this (next) request.

;R0 is destroyed.

;QRdskX and QRdsk return CC if no problems, and CS if there are no more
; buffers to queue.

.if ne <..save ! ..veri>

QRdskA:
	mov	r5,-(sp)
	mov	r1,r5			;Hold pointer to first buffer header

5$:	.assume	b.stat eq 0		;Set buffer status to empty in all
	mov	#< <b..emp * 400> + <b..ok & 377> >,(r1) ; buffers now, in
	mov	b.next(r1),r1		; case run out.
	cmp	r1,r5
	bne	5$

	call	qrdskx			;Queue the first request
10$:	mov	b.next(r1),r1		;Look at next buffer header
	cmp	r1,r5			;If back to start, quit.
	beq	20$
	call	qrdsk			;Queue next request
	bcc	10$			;(CS if no more available)
20$:	mov	(sp)+,r5
	return


.Enabl	lsb

QRdsk:					;QUEUE BUFFER AFTER LAST ONE QUEUED
	mov	r5,-(sp)
	mov	r4,-(sp)

	mov	b.last(r1),r5		;Get details from last buffer header

	mov	b.blk(r5),b.blk(r1)	;Block number, low order
	mov	b.blkh(r5),b.blkh(r1)	;Ibid, high order
	mov	b.lun(r5),b.lun(r1)	;Logical unit number
	add	#blkfac,b.blk(r1)	;Move on to next one
	bcc	10$
	inc	b.blkh(r1)		;Next partition means next
	inc	b.lun(r1)		; logical unit.
10$:	br	20$

QRdskX:					;QUEUE CURRENT BUFFER USING ITS VALUES
	mov	r5,-(sp)
	mov	r4,-(sp)
20$:
	mov	#bufsiz/2,r4		;Default read is 8kb
	mov	bfrec,r0		;See if any records left.
	beq	60$			;None.
	dec	bfrec			;Another 8kb bites the dust
	bne	30$
	tst	bfrem			;Any partial records?
	beq	30$			;No.  Last full one coming up.
	mov	bfrem,r4		;Yes.
	clr	bfrem			;Once done, nothing left
30$:	swab	r4			;Words to blocks

	mov	r4,b.blks(r1)		;Blocks in this bufferful
	swab	r4			;Back to words for read

	mov	#< <b..que * 400> + <b..qds & 377> >,b.stat(r1);Queued to disc

	tstb	pio			;Physical I/O?
	bne	35$

	.readc	#area,b.lun(r1),b.buf(r1),r4,b.dcrt(r1),b.blk(r1)
	br	38$
35$:
	bis	b.blkh(r1),r4		;High-order block no.
	.spfun	#area,#dklun,#sp.pio,b.buf(r1),r4,b.blk(r1),b.dcrt(r1)
38$:	bcc	70$

	tstb	@#errbyt
	bne	40$
	mov	#< <b..ful * 400> + <b..eof & 377> >,b.stat(r1) ;End of file
	br	50$
40$:
	mov	#< <b..ful * 400> + <b..err & 377> >,b.stat(r1) ;Error
50$:
	tst	(pc)+			;Skip to return, with carry clear
60$:
	sec
70$:
	mov	(sp)+,r4
	mov	(sp)+,r5

	return

.Dsabl	lsb

.endc			; if ne <..save ! ..veri>
.Sbttl	Queue Tape Buffers for reading

;These three routines expect the address of either the first tape buffer
; header in the chain (QRmtA) or the particular buffer header (QRmt, QRmtX)
; to be provided in R1.

;QRmtA assumes the information in the first header is correct, queues that
; request, then works round the chain queueing the whole set of requests in
; seriatim.

;QRmtX assumes the information in the header is correct and queues only that
; header's request.

;QRmt gets information from the last header, adjusts it accordingly, and
; queues this (next) request.

;R0 is destroyed.

;QRmtX and QRmt return CC if no problems, and CS if there are no more
; buffers to queue.

.if ne <..rest ! ..veri>

QRmtA:
	mov	r5,-(sp)
	mov	r1,r5			;Hold pointer to first buffer header

5$:	.assume	b.stat eq 0		;Set buffer status to empty in all
	mov	#< <b..emp * 400> + <b..ok & 377> >,(r1) ; buffers now, in
	mov	b.next(r1),r1		; case run out
	cmp	r1,r5
	bne	5$

	call	qrmtx			;Queue the first request
10$:	mov	b.next(r1),r1		;Look at next buffer header
	cmp	r1,r5			;If back to start, quit.
	beq	20$
	call	qrmt			;Queue next request
	bcc	10$			;(CS if no more available)
20$:	mov	(sp)+,r5
	return


.Enabl	lsb

QRmt:					;QUEUE BUFFER AFTER LAST ONE QUEUED
	mov	r5,-(sp)

	mov	b.last(r1),r5		;Get details from last buffer header

	mov	b.blk(r5),b.blk(r1)	;Block number, low order
	mov	b.blkh(r5),b.blkh(r1)	;Ibid, high order
	mov	b.lun(r5),b.lun(r1)	;Logical unit number
	add	#blkfac,b.blk(r1)	;Move on to next one
	bcc	10$
	inc	b.blkh(r1)		;Next partition means next
	inc	b.lun(r1)		; logical unit.
10$:	br	20$

QRmtX:					;QUEUE CURRENT BUFFER USING ITS VALUES
	mov	r5,-(sp)
20$:
	mov	#< <b..que * 400> + <b..qmt & 377> >,b.stat(r1);Queued to tape

	cmp	mtqued,recs		;Queued all we need to?
	bhis	50$			;Yes - don't do more.
	inc	mtqued

	mov	r1,-(sp)		;Get tape block address
	add	#b.tblk,(sp)
	mov	#-1,@(sp)		;Make it impossible value

	.spfun	#area,#mtlun,#sp.rdb,b.buf(r1),#bufsiz/2,(sp)+,b.tcrt(r1)
	bcc	60$
	tstb	@#errbyt
	bne	30$
	mov	#< <b..ful * 400> + <b..eof & 377> >,b.stat(r1) ;End of File
	br	40$
30$:
	mov	#< <b..ful * 400> + <b..err & 377> >,b.stat(r1) ;Error
40$:
	tst	(pc)+			;Skip to return, with carry clear
50$:
	sec
60$:
	mov	(sp)+,r5

	return

.Dsabl	lsb

.endc			; if ne <..rest ! ..veri>
.Sbttl	Queue Disc Buffers for writing

;These two routines expect the address of the particular buffer header in R1

;QWdskX assumes the information in the header is correct and queues only that
; header's request.

;QWdsk gets information from the last header, adjusts it accordingly, and
; queues this (next) request.

;R0 is destroyed.

;QWdskX and QRdsk return CC if no problems, and CS if there are no more
; buffers to queue.

.if ne ..rest

.Enabl	lsb

QWdsk:					;QUEUE BUFFER AFTER LAST ONE QUEUED
	mov	r5,-(sp)
	mov	r4,-(sp)

	mov	b.last(r1),r5		;Get details from last buffer header

	mov	b.blk(r5),b.blk(r1)	;Block number, low order
	mov	b.blkh(r5),b.blkh(r1)	;Ibid, high order
	mov	b.lun(r5),b.lun(r1)	;Logical unit number
	add	#blkfac,b.blk(r1)	;Move on to next one
	bcc	10$
	inc	b.blkh(r1)		;Next partition means next
	inc	b.lun(r1)		; logical unit.
10$:	br	20$

QWdskX:					;QUEUE CURRENT BUFFER USING ITS VALUES
	mov	r5,-(sp)
	mov	r4,-(sp)
20$:
	mov	#bufsiz/2,r4		;Default write is 8kb
	mov	bfrec,r0		;See if any records left.
	beq	60$			;None.
	dec	bfrec			;Another 8kb bites the dust
	bne	30$
	tst	bfrem			;Any partial records?
	beq	30$			;No.  Last full one coming up.
	mov	bfrem,r4		;Yes.
	clr	bfrem			;Once done, nothing left
30$:	swab	r4			;Words to blocks

	mov	r4,b.blks(r1)		;Blocks in this bufferful
	swab	r4			;Back to words for write

	mov	#< <b..que * 400> + <b..qds & 377> >,b.stat(r1);Queued to disc

	tstb	pio			;See if physical I/O required
	bne	35$			;Yes.

	.writc	#area,b.lun(r1),b.buf(r1),r4,b.dcrt(r1),b.blk(r1)
	br	38$
35$:
	neg	r4			;Write, therefore negative.
	bisb	b.blkh(r1),r4		;High-ord block # in bottom of w/count
	.spfun	#area,#dklun,#sp.pio,b.buf(r1),r4,b.blk(r1),b.dcrt(r1)
38$:	bcc	70$
	tstb	@#errbyt
	bne	40$
	mov	#< <b..emp * 400> + <b..eof & 377> >,b.stat(r1) ;End of File
	br	50$
40$:
	mov	#< <b..emp * 400> + <b..err & 377> >,b.stat(r1) ;Error
50$:
	tst	(pc)+			;Skip to return, with carry clear
60$:
	sec
70$:
	mov	(sp)+,r4
	mov	(sp)+,r5

	return

.Dsabl	lsb

.endc			; if ne ..rest
.Sbttl	Queue Tape Buffers for writing

;These routines expect the address of the particular buffer header in R1

;QWmtX assumes the information in the header is correct and queues only that
; header's request.

;QWmt gets information from the last header, adjusts it accordingly, and
; queues this (next) request.

;R0 is destroyed.

;QRmtX and QRmt return CC if no problems, and CS if there are no more
; buffers to queue.

.if ne ..save

.Enabl	lsb

QWmt:					;QUEUE BUFFER AFTER LAST ONE QUEUED
	mov	r5,-(sp)

	mov	b.last(r1),r5		;Get details from last buffer header
	mov	b.blk(r5),b.blk(r1)	;Block number, low order
	mov	b.blkh(r5),b.blkh(r1)	;Ibid, high order
	mov	b.lun(r5),b.lun(r1)	;Logical unit number
	add	#blkfac,b.blk(r1)	;Move on to next one
	bcc	10$
	inc	b.blkh(r1)		;Next partition means next
	inc	b.lun(r1)		; logical unit.
10$:	br	20$

QWmtX:					;QUEUE CURRENT BUFFER USING ITS VALUES
	mov	r5,-(sp)
20$:
	mov	#< <b..que * 400> + <b..qmt & 377> >,b.stat(r1);Queued to tape

	cmp	mtqued,recs		;Queued all we need to?
	bhis	50$			;Yes - don't do more.
	inc	mtqued

	mov	r1,-(sp)		;Get tape block address
	add	#b.tblk,(sp)
	mov	#-1,@(sp)		;Make it impossible value

	.spfun	#area,#mtlun,#sp.wrb,b.buf(r1),#bufsiz/2,(sp)+,b.tcrt(r1)
	bcc	60$
	tstb	@#errbyt
	bne	30$
	mov	#< <b..emp * 400> + <b..eof & 377> >,b.stat(r1) ;End of file
	br	40$
30$:
	mov	#< <b..emp * 400> + <b..err & 377> >,b.stat(r1) ;Error
40$:
	tst	(pc)+			;Skip to return, with carry clear
50$:
	sec
60$:
	mov	(sp)+,r5
	return

.Dsabl	lsb

.endc			; if ne ..save
.Sbttl	Disc Error Recovery

.Enabl	lsb

; Read or write the next record from or to the disc a block at a time until
; either the error goes away or the user ignores the error. If neither occurs,
; then die.

; Called with pointer to appropriate buffer header in r1.

dskerr:
	mov	r5,-(sp)		;Occasional oddities if don't
	mov	r4,-(sp)		; look after these.
	mov	r3,-(sp)
	mov	r2,-(sp)
	mov	r0,-(sp)

	mov	b.buf(r1),r5
	mov	b.blks(r1),r4
	mov	b.blk(r1),-(sp)
	mov	b.blkh(r1),-(sp)
	mov	b.lun(r1),-(sp)

10$:	.wait	b.lun(r1)

	bit	#$rest,pstat		;Read or write?
	bne	15$

	.readw	#area,b.lun(r1),r5,#256.,b.blk(r1)
	bcc	40$			;problem's not here
	br	20$
15$:
	.writw	#area,b.lun(r1),r5,#256.,b.blk(r1)
	bcc	40$

20$:	typex	<<cr><lf>/Disc error at block: /<200>>
	mov	b.blk(r1),r3
	mov	b.blkh(r1),r2
	call	typnum
30$:	typen	<; Ignore and continue? [Y/N] >
	getin	tlinb,20$,#hdrerr
	cmpb	#'Y,tlinb
	beq	40$
	cmpb	#'N,tlinb
	bne	30$
	typex	<<cr><lf>/Fatal disc error/<0>>
	jmp	crash

40$:
	add	#512.,r5		;next area in buffer
	inc	b.blk(r1)
	bne	60$
	inc	b.blkh(r1)
	inc	b.lun(r1)
60$:	dec	r4
	bne	10$

70$:	mov	#1,b.stat(r1)		;go for a comparison
	mov	(sp)+,b.lun(r1)
	mov	(sp)+,b.blkh(r1)
	mov	(sp)+,b.blk(r1)

	mov	(sp)+,r0
	mov	(sp)+,r2
	mov	(sp)+,r3
	mov	(sp)+,r4
	mov	(sp)+,r5
	return

.Dsabl	lsb
.Sbttl	Disc Read Completion Routines

; Disc read completion routines for Verify.  Note one completion routine
;	per buffer.

.if ne <..save ! ..veri>


dcrv1:	mov	#dh1,r1
	br	drc

dcrv2:	mov	#dh2,r1
	br	drc

; Disc read completion routines for Save/Restore.
;	Again, one routine per buffer.

dcrrtb:			;Table of disc read completion routines
	dcrr0
	dcrr1
	dcrr2
	dcrr3
	dcrr4
	dcrr5

	.psect	tapdat
dbhrtb:	.blkw	6	;Table of buffer header addresses for disc reads
	.psect	savtap

dcrr0:	mov	dbhrtb + <2 * 0>,r1
	br	drc

dcrr1:	mov	dbhrtb + <2 * 1>,r1
	br	drc

dcrr2:	mov	dbhrtb + <2 * 2>,r1
	br	drc

dcrr3:	mov	dbhrtb + <2 * 3>,r1
	br	drc

dcrr4:	mov	dbhrtb + <2 * 4>,r1
	br	drc

dcrr5:	mov	dbhrtb + <2 * 5>,r1
	.br	drc


drc:
	.assume	b.stat eq 0
	mov	#< <b..ful*400> + <b..ok&377> >,(r1) ;Buffer now full
	br	dc

.endc			; if ne <..save ! ..veri>
.Sbttl	Disc Write Completion Routines

; Disc Write Completion Routines for Restore

.if ne ..rest

dcrwtb:			;Table of disc write completion routines
	dcrw0
	dcrw1
	dcrw2
	dcrw3
	dcrw4
	dcrw5

	.psect	tapdat
dbhwtb:	.blkw	6	;Table of buffer header addresses for disc writes
	.psect	savtap

dcrw0:	mov	dbhwtb + <2 * 0>,r1
	br	dwc

dcrw1:	mov	dbhwtb + <2 * 1>,r1
	br	dwc

dcrw2:	mov	dbhwtb + <2 * 2>,r1
	br	dwc

dcrw3:	mov	dbhwtb + <2 * 3>,r1
	br	dwc

dcrw4:	mov	dbhwtb + <2 * 4>,r1
	br	dwc

dcrw5:	mov	dbhwtb + <2 * 5>,r1
	.br	dwc


dwc:
	.assume	b.stat eq 0
	mov	#< <b..emp*400> + <b..ok&377> >,(r1) ;Buffer now empty

.endc	; if ne ..rest


dc:	bit	#1,r0		;See if error
	beq	10$
	.assume	b..err eq b..ok-1
	decb	(r1)		;Error.
	return
10$:	bit	#20000,r0	;See if EOF
	beq	20$
	.assume	b..eof eq b..ok+1
	incb	(r1)		;Eof.
20$:	return
.Sbttl	Tape Read Completion Routines

.if ne <..rest ! ..veri>

tcrrtb:			;Table of tape read completion routines
	tcrr0
	tcrr1
	tcrr2
	tcrr3
	tcrr4
	tcrr5

	.psect	tapdat
tbhrtb:	.blkw	6	;Table of buffer header addresses for tape reads
	.psect	savtap

tcrr0:	mov	tbhrtb + <2 * 0>,r1
	br	trc

tcrr1:	mov	tbhrtb + <2 * 1>,r1
	br	trc

tcrr2:	mov	tbhrtb + <2 * 2>,r1
	br	trc

tcrr3:	mov	tbhrtb + <2 * 3>,r1
	br	trc

tcrr4:	mov	tbhrtb + <2 * 4>,r1
	br	trc

tcrr5:	mov	tbhrtb + <2 * 5>,r1
	.br	trc


trc:					;Tape Read Completion Routine
	.assume	b.stat eq 0
	mov	#< <b..ful*400> + <b..ok&377> >,(r1) ;Buffer now full
	br	tc

.endc	; if ne <..rest ! ..veri>
.Sbttl	Tape Write Completion Routines

.if ne ..save

tcrwtb:			;Table of tape write completion routines
	tcrw0
	tcrw1
	tcrw2
	tcrw3
	tcrw4
	tcrw5

	.psect	tapdat
tbhwtb:	.blkw	6	;Table of buffer header addresses for tape writes
	.psect	savtap

tcrw0:	mov	tbhwtb + <2 * 0>,r1
	br	twc

tcrw1:	mov	tbhwtb + <2 * 1>,r1
	br	twc

tcrw2:	mov	tbhwtb + <2 * 2>,r1
	br	twc

tcrw3:	mov	tbhwtb + <2 * 3>,r1
	br	twc

tcrw4:	mov	tbhwtb + <2 * 4>,r1
	br	twc

tcrw5:	mov	tbhwtb + <2 * 5>,r1
	.br	twc


twc:					;Tape Write Completion Routine
	.assume	b.stat eq 0
	mov	#< <b..emp*400> + <b..ok&377> >,(r1) ;Buffer now empty

.endc	; if ne ..save


tc:
	bis	r0,mtflag	;Keep track of occurrence of error
	bit	#20001,mtflag
	bne	5$
	.assume	b..eof eq b..ok+1
	inc	mtblok		;Count of successful MT transfers
5$:
	bit	#1,r0		;See if error
	beq	10$
	.assume	b..err eq b..ok-1
	decb	(r1)		;Error.
	return
10$:	bit	#20000,r0	;See if EOF
	beq	20$
	incb	(r1)		;Eof.
20$:	return
.Sbttl	Tape Routines

.Sbttl	- Show tape error

taperr:	mov	b.blkh(r1),r2
	mov	b.blk(r1),r3
	typex	<<cr><lf>|Unrecoverable tape I/O error at block |<200>>
	call	typnum
	call	tcrlf
	jmp	crash


.Sbttl	- Backspace the magtape

;call:	r1	number of blocks to backspace

backmt:	mov	#sp.bks,-(sp)
	br	movemt


.Sbttl	- Forward space the magtape

;call:	r1	number of blocks to forward space

forwmt:	mov	#sp.fws,-(sp)

movemt:	.spfun	#area,#mtlun,(sp)+,,r1,#tperr
	return
	

.Sbttl	- Clear channel error

.Enabl	lsb

clrmt:	mov	#200,r0
	call	tapspf
	bcc	10$
	return

10$:	cmpb	#25,outfil+f.dtyp	;If the null device, don't kill him.
	bne	20$
	return
20$:	typex	<<cr><lf>/Unexpected successful IO operation on tape/<200>>
	jmp	crash

.Dsabl	lsb


.Sbttl	- Set up 100ips streaming

.Enabl	lsb

Setstream:
	tstb	stream
	beq	10$		;No streaming required
	.spfun	#area,#mtlun,#-9.,#stbuf,#0,#0
	bcc	5$		;OK.
	tstb	stream		;Prang: if previous message, no more messages.
	bmi	10$
	typen	<Failed to >
	clrb	stream		; and don't try again if error.
5$:	tstb	stream
	bmi	10$
	type	<Set Streaming Mode>
	negb	stream
10$:	return

stbuf:	.word	1		;If 1, sets streaming mode on SPFUN -9

.Dsabl	lsb


.Sbttl	- Rewind the Magtape

.Enabl	lsb

rewind:	mov	#sp.rew,-(sp)	;force a plain rewind
	br	10$

rwtape:	mov	#sp.unl,-(sp)	;rewind and offline
	bit	#$oldtp,pstat
	beq	10$
	bit	#$mtvol,pstat
	beq	10$
	mov	#sp.rew,(sp)	;no just rewind

10$:
.if ne debug
	typex	<<cr><lf>/Explicit Rewind/<0>>
.endc
	mov	(sp)+,r0
	call	tapspf
	bcs	20$
	return

20$:	typex	<<cr><lf>/Cannot Rewind Tape/<0>>
	jmp	crash

.Dsabl	lsb


.Sbttl	- Rewind &/or Offline

;Call:	r2	filename block
;	r0	tape operation subroutine address

.Enabl	lsb

rewofl:	mov	r0,-(sp)
	mov	(r2),nulfil
	mov	#-1,r0		;just open, no tape movement
	call	tapluk
	bcc	10$
.if	ne debug
	typex	<<cr><lf>#Tape Lookup Failure.  Error byte : #<200>>
	movb	@#errbyt,r3
	clr	r2
	call	typnum
	call	tcrlf
.endc
	jmp	errfnf		;Lookup failure

10$:	call	@(sp)+
	.close	#mtlun
	return

.Dsabl	lsb

.Enabl	lsb

.Sbttl	- Type out block number.

TYPBLK:	mov	blkmon,r3	;Use block monitor, because it is mod 1000
	mov	blkmom,r2
	typen	<*** Current Block: >
	call	typnum
	typex	</    ***/<cr><200>>
	add	#blkmf,blkmon	;Next block to type out
	adc	blkmom
	return

.Dsabl	lsb
.Sbttl	Label Subroutines

.Sbttl	- SAVNAM - Save a filename
; save a filename pointed to by r2 on the stack, leaving r2 pointing to
; first word after filename, r0 corrupted

savnam:	mov	(sp)+,r0
	mov	(r2)+,-(sp)
	mov	(r2)+,-(sp)
	mov	(r2)+,-(sp)
	mov	(r2)+,-(sp)
	mov	r2,-(sp)
	jmp	(r0)

.Sbttl	- RESNAM - Restore a filename
; restore a filename from the stack, leaving r2 pointing to first word
; of filename, r0 corrupted

resnam:	mov	(sp)+,r0
	mov	(sp)+,r2
	mov	(sp)+,-(r2)
	mov	(sp)+,-(r2)
	mov	(sp)+,-(r2)
	mov	(sp)+,-(r2)
	jmp	(r0)


.Sbttl	- RDSBLK - Read a block from the tape

.Enabl	lsb

rdsblk:	.spfun	#area,#mtlun,#sp.rdb,mtbuff,#256.,#tperr
	bcc	30$
	cmpb	@#errbyt,#1
	bne	10$			;not eof error
	cmp	tperr,#5
	beq	20$			;is a read underrun
10$:
.if	ne debug
	typen	<Error byte : >
	movb	@#errbyt,r3
	clr	r2
	call	typnum
	typex	<<cr><lf>/First Word Code : /<200>>
	mov	tperr,r3
	clr	r2
	call	typnum
.endc
	typex	<<cr><lf>/Tape Read Error/<0>>
	jmp	crash

20$:	sec
30$:	return

.Dsabl	lsb
.Sbttl	- RDID -  Read volume id from tape and check validity of information

;Call with r0 indicating whether volume size checks are required
; (currently appears to be zero - no checks - only if NL is device)

.Enabl	lsb

rdid:	mov	r0,r3
	call	rdsblk
	bcc	10$
	  jmp	130$			;probably old SAVRES format
10$:	mov	mtbuff,r1
	clr	r2

	mov	#7,r0			;seven to add up
20$:	add	(r1)+,r2		;away we go ...
	sob	r0,20$

	mov	#<256.-7>,r0
30$:	cmp	r2,(r1)
	beq	40$
	  jmp	130$			;probably old SAVRES format
40$:	swab	r2
	add	(r1)+,r2
	sob	r0,30$

.if	ne debug
	typen	<Reading tape volume number : >
	mov	r3,-(sp)
	mov	@mtbuff,r3
	clr	r2
	call	typnum
	call	tcrlf
	mov	(sp)+,r3
.endc

	mov	mtbuff,r1		;point to buffer
	cmp	volnum,(r1)+
	beq	50$
	  jmp	200$
50$:	tst	r3
	bne	60$
	  jmp	170$
60$:
	.wait	#dklun			;See if disc channel in use
	bcc	90$			;Is - all must be well.
					;Isn't - must have to create file.
	mov	#outfil,r2
	mov	2(r1),f.size(r2)	;Put size into file block area.
	clr	f.sizh(r2)		;Must be zero for an RT-11 file!
	.enter	#area,#dklun,r2,2(r1)
	bcc	70$			;Room for it.

	typex	<<cr><lf>/Cannot create file /<200>>
	mov	#1,r0			;Type file size in WFT
	call	wft
	call	tcrlf
	jmp	crash
70$:
	typex	<<cr><lf>/Created file /<200>>
	mov	#1,r0
	call	wft
	call	tcrlf
	call	dsksiz			;Get size of disc file for
	mov	remain,bfrem		; sorting out counters
	beq	80$			; for full and partial buffers
	inc	recs			;(also resets dskblj & dskblk)
80$:	mov	recs,bfrec

90$:
	cmp	(r1),dskblj
	bne	100$
	cmp	2(r1),dskblk
	beq	170$

100$:	cmp	volnum,#1		;error if not volume 1
	bne	200$
110$:	.print	vrmsg			;show 'em what's what
	typen	< a >			;see what user really wants
	mov	(r1),r2
	mov	2(r1),r3
	call	typnum
	typen	< block image onto a >
	mov	dskblj,r2
	mov	dskblk,r3
	call	typnum
	typen	< block disc? [Y/N] >
	getin	tlinb,110$,#hsize
	cmpb	tlinb,#'N
	beq	200$			;flag an error then
	cmpb	tlinb,#'Y
	bne	110$			;must be a yes or no

	mov	(r1),r2			;assume tape image is smaller
	mov	2(r1),r3
	cmp	r2,dskblj
	blo	140$			;tape image is definitely smaller
	bhi	120$			;disc is smaller
	cmp	r3,dskblk
	blo	140$			;tape is smaller
120$:	mov	dskblj,r2		;disc was smaller so use its size
	mov	dskblk,r3
	br	150$

130$:	sez				;flag old format required
	return

140$:	mov	r2,dskblj		;tape image was smaller so use it
	mov	r3,dskblk

150$:	mov	r1,-(sp)
	mov	#blkfac,r0
	call	div21			;recalculate number of records
	swab	r0
	mov	r0,remain
	mov	r3,bfrec
	mov	r0,bfrem
	beq	160$
	inc	r3
160$:	mov	r3,recs
	mov	(sp)+,r1

170$:	cmp	(r1)+,(r1)+
	cmp	volnum,#1
	bne	180$			;not the first volume
	mov	(r1)+,mtdate		;obtain time of creation
	mov	(r1)+,mttime
	mov	(r1)+,mttime+2
	br	190$

180$:	cmp	mtdate,(r1)+		;time checks
	bne	200$
	cmp	mttime,(r1)+
	bne	200$
	cmp	mttime+2,(r1)+
	bne	200$

190$:	mov	(r1)+,mtblok
	clc
	br	210$

200$:	sec
210$:	clz
	return

.Dsabl	lsb
.Sbttl	- TAPLOD - Check to see that the tape is loaded correctly.

.Enabl	lsb

taplod:
	tstb	rewsrt		;Can't if rewind is suppressed, as we
	bne	70$		; use a rewind error to tell us it isn't.
	mov	(r2),nulfil
	mov	#-1,r0
	call	tapluk
	bcs	80$
10$:	mov	#sp.rew,r0
	call	tapspf
	bcc	60$

20$:	typex	<<cr><lf>#Error rewinding tape - Please check that it is#>
	tx	<# properly mounted.#<cr><lf>#Try again? [Y/N] #<200>>
	mov	#tlinb,r1
30$:	.ttyin			;Do this one with TTYINs so don't grab
	cmpb	r0,#lf		; command file input.
	beq	40$
	cmpb	r0,#40
	blo	30$
	movb	r0,(r1)+
	br	30$
40$:
	cmpb	tlinb,#'?
	bne	50$
	.print	#tload
	br	20$
50$:
	cmpb	tlinb,#'Y
	beq	10$
	cmpb	tlinb,#'N
	beq	90$
	br	20$

60$:	.close	#mtlun		;Can't purge genuine MTs
70$:	return


.Sbttl	- LKUP - Non-file-structured Lookup

; LKUP - Non-filestructured lookup for tape
; will corrupt R0 and rewind tape

lkup:	mov	outfil,nulfil		;get device name
	clr	r0			;Want rewind
	call	tapluk
	bcs	80$			;all is not well
	return

80$:	movb	@#errbyt,r5
	typex	<<cr><lf>/Cannot access /<200>>
	mov	outfil,r0
	call	w50t
	type	<:>
	typex	<# - .LOOKUP error code = #<200>>
	mov	r5,r0
	call	wdt
90$:	jmp	crash

.Dsabl	lsb

tapluk:
	mov	r0,-(sp)			;R0 has file seq no.
	.lookup	#area,#mtlun,#nulfil,(sp)+	;non-file structured enter
	return
tapspf:
	mov	r0,-(sp)
	.spfun	#area,#mtlun,(sp)+,#0,#0,#0	;SPFUN - function in r0
	return
.Sbttl	- (for SAVING only)

.Sbttl	- FILCHK - Check for overwrite check file
; ensure that overwrite check file does not exist on this tape

.if ne ..save

.Enabl	lsb

100$:	mov	#3,r1			;find tape mark
	call	forwmt
	call	clrmt
	.close	#mtlun
101$:	typen	<Tape not yet initialised;>
	br	200$

110$:	mov	#3,r1			;find tape mark
	call	forwmt
	call	clrmt
	call	rewind
	.close	#mtlun
111$:	typen	<Tape previously overwritten;>

200$:	typex	</ Mount a PRE-INITIALISED tape./<cr><lf>>
	tx	</Type RETURN to continue./<200>>
	getin	tlinb,(r1),#hnovr

filchk:	cmpb	outfil+f.dtyp,#25	;Was output device NL:?
	beq	20$			;Yes - ignore all this.
	typex	</** Testing **/<cr><200>>
	call	lkup			;let's have a look
	call	rdsblk			;should be volume header
	mov	mtbuff,r0
	cmp	(r0)+,#"VO
	bne	100$
	cmp	(r0)+,#"L1
	bne	100$

	call	rdsblk			;could be bootstrap
	mov	mtbuff,r0
	cmp	(r0),#240		;nop
	bne	10$			;not bootable
	cmpb	3(r0),#1
	bne	100$			;definitely wrong

	call	rdsblk			;should be check file
10$:	mov	mtbuff,r0
	cmp	(r0)+,#"HD
	bne	100$
	cmp	(r0)+,#"R1
	bne	100$
	cmp	(r0)+,#"$$		;ensure this is not the write check
	beq	110$
	mov	#3,r1			;find tape mark
	call	forwmt
	call	clrmt
	.close	#mtlun			;ok, let them proceed
	typex	</             /<cr><200>>
20$:	return

.Dsabl	lsb


.Sbttl	- WRCHK - Read/Write Check
; tape write/read check to ensure that tape is ok

.Enabl	lsb

wrchk:	cmpb	outfil+f.dtyp,#25	;If NL:, don't even try.
	beq	25$
	typex	</** Testing **/<cr><200>>
	mov	#outfil,r2		;save current filename
	call	savnam
	mov	volnum,-(sp)		;save
	mov	#-1,volnum

	mov	#savnm3,-(r2)		;give a dummy name
	mov	#savnm2,-(r2)
	mov	#savnm1,-(r2)
	mov	#1,r1			;.lookup required
	call	wrhdr
	mov	#blkfac,r5		;write check blocks
10$:	call	wrid
	sob	r5,10$

	mov	#blkfac,tblock
	mov	#1,r1			;mark end of tape
	call	wreof

	call	rewind
	mov	#3,r1			;find tape mark
	call	forwmt
	call	clrmt
	mov	mtblok,r4
	mov	#blkfac,r5
20$:	call	corupt
	mov	#1,r0			;volume size check required
	call	rdid
	blos	30$
	cmp	mtblok,r4
	bne	30$
	sob	r5,20$

	mov	#1,r1
	call	forwmt
	call	clrmt
	mov	#2,r1
	call	forwmt
	call	clrmt

	mov	(sp)+,volnum		;restore
	call	resnam
	clr	r1
	call	wrhdr
	typex	</             /<cr><200>>
25$:	return

30$:	typex	<<cr><lf>|Write/Read Check Failed on |<200>>
	mov	outfil,r0
	call	w50t
	typen	<: Block >
	mov	#blkfac,r3
	sub	r5,r3
	clr	r2
	call	typnum
	call	tcrlf
	jmp	crash

.Dsabl	lsb



.Sbttl	- HDR1 - Write Header

; Call with r1 whether .lookup and VOL1 should be done (zero if shouldn't)

;first set up the file name

.Enabl	lsb

wrhdr:	tst	r1
	beq	20$			;no .lookup required
	call	lkup
	call	svol1			;setup volume label
	call	wrsblk			;and write it

20$:	mov	#xarea,r1		;point at label area

	mov	outfil+2,r0		;first 3 character of file name
	call	w50f

	mov	outfil+4,r0		;second 3
	call	w50f

	movb	#'.,(r1)+		;dot separator

	mov	outfil+6,r0		;file extension
	call	w50f

;now set up date, etc

	call	shdr1			;now setup HDR1
	call	wrsblk			;and write it

;now the file mark

	call	wrmtfm

	return

.Dsabl	lsb


.Sbttl	- EOF - write eof label and file marks

; Call with r1 non zero to write EOF1 label only

.Enabl	lsb

wreof:	call	wrmtfm
	mov	r1,-(sp)
	bne	10$
	bit	#$mtvol,pstat
	bne	20$

10$:	mov	tblock,r5		;get blocks on tape
	call	seof1			;and setup EOF1
	call	wrsblk			;and write it

	call	wrmtfm

20$:	tst	(sp)+
	bne	30$
	call	wrmtfm

30$:	return

.Dsabl	lsb


.Sbttl	- WRID - Write volume id onto tape

.Enabl	lsb

wrid:	mov	mtbuff,r1		;point to buffer
	clr	r2
	mov	volnum,(r1)
	add	(r1)+,r2
	mov	dskblj,(r1)
	add	(r1)+,r2
	mov	dskblk,(r1)
	add	(r1)+,r2
	mov	mtdate,(r1)
	add	(r1)+,r2
	mov	mttime,(r1)
	add	(r1)+,r2
	mov	mttime+2,(r1)
	add	(r1)+,r2
	mov	mtblok,(r1)
	add	(r1)+,r2

	mov	#<256.-7>,r0
10$:	mov	r2,(r1)
	swab	r2
	add	(r1)+,r2
	sob	r0,10$

	call	wrsblk
	return

.Dsabl	lsb


; Corrupt data area

corupt:	mov	mtbuff,r1
	mov	#256.,r0

10$:	clr	(r1)+
	sob	r0,10$
	return
.Sbttl	- WRSBLK - Write a block to the tape

.Enabl	lsb

wrsblk:
	.spfun	#area,#mtlun,#sp.wrb,mtbuff,#256.,#tperr
	bcc	10$

	tstb	@#errbyt		;EOT is acceptable
	beq	10$

	typex	<<cr><lf>/Tape Write Error/<200>>
	jmp	crash

10$:	return

.Dsabl	lsb


.Sbttl	- WRMTFM - Write a file mark on the cartridge

.Enabl	lsb

wrmtfm:
	.spfun	#area,#mtlun,#sp.wfm
	bcc	20$
	tstb	@#errbyt		;EOT is acceptable here too
	beq	10$
	typex	<<cr><lf>/Tape Write File Mark Error/<0>>
	jmp	crash

10$:	call	clrmt		;clear any errors
.if	ne debug
	typex	<<cr><lf>/Tape error cleared/<0>>
.endc

20$:	return

.Dsabl	lsb


.Sbttl	- SHDR1 - Set up `HDR1` label in the buffer

shdr1:	mov	#label,r1	;point at buffer
	MOV	#"HD,(R1)+
	MOV	#"R1,@R1
	MOV	#1,R2		;file sequence number

10$:	mov	#label,R4
	ADD	#FSNASC-LABEL,R4;POINT TO FSN
	MOV	#2,R0
	call	BINDEC
	CLR	R2
	ADD	#BLKASC-<FSNASC+4>,R4
	CLR	R0
	call	BINDEC
	call	DATE

	mov	#label,r1	;move label into buffer
	mov	mtbuff,r2
	mov	#lablen,r0

20$:	mov	(r1)+,(r2)+
	sob	r0,20$
	return


.Sbttl	- SEOF1 - Set up EOF1 label

seof1:	mov	#label,r1

	mov	#"EO,(R1)+
	mov	#"F1,(r1)+

	mov	outfil+2,r0		;first 3 characters of file name
	call	w50f

	mov	outfil+4,r0		;second 3
	call	w50f

	movb	#'.,(r1)+		;dot separator

	mov	outfil+6,r0		;extension
	call	w50f

	mov	#blkasc,r4		;point at block number
	mov	r5,r2			;block number in r5
	mov	#0,r0

	call	bindec

	call	date			;and the date

	mov	#label,r1
	mov	mtbuff,r2
	mov	#lablen,r0

10$:	mov	(r1)+,(r2)+		;move label into buffer
	sob	r0,10$

	return


.Sbttl	- SVOL1 - Set up `VOL1` label in the buffer

svol1:	mov	#volab,r1		;point at volume label
	mov	mtbuff,r2		;and at buffer
	.br	lmove			;and move it in


.Sbttl	- Lmove - move ascii data and spaces

lmove:	movb	(r1)+,(r2)+		;move byte
	bne	lmove			;more to move

	tstb	-(r2)			;skip over end of asciz string
	movb	(r1)+,r0		;get number of spaces
	beq	20$			;at the absolute end

10$:	movb	#40,(r2)+
	sob	r0,10$			;all spaces moved?
					;yes
	br	lmove			;move next piece

20$:	return
.Sbttl	Routines from FSM Handler

;The following routines come from the RT-11 handler `FSM`. Notice the
;standard of the code and the comments!

.Sbttl	- Bindec

bindec:
	add	pc,r0
	add	#dectbl-.,r0
10$:	mov	#'0-1,r1
20$:	inc	r1
	sub	@r0,r2
	bpl	20$
	add	(r0)+,r2
	movb	r1,(r4)+
	tst	@r0
	bne	10$
	return

dectbl:	.word	10000.,1000.,100.,10.,1,0
.Sbttl	- DATE - Convert an RT-11 Date to YYDDD Format

date:	.date
	mov	r0,r2		;position correctly
	mov	r2,r1
	asr	r1
	bic	#140777,r1
	swab	r1
	mov	pc,r4
	add	#montab-.,r4
	add	r1,r4
	mov	@r4,r3
	cmp	r1,#4
	ble	1$
	bit	#3,r2
	bne	1$
	inc	r3
1$:	mov	r2,r1
	asr	r1
	asr	r1
	asr	r1
	asr	r1
	asr	r1
	bic	#177740,r1
	add	r1,r3
	bic	#177740,r2
	beq	2$
	add	#72.,r2
2$:	mov	pc,r4
	add	#darea-.,r4
	mov	#6,r0
	call	bindec
	mov	r3,r2
	mov	#4,r0
	jmp	bindec
	jan	=	0
	feb	=	jan + 31.
	mar	=	feb + 28.
	apr	=	mar + 31.
	may	=	apr + 30.
	jun	=	may + 31.
	jul	=	jun + 30.
	aug	=	jul + 31.
	sep	=	aug + 31.
	oct	=	sep + 30.
	nov	=	oct + 31.
	noel	=	nov + 30.
montab:	.word	0
	.word	jan,feb,mar,apr,may,jun,jul,aug,sep,oct,nov,noel
.Sbttl	Label Areas

.Psect	tapdat

;HDR label

dummy	=	0
SPACE	=	40
LABEL:	.ASCII	/HDR1/
XAREA:	.REPT	9.
	.BYTE	DUMMY
	.ENDR
	.REPT	8.
	.BYTE	SPACE
	.ENDR
	.ASCII	/RT11A /
	.ASCII	/0001/
FSNASC:	.BYTE	DUMMY,DUMMY,DUMMY,DUMMY
	.ASCII	/0001/
	.ASCII	/00/
	.BYTE	SPACE
DAREA:	.REPT	5
	.BYTE	DUMMY
	.ENDR
	.ASCII	/ 00000/
	.ASCII	/ /
	.ASCII	/0/
BLKASC:	.BYTE	DUMMY,DUMMY,DUMMY,DUMMY,DUMMY
SYSCOD:	.ASCII	/DECRT11A /
	.REPT	11.
	.BYTE	SPACE
	.ENDR
	.EVEN
lablen	=	<.-label>/2	;length of label, in words


;VOLUME label

VOLAB:	.asciz	/VOL1RT11A/
	.byte	28.			;28 spaces
	.asciz	/D%B/
	.byte	10.
	.asciz	/1/
	.byte	28.
	.asciz	/3/
	.byte	0			;end of label


.endc	; if ne ..save
.Sbttl	Buffer Header Blocks

.Psect	tapdat

descrp:	.blkb	b.size * 10	;space for descriptors


.Sbttl	Null file name - for non-structured lookup

nulfil:	.rad50	/            /


.Sbttl	Other Data

tblock:	.word	0		;blocks on tape
				;physical block of 8Kb, NOT 512 bytes
mtdate:	.word	0
mttime:	.word	0,0
mtblok:	.word	0

vrmsg:	.blkw	1		;pointer to message showing what we're doing

mtflag:	.word	0		;For keeping track of MT eof/errors
mtqued:	.word	0		;Count of MT records queued
problk:	.word	0		;Count of successfully processed bufferfuls

.Sbttl	TCRLF - Type a <cr><lf>

.Psect	savtap

tcrlf:	type	<>
	return
.Sbttl	Messages

.Psect	tapmsg

resmsg:	.ascii	/RESTORE/<200>
vermsg:	.ascii	/VERIFY/<200>

hload:	x
x <You must now remove the tape currently in the drive and load the next tape>
x <(Magnetic tape if the device is MT: or MS:, Cartridge if the device is SC:>
x
x <When the magtape is ready for use the ON-LINE light will come on.  The>
x <cartridge is always ready! (Hopefully you put the cartridge in properly?)>
x
x <Press the RETURN key to tell the computer it may continue.>
x
	.byte	0

hdrerr:	x
x <The block indicated cannot be accessed. Either enter "Y" (Yes) to ignore>
x < it and continue or "N" (No) to stop.>
x
	.byte	0

hsize:	x
x <If you answer "Y" (Yes), the disc image, although the wrong size, will be>
x <restored. If you answer "N" (No), the image will not be restored.>
x
	.byte	0


	.if ne <..rest ! ..veri>
oldfmt:	x
x <The tape in the drive either has a corrupted header block or is in the>
x <format used in SAVRES 4.2b or earlier. Answer "Y" (yes) if the tape is>
x <in an older format and you wish to use the disc image held on it.>
x <Answer "N" (no) if you do not wish to proceed.>
x
	.byte	0
	.endc


	.if ne ..save
hnovr:	x
x <Attempting to place multiple disc images on a tape which has previously>
x <been overwritten is not permitted. Saving disc images on an uninitialised>
x <tape may be done by selecting the overwrite option.>
x
	.byte	0

verpas:	x
x <If you answer "Y" (Yes), the disc image will be verified against the disc.>
x <If you answer "N" (No), a verification pass will not be made.>
x
	.byte	0
	.endc


tapunl:	x
x <If you answer "Y" (Yes), the tape will be unloaded.>
x <If you answer "N" (No), the tape will be rewound.>
x
	.byte	0

tload:	x
x <If you answer "Y" (Yes), another attempt will be made to rewind the tape.>
x <If you answer "N" (No), SAVRES will quit now.>
x
	.byte	0

.end

savflp.mac
.TITLE	savflp - SAVRES floppy disc routines
.Enable	lc,gbl
.Nlist	bex

.Ident	/07.01/

.Psect	savflp

.iif ndf debug debug = 0


.Sbttl	Documentation
				.if ne 0
	Floppy Disc overlay

	EDITED	26-APR-84 T.A.E. FIX DMBLK IN DSKERR
		27-APR-84 T.A.E. FIX BAD BRANCH IN DSKERR
		01-MAY-84 T.A.E. ALL DISc I/O COMPLETION TYPE
		01-MAY-84 T.A.E. FIX R2,R3 FOR COMPLETION ROUTINE
		01-FEB-85 C.E.C. Disc partitioning added
		16-Feb-87 C.G.W. Re-vamp macros due to assembly problems
				.endc
.Sbttl	Macros etc

.macro	type	text
	.save
	.psect	flpmes
$$$=.
	.asciz	@text@
	.restore
	.print	#$$$
.endm	type

.macro	typen	text
	.save
	.psect	flpmes
$$$=.
	.ascii	@text@<200>
	.restore
	.print	#$$$
.endm	typen

;Macro to type a string with full control in the string itself

.macro	typex	text
	.save
	.psect	flpmes
$$$=.
	.ascii	text
	.restore
	.print	#$$$
.endm	typex

;get input and provide help, if requested

;format is

;	getin	input buffer, address if help, help text(up to three)

.macro	GETIN,inbuf,hlpadd,hlptx1,hlptx2,hlptx3,?d
	.narg	args

	.gtlin	#inbuf

	cmpb	inbuf,#'?
	bne	d
.iif gt args-2	.print	hlptx1
.iif gt args-3	.print	hlptx2
.iif gt args-4	.print	hlptx3
.iif gt args-5 .error	hlpadd	;too many arguments
	jmp	hlpadd
d:
.endm


;Macro to tidy up help messages

.macro	x	string
.ascii	|'string'|<cr><lf>
.endm	x



	.MCALL	.LOOKUP,.ENTER,.PRINT,.DSTATUS,.SPFUN
	.MCALL	.READC,.WRITW,.READW,.WRITC,.EXIT,.FETCH
	.MCALL	.WAIT,.QSET,.GTLIN,.CLOSE,.TTYOUT
	.mcall	.settop,.releas
.Sbttl	Floppy Disc Save

FLPSAV::
	mov	#dklun,d$lun
	call	flblok			;ask for any block limits

	mov	#outfil,r2
	.lookup	#area,#flplun,r2
	bcs	1$			;open failure

	mov	#infil,r2
	.lookup	#area,d$lun,r2
	bcc	5$
1$:	jmp	errfnf			;open failure
5$:
	MOV	outfil,SFBLK		;Setup device for NEWVOL
	call	DSKSIZ			;Size DM (infil address in R2)
	MOV	DSKBLK,DMSIZ		;Save size
	mov	dskblj,dmsiy
	MOV	BEGBLK,DMBLK		;Setup starting block
	add	begblj,d$lun
	call	SIZFLP			;Size floppy
	MOV	#32.,FLPBLK		;Setup floppy starting block
	MOV	#1,VOLNUM		;Setup floppy starting volume
	call	NEWVOL			;Mount a discette
	MOV	#-1,AFLG		;Say buffer A ready
	MOV	#-1,BFLG		;Say buffer B ready
10$:	mov	DMSIZ,r0		;Any blocks left ?
	bis	dmsiy,r0
	BNE	15$
	JMP	FSDONE			;Branch if not
15$:	tst	cflg			;crash?
	beq	16$			;no
	jmp	crash

16$:	TST	AFLG			;Buffer A ready ?
	BEQ	40$			;Branch if not
	MOV	#FLBSIZ,TSIZE		;Default transfer size
	tst	dmsiy			;More than TSIZE blocks left ?
	bne	20$
	CMP	DMSIZ,TSIZE
	BHIS	20$			;Branch if so
	MOV	DMSIZ,TSIZE		;Else correct transfer size
20$:	call	CONVRT			;Convert to word count
	MOV	R0,WCNTA		;Word count for buffer A
	call	CSETUP			;SETUP FOR COMPL ROUTINE
	.READC	#AREA,d$lun,BUFFRA,WCNTA,#DSKCOM,DMBLK
	BCS	24$
22$:	TST	GODOT			;WAIT TO FINISH
	BEQ	22$
	.WAIT	d$lun			;WAIT & GET ERROR
	BCC	25$			;OK
24$:	.WAIT	d$lun
	mov	buffra,r2		;point r2 at buffer
	mov	wcnta,r3		;size of transfer
	call	dskerr			;and try to recover

25$:	SUB	TSIZE,DMSIZ		;Count DM blocks
	sbc	dmsiy
	ADD	TSIZE,DMBLK
	adc	d$lun
	CMP	FLPBLK,FLPSIZ		;End of volume ?
	BLO	30$			;branch if not
	INC	VOLNUM			;Count volume
	call	NEWVOL			;Get new volume
	MOV	#32.,FLPBLK		;Setup starting block
30$:	.WRITC	#AREA,#FLPLUN,BUFFRA,WCNTA,#WCA,FLPBLK
	BCC	35$

	call	erwflp			;write failure
	jmp	crash

35$:	CLR	AFLG			;Say A busy
	ADD	TSIZE,FLPBLK		;Count floppy blocks
40$:	tst	cflg			;crash?
	beq	41$
	jmp	crash

41$:	TST	BFLG			;B available ?
	BEQ	10$			;Branch if not
	mov	DMSIZ,r0		;Any more to transfer
	bis	dmsiy,r0
	bne	42$
	jmp	fsdone			;Branch if not
42$:	MOV	#FLBSIZ,TSIZE		;Default transfer size
	tst	dmsiy			;More than TSIZE blocks left ?
	bne	50$
	CMP	DMSIZ,TSIZE		;More than TSIZE blocks left ?
	BHIS	50$			;Branch if so
	MOV	DMSIZ,TSIZE		;Else correct transfer size
50$:	call	CONVRT			;Convert to word count
	MOV	R0,WCNTB		;Word count for buffer B
	call	CSETUP			;SETUP FOR COMPL.
	.READC	#AREA,d$lun,BUFFRB,WCNTB,#DSKCOM,DMBLK
	BCS	54$
52$:	TST	GODOT
	BEQ	52$
	.WAIT	d$lun
	BCC	55$
54$:	.WAIT	d$lun
	mov	buffrb,r2		;buffer address
	mov	wcntb,r3		;transfer count..
	call	dskerr			;try to recover

55$:	SUB	TSIZE,DMSIZ		;Count DM blocks
	sbc	dmsiy
	ADD	TSIZE,DMBLK
	adc	d$lun
	CMP	FLPBLK,FLPSIZ		;Need to change volumes ?
	BLO	60$			;Branch if not
	INC	VOLNUM			;Else count volume
	call	NEWVOL			;Get new discette
	MOV	#32.,FLPBLK		;Setup starting block
60$:	.WRITC	#AREA,#FLPLUN,BUFFRB,WCNTB,#WCB,FLPBLK
	BCC	65$

	call	erwflp			;write failure
	jmp	crash

65$:	CLR	BFLG			;Say B busy
	ADD	TSIZE,FLPBLK		;Count floppy blocks
	JMP	10$			;Continue

;	FLPSAV Completion routines

WCA:	BIT	#1,R0		;Test error bit
	BEQ	5$		;Branch if good

	call	erwflp		;write failure
	mov	#-1,cflg	;say crash...

5$:	MOV	#-1,AFLG		;Say A ready

	return
WCB:	BIT	#1,R0		;Test error bit
	BEQ	5$		;Branch if good

	call	erwflp			;write failure
	mov	#-1,cflg		;say crash...

5$:	MOV	#-1,BFLG		;Say B ready
	return

FSDONE:	.WAIT	#FLPLUN
	.WAIT	#FLPLUN
10$:	.CLOSE	d$lun
	dec	d$lun
	cmp	d$lun,#dklun
	bhis	10$
	.CLOSE	#FLPLUN
	MOV	DSKBLK,R3
	mov	dskblj,r2
	call	TYPNUM
	TYPE	< Blocks transferred to floppy>
	JMP	success
.Sbttl	Floppy Disc Restore

FLPRES::
	mov	#dklun,d$lun
	call	flblok			;ask for any block limits

	mov	#infil,r2
	.lookup	#area,#flplun,r2
	bcs	1$			;open failure

	mov	#outfil,r2
	.lookup	#area,d$lun,r2
	bcc	5$
1$:	jmp	errfnf			;open failure
5$:
	MOV	infil,SFBLK		;Setup device for NEWVOL
	call	DSKSIZ			;Size DM (#outfil in r2)
	MOV	DSKBLK,DMSIZ		;Save it
	mov	dskblj,dmsiy
	MOV	BEGBLK,DMBLK		;Setup starting block
	add	begblj,d$lun
	call	SIZFLP			;Size floppy
	MOV	#32.,FLPBLK		;Setup floppy starting block
	MOV	#1,VOLNUM		;Setup floppy starting volume
	call	NEWVOL			;Get it
	MOV	#-1,AFLG		;Say A ready
	MOV	#-1,BFLG		;Say B ready
10$:	TST	AFLG			;A ready ?
	BEQ	37$			;Branch if not
	mov	DMSIZ,r0		;Any blocks left to transfer ?
	bis	dmsiy,r0
	BNE	15$
	JMP	FRDONE			;Branch if not
15$:	MOV	#FLBSIZ,TSIZE		;Default transfer size
	tst	dmsiy
	bne	20$
	CMP	DMSIZ,TSIZE		;Are there that many blocks left ?
	BHIS	20$			;Branch if so
	MOV	DMSIZ,TSIZE		;Else correct transfer size
20$:	call	CONVRT			;Convert to word count
	MOV	R0,WCNTA		;Word count for buffer A
	CMP	FLPBLK,FLPSIZ		;Volume overflow ?
	BLO	30$			;Branch if not
	INC	VOLNUM			;Count volume
	call	NEWVOL			;Get new floppy
	MOV	#32.,FLPBLK		;Setup starting block
30$:	.READC	#AREA,#FLPLUN,BUFFRA,WCNTA,#RCA,FLPBLK
	BCC	35$
	mov	#infil,r2
	JMP	errrea			;read error
35$:	CLR	AFLG			;Say A busy
	ADD	TSIZE,FLPBLK		;Count floppy blocks
	SUB	TSIZE,DMSIZ		;Count DM blocks
	sbc	dmsiy
37$:	TST	BFLG			;B ready ?
	BEQ	10$			;Branch if not
	mov	DMSIZ,r0		;Any blocks left to transfer ?
	bis	dmsiy,r0
	BEQ	FRDONE			;Branch if not
	MOV	#FLBSIZ,TSIZE		;Default transfer size
	tst	dmsiy
	bne	40$
	CMP	DMSIZ,TSIZE		;Are there that many blocks left ?
	BHIS	40$			;Branch if so
	MOV	DMSIZ,TSIZE		;Else correct transfer size
40$:	call	CONVRT			;Convert to word count
	MOV	R0,WCNTB		;Setup buffer B word count
	CMP	FLPBLK,FLPSIZ		;Volume overflow ?
	BLO	45$			;Branch if not
	INC	VOLNUM			;Count volume
	call	NEWVOL			;Get new floppy
	MOV	#32.,FLPBLK		;Setup starting block
45$:	.READC	#AREA,#FLPLUN,BUFFRB,WCNTB,#RCB,FLPBLK
	BCC	50$
	mov	#infil,r2
	jmp	errrea			;read error
50$:	CLR	BFLG			;Say B busy
	ADD	TSIZE,FLPBLK		;Count floppy blocks
	SUB	TSIZE,DMSIZ		;Count DM blocks
	sbc	dmsiy
	JMP	10$			;Do forever

FRDONE:	.WAIT	#FLPLUN
	.WAIT	#FLPLUN
10$:	.CLOSE	d$lun
	dec	d$lun
	cmp	d$lun,#dklun
	bhis	10$
	.CLOSE	#FLPLUN
	MOV	DSKBLK,R3
	mov	dskblj,r2
	call	TYPNUM
	TYPE	< Blocks transferred to disc successfully>
	JMP	success


;	FLPRES	Completion routines

RCA:	BIT	#1,R0			;Test error bit
	BEQ	5$			;Branch if good
	call	erwflp			;nbg

5$:	.WRITW	#AREA,d$lun,BUFFRA,WCNTA,DMBLK
	BCC	10$

	MOV	R2,-(SP)		;IN A COMPLETION ROUTINE
	MOV	R3,-(SP)		;WE MUST SAVE THESE
	mov	buffra,r2		;point at buffer
	mov	wcnta,r3		;transfer count...
	call	dskerr			;try to recover
	MOV	(SP)+,R3		;RESTORE
	MOV	(SP)+,R2		;THESE

10$:	MOV	#-1,AFLG		;Say A ready
	MOV	WCNTA,R0		;Get word count
	SWAB	R0			;Make block count
	BIC	#177400,R0
	ADD	R0,DMBLK		;Count blocks
	adc	d$lun
	return

RCB:	BIT	#1,R0			;Test error bit
	BEQ	5$			;Branch if good
	mov	#infil,r2
	jmp	errrea			;read error
5$:	.WRITW	#AREA,#DKLUN,BUFFRB,WCNTB,DMBLK
	BCC	10$

	MOV	R2,-(SP)		;COMPLETION ROUTINE
	MOV	R3,-(SP)		;SAVE
	mov	buffrb,r2		;point at buffer
	mov	wcntb,r3		;transfer count...
	call	dskerr			;try to recover
	MOV	(SP)+,R3		;RESTORE REGS
	MOV	(SP)+,R2

10$:	MOV	#-1,BFLG		;Say B ready
	MOV	WCNTB,R0		;Get word count
	SWAB	R0			;Make block count
	BIC	#177400,R0
	ADD	R0,DMBLK		;Count blocks
	adc	d$lun
	return
.Sbttl	Subroutines


;DISC COMPLETION ROUTINE, BIT 0 OF R1 SET = HARDWARE ERROR

DSKCOM:	MOV	#-1,GODOT		;AS IN WAITING FOR
;	BIT	#1,R0			;NO ERROR
;	BEQ	COMOK			;NO ERROR
;	MOV	#-1,COMERR		;WE GOT AN ERROR
COMOK:	return				;BACK

;COMPLETION SETUP ROUTINE

CSETUP:	CLR	GODOT			;SET WAIT FLAG
;	CLR	COMERR			;CLEAR ERROR FLAG
	return

;try to recover from a disc error

;call:	r2	buffer pointer
;	r3	transfer count, in words

.Enabl	lsb

dskerr:	swab	r3			;make number of blocks

	MOV	DMBLK,-(SP)		;SAVE DMBLK
	mov	d$lun,-(sp)
;	call	SAYERR
;	BR	OVER
;SAYERR:
;	MOV	R2,-(SP)
;	MOV	52,R2
;	TYPEN	<ERROR BYTE = >
;	MOV	52,R2
;	call	TYPNUM
;	TYPE	<>
;	MOV	(SP)+,R2
;	return
;OVER:
10$:;;	MOV	#256.,R1
	bit	#$rest,pstat		;read or write?
	bne	15$			;write

	call	CSETUP			;SET UP FOR COMPLETION
	.readC	#area,d$lun,r2,#256.,#DSKCOM,dmblk	;read block
	bcs	30$			;block in error found
12$:	TST	GODOT			;WAIT TILL FINISHED
	BEQ	12$
	.WAIT	#DKLUN
	BCS	30$
	br	20$

15$:	.writw	#area,d$lun,r2,#256.,dmblk	;write block
	bcs	30$			;block in error found

20$:	add	#512.,r2		;position buffer pointer at next block
	inc	dmblk			;and the block number
	bne	25$
	inc	d$lun

25$:	sob	r3,10$			;more blocks to read?##(WAS 20$)
					;no - finished

	mov	(sp)+,d$lun
	MOV	(SP)+,DMBLK		;RESTORE DMBLK
	return				;just return and continue

;error found in block just read

30$:
;	call	SAYERR
	mov	r2,-(sp)		;save buffer pointer
	mov	r3,-(sp)
	type	<>			;ask the user
	typen	<Disc error at Block: >
	mov	dmblk,r3
	mov	d$lun,r2
	sub	#dklun,r2
	call	typnum
	typen	< Ignore and Continue [Y/N]?>
	mov	(sp)+,r2

	getin	tlinb,30$,#hdrerr

	cmpb	#'Y,tlinb		;continue?
	beq	20$			;yes - just ignore the error

	type	<>

	typen	<Fatal disc error at Block: >
	mov	dmblk,r3
	mov	d$lun,r2
	sub	#dklun,r2
	call	typnum
	type	<>
	jmp	crash

.Dsabl	lsb


;allow floppy block limits to be specified

.Enabl	lsb

flblok:	typen	<Do you want to transfer specific blocks only [Y/N]?>
	getin	tlinb,flblok,#hblok

	cmpb	#'Y,tlinb		;yes?
	bne	80$			;no....

10$:	typen	<Starting block number: >

	.gtlin	#tlinb			;get response
	cmpb	#'?,tlinb		;want help?
	bne	15$			;no

	type	<Specify the block number on the disc from where you want>
	typen	<to start >

	bit	#$rest,pstat		;restore?
	bne	12$			;yes

	type	<saving information>
	br	10$

12$:	type	<restoring information from the floppy>
	br	10$

;get starting block number

15$:	mov	#tlinb,r1
	call	rd2
	bcs	90$			;error

	mov	r3,begblk		;save start block
	mov	r2,begblj

;ask for end block

20$:	typen	<End block number     : >

	.gtlin	#tlinb

	cmpb	#'?,tlinb		;help wanted?
	bne	25$			;no

	type	<Specify the block number at which you want to finish tranferring>
	typen	<information >

	bit	#$rest,pstat		;restore?
	bne	22$			;yes

	type	<from the disc>
	br	20$

22$:	type	<to the disc>

	br	20$

;get end block number

25$:	mov	#tlinb,r1
	call	rd2
	bcs	90$

	mov	r3,endblk		;save end block
	mov	r2,endblj

	sub	begblk,r3		;check block numbers
	sbc	r2
	sub	begblj,r2
	blt	95$			;cannot have negative transfer!


80$:	return				;thats all folks

90$:	type	<Illegal number entered!>

92$:	type	<>
	br	flblok
95$:	type	<Starting block number must be less than End block number>
	br	92$

.Dsabl	lsb


;	Get new floppy volume

.Enabl	lsb

NEWVOL:
	tst	nvflag
	beq	7$

6$:	TYPEN	<Mount volume >
	MOV	VOLNUM,R0		;Get volume number
	CALL	WDT			;Write to terminal
	TYPEN	< in >
	MOV	SFBLK,R0
	CALL	W50T			;Display device name
	TYPEN	<: and type the RETURN key to continue.>

	getin	tlinb,6$,#hfmou

7$:	.LOOKUP	#AREA,#AUXLUN,#SFBLK	;Open SAV: non file-structured
	BCC	1$
	TYPE	<Cannot find Floppy Disc>
3$:	TST	(SP)+			;Cleanup stack
	JMP	CRASH
1$:	.READW	#AREA,#AUXLUN,BLKBUF,#256.,#1
	BCC	2$
	TYPE	<Cannot read first block of Floppy Disc>
	.CLOSE	#AUXLUN
	MOV	#-1,NVFLAG		;Flag for prompt
	BR	6$			;Try again

;	Read volume number from home block
2$:	.CLOSE	#AUXLUN			;Close channel
	MOV	BLKBUF,R1
	ADD	#730,R1			;Point to string
	CALL	RD			;Convert to number
	CMP	R0,VOLNUM		;Is it the correct volume ?
	BEQ	4$			;Branch if so

5$:	TYPE	<You have mounted the wrong volume.>
8$:	TYPEN	<Please mount volume >
	MOV	VOLNUM,R0		;Get volume number
	CALL	WDT			;Display it
	TYPEN	< in >
	MOV	SFBLK,R0
	CALL	W50T			;Display device name
	TYPEN	<: and type the RETURN key to continue.>

	GETIN	tlinb,5$,#hfwrv

	BR	7$			;Wait till he is ready

4$:	mov	#-1,nvflag
	return

.Dsabl	lsb


;size floppy disc

.Enabl	lsb

SIZFLP:	TYPEN	<Mount volume 1 in >
	MOV	SFBLK,R0
	CALL	W50T			;Display floppy unit number
	TYPEN	<: and type the RETURN key to continue.>

	getin	tlinb,sizflp,#hfmou1

	.SPFUN	#AREA,#FLPLUN,#sp.psz,#FLPSIZ,#1,#0
	BCC	10$
	TYPE	<Cannot get size of Floppy Disc>
	JMP	CRASH
10$:	sub	#<flbsiz-1>,flpsiz	;makes accounting easier later
	clr	nvflag			;no mount message
	return

.Dsabl	lsb


;floppy disc error routines

erwflp:
	mov	#outfil,r2
.if eq debug				;if debug mode
	jmp	errwri
.iff
	mov	(sp),r1			;get address

	mov	r5,-(sp)
	mov	r4,-(sp)
	mov	r3,-(sp)
	mov	r2,-(sp)
	mov	r1,r3
	movb	@#errbyt,-(sp)		;save error as well
	mov	r0,-(sp)
	.wait	#flplun			;wait for any i/o on the floppy
					;finish
	type	<>
	typen	<From: >
	clr	r2
	call	typoct
	typen	< R0: >
	mov	(sp)+,r3
	clr	r2
	call	typoct
	typen	< Block: >
	mov	flpblk,r3
	clr	r2
	call	typnum
	typen	< Error: >
	movb	(sp)+,r3		;get back error
	clr	r2
	call	typoct
	typen	< AFLG: >
	mov	aflg,r3
	clr	r2
	call	typoct
	typen	< BFLG: >
	mov	bflg,r3
	clr	r2
	call	typoct

	type	<>


	typen	<BUFFRA: >
	mov	buffra,r3
	clr	r2
	call	typoct
	typen	< WCNTA: >
	mov	wcnta,r3
	clr	r2
	call	typoct

	typen	< BUFFRB: >
	mov	buffrb,r3
	clr	r2
	call	typoct
	typen	< WCNTB: >
	mov	wcntb,r3
	clr	r2
	call	typoct

	typen	< FLPSIZ: >
	mov	flpsiz,r3
	clr	r2
	call	typnum
	type	<>

	mov	(sp)+,r2
	mov	(sp)+,r3
	mov	(sp)+,r4
	mov	(sp)+,r5
	return

.endc

.Enabl	lsb

errrea::typex	<<cr><lf>/Error reading /<200>>
	br	10$

errwri::typex	<<cr><lf>/Error writing /<200>>
10$:	jmp	filerr

.Dsabl	lsb

cflg:	.word	0		;non-zero if crashing
GODOT:	.WORD	0		;DISC COMPLETION FLAG
d$lun:	.word	0		;DM partition channel


;Timeout Value

TIMOUT	==	-1
.Sbttl	Help Text

cr	=15
lf	=12
esc	=33
dollar	='$


hblok::
x <When Saving or Restoring to or from Floppy Disc (DY:, SF:) you may specify>
x <the block numbers you wish to start and end the transfer with. This>
x <allows you to either Save just a portion of a disc, or to Restore>
x <to a specific place on a disc>
	.byte 0

hfmou:
x <You must now remove the floppy disc currently in the drive and load the>
x <next consecutive numbered floppy disc>
	.byte	0

hfmou1:
x <You must now load in the drive the floppy disc with the Volume Label '1'.>
x <This floppy must be the first of the Save or Restore floppy disc set>
	.byte	0

hfwrv:
x <The floppy disc in the drive has the wrong VOLUME label.  Replace it>
x <with the floppy with the right VOLUME label.  Volume labels are created>
x <on floppies with the INIT/VOL command.>
	.byte	0

hdrerr:	.ascii	<cr><lf>
x <The block indicated cannot be accessed. Either enter 'Y' (Yes) to ignore>
x < it and continue or 'N' (No) to stop.>
	.byte	0

	.even

.END

savres.cmp
!SAVRES.CMP - Command file for compressing sources of SAVRES

run comprs
c
savres.src
savres.mac
savrex
savini
savsav,savrst,savver,savtap
savflp
savres.cmp
savres.dis

x
!End of SAVRES.CMP

savres.dis
!SAVRES.DIS - Distribution Command File
R PIP
out:*.*=in:READ.ME
out:*.*=in:SAVRES.RNO
out:*.*=in:SAVRES.DOC
out:*.*=in:SAVRES.SRC
out:*.*=in:SAVRES.COM
out:*.*=in:COMPRS.SAV
out:*.*=in:SCNEW.MAC
out:*.*=in:SCNEW.TSX
out:*.*=in:SCNEW.SYS
out:*.*=in:TSXPRE.MAC
out:*.*=in:SETLIN.MAC
out:*.*=in:SETLIN.SAV
out:*.*=in:SETLIN.DOC
out:*.*=in:PCLV11.DOC
out:*.*=in:SCOLD.COM
out:*.*=in:SCOLD.MAC
out:*.*=in:SCBLOK.COM
out:*.*=in:SCBLOK.MAC
out:*.*=in:SB.SYS
out:*.*=in:CUTIL.MAC
out:*.*=in:CUTIL.SAV
out:*.*=in:REGDEF.MAC
out:*.*=in:SCBOOT.SAV
out:*.*=in:SCINIT.MAC
out:*.*=in:SCINIT.SAV
out:*.*=in:SYSGEN.CND
out:*.*=in:XM.MAC
out:*.*=in:DEBUG.MAC
out:*.*=in:SAVRES.DIS
^C

