PROGRAM ANSI ! MAGTAPE RECOVERY C C C J Doran, Sira Institute Ltd., South Hill, Chislehurst, C Kent, BR7 5EH, England. C C This program will read an unmounted ANSI magtape block by block, C allowing user intervention if the block read was not what it expected. C C Version: V1.01 Date: 27-Apr-82 C C Task-build as: C C >TKB C TKB>ANSI,ANSI/-SP=ANSI,GETCHR,MTQIO,TYPBLK,OPNFIL,CLSREN,UCASE C TKB>RENAME,LB:[1,1]F77OTS/LB C TKB>/ C ENTER OPTIONS: C TKB>MAXBUF=512 C TKB>// C C See "Multi-tasker" Vol 10, No 4, pp87-88 for RENAME. C CHARACTER*4 HDRTYP,BLKTYP(11),ANS*1,ILLBYT*27,TYPES*40 INTEGER*4 A(128) INCLUDE 'ANSICOM.FTN' EQUIVALENCE (A,B),(BLKTYP,TYPES) C Normal sequence of block types (repeats at HDR1): DATA BLKTYP/'VOL1','HDR1','HDR2','MARK','FILE','EOF1', * 'EOF2','MARK','EOV1','EOV2','????'/ * IEXPCT,IPR(1),MODE,LNAME,COPY,COPYAL,FILOPN,SLOWLY,ILLBYT/ * UNKNWN,1,'?',0,4*.FALSE.,' -- invalid byte count'/ C C Suppress count conversion error message in DECODE: CALL ERRSET(64,.TRUE.,.FALSE.,.TRUE.,.FALSE.) 1 TYPE 1000 1000 FORMAT('$Magtape device [ddu]: ') ACCEPT 1010,L,I 1010 FORMAT(A2,I) CALL ASNLUN(1,L.AND.'57537'O,I,IDS) ! 57537 sets upper case IF(IDS.NE.ISSUC) GOTO 1 CALL GETCHR('Written by RT-11',16,ANS,'YN',2,I) RT11=I.EQ.1 TYPE 1030 1030 FORMAT('$Start at block (<=0 for current) = ') ACCEPT *,NBLOCK IF(NBLOCK.LT.0) NBLOCK=0 IF(NBLOCK.NE.0) THEN CALL MTQIO(IORWD) ! Rewind tape NBLOCK=NBLOCK-1 ! Blocks to space out IF(NBLOCK.EQ.0) THEN IEXPCT=VOL1 ! Block 1 should be VOL1 ELSE ! others can be anything (default) C Space to first block required. Have to do one block at a time because C a multiple space block instruction fails on tape marks. DO 4 NREC=1,NBLOCK 3 CALL MTQIO(IOSPB) ! (IPR(1) initialised to 1) IF(ISB(1).EQ.IEEOF) GOTO 3 ! Don't count tape marks IF(ISB(1).EQ.IEEOV) THEN CALL GETCHR('Read past E-O-V mark',28,ANS,'YN',2,I) IF(I.EQ.2) GOTO 9999 END IF ! end of volume mark 4 CONTINUE END IF END IF ! tape positioning required IF(RT11) MODE='F' ! all RT-11 files are ANSI F CALL GETADR(IPR,A) ! Set up buffer pointer C C Come here for a new tape block. 10 NBLOCK=NBLOCK+1 DO 20 I=1,128 20 A(I)=0 IPR(2)=512 CALL MTQIO(IORLB) ! Read tape block DISPLD=.FALSE. ! Not displayed yet C Check for and handle read errors. IF(ISB(1).EQ.IEEOF) GOTO 200 ! Tape mark IF(ISB(1).NE.ISSUC) THEN IF(ISB(1).EQ.IEBBE) THEN CALL TYPBLK(' is bad',7) ELSE IF(ISB(1).EQ.IEDAO) THEN CALL TYPBLK(' -- data overrun',16) ELSE IF(ISB(1).EQ.IEVER) THEN CALL TYPBLK(' -- unrecoverable error',24) ELSE TYPE 1060,ISB(1),NBLOCK 1060 FORMAT(' Error ',O3,' on block ',I6,'.') GOTO 9997 ! Continue? END IF END IF ! errors C C Block read. If RSX, should be 80 or 512 bytes. 80-byte blocks are file C headers etc, 512 byte blocks are data. All RT-11 blocks are 512 bytes, C so check everything. IF(ISB(2).EQ.0) GOTO 10 ! Ignore empty block IF(.NOT. RT11) THEN IF(ISB(2).GT.80) GOTO 500 ! Not 80, try file data IF(ISB(2).NE.80) CALL TYPBLK(' is short header block',22) END IF ! RT11 C Find header type. Ask on TI: if unknown. DECODE(4,1090,B) HDRTYP ! Copy B(1:4) into HDRTYP 110 I=INDEX(TYPES,HDRTYP) ITYPE=(I+3)/4 IF(MOD(I,4).NE.1) THEN IF(RT11) THEN IF(IEXPCT.EQ.FILE) GOTO 500 TYPE 1100,NBLOCK,BLKTYP(IEXPCT),BLKTYP(FILE) END IF ! RT11 CALL TYPBLK(' is invalid header block',26) TYPE 1080 1080 FORMAT('$Enter type [VOL1/HDR1-2/FILE/EOF1-2/EOV1-2/QUIT/cr * to ignore]: ') ACCEPT 1090,HDRTYP 1090 FORMAT(A) IF(HDRTYP.EQ.' ') GOTO 10 ! = ignore totally CALL UCASE(HDRTYP,4) ! Change to UC for compares IF(HDRTYP.EQ.'QUIT') GOTO 9998 ! Close file and exit IEXPCT=UNKNWN GOTO 110 END IF ! invalid header block type C Valid header block, see if we expected it (if anything in particular). IF(ITYPE.NE.IEXPCT .AND. IEXPCT.NE.UNKNWN .AND. * .NOT.(ITYPE.EQ.EOV1 .AND. IEXPCT.EQ.EOF1)) * TYPE 1100,NBLOCK,BLKTYP(IEXPCT),BLKTYP(ITYPE) 1100 FORMAT(' Block',I12,'. Expecting ',A,', read ',A,'.') C Process according to what we got anyway. GOTO (140,150,170,200,500,180,190,200,300,310),ITYPE C VOL1 header, just print name of tape. 140 TYPE 1110,NBLOCK,(B(I),I=5,10) 1110 FORMAT(' Block',I12,'. Volume label: ',6A1) IEXPCT=HDR1 ! Next should be file header GOTO 10 C HDR1 defines filename. See if it's wanted, unless copy all flag set. 150 IEXPCT=HDR2 IF(FILOPN) THEN CALL CLSFIL TYPE *,'No EOF block, file closed anyway.' END IF ! file already open FNAME=' ' DECODE(17,1090,B(5)) FNAME(1:17) ! Save filename string LNAME=INDEX(FNAME,'.')+1 ! and its length noting possible LNAME=LNAME+INDEX(FNAME(LNAME:18),' ')-2 ! embedded spaces DECODE(6,1130,B(36),ERR=160) I,L ! Get version no components 1130 FORMAT(I4,I2) 160 TYPE 1135,NBLOCK,FNAME(1:LNAME),(I-1)*100+L+1 1135 FORMAT(' Block',I12,'. Start of file ',A,';',O6.6) COPY=.TRUE. IF(.NOT.RT11) GOTO 10 ! RT-11 doesn't write HDR2's C HDR2. Open file if required, in appropriate mode (D or F). 170 IEXPCT=MARK IF(.NOT.COPY) GOTO 10 IF(.NOT.RT11) DECODE(1,1090,B(5)) MODE CALL OPNFIL ! Open file GOTO 10 C EOF1. Close file if open. 180 IEXPCT=EOF2 TYPE 1140,NBLOCK,(B(I),I=55,60),(B(I),I=5,21) 1140 FORMAT(' Block',I12,'. End of ',6A1,'-block file: ',17A1) IF(.NOT.RT11) GOTO 195 ! No EOF2's in RT11, expect NEWF C EOF2. Close file again, in case EOF1 missed. 190 IEXPCT=NEWF ! Expect mark & new file 195 CALL CLSREN ! Close, possibly renaming GOTO 10 C C Tape mark found. End-of-volume if we had one last time too. 200 NBLOCK=NBLOCK-1 ! Don't count it as a block IF(SLOWLY) TYPE *,'Tape mark after block',NBLOCK,'.' IF(ITYPE.EQ.MARK) THEN TYPE *,'End of volume mark.' GOTO 9997 ! Continue? END IF ! End of volume ITYPE=MARK ! Remember in case a second GOTO (240,240,209,210,230,240,219,220,240,240,240),IEXPCT 209 TYPE 1100,NBLOCK,BLKTYP(HDR1),BLKTYP(MARK) ! { HDR2 -> } 210 IEXPCT=FILE ! mark -> file GOTO 10 219 TYPE 1100,NBLOCK,BLKTYP(EOF1),BLKTYP(MARK) ! { EOF2 -> } 220 IEXPCT=HDR1 ! mark -> HDR1 GOTO 10 230 IEXPCT=EOF1 ! file -> mark -> EOF1 GOTO 10 240 TYPE 1100,NBLOCK,BLKTYP(IEXPCT),BLKTYP(MARK) IEXPCT=UNKNWN GOTO 10 C C EOV1. End of file and volume in a multi-volume set. 300 IEXPCT=EOV2 302 CALL CLSREN ! Close file, with possible rename TYPE *,'End of volume block.' GOTO 9997 ! Continue? C C EOV2. Second end-of-volume block. If expected, user is reading past it. 310 IF(IEXPCT.NE.EOV2) GOTO 302 IEXPCT=UNKNWN ! Anything could follow GOTO 10 C C Process file record if copying. Note file may not yet be open. 500 IF(IEXPCT.NE.FILE .AND. IEXPCT.NE.UNKNWN) * TYPE 1100,NBLOCK,BLKTYP(IEXPCT),BLKTYP(FILE) ITYPE=FILE IF(IEXPCT.EQ.FILE .AND. (.NOT.COPY)) GOTO 10 IF(IEXPCT.NE.FILE .AND. .NOT.FILOPN) CALL TYPBLK(' ',1) IEXPCT=FILE CALL OPNFIL ! Open file if not done already IF(.NOT.(FILOPN.AND.COPY)) GOTO 10 IF(ISB(2).NE.512) TYPE *,ISB(2),' byte file block!' IF(SLOWLY) THEN CALL TYPBLK(' ',1) CALL GETCHR('Copy block',10,ANS,'YNQFI',5,I) GOTO (509,10,9998,508,506),I 506 COPY=.FALSE. ! Ignore rest of this file GOTO 10 508 SLOWLY=.FALSE. ! continue copying, Fast END IF ! slow copy 509 IF(MODE.EQ.'F') THEN WRITE(2'NREC) B GOTO 10 ELSE C Decompose D type block into records. Format is 4 bytes of ASCII byte C count, followed by the ASCII bytes themselves. '^' as the first byte C of the count means end of block. L=0 520 L=L+1 IF(L.GE.512 .OR. B(L).EQ.'^') GOTO 10 ! All done DECODE(4,1170,B(L),ERR=525) M 1170 FORMAT(I4) M=L+M-1 IF(M.GT.512) THEN C Illegal byte count. Report and write out rest of record as is. 525 DECODE(4,1090,B(L)) ILLBYT(24:27) ! Complete message CALL TYPBLK(ILLBYT,27) M=512 L=L-4 ! Write illegal count too END IF ! illegal record length 530 WRITE(2,1180) (B(I),I=L+4,M) 1180 FORMAT(4(64A1)) END IF ! D/F format NREC=NREC+1 L=M GOTO 520 C C End of program (?). 9997 CALL GETCHR('Continue',8,ANS,'YN',2,I) ! Continue? IF(I.EQ.1) GOTO 10 ! Yes, read next block 9998 CALL CLSFIL ! No, close file 9999 END ! and return to MCR