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: December 29, 1981 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) C note the order of the next several defines is significant! C ICR ONLY define(NOTICR,# NOT ICR) C Local ICR functions supported by LIST: C Invoke LIST on wild card file names C Route output to printer port of DT80 C Invoke HELP facility for LIST C Allow screen widths other than SCRWIDTH C Record or Block i/o. C set to define(RECORDIO,) for record io C size of buffer for mark/point C BLOCK IO define(MARKSIZE,3) C getnum - evaluate one line number expression INTEGER FUNCTION GETNUM(F, LIN, I, BUF, BLEN, NUM, BSFAIL) BYTE LIN(1), BUF(1), C INTEGER F, I, BLEN INTEGER*4NUM, PNUM LOGICAL BSFAIL INTEGER GETN COMMON/CLIST/DOT, OLDOT, TOPSCR, FOFF, FMAX, NXTREC, LSTRED, SAVDO *T, LOWC, HIGHC, TTCC, CC, OUTCC, MARKP, MARKB C current logical record; init: 1 INTEGER*4DOT C old value of dot INTEGER*4OLDOT C top of last screen; init: 1 INTEGER*4TOPSCR C offset in file of logical line 1; init: 0 INTEGER*4FOFF C highest line number of logical file; init: MAXINT-1 INTEGER*4FMAX C next record on file; init: 1 INTEGER*4NXTREC C last record read; init: 0 INTEGER*4LSTRED C value of dot saved by the = command; init: 1 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; init:0 INTEGER MARKP C points to every 100th line on file INTEGER MARKB(4, 0:1000) COMMON/TERM/SCRSIZ, SCRWID, SYSWID, SAVTAB, HLF, AUTOCR C current screen size; init: SCRLENGTH INTEGER SCRSIZ 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 saves value of system's hardware tabs flag INTEGER SAVTAB C true if hardware after col 80 (see gttyp) LOGICAL HLF C true if term set for auto carriagreturn (see gttyp) LOGICAL AUTOCR GETNUM = 1 NUM = 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, PNUM, BUF, BLEN, BSFAIL) .EQ. 1)) 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 = 0 GOTO 2040 2060 CONTINUE C = LIN(I) 2030 IF (.NOT.(C .NE. '+' .AND. C .NE. '-')) GOTO 2020 2040 CONTINUE RETURN END C getn - convert one term to line number INTEGER FUNCTION GETN(F, LIN, I, PNUM, BUF, BLEN, BSFAIL) BYTE LIN(1), BUF(1), DELIM INTEGER F, I, J, BLEN, MUL INTEGER*4PNUM LOGICAL BSFAIL, MAKPAT INTEGER SCAN INTEGER*4PTSCAN, BACKSC COMMON/CLIST/DOT, OLDOT, TOPSCR, FOFF, FMAX, NXTREC, LSTRED, SAVDO *T, LOWC, HIGHC, TTCC, CC, OUTCC, MARKP, MARKB C current logical record; init: 1 INTEGER*4DOT C old value of dot INTEGER*4OLDOT C top of last screen; init: 1 INTEGER*4TOPSCR C offset in file of logical line 1; init: 0 INTEGER*4FOFF C highest line number of logical file; init: MAXINT-1 INTEGER*4FMAX C next record on file; init: 1 INTEGER*4NXTREC C last record read; init: 0 INTEGER*4LSTRED C value of dot saved by the = command; init: 1 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; init:0 INTEGER MARKP C points to every 100th line on file INTEGER MARKB(4, 0:1000) COMMON/TERM/SCRSIZ, SCRWID, SYSWID, SAVTAB, HLF, AUTOCR C current screen size; init: SCRLENGTH INTEGER SCRSIZ 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 saves value of system's hardware tabs flag INTEGER SAVTAB C true if hardware after col 80 (see gttyp) LOGICAL HLF C true if term set for auto carriagreturn (see gttyp) LOGICAL AUTOCR GETN = 1 MUL = + 1 IF (.NOT.(LIN(I) .EQ. '-')) GOTO 2110 MUL = - 1 I = I + 1 GOTO 2120 2110 CONTINUE IF (.NOT.(LIN(I) .EQ. '+')) GOTO 2130 I = I + 1 2130 CONTINUE 2120 CONTINUE IF (.NOT.(LIN(I) .EQ. 0)) GOTO 2150 GETN = 0 GOTO 2160 2150 CONTINUE IF (.NOT.(LIN(I) .EQ. '.')) GOTO 2170 PNUM = DOT I = I + 1 GOTO 2160 2170 CONTINUE IF (.NOT.(LIN(I) .EQ. '#')) GOTO 2190 PNUM = OLDOT I = I + 1 GOTO 2160 2190 CONTINUE IF (.NOT.(LIN(I) .EQ. '%')) GOTO 2210 PNUM = 1 I = I + 1 GOTO 2160 2210 CONTINUE IF (.NOT.(LIN(I) .EQ. '$')) GOTO 2230 DOT = FMAX + 1 CALL POSIT(F, DOT) PNUM = DOT - 1 I = I + 1 GOTO 2160 2230 CONTINUE IF (.NOT.(LIN(I) .EQ. '@')) GOTO 2250 PNUM = TOPSCR I = I + 1 GOTO 2160 2250 CONTINUE IF (.NOT.(LIN(I) .EQ. '*')) GOTO 2270 PNUM = SAVDOT I = I + 1 GOTO 2160 2270 CONTINUE IF (.NOT.(LIN(I) .EQ. '/' .OR. LIN(I) .EQ. '\')) GOTO 2290 DELIM = LIN(I) IF (.NOT.(.NOT.MAKPAT(LIN, I, DELIM))) GOTO 2310 C build the pattern GETN = - 1 GOTO 2320 2310 CONTINUE IF (.NOT.(DELIM .EQ. '/')) GOTO 2330 PNUM = PTSCAN(F, BUF, BLEN, FMAX) IF (.NOT.(PNUM .EQ. -10)) GOTO 2350 PNUM = DOT 2350 CONTINUE GOTO 2340 2330 CONTINUE PNUM = BACKSC(F, BUF, BLEN) IF (.NOT.(PNUM .EQ. -10)) GOTO 2370 BSFAIL = .TRUE. PNUM = 1 2370 CONTINUE 2340 CONTINUE 2320 CONTINUE GOTO 2160 2290 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 = 0 2400 CONTINUE 2160 CONTINUE PNUM = PNUM*MUL RETURN 10 CONTINUE GETN = - 1 CALL ERR(LIN, I, 'Number too large.') RETURN END C makpat - make pattern if specified at lin(i) LOGICAL FUNCTION MAKPAT(LIN, I, DELIM) BYTE LIN(1), DELIM INTEGER I LOGICAL 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(14) 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)/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 IF (.NOT.(WPAT(LIN, I, SPCIAL, SRCHST, 134*2))) GOTO 2480 SNULL = .FALSE. GOTO 2490 2480 CONTINUE CALL ERR(LIN, I, 'Pattern too long.') 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, TFMAX INTEGER GETINP, WSRCH COMMON/CLIST/DOT, OLDOT, TOPSCR, FOFF, FMAX, NXTREC, LSTRED, SAVDO *T, LOWC, HIGHC, TTCC, CC, OUTCC, MARKP, MARKB C current logical record; init: 1 INTEGER*4DOT C old value of dot INTEGER*4OLDOT C top of last screen; init: 1 INTEGER*4TOPSCR C offset in file of logical line 1; init: 0 INTEGER*4FOFF C highest line number of logical file; init: MAXINT-1 INTEGER*4FMAX C next record on file; init: 1 INTEGER*4NXTREC C last record read; init: 0 INTEGER*4LSTRED C value of dot saved by the = command; init: 1 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; init:0 INTEGER MARKP C points to every 100th line on file INTEGER MARKB(4, 0:1000) COMMON/PAT/SNULL, SRCHST C .false. if srchst is valid; .true. otherwise LOGICAL SNULL C holds current search string BYTE SRCHST(268) TFMAX = FMAX FMAX = MXSRCH PTSCAN = - 10 CALL POSIT(F, DOT) 2500 IF (.NOT.(GETINP(F, BUF, BLEN) .NE. -10)) GOTO 2510 IF (.NOT.(WSRCH(BUF, BLEN, SRCHST) .EQ. 0)) GOTO 2520 DOT = DOT + 1 GOTO 2530 2520 CONTINUE PTSCAN = DOT GOTO 2510 2530 CONTINUE GOTO 2500 2510 CONTINUE FMAX = TFMAX 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, OLDOT, TOPSCR, FOFF, FMAX, NXTREC, LSTRED, SAVDO *T, LOWC, HIGHC, TTCC, CC, OUTCC, MARKP, MARKB C current logical record; init: 1 INTEGER*4DOT C old value of dot INTEGER*4OLDOT C top of last screen; init: 1 INTEGER*4TOPSCR C offset in file of logical line 1; init: 0 INTEGER*4FOFF C highest line number of logical file; init: MAXINT-1 INTEGER*4FMAX C next record on file; init: 1 INTEGER*4NXTREC C last record read; init: 0 INTEGER*4LSTRED C value of dot saved by the = command; init: 1 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; init:0 INTEGER MARKP C points to every 100th line on file INTEGER MARKB(4, 0:1000) BACKSC = - 10 MX = DOT - 1 SDOT = ((MX - 1)/100)*100 + 1 2540 IF (.NOT.(MX .GT. 0)) GOTO 2550 C search backwards in 100-line chunks DOT = SDOT NUM = - 10 2560 CONTINUE BACKSC = NUM NUM = PTSCAN(F, BUF, BLEN, MX) DOT = DOT + 1 2570 IF (.NOT.(NUM .EQ. -10)) GOTO 2560 IF (.NOT.(BACKSC .NE. -10)) GOTO 2590 GOTO 2550 2590 CONTINUE MX = SDOT - 1 SDOT = SDOT - 100 GOTO 2540 2550 CONTINUE IF (.NOT.(BACKSC .EQ. -10)) GOTO 2610 DOT = 1 GOTO 2620 2610 CONTINUE DOT = BACKSC 2620 CONTINUE RETURN END C replac - replace occurrences of "char" in "lin" with "text" INTEGER FUNCTION REPLAC(CHAR, TEXT, LIN, SIZE, I) INTEGER SIZE, I, TEXTL, LINL INTEGER LENGTH, CHSCAN C length(lin(i)) <= 2*MAXLINE! BYTE CHAR(1), TEXT(1), LIN(1), TEMP(268) REPLAC = 1 LINL = LENGTH(LIN) TEXTL = LENGTH(TEXT) 2630 IF (.NOT.(CHSCAN(LIN, I, CHAR) .EQ. 1)) GOTO 2640 IF (.NOT.(TEXTL+LINL .GT. SIZE)) GOTO 2650 REPLAC = 0 GOTO 2640 2650 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 2630 2640 CONTINUE IF (.NOT.(REPLAC .EQ. 1)) GOTO 2670 I = 1 2670 CONTINUE RETURN END C chscan - scan "lin" for "char", ignoring occurrences within file names C and search patterns INTEGER FUNCTION CHSCAN(LIN, I, CHAR) INTEGER I BYTE LIN(1), CHAR, DELIM BYTE CUPPER LOGICAL LITRAL, INPAT CHSCAN = 0 INPAT = .FALSE. LITRAL = .FALSE. 2690 IF (.NOT.(LIN(I) .NE. 0)) GOTO 2710 IF (.NOT.(INPAT)) GOTO 2720 IF (.NOT.(LIN(I) .EQ. '"')) GOTO 2740 IF (.NOT.(LIN(I+1) .NE. '"')) GOTO 2760 LITRAL = .NOT.LITRAL GOTO 2770 2760 CONTINUE I = I + 1 2770 CONTINUE GOTO 2750 2740 CONTINUE IF (.NOT.(LIN(I) .EQ. DELIM .AND. .NOT.LITRAL)) GOTO 2780 INPAT = .FALSE. 2780 CONTINUE 2750 CONTINUE GOTO 2730 2720 CONTINUE IF (.NOT.(LIN(I) .EQ. '/' .OR. LIN(I) .EQ. '\')) GOTO 2800 DELIM = LIN(I) INPAT = .TRUE. GOTO 2730 2800 CONTINUE IF (.NOT.(CUPPER(LIN(I)) .EQ. CHAR)) GOTO 2820 CHSCAN = 1 GOTO 2710 2820 CONTINUE IF (.NOT.(LIN(I) .EQ. '>')) GOTO 2840 GOTO 2710 2840 CONTINUE 2730 CONTINUE 2700 I = I + 1 GOTO 2690 2710 CONTINUE RETURN END