Program Files c ... This program retrieves files from the bad disk (Sia1:) c ... and stores them onto Sia0:[adapt.files]. The user c ... specifies the file...the program builds it from the index c ... file on Sia0, and the file blocks from Sia1, the clobbered c ... disk. c c c Implicit Integer (A-Z) Byte Header(512) , data(512) character val*1 Integer*4 Fblock(100), Nblocks(100), Attr(7), Succ Common /Chanl/Chan Integer*4 Chan c Character F_name*37, File_org(3)*10 Data File_org /'SEQUENTIAL', 'RELATIVE', 'INDEXED'/ Integer flag External Opener_1, Opener_2 c ........ open the INDEX File Open(Unit=3,Name='sia0:[adapt.disk]newindexf.sys', 1 Access = 'Direct', Recordsize = 128, Maxrec = 7000, 2 Organization = 'Relative', Type = 'old' ) c ....... open a log file to keep track of program use Open(Unit=9, Name='Dra0:[Adapt.Disk]Files.log', 1 Form='Formatted', Type='New') 20 Print 2 2 Format(' Enter file nr: '$) Read *,Nfile If(Nfile .eq. 0)Then stop End if c Read(3'Nfile,err=50)Header c ........ POINTS returns the mapping pointers in a useable form Call Points(Header, Np, Fblock, Nblocks, Flag) If(Flag .eq. 0)Then nsum = 0 Do j=1,np nsum = nsum + nblocks(j) end do Print 3,nfile, nsum,(header(i),i=77,95) 3 format(i6,2x,i6,' Blocks. ',19a1) c Print 4 4 Format(' Do you want this file? '$) Read 6,val 6 Format(a) If(Val .eq. 'Y' .or. val .eq. 'y')Then c ... Get type of file Write(9,3)nfile, nsum, (header(i),i=77,95) Call Rec_attr(Header, Attr) Encode(37, 31, F_name) (Header(i), i=77,95) 31 Format('Sia0:[Adapt.Files]',19a1) c If(Attr(1) .eq. 1)Then ! Fixed record format c ... If this is an OPL, set its record count to 2000 bytes If(Index(F_name, '.OPL') .ne. 0 .OR. 1 INDEX(F_NAME, '.NPL') .ne. 0)Then Open(Unit=1, Name=F_name, Recordtype='FIXED', Organization= 1 File_org(Attr(2)+1), Recl=500, Status='New', 3 Initialsize=nsum, Extendsize=10, 4 Access = 'Direct', 2 Err=101, Useropen=Opener_1, Iostat=Succ) Else Attr(4) = max0(10, attr(4)) Open(Unit=1, Name=F_name, Recordtype='FIXED', Organization= 1 File_org(Attr(2)+1), Recl=Attr(4), Status='New', 3 Initialsize=nsum, Extendsize=10, 4 CarriageControl='list', 2 Err=101, Useropen=Opener_1, Iostat=Succ) End if c Else if(Attr(1) .eq. 2)Then ! Variable record Open(Unit=1, Name=F_name, Recordtype='VARIABLE', 1 Organization=File_org(Attr(2)+1), Recl=Attr(4), 3 Initialsize=nsum, Extendsize=10, 4 CarriageControl='list', 3 Status='New', Err=101, Useropen=Opener_1, Iostat=Succ) c Else if(Attr(1) .eq. 3)Then ! VFC Records Open(Unit=1, Name=F_name, Recordtype='VARIABLE', 1 Organization=File_org(Attr(2)+1), Recl=Attr(4), 4 CarriageControl='list', 3 Initialsize=nsum, 2 Status='New', Err=101, Useropen=Opener_2, Iostat=Succ) c Else Print *,' Error in record format. ', Attr(1) Write(9,*)' Error in record format. ',Attr(1) Goto 20 101 Print *,' Error in opening file of type ',Attr(1) Write(9,*)' Error in opening file of type ',Attr(1) Call Failure(Succ,'Open Failure') Go to 20 End if Nr_vblock = 1 c ........ loop thru groups of mapping pointers. Output of POINTS Do jj = 1, np Kblock = Fblock(jj) do jk = 1, nblocks(jj) c ....... read and write the blocks Call Rdblok(Kblock, Data) Kblock = Kblock + 1 Nbytes = 512 Call Wrblok(Nr_vblock, Data, Nbytes) Nr_vblock = Nr_vblock + 1 end do end do Close(Unit=1) End if go to 20 50 Print *,' Unknown or illegal file number.' go to 20 else Print *,' Cannot process file. Flag= ',flag Write(9,*)' Cannot process file. Flag= ',flag go to 20 end if End Subroutine Points(Header, Npoints, Fblock, Nblocks, Flag) c c ... This routine puts the map pointers in a file header into c ... more tractable form. It returns, first of all, the number c ... of pointers there are in Npoints. Then, for each, it returns c ... the number of blocks there are in this pointer group (in c ... Nblocks) and the location of the first in Fblock. c ... Flag is returned 0 if everything is fine c ... 1 if an illegal pointer type is found (not <>0,1,2 c ... 2 if the map pointer count is < 0 or > 100. c Implicit Integer (A-Z) Integer*4 Fblock(100), Nblocks(100), Hd(8) Byte Header(512) c c c Nwords = # of Map words (2 bytes each) in header Nwords = Header(59) Nwords = Iand(Nwords, 'FF'x) If (Nwords .lt. 0 )Then Flag = 2 Return End if c ... 131 is byte address of first Map pointer Loc = 131 Npoints = 0 10 Continue Do j = 1,8 Hd(j) = Header(Loc + j - 1) Hd(j) = Iand(Hd(j) , 'FF'x) End do c ... Upper 2 bits of 2nd byte have pointer type Type = Jishft(Hd(2), -6) c ... Remove upper 2 bits from HD(2) Hd(2) = Jiand(Hd(2), '3F'x) If(Type .eq. 0)Then Flag = 1 Return Else if(Type .eq. 1)Then ! Format 1 Npoints = Npoints + 1 Nblocks(Npoints) = Hd(1) + 1 Fblock(Npoints) = Jishft(Hd(2),16) + Jishft(Hd(4),8) + 1 Hd(3) Nbyts = 4 Else if (Type .eq. 2)Then ! Format 2 Npoints = Npoints + 1 Nblocks(Npoints) = Hd(2) * 256 + Hd(1) + 1 Fblock(Npoints) = ((Hd(6) * 256 + Hd(5)) * 256 + Hd(4)) 1 * 256 + Hd(3) Nbyts = 6 Else if(Type .eq. 3)Then Npoints = Npoints + 1 Nblocks(Npoints) = ((Hd(2)* 256 + Hd(1)) * 256 + Hd(4)) * 256 1 + Hd(3) + 1 Fblock(Npoints) = ((Hd(8)*256 + Hd(7)) * 256 + Hd(6)) * 256 1 + Hd(5) Nbyts = 8 End if Nwords = Nwords - Nbyts / 2 Loc = Loc + Nbyts If(Nwords .gt. 0)Then Go to 10 End if Flag = 0 Return End Subroutine Rdblok(Block,Data) c .......... this routine reads a disk block numbered BLOCK into DATA IMPLICIT INTEGER*4 (A-Z) Byte Data(512) Logical Failure INTEGER*2 STATUS(4) INTEGER*4 DEVDEPINF INTEGER*2 NUMBYTES, QIOSTAT EQUIVALENCE (STATUS(1),QIOSTAT) EQUIVALENCE (STATUS(2),NUMBYTES) EQUIVALENCE (STATUS(3),DEVDEPINF) Data First /0/ If(First .eq. 0)Then SUCC = SYS$ASSIGN('_SIA1:',CHAN,,) IF(FAILURE(SUCC,'ASSIGN FAILURE'))PRINT*,CHAN First = 1 End if SUCC = SYS$QIOW(%VAL(1),%VAL(CHAN),%VAL(33),STATUS,,, +Data,%VAL(512),%VAL(Block),,,) IF(FAILURE(SUCC,'QIO FAILURE'))PRINT*,CHAN Succ = Iand(Qiostat, 'FFFF'x) If(Failure(Succ, 'Qio failure in Rdblok.'))Stop C WRITE(6,10001)QIOSTAT, NUMBYTES, DEVDEPINF C0001 FORMAT(1X,'QIOSTAT IS',Z4,'NUMBYTES IS ',I4, C +'DEVDEPINF IS',Z8) Return END LOGICAL FUNCTION FAILURE(SUCC, ERRMSG) c ...... This routine prints the error message associated with the c ...... flag SUCC returned from system services. IMPLICIT INTEGER*4 (A-Z) CHARACTER* (*) ERRMSG CHARACTER*60 MSG FAILURE = .FALSE. IF(SUCC .EQ. 0 .OR. SUCC .EQ. 1)RETURN FAILURE = .TRUE. IF(LEN(ERRMSG) .GT. 1)PRINT 1,ERRMSG(1:LEN(ERRMSG)),SUCC STAT=SYS$GETMSG(%VAL(SUCC), LENGTH, MSG, %VAL(15), ) IF(STAT .NE. 1)RETURN PRINT 2, MSG(1:LENGTH) 1 FORMAT(1X,A,'. (CODE=',Z')') 2 FORMAT(1X,A) RETURN END Subroutine Wrblok(Block,Data, Nbytes) IMPLICIT INTEGER*4 (A-Z) Common /Chanl/Chan Integer*4 Chan, Block Logical Failure Byte Data(512) INTEGER*2 STATUS(4) INTEGER*4 DEVDEPINF INTEGER*2 NUMBYTES, QIOSTAT EQUIVALENCE (STATUS(1),QIOSTAT) EQUIVALENCE (STATUS(2),NUMBYTES) EQUIVALENCE (STATUS(3),DEVDEPINF) c ... '30'x is Io$_Writevblk SUCC = SYS$QIOW(%VAL(2),%VAL(CHAN),%VAL('30'x),STATUS,,, +Data,%VAL(Nbytes),%VAL(Block),,,) IF(FAILURE(SUCC,'QIO FAILURE IN Wrblok'))PRINT*,CHAN Succ = Iand(Qiostat, 'FFFF'x) If(Failure(Succ,' Qio failure in Wrblok.'))Stop Return End Subroutine Rec_attr(Header, Attr) c ... This routine returns a vector of record attributes for the c ... file whose header is in 'header'. The attributes returned c ... are as follows: c ... Attr(1) Record format (from bits 0-3 of header (21) ) c ... Attr(2) File organization (from bits 4-7 of header 21) c ... Attr(3) Record attribute from header 22 c ... Attr(4) Record size, header 23 c ... Attr(5) Highest VBN allocated , header 25-28 c ... Attr(6) EOF block number, header 29-32 c ... Attr(7) First free byte in WOF block, header 33 Byte Header(512) Integer*2 Temp Integer*4 Attr(10), Head(40) Temp = header(21) Attr(1) = Iand(Temp, 'F'x) Attr(2) = Iand(Iishft(Temp, -4) , 'F'x) Do jj = 22,33 Head(jj) = Header(jj) Head(jj) = Iand(Head(jj) , 'FF'x) end do Attr(3) = Head(22) Attr(4) = Head(23) Attr(5) = ((Head(26)*16 + Head(25))*16 + Head(28)) 1 * 16 + Head(27) Attr(6) = ((Head(30)*16 + Head(29))*16 + Head(32)) 1 * 16 + Head(31) Attr(7) = Head(33) Return End