From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX"  2-JUN-1989 07:44
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Re:  Erasing tapes ...

Message-Id:  <8906021128.AA02471@crdgw1.ge.com>
Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Thu,  1 JUN 89 11:33:48 PDT
Received: from CUSPIF.TN.CORNELL.EDU by KL.SRI.COM with TCP; Thu, 1 Jun 89 11:28:15 PDT
Date: 1 Jun 1989 14:28:42 EST
From: Brian.T.Carcich@CUSPIF.TN.CORNELL.EDU
To: ajk%nihcu@cornellc, info-vax@kl.sri.com
Subject: Re:  Erasing tapes ...
X-Vms-Original-To: INET%"ajk%nihcu@cornellc",INET%"info-vax@kl.sri.com",CARCICH     


I think this does what you want:

(tapecheck.readme, .doc, .mar follow, just $ mac tapecheck & $ link tapecheck)
 
TAPECHECK.README;1
 
This submission includes 2 programs.

TAPECHECK is a program designed to quickly and inexpensively test the
data reliability of a magnetic tape.  This is a later release of the
same program submitted to an earlier DECUS tape, I think Fall 82.

SETUSER is a program similiar to the unsupported utility that existed
on VMS V2.0, but vanished with VMS V3.0.

	OCTOBER 14, 1982

	JIM LELLMAN
	G. D. SEARLE & CO.
	RESEARCH COMPUTING SERVICES
	4901 SEARLE PARKWAY
	SKOKIE IL, 60077
 
TAPECHECK.DOC;1
 
TAPECHECK is a program designed to quickly and inexpensively test the
data reliability of a magnetic tape.  It does this by writing blocks
of data on the entire tape, rewinding the tape, and reading the entire
tape back in.  Data blocks which do not match the original data pattern
or block length are announced along with the approximate position on the tape.

THIS PROGRAM OVERWRITES ALL THE DATA ON THE TAPE.  Please do not attempt
to check a tape that has valuable information on it.

The check performed by this program is not as good as is available from
any hardware tape evaluator.  The errors that this program reports might
conceivably be caused by the tape drive or some other factor.  However,
this program should run on virtually any VMS configuration with a mag tape.
It has been tested on various combinations of (750/780),(TU77/TU78),(2.5/3.0).
The author would be pleased to hear of any bugs found or improvements made.


RESTRICTIONS:

If you have a tape drive that does not run at 800, 1600 or 6250 BPI,
the program will complain and quit.  If the density you run at does not
match the density the system thinks you are at, the program may run but
will quote lengths incorrectly.

The program does terminal QIOs (sorry) and thus will only run from a terminal
or a command procedure as long as logical name TT points at a terminal.
What this means is you cannot easily run it in batch.



TO USE THE PROGRAM:

1) Mount the tape /FOREIGN at desired density* with logical name SCRATCH.

			      *	If the tape has been previously used at
				another density, the tape drive may set
				the density for you.  If this is a problem,
				INIT the tape first at the required density.
2) Run the program.

Sample Output:

	CHECKING TAPE AT 1600 BPI
	THE TAPE IS ABOUT 2332 FEET LONG

	A TAPE ERROR OCCURRED AT ABOUT 2301 FEET
	A TAPE ERROR OCCURRED AT ABOUT 2302 FEET

	2 TAPE ERRORS OCCURRED IN 2332 FEET

3) Dismount the tape.

There is reasonable documentation within the source file for finding out
how it works if anyone is interested.  This is a later release of the
same program submitted to an earlier DECUS tape, I think Fall 82.
The tape check can be made more stringent by changing the program to
inhibit retries on writes. (See source).  Anybody with a hardware tape
evaluator might run some known bad tapes past this program and let
me know the results.

This program writes on about 95% of the tape surface, the rest goes to
interrecord gaps.  Obviously the gaps are not checked for data reliability.
It is difficult to do much better than that on a standard tape drive.



	OCTOBER 14, 1982

	JIM LELLMAN
	G. D. SEARLE & CO.
	RESEARCH COMPUTING SERVICES
	4901 SEARLE PARKWAY
	SKOKIE IL, 60077
 
TAPECHECK.MAR;1
 
	.IDENT	/03/

; THIS PROGRAM IS DESIGNED TO VERIFY THE QUALITY OF TAPES. IT WAS DESIGNED
; WITH A TU77 OR TU78 IN MIND BUT CAN BE RATHER EASILY MODIFIED TO ADD
; BELLS AND WHISTLES.
;
; THE PROGRAM EXPECTS A TAPE MOUNTED FOREIGN WITH THE LOGICAL NAME "SCRATCH"
;
; SEVERAL PHILOSOPHICAL DECISIONS MADE WERE:
;
;	FOR CONVENIENCE IN FIGURING APPROXIMATE TAPE POSITION, TAPE RECORDS ARE
;	COMPUTED TO COME OUT TO 12 INCHES EACH FOR NRZI AND PE, INCLUDING A .6
;	INCH NOMINAL RECORD GAP.  GCR RECORDING IS TOO DENSE TO WRITE A SINGLE
;	RECORD LONGER THAN 10.33 INCHES, SO RECORD SIZE IS ADJUSTED FOR A 6
;	INCH RECORD INCLUDING THE NOMINAL .3 INCH GCR RECORD GAP.  REDUCING
;	RECORD SIZES DECREASES THE PERCENTAGE OF THE TAPE SURFACE TESTED.
;	APPROXIMATELY 95% OF THE TAPE IS WRITTEN UPON IN THIS VERSION.
;
;	THE PROGRAM AS WRITTEN HERE ALLOWS RETRIES ON WRITES (WITHOUT EXTENDED
;	INTERRECORD GAPS) BUT NO RETRIES ON READS.  THIS IS A MATTER OF
;	INDIVIDUAL PREFERENCE.  DISALLOWING RETRIES WILL RESULT IN MORE ERRORS
;	BEING REPORTED, POSSIBLY WHEN NOTHING IS SERIOUSLY WRONG WITH THE TAPE.
;	ALLOWING RETRIES MAY ALLOW MARGINAL SPOTS ON THE TAPE TO GO UNREPORTED.
;
;	OCTOBER 14, 1982
;
;	JIM LELLMAN
;	G. D. SEARLE & CO.
;	RESEARCH COMPUTING SERVICES
;	P. O. BOX 5110
;	CHICAGO, IL 60680
;
; MACRO DEFINITIONS
;
	$DSCDEF
	$IODEF
	$MTDEF
	$STSDEF
;
; LOCAL CONSTANTS
;

	PATTERN=^XBC				;8 BIT BYTE IS WRITTEN TO TAPE
						;WITH BITS ARRANGED: 31765P402
						;HEX BC ON TAPE IS:  101010101
						;NOTHING MAGIC ABOUT IT
;
; READ ONLY DATA
;
	.PSECT	RODATA,RD,NOWRT,NOEXE

WRITE:	.LONG	IO$_WRITEVBLK!IO$M_INHEXTGAP	;WRITE FUNCTION
						;NOTE RETRIES NOT INHIBITED
						;LEAVE EXTENDED GAP INHIBITED

READ:	.LONG	IO$_READVBLK!IO$M_INHRETRY	;READ FUNCTION
						;NOTE RETRIES INHIBITED

TAPE:	.ASCID	/SCRATCH/			;TAPE LOGICAL NAME

TERM:	.ASCID	/TT/				;TERMINAL LOGICAL NAME
						;NOTE WE DO NOT USE RMS,
						;SO THIS PROGRAM MUST HAVE
						;A TERMINAL AS OUTPUT DEVICE
;
;	MESSAGES
;

NOTAPE:	.ASCID	/PLEASE MOUNT TAPE FOREIGN WITH LOGICAL NAME 'SCRATCH'/

BADBPI:	.ASCID	/TAPE DENSITY NOT SUPPORTED/

BPI:	.ASCID	/CHECKING TAPE AT !SW BPI/

LENGTH:	.ASCID	\THE TAPE IS ABOUT !SW FEET LONG!/\

TAPERR:	.ASCID	/A TAPE ERROR OCCURRED AT ABOUT !SW FEET/

SUMERR:	.ASCID	/!SW TAPE ERROR!%S OCCURRED IN !SW FEET/

;
; READ/WRITE DATA
;
	.PSECT	RWDATA,RD,WRT,NOEXE

IOSB:	.BLKQ	1				;I/O STATUS BLOCK

LOCKTBL:.ADDRESS	BUFFER			;TABLE FOR LOCKING BUFFER
	.ADDRESS	BUFFER			;INTO THE WORKING SET

BUFSIZ:	.BLKL	1				;BUFFER SIZE

DENSITY:.BLKL	1				;TAPE DENSITY

TTCHAN:	.BLKW	1				;TERMINAL CHANNEL NUMBER

MTCHAN:	.BLKW	1				;TAPE CHANNEL NUMBER

BLOX:	.BLKW	1				;BLOCK COUNTER

FEET:	.BLKW	1				;TAPE FOOTAGE COUNTER

TOTAL:	.BLKW	1				;TOTAL LENGTH

ERROR:	.BLKW	1				;ERROR COUNTER

MESSAGE:.WORD	80				;TERMINAL MESSAGE DESCRIPTOR
	.BYTE	DSC$K_DTYPE_T
	.BYTE	DSC$K_CLASS_D
	.LONG	TERMBUF
TERMBUF:.BLKB	80				;TERMINAL STRING BUFFER

	MAX6250=	36150			;BIG ENOUGH FOR
						;6250 BPI * 5.7 INCHES
						; (MEASURED PHYSICALLY!)
	MAX1600=	18240			;18240 FOR 1600 BPI * 11.4 IN
	MAX800=		9120			;9120 FOR 800 BPI * 11.4 IN

BUFFER:	.BLKB	MAX6250				;DATA BUFFER

;
; EXECUTABLE CODE BEGINS
;

	.PSECT	CODE,EXE,RD,NOWRT

TAPECHECK::

	.WORD	^M<R5,R4,R3,R2>

	$ASSIGN_S	DEVNAM=TERM,-		;GET TERMINAL CHANNEL
			CHAN=TTCHAN
	CMPW		#SS$_NORMAL,R0		;OK?
	BEQL		1$			;SKIP IF ALL IS WELL
	BRW		EXIT			;BRANCH IF NOT

1$:	$ASSIGN_S	DEVNAM=TAPE,-		;GET TAPE CHANNEL
			CHAN=MTCHAN
	CMPW		#SS$_NORMAL,R0		;TAPE CHANNEL OK?
	BEQL		SETUP			;BRANCH IF OK

	MOVL		NOTAPE+4,R0		;GET STRING ADDRESS
	$QIOW_S		EFN=#1,-		;SEND
			CHAN=TTCHAN,-		;USER
			FUNC=#IO$_WRITEVBLK,-	;THE
			IOSB=IOSB,-		;"NO TAPE
			P1=(R0),-		;MOUNTED"
			P2=NOTAPE,-		;ERROR
			P4=#^A/0/		;MESSAGE
	BRW		EXIT			;AND QUIT

SETUP:	$QIOW_S		EFN=#1,-		;ISSUE REWIND QIO
			CHAN=MTCHAN,-
			FUNC=#IO$_REWIND,-
			IOSB=IOSB

	CMPW		#SS$_NORMAL,IOSB	;MAKE SURE ALL IS WELL
	BEQL		1$			;SKIP IF STATUS NORMAL
	BRW		ABORT			;ABORT IF NOT

1$:	$QIOW_S		CHAN=MTCHAN,-		;ISSUE SENSEMODE QIO
			FUNC=#IO$_SENSEMODE,-
			IOSB=IOSB

	CMPW		#SS$_NORMAL,IOSB	;CHECK THAT ALL IS WELL
	BEQL		2$			;SKIP IF STATUS NORMAL
	BRW		ABORT			;ABORT IF NOT

2$:	EXTZV		#MT$V_DENSITY,#MT$S_DENSITY,IOSB+4,R0

	MOVL		#MAX6250,BUFSIZ		;6250 BPI * 5.7 INCHES
	MOVL		#6250,DENSITY
	CMPL		R0,#MT$K_GCR_6250	;6250 BPI?
	BEQL		3$
	MOVL		#MAX1600,BUFSIZ		;1600 BPI * 11.4 INCHES
	MOVL		#1600,DENSITY
	CMPL		R0,#MT$K_PE_1600	;1600 BPI?
	BEQL		3$
	MOVL		#MAX800,BUFSIZ		;800 BPI * 11.4 INCHES
	MOVL		#800,DENSITY
	CMPL		R0,#MT$K_NRZI_800	;800 BPI?
	BEQL		3$

	MOVL		BADBPI+4,R0		;GET STRING ADDRESS
	$QIOW_S		EFN=#1,-		;SEND
			CHAN=TTCHAN,-		;USER
			FUNC=#IO$_WRITEVBLK,-	;THE
			IOSB=IOSB,-		;"BAD TAPE
			P1=(R0),-		;DENSITY"
			P2=BADBPI,-		;ERROR
			P4=#^A/0/		;MESSAGE
	BRW		EXIT			;AND QUIT

3$:	MOVW		#80,MESSAGE		;$FAO ONLY SHORTENS LENGTH

	$FAO_S		CTRSTR=BPI,-		;COMPOSE
			OUTLEN=MESSAGE,-	;NICE
			OUTBUF=MESSAGE,-	;DENSITY
			P1=DENSITY		;MESSAGE

	$QIO_S		CHAN=TTCHAN,-		;SEND
			FUNC=#IO$_WRITEVBLK,-	;USER
			IOSB=IOSB,-		;"TAPE
			P1=TERMBUF,-		;DENSITY
			P2=MESSAGE,-		;IS"
			P4=#^X8D010000		;MESSAGE

	ADDL2		BUFSIZ,LOCKTBL+4	;SET UPPER ADDRESS SO WE CAN
	$LKWSET_S	INADR=LOCKTBL		;LOCK BUFFER IN WORKSET

	CLRW		BLOX			;CLEAR LENGTH COUNTER

						;FILL BUFFER WITH PATTERN

	MOVC5		#0,BUFFER,#PATTERN,BUFSIZ,BUFFER

WRITER:	$QIOW_S		EFN=#1,-		;ISSUE WRITE LOGICAL
			CHAN=MTCHAN,-
			FUNC=WRITE,-
			IOSB=IOSB,-
			P1=BUFFER,-
			P2=BUFSIZ

	INCW		BLOX			;INCREMENT LENGTH

	CMPW		IOSB,#SS$_NORMAL	;CHECK WRITE STATUS
	BEQL		WRITER			;KEEP WRITING UNLESS FAIL
	CMPW		IOSB,#SS$_ENDOFTAPE	;HIT END OF TAPE?
	BEQL		EOT			;SKIP IF WAS EOT
	CMPW		IOSB,#SS$_PARITY	;CHECK FOR PARITY ERROR
	BEQL		WRITER			;PICK UP PARITY ERRORS LATER
	BRW		ABORT			;ABORT ON ANY OTHER ERROR

EOT:	MOVW		BLOX,TOTAL		;STORE TOTAL LENGTH IN FEET
	CMPL		DENSITY,#6250		;CHECK IF 6250 BPI
	BNEQ		1$			;SKIP IF NOT
	DIVW2		#2,TOTAL		;6250 BPI USES 6 INCH CHUNKS

1$:	MOVW		#80,MESSAGE		;$FAO ONLY SHORTENS LENGTH

	$FAO_S		CTRSTR=LENGTH,-		;COMPOSE
			OUTLEN=MESSAGE,-	;NICE
			OUTBUF=MESSAGE,-	;LENGTH
			P1=TOTAL		;MESSAGE

	$QIO_S		CHAN=TTCHAN,-		;SEND
			FUNC=#IO$_WRITEVBLK,-	;USER
			IOSB=IOSB,-		;"TAPE
			P1=TERMBUF,-		;LENGTH
			P2=MESSAGE,-		;IS"
			P4=#^X8D010000		;MESSAGE

	$QIO_S		CHAN=MTCHAN,-		;WRITE AN EOF
			FUNC=#IO$_WRITEOF,-
			IOSB=IOSB

	$QIOW_S		EFN=#1,-		;ISSUE REWIND QIO
			CHAN=MTCHAN,-
			FUNC=#IO$_REWIND,-
			IOSB=IOSB

	CLRW		BLOX			;ZERO BLOCK COUNTER

	CLRW		ERROR			;CLEAR ERROR COUNT

READER:	$QIOW_S		EFN=#1,-		;ISSUE READ LOGICAL
			CHAN=MTCHAN,-
			FUNC=READ,-
			IOSB=IOSB,-
			P1=BUFFER,-
			P2=BUFSIZ

	INCW		BLOX			;INCREMENT BLOCK COUNT

	CMPW		IOSB,#SS$_NORMAL	;ANY ERROR?
	BNEQ		ERR			;IF SO, GO DO ERROR CHECK
	CMPW		IOSB+2,BUFSIZ		;CHECK # BYTES READ
	BNEQ		ERR			;IF NOT RIGHT,GRIPE
	SKPC		#PATTERN,BUFSIZ,BUFFER 	;DO COMPARISON
	BNEQ		ERR			;IF NOT RIGHT,COMPLAIN
	BRB		READER			;ALL IS WELL, READ ON

ERR:	CMPW		IOSB,#SS$_ENDOFTAPE	;END OF TAPE FOUND?
	BEQL		DONE			;DONE IF END REPORTED
	BITL		#MT$M_EOF,IOSB+4	;END OF FILE?
	BNEQ		DONE			;DONE IF END OF FILE
	MOVW		BLOX,FEET		;PREPARE TO ANNOUNCE ERROR

	CMPL		DENSITY,#6250		;CHECK IF 6250 BPI
	BNEQ		1$			;SKIP IF NOT
	DIVW2		#2,FEET			;6250 BPI USES 6 INCH CHUNKS

1$:	BSBW		ANNOUNCE		;ANNOUNCE ERROR
	BRW		READER			;AND CONTINUE READING

DONE:	$QIO_S		CHAN=MTCHAN,-		;ISSUE REWIND QIO
			FUNC=#IO$_REWIND!IO$M_NOWAIT,-	;BUT DON'T WAIT FOR IT
			IOSB=IOSB

	MOVW		#80,MESSAGE		;$FAO ONLY SHORTENS LENGTH

	$FAO_S		CTRSTR=SUMERR,-		;PRODUCE
			OUTLEN=MESSAGE,-	;NICE
			OUTBUF=MESSAGE,-	;ERROR
			P1=ERROR,-		;SUMMARY
			P2=TOTAL		;MESSAGE

	$QIOW_S		EFN=#1,-		;SEND
			CHAN=TTCHAN,-		;USER
			FUNC=#IO$_WRITEVBLK,-	;THE
			IOSB=IOSB,-		;"TOTAL
			P1=TERMBUF,-		;ERROR
			P2=MESSAGE,-		;COUNT"
			P4=#^X8D020000		;MESSAGE

	BRB		EXIT			;ALL DONE

ABORT:	MOVW		IOSB,R0			;LAZY MAN'S DIAGNOSTIC
EXIT:	$EXIT_S		R0

	.PAGE

ANNOUNCE:

	INCW		ERROR			;BUMP ERROR COUNT

	MOVW		#80,MESSAGE		;$FAO ONLY SHORTENS LENGTH

	$FAO_S		CTRSTR=TAPERR,-		;CREATE
			OUTLEN=MESSAGE,-	;NICE
			OUTBUF=MESSAGE,-	;ERROR
			P1=FEET			;MESSAGE

	$QIOW_S		EFN=#1,-		;SEND
			FUNC=#IO$_WRITEVBLK,-	;THE
			CHAN=TTCHAN,-		;NICE
			IOSB=IOSB,-		;"TAPE
			P1=TERMBUF,-		;ERROR
			P2=MESSAGE,-		;AT"
			P4=#^X8D010000		;MESSAGE

	RSB					;RETURN

	.END		TAPECHECK

