Return to taptst.f CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / usr.lib / libU77 / test

Annotation of 43BSDTahoe/usr.lib/libU77/test/taptst.f, revision 1.1

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.