C C C C LIST File Listing Utility C ========================= C C Author: William P. Wood, Jr. C C Address: Computer Center C Institute For Cancer Research C 7701 Burholme Ave. C Philadelphia, Pa. 19111 C (215) 728 2760 C C Version: 3.0 C C Date: March 26, 1982 C C C C ******************************************************* C * * C * THIS SOFTWARE WAS DEVELOPED WITH SUPPORT * C * FROM THE NATIONAL INSTITUTES OF HEALTH: * C * NIH CA06927 * C * NIH CA22780 * C * * C * DIRECT INQUIRIES TO: * C * COMPUTER CENTER * C * THE INSTITUTE FOR CANCER RESEARCH * C * 7701 BURHOLME AVENUE * C * PHILADELPHIA, PENNSYLVANIA 19111 * C * * C * NO WARRANTY OR REPRESENTATION, EXPRESS OR * C * IMPLIED, IS MADE WITH RESPECT TO THE * C * CORRECTNESS, COMPLETENESS, OR USEFULNESS * C * OF THIS SOFTWARE, NOR THAT USE OF THIS * C * SOFTWARE MIGHT NOT INFRINGE PRIVATELY * C * OWNED RIGHTS. * C * * C * NO LIABILITY IS ASSUMED WITH RESPECT TO * C * THE USE OF, OR FOR DAMAGES RESULTING FROM * C * THE USE OF THIS SOFTWARE * C * * C ******************************************************* C C C define(VAX) # comment this out for PDP11 C Invoke LIST on wild card file names C note the order of the next several defines is significant! C Record or Block i/o. C or to "define(RECORDIO,#)" for block io C define(BLOCKIO,# BLOCK IO) C define(MARKSIZE,4) # size of buffer for mark/point C command line switch flags C defnam - provide defaults for file name, reset new defaults - C compatible with old version, doesn't return version number and C doesn't have special processing for asterisks SUBROUTINE DEFNAM(FILE, NODE, DEV, UIC, NAME, EXT, RESET) BYTE FILE(99) BYTE NODE(66), DEV(6), UIC(10), NAME(10), EXT(5), VER(7) LOGICAL RESET VER(1) = 0 CALL FPARSE(FILE, NODE, DEV, UIC, NAME, EXT, VER, RESET, .FALSE.) RETURN END C fparse - provide defaults for file name, reset new defaults. C if astrsk is true, asterisks only will use the defaults. SUBROUTINE FPARSE(FILE, NODE, DEV, UIC, NAME, EXT, VER, RESET, AST *RSK) BYTE FILE(99), TEMP(99) BYTE NODE(66), DEV(6), UIC(10), NAME(10), EXT(5), VER(7) LOGICAL RESET, ASTRSK INTEGER L, J, ICP, LEN INTEGER INDEXQ, BKSCNQ, CONCAT, SCAN TEMP(1) = 0 LEN = CONCAT(TEMP, FILE(SCAN(FILE, ' ', 1)), 99) FILE(1) = 0 J = 1 L = 0 ICP = INDEXQ(TEMP(J), ':') IF (.NOT.(ICP .NE. 0)) GOTO 2000 IF (.NOT.(TEMP(ICP+1) .EQ. ':')) GOTO 2020 ICP = ICP + 1 GOTO 2030 2020 CONTINUE ICP = 0 2030 CONTINUE 2000 CONTINUE CALL ADSTR(ICP, J, L, FILE, TEMP, NODE, 66 - 1, RESET, ASTRSK) CALL ADSTR(INDEXQ(TEMP(J), ':'), J, L, FILE, TEMP, DEV, 6 - 1, RES *ET, ASTRSK) CALL ADSTR(INDEXQ(TEMP(J), ']'), J, L, FILE, TEMP, UIC, 10 - 1, RE *SET, ASTRSK) CALL ADSTR(BKSCNQ(TEMP, ' .;', J) - J, J, L, FILE, TEMP, NAME, 10 *- 1, RESET, ASTRSK) CALL ADSTR(BKSCNQ(TEMP, ' ;', J) - J, J, L, FILE, TEMP, EXT, 5 - 1 *, RESET, ASTRSK) CALL ADSTR(LEN + 1 - J, J, L, FILE, TEMP, VER, 7 - 1, RESET, ASTRS *K) RETURN END C adstr - copy piece of file name for fparse SUBROUTINE ADSTR(I, J, L, FILE, TFILE, STR, MXSTR, RESET, ASTRSK) INTEGER I, J, L, MXSTR, K, IAST, CONCAT, SCAN, INDEXQ BYTE FILE(1), TFILE(1), STR(1) LOGICAL RESET, ASTRSK IF (.NOT.(I .EQ. 0 .AND. .NOT.ASTRSK)) GOTO 2040 L = CONCAT(FILE, STR, 99) GOTO 2050 2040 CONTINUE IF (.NOT.(I .NE. 0)) GOTO 2060 IF (.NOT.(ASTRSK)) GOTO 2080 IAST = INDEXQ(TFILE(J), '*') GOTO 2090 2080 CONTINUE IAST = 0 2090 CONTINUE IF (.NOT.(IAST .NE. 0 .AND. IAST .LE. I)) GOTO 2100 L = CONCAT(FILE, STR, 99) J = SCAN(TFILE, ' ', J + I) GOTO 2110 2100 CONTINUE K = MIN0(MXSTR, I) L = CONCAT(FILE, TFILE(J), L + 1 + K) J = SCAN(TFILE, ' ', J + I) IF (.NOT.(RESET)) GOTO 2120 CALL SCOPY(FILE, L + 1 - K, STR, 1) 2120 CONTINUE 2110 CONTINUE 2060 CONTINUE 2050 CONTINUE RETURN END