Google
 

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

c	This program will write in industry compatible mode a full tape
c	till EOT ( 32 bits out of 36 in 4 8-bit bytes )
c	This mode is used  by our friendly competition and standardized.
c
c	For checking puposes we will write variable length records with
c	the following pattern ( to be verified by TAPRED )
c
c	FILE 1	:	16 RECORDS of 16 words
c	FILE 2  :	17 RECORDS of 17 words
c	....
c	FILE N  :    N+15  RECORDS of N+15 words
c
c	WORD 1 of each record has RECORD-length shifted left 4 bits
c	WORD 2 of each record has RECORD-Nr within FILE shifted left 4 bits
c	WORDS 3 to n have number n shifted left 4 bits
c
c	The last RECORD ( or FILE ) will be terminated by EOT and will not
c	necessarily be complete
c

	IMPLICIT INTEGER (A-Z)
	dimension IBUF (8192)
	DO 10 I=3,8192
10	IBUF(I)=I*16	!FILL IBUF WITH SOMETHING RECOGNIZABLE

c	Get TAPE-Nr and DENSITY ( 800 or 1600 )
	TYPE 10020
	ACCEPT 10030,OU
	TYPE 10010
	ACCEPT 10060,IDEN1
	IF (IDEN1 .EQ. 800 ) IDEN=3
	IF (IDEN1 .EQ. 1600) IDEN=4
	CALL TOPEN (OU, JFN, 1, 32768, IDEN, 4, 0)
	call trew(jfn)	!rewind it first

20	N=0
c	Start writing
	TYPE 10040
	DO 60 J=16,8192
	len=j*4

	N=N+1
	ibuf(1)=16*j
	do 30 jj=1,j
	ibuf(2)=16*jj
30	CALL TWRITE (JFN,IBUF,len,FLAG1,FLAG2,$40)
	CALL TWEOF(JFN)
	GO TO 60

40	j1=j-15
	IF ((FLAG1 .EQ. 'E O T') .AND. (FLAG2 .EQ. '     '))  GOTO 50
	TYPE 10090,jj,J1
	GOTO 90

50	TYPE 10100,J1,JJ
	call tweof(jfn)	!write first eof-mark
	GOTO 80


60	CONTINUE
70	TYPE 10110
	CALL TWEOF (JFN)
	IF (LEN .LT. 0)  GOTO 20

80	call tweof(jfn)	!write 2'nd EOF-mark
	CALL TREW (JFN)

90	TYPE 10120,FLAG1, FLAG2
	STOP
10010	FORMAT(' Density to WRITE ( 800 or 1600 ): '$)
10020	FORMAT (' Output LOGICAL tape name: '$)
10030	FORMAT (A5)
10040	FORMAT (' Starting WRITE loop')
10060	FORMAT (I)
10070	FORMAT (1H0,2I5,' Length= ',I6,' Record no. = ',I6)
10090	FORMAT (' ? Error in TWRITE FILE NR. ',I6,' record no. ',I6)
10100	FORMAT ('  END-OF-REEL detected in TWRITE  FILE Nr. ',I6,
	1' RECORD Nr. ',I6)
10110	FORMAT ('  End of file')
10120	FORMAT ( ' Error indicator: '2A5)
	END