![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to taptst.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / lib / libU77 / test|
Return to taptst.f CVS log | Up to [CSRG BSD Unix] / 43BSDReno / lib / libU77 / test |
1.1 root 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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.