FORTRAN IV-PLUS V3.0-3 16:33:42 30-Sep-81 Page 1 UNDELETE.FTN;112 /RO/TR:ALL 0001 PROGRAM UNDELETE C C+ C C UNDELETE - F4P program to undelete files from a disk. There must be no C other activity on the disk and it must be MOUnted/UNL. C Naturally, this should only be run from a privileged terminal. C (F4P is required to perform 32-bit integer arithmetic.) C C This is not a privileged program! It should only be run C by someone knowledgeable about the system and FILES-11 C structures, and should normally NOT be INStalled for C general use. C C Search patterns for recovery are specified in a form C similar to the SRD /SElect_entry option: ? and * are C single character wild cards and a stem search is C automatically performed. Any unspecified fields C default to wild cards. Note that the special version C numbers, 0 and -1, are NOT supported. C C For example: C C To recover all the .FTN files owned by [100,2], C specify the search pattern [100,2]*.FTN. C C To recover all files beginning with BP2 owned C by any account, you may specify simply BP2. C C See the comments in the code for possible modifications ('NOTE'). C There should not be any required to run on a V3.1 system. C C To compile: C C >F4P UNDELETE,UNDELETE/-SP=UNDELETE C C To task build, include a reference to USERLIB/LB for UPSTR, UPPER, C and STDIO: C C >TKB C TKB>UNDELETE,UNDELETE/-SP=UNDELETE C TKB>LB:[1,1]SYSLIB/LB:$SHORT,[2,24]USERLIB/LB C TKB>/ C ENTER OPTIONS: C TKB>UNITS=5 C TKB>ACTFIL=1 C TKB>EXTSCT=$$FSR1:230 C TKB>UIC=[1,1] C TKB>// C C Larry Baker C U. S. Geological Survey C 345 Middlefield Road M/S 77 C Menlo Park, CA 94025 C (415) 323-8111 C RSX-11M V3.1 21-JAN-80 C C Warning -- as of this writing UNDELETE has been used exactly once in a FORTRAN IV-PLUS V3.0-3 16:33:42 30-Sep-81 Page 2 UNDELETE.FTN;112 /RO/TR:ALL C real live situation (it worked). It was written for this C emergency and has been used successfully on floppy disks C and RP03s. I recommend using any other source of a backup C copy of a file before attempting to UNDELETE it, since it C is always risky to mess with the volume structure. However, C when it was actually applied in a real disaster, UNDELETE C worked great, and I have confidence in its ability to correctly C manipulate the index file structure. C C- C 0002 IMPLICIT INTEGER (A-Z) C 0003 INTEGER*4 HFMAX, HEDRNO, IVBN, LONG2, MAPNO, KOUNT 0004 INTEGER HEADER(256), IDXBLK(256), LUNDAT(6) 0005 LOGICAL ISUSED, MATCH 0006 LOGICAL*1 REPLY(40), PATRN(24), COLON, INDEXF(23), LDEV(2) C 0007 EQUIVALENCE (HEDRNO, HEDR16) 0008 EQUIVALENCE (LUNDAT, LDEV) C 0009 DATA LONG2/2/, COLON/':'/, IEEOF/-10/, ISSUC/1/ C... NOTE: The mask ISDISK contains all the bit settings that a disk device C... might have set in the first device characteristics word, LUNDAT(3). 0010 DATA ISDISK/"140730/ C... File spec for index file on specified disk. 0011 DATA INDEXF/'D','D','N','N',':','[','0',',','0',']', 1 'I','N','D','E','X','F','.','S','Y','S', 2 ';','1',0/ C 0012 KOUNT = -1 C 0013 WRITE(5,501) 0014 501 FORMAT (/'$Enter disk name (ddnn:) ') 0015 READ(5,502,END=9940) NCHARS, REPLY 0016 502 FORMAT (Q, 40A1) C... Do a little syntax checking. 0017 IF (NCHARS .LE. 0) GOTO 1050 0018 IF (NCHARS .GT. 5) GOTO 1050 0019 IF (REPLY(NCHARS) .NE. COLON) GOTO 1050 0020 CALL ERRSNS 0021 CALL ASSIGN(1,REPLY,NCHARS) 0022 CALL ERRSNS(IERR) 0023 IF (IERR .EQ. 0) GOTO 1100 0024 1050 WRITE(5,503) (REPLY(J), J = 1,NCHARS) 0025 503 FORMAT (/' Unable to assign ', 40A1/) 0026 GOTO 9900 C C... Make sure this is really a disk. C C... NOTE: In order to run UNDELETE on an RSX-11M V3.0 system using C... RP03s, it was necessary to ZAP the value of ISDISK to "177777. C... While the I/O Drivers Manual indicates this should have C... worked, we found this test had to be bypassed. To find C... ISDISK in the map file, locate the contribution to PSECT C... $VARS from .MAIN., and add the offset to ISDISK found in C... the compiler listing. ZAP may then be used to open the C... location and change it to always pass this test. FORTRAN IV-PLUS V3.0-3 16:33:42 30-Sep-81 Page 3 UNDELETE.FTN;112 /RO/TR:ALL C 0027 1100 CALL GETLUN(1,LUNDAT) 0028 LUNDAT(2) = IAND(LUNDAT(2),"377) 0029 INDEXF(1) = LDEV(1) 0030 INDEXF(2) = LDEV(2) 0031 INDEXF(3) = '0' + (LUNDAT(2)/8) 0032 INDEXF(4) = '0' + MOD(LUNDAT(2),8) 0033 IF (IAND(LUNDAT(3),NOT(ISDISK)) .EQ. 0) GOTO 1150 0034 WRITE(5,505) (INDEXF(J), J = 1,5) 0035 505 FORMAT (/1X, 5A1, ' is not a disk.'/) 0036 GOTO 9000 C 0037 1150 CLOSE(UNIT=1) C C... BUFFERCOUNT=-1 disables all FCS access to the file. C... All I/O to the index file is done using F11ACP QIOs directly. C 0038 OPEN(UNIT=1,NAME=INDEXF,TYPE='OLD',BUFFERCOUNT=-1,ERR=1200) 0039 GOTO 1300 0040 1200 WRITE(5,504) 0041 504 FORMAT (/' Unable to access index file'/) 0042 GOTO 9900 C C... Read HOME block. 0043 1300 IF (GETBLK(1,LONG2,IDXBLK,IERR) .EQ. ISSUC) GOTO 1400 0044 WRITE(5,506) 0045 506 FORMAT (/' Home block read error'/) 0046 GOTO 9000 C C... Get offset to start of file headers and maximum number of files. C... Note: H.FMAX is a 16-bit unsigned binary number. 0047 1400 HIBSZ = IDXBLK(1) 0048 HEDRNO = 0 0049 HEDR16 = IDXBLK(4) 0050 HFMAX = HEDRNO D WRITE(5,509) HIBSZ, HFMAX D 509 FORMAT (/' Index file bitmap size (H.IBSZ): ', I6, '.'/ D 1 ' Maximum number of files (H.FMAX): ', I6, '.'/) C C... Make data pattern to match for header search (same as used by SRD). 0051 CALL MAKPAT(PATRN,IERR) 0052 IF (IERR .NE. 0) GOTO 9000 C C... There will be a maximum of HFMAX headers starting at VBN HIBSZ+3. 0053 IVBN = HIBSZ + 2 0054 KOUNT = 0 0055 DO 3000 HEDRNO = 1,HFMAX 0056 IVBN = 1 + IVBN C C... Is this file header marked available? 0057 IF (ISUSED(1,HEDRNO,IDXBLK,MAPNO,WORDNO,MASK)) GOTO 3000 C... No, see if it qualifies for resurrection 0058 IF (GETBLK(1,IVBN,HEADER,IERR) .NE. ISSUC) GOTO 4000 0059 IF (.NOT. MATCH(HEDRNO,PATRN,HEADER)) GOTO 3000 C... See if it looks like it might be saved (027027 in first C... field and zeroed out file number and checksum) 0060 IF (HEADER(1) .NE. "027027) GOTO 1700 0061 IF (HEADER(2) .NE. 0) GOTO 1700 FORTRAN IV-PLUS V3.0-3 16:33:42 30-Sep-81 Page 4 UNDELETE.FTN;112 /RO/TR:ALL 0062 IF (HEADER(256) .EQ. 0) GOTO 1800 C... Header possibly corrupted C C... NOTE: You may choose to let this recovery procede, but it is not C... advised. The one time I tried letting an unused header C... through (before the checks in MATCH were added), I ended C... up throwing VFY into a tizzy and made my test disk unusable. C 0063 1700 WRITE(5,511) 0064 511 FORMAT (' Warning: File header corrupted;', 1 ' recovery not attempted.') 0065 GOTO 3000 C C... Perform recovery for this file header C C... Set bitmap in index file (ISUSED told us where). 0066 1800 IDXBLK(WORDNO) = IOR(IDXBLK(WORDNO),MASK) 0067 IF (PUTBLK(1,MAPNO,IDXBLK,IERR) .NE. ISSUC) GOTO 4100 C... Set file number in file ID (16-bit unsigned binary). 0068 HEADER(2) = HEDR16 C... Reset the marked for delete characteristic 0069 HEADER(7) = IAND(HEADER(7),"77777) C... Set checksum in header 0070 CKSUM = 0 0071 DO 2200 J = 1,255 0072 2200 CKSUM = CKSUM + HEADER(J) 0073 HEADER(256) = CKSUM C... Re-write header 0074 IF (PUTBLK(1,IVBN,HEADER,IERR) .NE. ISSUC) GOTO 4200 C... Count this one in the total. 0075 KOUNT = 1 + KOUNT C 0076 3000 CONTINUE 0077 GOTO 9000 C C... Recovery loop terminated prematurely -- index file probably shorter C... than HFMAX. 0078 4000 IF (IERR .EQ. IEEOF) GOTO 9000 0079 WRITE(5,510) HEDRNO, IERR 0080 510 FORMAT (/' Fatal error reading file header no. ', I6, '.: ', I5/) 0081 GOTO 9000 C C... Error rewriting index file bitmap. 0082 4100 WRITE(5,513) IERR 0083 513 FORMAT (/' Fatal error rewriting index file bitmap: ', I5/) 0084 GOTO 9000 C C... Error rewriting file header to index file. 0085 4200 WRITE(5,514) IERR 0086 514 FORMAT (/' Fatal error rewriting file header to index file: ', 1 I5/) C C... Normal termination. 0087 9000 CLOSE(UNIT=1) C C... Print message if any files recovered. 0088 9900 IF (KOUNT) 9940, 9920, 9930 0089 9920 WRITE(5,516) FORTRAN IV-PLUS V3.0-3 16:33:42 30-Sep-81 Page 5 UNDELETE.FTN;112 /RO/TR:ALL 0090 516 FORMAT (/' No matching file headers found.'/) 0091 GOTO 9940 0092 9930 WRITE(5,515) KOUNT 0093 515 FORMAT (/' Total of ', I6, '. files recovered.'// 1 ' You must run the VFY utility to complete the', 2 ' recovery of the disk:'// 3 ' >VFY TI:,LB:=ddnn:/UP'/ 4 ' >VFY TI:,LB:=ddnn:/LO'/) C 0094 9940 CALL EXIT C 0095 END FORTRAN IV-PLUS V3.0-3 16:33:42 30-Sep-81 Page 6 UNDELETE.FTN;112 /RO/TR:ALL PROGRAM SECTIONS Number Name Size Attributes 1 $CODE1 002306 611 RO,I,CON,LCL 2 $PDATA 001262 345 RO,D,CON,LCL 3 $IDATA 000010 4 RW,D,CON,LCL 4 $VARS 002220 584 RW,D,CON,LCL 5 $TEMPS 000004 2 RW,D,CON,LCL VARIABLES Name Type Address Name Type Address Name Type Address Name Type Address Name Type Address CKSUM I*2 4-002216 COLON L*1 4-002144 HEDRNO I*4 4-000014 HEDR16 I*2 4-000014 HFMAX I*4 4-000020 HIBSZ I*2 4-002210 IEEOF I*2 4-002174 IERR I*2 4-002204 ISDISK I*2 4-002200 ISSUC I*2 4-002176 IVBN I*4 4-000024 J I*2 4-002206 KOUNT I*4 4-000040 LONG2 I*4 4-000030 MAPNO I*4 4-000034 MASK I*2 4-002214 NCHARS I*2 4-002202 WORDNO I*2 4-002212 ARRAYS Name Type Address Size Dimensions HEADER I*2 4-000044 001000 256 (256) IDXBLK I*2 4-001044 001000 256 (256) INDEXF L*1 4-002145 000027 11 (23) LDEV L*1 4-000000 000002 1 (2) LUNDAT I*2 4-000000 000014 6 (6) PATRN L*1 4-002114 000030 12 (24) REPLY L*1 4-002044 000050 20 (40) LABELS Label Address Label Address Label Address Label Address Label Address 501' 2-000000 502' 2-000036 503' 2-000044 504' 2-000126 505' 2-000076 506' 2-000170 510' 2-000322 511' 2-000224 513' 2-000406 514' 2-000470 515' 2-000630 516' 2-000562 1050 1-000266 1100 1-000360 1150 1-000614 1200 1-000654 1300 1-000714 1400 1-000776 1700 1-001362 1800 1-001420 2200 ** 3000 1-001634 4000 1-001724 4100 1-002016 4200 1-002064 9000 1-002122 9900 1-002140 9920 ** 9930 1-002222 9940 1-002260 FUNCTIONS AND SUBROUTINES REFERENCED ASSIGN CLOS$ ERRSNS EXIT GETBLK GETLUN ISUSED MAKPAT MATCH OPEN$ PUTBLK Total Space Allocated = 006024 1546 No FPP Instructions Generated FORTRAN IV-PLUS V3.0-3 16:33:49 30-Sep-81 Page 7 UNDELETE.FTN;112 /RO/TR:ALL 0001 INTEGER FUNCTION GETBLK (LUN, IBLK, IBUF, IERR) C C+ C C GETBLK - Reads a virtual block from the file currently associated with LUN. C PUTBLK - Writes a virtual block from the file currently associated with LUN. C C LUN - FORTRAN Logical Unit Number C IBLK - INTEGER*4 Virtual Block Number (from 1) C IBUF - Block buffer (256 words) C IERR - Error status (also returned as the function value): C C 1 = No errors (ISSUC) C ^0 = I/O Status Code C C- C 0002 IMPLICIT INTEGER (A-Z) 0003 INTEGER IBUF(256), IBLK(2) C 0004 IERR = IORVB(LUN,IBUF,512,IBLK,0,JUNK,IOSB2) 0005 GOTO 1000 C 0006 ENTRY PUTBLK (LUN, IBLK, IBUF, IERR) C 0007 IERR = IOWVB(LUN,IBUF,512,IBLK,0,JUNK,IOSB2) C 0008 1000 PUTBLK = IERR 0009 RETURN C 0010 END FORTRAN IV-PLUS V3.0-3 16:33:49 30-Sep-81 Page 8 UNDELETE.FTN;112 /RO/TR:ALL PROGRAM SECTIONS Number Name Size Attributes 1 $CODE1 000262 89 RO,I,CON,LCL 2 $PDATA 000010 4 RO,D,CON,LCL 3 $IDATA 000046 19 RW,D,CON,LCL 4 $VARS 000004 2 RW,D,CON,LCL ENTRY POINTS Name Type Address Name Type Address Name Type Address Name Type Address Name Type Address GETBLK I*2 1-000000 PUTBLK I*2 1-000100 VARIABLES Name Type Address Name Type Address Name Type Address Name Type Address Name Type Address IERR I*2 F-000010* IOSB2 I*2 4-000002 JUNK I*2 4-000000 LUN I*2 F-000002* ARRAYS Name Type Address Size Dimensions IBLK I*2 F-000004* 000004 2 (2) IBUF I*2 F-000006* 001000 256 (256) LABELS Label Address Label Address Label Address Label Address Label Address 1000 1-000174 FUNCTIONS AND SUBROUTINES REFERENCED IORVB IOWVB Total Space Allocated = 000344 114 No FPP Instructions Generated FORTRAN IV-PLUS V3.0-3 16:33:50 30-Sep-81 Page 9 UNDELETE.FTN;112 /RO/TR:ALL 0001 SUBROUTINE MAKPAT (PATRN, IERR) C C+ C C MAKPAT - Make search pattern from user response. C C PATRN - 24 char search pattern (see MATCH) C IERR - Error flag C C- C 0002 IMPLICIT INTEGER (A-Z) 0003 LOGICAL*1 REPLY(40), PATRN(24) 0004 LOGICAL*1 CHAR, QMARK, STAR, PERIOD, SEMI, LBRAK, RBRAK, COMMA 0005 LOGICAL*1 CHARA, CHARZ, CHAR0, CHAR7, CHAR9 C 0006 DATA QMARK/'?'/, STAR/'*'/, PERIOD/'.'/, SEMI/';'/ 0007 DATA LBRAK/'['/, RBRAK/']'/, COMMA/','/ 0008 DATA CHARA/'A'/, CHARZ/'Z'/, CHAR0/'0'/, CHAR7/'7'/, CHAR9/'9'/ C 0009 IERR = 1 C 0010 1000 WRITE(5,507) 0011 507 FORMAT (/'$Enter search pattern ([grp,mem]name.typ;version', 1 ', CR=all) ') 0012 READ(5,502,END=9000) NCHARS, REPLY 0013 502 FORMAT (Q, 40A1) 0014 WRITE(5,501) 0015 501 FORMAT (1X) C... Fill pattern with wild cards 0016 DO 1010 J = 1,24 0017 1010 PATRN(J) = QMARK 0018 IF (NCHARS .LE. 0) GOTO 1480 C... Convert to upper case characters 0019 CALL UPSTR(REPLY,NCHARS) C... Fill in owning UIC 0020 J = 0 0021 IF (REPLY(1) .NE. LBRAK) GOTO 1400 0022 J = 1 0023 DO 1210 I = 1,3 0024 J = 1 + J 0025 IF (J .GT. NCHARS) GOTO 1500 0026 CHAR = REPLY(J) 0027 IF (CHAR .EQ. COMMA) GOTO 1215 0028 1210 PATRN(I) = CHAR 0029 J = 1 + J 0030 IF (J .GT. NCHARS) GOTO 1500 0031 IF (REPLY(J) .NE. COMMA) GOTO 1500 0032 GOTO 1220 C... Right justify group number 0033 1215 IF (I .EQ. 1) GOTO 1220 0034 DO 1216 K = 3,1,-1 0035 I = I - 1 0036 CHAR = CHAR0 0037 IF (I .GE. 1) CHAR = PATRN(I) 0038 1216 PATRN(K) = CHAR 0039 1220 DO 1230 I = 4,6 0040 J = 1 + J FORTRAN IV-PLUS V3.0-3 16:33:50 30-Sep-81 Page 10 UNDELETE.FTN;112 /RO/TR:ALL 0041 IF (J .GT. NCHARS) GOTO 1500 0042 CHAR = REPLY(J) 0043 IF (CHAR .EQ. RBRAK) GOTO 1240 0044 1230 PATRN(I) = CHAR 0045 J = 1 + J 0046 IF (J .GT. NCHARS) GOTO 1500 0047 IF (REPLY(J) .NE. RBRAK) GOTO 1500 0048 GOTO 1400 C... Right justify member number. 0049 1240 IF (I .EQ. 4) GOTO 1400 0050 DO 1250 K = 6,4,-1 0051 I = I - 1 0052 CHAR = CHAR0 0053 IF (I .GE. 4) CHAR = PATRN(I) 0054 1250 PATRN(K) = CHAR C... Fill pattern with "name" part until period or 9 chars 0055 1400 DO 1420 I = 7,15 0056 J = 1 + J 0057 IF (J .GT. NCHARS) GOTO 1450 0058 CHAR = REPLY(J) 0059 IF (CHAR .EQ. PERIOD) GOTO 1430 0060 IF (CHAR .EQ. SEMI) GOTO 1445 0061 1420 PATRN(I) = CHAR 0062 J = 1 + J 0063 IF (J .GT. NCHARS) GOTO 1450 0064 CHAR = REPLY(J) 0065 IF ((CHAR .NE. PERIOD) .AND. (CHAR .NE. SEMI)) GOTO 1500 C... Fill "type" part with reply until 3 chars 0066 1430 DO 1440 I = 16,18 0067 J = 1 + J 0068 IF (J .GT. NCHARS) GOTO 1450 0069 CHAR = REPLY(J) 0070 IF (CHAR .EQ. SEMI) GOTO 1445 0071 1440 PATRN(I) = CHAR 0072 J = 1 + J 0073 IF (J .GT. NCHARS) GOTO 1450 0074 IF (REPLY(J) .NE. SEMI) GOTO 1500 C... Fill "version" part with reply until 6 chars 0075 1445 DO 1447 I = 19,24 0076 J = 1 + J 0077 IF (J .GT. NCHARS) GOTO 1448 0078 1447 PATRN(I) = REPLY(J) 0079 IF (NCHARS .GT. J) GOTO 1500 0080 GOTO 1450 C... Shift version number specification to be FORTRAN O6 style 0081 1448 IF (I .EQ. 19) GOTO 1450 0082 DO 1449 J = 24,19,-1 0083 I = I - 1 0084 CHAR = CHAR0 0085 IF (I .GE. 19) CHAR = PATRN(I) 0086 1449 PATRN(J) = CHAR C C... Validate characters (must be RAD50, ?, or *) and convert * to ? 0087 1450 CONTINUE D WRITE(5,511) PATRN D 511 FORMAT (' Search pattern: ', 24A1/) 0088 DO 1452 J = 1,6 0089 CHAR = PATRN(J) FORTRAN IV-PLUS V3.0-3 16:33:50 30-Sep-81 Page 11 UNDELETE.FTN;112 /RO/TR:ALL 0090 IF (CHAR .NE. STAR) GOTO 1451 0091 PATRN(J) = QMARK 0092 GOTO 1452 0093 1451 IF (CHAR .EQ. QMARK) GOTO 1452 0094 IF (CHAR .LT. CHAR0) GOTO 1520 0095 IF (CHAR .GT. CHAR7) GOTO 1520 0096 1452 CONTINUE 0097 DO 1460 J = 7,18 0098 CHAR = PATRN(J) 0099 IF (CHAR .NE. STAR) GOTO 1455 0100 PATRN(J) = QMARK 0101 GOTO 1460 0102 1455 IF (CHAR .EQ. QMARK) GOTO 1460 0103 IF (CHAR .LT. CHAR0) GOTO 1520 0104 IF (CHAR .LE. CHAR9) GOTO 1460 0105 IF (CHAR .LT. CHARA) GOTO 1520 0106 IF (CHAR .GT. CHARZ) GOTO 1520 0107 1460 CONTINUE 0108 DO 1470 J = 19,24 0109 CHAR = PATRN(J) 0110 IF (CHAR .NE. STAR) GOTO 1461 0111 PATRN(J) = QMARK 0112 GOTO 1470 0113 1461 IF (CHAR .EQ. QMARK) GOTO 1470 0114 IF (CHAR .LT. CHAR0) GOTO 1520 0115 IF (CHAR .GT. CHAR7) GOTO 1520 0116 1470 CONTINUE C C... Null search pattern comes here. 0117 1480 IERR = 0 C 0118 9000 RETURN C C... Pattern not of the form [grp,mem]name.typ;version 0119 1500 WRITE(5,512) 0120 512 FORMAT (/' Pattern not of the form [grp,mem],name.typ;version') 0121 GOTO 1000 C C... Illegal character in pattern 0122 1520 WRITE(5,508) CHAR, (REPLY(J), J = 1,NCHARS) 0123 508 FORMAT (/' Illegal character, ', A1, ', in ', 40A1) 0124 GOTO 1000 C 0125 END FORTRAN IV-PLUS V3.0-3 16:33:50 30-Sep-81 Page 12 UNDELETE.FTN;112 /RO/TR:ALL PROGRAM SECTIONS Number Name Size Attributes 1 $CODE1 003156 823 RO,I,CON,LCL 2 $PDATA 000252 85 RO,D,CON,LCL 3 $IDATA 000022 9 RW,D,CON,LCL 4 $VARS 000076 31 RW,D,CON,LCL ENTRY POINTS Name Type Address Name Type Address Name Type Address Name Type Address Name Type Address MAKPAT 1-000000 VARIABLES Name Type Address Name Type Address Name Type Address Name Type Address Name Type Address CHAR L*1 4-000050 CHARA L*1 4-000060 CHARZ L*1 4-000061 CHAR0 L*1 4-000062 CHAR7 L*1 4-000063 CHAR9 L*1 4-000064 COMMA L*1 4-000057 I I*2 4-000072 IERR I*2 F-000004* J I*2 4-000070 K I*2 4-000074 LBRAK L*1 4-000055 NCHARS I*2 4-000066 PERIOD L*1 4-000053 QMARK L*1 4-000051 RBRAK L*1 4-000056 SEMI L*1 4-000054 STAR L*1 4-000052 ARRAYS Name Type Address Size Dimensions PATRN L*1 F-000002* 000030 12 (24) REPLY L*1 4-000000 000050 20 (40) LABELS Label Address Label Address Label Address Label Address Label Address 501' 2-000106 502' 2-000100 507' 2-000000 508' 2-000200 512' 2-000110 1000 1-000054 1010 ** 1210 ** 1215 1-000566 1216 ** 1220 1-000720 1230 ** 1240 1-001136 1250 ** 1400 1-001270 1420 ** 1430 1-001536 1440 ** 1445 1-001742 1447 ** 1448 1-002072 1449 ** 1450 1-002224 1451 1-002314 1452 1-002372 1455 1-002502 1460 1-002600 1461 1-002710 1470 1-002756 1480 1-003000 1500 1-003014 1520 1-003054 9000 1-003012 FUNCTIONS AND SUBROUTINES REFERENCED UPSTR Total Space Allocated = 003550 948 No FPP Instructions Generated FORTRAN IV-PLUS V3.0-3 16:33:57 30-Sep-81 Page 13 UNDELETE.FTN;112 /RO/TR:ALL 0001 LOGICAL FUNCTION MATCH (HEDRNO, PATRN, HEADER) C C+ C C MATCH - Matches file headers selected for recovery. C C HEDRNO - Index file header number. C PATRN - 24 character match pattern ("?"=wild card): C C "gggmmmffffffffftttvvvvvv" C C g ( 1- 3) = Owner's group number C m ( 4- 6) = Owner's member number C f ( 7-15) = File name C t (16-18) = File type C v (19-24) = Version number C C All octal numbers not wild carded must have leading zeros. C C HEADER - Current file header (256 words). C C- C 0002 IMPLICIT INTEGER (A-Z) 0003 INTEGER*4 HEDRNO, USED, ALLOC 0004 INTEGER HEADER(256), IUSED(2), IALLOC(2) 0005 LOGICAL*1 NAME(24), PATRN(24), CHAR, QMARK 0006 LOGICAL*1 UIC(6), LUIC(2), LGROUP, LMEMBR, CRDATE(13) C 0007 EQUIVALENCE (USED, IUSED), (ALLOC, IALLOC), (UIC, NAME) 0008 EQUIVALENCE (IUIC, LUIC), (GROUP, LGROUP), (MEMBER, LMEMBR) C 0009 DATA QMARK/'?'/ C 0010 MATCH = .FALSE. C C... Insist on "027027 in first header word. 0011 IF (HEADER(1) .NE. "027027) GOTO 8100 C... If this header has never been used before, the creation date C... and modification date fields should be zeros. 0012 DO 1000 J = 30,42 0013 1000 IF (HEADER(J) .NE. 0) GOTO 1100 0014 GOTO 8100 C C... Convert UIC to two octal numbers 0015 1100 IUIC = HEADER(5) 0016 GROUP = 0 0017 LGROUP = LUIC(2) 0018 MEMBER = 0 0019 LMEMBR = LUIC(1) 0020 DO 1150 J = 3,1,-1 0021 UIC(J) = '0' + MOD(GROUP,8) 0022 GROUP = GROUP / 8 0023 UIC(J+3) = '0' + MOD(MEMBER,8) 0024 1150 MEMBER = MEMBER / 8 C C... Convert file name from RAD50 to ASCII 0025 CALL R50ASC(12,HEADER(24),NAME(7)) FORTRAN IV-PLUS V3.0-3 16:33:57 30-Sep-81 Page 14 UNDELETE.FTN;112 /RO/TR:ALL C... Convert version number to octal characters 0026 VERNO = HEADER(28) 0027 DO 1200 J = 24,19,-1 0028 NAME(J) = '0' + MOD(VERNO,8) 0029 1200 VERNO = VERNO / 8 C C... Attempt pattern match 0030 DO 2000 J = 1,24 0031 CHAR = PATRN(J) 0032 IF (CHAR .EQ. QMARK) GOTO 2000 0033 IF (CHAR .NE. NAME(J)) GOTO 8100 0034 2000 CONTINUE C C... Successful pattern match, type PIP-style directory info for user C 0035 IUSED(1) = HEADER(13) 0036 IUSED(2) = HEADER(12) 0037 IALLOC(1) = HEADER(11) 0038 IALLOC(2) = HEADER(10) 0039 CALL MOVSTR(13,HEADER,72,CRDATE,1) 0040 WRITE(5,501) HEDRNO, HEADER(3), NAME, USED, 1 (CRDATE(J), J = 1,11) 0041 501 FORMAT (' (', O6, ',', O6, '): [', 3A1, ',', 3A1, ']', 1 9A1, '.', 3A1, ';', 6A1, 3X, I6, '.', 3X, 2 2A1, '-', 3A1, '-', 2A1, 2X, 2A1, ':', 2A1) C C... NOTE: You may want to insert a query capability here as an option. C 0042 MATCH = .TRUE. C 0043 8100 RETURN C 0044 END FORTRAN IV-PLUS V3.0-3 16:33:57 30-Sep-81 Page 15 UNDELETE.FTN;112 /RO/TR:ALL PROGRAM SECTIONS Number Name Size Attributes 1 $CODE1 001172 317 RO,I,CON,LCL 2 $PDATA 000130 44 RO,D,CON,LCL 3 $IDATA 000062 25 RW,D,CON,LCL 4 $VARS 000072 29 RW,D,CON,LCL 5 $TEMPS 000002 1 RW,D,CON,LCL ENTRY POINTS Name Type Address Name Type Address Name Type Address Name Type Address Name Type Address MATCH L*2 1-000000 VARIABLES Name Type Address Name Type Address Name Type Address Name Type Address Name Type Address ALLOC I*4 4-000036 CHAR L*1 4-000046 GROUP I*2 4-000002 HEDRNO I*4 F-000002* IUIC I*2 4-000004 J I*2 4-000066 LGROUP L*1 4-000002 LMEMBR L*1 4-000000 MEMBER I*2 4-000000 QMARK L*1 4-000047 USED I*4 4-000042 VERNO I*2 4-000070 ARRAYS Name Type Address Size Dimensions CRDATE L*1 4-000050 000015 6 (13) HEADER I*2 F-000006* 001000 256 (256) IALLOC I*2 4-000036 000004 2 (2) IUSED I*2 4-000042 000004 2 (2) LUIC L*1 4-000004 000002 1 (2) NAME L*1 4-000006 000030 12 (24) PATRN L*1 F-000004* 000030 12 (24) UIC L*1 4-000006 000006 3 (6) LABELS Label Address Label Address Label Address Label Address Label Address 501' 2-000000 1000 ** 1100 1-000204 1150 ** 1200 ** 2000 1-000676 8100 1-001164 FUNCTIONS AND SUBROUTINES REFERENCED MOVSTR R50ASC Total Space Allocated = 001500 416 No FPP Instructions Generated FORTRAN IV-PLUS V3.0-3 16:34:00 30-Sep-81 Page 16 UNDELETE.FTN;112 /RO/TR:ALL 0001 LOGICAL FUNCTION ISUSED (LUN, HEDRNO, BUFFER, BLKNO, 1 WORDNO, MASK) C C+ C C ISUSED - Returns setting of bit number HEDRNO (I*4) in index file bitmap. C C LUN - Index file logical unit number C HEDRNO - Header number in question C BUFFER - Buffer to hold the index file bitmap block for HEDRNO C BLKNO - I*4 VBN of the bitmap block C WORDNO - FORTRAN index within BUFFER for the word containing C HEDRNOs bitmap C MASK - Integer mask for HEDRNOs bit in BUFFER(WORDNO) C C- C 0002 IMPLICIT INTEGER (A-Z) 0003 INTEGER*4 HEDRNO, BITNO, BLKNO 0004 INTEGER BUFFER(256), MASKS(16) C 0005 DATA MASKS/"000001,"000002,"000004, 1 "000010,"000020,"000040, 2 "000100,"000200,"000400, 3 "001000,"002000,"004000, 4 "010000,"020000,"040000, 5 "100000/ 0006 DATA ISSUC/1/ C C... Header number 1 is bit 0 in the bitmap 0007 BITNO = HEDRNO - 1 C... 4096 bits to a disk block starting at VBN 3 0008 BLKNO = 3 + (BITNO/4096) 0009 IF (GETBLK(LUN,BLKNO,BUFFER,IERR) .NE. ISSUC) GOTO 9900 0010 BITNO = MOD(BITNO,4096) C... Word in BUFFER and bit in word (corrected for FORTRAN array indexing) 0011 WORDNO = (BITNO/16) + 1 0012 BITNO = (MOD(BITNO,16)) + 1 C 0013 MASK = MASKS(BITNO) 0014 ISUSED = IAND(BUFFER(WORDNO),MASK) .NE. 0 C 0015 9000 RETURN C 0016 9900 WRITE(5,501) HEDRNO, IERR 0017 501 FORMAT (/' Error reading index file bitmap for header no. ', 1 I6, '.: ', I5/ 2 ' Recovery not attempted'/) 0018 ISUSED = .FALSE. 0019 GOTO 9000 C 0020 END FORTRAN IV-PLUS V3.0-3 16:34:00 30-Sep-81 Page 17 UNDELETE.FTN;112 /RO/TR:ALL PROGRAM SECTIONS Number Name Size Attributes 1 $CODE1 000514 166 RO,I,CON,LCL 2 $PDATA 000156 55 RO,D,CON,LCL 3 $IDATA 000026 11 RW,D,CON,LCL 4 $VARS 000050 20 RW,D,CON,LCL ENTRY POINTS Name Type Address Name Type Address Name Type Address Name Type Address Name Type Address ISUSED L*2 1-000000 VARIABLES Name Type Address Name Type Address Name Type Address Name Type Address Name Type Address BITNO I*4 4-000000 BLKNO I*4 F-000010* HEDRNO I*4 F-000004* IERR I*2 4-000046 ISSUC I*2 4-000044 LUN I*2 F-000002* MASK I*2 F-000014* WORDNO I*2 F-000012* ARRAYS Name Type Address Size Dimensions BUFFER I*2 F-000006* 001000 256 (256) MASKS I*2 4-000004 000040 16 (16) LABELS Label Address Label Address Label Address Label Address Label Address 501' 2-000000 9000 1-000420 9900 1-000426 FUNCTIONS AND SUBROUTINES REFERENCED GETBLK $JMOD Total Space Allocated = 000770 252 No FPP Instructions Generated