C
C
C-----------------------------------------------------------------------------
C
C	PROGRAM:	BADMM
C
C	AUTHOR:		Jan H. Belgraver
C
C	DATE:		2-FEB-81
C
C	VERSION:	V1.2	28-OCT-83
C
C	PURPOSE:	Bad block utility for magtapes.
C			Modified from program MMFIL by Han Lasance. It also 
C			calls subroutine INITMM by the same author to check if
C			driver is loaded, the tape is not write protected, and
C			to rewind the tape.
C			This utility became necessary since DEC's BAD utility 
C			does not provide for checking magtapes on bad blocks.
C
C	MODIFIED BY:	Jan H. Belgraver	21-JUL-81	JB01
C			Changed density into 1600 bpi.
C
C			Jan H. Belgraver	28-OCT-83	JB02	V1.2
C			Detach from MM: before stopping.
C			Ring bell when finished.
C
C	BUILDING:	TKB @BADMMBLD
C			    BADMM,BADMM/-SP=BADMM,[7,247]INITMM,[3,54]BELL
C
C-----------------------------------------------------------------------------
C
C

C
C
	PROGRAM BADMM
C
C
	LOGICAL*1	IOSB(4)
C	INTEGER*2	MMBUF(2560), IPARM(6)
	INTEGER*2	MMBUF(256), IPARM(6)


	IBAD	= 0
	NB	= 6000
C	IBS	= 2560				! Blocksize
	IBS	= 256				! Blocksize
	CALL	ASSIGN	(2, 'MM:')

C-----------------------------------------------------------------------------
C
C	Check if driver is loaded, unit can be attached, if not write-locked.
C	If O.K. rewind tape.
C
C-----------------------------------------------------------------------------

	CALL	INITMM	(1)

C-----------------------------------------------------------------------------
C
C	Set tape characteristics.
C	Inhibit writing with extended interrecord gap if bad block encountered.
C	Set density to 1600 bpi.
C
C-----------------------------------------------------------------------------

	IPARM(1) = "4200
	CALL	QIO	("2500, 2, 2,, IOSB)

C-----------------------------------------------------------------------------
C
C	Initialize IPARM for writing testdata to tape.
C
C-----------------------------------------------------------------------------

	IPARM(2)=IBS*2
	CALL	GETADR	(IPARM(1), MMBUF(1))

C-----------------------------------------------------------------------------
C
C	Main program section.
C	Try to write to tape until physical End-Of-Tape, if anything goes wrong
C	print a message.
C
C-----------------------------------------------------------------------------

	IB = 0
	T0 = SECNDS(0.)

10	IB = IB + 1
C	DO 12 J= 1, 2560
	DO 12 J= 1, 256
	   MMBUF(J)=I
12	CONTINUE
	CALL	WTQIO	("400, 2, 2,, IOSB, IPARM)	! Write logical block
	IF (IOSB(1) .EQ. 1) GOTO 10		! Next block

	IF	(IOSB(1) .NE. -56 .AND. IOSB(1) .NE. -4) GOTO 450
	IBAD	= IBAD + 1
	IF	(IBAD .GT. 500) GOTO 910
	WRITE	(5,410) IB
410	FORMAT	(' *   BAD TAPE BLOCK AT LBN: ',I6)
	GOTO	10

C-----------------------------------------------------------------------------

450	IF	(IOSB(1) .NE. -62) GOTO 900
	WRITE	(5,451)
451	FORMAT	(//' *** END OF TAPE ***')
	WRITE	(5,453) IBAD
453	FORMAT	(/' *   TOTAL NUMBER OF BAD BLOCKS FOUND = ',I6)
	WRITE	(5,452) IB, IBS, SECNDS(T0)
452	FORMAT	(/' *   ',I5,' BLOCKS OF ',I4,' WORDS WRITTEN IN ',
     $	F6.1,' SECONDS')
	CALL	QIO	("2540, 2, 2,, IOSB)	! Rewind and unload tape
	CALL	QIO	("2000, 2, 2,, IOSB)	! Detach MM:		! JB02
	CALL	BELL	(0)			! Ring bell 1 / 10 sec	! JB02
	CALL	EXIT

C-----------------------------------------------------------------------------

900	WRITE	(5,901) IOSB(1)
901	FORMAT	(//'    * FATAL * -- TAPE ERROR - IOS: ',I4)
	WRITE	(5,452) IB, IBS, SECNDS(T0)
	GOTO	999

910	WRITE	(5,911)
911	FORMAT	(//'    * FATAL * -- TOO MANY (>500) BAD BLOCKS')
	WRITE	(5,452) IB, IBS, SECNDS(T0)

C-----------------------------------------------------------------------------
C
C	Detach unit and rewind tape before exiting
C
C-----------------------------------------------------------------------------

999	CALL	QIO	("2540, 2, 2,, IOSB)	! Rewind and unload tape
	CALL	QIO	("2000, 2, 2,, IOSB)	! Detach MM:		! JB02

	STOP	'ERROR'

	END