.IDENT /04/ ; 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 ; ; Modified: J. Downward JGD1 Use subroutine Output_Message ; 06-Oct-1984 to send terminal output to ; SYS$OUTPUT so can use with ; BATCH. Output final error count ; to a DCL local symbol, ; Tape_Errors ; ; 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 ;WRITE: .LONG IO$_WRITEVBLK!IO$M_INHEXTGAP!IO$M_INHRETRY ; JGD1 ;NOTE RETRIES 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/ WRTERR: .ASCID /A write error occured at about !SW feet/ FATERR: .ASCID /A FATAL write error occured at about !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 .ENTRY TAPECHECK, ^M $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 PUSHAQ NOTAPE ; JGD1 CALLS #1,Output_Message ; JGD1 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$ PUSHAQ BADBPI ; JGD1 CALLS #1,Output_Message ; JGD1 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 PUSHAQ MESSAGE ; JGD1 CALLS #1,Output_Message ; JGD1 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 BNEQ 10$ ; JGD1 JMP Parity_Error ; ;JGD ; BEQL WRITER ;PICK UP PARITY ERRORS LATER 10$: JMP ABORT ;ABORT ON ANY OTHER ERROR Parity_Error: 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$: INCW ERROR ;BUMP ERROR COUNT MOVW #80,MESSAGE ;$FAO ONLY SHORTENS LENGTH $FAO_S CTRSTR=WRTERR,- ;CREATE OUTLEN=MESSAGE,- ;NICE OUTBUF=MESSAGE,- ;ERROR P1=FEET ;MESSAGE PUSHAQ MESSAGE ; JGD1 CALLS #1,Output_Message ; JGD1 JMP WRITER ; and then continue JGD1 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 PUSHAQ MESSAGE ; JGD1 CALLS #1,Output_Message ; JGD1 $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 PUSHAQ MESSAGE ; Output summary msg JGD1 CALLS #1,Output_Message ; to fortran JGD1 PUSHAW TOTAL ; Set tot length JGD1 PUSHAW ERROR ; & tot errors in DCL JGD1 CALLS #1,Output_Error_Total ; symbol JGD1 BRB EXIT ;ALL DONE ABORT: MOVW BLOX,FEET ;PREPARE TO ANNOUNCE ERROR JGD1 CMPL DENSITY,#6250 ;CHECK IF 6250 BPI JGD1 BNEQ 1$ ;SKIP IF NOT JGD1 DIVW2 #2,FEET ;6250 BPI USES 6 INCH CHUNKS JGD1 1$: INCW ERROR ;BUMP ERROR COUNT JGD1 MOVW #80,MESSAGE ;$FAO ONLY SHORTENS LENGTH JGD1 $FAO_S CTRSTR=FATERR,- ;CREATE JGD1 OUTLEN=MESSAGE,- ;NICE JGD1 OUTBUF=MESSAGE,- ;ERROR JGD1 P1=FEET ;MESSAGE JGD1 PUSHAQ MESSAGE ; JGD1 CALLS #1,Output_Message ; JGD1 MOVW IOSB,R0 ;LAZY MAN'S DIAGNOSTIC BRW EXIT1 ; JGD1 EXIT: BISL #STS$M_INHIB_MSG,R0 ; Inhibit error message JGD1 EXIT1: $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 PUSHAQ MESSAGE ; JGD1 CALLS #1,Output_Message ; JGD1 RSB ;RETURN .END TAPECHECK