C PROGRAM TO SEARCH A DEVICE DIRECTORY FOR A REQUESTED FILENAME AND RETURN ITS C NAME, # OF BLOCKS, DATE AND DEVICE WHERE DIRECTORY ENTRY WAS FOUND. THEN C THE DEVICE IS SCANNED FOR '*.DEV' FILES (SUBDEVICES) AND THEIR INDIVIDUAL C DIRECTORIES ARE SCANNED FOR FILENAME. C C THIS PROGRAM ALLOWS A LARGE DISK VOLUME CONTAINING SEVERAL SUBDEVICES TO C SCANNED FOR A FILENAME. THE PROGRAM RETURNS THE USUAL DIRECTORY C INFORMATION PLUS WHAT DEVICE OR SUBDEVICE THE FILE WAS FOUND ON. C C FILED BY GLENN BEVER--14-FEB-83. (HAPPY VALENTINE'S DAY!) C WILD CARD SEARCHES IMPROVED--5-APR-83, G. BEVER. C '/V' OPTION ADDED--8-APR-83, G. BEVER. C 'E:EXT' OPTION ADDED--9-JUL-84, G. BEVER. C SYSTEM IDENTIFICATION CHECK ADDED--31-0CT-84, G. BEVER. C C NASA DFRF C P.O. BOX 273 C EDWARDS, CA 93523 C C COMPILE AS FOLLOWS: C C .FORTRA SDIR C C LINK AS FOLLOWS: C C .LINK SDIR,NAMCMP C C REQUIRES LINKAGE WITH 'IRAM.OBJ' IF IT HAS NOT BEEN PUT IN 'SYSLIB.OBJ'. C C C CALL COMMAND STRING INTERPRETER TO GET DEVICE NAMES. C *TT:=DEV:FILE.NAM C C WHERE 'FILE.NAM' IS THE FILE TO SEARCH THE DIRECTORY FOR. C AND 'DEV:' IS THE DISK CONTAINING THE DIRECTORY TO SCAN C FOR 'FILE.NAM' AND SUBDIRECTORIES '*.DEV' TO SCAN FOR 'FILE.NAM'. C C */H C WILL PRINT OUT HELP FOR USING THIS PROGRAM. C C *DEV:FILE.NAM C WILL DEFAULT LIST TO LOGICAL UNIT 7 (TT:). C C*******KNOWN BUGS (IN PROGRAM)********** C 1) BOTH NAME AND EXTENT FIELD MUST HAVE THEIR OWN WILDCARD. C E.G.: C *.* * C WIL*.* INSTEAD OF WIL* C *.*D *D C C*******KNOWN BUGS (IN SUBROUTINE NAMCMP)********** C 1) REPEATED CHARACTER STRING COMPARE PROBLEM. E.G.: C IF '*FER.*' IS ENTERED AND 'BUFFER.COM' IS ENCOUNTERED, IT WILL NOT C REPORT IT AS A MATCH. THE ALGORITHM STARTS COMPARING CHARACTER C STRING 'FER' WITH THE 1ST 'F' IN 'BUFFER', HENCE, IT SEES 'FFE' C AND NOT 'FER'. C C 2) IF 5 CHARACTERS ARE ENTERED AND THE 6TH IS '*', NO MATCH WILL BE C REPORTED. E.G.: C 'BUFFE*.COM' REQUESTED WILL NOT FIND 'BUFFER.COM'. C C************************************************** C BUG SUMMARY: ALL PERMUTATIONS OF WILDCARD COMPARES DON'T WORK. C************************************************** C INTEGER*2 JNUM(2) INTEGER*2 ISPEC(39),JSWI(4,5) INTEGER*2 IVOL(6),IOWN(6),IDUM(6) REAL*4 EXT(2) INTEGER*2 PASSIN(3),PASOUT(5),IBUF(512),IBUF1(512),IN(3), C DEVICE(6) BYTE NAMDEV(12),NAME(9) DATA EXT/6RDEVLST,6RDATDAT/ DATA JSWI/'H',3*0,'V',3*0,'E',3*0,'A',3*0,'S',3*0/,IDIF/0/ C NOTE: 'A' & 'S' CURRENTLY UNUSED. INUM=0 C CALL COMMAND STRING INTERPRETER TO GET FILE NAMES. 5 IF(ICSI(ISPEC,EXT,,JSWI,5).NE.0) GO TO 5 C ASSIGN LOGICAL UNIT 7 TO 1ST OUTPUT FILE ENTERED. CALL IASIGN(7,ISPEC(1),ISPEC(2),0,0) C IF '/H' SWITCH NOT HIT, GO TO 6. IF(JSWI(2,1).EQ.0) GO TO 9 C HELP OUTPUT. WRITE(7,105) 105 FORMAT(' */H PRINTS THIS TEXT.'/ C ' *LP:=DEV:FILE.NAM SEARCHES "DEV:" & ALL SUBDEVICES'/ C ' ON IT FOR "FILE.NAM."'/ C ' PRINTS ON LP:'/ C ' *FILE.* SEARCHES FOR "FILE.*". PRINTS ON TT:.'/ C ' *TT:=*.NAM SEARCHES FOR "*.NAM". PRINTS ON TT:.'/ C ' .RU SDIR *.NAM SEARCHES FOR "*.NAM" FILES.'/ C ' PRINTS ON TT:.'/ C ' .RU SDIR *.NAM LP: SEARCHES FOR "*.NAM" FILES.'/ C ' PRINTS ON LP:.'/ C ' .RU SDIR DEV:/V PRINTS OUT VOLUME IDs FOR ALL'/ C ' SUBDEVICES ON "DEV:"'/ C ' .RU SDIR SEARCHES "DEV:" & "DEV:*.DSK" '/ C ' *DEV:FILE.NAM/E:DSK SUBDEVICES FOR "FILE.NAM."'/ C ' .SDIR DEV:FILE.NAM SEARCHES "DEV:" & ALL SUBDEVICES'/ C ' ENCOUNTERED ON IT FOR "FILE.NAM"'/ C ' (RT-11 V5 ONLY)'/) GO TO 5 ! CALL COMMAND STRING INTERPRETER AGAIN. C C GET FILE NAME TO SEARCH FOR. 9 PASSIN(1)=ISPEC(17) PASSIN(2)=ISPEC(18) PASSIN(3)=ISPEC(19) C NULL OUT FILE NAME SO AS TO OPEN THE DEVICE NON-STRUCTURED. ISPEC(17)="000000 ISPEC(18)="000000 ISPEC(19)="000000 C SET 'IBK' TO INDICATE 1ST CALL TO 'RTDIR'. IBK=0 C SET TO SEARCH DEVICE. DEVICE(1)=ISPEC(16) C SEARCH DEVICE 1ST (BEFORE SEARCHING SUBDEVICES). DEVICE(2)="000000 DEVICE(3)="000000 DEVICE(4)="000000 C C CONVERT FOUND DEVICE FILE NAME TO ASCII. CALL R50ASC(12,DEVICE,NAMDEV) C GO TO 8 C ASSIGN '*.DEV' TO FILE NAME REQUEST. 7 IN(1)="132500 IN(2)="000000 IN(3)="132500 IF(JSWI(2,3).EQ.2) IN(3)=JSWI(4,3)! IF /E OPTION, ASSIGN IT TO IN(3). C CALL ROUTINE TO FIND DIRECTORY ENTRY '*.DEV', '*.*' (/A) OR '*.xxx' (/E:xxx). CALL RTDIR(ISPEC(16),IN,DEVICE(2),MORE,IBK,IND,IBUF1,ICH, C IVOL,IOWN) IF(DEVICE(5).LT.6) GO TO 7 ! IF FILE < 6 BLKS, CAN'T BE SUBDEVICE. C IF FILE NOT FOUND, GO TO 20. IF(MORE.EQ.0) GO TO 20 C IF NOT RT-11 VOLUME, IGNORE. IF(MORE.EQ.-1) GO TO 7 C CONVERT FOUND DEVICE FILE NAME TO ASCII. CALL R50ASC(12,DEVICE,NAMDEV) C C CHECK FOR '/V' OPTION. IF(JSWI(2,2).EQ.0) GO TO 8 ! IF NO /V OPTION, GO TO 8. C GET VOLID ONLY. IBLK=0 CALL RTDIR(DEVICE,PASSIN,PASOUT,MORE,IBLK,INDEX,IBUF,ICHAN, C IVOL,IOWN) C IF(MORE.EQ.-1) GO TO 7 ! IF NOT RT-11 VOLUME, DON'T PRINT. WRITE(7,106)(NAMDEV(I),I=1,12),(IVOL(I),I=1,6),(IOWN(I),I=1,6) 106 FORMAT(1X,3A1,':',6A1,'.',3A1,2X,6A2,1X,6A2) GO TO 7 ! GET NEXT '*.DEV' FILE. C C SET 'IBLK' TO INDICATE 1ST CALL TO 'RTDIR'. 8 IBLK=0 C CALL ROUTINE TO FIND DIRECTORY ENTRY OF FILE.NAM. 10 CALL RTDIR(DEVICE,PASSIN,PASOUT,MORE,IBLK,INDEX,IBUF,ICHAN, C IVOL,IOWN) C IF FILE NOT FOUND, GO TO 7. IF(MORE.LE.0) GO TO 7 C CONVERT FILE NAME FROM RAD50 TO ASCII. CALL R50ASC(10,PASOUT,NAME) C CONVERT DATE. CALL DATCNV(PASOUT(5),IDAY,RMON,IYR) C IF FILE DIRECTORY ENTRY HAD NO DATE, GO TO 19. IF(IDAY.EQ.0.AND.IYR.EQ.0) GO TO 19 C OUTPUT DIRECTORY INFORMATION TO LOGICAL UNIT 7. WRITE(7,103)(NAME(I),I=1,9),PASOUT(4),IDAY,RMON,IYR, C (NAMDEV(I),I=1,12),(IVOL(I),I=1,6),(IOWN(I),I=1,6) 103 FORMAT(1X,6A1,'.',3A1,I6,2X,I2,'-',A3,'-',I2,5X, C 3A1,':',6A1,'.',3A1,2X,6A2,1X,6A2) C LOOK FOR MORE IN FILE. GO TO 10 C OUTPUT DIRECTORY INFORMATION TO LOGICAL UNIT 7 (NO DATE). 19 WRITE(7,104)(NAME(I),I=1,9),PASOUT(4), C (NAMDEV(I),I=1,12),(IVOL(I),I=1,6),(IOWN(I),I=1,6) 104 FORMAT(1X,6A1,'.',3A1,I6,2X,9X,5X, C 3A1,':',6A1,'.',3A1,2X,6A2,1X,6A2) C LOOK FOR MORE IN FILE. GO TO 10 C GET NEXT COMMAND. 20 TYPE 110 ! PRINT CR,LF. 110 FORMAT(1X,/) REWIND 7 ! CLEAR OUTPUT BUFFER. CALL CLOSE(7) ! RELEASE LU 7 DEFINITION. GO TO 5 END SUBROUTINE RTDIR(DEVICE,PASSIN,PASOUT,MORE,IBLK,INDEX,IBUF,ICHAN, C IVOL,IOWN) C SUBROUTINE TO LOOK FOR A FILE NAME IN DIRECTORY AND RETURN IT'S DATE AND C NUMBER OF BLOCKS, AS WELL AS THE DEVICE ON WHICH IT WAS FOUND. C C CALL AS: C C CALL RTDIR(DEVICE,PASSIN,PASOUT,MORE,IBLK,INDEX,IBUF,ICHAN, C C IVOL,IOWN) C WHERE: C I DEVICE= DEVICE (OR SUBDEVICE FILE NAME) ON WHICH DIRECTORY IS CHECKED. C I PASSIN= FILE NAME ARRAY OF 3 RAD50 WORDS. FILE TO SEARCH FOR. C O PASOUT= (1-3) RETURNED FILE NAME (RAD50). C (4) NUMBER OF BLOCKS. C (5) DATE OF FILE. C O MORE= -1-> SUBDEVICE IS NOT RT-11 VOLUME. C O 0-> FILE NOT FOUND IN DIRECTORY. C 1-> FILE FOUND. C I/O IBLK= CURRENT BLOCK # OF DEVICE DIRECTORY BEING ACCESSED. C MUST BE ZERO FOR 1ST ENTRY. C O INDEX= CURRENT WORD # IN BLOCK. C O IBUF= 512 WORD BUFFER TO STORE DIRECTORY SEGMENT. C O ICHAN= RT-11 CHANNEL REFERENCE NUMBER TO DIRECTORY FILE. C O IVOL= 12 CHARACTER VOLUME IDENTIFIER. C O IOWN= 12 CHARACTER OWNER IDENTIFIER. C C I-> INPUT TO SUBROUTINE. O-> OUTPUT (RETURNED) FROM SUBROUTINE. INTEGER*2 PASSIN(3),PASOUT(5),IBUF(512),DEVICE(4),ICOMP(6) INTEGER*2 IVOL(6),IOWN(6) DATA ICOMP/'DE','CR','T1','1A',' ',' '/ C IF THIS IS NOT 1ST CALL, GO TO 15. IF(IBLK.NE.0) GO TO 15 C GET A CHANNEL NUMBER. ICHAN=IGETC() IF(ICHAN.LT.0) STOP 'NO CHANNEL' C FETCH INPUT DEVICE HANDLER INTO MEMORY. IF(IFETCH(DEVICE(1)).NE.0) STOP 'BAD FETCH' C PERFORM LOOKUP OF INPUT FILE. I=LOOKUP(ICHAN,DEVICE(1)) IF(I.LT.0) GO TO 500 C C VERIFY THAT IT IS RT-11 VOLUME. IBLK=1 I=IREADW(256,IBUF,IBLK,ICHAN) IF(I.EQ.-1) GO TO 9999 ! PAST EOF. IF(I.LT.-1) GO TO 51 ! BAD READ. DO 11 J=1,6 IF(IBUF(J+"756/2+1).NE.ICOMP(J)) GO TO 57 ! NOT RT-11, SO RETURN. 11 CONTINUE C GET VOLUME ID, OWNER. DO 4 J=1,6 IVOL(J)=IBUF(J+"726/2+1 ) 4 IOWN(J)=IBUF(J+"742/2+1) IBLK=6 ! STARTING BLOCK OF DIRECTORY. C READ 1ST DIRECTORY SEGMENT (2 BLOCKS). 10 I=IREADW(256,IBUF,IBLK,ICHAN) IF(I.EQ.-1) GO TO 9999 ! PAST EOF. IF(I.LT.-1) GO TO 51 ! BAD READ. I=IREADW(256,IBUF(257),IBLK+1,ICHAN) IF(I.EQ.-1) GO TO 9999 ! PAST EOF. IF(I.LT.-1) GO TO 51 ! BAD READ. INDEX=6 ! BYTE OFFSET OF 1ST DIRECTORY ENTRY. C ASSIGN HEADER INFORMATION. 15 NSEG=IBUF(1) ! NUMBER OF DIRECTORY SEGMENTS (2 BLOCKS EACH). NXTSEG=IBUF(2) ! NEXT SEGMENT NUMBER. 0 -> THIS IS LAST ONE. NHISEG=IBUF(3) ! HIGHEST SEGMENT IN USE. NEXTRA=IBUF(4) ! # EXTRA BYTES USED IN EACH DIR ENTRY (USER DEFINED). IBK1ST=IBUF(5) ! STARTING BLK # OF DATA MONITORED BY THIS SEGMENT. MUL=NEXTRA+7 ! LENGTH OF EACH DIRECTORY ENTRY. C IF TERMINATION OF SEGMENT, GO TO 55. 16 IF(IBUF(INDEX).EQ."4000) GO TO 55 C IF NON-PERMANENT ENTRY, GO TO 50. IF(IBUF(INDEX).NE."2000.AND.IBUF(INDEX).NE."102000) GO TO 50 C PERMANENT ENTRY. C COMPARE DESIRED TO FOUND FILE NAMES. C IF FILE NAMES NOT THE SAME, GO TO 50. I=NAMCMP(PASSIN(1),IBUF(INDEX+1),6) ! CHECK FILE NAME. J=NAMCMP(PASSIN(3),IBUF(INDEX+3),3) ! CHECK EXTENT. IF(I.EQ.0.OR.J.EQ.0) GO TO 50 ! IF EITHER DOESN'T COMPARE, GO TO 50. C FILE FOUND. 19 PASOUT(1)=IBUF(INDEX+1) ! RETURN FILE NAME. PASOUT(2)=IBUF(INDEX+2) PASOUT(3)=IBUF(INDEX+3) PASOUT(4)=IBUF(INDEX+4) ! RETURN NUMBER OF BLOCKS. PASOUT(5)=IBUF(INDEX+6) ! RETURN DATE. C ARE MORE ENTRIES IN DIRECTORY. 47 MORE=1 ! 'MORE IN DIRECTORY' FLAG. INDEX=INDEX+MUL ! POINT INDEX TO NEXT DIRECTORY ENTRY. GO TO 400 C TRY NEXT DIRECTORY ENTRY. 50 INDEX=INDEX+MUL ! POINT INDEX TO NEXT DIRECTORY ENTRY. IF(INDEX.LE.512) GO TO 16 ! IF NOT AT BLOCK END, GO TO 16. C NEW DIRECTORY SEGMENT NEED. 55 IBLK=NXTSEG*2+4 ! CALCULATE BLOCK # OF NEXT DIRECTORY SEGMENT. IF(NXTSEG.EQ.0) GO TO 60 ! IF NO MORE SEGMENTS, GO TO 60. GO TO 10 ! ELSE GET NEXT DIRECTORY SEGMENT. 57 MORE=-1 ! NOT RT-11 VOLUME. GO TO 65 C END OF DIRECTORY FOUND. 60 MORE=0 ! 'NO MORE IN DIR.' FLAG. (FILE NOT FOUND). 65 CALL CLOSEC(ICHAN) ! CLOSE CHANNEL. CALL IFREEC(ICHAN) ! FREE IT FOR OTHER USE. 400 RETURN C ERROR PRINTOUT AREA. 51 TYPE 101,I 101 FORMAT(1X,I7,'BAD READ') STOP 9999 STOP 'INVALID BLOCK, PAST END OF FILE' 500 TYPE 100,I 100 FORMAT(1X,I7) STOP 'BAD LOOKUP' END SUBROUTINE DATCNV(IDAT,IDAY,RMON,IYR) C SUBROUTINE TO CONVERT RT-11 INTERNAL TIME FORMAT TO 'DA-MON-YR' FORMAT. C CALL AS: C C CALL DATCNV(IDAT,IDAY,RMON,IYR) C WHERE: C I IDAT= INTERNAL FORMATTED TIME. C O IDAY= INTEGER DAY (0-31). C O RMON= (REAL) ASCII MONTH ('Jan'-'Dec' or ' ') C O IYR= INTEGER YEAR (0-99). C C I-> INPUT TO SUBROUTINE. O-> OUTPUT (RETURNED) FROM SUBROUTINE. REAL*4 TABLE(13),RMON DATA TABLE/'Jan ','Feb ','Mar ','Apr ','May ','Jun ','Jul','Aug ', C 'Sep ','Oct ','Nov ','Dec ',' '/ IF(IDAT.NE.0) GO TO 10 C NO DATE FOUND (IDAT=0). IDAY=0 ! SET DAY TO 00. RMON=TABLE(13) ! SET MONTH TO ' '. IYR=0 ! SET YEAR TO 00. RETURN C DATE FOUND. 10 MON=IRAM(IDAT,10,"17) ! GET MONTH TABLE INDEX. RMON=TABLE(MON) ! RE-FORMAT MONTH. IDAY=IRAM(IDAT,5,"37) ! RE-FORMAT DAY. IYR=IRAM(IDAT,0,"37)+72 ! RE-FORMAT YEAR. RETURN END