program readrt c read rt-11 files from a tape or tpc image to current directory. c created 24-OCT-94, Tim Shoppa (shoppa@altair.krl.caltech.edu) implicit none integer size integer blcount,blcountr integer mbufsize parameter (mbufsize=512) logical dironly character*1 answer character*(mbufsize) buffer byte bufbyte(mbufsize) character*255 tpc_file character*17 file_name write(6,1) 1 format(1x,'Tape device or TPC file to read:',$) read(5,2) tpc_file 2 format(a255) open(unit=11,file=tpc_file,status='old',form='formatted', 1 carriagecontrol='none') 5 write(6,3) 3 format(1x,'(D)irectory or (E)xtract:',$) read(5,4) answer 4 format(a1) if (answer.eq.'D'.or.answer.eq.'d') then dironly=.true. else if (answer.eq.'E'.or.answer.eq.'e') then dironly=.false. else go to 5 end if 10 read(11,101) size,buffer(1:size) 101 format(q,a) c type *,size write (6,201)buffer(1:3) write (6,202)buffer(4:4) write (6,203)buffer(5:10) write (6,204)buffer(38:50) 201 format(1x,'Label Identifier:',t30,a3) 202 format(1x,'Label Number :',t30,a1) 203 format(1x,'Volume Identifier:',t30,a6) 204 format(1x,'Owner Identifier:',t30,a13) write(6,250) write(6,251) 250 format(1x,'Filename',t20,'Date',t40,'Actual/Reported Blocks') 251 format(1x,'--------',t20,'------',t40,'---------------------') 300 read(11,101,end=9990) size,buffer(1:size) if (size.lt.80 .or. buffer(1:4).ne.'HDR1') go to 300 write(6,301) buffer(5:21),buffer(42:47) file_name=buffer(5:21) 301 format(1x,a17,t20,a6,t39,' ',$) 400 read(11,101,end=450) size,buffer(1:size) if (size.ne.0) stop ' No tape mark after HDR1 - not RT format?' 450 if (.not.dironly) 1 open(unit=12,file=file_name,form='unformatted', 2 recordtype='fixed',recl=128,status='new') blcount=0 500 read(11,101,end=600,err=550) size,buffer(1:size) if (size.eq.0) go to 600 if (size.ne.512) stop ' Non-512 block length for RT-11 tape.' go to 551 550 type *,'Danger! bad block read, writing to file anyway...' 551 if (.not.dironly) write (12) buffer blcount=blcount+1 go to 500 600 if (.not.dironly) close(12) read(11,101) size,buffer(1:size) if (buffer(1:3).ne.'EOF') stop 'Expected to see EOF!' read(buffer(55:60),*) blcountr write(6,605) blcount,blcountr 605 format('+',i5,'/',i5) read(11,101,end=300) size,buffer(1:size) if (size.eq.0) go to 300 stop 'No tape mark after EOF!' 9990 stop 'Normal end of tape.' end