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 list - driver program for LIST file listing facility PROGRAM LIST BYTE COMAND(233), FILE(134), ANS(4) INTEGER NC, NANS, SOURCE, JUNK, STDOUT, PROMPT, NFILE, IER, RSTAT LOGICAL LER INTEGER REDIR LOGICAL OPNDEF, MATSWI 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/ OPEN(UNIT = 2, NAME = 'TI:', TYPE = 'OLD') OPEN(UNIT = 3, NAME = 'TI:', CARRIAGECONTROL = 'NONE', TYPE = 'NEW *') 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) STDOUT = 3 CALL GCCTYP(3, TTCC) OUTCC = TTCC CALL GTTYP(3) 2000 CONTINUE CALL GCMD(2, 'File? ', COMAND, NC, 134, SOURCE) IF (.NOT.(NC .LE. 0)) GOTO 2030 GOTO 2020 2030 CONTINUE PROMPT = 0 FLAGS(1) = .FALSE. FLAGS(2) = .TRUE. FLAGS(3) = .FALSE. FLAGS(4) = .FALSE. 2050 CONTINUE CALL PARSE(COMAND, FILE) LER = .FALSE. IF (.NOT.(FILE(1) .EQ. '/')) GOTO 2080 IF (.NOT.(MATSWI(FILE, '/Prompt', LER))) GOTO 2100 PROMPT = 1 GOTO 2110 2100 CONTINUE IF (.NOT.(MATSWI(FILE, '/Go', LER) .OR. MATSWI(FILE, '/NOPro *mpt', LER))) GOTO 2120 PROMPT = 2 GOTO 2110 2120 CONTINUE IF (.NOT.(MATSWI(FILE, '/HD', LER) .OR. MATSWI(FILE, '/Heade *r', LER))) GOTO 2140 FLAGS(1) = .TRUE. GOTO 2110 2140 CONTINUE IF (.NOT.(MATSWI(FILE, '/NOHeader', LER))) GOTO 2160 FLAGS(1) = .FALSE. GOTO 2110 2160 CONTINUE IF (.NOT.(MATSWI(FILE, '/NUmbers', LER))) GOTO 2180 FLAGS(2) = .TRUE. GOTO 2110 2180 CONTINUE IF (.NOT.(MATSWI(FILE, '/NONumbers', LER))) GOTO 2200 FLAGS(2) = .FALSE. GOTO 2110 2200 CONTINUE IF (.NOT.(MATSWI(FILE, '/Trim', LER))) GOTO 2220 FLAGS(3) = .TRUE. GOTO 2110 2220 CONTINUE IF (.NOT.(MATSWI(FILE, '/NOTrim', LER))) GOTO 2240 FLAGS(3) = .FALSE. GOTO 2110 2240 CONTINUE IF (.NOT.(MATSWI(FILE, '/Delete', LER))) GOTO 2260 FLAGS(4) = .TRUE. GOTO 2110 2260 CONTINUE IF (.NOT.(MATSWI(FILE, '/NODelete', LER))) GOTO 2280 FLAGS(4) = .FALSE. GOTO 2110 2280 CONTINUE IF (.NOT.(.NOT.LER)) GOTO 2300 CALL ERR(FILE, 2, 'Invalid switch.') 2300 CONTINUE GOTO 2010 2110 CONTINUE GOTO 2090 2080 CONTINUE GOTO 2070 2090 CONTINUE 2060 GOTO 2050 2070 CONTINUE NFILE = 0 2320 IF (.NOT.(OPNDEF(1, FILE, PROMPT, NFILE))) GOTO 2330 IF (.NOT.(REDIR(STDOUT, COMAND, RSTAT) .NE. -1)) GOTO 2340 IF (.NOT.(FLAGS(1))) GOTO 2360 CALL PUTHDR(STDOUT, FILE) 2360 CONTINUE CALL LISTIT(1, STDOUT, COMAND) IF (.NOT.(FLAGS(4))) GOTO 2380 CALL GCMD(2, 'Delete? ', ANS, NANS, 4, JUNK) IF (.NOT.(NANS .LT. 0)) GOTO 2400 C close(unit = FILE$IN) CALL BCLOSE(1, 'S', JUNK) GOTO 2330 2400 CONTINUE IF (.NOT.(MATSWI(ANS, 'Yes', LER))) GOTO 2420 C close(unit = FILE$IN, dispose = 'delete') CALL BCLOSE(1, 'D', JUNK) GOTO 2430 2420 CONTINUE C close(unit = FILE$IN) CALL BCLOSE(1, 'S', JUNK) 2430 CONTINUE GOTO 2390 2380 CONTINUE C close(unit = FILE$IN) CALL BCLOSE(1, 'S', JUNK) 2390 CONTINUE IF (.NOT.((((RSTAT) .AND. (4)) .NE. 0))) GOTO 2440 C redirected to wild file? CLOSE(UNIT = STDOUT) STDOUT = 3 OUTCC = TTCC C redirect last CALL CONCAT(COMAND, '>', 134 + 99) IF (.NOT.((((RSTAT) .AND. (2)) .NE. 0))) GOTO 2460 CALL CONCAT(COMAND, '>', 134 + 99) 2460 CONTINUE 2440 CONTINUE GOTO 2350 2340 CONTINUE C close(unit = FILE$IN) CALL BCLOSE(1, 'S', JUNK) GOTO 2330 2350 CONTINUE GOTO 2320 2330 CONTINUE IF (.NOT.(STDOUT .NE. 3)) GOTO 2480 CLOSE(UNIT = STDOUT) STDOUT = 3 OUTCC = TTCC 2480 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) CALL EXIT(XSTAT) END C listit - list the file SUBROUTINE LISTIT(F, STDOUT, COMND) BYTE COMND(1), COMAND(268), CMND, INBUF(512), QBUF(520) INTEGER F, STDOUT, FOUT, FOLD, BLEN, CP, NLNUM, J, K, IER, RSTAT, *SSTAT, FFCHAR, DUMMY INTEGER*4NPRINT, LASTPR, LINE1, LINE2, NUM, EOFLN, MXSRCH, HLDDOT, * TMPHLD INTEGER*4PCOUNT(4) INTEGER PMARK(4), PEND(4), PLEVEL LOGICAL PRINT, PRMMOD, NOPRNT, GOTBRK, FINDRP, DTMODE INTEGER RCMD, GETINP, REDIR INTEGER*4PTSCAN BYTE CUPPER LOGICAL GETNUM, CHSCAN, REPLAC, TYPLIN 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 COMMON/PAT/SNULL, SRCHST C .false. if srchst is valid; .true. otherwise LOGICAL SNULL C holds current search string BYTE SRCHST(268) COMMON/TTCHAR/WIDFAC, SAVTAB, TCTTP, TCWID, TCHHT, TCHFF, TCACR, S *FSMC, SFGMC, TV100, TVT52, IOATT, IODET C correction factor for width returned by system, INTEGER*2WIDFAC C patched by task builder to be 1 for IAS, 0 otherwise C saves value of system's hardware tabs flag INTEGER*2SAVTAB C qio function codes etc. INTEGER*2TCTTP, TCWID, TCHHT, TCHFF, TCACR, SFSMC, SFGMC, TV100, T *VT52, IOATT, IODET C 0 for RSX, patched to 1 by TKB for IAS - DATA WIDFAC/0/ C subtracted from screen width returned by system C default macro puts you in line-by-line mode BYTE MACRO(268) BYTE LAST(268) DATA MACRO(1)/32/,MACRO(2)/49/,MACRO(3)/83/,MACRO(4)/78/,MACRO(5)/ *80/,MACRO(6)/0/ DATA LAST(1)/0/ C normal prompt mode DATA PRMMOD/.TRUE./ C DT80 print mode off DATA DTMODE/.FALSE./ C integer aligned EQUIVALENCE(QBUF(9), INBUF(1)), (QBUF(1), DUMMY) CALL SCOPY(COMND, 1, COMAND, 1) FOUT = STDOUT CALL INITIO(F, FOUT) 2500 CONTINUE C cp points to current command in command buffer CP = 1 IF (.NOT.(REDIR(FOUT, COMAND, RSTAT) .EQ. -1)) GOTO 2530 C do file redirection COMAND(CP) = - 1 C do last replacement GOTO 2540 2530 CONTINUE IF (.NOT.(.NOT.REPLAC('L', LAST, COMAND, 2*134, CP))) GOTO 2550 CALL ERR(COMAND, CP, 'Command too long.') GOTO 2540 2550 CONTINUE J = CP IF (.NOT.(CHSCAN(COMAND, J, '['))) GOTO 2570 C define macro K = J + 1 GOTBRK = CHSCAN(COMAND, K, ']') COMAND(K) = 0 CALL SCOPY(COMAND, J + 1, MACRO, 1) C the null comand COMAND(J) = ' ' IF (.NOT.(GOTBRK)) GOTO 2590 CALL SCOPY(COMAND, K + 1, COMAND, J + 1) GOTO 2600 2590 CONTINUE COMAND(J + 1) = 0 2600 CONTINUE C do macro replacement 2570 CONTINUE IF (.NOT.(.NOT.REPLAC('M', MACRO, COMAND, 2*134, CP))) GOTO 26 *10 CALL ERR(COMAND, CP, 'Command too long.') 2610 CONTINUE 2540 CONTINUE PLEVEL = 0 BCLDOT = DOT 2630 CONTINUE PRINT = .FALSE. NOPRNT = .FALSE. LASTPR = 0 NPRINT = 0 NLNUM = 0 HLDDOT = DOT LINE2 = DOT 2660 CONTINUE IF (.NOT.(COMAND(CP) .EQ. ',')) GOTO 2690 NOPRNT = .FALSE. CP = CP + 1 NLNUM = 2 LINE1 = LINE2 2690 CONTINUE TMPHLD = DOT IF (.NOT.(.NOT.GETNUM(F, COMAND, CP, INBUF, BLEN, NUM, SSTAT *))) GOTO 2710 GOTO 2680 2710 CONTINUE IF (.NOT.(PLEVEL .GT. 0 .AND. (((SSTAT) .AND. (1 .OR. 2)) .N *E. 0))) GOTO 2730 CP = PEND(PLEVEL) PCOUNT(PLEVEL) = 0 GOTO 2680 2730 CONTINUE NOPRNT = (((SSTAT) .AND. (2)) .NE. 0) IF (.NOT.(NLNUM .EQ. 0)) GOTO 2750 NLNUM = 1 2750 CONTINUE LINE2 = NUM DOT = NUM IF (.NOT.(NLNUM .LE. 1)) GOTO 2770 HLDDOT = TMPHLD 2770 CONTINUE 2670 GOTO 2660 2680 CONTINUE CMND = CUPPER(COMAND(CP)) IF (.NOT.(CMND .EQ. 0 .OR. CMND .EQ. 'P' .OR. CMND .EQ. 27)) G *OTO 2790 PRINT = .TRUE. IF (.NOT.(NLNUM .LE. 1 .AND. CMND .EQ. 27)) GOTO 2810 DOT = DOT - SCRSIZ - SCRSIZ IF (.NOT.(DOT .LT. 1)) GOTO 2830 IF (.NOT.((TOPSCR .EQ. 1 .AND. NLNUM .EQ. 0) .OR. LINE2 *.LE. 1)) GOTO 2850 PRINT = .FALSE. 2850 CONTINUE DOT = 1 2830 CONTINUE GOTO 2820 2810 CONTINUE IF (.NOT.(NLNUM .GE. 2)) GOTO 2870 IF (.NOT.(LINE2 .LT. 1)) GOTO 2890 PRINT = .FALSE. GOTO 2900 2890 CONTINUE LASTPR = LINE2 2900 CONTINUE DOT = LINE1 2870 CONTINUE 2820 CONTINUE GOTO 2800 2790 CONTINUE IF (.NOT.(CMND .EQ. '(')) GOTO 2910 DOT = HLDDOT IF (.NOT.(PLEVEL .GE. 4)) GOTO 2930 CALL ERR(COMAND, CP, 'Too many parenthesis levels.') GOTO 2940 2930 CONTINUE IF (.NOT.(.NOT.FINDRP(COMAND, CP, PEND(PLEVEL+1)))) GOTO 295 *0 CALL ERR(COMAND, PEND(PLEVEL + 1), 'Matching end parenthes *is expected.') GOTO 2940 2950 CONTINUE PLEVEL = PLEVEL + 1 PMARK(PLEVEL) = CP IF (.NOT.(NLNUM .EQ. 0)) GOTO 2970 PCOUNT(PLEVEL) = - 1 GOTO 2980 2970 CONTINUE IF (.NOT.(NLNUM .EQ. 1)) GOTO 2990 PCOUNT(PLEVEL) = MAX0(0, LINE2) GOTO 2980 2990 CONTINUE PCOUNT(PLEVEL) = MAX0(0, (LINE2 - LINE1) + 1) 2980 CONTINUE IF (.NOT.(PCOUNT(PLEVEL) .EQ. 0)) GOTO 3010 CP = PEND(PLEVEL) PLEVEL = PLEVEL - 1 3010 CONTINUE 2940 CONTINUE GOTO 2800 2910 CONTINUE IF (.NOT.(CMND .EQ. ')')) GOTO 3030 IF (.NOT.(PLEVEL .LT. 1)) GOTO 3050 CALL ERR(COMAND, CP, 'Unexpected right parenthesis.') GOTO 3060 3050 CONTINUE IF (.NOT.(PCOUNT(PLEVEL) .GT. 0)) GOTO 3070 PCOUNT(PLEVEL) = PCOUNT(PLEVEL) - 1 3070 CONTINUE IF (.NOT.(PCOUNT(PLEVEL) .NE. 0)) GOTO 3090 CP = PMARK(PLEVEL) GOTO 3100 3090 CONTINUE PLEVEL = PLEVEL - 1 3100 CONTINUE 3060 CONTINUE GOTO 2800 3030 CONTINUE IF (.NOT.(CMND .EQ. ' ')) GOTO 3110 GOTO 2800 3110 CONTINUE IF (.NOT.(CMND .EQ. 'G')) GOTO 3130 PRINT = .TRUE. IF (.NOT.(NLNUM .LE. 1)) GOTO 3150 LASTPR = DOT GOTO 3160 3150 CONTINUE IF (.NOT.(LINE2 .LT. 1)) GOTO 3170 PRINT = .FALSE. GOTO 3180 3170 CONTINUE LASTPR = LINE2 3180 CONTINUE DOT = LINE1 3160 CONTINUE GOTO 2800 3130 CONTINUE IF (.NOT.(CMND .EQ. 'S')) GOTO 3190 DOT = HLDDOT IF (.NOT.(NLNUM .EQ. 0)) GOTO 3210 SCRSIZ = 23 GOTO 3220 3210 CONTINUE IF (.NOT.(NLNUM .EQ. 1)) GOTO 3230 SCRSIZ = MAX0(1, LINE2) GOTO 3220 3230 CONTINUE SCRSIZ = MAX0(1, (LINE2 - LINE1) + 1) 3220 CONTINUE GOTO 2800 3190 CONTINUE IF (.NOT.(CMND .EQ. 'C')) GOTO 3250 LSTRED = 0 DOT = HLDDOT IF (.NOT.(NLNUM .EQ. 0)) GOTO 3270 LOWC = 1 HIGHC = 512 + 1 GOTO 3280 3270 CONTINUE IF (.NOT.(NLNUM .EQ. 1)) GOTO 3290 LOWC = 1 HIGHC = MAX0(1, MIN0(512 + 1, LINE2)) GOTO 3280 3290 CONTINUE LOWC = MAX0(1, MIN0(512 + 1, LINE1)) HIGHC = MAX0(LOWC, MIN0(512 + 1, LINE2)) 3280 CONTINUE GOTO 2800 3250 CONTINUE IF (.NOT.(CMND .EQ. 'W')) GOTO 3310 DOT = HLDDOT IF (.NOT.(NLNUM .EQ. 0)) GOTO 3330 SCRWID = SYSWID GOTO 3340 3330 CONTINUE SCRWID = MAX0(1, LINE2) 3340 CONTINUE CALL SETWID(3, SCRWID) GOTO 2800 3310 CONTINUE IF (.NOT.(CMND .EQ. 'N')) GOTO 3350 PRMMOD = .NOT.PRMMOD GOTO 2800 3350 CONTINUE IF (.NOT.(CMND .EQ. 'F')) GOTO 3370 IF (.NOT.(NLNUM .EQ. 0)) GOTO 3390 FOFF = 0 FMAX = 2147483647 - 1 GOTO 3400 3390 CONTINUE IF (.NOT.(NLNUM .EQ. 1)) GOTO 3410 FOFF = FOFF + MAX0(1, MIN0(FMAX + 1, HLDDOT)) - 1 FMAX = MAX0(0, MIN0((FMAX - MAX0(1, MIN0(FMAX + 1, HLDDOT) *)) + 1, LINE2)) GOTO 3400 3410 CONTINUE FOFF = FOFF + MAX0(1, MIN0(FMAX + 1, LINE1)) - 1 FMAX = MAX0(0, (MAX0(0, MIN0(FMAX, LINE2)) - MAX0(1, MIN0( *FMAX + 1, LINE1))) + 1) 3400 CONTINUE DOT = 1 GOTO 2800 3370 CONTINUE IF (.NOT.(CMND .EQ. 'R')) GOTO 3430 LSTRED = 0 DOT = 1 SCRSIZ = 23 SCRWID = SYSWID CALL SETWID(3, SCRWID) LOWC = 1 HIGHC = 512 + 1 FOFF = 0 FMAX = 2147483647 - 1 PRMMOD = .TRUE. GOTO 2800 3430 CONTINUE IF (.NOT.(CMND .EQ. 'X')) GOTO 3450 GOTO 2650 3450 CONTINUE IF (.NOT.(CMND .EQ. 'V')) GOTO 3470 IF (.NOT.(.NOT.DTMODE)) GOTO 3490 C turn printer on CALL ESCSEQ(FOUT, '[5i') IF (.NOT.(FOUT .EQ. 3)) GOTO 3510 C print 132 columns CALL SETWID(3, 132) C save FF status CALL QIOFN(3, SFGMC, TCHFF, FFCHAR, IER) C set HFF on CALL QIOFN(3, SFSMC, TCHFF, 1, IER) 3510 CONTINUE DTMODE = .TRUE. 3490 CONTINUE GOTO 2800 3470 CONTINUE IF (.NOT.(CMND .EQ. '=')) GOTO 3530 SAVDOT = DOT GOTO 2800 3530 CONTINUE IF (.NOT.(CMND .EQ. '?')) GOTO 3550 IF (.NOT.(SNULL)) GOTO 3570 CALL ERR(COMAND, CP, 'Current search string is null.') GOTO 3580 3570 CONTINUE PRINT = .TRUE. EOFLN = 1 MXSRCH = 2147483647 - 1 IF (.NOT.(NLNUM .GE. 2)) GOTO 3590 DOT = LINE1 IF (.NOT.(LINE2 .LT. 1)) GOTO 3610 PRINT = .FALSE. GOTO 3620 3610 CONTINUE EOFLN = LINE1 MXSRCH = LINE2 LASTPR = LINE2 3620 CONTINUE 3590 CONTINUE 3580 CONTINUE GOTO 2800 3550 CONTINUE IF (.NOT.(COMAND(CP) .NE. -1)) GOTO 3630 CALL ERR(COMAND, CP, 'Illegal command.') 3630 CONTINUE 2800 CONTINUE CALL POSIT(F) IF (.NOT.(COMAND(CP) .NE. 0 .AND. COMAND(CP) .NE. -1)) GOTO 36 *50 CP = CP + 1 3650 CONTINUE IF (.NOT.(PRINT)) GOTO 3670 TOPSCR = DOT 3670 CONTINUE IF (.NOT.(PRINT .AND. .NOT.NOPRNT)) GOTO 3690 IF (.NOT.(CMND .EQ. '?')) GOTO 3710 3730 CONTINUE IF (.NOT.(PTSCAN(F, INBUF, BLEN, MXSRCH) .EQ. -10)) GOTO * 3760 DOT = MAX0(1, MIN0(EOFLN, DOT)) GOTO 3750 3760 CONTINUE IF (.NOT.(NPRINT .EQ. 0)) GOTO 3780 TOPSCR = DOT 3780 CONTINUE IF (.NOT.(FLAGS(2))) GOTO 3800 ENCODE(8, 3820, QBUF) DOT 3820 FORMAT(I7,'>') IF (.NOT.(.NOT.TYPLIN(FOUT, QBUF, BLEN+8, NPRINT, LAST *PR, .TRUE.))) GOTO 3830 GOTO 3750 3830 CONTINUE GOTO 3810 3800 CONTINUE IF (.NOT.(.NOT.TYPLIN(FOUT, INBUF, BLEN, NPRINT, LASTP *R, .TRUE.))) GOTO 3850 GOTO 3750 3850 CONTINUE 3810 CONTINUE 3740 GOTO 3730 3750 CONTINUE GOTO 3720 3710 CONTINUE 3870 CONTINUE IF (.NOT.(GETINP(F, INBUF, BLEN) .EQ. -10)) GOTO 3900 GOTO 3890 3900 CONTINUE 3880 IF (.NOT.(.NOT.TYPLIN(FOUT, INBUF, BLEN, NPRINT, LASTPR, . *FALSE.))) GOTO 3870 3890 CONTINUE IF (.NOT.(CMND .EQ. 'G')) GOTO 3920 DOT = TOPSCR 3920 CONTINUE 3720 CONTINUE 3690 CONTINUE 2640 IF (.NOT.(COMAND(CP) .EQ. 0 .OR. COMAND(CP) .EQ. -1)) GOTO 2630 2650 CONTINUE IF (.NOT.(COMAND(CP) .NE. -1)) GOTO 3940 C set last command buffer CALL SCOPY(COMAND, 1, LAST, 1) 3940 CONTINUE IF (.NOT.(DTMODE)) GOTO 3960 DTMODE = .FALSE. C turn printer off CALL ESCSEQ(FOUT, '[4i') IF (.NOT.(FOUT .EQ. 3)) GOTO 3980 CALL SETWID(3, SCRWID) C restore old FF charac. CALL QIOFN(3, SFSMC, TCHFF, FFCHAR, IER) 3980 CONTINUE 3960 CONTINUE FOLD = FOUT IF (.NOT.(FOUT .NE. STDOUT)) GOTO 4000 CLOSE(UNIT = FOUT) FOUT = STDOUT CALL GCCTYP(FOUT, OUTCC) 4000 CONTINUE IF (.NOT.(CMND .EQ. 'X')) GOTO 4020 GOTO 2520 4020 CONTINUE 2510 IF (.NOT.(RCMD(COMAND, DOT, PRMMOD .OR. NPRINT .EQ. 0 .OR. FOLD .N *E. 3) .EQ. -10)) GOTO 2500 2520 CONTINUE IF (.NOT.(FOUT .EQ. 3)) GOTO 4040 C then put trailing CR CALL PUT(FOUT, 13, 1, IER) 4040 CONTINUE RETURN END