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 gcmd - get command line from MCR or terminal SUBROUTINE GCMD(LUN, PROMPT, BUF, LEN, MAXLEN, SOURCE) BYTE PROMPT(1), BUF(1), TERMC INTEGER LUN, LEN, MAXLEN, SOURCE, I, J 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 - 2, TERMC) 2150 IF (.NOT.(LEN .GE. 0 .OR. LEN .EQ. -10)) GOTO 2140 IF (.NOT.(LEN .GE. 0 .AND. TERMC .EQ. 27)) GOTO 2170 C ESC as terminator? LEN = LEN + 1 BUF(LEN) = 27 2170 CONTINUE 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) BYTE BUF(134), PROMP(12) INTEGER*4DOT INTEGER NC, J, SOURCE INTEGER SCAN LOGICAL PRMFLG DATA PROMP(11)/'>'/, PROMP(12)/0/ IF (.NOT.(PRMFLG)) GOTO 2190 ENCODE(10, 2210, PROMP) DOT 2210 FORMAT(I10) J = SCAN(PROMP, ' ', 1) GOTO 2200 2190 CONTINUE J = 1 PROMP(1) = 0 2200 CONTINUE CALL GCMD(2, PROMP(J), BUF, NC, 134, SOURCE) RCMD = NC RETURN END C initio - initialize the io variables SUBROUTINE INITIO(F, FOUT) INTEGER F, FOUT 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/ DOT = 1 NXTREC = 1 TOPSCR = 1 MARKP = - 1 MRKINT = 4 LSTRED = 0 SAVDOT = 1 FOFF = 0 FMAX = 2147483647 - 1 LOWC = 1 C when highc > BUFSIZ, list flags record too long errors HIGHC = 512 + 1 IF (.NOT.(CC .EQ. 2)) GOTO 2220 C initialize virtual io CALL VINIT(F) 2220 CONTINUE RETURN END C getinp - get next record, increment nxtrec, mark every mrkint lines INTEGER FUNCTION GETINP(F, INBUF, BLEN) INTEGER F, BLEN, I, GETSTA, VGET C integer get INTEGER BGET INTEGER*4RDOT BYTE INBUF(512) 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/ RDOT = DOT + FOFF IF (.NOT.(DOT .GT. FMAX)) GOTO 2240 GETINP = - 10 GOTO 2250 2240 CONTINUE IF (.NOT.(RDOT .EQ. LSTRED)) GOTO 2260 GETINP = BLEN GOTO 2250 2260 CONTINUE IF (.NOT.(MOD(NXTREC-1, MRKINT) .EQ. 0)) GOTO 2280 IF (.NOT.((NXTREC-1)/MRKINT .GT. MARKP)) GOTO 2300 CALL MARKIT(F) 2300 CONTINUE 2280 CONTINUE IF (.NOT.(CC .EQ. 2)) GOTO 2320 GETSTA = VGET(F, INBUF, 512, GETINP) GOTO 2330 2320 CONTINUE C getsta = get(f, inbuf, BUFSIZ, getinp) GETSTA = BGET(F, INBUF, 512, GETINP) 2330 CONTINUE IF (.NOT.(GETINP .GE. 0)) GOTO 2340 10 BLEN = MAX0(0, MIN0(HIGHC, GETINP) - LOWC + 1) IF (.NOT.(LOWC .NE. 1 .AND. BLEN .GT. 0)) GOTO 2360 DO 2380 I = 1, BLEN C shift proper byte range to inbuf(1) INBUF(I) = INBUF(I - 1 + LOWC) 2380 CONTINUE 2360 CONTINUE IF (.NOT.(FLAGS(3))) GOTO 2400 2420 IF (.NOT.(BLEN .GT. 0)) GOTO 2440 IF (.NOT.(INBUF(BLEN) .NE. ' ' .AND. INBUF(BLEN) .NE. 9)) *GOTO 2450 GOTO 2440 2450 CONTINUE 2430 BLEN = BLEN - 1 GOTO 2420 2440 CONTINUE 2400 CONTINUE GETINP = BLEN LSTRED = NXTREC NXTREC = NXTREC + 1 GOTO 2350 2340 CONTINUE IF (.NOT.(GETINP .EQ. -40)) GOTO 2470 IF (.NOT.(HIGHC .GT. 512)) GOTO 2490 ENCODE(44, 2510, ERRBUF) DOT 2510 FORMAT('LIST -- Record number ',I10,' is too long') CALL TTPUT(ERRBUF, 44) XSTAT = 2 2490 CONTINUE GETINP = 512 GOTO 10 11 CONTINUE GOTO 2350 2470 CONTINUE IF (.NOT.(GETINP .EQ. -10)) GOTO 2520 IF (.NOT.(.NOT.RANDAC)) GOTO 2540 C don't try to read more records if not random access FOFF = 0 FMAX = 0 NXTREC = 1 LSTRED = 0 2540 CONTINUE GOTO 2350 2520 CONTINUE CALL REAERR(GETSTA, GETINP, 0) GETINP = - 10 LSTRED = 0 2350 CONTINUE 2250 CONTINUE RETURN END C typlin - type line if room is left on screen or (lastpr >= dot & lastpr != 0) LOGICAL FUNCTION TYPLIN(F, BUF, BLEN, NPRINT, LASTPR, IGNRFF) BYTE BUF(1), CCBUF(522), COPYB(520) INTEGER F, BLEN, NLINES, IER, PUTSTA, PUT INTEGER*4NPRINT, LASTPR LOGICAL IGNRFF, FFFLAG 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 EQUIVALENCE(COPYB(1), CCBUF(3)) C Carriagereturn C Line Feed DATA CCBUF(1), CCBUF(2)/13, 10/ TYPLIN = .TRUE. IF (.NOT.(LASTPR .LE. 0)) GOTO 2560 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 2580 TYPLIN = (.FALSE.) RETURN 2580 CONTINUE IF (.NOT.(OUTCC .EQ. 2)) GOTO 2600 C output to terminal or NONE file PUTSTA = PUT(F, CCBUF, BLEN + 2, IER) C output to LIST or FORTRAN file GOTO 2610 2600 CONTINUE PUTSTA = PUT(F, COPYB, BLEN, IER) 2610 CONTINUE GOTO 2570 2560 CONTINUE IF (.NOT.(LASTPR .GE. DOT)) GOTO 2620 C n1,n2 Print mode; leave funny chars in buf NLINES = 1 IF (.NOT.(OUTCC .EQ. 2)) GOTO 2640 C output to terminal or NONE file DO 2660 I = 1, BLEN COPYB(I) = BUF(I) 2660 CONTINUE PUTSTA = PUT(F, CCBUF, BLEN + 2, IER) C output to LIST or FORTRAN file GOTO 2650 2640 CONTINUE PUTSTA = PUT(F, BUF, BLEN, IER) 2650 CONTINUE GOTO 2570 2620 CONTINUE TYPLIN = (.FALSE.) RETURN 2570 CONTINUE IF (.NOT.(IER .NE. 0)) GOTO 2680 ENCODE(61, 2700, ERRBUF) PUTSTA 2700 FORMAT('LIST -- Error number ',I10,' occurred while writing re *cord') CALL TTPUT(ERRBUF, 61) XSTAT = 2 TYPLIN = .FALSE. 2680 CONTINUE NPRINT = NPRINT + NLINES DOT = DOT + 1 RETURN END C posit - position file to read record number "dot" SUBROUTINE POSIT(F) INTEGER F, SKPSTA, IER, SKIP, VSKIP INTEGER*4RDOT, MARKL, MARKP4 INTEGER*4N4, NR4 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/ DOT = MAX0(1, MIN0(FMAX + 1, DOT)) RDOT = FOFF + DOT IF (.NOT.(RDOT .EQ. NXTREC)) GOTO 2710 RETURN 2710 CONTINUE IF (.NOT.(RDOT .EQ. LSTRED)) GOTO 2730 IF (.NOT.(NXTREC .EQ. RDOT+1)) GOTO 2750 RETURN 2750 CONTINUE LSTRED = 0 2760 CONTINUE 2730 CONTINUE MARKP4 = MARKP MARKL = MIN0((RDOT - 1)/MRKINT, MARKP4) IF (.NOT.(MARKL .GT. (NXTREC-1)/MRKINT .OR. NXTREC .GT. RDOT)) GOT *O 2770 IF (.NOT.(.NOT.RANDAC)) GOTO 2790 CALL TTPUT('LIST -- Cannot position backwards on non-random ac *cess device', 0) DOT = MAX0(1, NXTREC - FOFF) XSTAT = 2 RETURN 2790 CONTINUE IF (.NOT.(CC .EQ. 2)) GOTO 2810 CALL VPOINT(F, MARKB(1, MARKL)) GOTO 2820 2810 CONTINUE CALL POINTR(F, MARKB(1, MARKL)) 2820 CONTINUE NXTREC = MARKL*MRKINT + 1 2770 CONTINUE 2830 CONTINUE IF (.NOT.((NXTREC-1)/MRKINT .NE. (RDOT-1)/MRKINT)) GOTO 2860 N4 = (((NXTREC - 1)/MRKINT)*MRKINT + MRKINT + 1) - NXTREC GOTO 2870 2860 CONTINUE N4 = RDOT - NXTREC 2870 CONTINUE IF (.NOT.(MOD(NXTREC-1, MRKINT) .EQ. 0)) GOTO 2880 IF (.NOT.((NXTREC-1)/MRKINT .GT. MARKP)) GOTO 2900 CALL MARKIT(F) 2900 CONTINUE 2880 CONTINUE IF (.NOT.(CC .EQ. 2)) GOTO 2920 SKPSTA = VSKIP(F, N4, NR4, IER) GOTO 2930 2920 CONTINUE SKPSTA = SKIP(F, N4, NR4, IER) 2930 CONTINUE NXTREC = NR4 + NXTREC 2840 IF (.NOT.(NXTREC .EQ. RDOT .OR. NR4 .NE. N4)) GOTO 2830 DOT = MAX0(1, NXTREC - FOFF) IF (.NOT.(NR4 .NE. N4)) GOTO 2940 IF (.NOT.(IER .NE. -10)) GOTO 2960 CALL REAERR(SKPSTA, IER, 0) 2960 CONTINUE IF (.NOT.(.NOT.RANDAC)) GOTO 2980 FOFF = 0 FMAX = 0 NXTREC = 1 LSTRED = 0 2980 CONTINUE 2940 CONTINUE RETURN END C markit - mark a line for later access SUBROUTINE MARKIT(F) INTEGER F, I, J 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/ IF (.NOT.(.NOT.RANDAC)) GOTO 3000 RETURN 3000 CONTINUE MARKP = MARKP + 1 IF (.NOT.(CC .EQ. 2)) GOTO 3020 CALL VMARK(F, MARKB(1, MARKP)) GOTO 3030 3020 CONTINUE CALL MARKR(F, MARKB(1, MARKP)) 3030 CONTINUE IF (.NOT.(MARKP .GE. 500)) GOTO 3040 C compress mark buffer, double mark interval DO 3060 I = 0, 500/2 DO 3080 J = 1, 3 MARKB(J, I) = MARKB(J, I*2) 3080 CONTINUE 3060 CONTINUE MARKP = 500/2 MRKINT = 2*MRKINT 3040 CONTINUE RETURN END C reaerr - output a read error message SUBROUTINE REAERR(MSGN, IER, OFFSET) INTEGER MSGN, IER, I INTEGER*4OFFSET 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/ IF (.NOT.(IER .EQ. -1054)) GOTO 3100 I = 73 ENCODE(I, 3120, ERRBUF) MAX0(1, NXTREC - FOFF) + OFFSET 3120 FORMAT('LIST -- Internal buffer overflowed while reading recor *d number ',I10) GOTO 3110 3100 CONTINUE IF (.NOT.(IER .EQ. -1053)) GOTO 3130 I = 59 ENCODE(I, 3150, ERRBUF) MAX0(1, NXTREC - FOFF) + OFFSET 3150 FORMAT('LIST -- Record number 'I10' has a negative record size *') GOTO 3110 3130 CONTINUE I = 79 ENCODE(I, 3160, ERRBUF) MSGN, MAX0(1, NXTREC - FOFF) + OFFSET 3160 FORMAT('LIST -- Error number ',I10,' occurred while reading re *cord number ',I10) 3110 CONTINUE CALL TTPUT(ERRBUF, I) XSTAT = 2 RETURN END