.TITLE	TPC - DOS11 TAPE/DISK COPY UTILITY
	.SBTTL	INTRODUCTION
	.IDENT	/V01.61/
	.MCALL	GCMLB$,GCML$,CSI$,CSI$1,CSI$2,CSI$SW,CSI$ND,DIR$,PUT$
	.MCALL	FDBDF$,FDAT$R,NMBLK$,WTSE$S,GET$,EXIT$S
	.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
;+
; VERSION 01
;
; REID L BROWN	27-OCT-77
;
; MODIFIED BY:
;
;	G H COHEN, 21-AUG-78
;	INSERT A DEFAULT VALUE FOR FILE ALLOCATION SIZE
;	USE .TRNCL IN PLACE OF .CLOSE
;	PROVIDE A MEANS FOR FILE EXTENSION
;	ATTACH TO MAGTAPE UNIT AND SET DENSITY TO 800BPI
;
;
;++AF1	A E Frisbie, 31-JAN-80
;++AF1	When moving error codes to MTERR or DSKERR, use MOVB instead of MOV,
;++AF1	followed by a MOVB #-1 if the result is negative.   This corrects the
;++AF1	problem of error numbers being printed as a positive value.
;
;++AF2	A E Frisbie, 12-MAR-80
;++AF2	Enlarge buffer size to handle larrrrrrrge records (4200. bytes).
;++AF2	This allows TPC to copy DSC and BRU tapes.
;
; THIS ROUTINE WILL PRESERVE A DOS-11 MAGTAPE IN IMAGE FORMAT ON DISK, OR
; RESTORE AN IMAGE FORMAT FILE FROM DISK TO MAGTAPE.  ITS UTILITY IS ITS
; ABILITY TO DRIVE THE MAGTAPE DRIVE AT FULL SPEED.  THIS FEATURE IS USEFUL
; WHEN MAKING LARGE NUMBERS OF COPIES OF DOS-11 MAGTAPE DATA.  THE RSX-11
; FILES-11 FILE IS COMPATIBLE WITH FCS VARIABLE LENGTH, BLOCK SPANNED
; RECORD MODE.
;
; gce02 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. (12/15/81)
; gce03 Add /RT11 switch to handle RT11 variant ANSI fmt (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. (1/3/82)
; gce04 add /FLX:NAME SWITCH TO ALLOW CREATION OF PSEUDO - FLX TYPE LABEL
;	RECORD IN [1,1]
; CONDITIONAL $VAX WILL DEFINE A "BIGGERTPC" TO HANDLE RECORDS UP TO
; 11000. BYTES LONG. (WORKS FINE ON VAX)
;
;	GCE05 - 3/14/83 - ADD SUPPORT FOR COPY PAST EOV/EOT IF ANSI.
; jn - add mf: (tu78) to list
;
;-

;
; 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

	.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 ADDR OF FDB'S

GCMBLK:	GCMLB$	3,TPC,,TILUN	; COMMAND LINE CONTROL BLOCK

INDFN:	NMBLK$	,DOS,,SY,0		; DEFAULT FILENAME: '.DOS'
OUTDFN:	NMBLK$	,DOS,,SY,0		;     "      "      '.DOS'

;
; 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	HD,HDMSK,CSIFLG,SET,NEG
	CSI$SW	NR,NRMSK,CSIFLG,SET,NEG
	CSI$SW	ER,ERMSK,CSIFLG,SET,NEG
	CSI$SW	EV,EVMSK,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$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 [+/-]
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
	CSI$
CSI:	.BLKB	C.SIZE		; DEFINE THE CSI WORK AREA
	.EVEN

	.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 -	DOS11 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 FILEX).'
	.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	'		/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'

	.EVEN

	.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		[ IO STATUS WORD #0	]
		; WD: 3		[ IO 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.
	.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
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,0 ; MAGTAPE DEVICE LIST
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

;
; 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=	.

	.SBTTL	PARSE INPUT SPECIFICATION & CHOOSE ACTION

;
; GET COMMAND LINE, PARSE IT & START ALL FILES
;

START:
	ALUN$S	#TILUN,#"TI,#0	;ENSURE TERMINAL ASSIGNED ON TILUN
	CALL	CLOSE		; INSURE ALL FILES ARE CLOSED (IGNORE ERRORS)
	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
110$:	CLR	(R0)+		; CLEAR OUT THE FILE DESCRIPTOR BLOCKS
	CMP	R0,#FDBEND	; AT END YET?
	BLO	110$		; 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
	MOV	#494.,SZLO	; DEFAULT RX01 SIZE FOR /SZ
	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
	GCML$	#GCMBLK		; READ A COMMAND LINE
	BCC	130$		; CONTINUE IF NO ERRORS
	CMPB	#GE.EOF,G.ERR(R0) ; END OF COMMAND INPUT?
	BNE	120$		; NO - COMMAND INPUT ERROR
	EXIT$S

120$:	ERRMSG	<TPC -- COMMAND LINE INPUT ERROR>
	JMP	START

130$:	CSI$1	#CSI,GCMBLK+G.CMLD+2,GCMBLK+G.CMLD ; PARSE COMMAND LINE
	BCC	140$		; CONTINUE IF NO ERRORS
135$:	ERRMSG	<TPC -- COMMAND LINE SYNTAX ERROR>
	JMP	START

140$:	CSI$2	R0,OUTPUT,#CSISW ; PARSE OUTPUT FILESPEC & SWITCHES
	BCC	160$		; NO ERRORS - CONTINUE
150$:	ERRMSG	<TPC -- INVALID SWITCH>
	JMP	START

160$:	BITB	#<CS.WLD!CS.MOR>,C.STAT(R0)
	BNE	135$
;SET UP /EBCDIC SUBLITERALS IF /EB SWITCH WAS SEEN
	BIT	#2,ANSFLG	;DID HE SET THE /EBCDIC SWITCH?
	BEQ	563$		;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
563$:
	BIT	#4,ANSFLG	;/RT11 SWITCH SET?
	BEQ	573$	;IF EQ NO
	MOV	#"F1,LITF2
	MOV	#"R1,LITR2	;LOOK FOR HDR1, EOF1 IF SO
573$:
	BIT	#HLPMSK,CSIFLG	; DID THE USER WANT HELP?
	BEQ	161$		; NO - CONTINUE
	JMP	HELP		; GIVE HIM HELP

161$:	BIT	#CONMSK,CSIFLG	; IS FILE TO BE CONTIGUOUS
	BNE	162$		; IF NE, YES
	TST	ALLOC		; IS ALLOC NEGATIVE
	BMI	163$		; IF YES SKIP
	NEG	ALLOC		; NEGATE IT
	BR	163$
162$:	TST	ALLOC		; IS ALLOC POSITIVE
	BPL	163$		; IF YES SKIP
	NEG	ALLOC		; NEGATE IT
163$:	BNE	263$		; (ALWAYS ALLOCATE SOMETHING!)
	MOV	#200.,ALLOC	;START AT 200 AT LEAST
263$:	TST	SALOC		; BUT NEVER LET SALOC REMAIN NEGATIVE
	BPL	164$		; IF POSITIVE, SKIP
	NEG	SALOC		; NEGATE IT
164$:	BNE	264$		;ALSO ALWAYS HAVE A SECONDARY ALLOC.
	MOV	#50.,SALOC
264$:	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	534$		;NORMAL IF NOT DSK-DSK
	CALL	.PRSDV		;PARSE DEVICE INFO
	BR	533$
534$:	CALL	.GTDID	;GET DEFAULT DIRECTORY ;;;GCE03
	CALL	.PARSE		; PARSE THE FILENAME BLOCK INFO
533$:	BCS	168$		; ERROR ON PARSE
	BIT	#102,D2DMSK	; IS THIS WRITING A "TAPE" (REALLY DISK?)
	BNE	500$		; IF SO FORGET DEVICE NAME CHECK
	CALL	MAGTST		; TEST FOR MAGTAPE DEVICE
	BCC	167$		; OUTPUT FILE IS DISK - OPEN IT
500$:	DEC	OUTDVF		; OUTPUT IS MAGTAPE - SO INDICATE
	BR	170$		; CONTINUE

167$:	OFNB$	R0,#FO.WRT,#OUTLUN,,,#FD.RWM
	BCC	170$		; CONTINUE IF NO ERRORS
168$:	ERRMSG	<TPC -- OPEN ERROR ON OUTPUT FILE>
	JMP START

170$:	MOV	#1002,F.RSIZ(R0) ; INIT THE RECORD SIZE IN FDB
	CLR	F.FFBY(R0)	; INDICATE NEXT BLOCK EMPTY
	CSI$2	#CSI,INPUT,#CSISW ; PARSE INPUT FILE & SWITCHES
	BCC	171$		; NO ERROR IF CARRY CLEAR
	JMP	150$		; REPORT SWITCH ERROR
171$:	BITB	#<CS.MOR!CS.WLD>,C.STAT(R0) ; NO WILDCARDS, ETC ALLOWED
	BEQ	173$		; OK - CONTINUE
	JMP	135$		; REPORT IT AS ERROR
173$:	BIT	#HLPMSK,CSIFLG	; DID HE WANT HELP?
	BEQ	175$		; NO - CONTINUE
	JMP	HELP		; YES - GIVE HIM HELP

175$:	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	543$
	CALL	.PRSDV
	BR	544$
543$:	CALL	.GTDID		; GET DEFAULT DIRECTORY
	CALL	.PARSE		; PARSE THE FILENAME BLOCK DATA
544$:	BCS	180$		; ERROR ON PARSE
	BIT	#101,D2DMSK	; IS THE INPUT A DISK LOOKING LIKE A TAPE?
	BNE	501$		; IF SO, FLAG FOR LATER
	CALL	MAGTST		; SEE IF THIS IS MAGTAPE
	BCC	190$		; NO - TRY TO OPEN THE FILE
501$:	DEC	INDVF		; INDICATE INPUT DEVICE IS MAGTAPE
	BR	200$		; CONTINUE
180$:	ERRMSG	<TPC -- OPEN ERROR ON INPUT FILE>
	JMP	START

190$:	OFNB$	R0,#FO.RD,,#INLUN,,,#FD.RWM
	BCS	180$		; ERROR ON OPEN

;
; DETERMINE WHETHER WE HAVE CORRECT COMBINATION OF DISK & MAGTAPE DEVICES:
; I.E. 1 DISK & 1 MAGTAPE
;

200$:	MOV	OUTDVF,R0	; R0 = OUTPUT DEVICE FLAG
	MOV	INDVF,R1	; R1 = INPUT DEVICE FLAG
	BIT	#100,D2DMSK
	BNE	210$		; /IM COPY IS BOTH DEVICES.
	XOR	R0,R1		; IF NOT -1, THEN WE HAVE 2 OF A KIND!
	BMI	210$		; GOOD! - CONTINUE
	ERRMSG	<TPC - SPECIFY 1 FILE & 1 MAGTAPE DEVICE>,START

210$:
;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	216$		;IF SO HANDLE SPECIALLY
	TST	R0		; WHICH WAS IT?
	BPL	215$		; OUTPUT IS DISK
	JMP	DSKTTP		; OUTPUT IS MAGTAPE
215$:	JMP	TPTDSK		; TAPE-TO-DISK
216$:	JMP	IMGMOD		; IMAGE MODE COPY

;
; 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	90$		; GOT IT! - ITS MAGTAPE (SET CARRY)
	TST	(R5)		; ANY MORE ENTRIES?
	BNE	10$		; YES - CONTINUE
	RETURN
90$:	SEC			; INDICATE MAGTAPE
	RETURN
;
; CLOSE - CLOSE FILES AT END OF RUN
;

CLOSE:
;	MOV	#FDBINP,R0	; POINT TO INPUT FDB
;	CALL	.TRNCL		; TRUNCATE AND CLOSE IT
	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
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
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


	.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
	JMP	START		; NO - 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
	JMP	ERROR		; PROCESS THE ERROR


;
; 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

	.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	204$		;IF SO LEAVE IN
	BIT	#40,D2DMSK	;SEE IF WANTED EVEN THO' DISK-DISK
	BEQ	203$		;IF NOT,SKIP 'EM
204$:
	QIOW$S	#IO.ATT,#INLUN,#1	; ATTACH TO TAPE UNIT
	BIT	#NRMSK,CSIFLG	;DID HE WANT TO SKIP THE REWIND?
	BNE	200$		;IF SO, SKIP REWIND
	QIOW$S	#IO.RWD,#INLUN,#1	; REWIND THE MAGTAPE
200$:	CLR	R0		;SET 800 BPI DENSITY INITIALLY
	BIT	#HDMSK,CSIFLG	;DID HE SAY HIGH DENSITY?
	BEQ	201$		;IF NOT LEAVE AT 800 BPI
	MOV	#4000,R0	;IF SO, SET 1600 BPI
201$:	BIT	#SCMSK,CSIFLG	;WAS THE /SC:NNNNNN SWITCH USED?
	BEQ	202$		;IF NOT JUST SET CHARACTS.
	BIS	SCVAL,R0	;ELSE OR IN CHARACTERISTICS WANTED
202$:
	QIOW$S	#IO.STC,#INLUN,#1,,,,<R0> ; SET TO 800BPI OR 1600 BPI
203$:
;
; 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!

10$:	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	10$		; 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)+	; ...

30$:	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	100$		;IF EQ NO, NORMAL
	MOV	#512.,R4	;ELSE SET 1BLOCK SIZE OF BUFFER
100$:
	QIO$S	#IO.RLB,#INLUN,,,R2,INVEC,<R3,R4,,LOHI,LOLO>;READ THE BLOCK
	BIT	#3,D2DMSK
	BEQ	215$		;IF NOT DSK-DSK OMIT COUNT HERE
	ADD	#1,LOLO
	ADC	LOHI		;THEN COUNT UP THE BLOCK NUMBER
215$:	ADD	#N.SIZE,R0	; R0 = ADDRESS OF NEXT BUFFER NODE
	CMP	R0,#TPLND	; ANY MORE TAPE BUFFERS?
	BLO	30$		; YES - CONTINUE
	JMP	WAIT		; NO - GO WAIT FOR I/O DONE

	.SBTTL	TAPEIN	- TAPE INPUT AST
;
; TAPEIN - HANDLE TAPE INPUT AST
;

	.GLOBL	TAPEIN,FLAGS
TAPEIN:	MOV	(SP)+,R5	; R5 = I/O STATUS ADDRESS
	BIT	#<EOV!ERR!DONE>,FLAGS	; ERROR OR END FLAGGED?
	BEQ	1$
	JMP	100$		; YES - GET OUT
1$:
	ADD	#1,ENDIO+2	;COUNT BLKS FINISHED
	ADC	ENDIO
	BIT	#1,D2DMSK	;SKIP UNLESS DSK-DSK
	BEQ	200$
	CMP	ENDIO,ENDBK	;HI PAST END?
	BHI	27$		;IF SO TREAT AS EOF
	BLO	200$		;IF LO ALLS WELL
	CMP	ENDIO+2,ENDBK+2	;LO BLK # PAST OR AT END?
	BHI	27$		;IF SO TREAT AS EOF
200$:
	MOV	N.BUF-N.IOST(R5),R4 ; R4 = BUFFER ADDRESS
	BIT	#ERMSK,CSIFLG	;IGNORING ERRORS?
	BEQ	2$		;IF NOT, LOOK AT ALL.
	CMPB	#IE.EOF,@R5	;WAS IT ENDFILE???
	BEQ	2$		;YES, LEAVE THAT 'ERROR'
; GCE05 - IF IGNORING IE.EOT,IE.EOV, SHOULD BE ABLE TO READ TAPES
; CREATED AND PASSING THE EOV REFLECTOR A LITTLE (AS MOST UTILS DO
; ON MULTIREEL OUTPUTS.)
	BIT	#EVMSK,CSIFLG	;IGNORING IE.EOT, IE.EOV?
	BNE	742$
	CMPB	#IE.EOT,@R5
	BEQ	2$	;OR EOT
	CMPB	#IE.EOV,@R5
	BEQ	2$
742$:	CMPB	#IE.PRI,@R5
	BEQ	2$	;OR IF TAPE DISMOUNTED
;MAKE ALL OTHER ERRORS BE IGNORED...
	MOVB	#IS.SUC,@R5	; YES, SAY ALL WAS OK
2$:
ANST00==.
	TSTB	(R5)		; ERROR ON I/O?
	BMI	26$		; 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	50$		; 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	644$		; IF SO IGNORE LENGTH FOR CHECKS
	CMP	2(R5),#80.	; WAS THE RECORD AN 80 BYTE ONE?
	BNE	50$		; IF NOT CAN'T BE AN ANSI EOV LABEL
644$:	CMP	2(R4),LITEO	; CHECK FOR FIRST 2 CHARS
	BNE	21$		;IF NOT "EO", RESET ANSCNT
	CMPB	4(R4),LITVV	;SEE IF IT'S "EOV"
	BNE	21$		;IF NE, RESET ANSCNT
	INC	ANSCNT		;ELSE COUNT UP ANSCNT
	BR	50$
21$:	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	120$		;IF NE NO, TRY EOF2
	CMP	4(R4),LITR2	;SEE IF STILL HDR2
	BNE	120$		;IF NOT CHECK EOF2
	MOV	#1,HDRLVL	;IF IT IS HDR2 SET LEVEL COUNTER UP TO 1
;				;(THIS PROTECTS AGAINST ACCIDENTAL SETS)
;	INC	HDRLVL		;IF IT IS HDR2 BUMP LEVEL COUNTER
	BR	50$		;THEN SCRAM
ANST03==.
120$:	CMP	2(R4),LITEO	;SEE IF IT'S EOF2
	BNE	50$		;IF NOT WE'RE THRU WITH IT
	CMP	4(R4),LITF2	;IF NOT THEN DONE
	BNE	50$
	DEC	HDRLVL		;COUNT DOWN FILE LEVEL
	BGE	50$		;IF 0 OR +, ALL'S WELL
	CLR	HDRLVL		;BUT CLAMP IT TO 0 IF WE MANAGE TO SCREW UP.
24$:	BR	50$
26$:
; 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 EOT/EOV ETC.?
	BNE	743$
	CMPB	#IE.EOT,(R5)	;EOT? IF SO ALWAYS MAKE EOV
	BEQ	29$
	CMPB	#IE.EOV,(R5)
	BEQ	29$
743$:
	CMPB	#IE.EOF,(R5)	; EOF?
	BNE	90$		; NO - ERROR
;
; GCE02 START
; ****** HERE ADD CODE TO SUPPORT /ANSI SWITCH IF SET
	BIT	#1,ANSFLG	; ANSI SWITCH SET?
	BEQ	27$		; 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	27$		;IF SO GO TEST FOR 2ND EOF AND WRITE THEM
	TST	HDRLVL		;ARE WE BETWEEN HDR2 AND EOF2?
	BNE	28$		;IF WE ARE (I.E. IF NE), JUST WRITE EOFS
;			;OTHERWISE JUST TREAT EOF MARKS AS END OF TAPE
27$:
; GCE02 END
	BIT	#EOF,FLAGS	; IS THIS 2ND EOF IN ROW? (EOV?)
	BNE	20$		; YES - END-OF-VOLUME
28$:	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	60$		; CONTINUE
;GCE02 START
ANST05==.
29$:	BIT	#1,ANSFLG	;THIS AN ANSI TAPE? IF SO IGNORE THESE ERRS
	BEQ	20$		;IF NOT ANSI TAPE (EQ) JUST SET EOV
	TST	2(R5)		;ANY DATA THERE?
	BNE	50$		;IF ANSI TAPE (NE), THEN ACCEPT RECORD
	BR	65$		;IF NO DATA JUST CONTINUE
;GCE02 END
ANST06==.
20$:	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	60$		; CONTINUE

50$:	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

60$:	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
65$:	JMP	TPDKDQ		; GO TRY TO DEQUEUE SOME WORK.

90$:	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	95$		;++AF1 SKIP IF POSITIVE (NOT LIKELY)
	MOVB	#-1,MTERR+1	;++AF1 ELSE MAKE HI BYTE NEGATIVE ALSO
95$:
	RESUME			; RESUME THE MAIN TASK

100$:	ASTX$S			; EXIT THE AST

	.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	204$		;IF OK DO THE TAPE STUFF
	JMP	203$		;IF NOT, SKIP 'EM
204$:
	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	200$		;IF SO, SKIP REWIND
	QIOW$S	#IO.RWD,#INLUN,#1	; REWIND THE MAGTAPE
	QIOW$S	#IO.RWD,#OUTLUN,#1	; REWIND TAPE
200$:	CLR	R0		;SET 800 BPI DENSITY INITIALLY
	BIT	#HDMSK,CSIFLG	;DID HE SAY HIGH DENSITY?
	BEQ	201$		;IF NOT LEAVE AT 800 BPI
	MOV	#4000,R0	;IF SO, SET 1600 BPI
201$:	BIT	#SCMSK,CSIFLG	;WAS THE /SC:NNNNNN SWITCH USED?
	BEQ	202$		;IF NOT JUST SET CHARACTS.
	BIS	SCVAL,R0	;ELSE OR IN CHARACTERISTICS WANTED
202$:
	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	203$		;IF NOT, SKIP WRITE OF LABEL.
	CMPB	FLXNAM,#'A	;LEGAL NAMES ARE THIS BIG OR MORE
	BLO	223$		;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	233$
	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	234$
233$:	MOV	R1,LBLBK	;STORE 3 OR LESS CHAR NAME
	CLR	LBLBK+2		;ZERO 2ND HALF NAME
234$:
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
223$:	QIOW$S	#IO.WLB,#OUTLUN,#1,,,,<#LBLBK,#14.> ;WRITE THE FLX LABEL
203$:
;
;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	1$		;IF LOS ALL'S WELL
	MOV	#IMBFMX,IMBF	;ELSE SET MAX AS BLOCK FACTOR
1$:
	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	40$		;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
40$:
;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
41$:	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	42$		;IF NO ERR, +; SKIP ERR MSG
	ERRMSG	<TPC -W- INPUT READ ERR>
	TST	IMGIOS+2	;SEE IF 0 WORDS READ (==> DONE)
	BNE	42$		;IF NONZERO GO ON
	BIT	#ERMSK,CSIFLG	;IF /ER SPEC'D, USE BLK FACTOR ALWAYS
	BNE	42$
	MOV	R1,IMGIOS+2	;ELSE SAY HOW MANY WE GOT
	SUB	#DSKBF0+1000,IMGIOS+2	;MAKE IT A BYTE COUNT
	BR	43$
42$:	DEC	R0		;COUNT DOWN BLKS TO DO
	BGT	41$
	MOV	R3,IMGIOS+2	;COPY WC WE WOULD HAVE USED...
43$:	MOV	#1,IMGIOS
	MOV	(SP)+,R5
	MOV	(SP)+,R4
	MOV	(SP)+,R1
	MOV	(SP)+,R0
50$:
	TSTB	IMGIOS		;SEE IF ALL WENT OK
	BPL	2$
	ERRMSG	<TPC -W- IMG ERROR ON INPUT DISK>
2$:	MOV	IMGIOS+2,R4	;GET BYTES READ
	BNE	470$		;IF NONZERO WE KEEP GOING
	BIT	#ERMSK,CSIFLG	;IF /ER SPECIFIED DON'T TEST THIS
	BNE	470$
	JMP	IMGDUN		;ZERO READ MEANS ALL DONE.
470$:	BIT	#1000,D2DMSK	;/NO NUBBLE WRITE SPECIFIED?
	BNE	60$		;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	370$		;SKIP NIBBLE WRITE
60$:
;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
61$:	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	62$		;IF PL ALL WELL
	ERRMSG	<TPC -W- IMG WRITE ERR>
62$:
	DEC	R0		;COUNT DOWN BLKS TO DO
	BGT	61$		;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
370$:	TSTB	IMGIOS
	BPL	3$
	ERRMSG	<TPC -W- IMG ERROR ON OUTPUT DISK>
3$:	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	4$
	TST	IMGCT+2
	BEQ	IMGDUN		;END WHEN WE COUNT DOWN TO 0 LEFT
4$:	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	5$
	CMP	IMGCT+2,IMBF	;ENOUGH BLKS LEFT FOR FULL BUFFER?
	BHIS	5$		;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
5$:
	JMP	IMGLOP		;THEN GO TRY ANOTHER CHUNK
IMGDUN:
;ALL DONE... FINISH UP
	BIT	#40,D2DMSK	;/CT SPEC'D?
	BEQ	206$		;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	206$		;IF NOT SKIP IT
	QIOW$S	#IO.RWD,#OUTLUN,#20.,,R3	;DO THE REWIND
206$:
	JMP	START		;DONE!

	.SBTTL	DSKOUT	- DISK OUTPUT AST
;
; DSKOUT - PROCESS DISK OUTPUT AST
;

DSKOUT:	MOV	(SP)+,R5	; R5 = AST ADDRESS
	BIT	#<ERR!DONE>,FLAGS	; ANY ERRORS OR OPERATION COMPLETE?
	BEQ	620$
	JMP	100$		; YES - JUST EXIT AST
620$:
;	BNE	100$		; YES - JUST EXIT AST
	TSTB	(R5)		; ANY ERRORS ON OPERATION?
	BMI	90$		; 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

90$:	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	95$		;++AF1 SKIP IF POSITIVE (NOT LIKELY)
	MOVB	#-1,DSKERR+1	;++AF1 ELSE MAKE HI BYTE NEGATIVE ALSO
95$:
	RESUME			; CONTINUE THE MAIN TASK

100$:	ASTX$S

	.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$:	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	70$		; NONE LEFT!
	MOV	N.IOST+2(R2),R3	; R3 = LENGTH OF TAPE BUFFER DATA
	BNE	22$
	JMP	80$		; NO TAPE DATA!
22$:
;	BEQ	80$		; NO TAPE DATA!

	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

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	80$		; CONTINUE IF MORE ROOM LEFT

70$:	MOV	R0,R5		; R5 = NODE ADDRESS
	CALL	NODDEL		; DELETE THE NODE
	MOV	R2,-(SP)	; SAVE R2
	MOV	#FDBOUT,R4	; GET FDB ADDRESS
76$:	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	75$	;IF LO, KNOW ALL OK
	BHI	71$		; IF HIGH, MUST EXTEND
	CMP	R2,F.HIBK+2(R4)	; COMPARE ULTIMATE LOW ORDER
	BLO	75$		; IF LOW, THERE IS ROOM
71$:	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	73$		; 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
;
73$:	CALL	.EXTND		; DO THE EXTEND
;.EXTND BETTER RESET F.HIBK SO THE THING DOESN'T JUST GOBBLE DISK...
	BCC	74$		; IF NO ERROR FROM EXTEND, GO ON
	MOV	#ERR,FLAGS	; FLAG AN ERROR
	TST	(SP)+		; POP STACK
	JMP	100$		; GET OUT
74$:	MOV	(SP)+,R0	; RESTORE NODE ADDRESS IN R0
	BR	76$		; GO BACK TO CHECK THAT INCREMENT WAS ENOUGH
75$:	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
;

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

85$:	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	200$		;IF EQ NO,NORMAL
	MOV	#512.,R5	;YES, SET 1 BLOCK
	CMP	LOHI,ENDBK	;ALL BLKS ALREADY SENT?
	BLO	200$		;IF LOWER THAN END, MORE TO DO
	CMP	LOLO,ENDBK+2	;ARE LOW ORDER BLKS SAME?
	BLO	200$		;IF LOWER ALL'S WELL
	SUB	#1,LOLO		;SINCE WE PASSED END, BACK UP 1
	SBC	LOHI
200$:
	QIO$S	#IO.RLB,#INLUN,,,R3,INVEC,<R4,R5,,LOHI,LOLO>
	BIT	#1,D2DMSK
	BEQ	202$		;SKIP INC UNLESS DSK-DSK
	ADD	#1,LOLO
	ADC	LOHI		;BUMP BLOCK NUMBER (IGNORED BY TAPE DRIVER)
202$:	JMP	TPDKDQ		; TRY TO DEQUEUE MORE WORK

90$:	ASTX$S			; EXIT THE AST

100$:	RESUME			; RESUME THE MAIN TASK
	ASTX$S			; EXIT AST

	.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	210$		;IF NOT LEAVE IN
	BIT	#40,D2DMSK
	BEQ	203$
210$:
	QIOW$S	#IO.ATT,#OUTLUN,#1	; ATTACH TO TAPE UNIT
	BIT	#NRMSK,CSIFLG
	BNE	200$		;DID HE SAY NO REWIND?
	QIOW$S	#IO.RWD,#OUTLUN,#1	; REWIND TAPE
200$:	CLR	R0		;800 BPI DEFAULT
	BIT	#HDMSK,CSIFLG	;1600 BPI TAPE?
	BEQ	201$		;IF NOT LEAVE 800
	MOV	#4000,R0	;IF SO SAY 1600BPI
201$:	BIT	#SCMSK,CSIFLG	;DID HE SET OTHER CHARACTERISTICS?
	BEQ	202$		;IF EQ NO, JUST SET CHARACS.
	BIS	SCVAL,R0	;ELSE OR IN OTHER BITS HE WANTS
202$:
	QIOW$S	#IO.STC,#OUTLUN,#1,,,,<R0> ; SET TO 800BPI OR 1600BPI
203$:
;
; 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)+	; ...

10$:	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	10$		; 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)+	; ...

20$:	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
	BLO	20$		; CONTINUE IF IN RANGE
	JMP	WAIT		; ELSE GO WAIT FOR XFER TO COMPLETE

	.SBTTL	DSKIN	- DISK INPUT AST ROUTINE
;
; DSKIN - HANDLE DISK I/O DONE AST
;

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

50$:	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
	JMP	DKTPDQ		; GO TO MAIN DE-QUEUING ROUTINE

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

100$:	ASTX$S			; EXIT THE AST

	.SBTTL	TAPOUT	- TAPE OUTPUT I/O DONE AST ROUTINE
;
; TAPOUT - TAPE OUTPUT I/O DONE ROUTINE
;

TAPOUT:	MOV	(SP)+,R5	; R5 = I/O STATUS ADDRESS
	BIT	#<ERR!DONE>,FLAGS	; ERRORS OR DONE?
	BEQ	620$
	JMP	100$		; YES - JUST EXIT
620$:
	ADD	#1,ENDIO+2	;COUNT I/O DONES
	ADC	ENDIO
	BIT	#2,D2DMSK
	BEQ	210$
	CMP	ENDIO,ENDBK
	BLO	210$		;PAST END?
	BHI	233$
	CMP	ENDIO+2,ENDBK+2
	BHIS	233$		;TREAT AS EOF
210$:
	SUB	#N.IOST,R5	; ADJUST R5 TO POINT TO NODE
	BIT	#ERMSK,CSIFLG	;TRYING TO IGNORE TAPE ERRORS?
	BEQ	200$		;IF NOT, LOOK AT ALL
	CMPB	N.IOST(R5),#IE.PRI ;TAPE UNMOUNTED?
	BEQ	90$		;IF SO THEN DONE. IGNORE OTHER ERRORS
	BIT	#EVMSK,CSIFLG	; IGNORING EOT/EOV MARKER?
	BNE	745$
;NOTE THE /EV OR /ER SWITCHES COULD CAUSE OUTPUT TO RUN OFF REEL. TOO BAD
; IF IT HAPPENS (USER SHOULD KNOW BETTER)
	CMPB	N.IOST(R5),#IE.EOT
	BEQ	90$
	CMPB	N.IOST(R5),#IE.EOV
	BEQ	90$		;ALLOW PRIV, EOT, OR EOV AS REAL.
745$:	BR	201$		;SKIP NORMAL TEST THEN
200$:	TSTB	N.IOST(R5)	; WAS THERE AN ERROR ON THE XFER?
	BMI	90$		; YES - SO INDICATE
	BR	201$
233$:	BIT	#40,D2DMSK	;UNLESS SPECIAL FLAG SET
	BNE	201$
	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	95$
201$:
	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

90$:
	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	95$		;++AF1 SKIP IF POSITIVE (NOT LIKELY)
	MOVB	#-1,MTERR+1	;++AF1 ELSE MAKE HI BYTE NEGATIVE ALSO
95$:
	RESUME			; CONTINUE EXECUTION OF MAIN TASK

100$:	ASTX$S

	.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$:	ASTX$S			; EXIT AST

;
; 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	70$		; ZERO - GO WRITE EOF
;	BEQ	70$		; 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	31$
580$:	JMP	80$		; NO BYTES LEFT IN BUFFER!
31$:
	CMP	R1,R3		; WILL THIS BE A PARTIAL COPY?
	BHIS	40$		; 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	50$		; CONTINUE

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

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

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

	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	580$		; 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	244$
	CMP	LOHI,ENDBK
	BHI	241$
	BLO	244$
	CMP	LOLO,ENDBK+2
	BHIS	241$
244$:
	QIO$S	#IO.WLB,#OUTLUN,,,R3,OUTVEC,<R4,R5,,LOHI,LOLO>
241$:
	BIT	#3,D2DMSK
	BEQ	242$
	ADD	#1,LOLO
	ADC	LOHI		;COUNT BLK # TO DO
242$:
	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	67$		; IF EQ NO, NORMAL
	BIT	#4,ANSFLG	;IS THIS /RT11 ANSI VERSION (NOT 80 BYTE LABELS)
	BNE	645$		;IF SO SKIP LENGTH CHECK
	CMP	R5,#80.		;WRITING 80 BYTES?
	BNE	67$		;IF NOT THIS ISN'T OF INTEREST
645$:	CMP	(R4),LITEO	; EOV OR EOF2?
	BNE	160$		; IF NOT CHECK FOR HDR2
;COULD BE AN EOV OR EOF2
	CMPB	2(R4),LITVV	; IS IT EOV?
	BNE	161$		;IF NE NO
; SAW EOV1 SO BUMP ANSCNT
	INC	ANSCNT		;COUNT EOV1
	BR	75$
161$:	CLR	ANSCNT		;2 EOV1 IN A ROW ARE REAL END
	CMP	2(R4),LITF2	; SEE IF EOF2 RECORD
	BNE	75$		; IF NE NO, JUST SKIP ANY SPECIAL STUFF
	DEC	HDRLVL		;ELSE COUNT DOWN HEADER LEVEL
	BGE	75$		;AND
	CLR	HDRLVL		;...CLAMP IT POSITIVE OR 0
	BR	75$
160$:	CMP	(R4),LITHD	;COULD THIS BE HDR2?
	BNE	75$		;IF NOT, JUST BYPASS
	CMP	2(R4),LITR2	;IF REALLY HDR2 THIS WILL BE EQ
	BNE	75$
	INC	HDRLVL		;SO COUNT UP LEVEL
67$:
; END GCE02
	BR	75$		; CONTINUE

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

75$:	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
;

80$:	CMP	N.WRK(R0),N.PTR(R0)	; BUFFER EMPTY?
	BLOS	81$
	JMP	DKTPDQ		; NO - CONTINUE DEQUEUEING
81$:
	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

100$:	BIS	#DONE,FLAGS	; FLAG I/O DONE
	.IF	NDF,XXEOF
	BIT	#2,D2DMSK
	BEQ	310$
	BIT	#40,D2DMSK
	BEQ	311$
310$:
	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	311$		;IF NOT SKIP IT
	QIOW$S	#IO.RWD,#OUTLUN,#20.,,R3,OUTVEC	;DO THE REWIND
311$:
;NOTE THE WAIT TO ENSURE WE GET DONE.
; THIS WILL PREVENT THE IO.KIL FROM CLOBBERINT THE EOF WRITES THAT ARE
; OUTSTANDING.
	.ENDC
	RESUME			; CONTINUE THE MAIN TASK
	ASTX$S			; EXIT AST

	.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



	.END	START