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 gttyp - get terminal type for IAS and RSX11-M SUBROUTINE GTTYP(F) INTEGER F, F2, TYPE, ACR, IERR 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/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 SCRSIZ = 23 C attach terminal CALL QIOFN(F, IOATT, 0, 0, IERR) C C The return of screen width is inconsistent across operating systems (ie. C IAS is weird); thus the variable widfac is patched by TKB to be 1 for IAS. C C get screen width CALL QIOFN(F, SFGMC, TCWID, SYSWID, IERR) IF (.NOT.(IERR .EQ. 0)) GOTO 2000 SYSWID = SYSWID - WIDFAC GOTO 2010 2000 CONTINUE SYSWID = 80 2010 CONTINUE SCRWID = SYSWID C C If your terminals do a hardware line feed and carriagereturn after the C 80th character but before the 81st character (ADM3A's do this if set for C auto newline in their switch bank) then set hlf (hardware line-feed) to C true, otherwise set hlf to false. C C get terminal type CALL QIOFN(F, SFGMC, TCTTP, TYPE, IERR) IF (.NOT.(IERR .EQ. 0 .AND. (TYPE .EQ. TV100 .OR. TYPE .EQ. TVT52) *)) GOTO 2020 HLF = .FALSE. GOTO 2030 2020 CONTINUE HLF = .TRUE. C C If your terminal is set for auto carriagereturn then software tabs work C properly all the time; otherwise they only work properly for the first C line of output from a record. Therefore autocr should be set true if the C terminal is set for auto carriagereturn, so that NUMLIN knows what's what. C The following code probably won't have to be modified. C note: auto carriagereturn is known as "wrap" on M and VMS systems. C 2030 CONTINUE C get auto carriagereturn flag- CALL QIOFN(F, SFGMC, TCACR, ACR, IERR) C used in NUMLIN IF (.NOT.(ACR .EQ. 1 .AND. IERR .EQ. 0)) GOTO 2040 AUTOCR = .TRUE. GOTO 2050 2040 CONTINUE AUTOCR = .FALSE. C C now set term for no hardware tabs so NUMLIN knows where it is on the screen C 2050 CONTINUE CALL QIOFN(F, SFGMC, TCHHT, SAVTAB, IERR) CALL QIOFN(F, SFSMC, TCHHT, 0, IERR) RETURN C tabbak - reset hardware tab status on exit from list. C also reset screen width. ENTRY TABBAK(F2) CALL QIOFN(F2, SFSMC, TCHHT, SAVTAB, IERR) CALL SETWID(F2, SYSWID) RETURN END C qiofn - do a qio function SUBROUTINE QIOFN(F, FUNC, CHAR, VAL, IERR) INTEGER F, FUNC, CHAR, VAL, IERR, DPB(6), DSW, IOSB(2) BYTE BUF(2), BIOSB 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 EQUIVALENCE(BIOSB, IOSB) BUF(1) = CHAR BUF(2) = VAL CALL GETADR(DPB, BUF) DPB(2) = 2 CALL WTQIO(FUNC, F, F, , IOSB, DPB, DSW) IF (.NOT.(BIOSB .GE. 0 .AND. DSW .GE. 0)) GOTO 2060 IERR = 0 IF (.NOT.(FUNC .EQ. SFGMC)) GOTO 2080 VAL = BUF(2) C mask out high byte VAL = VAL .AND. 255 2080 CONTINUE GOTO 2070 2060 CONTINUE IERR = - 1 2070 CONTINUE RETURN END C setwid - set terminal screen width characteristic SUBROUTINE SETWID(F, WID) INTEGER WID, IERR 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 widfac=1 for IAS CALL QIOFN(F, SFSMC, TCWID, WID + WIDFAC, IERR) RETURN END C escseq - send out a terminal control sequence beginning with ESC SUBROUTINE ESCSEQ(F, SEQ) INTEGER F, IER BYTE SEQ(1), TSEQ(10) INTEGER LENGTH DATA TSEQ(1)/27/ CALL SCOPY(SEQ, 1, TSEQ, 2) CALL PUT(F, TSEQ, LENGTH(TSEQ), IER, .TRUE.) RETURN END C C numlin - castrate control chars, count number of lines to print this record C C This routine figures out how many lines would be printed if a record C were printed at the terminal, sets non-printing characters C to 0, and detects form feeds. C SUBROUTINE NUMLIN(BUF, OUTB, BLEN, FFFLAG, NLINES) INTEGER BLEN, NLINES, PRLEN, I, NL LOGICAL FFFLAG BYTE BUF(1), OUTB(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 FFFLAG = .FALSE. PRLEN = 0 NLINES = 1 IF (.NOT.(BLEN .LE. 0)) GOTO 2100 RETURN 2100 CONTINUE DO 2120 I = 1, BLEN OUTB(I) = BUF(I) I2140 = (OUTB(I)) GOTO 2140 2160 CONTINUE CONTINUE GOTO 2150 2170 CONTINUE NL = PRLEN/SCRWID NLINES = NLINES + NL PRLEN = MAX0(0, PRLEN - NL*SCRWID - 1) GOTO 2150 2180 CONTINUE IF (.NOT.((PRLEN .LT. SCRWID .AND. NLINES .EQ. 1) .OR. AUTOCR) *) GOTO 2190 PRLEN = PRLEN + 8 - MOD(MOD(PRLEN, SCRWID), 8) GOTO 2200 2190 CONTINUE PRLEN = PRLEN + 8 2200 CONTINUE GOTO 2150 2210 CONTINUE NL = PRLEN/SCRWID NLINES = NLINES + NL + 1 PRLEN = PRLEN - NL*SCRWID GOTO 2150 2220 CONTINUE OUTB(I) = 0 C signal new page FFFLAG = .TRUE. GOTO 2150 2230 CONTINUE NL = PRLEN/SCRWID NLINES = NLINES + NL PRLEN = 0 GOTO 2150 2240 CONTINUE OUTB(I) = '$' PRLEN = PRLEN + 1 GOTO 2150 2250 CONTINUE C regular printing chars PRLEN = PRLEN + 1 GOTO 2150 2260 CONTINUE C anything else OUTB(I) = 0 GOTO 2150 2140 CONTINUE IF (I2140 .EQ. 7) GOTO 2160 IF (I2140 .EQ. 8) GOTO 2170 IF (I2140 .EQ. 9) GOTO 2180 IF (I2140 .EQ. 10) GOTO 2210 IF (I2140 .EQ. 12) GOTO 2220 IF (I2140 .EQ. 13) GOTO 2230 IF (I2140 .EQ. 27) GOTO 2240 IF (I2140 .GE. 32 .AND. I2140 .LE. 126) GOTO 2250 GOTO 2260 2150 CONTINUE 2120 CONTINUE IF (.NOT.(.NOT.HLF)) GOTO 2270 NL = MAX0(0, PRLEN - 1)/SCRWID GOTO 2280 2270 CONTINUE NL = PRLEN/SCRWID 2280 CONTINUE NLINES = NLINES + NL RETURN END