PROGRAM MTCOPY	! General Magtape to Magtape Copy Program
C
C	18-Apr-83 (AHS) Modify to accept <cr> as default answer for No
C
	IMPLICIT INTEGER (A-Z)
	LOGICAL ASK, ERRCHK, DBLEOF, EOFSTP, MVTAPE, PARERR
	INTEGER BUFFER(20000),STATUS(2),QIOPRM(6),IOSTAT(2)
	INTEGER TEMPRM(6)
	BYTE YESNO,IOSTLO,IOSTHI,IOSBYT(2)
	EQUIVALENCE (IOSTAT(1),IOSBYT(1))
	EQUIVALENCE (IOSBYT(1),IOSTLO)
	EQUIVALENCE (IOSBYT(2),IOSTHI)
	DATA CO /5/
	DATA MT0LUN /1/, MT0EFN /1/
	DATA MT1LUN /2/, MT1EFN /2/
	DATA IOATT /O001400/	!Attach device
	DATA IORWD /O002400/	!Rewind
	DATA IORLB /O001000/	!Read logical block
	DATA IOWLB /O000400/	!Write logical block
	DATA IOEOF /O003000/	!Write EOF mark
	DATA IORWU /O002540/	!Rewind and unload
	DATA IOSPB /O002420/	!Space blocks
C
C		IOSTAT ERRROR RETURNS: (low byte of word 1)
C
	DATA ISSUC /1/		!Success
	DATA IEEOT /O302/	!End-of-Tape
	DATA IEWLK /O364/	!Write locked
	DATA IEEOF /O366/	!End-of-File
	DATA IEVER /O374/	!Parity error on device
	DATA IEDNR /O375/	!Device not ready, blank tape, etc.
C
	MVEOF = 0
	EOFSTP = .FALSE.
	WRITE (CO,9100)
C
C		Assign LUN 1 to MTn: (source)
C		Assign LUN 2 to MTm: (sink)
C
	WRITE(CO,9110)
	READ (CO,9410) ISRC
	WRITE(CO,9120)
	READ (CO,9410) ISNK
	CALL ASK(CO,EOFSTP,'Stop on double EOF')
	CALL ASK(CO,PARERR,'Process parity errors on source tape')
	CALL ASK(CO,MVTAPE,'Skip files at beginning of source tape')
	IF (MVTAPE) WRITE (CO,9400)
	IF (MVTAPE) READ  (CO,9410) MVEOF
	IF (MVTAPE) WRITE (CO,9420) MVEOF
	CALL ASNLUN(MT0LUN,'MT',ISRC,DSW)
	IF (ERRCHK(DSW,1,CO)) CALL EXIT
	CALL ASNLUN(MT1LUN,'MT',ISNK,DSW)
	IF (ERRCHK(DSW,1,CO)) CALL EXIT
C
C		Attach MT: units to make sure we have complete access
C
	CALL WTQIO (IOATT,MT0LUN,MT0EFN,,,,DSW)
	IF (ERRCHK(DSW,2,CO)) CALL EXIT
	CALL WTQIO (IOATT,MT1LUN,MT1EFN,,,,DSW)
	IF (ERRCHK(DSW,2,CO)) CALL EXIT
C
C		Rewind both MT: units
C
	CALL WTQIO (IORWD,MT0LUN,MT0EFN,,,,DSW)
	IF (ERRCHK(DSW,3,CO)) CALL EXIT
	CALL WTQIO (IORWD,MT1LUN,MT1EFN,,,,DSW)
	IF (ERRCHK(DSW,3,CO)) CALL EXIT
C
C		Setup for looping on: read MT0, write MT1
C
10	EOFCNT = 0
	DBLEOF = .FALSE.
	DO 90 I = 1,6
90	QIOPRM(I) = 0
	WRITE (CO,9000) ISRC,ISNK
C
100	CONTINUE
	CALL GETADR(QIOPRM(1),BUFFER)
	QIOPRM(2) = 2 * 20000
	CALL WTQIO (IORLB,MT0LUN,MT0EFN,,IOSTAT,QIOPRM,DSW)
C
C				PROCESS PARITY ERRORS
C
	IF (PARERR.AND.IOSTAT(1).EQ.IEVER) GOTO 180
	IF ((.NOT.PARERR).AND.IOSTAT(1).EQ.IEVER) GOTO 500
C
C				PROCESS EOF SKIPPING AT BEGINNING OF TAPE
C				(allows recovering data after initialize
C				 has written two EOFS on a tape with data)
C
	IF (.NOT.MVTAPE) GOTO 120
	IF (IOSTAT(1).EQ.IEEOF) MVEOF = MVEOF - 1
	IF (MVEOF.GT.0) GOTO 100	!Not enough EOF's skipped yet
	MVTAPE = .FALSE.		!Skiped enough, read next block
	GOTO 100
120	CONTINUE
	IF (IOSTAT(1).NE.IEEOF) EOFCNT = 0
	IF (IOSTAT(1).EQ.IEEOF) EOFCNT = EOFCNT + 1
	IF (EOFCNT   .EQ.2) DBLEOF = .TRUE.
	IF (DBLEOF) GOTO 1000
	IF (IOSTAT(1).EQ.ISSUC) GOTO 200 !Read block -> Write block
	IF (IOSTAT(1).EQ.IEEOF) GOTO 300 !Read EOF -> Write EOF
	IF (IOSTAT(1).EQ.IEDNR) GOTO 1100 !MT0 not ready -> ask user
	WRITE (CO,9800) IOSTAT
	CALL EXIT
C
180	CONTINUE		!Parity Error
	WRITE (CO,9350)
	WRITE (CO,9355) IOSTAT(2)
	READ  (CO,9356) IOSTAT(2)
	IF (IOSTAT(2).GT.0) GOTO 200	!User wants block to be written
	IF (IOSTAT(2).EQ.0) GOTO 100	!Don't write Zero length block
	QIOPRM(1)=-1			!Backup by one block
	CALL WTQIO (IOSPB,MT0LUN,MT0EFN,,IOSTAT,QIOPRM,DSW)
	GOTO 100			!Reread block
200	CONTINUE
	QIOPRM(2) = IOSTAT(2)
210	CALL WTQIO (IOWLB,MT1LUN,MT1EFN,,IOSTAT,QIOPRM,DSW)
	IF (ERRCHK(DSW,9,CO)) CALL EXIT
	IF (IOSTAT(1).EQ.1) GOTO 100
	CALL ERRCHK(-1,10,CO)	!Put out message that write to MT1: failed
	WRITE (CO, 9600) IOSTAT
	IF (ASK(CO,DUMMY,'Try to rewrite block')) GOTO 210
	CALL WTQIO (IOEOF,MT1LUN,MT1EFN,,IOSTAT,,DSW) !Write EOF
	GOTO 1050		! and exit
C
300	CONTINUE
	CALL WTQIO (IOEOF,MT1LUN,MT1EFN,,IOSTAT,,DSW) !Write EOF
	IF (ERRCHK(DSW,8,CO)) CALL EXIT
	IF (IOSTAT(1).EQ.1) GOTO 100
	CALL ERRCHK(-1,10,CO)
	GOTO 100
C
500	WRITE (CO,9360)		!Parity error exit
C
1000	IF (EOFSTP) GOTO 1050
	IF (ASK(CO,DBLEOF,
	1   'Double EOF Detected on Input Tape, Continue?')) GOTO 10
1050	CALL WTQIO (IOEOF,MT1LUN,MT1EFN,,IOSTAT,,DSW) !Write one more EOF
	CALL WTQIO (IORWD,MT0LUN,MT0EFN,,,,DSW)
	IF (ERRCHK(DSW,3,CO)) CALL EXIT
	CALL WTQIO (IORWD,MT1LUN,MT1EFN,,,,DSW)
	IF (ERRCHK(DSW,3,CO)) CALL EXIT
	WRITE(CO,9200)
	CALL EXIT	! and quit
C
1100	WRITE (CO,9300)
	READ (CO,9900) YESNO
	IF (YESNO.EQ.'Y'.OR.YESNO.EQ.'y') GOTO 10
	CALL WTQIO (IOEOF,MT1LUN,MT1EFN,,IOSTAT,,DSW) !Write one more EOF
	CALL EXIT
C
9000	FORMAT (' MTCOPY - Begin image copy MT',I1,': to MT',I1,':')
9010	FORMAT (I4,10X,3(O6,1X),I7)
9100	FORMAT ('-MTCOPY V1.0 - Image Tape Copy Program')
9110	FORMAT ($' Source MT: Unit Number: ')
9120	FORMAT ($' Destination MT: Unit Number: ')
9200	FORMAT (' MTCOPY - Normal Termination')
9300	FORMAT (' MT0: IE.DNR error was returned, possible causes:'/
	1	'      -time-out (i.e. lost interrupt) or,'/
	2	'      -vacuum failure on drive or,'/
	3$	'      -blank tape being read;        CONTINUE? [Y/N]:')
9350	FORMAT (' MTCOPY - Parity error on input tape, Continuing')
9355	FORMAT (' Block in error had ',I8,' bytes '/
	1	'$Enter number of bytes to written on output:')
9356	FORMAT (I10)
9360	FORMAT (' MTCOPY - Parity error on input tape, Fatal error')
9400	FORMAT ($' Enter number of EOF marks to be skipped: ')
9410	FORMAT (I)
9420	FORMAT (' Moving input tape forward by ',I4,' EOF marks')
9600	FORMAT (' I/O status (O,I)= ',O8,I8)
9800	FORMAT (' MTCOPY - Internal Failure - Please notify system manager'
	1	/' Last IOSTAT (octal) = ',2O)
9900	FORMAT (1A1)
	END

	LOGICAL FUNCTION ASK ( CO, ANS, TEXT )
C
C ASK - Ask user a YES/NO question and return a function value and
C	a logical variable 'ANS' which is set to .TRUE. if the answer
C	was Y(es) or .FALSE. if the answer was N(o).
C
	LOGICAL ANS, BADANS, ANSWER(2)
	BYTE TEXT(1),YESNO
	INTEGER CO, NTEXT, CHOICE
	DATA ANSWER(1) /.TRUE./, ANSWER(2) /.FALSE./
C
	BADANS = .FALSE.
	DO 1 I=1,256
	IF (TEXT(I).EQ.0) GOTO 2
1	CONTINUE
	NTEXT = 132
2	NTEXT = I
10	CONTINUE
	IF (BADANS) WRITE(CO,1050)
	WRITE(CO,1000)
	WRITE(CO,1010) (TEXT(I),I=1,NTEXT)
	WRITE(CO,1020)
	READ (CO,1040) N,YESNO
	BADANS = .FALSE.
	CHOICE = 0
	IF (N.EQ.0) CHOICE = 2
	IF (YESNO.EQ.'Y' .OR. YESNO.EQ.'y') CHOICE = 1
	IF (YESNO.EQ.'N' .OR. YESNO.EQ.'n') CHOICE = 2
	IF (CHOICE.EQ.0) BADANS = .TRUE.
	IF (BADANS) GOTO 10
	ASK = ANSWER(CHOICE)
	ANS = ANSWER(CHOICE)
	RETURN
1000	FORMAT(' ')
1010	FORMAT($'+',A1)
1020	FORMAT($'+ [Y/N] :')
1040	FORMAT(Q,A1)
1050	FORMAT('   Valid Answers Are: Y(es), N(o); <cr> defaults to No')
	END

	LOGICAL FUNCTION ERRCHK(DSW,ERRNUM,LUN)
C
C ERRCHK - General error reporting subroutine.
C
C Return function value of true if DSW was negative (indicating an error)
C and optionally print an error message if LUN is non-zero, Including text
C for the appropriate error numer if ERRNUM is within range.
C
C	IF ( ERRCHK( DSW, <err number>, <lun for message> )) CALL EXIT
C
	INTEGER DSW,ERRNUM,ERRMAX,LUN
	ERRCHK=.FALSE.		! Start off with no error
	IF (DSW.GT.0) RETURN	! If DSW > 0, there is no error, so return
	ERRCHK=.TRUE.		! else see if we should print a message
	IF (LUN.EQ.0) RETURN	! If LUN = 0, no message, just function val
	WRITE(LUN,9999) ERRNUM	! else write at least the error number
	IF (ERRNUM.LE.0.OR.ERRNUM.GT.10) GOTO 100
	GOTO (1,2,3,4,5,6,7,8,9,10),ERRNUM
1	WRITE (LUN,9010)
	RETURN
2	WRITE (LUN,9011)
	RETURN
3	WRITE (LUN,9012)
	RETURN
4	CONTINUE
5	CONTINUE
6	CONTINUE
7	CONTINUE
8	CONTINUE
9	CONTINUE
	GO TO 100
10	CONTINUE
	WRITE (LUN,9020)
	RETURN
100	WRITE(LUN,9100)		!In case no message, terminate output line
	RETURN
9010	FORMAT('+Problem assigning LUNs to one of the MT: units')
9011	FORMAT('+Cannot attach magtapes')
9012	FORMAT('+Cannot rewind magtapes')
9020	FORMAT('+Write Failure')
9100	FORMAT(/)
9999	FORMAT($' MTCOPY -- * ERROR *',I3,2X)
	END