.NLIST	TTM
	.ENABL	LC
	.LIST	ME
	.TITLE	MAGTAPE UTILITIES
	.GLOBL	IREADY,LOADPT,IEOF,IRING,RWD,BFOUT,BFINP
	.GLOBL	EFILE,RWDNW,IEOT,BFINW,BFONW
	.GLOBL	LENGTH
	.GLOBL	IERRM,BFINE
	.GLOBL	BFONE
	.GLOBL	OFFLN
	.GLOBL	L7,M7,H7,CD7,L9,H9
	.MCALL .REGDEF,.EXIT,.PRINT
		BACK = 13		;BACKSPACE AND GO
	.PSECT	$CODE
	.SBTTL	Description and History
;
;
;	THIS SET OF ROUTINES PERFORM THE LISTED FUNCTIONS
;	ON EITHER SEVEN OR NINE-TRACK TAPE RECORDERS.
;
;	THE DEFAULT DRIVE TYPE IS NINE TRACK 800 BPI.
;
;	ORIGINAL VERSION WRITTEN BY JOHN C. DAVIES III
;	DECEMBER 1975
;
;	MODIFIED BY NED W. RHODES FOR USE WITH THE
;	TARGET STRENGTH SYSTEM IN NOVEMBER OF 1977
;
;	MODIFIED ONCE AGAIN BY NED W. RHODES FOR USE
;	ON THE AALC/STRUCTURES JOB.  THE BUFFER INPUT AND
;	OUTPUT ROUTINES CAN NOW BE STARTED AND THE PROGRAM
;	DOES NOT WAIT FOR THE I/O TO COMPLETE.
;
;	MODIFIED ANOTHER TIME BY NED W. RHODES SO THAT THE
;	LENGTH OF THE RECORD READ IS ACCESSIBLE FROM FORTRAN.
;	10-JULY-78.
;
;	FIXED LENGTH FUNCTION TO CORRECTLY RETURN ONE WORD RECORD
;	LENGTHS.  By John Davies   December 12, 1978
;
;
;	FIXED RWD FUNCTION TO PROPERLY WAIT UNTIL UNIT READY BEFORE
;	RETURNING TO CALLER. By John Davies   December 29, 1978.
;
;
;	ADDED ERROR CHECKING FUNCTION 22-FEB-79
;
;
;	Added a re-try feature to BFINP to try and compensate
;	for dirty tape heads.	<NWR> 11-November-79
;
;
;	Added the ability to call BFINP without error checking
;	so that the calling program could do the checking.
;	<NWR> 27-NOVEMBER-79
;
;	Added the ability to use the OFFLINE function to set
;	a drive offline and rewind it.
;	<NWR> 27-NOVEMBER-79
;
;	And finally corrected and added all the density select
;	features for all sevena and nine track tape drives.
;	<NWR> 27-NOVEMBER-79
;
;	And added non-error checking to BFOUT. <NWR> 01-Feb-80
;
;	Had to add a controller ready check before selecting the
;	unit for the Target Strength Program due to the
;	fact that I am using write with no wait. <NWR> 17-Jun-80
;
;
	.PAGE
	.SBTTL	MAGTAPE UTILITIES FUNCTIONS
;		
;	FUNCTIONS:
;
;	IREADY(IPHYSUT)	NEG IF NOT READY
;	LOADPT(IPHUNIT)	NEG IF AT LOAD POINT
;	IEOF(IPHYSUNT)	NEG IF EOF ON LAST TAPE MOTION
;	IRING(IPHYUNIT) NEG IF RING INSTALLED
;	IEOT(IPHYUNIT)  NEG IF PAST END OF TAPE
;	LENGTH(IBUFF)	RETURNS LENGTH OF RECORD READ PROVIDED
;			THAT NO OTHER TAPE TRANSFERS HAVE TAKEN 
;			PLACE BETWEEN THE CALL TO READ AND THE
;			CALL FOR THE LENGTH.
;	IERRM(IDUM)	RETURNS 0 IF NO READ OR WRITE ERROR.
;			IF THERE IS AN ERROR THE CONTENTS OF
;			THE MAG TAPE CONTROLLER ERROR REGISTER
;			IS RETURNED.  SEE PERIPHERALS HANDBOOK
;			FOR THE EXPLAINATION OF THE ERROR CODES.
;
;
	.PAGE
	.SBTTL SUBROUTINES
;	SUBROUTINES:
;
;	CALL CD7  SET UP FOR SEVEN TRACK CORE DUMP
;	CALL L7 SET-UP FOR SEVEN TRACK 200 BPI <12 BITS>
;	CALL M7 SET-UP FOR SEVEN TRACK 556 BPI <12 BITS>
;	CALL H7 SET-UP FOR SEVEN TRACK 6/6 FORMAT <12 BITS> 800 BPI
;	CALL L9   SET UP FOR NINE TRACK 800 BPI
;	CALL H9  SET-UP FOR NINE TRACK 1600 BPI
;	CALL RWD(IPHYSUNIT) REWIND UNIT--WAIT UNTIL AT LOAD POINT
;	CALL RWDNW(IPHYUNIT) REWIND UNIT--DON'T WAIT FOR LOAD POINT
;	CALL EFILE(IPHYUNIT) WRITE A FILE MARK
;	CALL BFINP(IPHYSUNIT,IBUFF,ICOUNT) READ A BUFFER
;	CALL BFOUT(IPHYSUNIT,IBUFF,ICOUNT) WRITE A BUFFER
;	CALL BFINW(IPHYSUNIT,IBUFF,ICOUNT) READ WITH NO WAIT
;	CALL BFONW(IPHYSUNIT,IBUFF,ICOUNT) WRITE WITH NO WAIT
;	CALL BFINE(IPHYSUNIT,IBUFF,ICOUNT) READ WITH NO ERROR CHECKING
;	CALL BFONE(IPHYSUNIT,IBUFF,ICOUNT) WRITE WITH NO ERROR CHECKING
;	CALL OFFLN(IPHYUNIT)	REWIND THE DRIVE AND PLACE IT OFFLINE
;
;
;	IPHYSUNIT = MAG TAPE PHYSICAL UNIT
;
;	IBUFF = BUFFER FOR INPUT OR OUTPUT
;
;	ICOUNT = 16 BIT WORD COUNT
;
;
;
	.PAGE
	.SBTTL	REGISTER DEFINITIONS
;
;
;
	.REGDEF
	MTS=172520
	MTC=MTS+2
	MTBRC=MTS+4
	MTCMA=MTS+6
;
;
;	MTS   = MAG TAPE STATUS REGISTER
;	MTC   = MAG TAPE COMMAND REGISTER
;	MTBRC = MAG TAPE BYTE RECORD COUNTER
;	MTCMA = MAG TAPE CURRENT MEMORY ADDRESS
;
;
	.PAGE
	.SBTTL	SET-UP FOR SEVEN TRACK CORE DUMP
;
;
CD7:	MOV	#60000,DENSY			;SET-UP
	RTS	PC				;RETURN
;
;
	.SBTTL	SET-UP FOR NINE TRACK 800 BPI
;
;
L9:	MOV	#60000,DENSY			;800 BPI
	CLR	PARITY				;ODD PARITY
	RTS	PC				;RETURN
;
;
	.SBTTL	SET-UP FOR NINE TRACK 1600 BPI
;
;
H9:	MOV	#20000,DENSY			;16000 BPI
	CLR	PARITY				;ODD PARITY
	RTS	PC				;RETURN
;
;
	.SBTTL	SET-UP FOR SEVEN TRACK 200 BPI
;
;
L7:	CLR	DENSY				;200 BPI
	RTS	PC				;RETURN
;
;
	.SBTTL	SET-UP FOR SEVEN TRACK 556 BPI
;
;
M7:	MOV	#20000,DENSY			;556 BPI
	RTS	PC				;RETURN
;
;
	.SBTTL	SET-UP FOR SEVEN TRACK 800 BPI <6-6 FORMAT> 12 BITS
;
;
H7:	MOV	#40000,DENSY			;800 BPI 12 BITS
	RTS	PC				;RETURN
;
;
	.SBTTL	EVEN PARITY FOR SEVEN TRACK
;
;
EVEN7:	MOV	#4000,PARITY			;FOR THE BIT SET
	RTS	PC				;RETURN
;
;
	.SBTTL	ODD PARITY FOR SEVEN TRACK
;
;
ODD7:	CLR	PARITY				;FOR THE BIT SET
	RTS	PC				;RETURN
	.PAGE
	.SBTTL	LENGTH READ FUNCTION
;
;
;	FUNCTION RETURNS LENGTH (IN WORDS) OF THE 
;	LAST BUFFER READ PROVIDED THAT NO OTHER TAPE 
;	TRANSFERS TOOK PLACE BETWEEN THE CALL FOR A READ 
;	AND THE CALL TO LENGTH.
;
;
LENGTH:	MOV	(R5)+,R0		;NUMBER OF ARGUMENTS
	MOV	(R5),R1			;START ADDR OF TRANSFERED BUFFER
	MOV	@#MTCMA,R0		;ADDRESS + 1 OF LAST TRANSFER
	SUB	R1,R0			;SUBTRACT FOR DELTA BYTES
	ASR	R0			;DIVIDE BY 2 FOR WORDS
	RTS	PC			;RETURN
	.PAGE
	.SBTTL	MAG TAPE READY ROUTINE
;
;
IREADY:	JSR	PC,PARM				;GET PARAMETERS
	MOV	R0,@#MTC			;SELECT UNIT
	CLR	R0				;CLEAR READY FLAG
	TSTB	@#MTC				;CONTROLLER READY??
	BPL	NOT				;SET NO FLAG
	BIT	#1,@#MTS			;UNIT READY??
	BNE	RED				;READY
NOT:	DEC	R0				;SET NOT READY
RED:	RTS	PC				;RETURN
	.PAGE
	.SBTTL	GET PARAMETERS ROUTINE
PARM:	MOV	(R5)+,R0			;NUMBER OF ARGUMENTS
	MOV	@(R5)+,R0			;GET UNIT NUMBER
	SWAB	R0				;MOVE IN UNIT NUMBER
	BIS	(PC)+,R0			;SET 800 BPI DENSITY
DENSY:	.WORD	60000				;800 BPI (9)/CORE DUMP (7)
	BIS	(PC)+,R0			;SET PARITY
PARITY:	.WORD	0				;DEFAULT ODD
	RTS	PC				;RETURN
	.PAGE
	.SBTTL	LOADPOINT ROUTINE
LOADPT:	JSR	PC,PARM				;GET PARAMETERS
	JSR	PC,REQST			;GET REQUEST
	CLR	R0				;CLEAR FLAG
	BIT	#40,@#MTS			;ARE WE AT BOT??
	BEQ	NBOT				;NO, RETURN
	DEC	R0				;SET FLAG
NBOT:	RTS	PC				;RETURN
	.PAGE
	.SBTTL	IEOF ROUTINE
IEOF:	JSR	PC,PARM				;GET PARAMETERS
	JSR	PC,REQST			;REQUEST TAPE UNIT
	CLR	R0				;CLEAR FLAG
	BIT	#40000,@#MTS			;EOF READ??
	BEQ	NEF				;NO, RETURN
	DEC	R0				;SET FLAG
NEF:	RTS	PC				;RETURN
	.PAGE
	.SBTTL	WRITE RING ROUTINE
IRING:	JSR	PC,PARM				;GET PARAMETERS
	JSR	PC,REQST			;REQUEST UNIT
	CLR	R0				;CLEAR FLAG
	BIT	#4,@#MTS			;RING INSTALLED??
	BNE	NRING				;NO, RETURN
	DEC	R0				;SET FLAG
NRING:	RTS	PC
	.PAGE
	.SBTTL	REWIND AND WAIT ROUTINE
RWD:	JSR	PC,PARM				;GET PARAMETERS
	JSR	PC,REQST			;REQUEST UNIT
	BIS	#17,R0				;SET A REWIND
	MOV	R0,@#MTC			;DO IT
	BIT	#2,@#MTS			;CHECK REWIND BIT
	BNE	.-6				;BR IF STILL REWIND
	BIT	#1,@#MTS			;CK READY BIT
	BEQ	.-6				;CK UNTIL READY
	RTS	PC				;YES, RETURN
	.PAGE
	.SBTTL	REWIND, DON'T WAIT
RWDNW:	JSR	PC,PARM				;GET PARAMETERS
	JSR	PC,REQST			;SELECT UNIT
	BIS	#17,R0				;SET REWIND BIT
	MOV	R0,@#MTC			;DO IT
	RTS	PC				;RETURN
	.PAGE
	.SBTTL	TALK TO TAPE FOR READ/WRITE WITH WAIT
BUFF:	JSR	PC,PARM				;GET PARAMETERS
	JSR	PC,REQST			;SELECT UNIT
	MOV	(R5)+,R3			;GET MEMORY ADDRESS
	MOV	R3,@#MTCMA			;SET MEMORY ADDRESS
	MOV	@(R5),R2			;GET NUMBER OF WORDS 
	BIS	R4,R0				;SET A READ OR WRITE
	ASL	R2				;FORM BYTE COUNT
	NEG	R2				;MAKE A MINUS
	MOV	R2,@#MTBRC			;MOVE IN BYTE COUNT
	MOV	R0,@#MTC			;DO IT
	TSTB	@#MTC				;DONE??
	BPL	.-4				;NO, WAIT
;
;
;	Check for error
;
;
	TST	@#MTC				;IS ERROR BIT LIT??
	BPL	RT				;NO--RETURN
;
;
;	Mask out certain errors
;
;
	BIT	#34400,@#MTS			;JUST CRC,PARITY,BGL,AND BAD
	BEQ	RT				;NO ERROR
;
;
;	Begin some retries
;
;
RETRY:	MOV	R0,-(SP)			;SAVE R0
	CMP	#5,R4				;IS IT A WRITE??
	BNE	RETRY2				;NO--A READ
;
;
;	WRITE ERROR
;
;
	.PRINT	#RMESS2				;INFORM USER
	JMP	RET22				;CONTINUE
;
;
;	READ ERROR
;
;
RETRY2:	.PRINT	#RMESS				;INFORM USER
RET22:	MOV	(SP)+,R0			;RESTORE R0
	INC	RTRY				;BUMP RE-TRY COUNTER
	BIC	R4,R0				;MAKE JUST UNIT NUMBER
;
;
;	Backspace a record
;
;
	MOV	#-1,@#MTBRC			;ONE RECORD
	BIS	#BACK,R0			;BACKSPACE
	MOV	R0,@#MTC			;DO IT
	BIC	#BACK,R0			;MAKE JUST UNIT NUMBER
	TSTB	@#MTC				;DONE??
	BPL	.-4				;NO WAIT
;
;
;	Re-read
;
;
	JSR	PC,REQST			;SELECT TAPE
	MOV	R3,@#MTCMA			;SET MEMORY ADDRESS
	MOV	R2,@#MTBRC			;MOVE IN BYTE COUNT
	BIS	R4,R0				;SET READ OR WRITE
	MOV	R0,@#MTC			;DO IT
	TSTB	@#MTC				;DONE??
	BPL	.-4				;NO, WAIT
;
;
;	Check for error
;
;
	TST	@#MTC				;IS ERROR BIT LIT??
	BPL	RT				;NO--RETURN
;
;
;	Mask out certain errors
;
;
	BIT	#34400,@#MTS			;JUST CRC,PARITY,BGL,AND BAD
	BEQ	RT				;NO ERROR
;
;
;	Decide to re-try
;
;
	CMP	#5,RTRY				;OVER LIMIT??
	BLE	IOERR				;WRITE MESSAGE AND LEAVE
	BR	RETRY				;RE-TRY AGAIN
;
;
;	Exit
;
;
RT:	CLR	RTRY				;CLEAR RETRY INDICATOR
RT2:	RTS	PC				;RETURN
;
;
;	ERROR--Read error after five reads
;
;
IOERR:	CMP	#5,R4				;IS IT A WRITE??
	BNE	IO2				;NO--READ ERROR
	.PRINT	#ER2				;PRINT ERROR MESSAGE
	.EXIT					;HALT
;
;
;	READ ERROR
;
;
IO2:	.PRINT	#ER				;PRINT ERROR MESSAGE
	.EXIT					;HALT PROGRAM
ER:	.ASCIZ	/?BFINP-F-Read error after 5 tries <possible bad tape>./
ER2:	.ASCIZ	/?BFOUT-F-Write error after 5 tries <possible bad tape>./
RMESS:	.ASCIZ	/?BFINP-W-Read error./
RMESS2:	.ASCIZ	/?BFOUT-W-Write error./
	.EVEN
RTRY:	.WORD	0				;RETRY COUNTER
	.PAGE
	.SBTTL	BFOUT ROUTINE
BFOUT:	MOV	#5,R4				;SET A WRITE
	JMP	BUFF				;TALK TO TAPE UNIT
;
;
	.SBTTL	BFINP ROUTINE
BFINP:	MOV	#3,R4				;SET A READ
	JMP	BUFF				;TALK TO TAPE UNIT
	.PAGE
	.SBTTL	TALK TO TAPE FOR READ WITH NO ERROR CHECKING
BUFFER:	JSR	PC,PARM				;GET PARAMETERS
	JSR	PC,REQST			;SELECT UNIT
	MOV	(R5)+,@#MTCMA			;SET MEMORY ADDRESS
	MOV	@(R5),R2			;GET NUMBER OF WORDS 
	BIS	R4,R0				;SET A READ OR WRITE
	ASL	R2				;FORM BYTE COUNT
	NEG	R2				;MAKE A MINUS
	MOV	R2,@#MTBRC			;MOVE IN BYTE COUNT
	MOV	R0,@#MTC			;DO IT
	TSTB	@#MTC				;DONE??
	BPL	.-4				;NO, WAIT
	RTS	PC				;RETURN
	.PAGE
	.SBTTL	BFONE ROUTINE
BFONE:	MOV	#5,R4				;SET A WRITE
	BR	BUFFER				;TALK TO TAPE UNIT
;
;
	.SBTTL	BFINE ROUTINE
BFINE:	MOV	#3,R4				;SET A READ
	BR	BUFFER				;TALK TO TAPE UNIT
	.PAGE
	.SBTTL	TALK TO TAPE FOR READ/WRITE WITH NO WAIT
BUFFNW:	JSR	PC,PARM				;GET PARAMETERS
	JSR	PC,REQST			;SELECT UNIT
	MOV	(R5)+,@#MTCMA			;SET MEMORY ADDRESS
	MOV	@(R5),R2			;GET NUMBER OF WORDS 
	BIS	R4,R0				;SET A READ OR WRITE
	ASL	R2				;FORM BYTE COUNT
	NEG	R2				;MAKE A MINUS
	MOV	R2,@#MTBRC			;MOVE IN BYTE COUNT
	MOV	R0,@#MTC			;DO IT
	RTS	PC				;RETURN
	.PAGE
	.SBTTL	BFONW ROUTINE
BFONW:	MOV	#5,R4				;SET A WRITE
	BR	BUFFNW				;TALK TO TAPE UNIT
;
;
	.SBTTL	BFINW ROUTINE
BFINW:	MOV	#3,R4				;SET A READ
	BR	BUFFNW				;TALK TO TAPE UNIT
	.PAGE
	.SBTTL	SELECT UNIT ROUTINE
REQST:
	TSTB	@#MTC				;CONTROLLER READY??
	BPL	.-4				;NO, WAIT
	MOV	R0,@#MTC			;SELECT UNIT
WAIT:	BIT	#1,@#MTS			;DRIVE READY??
	BEQ	WAIT				;NO, WAIT
	RTS	PC				;READY, RETURN
	.PAGE
	.SBTTL	WRITE EOF ROUTINE
EFILE:	JSR	PC,PARM				;GET PARAMETERS
	JSR	PC,REQST			;SELECT UNIT
	BIS	#7,R0				;SET EOF BIT
	MOV	R0,@#MTC			;WRITE EOF
	TSTB	@#MTC				;DONE??
	BPL	.-4				;NO, WAIT
	BIT	#1,@#MTS			;UNIT STOPPED??
	BEQ	.-6				;NO, WAIT
	RTS	PC				;YES, RETURN
	.PAGE
	.SBTTL	PAST EOT ROUTINE
IEOT:	JSR	PC,PARM				;GET PARAMETERS
	JSR	PC,REQST			;SELECT UNIT
	CLR	R0				;CLEAR FLAG
	BIT	#2000,@#MTS			;PAST EOT??
	BEQ	EOT2				;NO, RETURN
	DEC	R0				;SET FLAG
EOT2:	RTS	PC				;RETURN
	.PAGE
	.SBTTL	IERRM ROUTINE
;
;
;	THIS ROUTINE READS THE COMMAND REGISTER AND IF THE
;	ERROR BIT IS NOT SET, IT RETURNS A ZERO.  OTHERWISE
;	IT RETURNS THE CONTROL AND STATUS REGISTER.
;
;
;
;
;	BIT 7 SET = NON-EXIST MEMORY
;	BIT 8 SET = BAD TAPE ERROR
;	BIT 9 SET = RECORD LENGTH ERROR
;	BIT 10 SET = EOT
;	BIT 11 SET = BUSS GRANT LATE
;	BIT 12 SET = PARITY ERROR
;	BIT 13 SET = CRC ERROR
;	BIT 14 SET = EOF
;	BIT 15 SET = ILLEGAL COMMAND
;
;
;
IERRM:	CLR	R0				;CLEAR RETURN
	TST	@#MTC				;ERROR
	BPL	RIER				;NO--RETURN
	MOV	@#MTS,R1			;GET ERROR CODES
	BIC	#42177,R1			;CLEAR LOW ORDER BITS
	BEQ	RIER				;IGNOR EOT AND EOF
	MOV	R1,R0				;ERROR CODES
RIER:	RTS	PC				;RETURN
	.PAGE
	.SBTTL	FUNCTION OFFLN
;
;
;	Rewind the drive and set it off line
;
;
OFFLN:	JSR	PC,PARM				;GET PARAMETERS
	JSR	PC,REQST			;SELECT UNIT
	MOV	R0,@#MTC			;SELECT UNIT AND OFFLINE
	INC	@#MTC				;GO DO IT
	RTS	PC				;RETURN
	.END