C C C C LIST File Listing Utility C ========================= C C Author: William Wood 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: 2.0 C C Date: December 1, 1980 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 * THIS SOFTWARE WAS DESIGNED FOR USE ON A * C * PDP-11/70 OPERATING UNDER IAS V3.0 USING * C * THE FORTRAN-IV PLUS COMPILER. * C * * C ******************************************************* C C C C note the order of the next several defines is significant! C comment this out for export version C ICR ONLY define(NOTICR,# NOT ICR) C Local ICR functions supported by LIST: C Invoke LIST on SRD-selected files 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, ODOT, TOPSCR, FOFF, FMAX, NXTREC, LSTRED, SAVDOT *, LOWC, HIGHC, CC, OUTCC, MARKP, MARKB C current logical record; init: 1 INTEGER*4DOT C old value of dot INTEGER*4ODOT 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 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 2080 2070 CONTINUE IF (.NOT.(C .EQ. '-')) GOTO 2090 NUM = NUM - (SCRSIZ + 1)/2 GOTO 2100 2090 CONTINUE GETNUM = 0 GOTO 2040 2100 CONTINUE 2080 CONTINUE 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 INTEGER OPTPAT, SCAN INTEGER*4PTSCAN, BACKSC COMMON/CLIST/DOT, ODOT, TOPSCR, FOFF, FMAX, NXTREC, LSTRED, SAVDOT *, LOWC, HIGHC, CC, OUTCC, MARKP, MARKB C current logical record; init: 1 INTEGER*4DOT C old value of dot INTEGER*4ODOT 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 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 2180 2170 CONTINUE IF (.NOT.(LIN(I) .EQ. '#')) GOTO 2190 PNUM = ODOT I = I + 1 GOTO 2200 2190 CONTINUE IF (.NOT.(LIN(I) .EQ. '$')) GOTO 2210 DOT = FMAX + 1 CALL POSIT(F, DOT) PNUM = DOT - 1 I = I + 1 GOTO 2220 2210 CONTINUE IF (.NOT.(LIN(I) .EQ. '@')) GOTO 2230 PNUM = TOPSCR I = I + 1 GOTO 2240 2230 CONTINUE IF (.NOT.(LIN(I) .EQ. ';')) GOTO 2250 PNUM = SCRSIZ I = I + 1 GOTO 2260 2250 CONTINUE IF (.NOT.(LIN(I) .EQ. '*')) GOTO 2270 PNUM = SAVDOT I = I + 1 GOTO 2280 2270 CONTINUE IF (.NOT.(LIN(I) .EQ. '/' .OR. LIN(I) .EQ. '\')) GOT *O 2290 DELIM = LIN(I) IF (.NOT.(OPTPAT(LIN, I, DELIM) .EQ. -1)) GOTO 231 *0 C build the pattern GETN = - 1 CALL ERR(LIN, I - 1, 'Current search string is n *ull.') LIN(I) = - 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 2300 2290 CONTINUE J = SCAN(LIN, '1234567890', I) IF (.NOT.(I .NE. J)) GOTO 2390 DECODE(J-I, 20, LIN(I), ERR=10) PNUM 20 format(i) I = J GOTO 2400 2390 CONTINUE GETN = 0 2400 CONTINUE 2300 CONTINUE 2280 CONTINUE 2260 CONTINUE 2240 CONTINUE 2220 CONTINUE 2200 CONTINUE 2180 CONTINUE 2160 CONTINUE PNUM = PNUM*MUL RETURN 10 CONTINUE GETN = - 1 CALL ERR(LIN, I, 'Number too large.') RETURN END C optpat - make pattern if specified at lin(i) INTEGER FUNCTION OPTPAT(LIN, I, DELIM) BYTE LIN(1), DELIM INTEGER I, J, PBEG LOGICAL BOL BYTE CUPPER COMMON/PAT/SLEN, SLIMIT, SRCHST, SHFTAB C length of search string; init: 0 INTEGER SLEN C when equal to slen, limits string INTEGER SLIMIT C searching to beginning of input buffer C holds current search string BYTE SRCHST(134) C holds amount to shift search string BYTE SHFTAB( - 128:127) C along input when mismatch occurs. DATA SLEN/0/ I = I + 1 IF (.NOT.(LIN(I) .EQ. 0)) GOTO 2410 GOTO 2420 2410 CONTINUE IF (.NOT.(LIN(I) .EQ. DELIM)) GOTO 2430 C repeated delimiter C leave existing pattern alone I = I + 1 GOTO 2440 2430 CONTINUE C search all of input for search string BOL = .FALSE. PBEG = I J = 1 2450 IF (.NOT.(LIN(I) .NE. DELIM .AND. LIN(I) .NE. 0)) GOTO 2470 IF (.NOT.(I .EQ. PBEG .AND. LIN(I) .EQ. '%')) GOTO 2480 C search only beginning of line? BOL = .TRUE. GOTO 2460 2480 CONTINUE IF (.NOT.(LIN(I) .EQ. '''')) GOTO 2500 I = I + 1 IF (.NOT.(LIN(I) .EQ. 0)) GOTO 2520 GOTO 2470 2520 CONTINUE GOTO 2510 2500 CONTINUE IF (.NOT.(LIN(I) .EQ. '^')) GOTO 2540 I = I + 1 IF (.NOT.(LIN(I) .EQ. 0)) GOTO 2560 GOTO 2470 2560 CONTINUE LIN(I) = CUPPER(LIN(I)) - 64 2570 CONTINUE 2540 CONTINUE 2510 CONTINUE SRCHST(J) = LIN(I) J = J + 1 2460 I = I + 1 GOTO 2450 2470 CONTINUE SLEN = J - 1 IF (.NOT.(BOL)) GOTO 2580 C only search beginning of line SLIMIT = SLEN GOTO 2590 2580 CONTINUE C search all of line SLIMIT = 512 2590 CONTINUE IF (.NOT.(LIN(I) .EQ. DELIM)) GOTO 2600 I = I + 1 C C now set up the shift table, which contains the amount to shift C the pattern along the input when a given character in the input C doesn't match the pattern. C 2600 CONTINUE DO 2620 J = - 128, 127 SHFTAB(J) = SLEN 2620 CONTINUE 2630 CONTINUE J = 1 2640 IF (.NOT.(J .LT. SLEN)) GOTO 2660 SHFTAB(SRCHST(J)) = SLEN - J 2650 J = J + 1 GOTO 2640 2660 CONTINUE 2440 CONTINUE 2420 CONTINUE IF (.NOT.(SLEN .EQ. 0)) GOTO 2670 OPTPAT = - 1 GOTO 2680 2670 CONTINUE OPTPAT = 1 2680 CONTINUE RETURN END C ptscan - scan for next occurrence of pattern INTEGER*4FUNCTION PTSCAN(F, BUF, BLEN, MXSRCH) BYTE BUF(1) INTEGER F, BLEN INTEGER*4MXSRCH, TFMAX INTEGER GETINP, SEARCH COMMON/CLIST/DOT, ODOT, TOPSCR, FOFF, FMAX, NXTREC, LSTRED, SAVDOT *, LOWC, HIGHC, CC, OUTCC, MARKP, MARKB C current logical record; init: 1 INTEGER*4DOT C old value of dot INTEGER*4ODOT 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 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/SLEN, SLIMIT, SRCHST, SHFTAB C length of search string; init: 0 INTEGER SLEN C when equal to slen, limits string INTEGER SLIMIT C searching to beginning of input buffer C holds current search string BYTE SRCHST(134) C holds amount to shift search string BYTE SHFTAB( - 128:127) C along input when mismatch occurs. TFMAX = FMAX FMAX = MXSRCH PTSCAN = - 10 CALL POSIT(F, DOT) 2690 IF (.NOT.(GETINP(F, BUF, BLEN) .NE. -10)) GOTO 2700 IF (.NOT.(SEARCH(BUF, MIN0(BLEN, SLIMIT), SRCHST, SLEN, SHFTAB) *.EQ. 0)) GOTO 2710 DOT = DOT + 1 GOTO 2720 2710 CONTINUE PTSCAN = DOT GOTO 2700 2720 CONTINUE GOTO 2690 2700 CONTINUE FMAX = TFMAX RETURN END C backsc - search backwards for pattern INTEGER*4FUNCTION BACKSC(F, BUF, BLEN) BYTE BUF(1) INTEGER F, BLEN INTEGER*4MX, SDOT, NUM INTEGER*4PTSCAN COMMON/CLIST/DOT, ODOT, TOPSCR, FOFF, FMAX, NXTREC, LSTRED, SAVDOT *, LOWC, HIGHC, CC, OUTCC, MARKP, MARKB C current logical record; init: 1 INTEGER*4DOT C old value of dot INTEGER*4ODOT 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 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 2730 IF (.NOT.(MX .GT. 0)) GOTO 2740 C search backwards in 100-line chunks DOT = SDOT NUM = - 10 2750 CONTINUE BACKSC = NUM NUM = PTSCAN(F, BUF, BLEN, MX) DOT = DOT + 1 2760 IF (.NOT.(NUM .EQ. -10)) GOTO 2750 2770 CONTINUE IF (.NOT.(BACKSC .NE. -10)) GOTO 2780 GOTO 2740 2780 CONTINUE MX = SDOT - 1 SDOT = SDOT - 100 GOTO 2730 2740 CONTINUE IF (.NOT.(BACKSC .EQ. -10)) GOTO 2800 DOT = 1 GOTO 2810 2800 CONTINUE DOT = BACKSC 2810 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(2*134) REPLAC = 1 LINL = LENGTH(LIN) TEXTL = LENGTH(TEXT) 2820 IF (.NOT.(CHSCAN(LIN, I, CHAR) .EQ. 1)) GOTO 2830 IF (.NOT.(TEXTL+LINL .GT. SIZE)) GOTO 2840 REPLAC = 0 GOTO 2830 2840 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 2820 2830 CONTINUE IF (.NOT.(REPLAC .EQ. 1)) GOTO 2860 I = 1 2860 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 CHSCAN = 0 2880 IF (.NOT.(LIN(I) .NE. 0)) GOTO 2900 IF (.NOT.(CUPPER(LIN(I)) .EQ. CHAR)) GOTO 2910 CHSCAN = 1 GOTO 2900 2910 CONTINUE IF (.NOT.(LIN(I) .EQ. '>')) GOTO 2930 GOTO 2900 2930 CONTINUE IF (.NOT.(LIN(I) .EQ. '/' .OR. LIN(I) .EQ. '\')) GOTO 2950 DELIM = LIN(I) I = I + 1 2970 IF (.NOT.(LIN(I) .NE. DELIM)) GOTO 2990 IF (.NOT.(LIN(I) .EQ. '''')) GOTO 3000 I = I + 1 3000 CONTINUE IF (.NOT.(LIN(I) .EQ. 0)) GOTO 3020 GOTO 2900 3020 CONTINUE 2980 I = I + 1 GOTO 2970 2990 CONTINUE 2950 CONTINUE 2940 CONTINUE 2920 CONTINUE 2890 I = I + 1 GOTO 2880 2900 CONTINUE RETURN END C search has been recoded in macro for speed; see SEARCH.MAC C$# search - find a pattern in a line C$ integer function search(text, n, pattrn, m, shftab) C$ byte text(1), pattrn(1), shftab(-128:127) C$ integer n, m, j, i C$ C$ search = 0 C$ if (m ~= 0) { C$ j = m C$ while (j <= n) { C$ do i = m,1,-1 C$ if (text(j-m+i) ~= pattrn(i)) { C$ j = j + shftab(text(j)) C$ next 2 C$ } C$ search = j-m+1 C$ return C$ } C$ } C$ return C$ end