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 getnum - evaluate one line number expression LOGICAL FUNCTION GETNUM(F, LIN, I, BUF, BLEN, NUM, SSTAT) BYTE LIN(1), BUF(1), C INTEGER F, I, BLEN, SSTAT INTEGER*4NUM, PNUM, EOFLN LOGICAL GETN COMMON/CLIST/DOT, BCLDOT, TOPSCR, FOFF, FMAX, NXTREC, LSTRED, SAVD *OT, LOWC, HIGHC, TTCC, CC, OUTCC, MARKP, MRKINT, XSTAT, RANDAC, FL *AGS, MARKB, ERRBUF C current logical record INTEGER*4DOT C dot at beginning of command line INTEGER*4BCLDOT C top of last screen INTEGER*4TOPSCR C offset in file of logical line 1 INTEGER*4FOFF C highest line number of logical file INTEGER*4FMAX C next record on file INTEGER*4NXTREC C last record read INTEGER*4LSTRED C value of dot saved by the = command INTEGER*4SAVDOT C low value of record column range INTEGER LOWC C high value of record column range INTEGER HIGHC C carriagecontrol type of standard output INTEGER TTCC C carriagecontrol type of input file INTEGER CC C carriagecontrol type of output file INTEGER OUTCC C index of highest line number in markb INTEGER MARKP C interval in lines between file marks INTEGER MRKINT C exit status INTEGER XSTAT C .true. if input is random access device LOGICAL RANDAC C command line switch flags LOGICAL FLAGS(4) C points to every mrkint line in file INTEGER*2MARKB(3, 0:500) C buffer for constructing error messages BYTE ERRBUF(80) DATA XSTAT/1/ COMMON/TERM/SCRSIZ, SCRWID, SYSWID, HLF, AUTOCR C current screen size; init: SCRLENGTH INTEGER*4SCRSIZ C (SCRLENGTH = real screen length-1 = 23) C current screen width; init: syswid INTEGER SCRWID C screen width from terminal driver (see gttyp) INTEGER SYSWID C true if hardware after col 80 (see gttyp) LOGICAL HLF C true if term set for auto carriagereturn (see gttyp) LOGICAL AUTOCR NUM = 0 EOFLN = 0 SSTAT = 0 C = LIN(I) IF (.NOT.(C .EQ. '+' .OR. C .EQ. '-')) GOTO 2000 NUM = DOT 2000 CONTINUE 2020 CONTINUE IF (.NOT.(GETN(F, LIN, I, BUF, BLEN, PNUM, SSTAT, EOFLN))) GOTO *2050 NUM = NUM + PNUM GOTO 2060 2050 CONTINUE IF (.NOT.(C .EQ. '+')) GOTO 2070 NUM = NUM + (SCRSIZ + 1)/2 GOTO 2060 2070 CONTINUE IF (.NOT.(C .EQ. '-')) GOTO 2090 NUM = NUM - (SCRSIZ + 1)/2 GOTO 2060 2090 CONTINUE GETNUM = (.FALSE.) RETURN 2060 CONTINUE C = LIN(I) 2030 IF (.NOT.(C .NE. '+' .AND. C .NE. '-')) GOTO 2020 IF (.NOT.(EOFLN .NE. 0)) GOTO 2110 C had a search failure NUM = EOFLN 2110 CONTINUE GETNUM = (.TRUE.) RETURN END C getn - convert one term to line number LOGICAL FUNCTION GETN(F, LIN, I, BUF, BLEN, PNUM, SSTAT, EOFLN) BYTE LIN(1), BUF(1), DELIM, CUPPER INTEGER F, I, J, BLEN, SSTAT, MUL, SCAN, INDEXX INTEGER*4PNUM, EOFLN, PTSCAN, BACKSC LOGICAL MAKPAT COMMON/CLIST/DOT, BCLDOT, TOPSCR, FOFF, FMAX, NXTREC, LSTRED, SAVD *OT, LOWC, HIGHC, TTCC, CC, OUTCC, MARKP, MRKINT, XSTAT, RANDAC, FL *AGS, MARKB, ERRBUF C current logical record INTEGER*4DOT C dot at beginning of command line INTEGER*4BCLDOT C top of last screen INTEGER*4TOPSCR C offset in file of logical line 1 INTEGER*4FOFF C highest line number of logical file INTEGER*4FMAX C next record on file INTEGER*4NXTREC C last record read INTEGER*4LSTRED C value of dot saved by the = command INTEGER*4SAVDOT C low value of record column range INTEGER LOWC C high value of record column range INTEGER HIGHC C carriagecontrol type of standard output INTEGER TTCC C carriagecontrol type of input file INTEGER CC C carriagecontrol type of output file INTEGER OUTCC C index of highest line number in markb INTEGER MARKP C interval in lines between file marks INTEGER MRKINT C exit status INTEGER XSTAT C .true. if input is random access device LOGICAL RANDAC C command line switch flags LOGICAL FLAGS(4) C points to every mrkint line in file INTEGER*2MARKB(3, 0:500) C buffer for constructing error messages BYTE ERRBUF(80) DATA XSTAT/1/ GETN = .TRUE. MUL = + 1 IF (.NOT.(LIN(I) .EQ. '-')) GOTO 2130 MUL = - 1 I = I + 1 GOTO 2140 2130 CONTINUE IF (.NOT.(LIN(I) .EQ. '+')) GOTO 2150 I = I + 1 2150 CONTINUE 2140 CONTINUE I2170 = (LIN(I)) GOTO 2170 2190 CONTINUE GETN = .FALSE. GOTO 2180 2200 CONTINUE PNUM = DOT I = I + 1 GOTO 2180 2210 CONTINUE PNUM = BCLDOT I = I + 1 GOTO 2180 2220 CONTINUE DOT = 2147483647 C only position to $ if necessary IF (.NOT.(I .EQ. 1 .OR. (INDEXX('?PpGgFf', LIN(I+1)) .EQ. 0 .AND *. LIN(I+1) .NE. 0))) GOTO 2230 CALL POSIT(F) GOTO 2240 2230 CONTINUE IF (.NOT.(LIN(I-1) .NE. ',')) GOTO 2250 CALL POSIT(F) 2250 CONTINUE 2240 CONTINUE PNUM = DOT - 1 I = I + 1 GOTO 2180 2270 CONTINUE PNUM = TOPSCR I = I + 1 GOTO 2180 2280 CONTINUE PNUM = SAVDOT I = I + 1 GOTO 2180 2290 CONTINUE DELIM = LIN(I) IF (.NOT.(.NOT.MAKPAT(LIN, I, DELIM))) GOTO 2300 C build the pattern GETN = .FALSE. GOTO 2310 2300 CONTINUE IF (.NOT.(DELIM .EQ. '/')) GOTO 2320 PNUM = PTSCAN(F, BUF, BLEN, 2147483647 - 1) IF (.NOT.(PNUM .EQ. -10)) GOTO 2340 SSTAT = SSTAT .OR. (1) EOFLN = DOT PNUM = EOFLN 2340 CONTINUE GOTO 2330 2320 CONTINUE PNUM = BACKSC(F, BUF, BLEN) IF (.NOT.(PNUM .EQ. -10)) GOTO 2360 SSTAT = SSTAT .OR. (2) EOFLN = 1 PNUM = EOFLN 2360 CONTINUE 2330 CONTINUE 2310 CONTINUE GOTO 2180 2380 CONTINUE J = SCAN(LIN, '1234567890', I) IF (.NOT.(I .NE. J)) GOTO 2390 DECODE(J-I, 2410, LIN(I), ERR=10) PNUM 2410 FORMAT(I) I = J GOTO 2400 2390 CONTINUE GETN = .FALSE. 2400 CONTINUE GOTO 2180 2170 CONTINUE IF (I2170 .EQ. 0) GOTO 2190 IF (I2170 .EQ. 35) GOTO 2210 IF (I2170 .EQ. 36) GOTO 2220 IF (I2170 .EQ. 42) GOTO 2280 IF (I2170 .EQ. 46) GOTO 2200 IF (I2170 .EQ. 47) GOTO 2290 IF (I2170 .EQ. 64) GOTO 2270 IF (I2170 .EQ. 92) GOTO 2290 GOTO 2380 2180 CONTINUE PNUM = PNUM*MUL RETURN 10 CONTINUE CALL ERR(LIN, I, 'Number too large.') GETN = (.FALSE.) RETURN END C makpat - make pattern if specified at lin(i) LOGICAL FUNCTION MAKPAT(LIN, I, DELIM) BYTE LIN(1), DELIM INTEGER I, WPSTAT, WPAT COMMON/PAT/SNULL, SRCHST C .false. if srchst is valid; .true. otherwise LOGICAL SNULL C holds current search string BYTE SRCHST(268) BYTE SPCIAL(17) DATA SPCIAL(1)/32/,SPCIAL(2)/42/,SPCIAL(3)/63/,SPCIAL(4)/124/,SPCI *AL(5)/38/,SPCIAL(6)/126/,SPCIAL(7)/37/,SPCIAL(8)/36/,SPCIAL(9)/94/ *,SPCIAL(10)/34/,SPCIAL(11)/96/,SPCIAL(12)/64/,SPCIAL(13)/35/,SPCIA *L(14)/60/,SPCIAL(15)/62/,SPCIAL(16)/44/,SPCIAL(17)/0/ DATA SNULL/.TRUE./ I = I + 1 IF (.NOT.(LIN(I) .EQ. 0 .OR. LIN(I) .EQ. DELIM)) GOTO 2420 C use previous pattern IF (.NOT.(LIN(I) .EQ. DELIM)) GOTO 2440 I = I + 1 2440 CONTINUE IF (.NOT.(SNULL)) GOTO 2460 CALL ERR(LIN, I - 1, 'Current search string is null.') LIN(I) = - 1 2460 CONTINUE GOTO 2430 2420 CONTINUE SPCIAL(1) = DELIM WPSTAT = WPAT(LIN, I, SPCIAL, SRCHST, 134*2) IF (.NOT.(WPSTAT .EQ. 1)) GOTO 2480 SNULL = .FALSE. GOTO 2490 2480 CONTINUE IF (.NOT.(WPSTAT .EQ. 2)) GOTO 2500 CALL ERR(LIN, I, 'Pattern too long.') GOTO 2510 2500 CONTINUE CALL ERR(LIN, I, 'Bad column range.') 2510 CONTINUE SNULL = .TRUE. 2490 CONTINUE 2430 CONTINUE MAKPAT = (.NOT.SNULL) RETURN END C ptscan - scan for next occurrence of pattern INTEGER*4 FUNCTION PTSCAN(F, BUF, BLEN, MXSRCH) BYTE BUF(1) INTEGER F, BLEN INTEGER*4MXSRCH INTEGER GETINP, WSRCH COMMON/CLIST/DOT, BCLDOT, TOPSCR, FOFF, FMAX, NXTREC, LSTRED, SAVD *OT, LOWC, HIGHC, TTCC, CC, OUTCC, MARKP, MRKINT, XSTAT, RANDAC, FL *AGS, MARKB, ERRBUF C current logical record INTEGER*4DOT C dot at beginning of command line INTEGER*4BCLDOT C top of last screen INTEGER*4TOPSCR C offset in file of logical line 1 INTEGER*4FOFF C highest line number of logical file INTEGER*4FMAX C next record on file INTEGER*4NXTREC C last record read INTEGER*4LSTRED C value of dot saved by the = command INTEGER*4SAVDOT C low value of record column range INTEGER LOWC C high value of record column range INTEGER HIGHC C carriagecontrol type of standard output INTEGER TTCC C carriagecontrol type of input file INTEGER CC C carriagecontrol type of output file INTEGER OUTCC C index of highest line number in markb INTEGER MARKP C interval in lines between file marks INTEGER MRKINT C exit status INTEGER XSTAT C .true. if input is random access device LOGICAL RANDAC C command line switch flags LOGICAL FLAGS(4) C points to every mrkint line in file INTEGER*2MARKB(3, 0:500) C buffer for constructing error messages BYTE ERRBUF(80) DATA XSTAT/1/ COMMON/PAT/SNULL, SRCHST C .false. if srchst is valid; .true. otherwise LOGICAL SNULL C holds current search string BYTE SRCHST(268) PTSCAN = - 10 CALL POSIT(F) 2520 IF (.NOT.(DOT .LE. MXSRCH)) GOTO 2540 IF (.NOT.(GETINP(F, BUF, BLEN) .EQ. -10)) GOTO 2550 GOTO 2540 2550 CONTINUE IF (.NOT.(WSRCH(BUF, BLEN, SRCHST) .NE. 0)) GOTO 2570 PTSCAN = DOT GOTO 2540 2570 CONTINUE 2560 CONTINUE 2530 DOT = DOT + 1 GOTO 2520 2540 CONTINUE RETURN END C backsc - search backwards for pattern INTEGER*4 FUNCTION BACKSC(F, BUF, BLEN) BYTE BUF(1) INTEGER F, BLEN INTEGER*4MX, SDOT, NUM INTEGER*4PTSCAN COMMON/CLIST/DOT, BCLDOT, TOPSCR, FOFF, FMAX, NXTREC, LSTRED, SAVD *OT, LOWC, HIGHC, TTCC, CC, OUTCC, MARKP, MRKINT, XSTAT, RANDAC, FL *AGS, MARKB, ERRBUF C current logical record INTEGER*4DOT C dot at beginning of command line INTEGER*4BCLDOT C top of last screen INTEGER*4TOPSCR C offset in file of logical line 1 INTEGER*4FOFF C highest line number of logical file INTEGER*4FMAX C next record on file INTEGER*4NXTREC C last record read INTEGER*4LSTRED C value of dot saved by the = command INTEGER*4SAVDOT C low value of record column range INTEGER LOWC C high value of record column range INTEGER HIGHC C carriagecontrol type of standard output INTEGER TTCC C carriagecontrol type of input file INTEGER CC C carriagecontrol type of output file INTEGER OUTCC C index of highest line number in markb INTEGER MARKP C interval in lines between file marks INTEGER MRKINT C exit status INTEGER XSTAT C .true. if input is random access device LOGICAL RANDAC C command line switch flags LOGICAL FLAGS(4) C points to every mrkint line in file INTEGER*2MARKB(3, 0:500) C buffer for constructing error messages BYTE ERRBUF(80) DATA XSTAT/1/ BACKSC = - 10 MX = DOT - 1 SDOT = ((MX - 1)/MRKINT)*MRKINT + 1 2590 IF (.NOT.(MX .GT. 0)) GOTO 2600 C search backwards in "mark interval" line chunks DOT = SDOT NUM = - 10 2610 CONTINUE BACKSC = NUM NUM = PTSCAN(F, BUF, BLEN, MX) DOT = DOT + 1 2620 IF (.NOT.(NUM .EQ. -10)) GOTO 2610 IF (.NOT.(BACKSC .NE. -10)) GOTO 2640 GOTO 2600 2640 CONTINUE MX = SDOT - 1 SDOT = SDOT - MRKINT GOTO 2590 2600 CONTINUE IF (.NOT.(BACKSC .EQ. -10)) GOTO 2660 DOT = 1 GOTO 2670 2660 CONTINUE DOT = BACKSC 2670 CONTINUE RETURN END C replac - replace occurrences of "char" in "lin" with "text" LOGICAL FUNCTION REPLAC(CHAR, TEXT, LIN, SIZE, I) INTEGER SIZE, I, TEXTL, LINL INTEGER LENGTH C length(lin(i)) <= 2*MAXLINE! BYTE CHAR(1), TEXT(1), LIN(1), TEMP(268) LOGICAL CHSCAN REPLAC = .TRUE. LINL = LENGTH(LIN) TEXTL = LENGTH(TEXT) 2680 IF (.NOT.(CHSCAN(LIN, I, CHAR))) GOTO 2690 IF (.NOT.(TEXTL+LINL .GT. SIZE)) GOTO 2700 REPLAC = .FALSE. GOTO 2690 2700 CONTINUE LINL = LINL + TEXTL - 1 CALL SCOPY(LIN, I + 1, TEMP, 1) CALL SCOPY(TEXT, 1, LIN, I) I = I + TEXTL CALL SCOPY(TEMP, 1, LIN, I) GOTO 2680 2690 CONTINUE IF (.NOT.(REPLAC)) GOTO 2720 I = 1 2720 CONTINUE RETURN END C chscan - scan "lin" for "char", ignoring occurrences within file names, C double quoted strings, and search patterns LOGICAL FUNCTION CHSCAN(LIN, I, CHAR) INTEGER I, NUQCP BYTE LIN(1), CHAR, DELIM, CUPPER LOGICAL INPAT CHSCAN = .FALSE. INPAT = .FALSE. I = NUQCP(LIN, I) 2740 IF (.NOT.(LIN(I) .NE. 0)) GOTO 2760 IF (.NOT.(INPAT)) GOTO 2770 IF (.NOT.(LIN(I) .EQ. DELIM .AND. LIN(I-1) .NE. '^')) GOTO 279 *0 INPAT = .FALSE. 2790 CONTINUE GOTO 2780 2770 CONTINUE IF (.NOT.(LIN(I) .EQ. '/' .OR. LIN(I) .EQ. '\')) GOTO 2810 DELIM = LIN(I) INPAT = .TRUE. GOTO 2780 2810 CONTINUE IF (.NOT.(CUPPER(LIN(I)) .EQ. CHAR)) GOTO 2830 CHSCAN = .TRUE. GOTO 2760 2830 CONTINUE IF (.NOT.(LIN(I) .EQ. '>')) GOTO 2850 GOTO 2760 2850 CONTINUE 2780 CONTINUE 2750 I = NUQCP(LIN, I + 1) GOTO 2740 2760 CONTINUE RETURN END C findrp - find matching right paren LOGICAL FUNCTION FINDRP(COMAND, CP, RP) BYTE COMAND(1) INTEGER CP, RP, LP LOGICAL CHSCAN RP = CP LP = RP + 1 2870 CONTINUE IF (.NOT.(.NOT.CHSCAN(COMAND, RP, ')'))) GOTO 2900 FINDRP = (.FALSE.) RETURN 2900 CONTINUE IF (.NOT.(.NOT.CHSCAN(COMAND, LP, '('))) GOTO 2920 FINDRP = (.TRUE.) RETURN 2920 CONTINUE IF (.NOT.(LP .GT. RP)) GOTO 2940 FINDRP = (.TRUE.) RETURN 2940 CONTINUE 2880 RP = RP + 1 LP = LP + 1 GOTO 2870 END