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 list - driver program for LIST file listing facility PROGRAM LIST BYTE COMAND(168), FILE(134), ANS(2) INTEGER NC, SOURCE, STDOUT, NFILE, IER LOGICAL HDR INTEGER REDIR LOGICAL OPNDEF, EQ 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) OPEN(UNIT = 2, NAME = 'TI:', CARRIAGECONTROL = 'LIST', TYPE = 'NEW *') TTCC = 2 OPEN(UNIT = 3, NAME = 'TO:', CARRIAGECONTROL = 'NONE', TYPE = 'NEW *', RECORDSIZE = 524) C no such file CALL ERRSET(29, .TRUE., .FALSE., .TRUE., .FALSE., 15) C open failure CALL ERRSET(30, .TRUE., .FALSE., .TRUE., .FALSE., 15) C file name specification CALL ERRSET(43, .TRUE., .FALSE., .FALSE., .FALSE., 15) C input conversion error CALL ERRSET(64, .TRUE., .FALSE., .TRUE., .FALSE., 15) C variable format exp err CALL ERRSET(68, .TRUE., .FALSE., .TRUE., .FALSE., 15) CALL GTTYP(3) STDOUT = 3 2000 CONTINUE CALL GCMD(2, 'File? ', COMAND, NC, 134, SOURCE) IF (.NOT.(NC .LE. 0)) GOTO 2030 GOTO 2020 2030 CONTINUE ANS(1) = 'N' HDR = .FALSE. 2050 CONTINUE CALL PARSE(COMAND, FILE) IF (.NOT.(EQ(FILE, '/GO'))) GOTO 2080 ANS(1) = 'G' GOTO 2090 2080 CONTINUE IF (.NOT.(EQ(FILE, '/HD'))) GOTO 2100 HDR = .TRUE. GOTO 2090 2100 CONTINUE GOTO 2070 2090 CONTINUE 2060 GOTO 2050 2070 CONTINUE NFILE = 0 2120 IF (.NOT.(OPNDEF(1, FILE, ANS, NFILE, .TRUE.))) GOTO 2130 IF (.NOT.(REDIR(STDOUT, COMAND) .NE. -1)) GOTO 2140 IF (.NOT.(HDR)) GOTO 2160 CALL PUTHDR(STDOUT, FILE) 2160 CONTINUE CALL LISTIT(1, STDOUT, COMAND) CLOSE(UNIT = 1) C BLOCK IO call bclose(FILE$IN) GOTO 2150 2140 CONTINUE CLOSE(UNIT = 1) C BLOCK IO call bclose(FILE$IN) GOTO 2130 2150 CONTINUE GOTO 2120 2130 CONTINUE IF (.NOT.(STDOUT .NE. 3)) GOTO 2180 CLOSE(UNIT = STDOUT) STDOUT = 3 2180 CONTINUE 2010 IF (.NOT.(SOURCE .LT. 0)) GOTO 2000 2020 CONTINUE C command line was from MCR CALL PUT(3, 13, 1, IER) CALL TABBAK(3) END C listit - list the file SUBROUTINE LISTIT(F, STDOUT, COMND) BYTE COMND(1), COMAND(268), CMND, MACRO(268), LAST(268), INBUF(512 *), QBUF(520) INTEGER F, STDOUT, FOUT, FOLD, BLEN, CP, NLNUM, J, K, IER C ICR ONLY integer ffchar INTEGER*4NPRINT, NTOPRT, LINE1, LINE2, NUM, SAVE1, SAVE2, EOFLN, M *XSRCH, HLDDOT, TMPDOT LOGICAL PRINT, PRMMOD, BSFAIL, NOPRNT C ICR ONLY logical vmode INTEGER RCMD, GETINP, TYPLIN, GETNUM, CHSCAN, REPLAC, REDIR INTEGER*4PTSCAN BYTE CUPPER 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 COMMON/PAT/SNULL, SRCHST C .false. if srchst is valid; .true. otherwise LOGICAL SNULL C holds current search string BYTE SRCHST(268) C ICR ONLY include qiofn.cmn EQUIVALENCE(QBUF(9), INBUF(1)) C normal prompt mode DATA PRMMOD/.TRUE./ C ICR ONLY data vmode/.false./ # copy mode off C default macro puts you in line-by-line mode DATA MACRO(1), MACRO(2), MACRO(3), MACRO(4), MACRO(5), MACRO(6)/' *', '1', 'S', 'N', 'P', 0/ DATA LAST(1)/0/ CALL SCOPY(COMND, 1, COMAND, 1) FOUT = STDOUT CALL INITIO(F, FOUT) 2200 CONTINUE C cp points to current command in command buffer CP = 1 IF (.NOT.(REDIR(FOUT, COMAND) .EQ. -1)) GOTO 2230 C do file redirection COMAND(CP) = - 1 C do last replacement GOTO 2240 2230 CONTINUE IF (.NOT.(REPLAC('L', LAST, COMAND, 2*134, CP) .NE. 1)) GOTO 225 *0 CALL ERR(COMAND, CP, 'Command too long.') GOTO 2240 2250 CONTINUE J = CP IF (.NOT.(CHSCAN(COMAND, J, '[') .EQ. 1)) GOTO 2270 C define macro K = J + 1 IER = CHSCAN(COMAND, K, ']') COMAND(K) = 0 CALL SCOPY(COMAND, J + 1, MACRO, 1) C the null comand COMAND(J) = ' ' IF (.NOT.(IER .EQ. 1)) GOTO 2290 CALL SCOPY(COMAND, K + 1, COMAND, J + 1) GOTO 2300 2290 CONTINUE COMAND(J + 1) = 0 2300 CONTINUE C do macro replacement 2270 CONTINUE IF (.NOT.(REPLAC('M', MACRO, COMAND, 2*134, CP) .NE. 1)) GOTO *2310 CALL ERR(COMAND, CP, 'Command too long.') 2310 CONTINUE 2240 CONTINUE OLDOT = DOT 2330 CONTINUE PRINT = .FALSE. NTOPRT = 0 NPRINT = 0 NLNUM = 0 LINE2 = DOT HLDDOT = DOT SAVE2 = DOT NOPRNT = .FALSE. 2360 CONTINUE IF (.NOT.(COMAND(CP) .EQ. ',')) GOTO 2390 NOPRNT = .FALSE. CP = CP + 1 NLNUM = 2 LINE1 = LINE2 SAVE1 = SAVE2 2390 CONTINUE BSFAIL = .FALSE. TMPDOT = DOT IF (.NOT.(GETNUM(F, COMAND, CP, INBUF, BLEN, NUM, BSFAIL) .N *E. 1)) GOTO 2410 GOTO 2380 2410 CONTINUE NOPRNT = BSFAIL IF (.NOT.(NLNUM .EQ. 0)) GOTO 2430 NLNUM = 1 2430 CONTINUE SAVE2 = NUM LINE2 = MIN0(FMAX + 1, MAX0(1, NUM)) DOT = LINE2 IF (.NOT.(NLNUM .LE. 1)) GOTO 2450 HLDDOT = TMPDOT 2450 CONTINUE 2370 GOTO 2360 2380 CONTINUE CMND = CUPPER(COMAND(CP)) IF (.NOT.(CMND .EQ. 0 .OR. CMND .EQ. 'P' .OR. CMND .EQ. 27)) G *OTO 2470 PRINT = .TRUE. IF (.NOT.(CMND .EQ. 0)) GOTO 2490 C will add 1 later CP = CP - 1 2490 CONTINUE IF (.NOT.(NLNUM .LE. 1 .AND. CMND .EQ. 27)) GOTO 2510 DOT = DOT - 2*SCRSIZ IF (.NOT.(DOT .LT. 1)) GOTO 2530 IF (.NOT.((TOPSCR .EQ. 1 .AND. NLNUM .EQ. 0) .OR. LINE2 *.EQ. 1)) GOTO 2550 PRINT = .FALSE. 2550 CONTINUE DOT = 1 2530 CONTINUE GOTO 2520 2510 CONTINUE IF (.NOT.(NLNUM .GE. 2)) GOTO 2570 IF (.NOT.(LINE2 .LT. LINE1)) GOTO 2590 PRINT = .FALSE. GOTO 2600 2590 CONTINUE NTOPRT = (LINE2 - LINE1) + 1 2600 CONTINUE DOT = LINE1 2570 CONTINUE 2520 CONTINUE GOTO 2480 2470 CONTINUE IF (.NOT.(CMND .EQ. ' ')) GOTO 2610 GOTO 2480 2610 CONTINUE IF (.NOT.(CMND .EQ. 'G')) GOTO 2630 PRINT = .TRUE. IF (.NOT.(NLNUM .LE. 1)) GOTO 2650 NTOPRT = 1 GOTO 2660 2650 CONTINUE IF (.NOT.(LINE2 .LT. LINE1)) GOTO 2670 PRINT = .FALSE. GOTO 2680 2670 CONTINUE NTOPRT = (LINE2 - LINE1) + 1 2680 CONTINUE DOT = LINE1 2660 CONTINUE GOTO 2480 2630 CONTINUE IF (.NOT.(CMND .EQ. 'S')) GOTO 2690 DOT = HLDDOT IF (.NOT.(NLNUM .EQ. 0)) GOTO 2710 SCRSIZ = 23 GOTO 2720 2710 CONTINUE IF (.NOT.(NLNUM .EQ. 1)) GOTO 2730 SCRSIZ = MAX0(1, SAVE2) GOTO 2720 2730 CONTINUE SCRSIZ = MAX0(1, (LINE2 - LINE1) + 1) 2720 CONTINUE GOTO 2480 2690 CONTINUE IF (.NOT.(CMND .EQ. 'C')) GOTO 2750 LSTRED = 0 DOT = HLDDOT IF (.NOT.(NLNUM .EQ. 0)) GOTO 2770 LOWC = 1 HIGHC = 512 GOTO 2780 2770 CONTINUE IF (.NOT.(NLNUM .EQ. 1)) GOTO 2790 LOWC = 1 HIGHC = MAX0(1, SAVE2) GOTO 2780 2790 CONTINUE LOWC = MAX0(1, SAVE1) HIGHC = MAX0(LOWC, SAVE2) 2780 CONTINUE C C the W command is installation dependent because the screen width C value returned from the system is different on M systems than IAS. C Fix it if you like. C C ICR ONLY else if (cmnd == 'W') { C ICR ONLY dot = hlddot C ICR ONLY if (nlnum == 0) C ICR ONLY scrwid = syswid C ICR ONLY else C ICR ONLY scrwid = max0(1, save2) C ICR ONLY call setwid(TT$OUT, scrwid) C ICR ONLY } GOTO 2480 2750 CONTINUE IF (.NOT.(CMND .EQ. 'N')) GOTO 2810 PRMMOD = .NOT.PRMMOD GOTO 2480 2810 CONTINUE IF (.NOT.(CMND .EQ. 'F')) GOTO 2830 IF (.NOT.(NLNUM .EQ. 0)) GOTO 2850 FOFF = 0 FMAX = 2147483647 - 1 GOTO 2860 2850 CONTINUE IF (.NOT.(NLNUM .EQ. 1)) GOTO 2870 FOFF = FOFF + HLDDOT - 1 FMAX = MIN0((FMAX - HLDDOT) + 1, LINE2) GOTO 2860 2870 CONTINUE FOFF = FOFF + LINE1 - 1 FMAX = MAX0(0, (MIN0(LINE2, FMAX) - LINE1) + 1) 2860 CONTINUE DOT = 1 GOTO 2480 2830 CONTINUE IF (.NOT.(CMND .EQ. 'R')) GOTO 2890 SCRSIZ = 23 SCRWID = SYSWID LOWC = 1 HIGHC = 512 FOFF = 0 FMAX = 2147483647 - 1 PRMMOD = .TRUE. GOTO 2480 2890 CONTINUE IF (.NOT.(CMND .EQ. 'X')) GOTO 2910 GOTO 2350 C ICR ONLY else if (cmnd == 'V') { C ICR ONLY if (~vmode & fout == TT$OUT) { C ICR ONLY call setwid(TT$OUT, 132) # print 132 columns C ICR ONLY call escseq(fout, '[5i') # turn printer on C ICR ONLY call qiofn(TT$OUT, SFGMC, TCHFF, ffchar, ier) # save FF characte Cristic C ICR ONLY call qiofn(TT$OUT, SFSMC, TCHFF, 1, ier) # set HFF on C ICR ONLY } C ICR ONLY vmode = fout == TT$OUT C ICR ONLY } 2910 CONTINUE IF (.NOT.(CMND .EQ. 'H')) GOTO 2930 CALL RUNSYS('LIS LB:[1,2]LIST.HLP 24SP', 25, IER) CALL WAITSY C NO HELP call err(comand, cp, 'Help is not available yet.') GOTO 2480 2930 CONTINUE IF (.NOT.(CMND .EQ. '=')) GOTO 2950 SAVDOT = DOT GOTO 2480 2950 CONTINUE IF (.NOT.(CMND .EQ. '?')) GOTO 2970 IF (.NOT.(SNULL)) GOTO 2990 CALL ERR(COMAND, CP, 'Current search string is null.') GOTO 3000 2990 CONTINUE PRINT = .TRUE. EOFLN = 1 MXSRCH = FMAX IF (.NOT.(NLNUM .GE. 2)) GOTO 3010 DOT = LINE1 IF (.NOT.(LINE2 .LT. LINE1)) GOTO 3030 PRINT = .FALSE. GOTO 3040 3030 CONTINUE EOFLN = LINE1 MXSRCH = LINE2 NTOPRT = (LINE2 - LINE1) + 1 3040 CONTINUE 3010 CONTINUE 3000 CONTINUE GOTO 2480 2970 CONTINUE IF (.NOT.(COMAND(CP) .NE. -1)) GOTO 3050 CALL ERR(COMAND, CP, 'Illegal command. Type H for help.') C NO HELP call err(comand, cp, 'Illegal command.') 3050 CONTINUE 2480 CONTINUE CALL POSIT(F, DOT) IF (.NOT.(COMAND(CP) .NE. -1)) GOTO 3070 CP = CP + 1 3070 CONTINUE IF (.NOT.(PRINT)) GOTO 3090 TOPSCR = DOT 3090 CONTINUE IF (.NOT.(PRINT .AND. .NOT.NOPRNT)) GOTO 3110 IF (.NOT.(CMND .EQ. '?')) GOTO 3130 3150 CONTINUE IF (.NOT.(PTSCAN(F, INBUF, BLEN, MXSRCH) .EQ. -10)) GOTO * 3180 DOT = EOFLN GOTO 3170 3180 CONTINUE IF (.NOT.(NPRINT .EQ. 0)) GOTO 3200 TOPSCR = DOT 3200 CONTINUE ENCODE(8, 10, QBUF) DOT 10 FORMAT(I7, '>') 3160 IF (.NOT.(TYPLIN(FOUT, QBUF, BLEN+8, NPRINT, NTOPRT, .TRUE *.) .EQ. 0)) GOTO 3150 3170 CONTINUE GOTO 3140 3130 CONTINUE 3220 CONTINUE IF (.NOT.(GETINP(F, INBUF, BLEN) .EQ. -10)) GOTO 3250 GOTO 3240 3250 CONTINUE 3230 IF (.NOT.(TYPLIN(FOUT, INBUF, BLEN, NPRINT, NTOPRT, .FALSE *.) .EQ. 0)) GOTO 3220 3240 CONTINUE IF (.NOT.(CMND .EQ. 'G')) GOTO 3270 DOT = TOPSCR 3270 CONTINUE 3140 CONTINUE 3110 CONTINUE 2340 IF (.NOT.(COMAND(CP) .EQ. 0 .OR. COMAND(CP) .EQ. -1)) GOTO 2330 2350 CONTINUE IF (.NOT.(COMAND(CP) .NE. -1)) GOTO 3290 C save command buffer CALL SCOPY(COMAND, 1, LAST, 1) C ICR ONLY if (vmode) { C ICR ONLY vmode = .false. C ICR ONLY call escseq(fout, '[4i') # turn printer off C ICR ONLY call setwid(TT$OUT, scrwid) C ICR ONLY call qiofn(TT$OUT,SFSMC,TCHFF,ffchar,ier)# restore old FF characte Cristic C ICR ONLY } 3290 CONTINUE FOLD = FOUT IF (.NOT.(FOUT .NE. STDOUT)) GOTO 3310 CLOSE(UNIT = FOUT) FOUT = STDOUT CALL GFTYP(FOUT, OUTCC) 3310 CONTINUE IF (.NOT.(CMND .EQ. 'X')) GOTO 3330 GOTO 2220 3330 CONTINUE 2210 IF (.NOT.(RCMD(COMAND, DOT, PRMMOD .OR. NPRINT .EQ. 0 .OR. FOLD .N *E. 3) .EQ. -10)) GOTO 2200 2220 CONTINUE IF (.NOT.(FOUT .EQ. 3)) GOTO 3350 C then put trailing CR CALL PUT(FOUT, 13, 1, IER) 3350 CONTINUE RETURN END