2.9BSD/usr/src/lib/libU77/test/taptst.f

	program taptst
C
C Test the tape I/O routines
C
C	ierr = topen  (tlu, name, labelled)
C	ierr = tclose (tlu)
C	nbytes = tread  (tlu, buffer)
C	nbytes = twrite (tlu, buffer)
C	ierr = trewin (tlu)
C	ierr = tskipf (tlu, nfiles, nrecs)
C	ierr = tstate (tlu, fileno, recno, err, eof, eot, tcsr)
C
	character*20	devnam
	integer		topen, tclose, twrite, trewin, tskipf, tstate
	logical		labled, errf, eoff, eotf
	integer		tlu, file, rec, tcsr
	character*256	outbuf

	if (iargc() .ge. 1) then
		do 100 i = 1, iargc()
			call getarg (i, outbuf)
			if (outbuf(:5) .eq. '/dev/') devnam = outbuf
			if (outbuf(:3) .eq. 'lab') labled = .true.
  100		continue
	else
		devnam = '/dev/rnmt0.1600'
		labled = .false.
	endif

	tlu = 3

	write(*,*) 'tstate before open ...'
	ierr = tstate(tlu, file, rec, errf, eoff, eotf, tcsr)
	if (ierr .ge. 0) then
		write(*,*) 'tstate: file', file, 'rec', rec,
     +			'err', errf, 'eof', eoff, 'eot', eotf
		write(*,'("tcsr: ", 8ri6.6)') tcsr
	else
		call perror('tstate')
	endif

	write(*,*) '\ntopen', devnam, '  labelled =', labled
	ierr = topen(tlu, devnam, labled)
	if (ierr .lt. 0) then
		call perror('topen')
		stop
	endif

	write(*,*) '\ntwrite 4 records of 256 bytes each ...'
	do 120 i = 1, 4
		do 110 j = 1, 256
			outbuf(j:j) = char(i + 16)
  110		continue

		ierr = twrite(tlu, outbuf)
		if (ierr .ne. 256) then
			call perror('twrite')
		endif
  120	continue

	write(*,*) '\nrewinding ...'
	ierr = trewin(tlu)
	if (ierr .lt. 0) then
		call perror('trewin')
		ierr = tclose(tlu)
		ierr = topen(tlu, devnam, labled)
	endif

	write(*,*) '\ntread and dump ...'
	call scanf(tlu)

	write(*,*) '\nrewinding ...'
	ierr = trewin(tlu)
	if (ierr .lt. 0) then
		call perror('trewin')
		ierr = tclose(tlu)
		ierr = topen(tlu, devnam, labled)
	endif

	write(*,*) '\ntskip 2 records ...'
	ierr = tskipf(tlu, 0, 2)
	if (ierr .lt. 0) then
		call perror('tskipf')
	endif

	write(*,*) '\ntread & dump ...'
	call scanf(tlu)

	write(*,*) '\ntrewind and tskip to EOT ...'
	ierr = trewin(tlu)
	ierr = tskipf(tlu, 100, 0)

	write(*,*) '\ntwrite 4 more records of 256 bytes each ...'
	do 220 i = 1, 4
		do 210 j = 1, 256
			outbuf(j:j) = char(i + 32)
  210		continue

		ierr = twrite(tlu, outbuf)
		if (ierr .ne. 256) then
			call perror('twrite')
		endif
  220	continue

	write(*,*) '\ntrewind and tskip to 1 file & 3 records ...'
	ierr = trewin(tlu)
	ierr = tskipf(tlu, 1, 3)

	write(*,*) '\ntread & dump ...'
	call scanf(tlu)

	write(*,*) '\ntstate ...'
	ierr = tstate(tlu, file, rec, errf, eoff, eotf, tcsr)
	if (ierr .ge. 0) then
		write(*,*) 'tstate: file', file, 'rec', rec,
     +			'err', errf, 'eof', eoff, 'eot', eotf
		write(*,'("tcsr: ", 8ri6.6)') tcsr
	else
		call perror('tstate')
	endif

	write(*,*) '\ntclose ...'
	ierr = tclose(tlu)
	if (ierr .lt. 0) then
		call perror('tclose')
	endif

	write(*,*) '\ntstate after tclose ...'
	ierr = tstate(tlu, file, rec, errf, eoff, eotf, tcsr)
	if (ierr .ge. 0) then
		write(*,*) 'tstate: file', file, 'rec', rec,
     +			'err', errf, 'eof', eoff, 'eot', eotf
		write(*,'("tcsr: ", 8ri6.6)') tcsr
	else
		call perror('tstate')
	endif

	end

	subroutine scanf (tlu)
	integer	tlu

	integer		tread, tstate
	logical		errf, eoff, eotf
	integer		file, rec, tcsr
	character*10240	buffer

C  100	nb = tread(tlu, buffer(:70))
  100	nb = tread(tlu, buffer)
	if (nb .gt. 0) then
		ierr = tstate(tlu, file, rec, errf, eoff, eotf, tcsr)
		if (ierr .lt. 0) then
			call perror('tstate')
			stop 'scanf'
		endif
		write(*,*) 'scanf: file', file+1, 'record', rec,
     +			'length', nb
		do 110 i = 1, nb, 16
			write(*, '(4x, $)')
			nl = min0(nb, i + 15)
			do 105 j = i, nl
				ival = and(ichar(buffer(j:j)), 255)
				write(*, '(su, 16r, i4.2, $)') ival
  105			continue
		write(*,*)
  110		continue
		write(*,*)
	else if (nb .eq. 0) then
		write(*,*) 'EOF'
		return
	else
		call perror('tread')
		stop 'scanf'
	endif

	goto 100

	end