Google
 

Trailing-Edge - PDP-10 Archives - BB-D867C-BM - uetp/lib/tapred.for
There are 16 other files named tapred.for in the archive. Click here to see a list.
	PROGRAM tapred

c	Program reads and verifies tapes written by TAPWRT
c	.. uses "industry-compatible" mode i.e. 32 bits out of 36 bits
c	in 4 8 bit bytes. 
c
c	All numbers therefore are shifted left 4 bits left
c	Hardware comes back with junk in other 4 bits , therefore
c	masked out !!

c	IBUF(1)= Record length == FILE-Nr - 15 (all mod 16 )
c	IBUF(2)= Record Nr.
	implicit integer (a-z)

	dimension IBUF (8192)
	mask="777777777760	!mask parity and junk off

c	Get TAPE-Nr and DENSITY ( 800 or 1600 )
	TYPE 10010
	ACCEPT 10020,UNIT

	TYPE 10030
	ACCEPT 10040,IDEN1
	IF (IDEN1 .EQ. 800)  IDEN=3
	IF (IDEN1 .EQ. 1600)  IDEN=4

	outdev='TTY:'
	OPEN (UNIT=2,DEVICE=OUTDEV,ACCESS='SEQOUT')

	CALL TOPEN (UNIT,JFN,0,32768,IDEN,4,0)
	call trew(jfn)	!rewind it first
	file=0
10	N=0
	file=file+1
	WRITE (2,10070)file
	j=1
	words=0

20	LEN=32768		!READ THE maxiMUM LENGTH IND. RECORD
30	CALL TREAD (JFN,IBUF,LEN,FLAG1,FLAG2,$50,$60)
	words=words+(len/4)
	N=N+1

c		Do some checking
	foo1=((ibuf(1).and.mask)/16)-15!is FILE-Nr ascending?
	if (file .ne. foo1)write (2,10140)file,foo1
	foo=(ibuf(2).and.mask)/16!is RECORD-Nr ascending?
	if(n .ne. foo ) write (2,10150) file, n , foo
	foo1=foo1+15
	do 29 jj=3,foo1	!is rest of RECORD numbered correctly?
	foo2=16*jj
	if((ibuf(jj).and. mask).ne. foo2)write (2,10130) file,n,jj,foo2,ibuf(jj)
29	continue
40	j=j+1
	goto 20	!next record

50	WRITE (2,10090)file, J	!we got an error out of TREAD
	GOTO  70

c	We got some magtape error-indicator - is it EOT?
60	if((flag1.eq.'E O T').and.(flag2.eq.'     '))goto 65
	j1=j-1
	WRITE (2,10100)file,j1,words
	goto 66

65	write (2,10120)file,j,words	!we found ourselves at EOT
	call trew(jfn)
	stop
C  TEST N - IF IT IS 0 THAN EITHER THERE WERE 2 CONSECUTIVE EOF'S,
C   OR THERE IS AN EOF AT THE BEGINNING OF THE REEL...STOP ANYWAY.

66	IF (N .NE. 0)  GOTO 10
	CALL TREW (JFN)   !ELSE, REWIND AND STOP
	STOP


70	WRITE (2,10110) FLAG1, FLAG2
	STOP
10010	FORMAT (' Logical tape file to read: '$)
10020	FORMAT (A5)
10030	FORMAT (' Density to read ( 800 or 1600 ): '$)
10040	FORMAT (I)
10070	FORMAT (' Reading File Nr: ',i6)
10090	FORMAT (' ?Error in TREAD at record no. ',I6)
10100	FORMAT (' FILE Nr: ',i6,' with ',i6,' RECORDS or ',i12,' words.') 
10110	FORMAT (' Error Indicator: '2A5)
10120	format(' END of TAPE ',i6,' Files with ',i6,
	1' RECORDS and ',i12,' words read.')
10130	format(' ?FILE: ',i6,' RECORD Nr.: ',i6,' WORD Nr: ',i12,
	1' Expected: ',O12,' Actual: ',O12)
10140	format(' ?FILE Nr. expected ',i6,' Actual Nr. is : ',i6)
10150	format(' ?FILE: ',I6,' RECORD Nr expected : ',i6,
	1' Actual RECORD Nr : ',i6)
	END