1: program taptst 2: C 3: C Test the tape I/O routines 4: C 5: C ierr = topen (tlu, name, labelled) 6: C ierr = tclose (tlu) 7: C nbytes = tread (tlu, buffer) 8: C nbytes = twrite (tlu, buffer) 9: C ierr = trewin (tlu) 10: C ierr = tskipf (tlu, nfiles, nrecs) 11: C ierr = tstate (tlu, fileno, recno, err, eof, eot, tcsr) 12: C 13: character*20 devnam 14: integer topen, tclose, twrite, trewin, tskipf, tstate 15: logical labled, errf, eoff, eotf 16: integer tlu, file, rec, tcsr 17: character*256 outbuf 18: 19: if (iargc() .ge. 1) then 20: do 100 i = 1, iargc() 21: call getarg (i, outbuf) 22: if (outbuf(:5) .eq. '/dev/') devnam = outbuf 23: if (outbuf(:3) .eq. 'lab') labled = .true. 24: 100 continue 25: else 26: devnam = '/dev/rnmt0.1600' 27: labled = .false. 28: endif 29: 30: tlu = 3 31: 32: write(*,*) 'tstate before open ...' 33: ierr = tstate(tlu, file, rec, errf, eoff, eotf, tcsr) 34: if (ierr .ge. 0) then 35: write(*,*) 'tstate: file', file, 'rec', rec, 36: + 'err', errf, 'eof', eoff, 'eot', eotf 37: write(*,'("tcsr: ", 8ri6.6)') tcsr 38: else 39: call perror('tstate') 40: endif 41: 42: write(*,*) '\ntopen', devnam, ' labelled =', labled 43: ierr = topen(tlu, devnam, labled) 44: if (ierr .lt. 0) then 45: call perror('topen') 46: stop 47: endif 48: 49: write(*,*) '\ntwrite 4 records of 256 bytes each ...' 50: do 120 i = 1, 4 51: do 110 j = 1, 256 52: outbuf(j:j) = char(i + 16) 53: 110 continue 54: 55: ierr = twrite(tlu, outbuf) 56: if (ierr .ne. 256) then 57: call perror('twrite') 58: endif 59: 120 continue 60: 61: write(*,*) '\nrewinding ...' 62: ierr = trewin(tlu) 63: if (ierr .lt. 0) then 64: call perror('trewin') 65: ierr = tclose(tlu) 66: ierr = topen(tlu, devnam, labled) 67: endif 68: 69: write(*,*) '\ntread and dump ...' 70: call scanf(tlu) 71: 72: write(*,*) '\nrewinding ...' 73: ierr = trewin(tlu) 74: if (ierr .lt. 0) then 75: call perror('trewin') 76: ierr = tclose(tlu) 77: ierr = topen(tlu, devnam, labled) 78: endif 79: 80: write(*,*) '\ntskip 2 records ...' 81: ierr = tskipf(tlu, 0, 2) 82: if (ierr .lt. 0) then 83: call perror('tskipf') 84: endif 85: 86: write(*,*) '\ntread & dump ...' 87: call scanf(tlu) 88: 89: write(*,*) '\ntrewind and tskip to EOT ...' 90: ierr = trewin(tlu) 91: ierr = tskipf(tlu, 100, 0) 92: 93: write(*,*) '\ntwrite 4 more records of 256 bytes each ...' 94: do 220 i = 1, 4 95: do 210 j = 1, 256 96: outbuf(j:j) = char(i + 32) 97: 210 continue 98: 99: ierr = twrite(tlu, outbuf) 100: if (ierr .ne. 256) then 101: call perror('twrite') 102: endif 103: 220 continue 104: 105: write(*,*) '\ntrewind and tskip to 1 file & 3 records ...' 106: ierr = trewin(tlu) 107: ierr = tskipf(tlu, 1, 3) 108: 109: write(*,*) '\ntread & dump ...' 110: call scanf(tlu) 111: 112: write(*,*) '\ntstate ...' 113: ierr = tstate(tlu, file, rec, errf, eoff, eotf, tcsr) 114: if (ierr .ge. 0) then 115: write(*,*) 'tstate: file', file, 'rec', rec, 116: + 'err', errf, 'eof', eoff, 'eot', eotf 117: write(*,'("tcsr: ", 8ri6.6)') tcsr 118: else 119: call perror('tstate') 120: endif 121: 122: write(*,*) '\ntclose ...' 123: ierr = tclose(tlu) 124: if (ierr .lt. 0) then 125: call perror('tclose') 126: endif 127: 128: write(*,*) '\ntstate after tclose ...' 129: ierr = tstate(tlu, file, rec, errf, eoff, eotf, tcsr) 130: if (ierr .ge. 0) then 131: write(*,*) 'tstate: file', file, 'rec', rec, 132: + 'err', errf, 'eof', eoff, 'eot', eotf 133: write(*,'("tcsr: ", 8ri6.6)') tcsr 134: else 135: call perror('tstate') 136: endif 137: 138: end 139: 140: subroutine scanf (tlu) 141: integer tlu 142: 143: integer tread, tstate 144: logical errf, eoff, eotf 145: integer file, rec, tcsr 146: character*10240 buffer 147: 148: C 100 nb = tread(tlu, buffer(:70)) 149: 100 nb = tread(tlu, buffer) 150: if (nb .gt. 0) then 151: ierr = tstate(tlu, file, rec, errf, eoff, eotf, tcsr) 152: if (ierr .lt. 0) then 153: call perror('tstate') 154: stop 'scanf' 155: endif 156: write(*,*) 'scanf: file', file+1, 'record', rec, 157: + 'length', nb 158: do 110 i = 1, nb, 16 159: write(*, '(4x, $)') 160: nl = min0(nb, i + 15) 161: do 105 j = i, nl 162: ival = and(ichar(buffer(j:j)), 255) 163: write(*, '(su, 16r, i4.2, $)') ival 164: 105 continue 165: write(*,*) 166: 110 continue 167: write(*,*) 168: else if (nb .eq. 0) then 169: write(*,*) 'EOF' 170: return 171: else 172: call perror('tread') 173: stop 'scanf' 174: endif 175: 176: goto 100 177: 178: end
|
Last modified: 1987-02-18
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 1044 |
|