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 list - driver program for LIST file listing facility PROGRAM LIST BYTE COMAND(134 + 125), FILE(134), ANS(2) INTEGER NC, SOURCE, STDOUT, NFILE, FTMP, IER LOGICAL HDR INTEGER REDIR LOGICAL OPNDEF, EQ, GETFIL FTMP = 2 open(unit=ftmp, name='TI:', carriagecontrol='LIST') FTMP = 3 open(unit=ftmp, name='TI:', carriagecontrol='NONE', * 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(2) 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 2110 2100 CONTINUE GOTO 2070 2110 CONTINUE 2090 CONTINUE 2060 GOTO 2050 2070 CONTINUE NFILE = 0 2120 IF (.NOT.(GETFIL(FILE, ANS, NFILE, .TRUE.))) GOTO 2130 IF (.NOT.(OPNDEF(1, FILE))) GOTO 2140 IF (.NOT.(REDIR(STDOUT, COMAND) .NE. -1)) GOTO 2160 IF (.NOT.(HDR)) GOTO 2180 CALL PUTHDR(STDOUT, FILE) 2180 CONTINUE CALL LISTIT(1, STDOUT, COMAND) CLOSE(UNIT = 1) C BLOCK IO call bclose(FILEIN) GOTO 2170 2160 CONTINUE CLOSE(UNIT = 1) C BLOCK IO call bclose(FILEIN) GOTO 2130 2170 CONTINUE 2140 CONTINUE GOTO 2120 2130 CONTINUE IF (.NOT.(STDOUT .NE. 3)) GOTO 2200 CLOSE(UNIT = STDOUT) STDOUT = 3 2200 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(2) END C listit - list the file SUBROUTINE LISTIT(F, STDOUT, COMND) BYTE COMND(1), COMAND(2*134), CMND, MACRO(2*134), LAST(2*134), INB *UF(512), QBUF(512 + 8) 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, 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 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. 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 DATA MACRO(1), MACRO(2), MACRO(3), MACRO(4), MACRO(5), MACRO(6)/' C default puts you in line-by-line mode *', '1', 'S', 'N', 'P', 0/ DATA LAST(1)/0/ CALL SCOPY(COMND, 1, COMAND, 1) FOUT = STDOUT CALL INITIO(F, FOUT) 2220 CONTINUE C cp points to current command in command buffer CP = 1 IF (.NOT.(REDIR(FOUT, COMAND) .EQ. -1)) GOTO 2250 C do file redirection COMAND(CP) = - 1 C do last replacement GOTO 2260 2250 CONTINUE IF (.NOT.(REPLAC('L', LAST, COMAND, 2*134, CP) .NE. 1)) GOTO 2 *270 CALL ERR(COMAND, CP, 'Command too long.') GOTO 2280 2270 CONTINUE J = CP IF (.NOT.(CHSCAN(COMAND, J, '[') .EQ. 1)) GOTO 2290 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 2310 CALL SCOPY(COMAND, K + 1, COMAND, J + 1) GOTO 2320 2310 CONTINUE COMAND(J + 1) = 0 2320 CONTINUE C do macro replacement 2290 CONTINUE IF (.NOT.(REPLAC('M', MACRO, COMAND, 2*134, CP) .NE. 1)) GOT *O 2330 CALL ERR(COMAND, CP, 'Command too long.') 2330 CONTINUE 2280 CONTINUE 2260 CONTINUE ODOT = DOT 2350 CONTINUE PRINT = .FALSE. NTOPRT = 0 NPRINT = 0 NLNUM = 0 LINE2 = DOT HLDDOT = DOT SAVE2 = DOT NOPRNT = .FALSE. 2380 CONTINUE IF (.NOT.(COMAND(CP) .EQ. ',')) GOTO 2410 NOPRNT = .FALSE. CP = CP + 1 NLNUM = 2 LINE1 = LINE2 SAVE1 = SAVE2 2410 CONTINUE BSFAIL = .FALSE. TMPDOT = DOT IF (.NOT.(GETNUM(F, COMAND, CP, INBUF, BLEN, NUM, BSFAIL) .N *E. 1)) GOTO 2430 GOTO 2400 2430 CONTINUE NOPRNT = BSFAIL IF (.NOT.(NLNUM .EQ. 0)) GOTO 2450 NLNUM = 1 2450 CONTINUE SAVE2 = NUM LINE2 = MIN0(FMAX + 1, MAX0(1, NUM)) DOT = LINE2 IF (.NOT.(NLNUM .LE. 1)) GOTO 2470 HLDDOT = TMPDOT 2470 CONTINUE 2390 GOTO 2380 2400 CONTINUE CMND = CUPPER(COMAND(CP)) IF (.NOT.(CMND .EQ. 0 .OR. CMND .EQ. 'P' .OR. CMND .EQ. 27)) G *OTO 2490 PRINT = .TRUE. IF (.NOT.(CMND .EQ. 0)) GOTO 2510 C will add 1 later CP = CP - 1 2510 CONTINUE IF (.NOT.(NLNUM .LE. 1 .AND. CMND .EQ. 27)) GOTO 2530 DOT = DOT - 2*SCRSIZ IF (.NOT.(DOT .LT. 1)) GOTO 2550 IF (.NOT.((TOPSCR .EQ. 1 .AND. NLNUM .EQ. 0) .OR. LINE2 *.EQ. 1)) GOTO 2570 PRINT = .FALSE. 2570 CONTINUE DOT = 1 2550 CONTINUE GOTO 2540 2530 CONTINUE IF (.NOT.(NLNUM .GE. 2)) GOTO 2590 IF (.NOT.(LINE2 .LT. LINE1)) GOTO 2610 PRINT = .FALSE. GOTO 2620 2610 CONTINUE NTOPRT = (LINE2 - LINE1) + 1 2620 CONTINUE DOT = LINE1 2590 CONTINUE 2540 CONTINUE GOTO 2500 2490 CONTINUE IF (.NOT.(CMND .EQ. ' ')) GOTO 2630 GOTO 2640 2630 CONTINUE IF (.NOT.(CMND .EQ. 'G')) GOTO 2650 PRINT = .TRUE. IF (.NOT.(NLNUM .LE. 1)) GOTO 2670 NTOPRT = 1 GOTO 2680 2670 CONTINUE IF (.NOT.(LINE2 .LT. LINE1)) GOTO 2690 PRINT = .FALSE. GOTO 2700 2690 CONTINUE NTOPRT = (LINE2 - LINE1) + 1 2700 CONTINUE DOT = LINE1 2680 CONTINUE GOTO 2660 2650 CONTINUE IF (.NOT.(CMND .EQ. 'S')) GOTO 2710 DOT = HLDDOT IF (.NOT.(NLNUM .EQ. 0)) GOTO 2730 SCRSIZ = 23 GOTO 2740 2730 CONTINUE IF (.NOT.(NLNUM .EQ. 1)) GOTO 2750 SCRSIZ = MAX0(1, SAVE2) GOTO 2760 2750 CONTINUE SCRSIZ = MAX0(1, (LINE2 - LINE1) + 1) 2760 CONTINUE 2740 CONTINUE GOTO 2720 2710 CONTINUE IF (.NOT.(CMND .EQ. 'C')) GOTO 2770 LSTRED = 0 DOT = HLDDOT IF (.NOT.(NLNUM .EQ. 0)) GOTO 2790 LOWC = 1 HIGHC = 512 GOTO 2800 2790 CONTINUE IF (.NOT.(NLNUM .EQ. 1)) GOTO 2810 LOWC = 1 HIGHC = MAX0(1, SAVE2) GOTO 2820 2810 CONTINUE LOWC = MAX0(1, SAVE1) HIGHC = MAX0(LOWC, SAVE2) 2820 CONTINUE 2800 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(TERM, scrwid) C ICR ONLY } GOTO 2780 2770 CONTINUE IF (.NOT.(CMND .EQ. 'N')) GOTO 2830 PRMMOD = .NOT.PRMMOD GOTO 2840 2830 CONTINUE IF (.NOT.(CMND .EQ. 'F')) GOTO 2850 IF (.NOT.(NLNUM .EQ. 0)) GOTO 2870 FOFF = 0 FMAX = 2147483647 - 1 GOTO 2880 2870 CONTINUE IF (.NOT.(NLNUM .EQ. 1)) GOTO 2890 FOFF = FOFF + HLDDOT - 1 FMAX = MIN0((FMAX - HLDDOT) + 1, LINE2) GOTO 2900 2890 CONTINUE FOFF = FOFF + LINE1 - 1 FMAX = MAX0(0, (MIN0(LINE2, FMAX) - LINE1) + * 1) 2900 CONTINUE 2880 CONTINUE DOT = 1 GOTO 2860 2850 CONTINUE IF (.NOT.(CMND .EQ. 'R')) GOTO 2910 SCRSIZ = 23 SCRWID = SYSWID LOWC = 1 HIGHC = 512 FOFF = 0 FMAX = 2147483647 - 1 PRMMOD = .TRUE. GOTO 2920 2910 CONTINUE IF (.NOT.(CMND .EQ. 'X')) GOTO 2930 GOTO 2370 C ICR ONLY else if (cmnd == 'V') { C ICR ONLY if (~vmode & fout == NONETERM) { C ICR ONLY call setwid(TERM, 132) # print 132 columns C ICR ONLY call escseq(fout, '[5i') # turn printer on C ICR ONLY call qiofn(TERM, SFGMC, TCHFF, ffchar, ier) # save FF characteristic C ICR ONLY call qiofn(TERM, SFSMC, TCHFF, 1, ier) # set HFF on C ICR ONLY } C ICR ONLY vmode = fout == NONETERM C ICR ONLY } 2930 CONTINUE IF (.NOT.(CMND .EQ. 'H')) GOTO 2950 CALL RUNSYS('LIS LB:[1,2]LIST.HLP 24SP', 2 *5, IER) CALL WAITSY C NO HELP call err(comand, cp, 'Help is not available yet.') GOTO 2960 2950 CONTINUE IF (.NOT.(CMND .EQ. '=')) GOTO 2970 SAVDOT = DOT GOTO 2980 2970 CONTINUE IF (.NOT.(CMND .EQ. '?')) GOTO 2990 IF (.NOT.(SLEN .EQ. 0)) GOTO 3010 CALL ERR(COMAND, CP, 'Current search * string is null.') GOTO 3020 3010 CONTINUE PRINT = .TRUE. EOFLN = 1 MXSRCH = FMAX IF (.NOT.(NLNUM .GE. 2)) GOTO 3030 DOT = LINE1 IF (.NOT.(LINE2 .LT. LINE1)) GOTO *3050 PRINT = .FALSE. GOTO 3060 3050 CONTINUE EOFLN = LINE1 MXSRCH = LINE2 NTOPRT = (LINE2 - LINE1) + 1 3060 CONTINUE 3030 CONTINUE 3020 CONTINUE GOTO 3000 2990 CONTINUE IF (.NOT.(COMAND(CP) .NE. -1)) GOTO 30 *70 CALL ERR(COMAND, CP, 'Illegal comman *d. Type H for help.') C NO HELP call err(comand, cp, 'Illegal command.') 3070 CONTINUE 3000 CONTINUE 2980 CONTINUE 2960 CONTINUE 2940 CONTINUE 2920 CONTINUE 2860 CONTINUE 2840 CONTINUE 2780 CONTINUE 2720 CONTINUE 2660 CONTINUE 2640 CONTINUE 2500 CONTINUE CALL POSIT(F, DOT) IF (.NOT.(COMAND(CP) .NE. -1)) GOTO 3090 CP = CP + 1 3090 CONTINUE IF (.NOT.(PRINT)) GOTO 3110 TOPSCR = DOT 3110 CONTINUE IF (.NOT.(PRINT .AND. .NOT.NOPRNT)) GOTO 3130 IF (.NOT.(CMND .EQ. '?')) GOTO 3150 3170 CONTINUE IF (.NOT.(PTSCAN(F, INBUF, BLEN, MXSRCH) .EQ. -10)) GOTO * 3200 DOT = EOFLN GOTO 3190 3200 CONTINUE IF (.NOT.(NPRINT .EQ. 0)) GOTO 3220 TOPSCR = DOT 3220 CONTINUE ENCODE(8, 10, QBUF) DOT 10 FORMAT(I7, '>') 3180 IF (.NOT.(TYPLIN(FOUT, QBUF, BLEN+8, NPRINT, NTOPRT, .TR *UE.) .EQ. 0)) GOTO 3170 3190 CONTINUE GOTO 3160 3150 CONTINUE 3240 CONTINUE IF (.NOT.(GETINP(F, INBUF, BLEN) .EQ. -10)) GOTO 3270 GOTO 3260 3270 CONTINUE 3250 IF (.NOT.(TYPLIN(FOUT, INBUF, BLEN, NPRINT, NTOPRT, .FAL *SE.) .EQ. 0)) GOTO 3240 3260 CONTINUE IF (.NOT.(CMND .EQ. 'G')) GOTO 3290 DOT = TOPSCR 3290 CONTINUE 3160 CONTINUE 3130 CONTINUE 2360 IF (.NOT.(COMAND(CP) .EQ. 0 .OR. COMAND(CP) .EQ. -1)) GOTO 235 *0 2370 CONTINUE IF (.NOT.(COMAND(CP) .NE. -1)) GOTO 3310 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(TERM, scrwid) C ICR ONLY call qiofn(TERM,SFSMC,TCHFF,ffchar,ier) # restore old FF characteristic C ICR ONLY } 3310 CONTINUE FOLD = FOUT IF (.NOT.(FOUT .NE. STDOUT)) GOTO 3330 CLOSE(UNIT = FOUT) FOUT = STDOUT CALL GFTYP(FOUT, OUTCC) 3330 CONTINUE IF (.NOT.(CMND .EQ. 'X')) GOTO 3350 GOTO 2240 3350 CONTINUE 2230 IF (.NOT.(RCMD(COMAND, DOT, PRMMOD .OR. NPRINT .EQ. 0 .OR. FOLD *.NE. 3) .EQ. -10)) GOTO 2220 2240 CONTINUE IF (.NOT.(FOUT .EQ. 3)) GOTO 3370 C then put trailing CR CALL PUT(FOUT, 13, 1, IER) 3370 CONTINUE RETURN END