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 (6) TIME OF FILE (TSX+ CREATED FILES ONLY). 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. C C TSX+ TIME OF DAY ADDED--3-JAN-86, G. BEVER. C INTEGER*2 PASSIN(3),PASOUT(6),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(6)=IBUF(INDEX+5) ! RETURN TIME (TSX+ CREATED FILES ONLY). 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