.Enable	lc
;
	.TITLE	TPC - TAPE/DISK COPY UTILITY
$VAX=1		; Define version for very large tape records (11000 bytes)
;
	.SBTTL	Introduction
;
        .IDENT  /V01.75/
;
	.MCALL	GCMLB$,GCML$,CSI$,CSI$1,CSI$2,CSI$SW,CSI$ND,DIR$,PUT$
        .MCALL  FDBDF$,FDAT$R,NMBLK$,WTSE$S,GET$,EXIT$S,FINIT$	;JKN02
	.MCALL	QIOW$,OFNB$,CSI$SV,FSRSZ$
	.MCALL	ALUN$S,CLOSE$
	.MCALL	QIOW$S,ASTX$S,FDOP$R,QIO$S,CLEF$S,SETF$S
	.NLIST	BEX
;+
;
; TPC -- Fast Tape/Disk/Tape Copy Utility
;
; Version 01.75
;
; This routine will preserve any arbitrary format magtape in an image form
; on disk, or restore an image format file from disk to magtape.
;
; Its utility is its ability to drive the magtape at full speed.   This
; feature is useful when making many copies of DOS-11 magtapes.   The RSX-11
; Files-11 file is compatible with FCS variable length, block spanned
; record mode.
;
;
; Reid L Brown	27-Oct-77
;
; Modified by:
;
;	G H Cohen, 21-Aug-78
;	1) Insert a default value for file allocation size.
;	2) Use .TRNCL in place of .CLOSE.
;	3) Provide a means for file extension.
;	4) Attach to magtape unit and set density to 800BPI.
;
;+AF1	Alan E. Frisbie, 31-Jan-80
;	When moving error codes to MTERR or DSKERR, use MOVB instead of MOV,
;	followed by a MOVB #-1 if the result is negative.   This corrects the
;	problem of error numbers being printed as a positive value.
;
;+AF2	Alan E. Frisbie, 12-Mar-80
;	Enlarge buffer size to handle larrrrrrrge records (4200. bytes).
;	This allows TPC to copy DSC and BRU tapes.
;
; gce02 Glenn C. Everhart, 15-Dec-81
;	Add /ANsi switch to check for EOV as 1st 3 bytes in 80 byte
;	records seen. This should allow BIGTPC to copy ANSI tapes without
;	errors due to null files.
; 	Add /SC:nnnnnn switch to allow one to set tape characteristics
;	to nnnnnn (in RSX format) to handle really strange tape formats
;	Add processing to write 4 extra EOFs on tape at EOV and back-space
;	over all but 1 EOF to permit easy appending to FLX format tapes.
;	(The 4 EOFs will allow TPC input to stop fully when reading
;	the tapes in.)
;	Add /EB switch as subset of /ANsi switch, specifying EBCDIC
;	labels. Note that /AN will check for EITHER set
;	depending on this but not both.
;
; gce03 Glen C. Everhart, 3-Jan-83
;	Add /RT11 switch to handle RT11 variant ANSI format (512 byte labels).
;	Add /TR and /TW and associated logic for disk-disk copies in both
;	directions. Improve help message to give defaults. Change default
;	to /ANsi and make switches negatable.
;
; gce04 Glenn C. Everhart, (V01.40)
;	Add /FLX:NAME switch to allow creation of pseudo-FLX-type label
;	record in [1,1] on output tape.
;
; JKN01 Jim Neeland, (V01.44)
;	Add tape device "MF" to list to support TU78's.
;
; GCE04 Glenn Everhart
;	Conditional $VAX will define a "BIGGERTPC" to handle records up
;	to 11000. bytes long (works fine on VAX).
;
;+AF3   Alan E. Frisbie, 11-May-83  (V01.50)
;	Add /VE (Verify) and /CM (Compare) switches.
;	Make TPC serially re-usable when switching Tape/Disk directions.
;	Also do general cleanup of local symbols (using KED).
;
;JKN02  Jim Neeland, 3-Jun-83 (V01.51)
;       Add call to FINIT$ so files don't go to/from [0,0]!
;
;GCE05  Glenn Everhart, 23-Jun-83 (V01.70)
;	Add support for passing beyond the eov/eot to the double EOF
;	beyond it (if any...)
;
;???00  Unknown X. Unknown, ??-???-?? (V01.71-V01.74)
;	Various miscellaneous changes, including:
;		1) Add MU: and MA: to list of tape devices
;		2) Add /MI (Magtape In) and /MO (Magtape Out) switches
;		   to force a device to be treated as a tape (useful
;		   if new tape devices are ever defined).
;
;+AF4   Alan E. Frisbie, 26-Jun-91  (V01.75)
;	Fix serious bug in AST routines: none of them ever saved
;	R0-R5!!!   Since only one AST routine could ever execute
;	at a time (and the mainline code was suspended), this
;	bug has gone undetected for 14 years.
;	It finally bit me when I tried to go disk-to-tape from
;	a high-speed caching disk controller.   The first QIO
;	completed (and triggered the AST) before the second QIO
;	was issued.   The registers were then clobbered, causing
;	the remainder of the setup code to execute incorrectly.
;
;-
;
; Local MACROS
;

	.MACRO	ERRMSG	MESSAG,WHERE,?A,?B,?C
	BR	C
A:	.ASCII	^MESSAG^
B:	.EVEN
C:	MOV	#A,QIO+Q.IOPL
	MOV	#B-A,QIO+Q.IOPL+2
	DIR$	#QIO
	.IIF	DF,WHERE	JMP	WHERE
	.ENDM	ERRMSG

	.MACRO	PAUSE
	CLEF$S	#16.
	WTSE$S	#16.
	.ENDM	PAUSE

	.MACRO	RESUME
	SETF$S	#16.
	.ENDM	RESUME

;
; Allocate FSR area
;

	FSRSZ$	3			; Allocate 3 buffers
	.page
	.SBTTL	CSI & FCS data & buffers
;
; File descriptor blocks & related information
;

FDBST:				; Start of FDB'S
FDBINP::FDBDF$			; Define input FDB
FDBOUT::FDBDF$			; Define output FDB
FDBEND:				; End address of FDB'S

GCMBLK:	GCMLB$	3,TPC,,TILUN	; Command line control block

INDFN:	NMBLK$	TAPECOPY,TPC,,SY,0		; Default input filename
OUTDFN:	NMBLK$	TAPECOPY,TPC,,SY,0		; Default output filename

;
; LUNS
;

INLUN=	1			; Input file on 1
OUTLUN=	2			; Output file on 2
TILUN=	5			; GCML & QIO'S to #5 (Default from TKB)

;
; Command string interpreter
;

CSIFLG:	.WORD	0		; Flag word for command switches

HLPMSK=	1			; /HE - Print help message
BLKMSK= 2			; /BL - Allocate blocks
SALMSK= 4			; /SA - Secondary allocation (blocks)
CONMSK= 10			; /CO - Contiguous file
HDMSK=20			; /HD - 1600 BPI tape I/O
NRMSK=40			; /NR - No rewind before start
ERMSK=100			; /ER - Ignore errors (except end-tape, EOV)
SCMSK=200			; /SC:NNNNNN set characteristics to NNNNNN (Octal)
EVMSK=400			; /EV = Copy to EOV1/2, ignore IE.EOT/IE.EOV
ANSFLG:	.WORD	0	; Flag nonzero for ANSI tapes
ANSCNT:	.WORD	0	; Count of EOV1 or EOV2 records seen
HDRLVL:	.WORD	0	; Count bumped up by HDR2 and down by EOF2 or EOV2

CSISW:	CSI$SW	HE,HLPMSK,CSIFLG
	CSI$SW	BL,BLKMSK,CSIFLG,SET,NEG,ALCTAB
	CSI$SW	SC,SCMSK,CSIFLG,SET,NEG,SCTAB
	CSI$SW	SA,SALMSK,CSIFLG,SET,NEG,SALTAB
	CSI$SW	CO,CONMSK,CSIFLG,SET,NEG
	CSI$SW	EV,EVMSK,CSIFLG,SET,NEG	;GCE05
	CSI$SW	HD,HDMSK,CSIFLG,SET,NEG
	CSI$SW	NR,NRMSK,CSIFLG,SET,NEG
	CSI$SW	ER,ERMSK,CSIFLG,SET,NEG
	CSI$SW	AN,1,ANSFLG,SET,NEG
	CSI$SW	EB,2,ANSFLG,SET,NEG	; /EBCDIC label flag
	CSI$SW	RT,4,ANSFLG,SET,NEG	; /RT11 version of ANSI format
;
; New switches for counts
; allows copy of disk to disk
; /TR = Tape in reading to file
; /TW = Tape out writing tape from file
; either ==> disk-disk
; /SZ:NNNNN:MMMMM = Length (low:high) of copy if disk-disk
; /LO:NNNNN:MMMMM = Start blk (octal, lo:hi) of copy on nonfile disk
; /CT - Enable control accesses (density, etc.)
;
;gce04 new switches for image mode copy
; /IM:lo:hi:blkfct
;	Where lo and hi are octal output blk # and blkfct is number of
; 512 byte blocks to buffer onto the output device (default 8.)
;
	CSI$SW	TR,1,D2DMSK,SET,NEG
	CSI$SW	TW,2,D2DMSK,SET,NEG
	CSI$SW	SZ,4,D2DMSK,SET,NEG,SZTAB
	CSI$SW	LO,10,D2DMSK,SET,NEG,LOTAB
	CSI$SW	FR,20,D2DMSK,SET,NEG	; /FR = Rewind after end
	CSI$SW	CT,40,D2DMSK,SET,NEG
	CSI$SW	IM,100,D2DMSK,SET,NEG,IMTAB
	CSI$SW	FL,200,D2DMSK,SET,NEG,FLXNMB
	CSI$SW	NI,400,D2DMSK,SET,NEG	; /NI = Input file read 512 bytes at
					;       a time (nibble in)
	CSI$SW	NO,1000,D2DMSK,SET,NEG	; /NO = Output file write 512 bytes at
					;       a time (nibble out).
					; /NI and /NO work only on /IM copies.
	CSI$SW	MI,1,TFAKMK,SET,NEG	; /MI for Magtape In (override dev parse)
	CSI$SW	MO,1,TFAKMK,SET,NEG	; /MO for Magtape Out (override dev parse)
	CSI$SW	CM,1,VFYMSK,SET,NEG	;+AF3 /CM = Compare tape with existing file
	CSI$SW	VE,2,VFYMSK,SET,NEG	;+AF3 /VE = Verify Tape/Disk transfers
;
;
	CSI$ND


 .GLOBL LOLO,LOHI,SZLO,SZHI,START,D2DMSK,FDBINP,FDBOUT,INVEC
 .GLOBL OUTVEC,HELP,TPLHD,DSKLHD,DSKTTP,TPTDSK,MAGTST,WAIT
 .GLOBL ERROR,TAPEIN,DSKOUT,TPDKDQ,DSKIN,TAPOUT,DKTPDQ,NODADD,NODDEL
;
ALCTAB:	CSI$SV	DECIMAL,ALLOC,2
SALTAB:	CSI$SV	DECIMAL,SALOC,2
SCTAB:	CSI$SV	OCTAL,SCVAL,2
SZTAB:	CSI$SV	OCTAL,SZLO,2
	CSI$SV	OCTAL,SZHI,2
LOTAB:	CSI$SV	OCTAL,LOLO,2
	CSI$SV	OCTAL,LOHI,2
IMTAB:	CSI$SV	OCTAL,IMLO,2
	CSI$SV	OCTAL,IMHI,2
	CSI$SV	DECIMAL,IMBF,2
FLXNMB:	CSI$SV	ASCII,FLXNAM,6
	CSI$ND
FLXNAM:	.ASCII	/IMGFIL/
;
; FLX type label block (To write if image mode copy to tape)
;
LBLBK:	.RAD50	/IMG/
	.RAD50	/FIL/
	.RAD50	/OLB/	; Pick a file type FLX treats in image mode
	.BYTE	1,1	; UIC [1,1]
	.WORD	233	; Standard DOS protection
	.WORD	1	; Forget the date of creation ... dunno how to do easily
	.WORD	0	; Spare in DOS, last 3 name chars in RSX FLX
;
; End of DOS label block
;
SCVAL:	.WORD	0	; charac. value.
ALLOC:	.WORD	-100.	; Allocation value [+/-]
SALOC:	.WORD	-50.	; Secondary allocation value [+/-]
TFAKMK:	.WORD	0	; Tape fake mask
D2DMSK:	.WORD	0
SZHI:	.WORD	0
SZLO:	.WORD	0	; Length HI,LO words
LOHI:	.WORD	0	; Low blk # HI part
LOLO:	.WORD	0	; and low part
ENDBK:	.WORD	0,0	; End logical block to use (sum of LO, size)
ENDIO:	.WORD	0,0	; Count of I/O dones seen at AST entry
IMHI:	.WORD	0
IMLO:	.WORD	0
IMBF:	.WORD	8.	; Blocking factor
VFYMSK:	.WORD	0	;+AF3 Verify and Compare switches
CMPPAS:	.WORD	0	;+AF3 0 = Normal copy pass,   -1 = Compare pass in progress
SWTDEV:	.WORD	0	;+AF3 0 = Nothing,   -1 = Switch devices for compare pass
	CSI$
CSI:	.BLKB	C.SIZE		; Define the CSI work area
	.EVEN
	.page
	.SBTTL	Help message & text
;
; Error message processing & help
;

QIO::	QIOW$	IO.WVB,TILUN,1,,IOSTAT,,<.-.,.-.,40,.-.,.-.,.-.>
IOSTAT::.WORD	0,0

ERRBUF:	.BLKB	80.

HLPMSG:
.ASCIZ	'TPC -	Tape / Disk utility program'
.ASCIZ	'	This program will copy magtapes to RSX-11 disk'
.ASCIZ	'	files and record them in a special image mode.'
.ASCIZ	'	This allows very fast multiple copies of tapes to be made'
.ASCIZ	'	from the disk image (much faster than FLX).'
	.IF	NDF,$VAX
.ASCIZ	'	Maximum block size is 4200. bytes. per tape block.'
	.IFF
.ASCIZ	'	Maximum block size is 11000. bytes. per tape block.'
	.ENDC
.ASCIZ	' '
.ASCIZ	'	The command format is standard RSX-11:'
.ASCIZ	' '
.ASCIZ	'		TPC>outfile=infile[/BL:nnnn][/SA:mmmm][/CO][/HE]'
.ASCIZ	'	Where:'
.ASCIZ	'		-One "file" must be a magtape device'
.ASCIZ	'		/BL:nnnn = An optional allocation specification'
.ASCIZ	'		 if disk is the output device.'
.ASCIZ	'		/SA:mmmm = An optional secondary allocation amount'
.ASCIZ	'		 if disk is the output device.'
.ASCIZ	'		/CO = Disk file to be contiguous'
.ASCIZ	'		/HE = This help text'
.ASCIZ	'		/NR = Do not rewind tape before use'
.ASCIZ	'		/HD = Use high density (1600 BPI) on tape'
.ASCIZ	'		/ER = Ignore input tape errors except EOT/EOV/EOF'
.ASCIZ	'		/EV = Ignore End-Volume or End-Tape errors'
.ASCIZ	'		/AN = ANSI format tape, use EOV1 and EOV2 for endtape'
.ASCIZ	'		/EB = EBCDIC labels (requires /AN switch)'
.ASCIZ	'		/SC:nnnn Sets tape characteristics to nnnn (octal)'
.ASCIZ	'		/TR = Read disk as if tape, to file on output'
.ASCIZ	'		/TW = Write file to disk as if tape output'
.ASCIZ	'		/SZ:low:high = Size in blks of disk to read on /TR'
.ASCIZ	'		/LO:low:high = Low blk number to start with on'
.ASCIZ	'			nonfile disk'
.ASCIZ	'		/FR = Rewind tape after writing'
.ASCIZ	'		/RT = RT11 version of ANSI format (Not 80 byte lbls)'
.ASCIZ	'		/VE = Verify tape/disk transfer after copy'
.ASCIZ	'		/CM = Compare tape and existing disk file'
.ASCIZ	'		/MI = Magtape In (overrides device name recog.)'
.ASCIZ	'		/MO = Magtape Out (overrides device name recog.)'
.ASCIZ	'		/IM:lo:hi:blkfct = Image copy, output blk no (lo:hi)'
.ASCIZ	'			and block factor args (blkfct=8 default)'
.ASCIZ	'	Image mode subswitches:'
.ASCIZ	'		/FL:filnam = Create FLX label first on tape of'
.ASCIZ	'			filnam.OLB[1,1]<233>'
.ASCIZ	'		/CT = Include control QIOS even if dsk-dsk'
.ASCIZ	'		/NI = "Nibble copy" In (read input in 1 blk a time)'
.ASCIZ	'		/NO = "Nibble copy" Out (wrt output 1 blk at a time)'
.ASCIZ	'	Defaults: /AN/-HD/-EB/BL:100/SA:50/-CO/SZ:494.:0/LO:0:0/-CT'
HLPEND=	.
	.EVEN

DSKERM:	.ASCIZ	'TPC -- Disk I/O error.  Code=%D'
MTERM:	.ASCIZ	'TPC -- Magtape I/O error.  Code=%D'
CMPERM:	.ASCIZ	'TPC -- Compare error.   Files are different.'

	.EVEN
	.page
	.SBTTL	Tape / disk data & tables
;
; Disk & tape operations are entirely AST driven, using linked lists to
; control the sequence of events to be followed.  All buffers for both
; input & output operations are kept in linked lists by types (input or
; output) and are scanned at each AST to see what work needs to be done.
;
; The general format for a list node is:
;
N.FWD	= 0	; WD: 0		[ Link to next node	]
N.BWD	= 2	; WD: 1		[ Link to prior node	]
N.IOST	= 4	; WD: 2		[ I/O status word #0	]
		; WD: 3		[ I/O status word #1	]
N.WRK	= 10	; WD: 4		[ Temporary work var.	]
N.BUF	= 12	; WD: 5		[ Buffer address	]
N.LEN	= 14	; WD: 6		[ Buffer length		]
N.PTR	= 16	; WD: 7		[ Current buffer pointer]
N.BKH	= 20	; WD: 10	[ High order block no.	]
N.BKL	= 22	; WD: 11	[ Low order block no.	]
N.SIZE	= 24	; Size of node
;

	.IF	NDF,$VAX
DSKBKS	=	20.		;+AF2 No. of blocks in disk buffer
	.IFF
DSKBKS	=	8.		; Use small disk buffer to allow big tape buffer
	.ENDC
DSKBFS	= DSKBKS*512.		; Disk buffer size = 16 blocks
DSKBF0:	.BLKB	DSKBFS		; Allocate 1st buffer
DSKBF1:	.BLKB	DSKBFS		; & 2nd buffer

	.IF	NDF,$VAX
TPBFS	= 4200.+2		;+AF2 Tape buffer size = 1 block + 1 word
	.IFF
TPBFS=11000.+2.
	.ENDC
TPBF0:	.BLKB	TPBFS		; Tape buffer 1
TPBF1:	.BLKB	TPBFS		; Tape buffer 2
TPBF2:	.BLKB	TPBFS		; Tape buffer 3
	.IF	NDF,$VAX
TPBF3:	.BLKB	TPBFS		; Tape buffer 4 (Except for big tape buffers)
IMBFMX=<2*DSKBKS>+<4*<TPBFS/1000>>
	.IFF
IMBFMX=<2*DSKBKS>+<3*<TPBFS/1000>>
	.ENDC
 .PRINT IMBFMX ;max buffer for /IM mode
;
; Control variables
;

DSKFCT:	.WORD	DSKBKS		; Disk blocking factor
INVEC:	.WORD	0		; Current input vector
OUTVEC:	.WORD	0		; Current output vector
OUTDVF:	.WORD	0		; Output device flag(-1 for magtape, 0 for disk)
INDVF:	.WORD	0		; Input device flag
MAGDEV:	.WORD	"MM,"MS,"MT,"MF,"MU,"MA,0 ; Magtape device list		;JKN01
IOST:	.WORD	0,0		; I/O status block for simple QIO'S
FLAGS:	.WORD	0		; Disk & magtape flags
MTERR:	.WORD	0		; Magtape error value
DSKERR:	.WORD	0		; Disk error variable
;
; Literals for label string searches for /ANSI switch (modified to
; EBCDIC values if /EB switch seen)
;
LITEO:	.ASCII	/EO/
LITF2:	.ASCII	/F2/
LITVV:	.ASCII	/VV/
LITHD:	.ASCII	/HD/
LITR2:	.ASCII	/R2/
;
; Flag values for disk & magtape flags
;
EOV	= 1	; End of volume seen
EOF	= 2	; End of file seen
ERR	= 4	; Error encountered
DONE	= 10	; Transfer done
CMPERR	= 20	; Compare error
;
; VFYMSK flags
;
CMPFLG	= 1	; Do a compare
VFYFLG	= 2	; Do a verify after this copy
;
	.page
;
; Disk node list
;

DSKLHD:	.WORD	DSKLHD		; Disk node listhead, forward pointer
	.WORD	DSKLHD		;  & backward pointer
				; NOTE: listhead & lists must remain together

DSKLST:	.WORD	0,0,0,0,0,DSKBF0,DSKBFS,DSKBF0,0,0	; Disk node #0
	.WORD	0,0,0,0,0,DSKBF1,DSKBFS,DSKBF0,0,0	; Disk node #1
DSKLND=	.

;
; Tape node list
;

TPLHD:	.WORD	TPLHD		; Tape node listhead address, forward pointer
	.WORD	TPLHD		;  & backward pointer

TPLST:	.WORD	0,0,0,0,0,TPBF0,TPBFS,0,0,0		; Tape buffer #0
	.WORD	0,0,0,0,0,TPBF1,TPBFS,0,0,0		; Tape buffer #1
	.WORD	0,0,0,0,0,TPBF2,TPBFS,0,0,0		; Tape buffer #2
	.IF	NDF,$VAX
	.WORD	0,0,0,0,0,TPBF3,TPBFS,0,0,0		; Tape buffer #3
	.ENDC
TPLND=	.
	.page
	.SBTTL	Parse input specification & choose action

;
; Get command line, parse it & start all files
;

BEGIN:  FINIT$                  ;JKN02 Once-only call to init FCS use
START:
	CLR	VFYMSK		;+AF3 Clear VErify and CoMpare switches
	CLR	CMPPAS		;+AF3 Set normal copy pass operation
START2:
	CLR	SWTDEV		;+AF3 Clear switch-device flag
	BIT	#VFYFLG,VFYMSK	;+AF3 Second time thru, do a verify?
	BEQ	10$		;+AF3 No, skip
	MOV	#-1,CMPPAS	;+AF3 Yes, set compare-pass flag
	CLR	VFYMSK		;+AF3 Make sure we only do it once
	ERRMSG	<TPC -- Starting verify pass.>	;Not really an error...
10$:
	ALUN$S	#TILUN,#"TI,#0	; Ensure terminal assigned on TILUN
	CALL	CLOSE		; Insure all files are closed (ignore errors)
START3:
	MOV	#DSKLHD,DSKLHD
	MOV	#DSKLHD,DSKLHD+2	; set up queues
	MOV	#TPLHD,TPLHD
	MOV	#TPLHD,TPLHD+2		; anew in case screwed up before
	MOV	#FDBST,R0	; Point to the first FDB
10$:	CLR	(R0)+		; Clear out the file descriptor blocks
	CMP	R0,#FDBEND	; At end yet?
	BLO	10$		; No - continue
	MOV	#"EO,LITEO	; Set up ANSI search literals
	MOV	#"F2,LITF2
	MOV	#"VV,LITVV
	MOV	#"HD,LITHD
	MOV	#"R2,LITR2
	MOV	#1,ANSFLG	; Say ANSI mode	;GCE02
	CLR	ANSCNT		; and zero ANSI EOVs seen ;GCE02
	CLR	HDRLVL		; Zero header level counter
	CLR	CSIFLG		; Reset the command string flags
	CLR	INDVF		; Reset input device type
	CLR	OUTDVF		; Reset output device type
	MOV	#-100.,ALLOC	; Reset the allocation amount
	MOV	#-50.,SALOC	; Reset the secondary allocation
	CLR	D2DMSK
	CLR	TFAKMK		; Zero aux flag words
	.IF	NDF,$$$PRO
	MOV	#494.,SZLO	; Default RX01 size for /SZ
	.IFF
	MOV	#800.,SZLO	; Default RX50 size for /SZ (PRO 350)
	.ENDC
	CLR	SZHI
	CLR	LOLO
	CLR	LOHI		; Start with blk 0
	CLR	IMHI
	CLR	IMLO
.IF GE, IMBFMX-8.
IMMM=8.
.IFF
IMMM=IMBFMX
.ENDC
.PRINT IMMM ; Default /IM blk factor
	MOV	#IMMM,IMBF	; Set block factor default for /IM copy
	TST	CMPPAS		;+AF3 Is this a compare pass?
	BNE	30$		;+AF3 Yes, don't read a command line - use old one
	GCML$	#GCMBLK		; Read a command line
	BCC	30$		; Continue if no errors
	CMPB	#GE.EOF,G.ERR(R0) ; End of command input?
	BNE	20$		; No - command input error
	EXIT$S

20$:	ERRMSG	<TPC -- Command line input error>
	JMP	START

30$:	CSI$1	#CSI,GCMBLK+G.CMLD+2,GCMBLK+G.CMLD ; Parse command line
	BCC	50$		; Continue if no errors
40$:	ERRMSG	<TPC -- Command line syntax error>
	JMP	START
;
; Now that we have a valid command line, parse it to get any combination
; of switches on both input and output sides.
;
50$:
	Tst	CMPPAS		;+AF3 Are we already in a compare pass?
	BNE	58$		;+AF3 Yes -- skip this stuff
;
	CSI$2	R0,INPUT,#CSISW	;+AF3 Parse just for /CM & /VE switches
	CSI$2	R0,OUTPUT,#CSISW ;+AF3 Parse just for /CM & /VE switches
	CMP	#CMPFLG!VFYFLG,VFYMSK	;+AF3 Both compare and verify specified?
	BNE	52$		;+AF3 No, OK
	ERRMSG	<TPC -- /VE and /CM Not valid at same time.>,START
52$:
	BIT	#CMPFLG,VFYMSK	;+AF3 Does the user want to compare tape/file??
	BEQ	54$		;+AF3 NO, Skip
	MOV	#-1,CMPPAS	;+AF3 YES, Set compare pass flag
	CLR	VFYMSK		;+AF3 and remove switches
54$:
	CSI$1	#CSI,GCMBLK+G.CMLD+2,GCMBLK+G.CMLD ;+AF3 Re-parse command line
;
58$:
;
	TST	SWTDEV		;+AF3 Do we need to switch input & output for compare?
	BEQ	60$		;+AF3 NO, thank god
	CSI$2	R0,INPUT,#CSISW	;+AF3 For compare, magtape must be the input device
	BR	88$		;+AF3 Continue
60$:
	CSI$2	R0,OUTPUT,#CSISW ; Parse output filespec & switches
88$:
	BCC	95$		; No errors - continue
90$:
	ERRMSG	<TPC -- Invalid switch>
	JMP	START

95$:	BITB	#<CS.WLD!CS.MOR>,C.STAT(R0)
	BEQ	98$		;+AF3 OK, skip
	Jmp	40$		;+AF3 Report error
98$:
;
; Set up /EBCDIC subliterals if /EB switch was seen
;
	BIT	#2,ANSFLG	; Did he set the /EBCDIC switch?
	BEQ	100$		; If EQ no
	BIS	#1,ANSFLG	; If so force ON /ANSI switch
	MOV	#153305,LITEO	; Set up EBCDIC literals for label text
	MOV	#171306,LITF2
	MOV	#162745,LITVV
	MOV	#142310,LITHD
	MOV	#171331,LITR2
100$:
	BIT	#4,ANSFLG	; /RT11 switch set?
	BEQ	110$		; If EQ no
	MOV	#"F1,LITF2
	MOV	#"R1,LITR2	; Look for HDR1, EOF1 if so
110$:
	BIT	#HLPMSK,CSIFLG	; Did the user want help?
	BEQ	120$		; No - continue
	JMP	HELP		; Give him help

120$:
	BIT	#CONMSK,CSIFLG	; Is file to be contiguous?
	BNE	150$		; If NE, yes
	TST	ALLOC		; Is ALLOC negative?
	BMI	160$		; If yes, skip
	NEG	ALLOC		; Negate it
	BR	160$
150$:	TST	ALLOC		; Is ALLOC positive?
	BPL	160$		; If yes skip
	NEG	ALLOC		; Negate it
160$:	BNE	170$		; (Always allocate something!)
	MOV	#200.,ALLOC	; Start at 200 at least
170$:	TST	SALOC		; But never let SALOC remain negative
	BPL	180$		; If positive, skip
	NEG	SALOC		; Negate it
180$:	BNE	190$		; Also always have a secondary alloc.
	MOV	#50.,SALOC
190$:	FDAT$R	#FDBOUT,#R.VAR,#FD.CR,,ALLOC,SALOC ; Init the FDB
	FDOP$R	R0,#OUTLUN
	MOV	R0,R1		; R1 = Filename block address
	ADD	#F.FNB,R1	; ...
	MOV	#CSI+C.DSDS,R2	; R2 = Dataset descriptor
	MOV	#OUTDFN,R3	; R3 = Default filename address
	BIT	#102,D2DMSK
	BEQ	200$		; Normal if not dsk-dsk
	CALL	.PRSDV		; Parse device info
	BR	210$
200$:	CALL	.GTDID		; Get default directory ;GCE03
	CALL	.PARSE		; Parse the filename block info
210$:	BCS	250$		; Error on parse
	BIT	#102,D2DMSK	; Is this writing a "tape" (really disk?)
	BNE	220$		; If so forget device name check
	BIT	#2,TFAKMK	; Is output tape via /MO switch?
	BNE	220$		; If NE yes, go flag it so.
	CALL	MAGTST		; Test for magtape device
	BCC	230$		; Output file is disk - open it
220$:	DEC	OUTDVF		; Output is magtape - so indicate
;
;
;+AF3     Here we do something really crazy.   Rather than write the compare
;+AF3   code for both tape-to-disk and disk-to-tape, I wrote it only for
;+AF3   tape-to-disk.    When a compare (verify) is called for when the
;+AF3   user specifies disk-to-tape, we simply switch the output and input
;+AF3   devices.
;+AF3
;+AF3     This is done by testing to see if the output device is a disk.
;+AF3   If not, a flag is set and the command line is re-parsed with CSI$2
;+AF3   called with "OUTPUT" and "INPUT" reversed.   Clever, huh?
;+AF3   I was afraid you would say that.   Oh well, at least it seems to work.
;
	TST	CMPPAS		;+AF3 Doing compare operation now?
	BEQ	260$		;+AF3 No, skip
	MOV	#-1,SWTDEV	;+AF3 Set Switch Device flag
	JMP	START3		;+AF3 and go parse the command line again
				;+AF3 with input and output devices switched
;
230$:
	TST	CMPPAS		;+AF3 Doing compare pass?
	BEQ	240$		;+AF3 NO, normal copy
	OFNB$	R0,#FO.RD,#OUTLUN,,,#FD.RWM	;+AF3 Open for read during compare
	BCC	270$		;+AF3 Skip if OK
	BR	250$		;+AF3 else error
240$:
	OFNB$	R0,#FO.WRT,#OUTLUN,,,#FD.RWM
	BCC	260$		; Continue if no errors
250$:	ERRMSG	<TPC -- Open error on output file>
	JMP START

260$:	MOV	#1002,F.RSIZ(R0) ; Init the record size in FDB
	CLR	F.FFBY(R0)	; Indicate next block empty
270$:
	TST	SWTDEV		;+AF3 Do we need to switch input & output?
	BEQ	280$		;+AF3 No, thank god
	CSI$2	#CSI,OUTPUT,#CSISW	;+AF3 For compare, disk must be output device
	BR	290$		;+AF3 Continue
280$:
	CSI$2	#CSI,INPUT,#CSISW ; Parse input file & switches
290$:
	BCC	300$		; No error if carry clear
	JMP	90$		; Report switch error
300$:	BITB	#<CS.MOR!CS.WLD>,C.STAT(R0) ; No wildcards, etc allowed
	BEQ	310$		; OK - continue
	JMP	40$		; Report it as error
310$:	BIT	#HLPMSK,CSIFLG	; Did he want help?
	BEQ	320$		; No - continue
	JMP	HELP		; Yes - give him help

320$:	FDOP$R	#FDBINP,#INLUN,,#INDFN	; Declare LUN to input FDB
	MOV	R0,R1		; R1 = FNB address
	ADD	#F.FNB,R1	; ...
	MOV	#CSI+C.DSDS,R2	; R2 = Dataset descriptor
	MOV	#INDFN,R3	; R3 = Default filename
	BIT	#101,D2DMSK
	BEQ	330$
	CALL	.PRSDV
	BR	340$
330$:	CALL	.GTDID		; Get default directory
	CALL	.PARSE		; Parse the filename block data
340$:	BCS	360$		; Error on parse
	BIT	#101,D2DMSK	; Is the input a disk looking like a tape?
	BNE	350$		; If so, flag for later
	BIT	#1,TFAKMK	; /MI switch force us to treat IN as tape?
	BNE	350$		; If NE yes, go treat IN as tape. Skip test.
	CALL	MAGTST		; See if this is magtape
	BCC	370$		; No - try to open the file
350$:	DEC	INDVF		; Indicate input device is magtape
	BR	380$		; Continue
360$:	ERRMSG	<TPC -- Open error on input file>
	JMP	START

370$:	OFNB$	R0,#FO.RD,,#INLUN,,,#FD.RWM	; (If not magtape)
	BCS	360$		; Error on open

;
; Determine whether we have correct combination of disk & magtape devices:
; i.e. 1 disk & 1 magtape
;

380$:	MOV	OUTDVF,R0	; R0 = Output device flag
	MOV	INDVF,R1	; R1 = Input device flag
	BIT	#100,D2DMSK
	BNE	390$		; /IM copy is both devices.
	XOR	R0,R1		; If not -1, then we have 2 of a kind!
	BMI	390$		; Good! - continue
	ERRMSG	<TPC - Specify 1 file & 1 magtape device>,START

390$:
;
; Set up ENDBK block
;
	MOV	LOLO,ENDBK+2
	MOV	LOHI,ENDBK
	ADD	SZLO,ENDBK+2
	ADC	ENDBK
	ADD	SZHI,ENDBK	; Now have ENDBK as (HI,LO) as QIO$ needs.
	MOV	LOLO,ENDIO+2	; Copy start blk # for count of done I/O'S
	MOV	LOHI,ENDIO
	BIT	#100,D2DMSK	; /IMage mode?
	BNE	410$		; If so handle specially
	TST	CMPPAS		;+AF3 Compare pass?
	BNE	400$		;+AF3 Handled as special case of tape-to-disk
	TST	R0		; Which was it?
	BPL	400$		; Output is disk
	JMP	DSKTTP		; Output is magtape
400$:	JMP	TPTDSK		; Tape-to-disk
410$:	JMP	IMGMOD		; Image mode copy
	.page
;
; MAGTST - Subroutine to test for magtape as the redirected device which
;	   was assigned in the filename block.
;

MAGTST:	MOV	#MAGDEV,R5	; Point R5 to device list

10$:	CMP	(R5)+,N.DVNM(R1); Test device name field of filename block
	BEQ	20$		; Got it! - It's magtape (set carry)
	TST	(R5)		; Any more entries?
	BNE	10$		; Yes - continue
	RETURN
20$:	SEC			; Indicate magtape
	RETURN
;
; CLOSE - Close files at end of run
;
CLOSE:
	TST	INDVF		; Input device a file?
	BNE	10$		; If NE, no - don't close it
	CLOSE$	#FDBINP		; Close input file
	BR	20$		; Check output file
10$:
	QIOW$S	#IO.KIL,#INLUN,#1	; Else kill I/O just in case
	QIOW$S	#IO.DET,#INLUN,#1	;+AF3 and Detach from the tape
20$:
	TST	OUTDVF		; Is output device a file?
	BNE	30$		; If NE no, don't close it
	MOV	#FDBOUT,R0	; Point to output FDB
	CALL	.TRNCL		; Truncate and close it
	BR	40$		; Exit
30$:
	QIOW$S	#IO.KIL,#OUTLUN,#1	; Else kill I/O just in case
	QIOW$S	#IO.DET,#OUTLUN,#1	;+AF3 and Detach from the tape
40$:
	RETURN
;
;
;
; HELP - List out the help text on TI:
;

HELP:	MOV	#HLPMSG,R0	; R0 = Help message text address
	MOV	#40,QIO+Q.IOPL+4; Set the CC-Type to CR-LF
;
10$:	MOV	R0,QIO+Q.IOPL	; Put the address in the DPB
	MOV	R0,R1		; Save the beginning address in R1
;
20$:	TSTB	(R0)+		; Scan to null at end
	BNE	20$		; Continue till NULL character
	MOV	R0,R2		; R2 = Ending line address + 1
	DEC	R2		; Backup to end of line
	SUB	R1,R2		; R2 = Length of line
	MOV	R2,QIO+Q.IOPL+2	; Put length in QIO DPB
	DIR$	#QIO		; Output the line
	CMP	R0,#HLPEND	; Any more text to go?
	BLO	10$		; Yes - continue
	JMP	START
	.page
	.SBTTL	Wait code & error processing
;
; WAIT-	Processing of normal code suspends itself here after initiating
;	the tape copy operation.  All work is done via AST routines, and
;	is completely 'interrupt' driven.  When an error occurs, or the
;	transfer is finished, the main program is 'resumed'.  It must then
;	check for any errors encountered in the AST routines.
;
;
WAIT:	PAUSE			; Wait for processing to complete
	BIT	#ERR,FLAGS	; Any errors ?
	BNE	20$		; Yes - process it
	TST	CMPPAS		;+AF3 In compare pass?
	BEQ	10$		;+AF3 No - do restart
	ERRMSG	<TPC -- Compare OK.>	;+AF3 Not really an error message
	JMP	START		;+AF3 Just finished compare pass - do original start
10$:
	JMP	START2		;+AF3 Restart

20$:	MOV	#DSKERM,R1	; Assume a disk error
	MOV	DSKERR,-(SP)	; Put error code on stack
	BEQ	30$		; No code - not disk error
	JMP	ERROR		; Go process error

30$:	MOV	#MTERM,R1	; Setup magtape error message
	MOV	MTERR,(SP)	; & error code
	BEQ	40$		;+AF3 No code - not magtape error
	JMP	ERROR		; Process the error
;
;
40$:
	MOV	#CMPERM,R1	;+AF3 Point to compare error message
	MOV	#0,(SP)		;+AF3 Null parameter
	JMP	ERROR		;+AF3 Process error message


;
; ERROR-Process error messages.  This routine outputs error messages to
;	the users terminal using $EDMSG.  The pattern string is assumed
;	to be pointed to by R1, and the error code on the stack.  This
;	routine should be passed control via	'JMP	ERROR'.
;

ERROR:	MOV	#ERRBUF,R0	; R0 = Output buffer pointer
	MOV	SP,R2		; R2 = Parameter pointer
	CALL	$EDMSG		; Edit the message
	MOV	#ERRBUF,QIO+Q.IOPL	; Setup the QIO DPB
	MOV	R1,QIO+Q.IOPL+2		; ...
	TST	(SP)+		; Pop the parameter from the stack
	DIR$	#QIO		; Output it
	JMP	START		; Restart
	.page
	.SBTTL	Tape to disk operations
;
; Tape to disk
;
;	This function initiates a transfer sequence from the tape drive
;	to the disk file.  The tape is rewound prior to the start of
;	the copy, and all operations are multi-buffered.
;

TPTDSK:	CLR	FLAGS		; RESET ALL FLAGS
	CLR	DSKERR		; RESET DISK ERROR VALUE
	CLR	MTERR		; & MAGTAPE ERROR VALUE
	MOV	#TAPEIN,INVEC	; SETUP AST VECTORS
	MOV	#DSKOUT,OUTVEC	; ...
	BIT	#3,D2DMSK	;SEE IF CONTROL QIOS ARE CORRECT
	BEQ	10$		;IF SO LEAVE IN
	BIT	#40,D2DMSK	;SEE IF WANTED EVEN THO' DISK-DISK
	BEQ	50$		;IF NOT,SKIP 'EM
10$:
	QIOW$S	#IO.ATT,#INLUN,#1	; ATTACH TO TAPE UNIT
	BIT	#NRMSK,CSIFLG	;DID HE WANT TO SKIP THE REWIND?
	BNE	20$		;IF SO, SKIP REWIND
	QIOW$S	#IO.RWD,#INLUN,#1	; REWIND THE MAGTAPE
20$:	CLR	R0		;SET 800 BPI DENSITY INITIALLY
	BIT	#HDMSK,CSIFLG	;DID HE SAY HIGH DENSITY?
	BEQ	30$		;IF NOT LEAVE AT 800 BPI
	MOV	#4000,R0	;IF SO, SET 1600 BPI
30$:	BIT	#SCMSK,CSIFLG	;WAS THE /SC:NNNNNN SWITCH USED?
	BEQ	40$		;IF NOT JUST SET CHARACTS.
	BIS	SCVAL,R0	;ELSE OR IN CHARACTERISTICS WANTED
40$:
	QIOW$S	#IO.STC,#INLUN,#1,,,,<R0> ; SET TO 800BPI OR 1600 BPI
50$:
;
; INITIALIZE & PLACE ALL DISK BUFFERS IN THE QUEUE
;

	MOV	#DSKLHD,R0	; R0 = DISK BUFFER LISTHEAD
	MOV	R0,R4		; R4 = SAVED LISTHEAD ADDRESS
	MOV	R4,(R0)+	; SETUP A NULL LISTHEAD
	MOV	R4,(R0)+	; ...
				; NOTE: THE LISTHEAD & LISTS MUST BE TOGETHER!

60$:	MOV	R0,R5		; R5 = BUFFER NODE ADDRESS
	CALL	NODADD		; ADD IT TO DISK QUEUE
	MOV	N.BUF(R5),N.PTR(R5)	; UPDATE POINTER TO BUFFER START
	ADD	#N.SIZE,R0	; R0 = NEXT POINTER
	CMP	R0,#DSKLND	; AT END OF LIST YET?
	BLO	60$		; NO - CONTINUE

;
; INITIALIZE TAPE BUFFER LISTHEAD TO NULL, AND INITIATE I/O TO THE TAPE
; DRIVE FOR EVERY AVAILABLE BUFFER NODE IN ORDER TO START THE PROCESS GOING.
;

	MOV	#TPLHD,R0	; R0 = TAPE LISTHEAD ADDRESS
	MOV	R0,R1		; R1 = SAVED LISTHEAD ADDRESS
	MOV	R1,(R0)+	; INITIALIZE THE LISTHEAD TO NULL
	MOV	R1,(R0)+	; ...

80$:	MOV	R0,R1		; R1 = COPY OF NODE ADDRESS
	CLR	N.PTR(R0)	; RESET THE POINTER VALUE
	ADD	#N.IOST,R1	; R1 = IO STATUS ADDRESS
	MOV	R1,R2		; R2 = "    "	   "
	ADD	#N.BUF-N.IOST,R1; POINT R1 TO BUFFER ADDRESS CELL
	MOV	(R1)+,R3	; R3 = BUFFER ADDRESS
	TST	(R3)+		; ADVANCE BEYOND 1ST WORD
	MOV	(R1),R4		; & GET BUFFER SIZE
	SUB	#2,R4		; DECREASE BY TWO TO ACCOUNT FOR R3 OFFSET
	BIT	#1,D2DMSK	;READING DISK, NOT REAL TAPE?
	BEQ	85$		;IF EQ NO, NORMAL
	MOV	#512.,R4	;ELSE SET 1BLOCK SIZE OF BUFFER
85$:
	QIO$S	#IO.RLB,#INLUN,,,R2,INVEC,<R3,R4,,LOHI,LOLO>;READ THE BLOCK
	BIT	#3,D2DMSK
	BEQ	95$		;IF NOT DSK-DSK OMIT COUNT HERE
	ADD	#1,LOLO
	ADC	LOHI		;THEN COUNT UP THE BLOCK NUMBER
95$:	ADD	#N.SIZE,R0	; R0 = ADDRESS OF NEXT BUFFER NODE
	CMP	R0,#TPLND	; ANY MORE TAPE BUFFERS?
	BLO	80$		; YES - CONTINUE
	TST	CMPPAS		;+AF3 Doing compare pass?
	BNE	100$		;+AF3 Yes, skip to startup disk stuff
	JMP	WAIT		;+AF3 No - go wait for I/O Done
100$:
;
;
; HERE IS WHERE WE START UP THE DISK READS WHEN DOING A COMPARE OPERATION
;
;
	MOV	#DSKIN,OUTVEC	;+AF3 Setup AST vector

;
; INITATE DISK I/O OPERATIONS FOR ALL AVAILABLE DISK BUFFERS
;

	MOV	#DSKLHD,R0	; R0 = DISK LISTHEAD POINTER
	MOV	R0,R1		; R1 = SAVE LISTHEAD ADDR
	MOV	R1,(R0)+	; INITIATE THE LISTHEAD TO NULL
	MOV	R1,(R0)+	; ...

110$:	MOV	N.BUF(R0),R2	; R2 = BUFFER ADDRESS
	MOV	R2,N.PTR(R0)	; INIT THE BUFFER POINTER
	MOV	N.LEN(R0),R3	; R3 = LENGTH OF READ
	MOV	R0,R1		; R1 = IO STATUS BLOCK ADDR
	ADD	#N.IOST,R1	; ...
	MOV	#FDBOUT,R5	; R5 = INPUT FDB ADDRESS
	QIO$S	#IO.RVB,#OUTLUN,,,R1,OUTVEC,<R2,R3,,F.BKVB(R5),F.BKVB+2(R5)>
	ADD	DSKFCT,F.BKVB+2(R5) ; UPDATE THE NEXT BLOCK NO.
	ADC	F.BKVB(R5)	; ...
	ADD	#N.SIZE,R0	; ADVANCE TO NEXT BUFFER NODE
	CMP	R0,#DSKLND	;+AF3 Past end?
;????	CMP	R0,#DSKLND	;+AF3 Past end?
	BLO	110$		; CONTINUE IF IN RANGE
	JMP	WAIT		; ELSE GO WAIT FOR XFER TO COMPLETE
	.page
	.SBTTL	TAPEIN	- Tape input AST
;
; TAPEIN - Handle tape input AST
;

	.GLOBL	TAPEIN,FLAGS
TAPEIN:
	JSR	R5, ASTQIO	;+AF4 Save registers & call us back with
				;+AF4    AST parameter in R3
	MOV	R3, R5		;+AF4 R5 = I/O STATUS ADDRESS
	BIT	#<EOV!ERR!DONE>,FLAGS	; ERROR OR END FLAGGED?
	BEQ	10$
	JMP	180$		; YES - GET OUT
10$:
	ADD	#1,ENDIO+2	;COUNT BLKS FINISHED
	ADC	ENDIO
	BIT	#1,D2DMSK	;SKIP UNLESS DSK-DSK
	BEQ	20$
	CMP	ENDIO,ENDBK	;HI PAST END?
	BHI	95$		;IF SO TREAT AS EOF
	BLO	20$		;IF LO ALLS WELL
	CMP	ENDIO+2,ENDBK+2	;LO BLK # PAST OR AT END?
	BHI	95$		;IF SO TREAT AS EOF
20$:
	MOV	N.BUF-N.IOST(R5),R4 ; R4 = BUFFER ADDRESS
	BIT	#ERMSK,CSIFLG	;IGNORING ERRORS?
	BEQ	30$		;IF NOT, LOOK AT ALL.
	CMPB	#IE.EOF,@R5	;WAS IT ENDFILE???
	BEQ	30$		;YES, LEAVE THAT 'ERROR'
;
;gce05 - If ignoring EOV,EOT errors just treat as OK...
;
	BIT	#EVMSK,CSIFLG	;IGNORING IE.EOT,IE.EOV?
	BNE	24$		;IF NE YES, SKIP TEST...
	CMPB	#IE.EOT,@R5
	BEQ	30$		; Skip if End-Of-Tape
	CMPB	#IE.EOV,@R5
	BEQ	30$		; or End-Of-Volume
24$:
	CMPB	#IE.PRI,@R5
	BEQ	30$		; or if tape dismounted
;
; Make all other errors be ignored...
;
	MOVB	#IS.SUC,@R5	; YES, SAY ALL WAS OK
30$:
ANST00==.
	TSTB	(R5)		; ERROR ON I/O?
	BMI	85$		; IF MI YES, GO HANDLE IT
;
; HERE WE CHECK FOR SPECIAL ANSI LABEL RECORDS.
; RECORD LENGTH MUST BE 80. BYTES ON INPUT AND TEXT OF FIRST
; 3 OR 4 CHARACTERS IN THE RECORD IS CHECKED.	;GCE02
;
ANST01==.
	BIT	#1,ANSFLG	; /ANSI SWITCH SEEN 	;GCE02
	BEQ	130$		; IF EQ NO, JUST PROCESS DATA
;
; SEE IF THIS WAS AN "EOV" RECORD. R4 POINTS TO DATA AREA.
; BE SURE RECORD LENGTH IS 80 BYTES FIRST.
;
	BIT	#4,ANSFLG	;/RT11 ANSI? (512 BYTE HEADERS)
	BNE	40$		; IF SO IGNORE LENGTH FOR CHECKS
	CMP	2(R5),#80.	; WAS THE RECORD AN 80 BYTE ONE?
	BNE	130$		; IF NOT CAN'T BE AN ANSI EOV LABEL
40$:	CMP	2(R4),LITEO	; CHECK FOR FIRST 2 CHARS
	BNE	50$		;IF NOT "EO", RESET ANSCNT
	CMPB	4(R4),LITVV	;SEE IF IT'S "EOV"
	BNE	50$		;IF NE, RESET ANSCNT
	INC	ANSCNT		;ELSE COUNT UP ANSCNT
	BR	130$
50$:	CLR	ANSCNT		;REQUIRE EOV1 AND EOV2 IN IMMEDIATE SUCCESSION
ANST02==.
; TEST FOR HDR2 OR EOF2 AND INCREMENT OR DECREMENT HDRLVL THEN
; THIS ALLOWS ONE TO HANDLE PARTIALLY FILLED ANSI TAPES.
	CMP	2(R4),LITHD	;HDR2
	BNE	60$		;IF NE NO, TRY EOF2
	CMP	4(R4),LITR2	;SEE IF STILL HDR2
	BNE	60$		;IF NOT CHECK EOF2
	MOV	#1,HDRLVL	;IF IT IS HDR2 SET LEVEL COUNTER UP TO 1
;				;(THIS PROTECTS AGAINST ACCIDENTAL SETS)
	BR	130$		;THEN SCRAM
ANST03==.
60$:	CMP	2(R4),LITEO	;SEE IF IT'S EOF2
	BNE	130$		;IF NOT WE'RE THRU WITH IT
	CMP	4(R4),LITF2	;IF NOT THEN DONE
	BNE	130$
	DEC	HDRLVL		;COUNT DOWN FILE LEVEL
	BGE	130$		;IF 0 OR +, ALL'S WELL
	CLR	HDRLVL		;BUT CLAMP IT TO 0 IF WE MANAGE TO SCREW UP.
80$:	BR	130$
85$:
; ALLOW IE.EOT AND IE.EOV ERRORS TO PROPAGATE IN AN ATTEMPT TO HANDLE CASES
; WHERE THOSE ERRORS OCCUR ON READING THE TAPE. IF ANSI TAPE, THEY REALLY
; ARE NOT THE END OF DATA AND SHOULD BE BYPASSED.
ANST04==.
	BIT	#EVMSK,CSIFLG	;IGNORING EOV/EOT ETC...
	BEQ	87$		;IF EQ NO
	CMPB	#IE.EOT,(R5)
	BEQ	86$
	CMPB	#IE.EOV,(R5)
	BNE	87$
86$:	MOVB	#IS.SUC,(R5)	;FLAG ALL WELL
	BR	30$
87$:
	CMPB	#IE.EOT,(R5)	;EOT? IF SO ALWAYS MAKE EOV
	BEQ	110$
	CMPB	#IE.EOV,(R5)
	BEQ	110$
	CMPB	#IE.EOF,(R5)	; EOF?
	BNE	160$		; NO - ERROR
88$:
;
; GCE02 START
; ****** HERE ADD CODE TO SUPPORT /ANSI SWITCH IF SET
	BIT	#1,ANSFLG	; ANSI SWITCH SET?
	BEQ	95$		; IF EQ NO, JUST DO THE USUAL THINGS
; PROCESS ANSI MODE EOF RETURNS...
;
; ACTUALLY, NEED TO DUPLICATE EOF, BUT NEED EOV IF 2 ANSI EOVS THERE.
; IF ANSCNT IS 2 ALREADY, ALLOW NORMAL PROCESSING.
	.GLOBL	ANSCNT,HDRLVL,ANSFLG
	CMP	ANSCNT,#2	;SEEN AT LEAST 2 EOV RECORDS?
	BHIS	95$		;IF SO GO TEST FOR 2ND EOF AND WRITE THEM
	TST	HDRLVL		;ARE WE BETWEEN HDR2 AND EOF2?
	BNE	100$		;IF WE ARE (I.E. IF NE), JUST WRITE EOFS
;				;OTHERWISE JUST TREAT EOF MARKS AS END OF TAPE
95$:
; GCE02 END
	BIT	#EOF,FLAGS	; IS THIS 2ND EOF IN ROW? (EOV?)
	BNE	120$		; YES - END-OF-VOLUME
100$:	BIS	#EOF,FLAGS	; NO - SO SET IT TO INDICATE 1ST EOF
	MOV	#2,2(R5)	; YES - SET LENGTH FOR OUTPUT = 2 BYTES
	CLR	(R4)		; DATA VALUE = 0 (COUNT = 0)
	BR	140$		; CONTINUE
;GCE02 START
ANST05==.
110$:	BIT	#1,ANSFLG	;THIS AN ANSI TAPE? IF SO IGNORE THESE ERRS
	BEQ	120$		;IF NOT ANSI TAPE (EQ) JUST SET EOV
	TST	2(R5)		;ANY DATA THERE?
	BNE	130$		;IF ANSI TAPE (NE), THEN ACCEPT RECORD
	BR	150$		;IF NO DATA JUST CONTINUE
;GCE02 END
ANST06==.
120$:	BIS	#EOV,FLAGS	; INDICATE EOV SEEN
	MOV	#4,2(R5)	; YES - DATA LENGTH = 4 BYTES (2 NULLS)
	CLR	(R4)+		; RESET THE TWO 'NULL' RECORDS
	CLR	(R4)		; ...
	BR	140$		; CONTINUE

130$:	MOV	2(R5),(R4)	; SETUP 1ST BUFFER WORD WITH DATA LENGTH
	ADD	#2,2(R5)	; TOTAL LENGTH INCLUDES THE LENGTH WORD
	BIC	#EOF,FLAGS	; RESET THE EOF SEEN FLAG

140$:	SUB	#4,R5		; ADJUST R5 TO POINT TO START OF NODE
	MOV	N.BUF(R5),N.PTR(R5) ; SETUP THE POINTER TO START OF DATA
	MOV	TPLHD+2,R4	; R4 = PRIOR NODE ADDRESS FOR ADD OPERATION
	CALL	NODADD		; ADD NODE TO TAPE BUFFER LIST
150$:	JMP	TPDKDQ		; GO TRY TO DEQUEUE SOME WORK.

160$:	QIOW$S	#IO.KIL,#INLUN,#1,,IOST	; CANCEL ALL TAPE I/O'S IN PROG.
	BIS	#ERR,FLAGS	; FLAG THE ERROR
	MOVB	(R5),MTERR	;+AF1 COPY ERROR CODE FOR MAGTAPE
	BPL	170$		;+AF1 SKIP IF POSITIVE (NOT LIKELY)
	MOVB	#-1,MTERR+1	;+AF1 ELSE MAKE HI BYTE NEGATIVE ALSO
170$:
	RESUME			; RESUME THE MAIN TASK

180$:
	Return			;+AF4 Return to ASTQIO to restore registers
				;+AF4   and exit the AST via ASTX$S

	.page
	.SBTTL	IMGMOD - Do image mode copies
;
; This section is primarily for copying disk to disk with no format dependence
; but if the /CT switch is set will try to do set-characteristics and
; rewinds, etc., as needed for tape. also will try to write a couple eofs
; after the writes.
; Note the /FL:name switch allows one to write pseudo-flx tapes which can
; then contain other (real) FLX programs. FLX can't handle big block
; sizes, but can skip files like this since labels are ok. Creation dates
; will be fouled up but otherwise ok. The /IM and /CT switches must be
; used to permit /FL to have any effect.
;
IMGCT:	.WORD	0,0	;COUNT OF BLOCKS TO DO LEFT
IMGNM:	.WORD	0,0	;BLOCK NUMBERS TO USE
IMGIOS:	.WORD	0,0	;I/O STATUS BLK
IMGMOD:
	MOV	IMHI,IMGNM
	MOV	IMLO,IMGNM+2	;SET UP BLK #S TO USE
	MOV	SZLO,IMGCT+2
	MOV	SZHI,IMGCT	;SET UP COUNT TO DO
	CLR	FLAGS		; RESET ALL FLAGS
	CLR	DSKERR		; RESET DISK ERROR VALUE
	CLR	MTERR		; & MAGTAPE ERROR VALUE
	BIT	#40,D2DMSK	;SEE IF WANTED EVEN THO' DISK-DISK
	BNE	10$		;IF OK DO THE TAPE STUFF
	JMP	85$		;IF NOT, SKIP 'EM
10$:
	QIOW$S	#IO.ATT,#INLUN,#1	; ATTACH TO TAPE UNIT
	QIOW$S	#IO.ATT,#OUTLUN,#1	; ATTACH TO TAPE UNIT
	BIT	#NRMSK,CSIFLG	;DID HE WANT TO SKIP THE REWIND?
	BNE	20$		;IF SO, SKIP REWIND
	QIOW$S	#IO.RWD,#INLUN,#1	; REWIND THE MAGTAPE
	QIOW$S	#IO.RWD,#OUTLUN,#1	; REWIND TAPE
20$:	CLR	R0		;SET 800 BPI DENSITY INITIALLY
	BIT	#HDMSK,CSIFLG	;DID HE SAY HIGH DENSITY?
	BEQ	30$		;IF NOT LEAVE AT 800 BPI
	MOV	#4000,R0	;IF SO, SET 1600 BPI
30$:	BIT	#SCMSK,CSIFLG	;WAS THE /SC:NNNNNN SWITCH USED?
	BEQ	40$		;IF NOT JUST SET CHARACTS.
	BIS	SCVAL,R0	;ELSE OR IN CHARACTERISTICS WANTED
40$:
	QIOW$S	#IO.STC,#OUTLUN,#1,,,,<R0> ; SET TO 800BPI OR 1600BPI
	QIOW$S	#IO.STC,#OUTLUN,#1,,,,<R0> ; SET TO 800BPI OR 1600BPI
	BIT	#200,D2DMSK	;/FLX SWITCH SET UP A NAME?
	BEQ	85$		;IF NOT, SKIP WRITE OF LABEL.
	CMPB	FLXNAM,#'A	;LEGAL NAMES ARE THIS BIG OR MORE
	BLO	80$		;IF NOT, USE DEFAULT
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)
;RADIX-50 PACK THE FILE NAME
	MOV	#FLXNAM,R0	;NAME IN
	CLR	R1		;NO PERIODS PLEASE
	JSR	PC,$CAT5	;CONVERT THE RAD50
	BCS	50$
	MOV	R1,LBLBK	;STORE OFF 1ST 3 CHARS
	CLR	R1
	JSR	PC,$CAT5	;CONVERT 2ND HALF
	MOV	R1,LBLBK+2	;STORE WHATEVER WE HAVE
	BR	60$
50$:	MOV	R1,LBLBK	;STORE 3 OR LESS CHAR NAME
	CLR	LBLBK+2		;ZERO 2ND HALF NAME
60$:
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
80$:	QIOW$S	#IO.WLB,#OUTLUN,#1,,,,<#LBLBK,#14.> ;WRITE THE FLX LABEL
85$:
;
;MAIN LOOP. USE ALL SPACE AVAILABLE AS A BIG BUFFER AND JUST SHUFFLE BACK
;AND FORTH TILL DONE.
.MCALL QIOW$S
IMGS:
	CMP	IMBF,#IMBFMX	;IS BLOCK FACTOR LEGAL?
	BLOS	10$		;IF LOS ALL'S WELL
	MOV	#IMBFMX,IMBF	;ELSE SET MAX AS BLOCK FACTOR
10$:
	MOV	IMBF,R3		;GET MAX BLK #
	ASH	#9.,R3		;SHIFT OVER 9 BITS FOR BUFFER SIZE
;DSKBF0 IS BUFFER ADDRESS
IMGLOP:
	BIT	#400,D2DMSK	;/NI SWITCH SET? (IF SO READ 512 AT A TIME)
	BNE	10$		;IF NE YES
	QIOW$S	#IO.RLB,#INLUN,#1,,#IMGIOS,,<#DSKBF0,R3,,LOHI,LOLO>
;THE ABOVE READS INPUT AT BLKS GIVEN.
	BR	50$		;SKIP 1 BLK AT A TIME READIN
10$:
;NIBBLE READIN (USE TO AVOID LOSS OF DATA DUE TO BAD BLOCKS)
	MOV	R0,-(SP)
	MOV	IMBF,R0
	MOV	R1,-(SP)
	MOV	#DSKBF0,R1	;DATA AREA
	MOV	R4,-(SP)
	MOV	R5,-(SP)
	MOV	LOHI,R4
	MOV	LOLO,R5
20$:	QIOW$S	#IO.RLB,#INLUN,#1,,#IMGIOS,,<R1,#1000,,R4,R5>
	ADD	#1,R5
	ADC	R4		;COUNT BLOCKS...
	ADD	#1000,R1	;BUMP ADDRESS POINTER
	TSTB	IMGIOS
	BPL	30$		;IF NO ERR, +; SKIP ERR MSG
	ERRMSG	<TPC -Warning- Input read error>
	TST	IMGIOS+2	;SEE IF 0 WORDS READ (==> DONE)
	BNE	30$		;IF NONZERO GO ON
	BIT	#ERMSK,CSIFLG	;IF /ER SPEC'D, USE BLK FACTOR ALWAYS
	BNE	30$
	MOV	R1,IMGIOS+2	;ELSE SAY HOW MANY WE GOT
	SUB	#DSKBF0+1000,IMGIOS+2	;MAKE IT A BYTE COUNT
	BR	40$
30$:	DEC	R0		;COUNT DOWN BLKS TO DO
	BGT	20$
	MOV	R3,IMGIOS+2	;COPY WC WE WOULD HAVE USED...
40$:	MOV	#1,IMGIOS
	MOV	(SP)+,R5
	MOV	(SP)+,R4
	MOV	(SP)+,R1
	MOV	(SP)+,R0
50$:
	TSTB	IMGIOS		;SEE IF ALL WENT OK
	BPL	60$
	ERRMSG	<TPC -Warning- IMG error on input disk>
60$:	MOV	IMGIOS+2,R4	;GET BYTES READ
	BNE	80$		;IF NONZERO WE KEEP GOING
	BIT	#ERMSK,CSIFLG	;IF /ER SPECIFIED DON'T TEST THIS
	BNE	80$
	JMP	IMGDUN		;ZERO READ MEANS ALL DONE.
80$:	BIT	#1000,D2DMSK	;/NO NUBBLE WRITE SPECIFIED?
	BNE	85$		;IF NE YES, DO IT 1 BLK AT A TIME
	QIOW$S	#IO.WLB,#OUTLUN,#1,,#IMGIOS,,<#DSKBF0,R4,,IMGNM,IMGNM+2>
;WRITE THE DATA OUT
	BR	110$		;SKIP NIBBLE WRITE
85$:
;NIBBLE WRITE (1 BLK AT A TIME TO AVOID LOSS OF DATA ON ERRORS)
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,R0
	ASH	#-9.,R0		;CONVERT TO A NUMBER OF BLOCKS TO DO
	MOV	#DSKBF0,R1	;BUFFER ADDRESS
	MOV	IMGNM,R2	;HI BLK NO
	MOV	IMGNM+2,R3	;LO BLK NO
95$:	QIOW$S	#IO.WLB,#OUTLUN,#1,,#IMGIOS,,<R1,#1000,,R2,R3>
	ADD	#1,R3
	ADC	R2		;BUMB BLK NO
	ADD	#1000,R1	;AND BUFF ADDR
	TSTB	IMGIOS		;CHECK ERRS
	BPL	100$		;IF PL ALL WELL
	ERRMSG	<TPC -Warning- IMG write error>
100$:
	DEC	R0		;COUNT DOWN BLKS TO DO
	BGT	95$		;AND LOOP TILL DONE
	MOV	R4,IMGIOS+2	;SAY WE WROTE ALL
	MOV	#1,IMGIOS	;WITH SUCCESS!!!!
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
110$:	TSTB	IMGIOS
	BPL	120$
	ERRMSG	<TPC -Warning- IMG error on output disk>
120$:	ASH	#-9.,R4		;GET NO. BLOCKS HANDLED LAST TIME
	BEQ	IMGDUN		;IF 0, EXIT
	SUB	R4,IMGCT+2	;COUNT DOWN BLOCKS TO DO
	SBC	IMGCT
	BMI	IMGDUN		;COUNT NEGATIVE MEANS DONE
	BNE	130$
	TST	IMGCT+2
	BEQ	IMGDUN		;END WHEN WE COUNT DOWN TO 0 LEFT
130$:	ADD	R4,LOLO
	ADC	LOHI		;ELSE BUMP BLOCK NUMBERS LEFT
	ADD	R4,IMGNM+2
	ADC	IMGNM		;IN BOTH INPUT AND OUTPUT
	;SEE HERE IF IMGCT+2 IS LESS THAN IMBF AND RESET THE
	;BUFFER SIZE IF SO TO DO MORE REASONABLE THINGS.
	TST	IMGCT		;IF H.O. COUNT IS NONZERO DONT DO THIS
	BNE	140$
	CMP	IMGCT+2,IMBF	;ENOUGH BLKS LEFT FOR FULL BUFFER?
	BHIS	140$		;IF HIS YES
	MOV	IMGCT+2,R3	;ELSE SET UP COUNT OF WHAT'S LEFT TO DO
	ASH	#9.,R3		;AND MAKE A VALID BYTE COUNT OF IT.
	BEQ	IMGDUN
140$:
	JMP	IMGLOP		;THEN GO TRY ANOTHER CHUNK
IMGDUN:
;ALL DONE... FINISH UP
	BIT	#40,D2DMSK	;/CT SPEC'D?
	BEQ	10$		;IF EQ NO
	QIO$S	#IO.EOF,#OUTLUN,,,R3
	QIO$S	#IO.EOF,#OUTLUN,,,R3
	QIO$S	#IO.EOF,#OUTLUN,,,R3
	QIO$S	#IO.EOF,#OUTLUN,,,R3
	QIO$S	#IO.EOF,#OUTLUN,,,R3
;NOW HAVE 5 EOF'S OUT TO DO. THUS WE NEED TO BACKSPACE OVER 4 RECORDS
;TO LEAVE TAPE IN POSITION AFTER THE FIRST EOF. DO IT THUS:
	.MCALL	QIOW$S
	QIOW$S	#IO.SPF,#OUTLUN,#20.,,R3,,#-4	;BACKSPACE OVER 4 EOFS
	BIT	#20,D2DMSK	;/FR FINAL REWIND WANTED?
	BEQ	10$		;IF NOT SKIP IT
	QIOW$S	#IO.RWD,#OUTLUN,#20.,,R3	;DO THE REWIND
10$:
	JMP	START		;DONE!
	.page
	.SBTTL	DSKOUT	- Disk output AST
;
; DSKOUT - Process disk output AST
;

DSKOUT:
	JSR	R5, ASTQIO	;+AF4 Save registers & call us back with
				;+AF4    AST parameter in R3
	MOV	R3, R5		;+AF4 R5 = I/O STATUS ADDRESS
	BIT	#<ERR!DONE>,FLAGS	; ANY ERRORS OR OPERATION COMPLETE?
	BEQ	10$
	JMP	40$		; YES - JUST EXIT AST
10$:
	TSTB	(R5)		; ANY ERRORS ON OPERATION?
	BMI	20$		; YES - ERROR

	SUB	#4,R5		; R5 = NODE ADDRESS (ADJUSTED)
	MOV	N.BUF(R5),N.PTR(R5)	; RESET THE BUFFER POINTER
	MOV	DSKLHD+2,R4	; R4 = PRIOR NODE ADDRESS FOR ADD
	CALL	NODADD		; ADD THIS TO DISK BUFFER QUEUE
	JMP	TPDKDQ		; TRY TO DEQUEUE SOME WORK

20$:	QIOW$S	#IO.KIL,#OUTLUN,#1,,#IOST	; CANCEL ALL OUTPUT I/O
	BIS	#ERR,FLAGS	; FLAG THE ERROR
	MOVB	(R5),DSKERR	;+AF1 SAVE THE ERROR CODE
	BPL	30$		;+AF1 SKIP IF POSITIVE (NOT LIKELY)
	MOVB	#-1,DSKERR+1	;+AF1 ELSE MAKE HI BYTE NEGATIVE ALSO
30$:
	RESUME			; CONTINUE THE MAIN TASK

40$:
	Return			;+AF4 Return to ASTQIO to restore registers
				;+AF4   and exit the AST via ASTX$S

	.page
	.SBTTL	TPDKDQ	- Tape to disk dequeue routine
;
; TPDKDQ-
;
;	This routine performs the majority of work in the transfer operation.
;	Entries in the tape input queue represent data input from the mag-
;	tape drive, which needs to be output to the disk.  The entries in the
;	disk queue are empty buffers.  This routine copies magtape buffer
;	information starting with the 1st buffer in the queue to the disk
;	buffers, only exiting the AST when there are no more buffers available
;	at any time to continue the operation.
;

TPDKDQ:	MOV	#DSKLHD,R0	; R0 = DISK LISTHEAD ADDRESS
	CMP	R0,(R0)		; ANY OUTPUT BUFFERS AVAILABLE?
	BEQ	10$		; NO - JUST EXIT AST
	MOV	(R0),R0		; R0 = BUFFER NODE ADDRESS

	MOV	#TPLHD,R2	; R2 = TAPE LISTHEAD ADDRESS
	CMP	R2,(R2)		; ANY TAPE BUFFERS READY?
	BEQ	10$		; NO - WAIT FOR SOME TO COME
	MOV	(R2),R2		; R2 = BUFFER ADDRESS
	BR	20$		; CONTINUE

10$:
	Return			;+AF4 Return to ASTQIO to restore registers
				;+AF4   and exit the AST via ASTX$S


;
; THERE IS AT LEAST ONE INPUT BUFFER READY & ONE OUTPUT BUFFER AVAILABLE.
; SETUP ALL POINTERS, CALCULATE THE NUMBER OF BYTES TO COPY & THE AMOUNT
; OF SPACE LEFT IN THE DISK BUFFER.  TRANSFER AS MUCH AS WILL FIT INTO
; THE DISK BUFFER.
;

20$:	MOV	N.PTR(R0),R1	; R1 = REMAINING LENGTH IN DISK BUFFER
	SUB	N.BUF(R0),R1	; ...
	NEG	R1		; (R1 = -AMOUNT USED)
	ADD	N.LEN(R0),R1	; ...
	BLE	DSKWRT		; NONE LEFT!
	MOV	N.IOST+2(R2),R3	; R3 = LENGTH OF TAPE BUFFER DATA
	BNE	30$
	JMP	QUEMTR		; NO TAPE DATA!
30$:

	CMP	R1,R3		; COMPARE REMAINING DISK TO TAPE BUFFER
	BHIS	40$		; DISK BUFFER WILL HOLD IT ALL - CONTINUE
	SUB	R1,R3		; R3 = AMOUNT WHICH WILL NOT FIT
	MOV	R3,N.IOST+2(R2)	; UPDATE THE AMOUNT WHICH REMAINS FOR TAPE
	MOV	R1,R3		; R3 = TRANSFER COUNT
	BR	50$		; CONTINUE

40$:	CLR	N.IOST+2(R2)	; XFER WILL FIT - NO DATA WILL BE LEFT

50$:	MOV	N.PTR(R2),R4	; R4 = FROM POINTER
	MOV	N.PTR(R0),R5	; R5 = TO POINTER
	ASR	R3		; R3 = XFER COUNT IN WORDS
	TST	CMPPAS		;+AF3 Is this a compare pass??
	BEQ	60$		;+AF3 No, go move data
	JMP	CMPBUF		;+AF3 If compare, go do compare operation

60$:	MOV	(R4)+,(R5)+	; COPY THE BUFFER
	SOB	R3,60$		; ...

	MOV	R5,N.PTR(R0)	; RESTORE NEW BUFFER POINTER VALUES
	MOV	R4,N.PTR(R2)	; ...

;
; WRITE OUT DISK BUFFER IF REQUIRED
;

	SUB	N.BUF(R0),R5	; R5 = AMOUNT OF BUFFER USED
	CMP	R5,N.LEN(R0)	; COMPARE TO BUFFER SIZE
	BLO	QUEMTR		; CONTINUE IF MORE ROOM LEFT

DSKWRT:
	TST	CMPPAS		;+AF3 In compare pass?
	BEQ	20$		;+AF3 No, skip to normal write
	BIT	#EOF,FLAGS	;+AF3 This should be END-OF-FILE time
	BNE	10$		;+AF3 It is, exit gracefully
	BIS	#CMPERR,FLAGS	;+AF3 Not EOF on disk file.   Flag error
10$:
	JMP	TDDONE		;+AF3 EXIT
20$:
	MOV	R0,R5		; R5 = NODE ADDRESS
	CALL	NODDEL		; DELETE THE NODE
	MOV	R2,-(SP)	; SAVE R2
	MOV	#FDBOUT,R4	; GET FDB ADDRESS
30$:	MOV	N.LEN(R0),R2	; COPY BUFFER LENGTH
	ASH	#-9.,R2		; CHANGE IT TO BLOCKS
	INC	R2		; AND ROUND UP
	CLR	R3		; CLEAR HIGH ORDER
	ADD	F.EFBK+2(R4),R2	; ADD LOW ORDER CURRENT BLOCK
	ADC	R3		; ADD CARRY INTO HIGH ORDER
	ADD	F.EFBK(R4),R3	; ADD HIGH ORDER CURRENT BLOCK
;CHANGE CMP TO CMPB BELOW TO AVOID TROUBLES...
;ONLY 8 BITS OF HIGH BLK ALLOCATED CAN REALLY BE THERE...
	CMPB	R3,F.HIBK(R4)	; COMPARE ULTIMATE HIGH ORDER TO
				;  AMOUT ALLOCATED ALREADY
	BLO	80$	;IF LO, KNOW ALL OK
	BHI	40$		; IF HIGH, MUST EXTEND
	CMP	R2,F.HIBK+2(R4)	; COMPARE ULTIMATE LOW ORDER
	BLO	80$		; IF LOW, THERE IS ROOM
40$:	MOV	R0,-(SP)	; PUSH NODE ADDRESS ON STACK
	MOV	R4,R0		; COPY FDB ADDRESS
	MOV	SALOC,R1	; GET SECONDARY ALLOCATION VALUE
	MOV	#203,R2		; SET CONTROL BITS FOR ENABLE, CONTIGUOUS
				; (BUT FILE IS NOW NON-CONTIGUOUS)
	BIT	#CONMSK,CSIFLG	; IS /CO SET?
	BNE	50$		; YES, HENCE WANTED CONTIGUOUS
	BIC	#7,R2		; CHANGE CONTROL INDICATORS TO NON-CONTIGUOUS
;
; THERE SEEMS TO BE A PROBLEM ABOVE 65536 BLOCKS ON DISK...
; CHANGE OF CMP TO CMPB ABOVE MAY OR MAY NOT FIX IT.
; GCE 11/5/82
;
50$:	CALL	.EXTND		; DO THE EXTEND
;.EXTND BETTER RESET F.HIBK SO THE THING DOESN'T JUST GOBBLE DISK...
	BCC	60$		; IF NO ERROR FROM EXTEND, GO ON
	MOV	#ERR,FLAGS	; FLAG AN ERROR
	TST	(SP)+		; POP STACK
	JMP	TDDONE		; GET OUT
60$:	MOV	(SP)+,R0	; RESTORE NODE ADDRESS IN R0
	BR	30$		; GO BACK TO CHECK THAT INCREMENT WAS ENOUGH
80$:	MOV	(SP)+,R2	; RESTORE R2
	MOV	R0,R1		; COPY NODE ADDRESS TO R1
	ADD	#N.IOST,R1	; R1 = IO STATUS BLOCK ADDRESS
	MOV	#FDBOUT,R3	; R3 = OUTPUT FDB POINTER
	MOV	N.BUF(R0),R4	; R4 = BUFFER ADDRESS
	MOV	N.LEN(R0),R5	; R5 = BUFFER LENGTH
	MOV	F.BKVB(R3),N.BKH(R0)	; MOVE BLOCK# INTO NODE
	MOV	F.BKVB+2(R3),N.BKL(R0)	; ...
	QIO$S	#IO.WVB,#OUTLUN,,,R1,OUTVEC,<R4,R5,#0,N.BKH(R0),N.BKL(R0)>
	ADD	DSKFCT,F.BKVB+2(R3)	; UPDATE BLOCK NUMBER TO NEXT WRITE
	ADC	F.BKVB(R3)		; ...
	MOV	F.BKVB(R3),F.EFBK(R3)	; UPDATE EOF BLOCK#
	MOV	F.BKVB+2(R3),F.EFBK+2(R3) ; ...

;
; QUEUE UP MAGTAPE FOR MORE INPUT IF BUFFER IS EMPTY
;

QUEMTR:	TST	N.IOST+2(R2)	; ANY MORE DATA TO XFER FROM THIS BUFFER?
	BEQ	10$		; NO
	JMP	TPDKDQ		; TRY TO DEQUEUE MORE WORK
10$:	BIT	#EOV,FLAGS	; DONE?
	BEQ	20$		; NO - CONTINUE
	BIS	#DONE,FLAGS	; YES - FLAG IT
	MOV	#DSKLHD,R0	; R0 = DISK LISTHEAD ADDRESS
	CMP	R0,(R0)		; ANY ENTRIES IN LIST?
	BEQ	TDDONE		; NO - DONE
	MOV	(R0),R0		; R0 = DISK NODE ADDRESS
	CMP	N.BUF(R0),N.PTR(R0) ; ANY DATA IN BUFFER?
	BNE	DSKWRT		; YES - GO WRITE IT OUT
	BEQ	TDDONE		; GO RESUME MAIN TASK & EXIT

20$:	MOV	R2,R5		; COPY NODE ADDR TO R5
	CALL	NODDEL		; DELETE THE NODE
	MOV	R2,R3		; COPY NODE ADDRESS TO R3
	ADD	#N.IOST,R3	; R3 = IO STATUS ADDR
	MOV	N.BUF(R2),R4	; R4 = BUFFER ADDRESS
	TST	(R4)+		; ADVANCE OVER 1ST WORD IN BUFFER
	MOV	N.LEN(R2),R5	; R5 = LENGTH (MAX) FOR READ
	SUB	#2,R5		; REDUCE BY AMOUNT BUFFER WAS ADVANCED
	BIT	#1,D2DMSK	;READING DISK AS TAPE?
	BEQ	30$		;IF EQ NO,NORMAL
	MOV	#512.,R5	;YES, SET 1 BLOCK
	CMP	LOHI,ENDBK	;ALL BLKS ALREADY SENT?
	BLO	30$		;IF LOWER THAN END, MORE TO DO
	CMP	LOLO,ENDBK+2	;ARE LOW ORDER BLKS SAME?
	BLO	30$		;IF LOWER ALL'S WELL
	SUB	#1,LOLO		;SINCE WE PASSED END, BACK UP 1
	SBC	LOHI
30$:
	QIO$S	#IO.RLB,#INLUN,,,R3,INVEC,<R4,R5,,LOHI,LOLO>
	BIT	#1,D2DMSK
	BEQ	40$		;SKIP INC UNLESS DSK-DSK
	ADD	#1,LOLO
	ADC	LOHI		;BUMP BLOCK NUMBER (IGNORED BY TAPE DRIVER)
40$:	JMP	TPDKDQ		; TRY TO DEQUEUE MORE WORK

50$:
	Return			;+AF4 Return to ASTQIO to restore registers
				;+AF4   and exit the AST via ASTX$S


TDDONE:	RESUME			; RESUME THE MAIN TASK
	Return			;+AF4 Return to ASTQIO to restore registers
				;+AF4   and exit the AST via ASTX$S

	.page
;
; COMPARE TAPE BUFFER WITH DISK BUFFER
; READ NEW DISK BUFFERS AS NEEDED
;
CMPBUF:
	CMP	(R4)+,(R5)+	;+AF3 Same?
	BNE	BADCMP		;+AF3 No, give error message
	SOB	R3,CMPBUF	;+AF3 Test next word

	MOV	R5,N.PTR(R0)	;+AF3 Set next word pointer
	MOV	R4,N.PTR(R2)	;+AF3 ***

	SUB	N.BUF(R0),R5	;+AF3 Get length used
	CMP	R5,N.LEN(R0)	;+AF3 Compare with total available length
	BLO	10$		;+AF3 Some still left, go read more mag tape

	MOV	R0,R5		;+AF3 Save node pointer
	CALL	NODDEL		;+AF3 Delete disk node from list

	MOV	R0,R1		;+AF3 Node pointer
	ADD	#N.IOST,R1	;+AF3 Point at IOSB for this buffer
	MOV	N.BUF(R0),R4	;+AF3 Buffer address
	MOV	N.LEN(R0),R5	;+AF3 # of bytes to read
	MOV	#FDBOUT,R3	;+AF3 Get address of disk FDB
	QIO$S	#IO.RVB,#OUTLUN,,,R1,OUTVEC,<R4,R5,,F.BKVB(R3),F.BKVB+2(R3)>
	ADD	DSKFCT,F.BKVB+2(R3)	;+AF3 Update VBN
	ADC	F.BKVB(R3)	;+AF3 High order VBN
10$:
	JMP	QUEMTR		;+AF3 Do another mag tape read
;
;
;
BADCMP:
	BIS	#CMPERR!ERR,FLAGS	;+AF3 Flag error condition
	QIOW$S	#IO.KIL,#OUTLUN,#1,,#IOST	;+AF3 Kill all remaining disk reads
	QIOW$S	#IO.KIL,#INLUN,#1,,#IOST	;+AF3 Kill all remaining tape reads
	RESUME			;+AF3 Resume main program

	Return			;+AF4 Return to ASTQIO to restore registers
				;+AF4   and exit the AST via ASTX$S

	.page
	.SBTTL	Disk to tape operations
;
; DISK TO TAPE
;
;	This function transfers data from the disk file to magtape.  The
;	magtape is rewound prior to processing.  All reads from disk are
; 	multi-block QIO'S (also multi-buffered) to take advantage of the
;	higher throughput of the disk.  Magtape operations are also multi-
;	buffered.
;

DSKTTP:	CLR	FLAGS		; RESET ALL FLAGS
	CLR	DSKERR		; RESET DISK ERROR VALUE
	CLR	MTERR		; RESET MAGTAPE ERROR
	MOV	#DSKIN,INVEC	; SETUP INPUT VECTOR
	MOV	#TAPOUT,OUTVEC	; & OUTPUT VECTOR
	BIT	#2,D2DMSK	;SKIP CONTROL QIO'S?
	BEQ	10$		;IF NOT LEAVE IN
	BIT	#40,D2DMSK
	BEQ	50$
10$:
	QIOW$S	#IO.ATT,#OUTLUN,#1	; ATTACH TO TAPE UNIT
	BIT	#NRMSK,CSIFLG
	BNE	20$		;DID HE SAY NO REWIND?
	QIOW$S	#IO.RWD,#OUTLUN,#1	; REWIND TAPE
20$:	CLR	R0		;800 BPI DEFAULT
	BIT	#HDMSK,CSIFLG	;1600 BPI TAPE?
	BEQ	30$		;IF NOT LEAVE 800
	MOV	#4000,R0	;IF SO SAY 1600BPI
30$:	BIT	#SCMSK,CSIFLG	;DID HE SET OTHER CHARACTERISTICS?
	BEQ	40$		;IF EQ NO, JUST SET CHARACS.
	BIS	SCVAL,R0	;ELSE OR IN OTHER BITS HE WANTS
40$:
	QIOW$S	#IO.STC,#OUTLUN,#1,,,,<R0> ; SET TO 800BPI OR 1600BPI
50$:
;
; INITIALIZE & PALACE ALL TAPE BUFFERS IN OUTPUT QUEUE
;

	MOV	#TPLHD,R0	; R0 = TAPE BUFFER LISTHEAD
	MOV	R0,R4		; R4 = SAVED LISTHEAD ADDR
	MOV	R4,(R0)+	; SET LISTHEAD TO NULL
	MOV	R4,(R0)+	; ...

60$:	MOV	R0,R5		; R5 = BUFFER NODE ADDRESS
	CALL	NODADD		; ADD TAPE BUFFER TO LIST
	MOV	N.BUF(R5),N.PTR(R5)	; INIT THE POINTER
	CLR	N.WRK(R5)	; RESET 'NUMBER REMAINING BYTES' COUNT
	ADD	#N.SIZE,R0	; ADVANCE TO NEXT BUFFER
	CMP	R0,#TPLND	; AT END OF TAPE BUFFERS?
	BLO	60$		; NO - CONTINUE

;
; INITATE DISK I/O OPERATIONS FOR ALL AVAILABLE DISK BUFFERS
;

	MOV	#DSKLHD,R0	; R0 = DISK LISTHEAD POINTER
	MOV	R0,R1		; R1 = SAVE LISTHEAD ADDR
	MOV	R1,(R0)+	; INITIATE THE LISTHEAD TO NULL
	MOV	R1,(R0)+	; ...

80$:	MOV	N.BUF(R0),R2	; R2 = BUFFER ADDRESS
	MOV	R2,N.PTR(R0)	; INIT THE BUFFER POINTER
	MOV	N.LEN(R0),R3	; R3 = LENGTH OF READ

;***	BIT	#3,D2DMSK	; READ DISKS 1 BLK AT A TIME
;***	BEQ	240$
;***	MOV	#512.,R3	; I.E. 512 BYTES

;240$:
	MOV	R0,R1		; R1 = IO STATUS BLOCK ADDR
	ADD	#N.IOST,R1	; ...
	MOV	#FDBINP,R5	; R5 = INPUT FDB ADDRESS
	QIO$S	#IO.RVB,#INLUN,,,R1,INVEC,<R2,R3,,F.BKVB(R5),F.BKVB+2(R5)>
	ADD	DSKFCT,F.BKVB+2(R5) ; UPDATE THE NEXT BLOCK NO.
	ADC	F.BKVB(R5)	; ...
	ADD	#N.SIZE,R0	; ADVANCE TO NEXT BUFFER NODE
	CMP	R0,#DSKLND	;+AF3 Past end?
;????	CMP	R0,#DSKLND	;+AF3 Past end?
	BLO	80$		; CONTINUE IF IN RANGE
	JMP	WAIT		; ELSE GO WAIT FOR XFER TO COMPLETE
	.page
	.SBTTL	DSKIN	- Disk input AST routine
;
; DSKIN - Handle disk I/O done AST
;

DSKIN:
	JSR	R5, ASTQIO	;+AF4 Save registers & call us back with
				;+AF4    AST parameter in R3
	MOV	R3, R5		;+AF4 R5 = I/O STATUS ADDRESS
	SUB	#4,R5		; POINT R5 TO NODE BEGINNING
	BIT	#<ERR!DONE>,FLAGS ; ANY ERRORS OR IS I/O COMPLETE?
	BNE	85$		; YES - JUST EXIT THE AST
	TSTB	N.IOST(R5)	; WAS THERE AN ERROR ON THIS XFER?
	BPL	20$		; NO - CONTINUE
	CMPB	#IE.EOF,N.IOST(R5)	; WAS IT EOF?
	BNE	40$		; NO - REAL ERROR
	BIT	#3,D2DMSK	; THIS A DSK-DISK XFER?
	BEQ	10$		; IF EQ NO
	CMP	ENDIO,ENDBK	; IF NE YES, BE SURE OUTPUT DONE
	BHI	10$		; SET EOF WHEN DONE
	BLO	20$
	CMP	ENDIO+2,ENDBK+2	; CHECK DBL PREC.
	BLO	20$		; IF NOT AT END IGNORE EOF INPUT
10$:
	BIS	#EOF,FLAGS	; FLAG EOF
	BR	85$		; & IGNORE AST

20$:	MOV	N.IOST+2(R5),N.WRK(R5)	; COPY THE # BYTES XFERRED
	ADD	N.BUF(R5),N.WRK(R5)	; POINT TO END BYTE + 1
	MOV	N.BUF(R5),N.PTR(R5)	; SETUP THE BEGINNING PTR
	MOV	DSKLHD+2,R4	; R4 = PRIOR (LAST) NODE IN LIST ADDR
	CALL	NODADD		; ADD NODE TO END OF QUEUE
;
;+AF3 Here we get sneeky.   If this is a compare operation, this AST
;+AF3 is being used by the tape-to-disk routine, but for read operations.
;
	TST	CMPPAS		;+AF3 Is this a compare pass?
	BEQ	30$		;+AF3 No, skip and do normal stuff
	JMP	TPDKDQ		;+AF3 Yes, go to tape-to-disk dequeue routine
30$:
	JMP	DKTPDQ		; GO TO MAIN DE-QUEUING ROUTINE

40$:	TST	CMPPAS		;+AF3 Doing compare?
	BEQ	50$			;+AF3 No,skip
	QIOW$S	#IO.KIL,#OUTLUN,#1,,#IOST ; CANCEL ALL OTHER DISK I/O'S
	BR	60$
50$:
	QIOW$S	#IO.KIL,#INLUN,#1,,#IOST ; CANCEL ALL OTHER DISK I/O'S
60$:
	BIS	#ERR,FLAGS	; FLAG THE ERROR
	MOVB	N.IOST(R5),DSKERR ;+AF1 SAVE DISK ERROR CODE
	BPL	80$		;+AF1 SKIP IF POSITIVE (NOT LIKELY)
	MOVB	#-1,DSKERR+1	;+AF1 ELSE MAKE HI BYTE NEGATIVE ALSO
80$:
	RESUME			; CONTINUE THE MAIN TASK

85$:
	Return			;+AF4 Return to ASTQIO to restore registers
				;+AF4   and exit the AST via ASTX$S

	.page
	.SBTTL	TAPOUT	- Tape output I/O done AST routine
;
; TAPOUT - Tape output I/O done routine
;

TAPOUT:
	JSR	R5, ASTQIO	;+AF4 Save registers & call us back with
				;+AF4    AST parameter in R3
	MOV	R3, R5		;+AF4 R5 = I/O STATUS ADDRESS
	BIT	#<ERR!DONE>,FLAGS	; ERRORS OR DONE?
	BEQ	10$
	JMP	85$		; YES - JUST EXIT
10$:
	ADD	#1,ENDIO+2	;COUNT I/O DONES
	ADC	ENDIO
	BIT	#2,D2DMSK
	BEQ	20$
	CMP	ENDIO,ENDBK
	BLO	20$		;PAST END?
	BHI	40$
	CMP	ENDIO+2,ENDBK+2
	BHIS	40$		;TREAT AS EOF
20$:
	SUB	#N.IOST,R5	; ADJUST R5 TO POINT TO NODE
	BIT	#ERMSK,CSIFLG	;TRYING TO IGNORE TAPE ERRORS?
	BEQ	30$		;IF NOT, LOOK AT ALL
	CMPB	N.IOST(R5),#IE.PRI ;TAPE UNMOUNTED?
	BEQ	60$		;IF SO THEN DONE. IGNORE OTHER ERRORS
;
; NOTE: The /EV or /ER switches can make tape run off reel. Too bad
; if so (user ought to know better...)
;
	BIT	#EVMSK,CSIFLG
	BNE	24$
	CMPB	N.IOST(R5),#IE.EOT
	BEQ	60$
	CMPB	N.IOST(R5),#IE.EOV
	BEQ	60$		;ALLOW PRIV, EOT, OR EOV AS REAL.
24$:	BR	50$		;SKIP NORMAL TEST THEN
30$:	TSTB	N.IOST(R5)	; WAS THERE AN ERROR ON THE XFER?
	BMI	60$		; YES - SO INDICATE
	BR	50$
40$:	BIT	#40,D2DMSK	;UNLESS SPECIAL FLAG SET
	BNE	50$
	BIS	#DONE,FLAGS	;ON DSK-DSK, DONE WHEN FINISHED XFER
	MOV	N.BUF(R5),N.PTR(R5)	; SETUP THE BUFFER POINTER
	CLR	N.WRK(R5)	; RESET THE NO. BYTES LEFT TO XFER
	MOV	TPLHD+2,R4	; R4 = PRIOR (LAST) EXISTING NODE ADDR
	CALL	NODADD		; ADD THE NODE TO FREE TAPE BUFFER LIST
	QIOW$S	#IO.KIL,#OUTLUN,#1,,#IOST ; CANCEL ALL CURRENT I/O'S
	BR	80$
50$:
	MOV	N.BUF(R5),N.PTR(R5)	; SETUP THE BUFFER POINTER
	CLR	N.WRK(R5)	; RESET THE NO. BYTES LEFT TO XFER
	MOV	TPLHD+2,R4	; R4 = PRIOR (LAST) EXISTING NODE ADDR
	CALL	NODADD		; ADD THE NODE TO FREE TAPE BUFFER LIST
	JMP	DKTPDQ		; GO TO THE MAIN DE-QUEUING ROUTINE

60$:
	QIOW$S	#IO.KIL,#OUTLUN,#1,,#IOST ; CANCEL ALL CURRENT I/O'S
	BIS	#ERR,FLAGS	; FLAG THE ERROR
	MOVB	N.IOST(R5),MTERR ;+AF1 Save error code
	BPL	80$		;+AF1 Skip if positive (not likely)
	MOVB	#-1,MTERR+1	;+AF1 else make HI byte negative also
80$:
	RESUME			; CONTINUE EXECUTION OF MAIN TASK

85$:
	Return			;+AF4 Return to ASTQIO to restore registers
				;+AF4   and exit the AST via ASTX$S

	.page
	.SBTTL	DKTPDQ	- Disk to tape dequeue routine
;
; DKTPDQ-
;
;	This routine interfaces the data coming in a continuous stream
;	from the disk (in multi-block buffers) to the magtape output. As
;	the tape is blocked 512., it is desirable to keep a constant no.
;	of I/O requests queued up to the tape drive, thereby allowing
;	this program to pay for itself.
;

DKTPDQ:	MOV	#DSKLHD,R0	; R0 = DISK LISTHEAD POINTER
	CMP	(R0),R0		; NULL LIST?
	BEQ	10$		; YES - WAIT FOR WORK
	MOV	(R0),R0		; R0 = THE 1ST NODE ADDR IN LIST

	MOV	#TPLHD,R2	; R2 = TAPE OUTPUT LISTHEAD ADDR
	CMP	(R2),R2		; ANY NODES FREE FOR OUTPUT?
	BEQ	10$		; NO - WAIT FOR SOME TO FREE UP
	MOV	(R2),R2		; R2 = ADDR OF 1ST FREE TAPE NODE
	BR	20$		; CONTINUE

10$:
	Return			;+AF4 Return to ASTQIO to restore registers
				;+AF4   and exit the AST via ASTX$S

;
; Transfer data from the current disk buffer to the current tape buffer
; (note that this might be the resumption of a transfer begun earlier). When
; the tape buffer is filled (or the operation type determined if EOF), the
; the tape node is dequeued & the output initiated.  When a disk buffer is
; empty, the next one in the queue is serviced.
;

20$:	MOV	N.WRK(R2),R3	; R3 = REMAINING BYTES IF PARTIAL XFER
	BNE	30$		; WAS A PARTIAL - CONTINUE IT
	MOV	@N.PTR(R0),R3	; ELSE, START OF NEW RECORD
	ADD	#2,N.PTR(R0)	; ADVANCE OVER CONTROL WORD
	MOV	R3,N.WRK(R2)	; SAVE IT AS SIZE REQ'D
	BNE	30$
	JMP	160$		; ZERO - GO WRITE EOF

30$:	MOV	N.WRK(R0),R1	; R1 = ENDING DISK BUFFER ADDR
	SUB	N.PTR(R0),R1	; R1 = # BYTES LEFT IN BUFFER
	BNE	50$
40$:	JMP	210$		; NO BYTES LEFT IN BUFFER!
50$:
	CMP	R1,R3		; WILL THIS BE A PARTIAL COPY?
	BHIS	60$		; NO - ALL OF DATA IN DISK BUFFER
	SUB	R1,R3		; R3 = AMOUNT STILL REQ'D
	MOV	R3,N.WRK(R2)	; UPDATE TAPE BUFFER REMAINING COUNT
	MOV	R1,R3		; R3 = ACTUAL NUMBER OF BYTES TO XFER
	BR	80$		; CONTINUE

60$:	CLR	N.WRK(R2)	; INDICATE WHOLE XFER GOOD

80$:	MOV	N.PTR(R0),R4	; R4 = FROM POINTER
	MOV	N.PTR(R2),R5	; R5 = TO POINTER
	ASR	R3		; R3 = WORD XFER COUNT

85$:	MOV	(R4)+,(R5)+	; COPY THE DARA
	SOB	R3,85$		; ...

	MOV	R4,N.PTR(R0)	; UPDATE THE DISK POINTER
	MOV	R5,N.PTR(R2)	; & THE TAPE POINTER
	TST	N.WRK(R2)	; DO WE WRITE THE TAPE BUFFER?
	BNE	40$		; NO - SEE ABOUT DISK
	MOV	N.BUF(R2),R4	; R4 = TAPE BUFFER ADDRESS
	SUB	R4,R5		; R5 = NO. BYTES DATA IN BUFFER
	MOV	R2,R3		; R3 = THE IO STATUS ADDR
	ADD	#N.IOST,R3	; ...
	BIT	#3,D2DMSK
	BEQ	95$
	CMP	LOHI,ENDBK
	BHI	100$
	BLO	95$
	CMP	LOLO,ENDBK+2
	BHIS	100$
95$:
	QIO$S	#IO.WLB,#OUTLUN,,,R3,OUTVEC,<R4,R5,,LOHI,LOLO>
100$:
	BIT	#3,D2DMSK
	BEQ	110$
	ADD	#1,LOLO
	ADC	LOHI		;COUNT BLK # TO DO
110$:
	BIC	#EOV,FLAGS	; RESET THE END-OF-VOLUME TEST BIT
;
;GCE02 - For ANSI tape set HDRLVL or ANSCNT and don't set EOV status
; if inside ANSI area where 2 EOFS are * NOT * EOV.
;
	BIT	#1,ANSFLG	; /ANSI TAPE FLAG SEEN?
	BEQ	150$		; IF EQ NO, NORMAL
	BIT	#4,ANSFLG	;IS THIS /RT11 ANSI VERSION (NOT 80 BYTE LABELS)
	BNE	120$		;IF SO SKIP LENGTH CHECK
	CMP	R5,#80.		;WRITING 80 BYTES?
	BNE	150$		;IF NOT THIS ISN'T OF INTEREST
120$:	CMP	(R4),LITEO	; EOV OR EOF2?
	BNE	140$		; IF NOT CHECK FOR HDR2
;COULD BE AN EOV OR EOF2
	CMPB	2(R4),LITVV	; IS IT EOV?
	BNE	130$		;IF NE NO
; SAW EOV1 SO BUMP ANSCNT
	INC	ANSCNT		;COUNT EOV1
	BR	200$
130$:	CLR	ANSCNT		;2 EOV1 IN A ROW ARE REAL END
	CMP	2(R4),LITF2	; SEE IF EOF2 RECORD
	BNE	200$		; IF NE NO, JUST SKIP ANY SPECIAL STUFF
	DEC	HDRLVL		;ELSE COUNT DOWN HEADER LEVEL
	BGE	200$		;AND
	CLR	HDRLVL		;...CLAMP IT POSITIVE OR 0
	BR	200$
140$:	CMP	(R4),LITHD	;COULD THIS BE HDR2?
	BNE	200$		;IF NOT, JUST BYPASS
	CMP	2(R4),LITR2	;IF REALLY HDR2 THIS WILL BE EQ
	BNE	200$
	INC	HDRLVL		;SO COUNT UP LEVEL
150$:
; END GCE02
	BR	200$		; CONTINUE

160$:	MOV	R2,R3		; R3 = IO STATUS ADDR
	ADD	#N.IOST,R3	; ...
	BIT	#3,D2DMSK	;DSK-DSK?
	BEQ	170$
	BIT	#40,D2DMSK
	BNE	170$
	BR	180$
170$:
	QIO$S	#IO.EOF,#OUTLUN,,,R3,OUTVEC
180$:
	BIT	#EOV,FLAGS	; WAS EOV FLAG SET LAST TIME?
	BNE	230$		; YES - TWO EOF'S = EOV
	BIT	#1,ANSFLG	; /ANSI TAPE? 	;GCE02
	BEQ	190$		; IF EQ NO, JUST SET EOV
	CMP	ANSCNT,#2	; SAW EOV1 AND EOV2 RECORDS ALREADY?
	BHIS	190$		;IF SO SET EOV FLAG FOR NEXT EOF
	TST	HDRLVL		;BUT IF BETWEEN HDR2 AND EOF2 INSIDE VOL...
	BNE	200$		;...THEN DON'T SET EOV FLAG
190$:
;END GCE02
	BIS	#EOV,FLAGS	; NO - SO SET IT FOR THIS EOF

200$:	MOV	R2,R5		; R5 = NODE ADDRESS FOR DELETE
	CALL	NODDEL		; DELETE THE NODE FROM THE QUEUE

;
; DETERMINE WHETHER CURRENT DISK BUFFER IS EMPTY & INITIATE A NEW READ IF SO
;

210$:	CMP	N.WRK(R0),N.PTR(R0)	; BUFFER EMPTY?
	BLOS	220$
	JMP	DKTPDQ		; NO - CONTINUE DEQUEUEING
220$:
	MOV	R0,R5		; R5 = NODE ADDR
	CALL	NODDEL		; DELETE THE NODE FROM DISK QUEUE
	MOV	R0,R1		; R1 = IO STATUS ADDR
	ADD	#N.IOST,R1	; ...
	MOV	N.BUF(R0),R4	; R4 = BUFFER ADDR
	MOV	N.LEN(R0),R5	; R5 = NO. BYTES TO READ

;***	BIT	#3,D2DMSK	; READ DISKS 1 BLK AT A TIME...
;***	BEQ	382$
;***	MOV	#512.,R5

;382$:
	MOV	#FDBINP,R3	; R3 = FDB ADDR
	QIO$S	#IO.RVB,#INLUN,,,R1,INVEC,<R4,R5,,F.BKVB(R3),F.BKVB+2(R3)>
	ADD	DSKFCT,F.BKVB+2(R3) ; UPDATE NEXT BLOCK#
	ADC	F.BKVB(R3)	; ...
	JMP	DKTPDQ		; CONTINUE

230$:	BIS	#DONE,FLAGS	; FLAG I/O DONE
	.IF	NDF,XXEOF
	BIT	#2,D2DMSK
	BEQ	240$
	BIT	#40,D2DMSK
	BEQ	250$
240$:
	QIO$S	#IO.EOF,#OUTLUN,,,R3,OUTVEC
	QIO$S	#IO.EOF,#OUTLUN,,,R3,OUTVEC
	QIO$S	#IO.EOF,#OUTLUN,,,R3,OUTVEC
;
;NOW HAVE 5 EOF'S OUT TO DO. THUS WE NEED TO BACKSPACE OVER 4 RECORDS
;TO LEAVE TAPE IN POSITION AFTER THE FIRST EOF. DO IT THUS:
;
	.MCALL	QIOW$S
	QIOW$S	#IO.SPF,#OUTLUN,#20.,,R3,OUTVEC,#-4	;BACKSPACE OVER 4 EOFS
	BIT	#20,D2DMSK	;/FR FINAL REWIND WANTED?
	BEQ	250$		;IF NOT SKIP IT
	QIOW$S	#IO.RWD,#OUTLUN,#20.,,R3,OUTVEC	;DO THE REWIND
250$:
;
; Note the wait to ensure we get done.
; This will prevent the IO.KIL from clobbering the EOF writes that are
; outstanding.
;
	.ENDC
	RESUME			; CONTINUE THE MAIN TASK
	Return			;+AF4 Return to ASTQIO to restore registers
				;+AF4   and exit the AST via ASTX$S

	.page

	.SBTTL	--SUBROUTINES--
	.SBTTL	NODADD	-  Add node to deque
;
; NODADD-	Add node to deque list
;
;  Inputs:	R5 = Node address
;		R4 = Prior node address
;
;  Outputs:	same
;

NODADD:	MOV	R4,2(R5)	; SETUP BACKWARD POINTER
	MOV	(R4),(R5)	; SETUP FORWARD POINTER
	MOV	R5,(R4)		; SETUP PRIOR FORWARD POINTER
	MOV	(R5),R5		; POINT R5 TO NEXT NODE
	MOV	(R4),2(R5)	; SETUP NEXT BACKWARD POINTER
	MOV	(R4),R5		; RESTORE R5
	RETURN


	.SBTTL	NODDEL	-  Delete node from deque
;
; NODDEL-	Delete node from dequeue list
;
;  Inputs:	R5 = Node address
;
;  Outputs:	same
;

NODDEL:	MOV	(R5),@2(R5)	; POINT PRIOR TO NEXT
	MOV	(R5),-(SP)	; SAVE NEXT ADDRESS
	ADD	#2,(SP)		; POINT TO NEXT BACWARD POINTER
	MOV	2(R5),@(SP)+	; POINT NEXT BACKWARD TO PRIOR
	RETURN


	.Page
	.SBTTL	ASTSAV  -  AST Register Save/Restore

;+AF4	ASTSAV routine added to TPC on 26-Jun-91 to fix a problem with
;+AF4	the AST routines not saving/restoring the registers.   Aaaaack!!!
;+AF4	It took 14 years (and a super-fast disk controller) to find this bug!

;+
; Save registers from AST and call caller back as a co-routine.
; On return from the user's code, restore the registers and
; exit the AST.   Some entries set R3 to the optional parameter
; (while removing it from the stack).   These are ASTQIO, ASTTIM
; ASTCLI, and ASTSTS.
;
; Call with:	JSR	R5, ASTxxx
;
; Exit with:	AST dismissed
;-

	.Enabl	LSB

ASTQIO::			; QIO Completion
ASTTIM::			; Mark Time
ASTCLI::			; Command Arrival
ASTSTS::			; Offspring Status
	Mov	R3, -(SP)	; Save R3
	Mov	4(SP), R3	; Get optional  parameter
	Mov	2(SP), 4(SP)	; Save R5
	Mov	R4, 2(SP)	; Save R4
	Br	1000$		;   and continue

ASTPWF::			; Power Recovery
ASTRCV::			; Receive Data
ASTRRF::			; Receive-by-Reference
ASTEXI::			; Task Exit (non-extended)
	Mov	R4, -(SP)	; Save R4
	Mov	R3, -(SP)	;  ... R3
1000$:
	Mov	R2, -(SP)	;  ... R2
	Mov	R1, -(SP)	;  ... R1
	Mov	R0, -(SP)	;  ... R0
	Call	(R5)		; Call caller back
;
; Return here via RTS PC after AST has been processed
;
	Mov	(SP)+, R0	; Restore R0
	Mov	(SP)+, R1	;   ...   R1
	Mov	(SP)+, R2	;   ...   R2
	Mov	(SP)+, R3	;   ...   R3
	Mov	(SP)+, R4	;   ...   R4
	Mov	(SP)+, R5	;   ...   R5
	ASTX$S			; Exit AST

	.Dsabl	LSB

        .END    BEGIN		;JKN02