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 gcmd - get command line from MCR or terminal SUBROUTINE GCMD(LUN, PROMPT, BUF, LEN, MAXLEN, SOURCE) BYTE PROMPT(1), BUF(1) INTEGER LUN, LEN, MAXLEN, SOURCE INTEGER I, J, JUNK LOGICAL FIRST DATA FIRST/.TRUE./ LEN = 0 IF (.NOT.(FIRST)) GOTO 2000 FIRST = .FALSE. CALL GETMCR(BUF, LEN) IF (.NOT.(LEN .GT. 0)) GOTO 2020 SOURCE = - 2 I = 1 2040 IF (.NOT.(I .LT. LEN)) GOTO 2060 IF (.NOT.(BUF(I) .EQ. ' ' .OR. BUF(I+1) .EQ. '/')) GOTO 2070 GOTO 2060 2070 CONTINUE 2050 I = I + 1 GOTO 2040 2060 CONTINUE J = I I = I + 1 2090 IF (.NOT.(I .LE. LEN)) GOTO 2110 BUF(I - J) = BUF(I) 2100 I = I + 1 GOTO 2090 2110 CONTINUE LEN = LEN - J 2020 CONTINUE 2000 CONTINUE IF (.NOT.(LEN .LE. 0)) GOTO 2120 SOURCE = 0 2140 CONTINUE CALL READPR(LUN, PROMPT, BUF, LEN, MAXLEN - 1, JUNK) 2150 IF (.NOT.(LEN .GE. 0 .OR. LEN .EQ. -10)) GOTO 2140 2120 CONTINUE BUF(MAX0(1, MIN0(MAXLEN, LEN + 1))) = 0 RETURN END C rcmd - get the next list command INTEGER FUNCTION RCMD(BUF, DOT, PRMFLG) INTEGER NC, J INTEGER*4DOT INTEGER SCAN BYTE BUF(1), PROMP(13), TERMC LOGICAL PRMFLG DATA PROMP(12)/'>'/, PROMP(13)/0/ IF (.NOT.(PRMFLG)) GOTO 2170 ENCODE(11, 10, PROMP) DOT 10 FORMAT(1X, I10) J = SCAN(PROMP, ' ', 1) GOTO 2180 2170 CONTINUE J = 1 PROMP(J) = 0 2180 CONTINUE 2190 CONTINUE CALL READPR(2, PROMP(J), BUF, NC, 134 - 2, TERMC) 2200 IF (.NOT.(NC .GE. 0 .OR. NC .EQ. -10)) GOTO 2190 RCMD = NC IF (.NOT.(RCMD .GE. 0 .AND. TERMC .EQ. 27)) GOTO 2220 C ESC as terminator? RCMD = RCMD + 1 BUF(RCMD) = 27 2220 CONTINUE BUF(MAX0(1, RCMD + 1)) = 0 RETURN END C initio - initialize the io variables SUBROUTINE INITIO(F, FOUT) INTEGER F, FOUT 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) DOT = 1 NXTREC = 1 TOPSCR = 1 MARKP = - 1 LSTRED = 0 SAVDOT = 1 FOFF = 0 FMAX = 2147483647 - 1 LOWC = 1 HIGHC = 512 CALL GFTYP(F, CC) CALL GFTYP(FOUT, OUTCC) IF (.NOT.(CC .EQ. 2)) GOTO 2240 C initialize virtual io CALL VINIT(F) 2240 CONTINUE RETURN END C getinp - get next record, increment nxtrec, mark every 100 lines INTEGER FUNCTION GETINP(F, INBUF, BLEN) INTEGER F, BLEN, IER, I INTEGER*4RDOT BYTE INBUF(512), ERRBUF(80) 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) RDOT = DOT + FOFF IF (.NOT.(DOT .GT. FMAX)) GOTO 2260 GETINP = - 10 GOTO 2270 2260 CONTINUE IF (.NOT.(RDOT .EQ. LSTRED)) GOTO 2280 GETINP = BLEN GOTO 2270 2280 CONTINUE IF (.NOT.(MOD(NXTREC-1, 100) .EQ. 0)) GOTO 2300 IF (.NOT.((NXTREC-1)/100 .GT. MARKP .AND. MARKP .LT. 1000)) GO *TO 2320 MARKP = MARKP + 1 IF (.NOT.(CC .EQ. 2)) GOTO 2340 CALL VMARK(F, MARKB(1, MARKP)) GOTO 2350 2340 CONTINUE CALL MARKR(F, MARKB(1, MARKP)) 2350 CONTINUE 2320 CONTINUE 2300 CONTINUE IF (.NOT.(CC .EQ. 2)) GOTO 2360 CALL VGET(F, INBUF, 512, GETINP) GOTO 2370 2360 CONTINUE CALL GET(F, INBUF, 512, GETINP) C BLOCK IO call bget(f, inbuf, BUFSIZ, getinp) 2370 CONTINUE IF (.NOT.(GETINP .GE. 0)) GOTO 2380 GETINP = MAX0(0, MIN0(HIGHC, GETINP) - LOWC + 1) BLEN = GETINP IF (.NOT.(LOWC .NE. 1 .AND. BLEN .GT. 0)) GOTO 2400 DO 2420 I = 1, BLEN C shift proper byte range to inbuf(1) INBUF(I) = INBUF(I - 1 + LOWC) 2420 CONTINUE 2400 CONTINUE LSTRED = NXTREC NXTREC = NXTREC + 1 GOTO 2390 2380 CONTINUE IF (.NOT.(GETINP .EQ. -40)) GOTO 2440 ENCODE(41, 10, ERRBUF) NXTREC 10 FORMAT('LIST -- RECORD NUMBER ', I7, ' IS TOO LONG') CALL TTPUT(ERRBUF, 41) GETINP = 0 BLEN = GETINP LSTRED = 0 NXTREC = NXTREC + 1 GOTO 2390 2440 CONTINUE IF (.NOT.(GETINP .NE. -10)) GOTO 2460 ENCODE(69, 20, ERRBUF) GETINP, NXTREC 20 FORMAT('LIST -- ERROR NUMBER 'I3, ' OCCURRED WHILE READING REC *ORD NUMBER ', I7) CALL TTPUT(ERRBUF, 69) GETINP = - 10 2460 CONTINUE 2390 CONTINUE 2270 CONTINUE RETURN END C typlin - type line if room is left on screen or ntoprt > 0 INTEGER FUNCTION TYPLIN(F, BUF, BLEN, NPRINT, NTOPRT, IGNRFF) BYTE BUF(1), CCBUF(522), COPYB(520) INTEGER F, BLEN, NLINES, IER INTEGER*4NPRINT, NTOPRT LOGICAL FFFLAG, IGNRFF 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 EQUIVALENCE(COPYB(1), CCBUF(3)) C Carriagereturn C Line Feed DATA CCBUF(1), CCBUF(2)/13, 10/ TYPLIN = 0 IF (.NOT.(NTOPRT .LE. 0)) GOTO 2480 C normal print mode CALL NUMLIN(BUF, COPYB, BLEN, FFFLAG, NLINES) IF (.NOT.(NPRINT .GT. 0 .AND. (NPRINT+NLINES .GT. SCRSIZ .OR. (F *FFLAG .AND. .NOT.IGNRFF)))) GOTO 2500 RETURN 2500 CONTINUE GOTO 2490 2480 CONTINUE C n1,n2 Print mode; leave funny chars in buf NLINES = 1 DO 2520 I = 1, BLEN COPYB(I) = BUF(I) 2520 CONTINUE 2490 CONTINUE IF (.NOT.(OUTCC .EQ. 2)) GOTO 2540 C output to terminal or NONE file CALL PUT(F, CCBUF, BLEN + 2, IER) C output to LIST or FORTRAN file GOTO 2550 2540 CONTINUE CALL PUT(F, COPYB, BLEN, IER) 2550 CONTINUE NPRINT = NPRINT + NLINES DOT = DOT + 1 NTOPRT = NTOPRT - 1 IF (.NOT.(NTOPRT .NE. 0)) GOTO 2560 TYPLIN = 1 2560 CONTINUE RETURN END C posit - position file to read record number "newdot" SUBROUTINE POSIT(F, NEWDOT) INTEGER F INTEGER*4NEWDOT, RDOT, MARKL, MARKP4 INTEGER*4N4, NR4 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) RDOT = FOFF + NEWDOT IF (.NOT.(RDOT .EQ. NXTREC)) GOTO 2580 RETURN 2580 CONTINUE IF (.NOT.(RDOT .EQ. LSTRED)) GOTO 2600 IF (.NOT.(NXTREC .EQ. RDOT+1)) GOTO 2620 RETURN 2620 CONTINUE LSTRED = 0 2630 CONTINUE 2600 CONTINUE MARKP4 = MARKP MARKL = MIN0((RDOT - 1)/100, MARKP4) IF (.NOT.(MARKL .GT. (NXTREC-1)/100 .OR. NXTREC .GT. RDOT)) GOTO 2 *640 IF (.NOT.(CC .EQ. 2)) GOTO 2660 CALL VPOINT(F, MARKB(1, MARKL)) GOTO 2670 2660 CONTINUE CALL POINTR(F, MARKB(1, MARKL)) 2670 CONTINUE NXTREC = MARKL*100 + 1 2640 CONTINUE 2680 CONTINUE IF (.NOT.((NXTREC-1)/100 .NE. (RDOT-1)/100)) GOTO 2710 N4 = ((NXTREC - 1)/100*100 + 101) - NXTREC GOTO 2720 2710 CONTINUE N4 = RDOT - NXTREC 2720 CONTINUE IF (.NOT.(MOD(NXTREC-1, 100) .EQ. 0)) GOTO 2730 IF (.NOT.((NXTREC-1)/100 .GT. MARKP .AND. MARKP .LT. 1000)) GO *TO 2750 MARKP = MARKP + 1 IF (.NOT.(CC .EQ. 2)) GOTO 2770 CALL VMARK(F, MARKB(1, MARKP)) GOTO 2780 2770 CONTINUE CALL MARKR(F, MARKB(1, MARKP)) 2780 CONTINUE 2750 CONTINUE 2730 CONTINUE IF (.NOT.(CC .EQ. 2)) GOTO 2790 CALL VSKIP(F, N4, NR4) GOTO 2800 2790 CONTINUE CALL SKIP(F, N4, NR4) 2800 CONTINUE NXTREC = NR4 + NXTREC 2690 IF (.NOT.(NXTREC .EQ. RDOT .OR. NR4 .NE. N4)) GOTO 2680 NEWDOT = MAX0(1, NXTREC - FOFF) RETURN END