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 C These routines serve as get, skip, mark, and point routines for C carriagecontrol NONE files. They may also be used for LIST C files which, in addition to the implied in each C physical record, have explicit carriagecontrol. C C vinit - init virtual io SUBROUTINE VINIT(F) INTEGER F, BOFM(4), NC BYTE TBUF(2) C vrec common - hold common variables for virtual record package COMMON/VREC/TMARK, CC, VBP, VSIZ, VBUF C temporary buffer to mark records INTEGER TMARK(3) C carriagecontrol type of file INTEGER CC C pointer to next record in vbuf INTEGER VBP C size of record in vbuf INTEGER VSIZ C holds physical record BYTE VBUF(512) CALL GFTYP(F, CC) VBP = 0 VSIZ = - 1 CALL MARKR(F, TMARK) IF (.NOT.(CC .EQ. 2)) GOTO 2000 CALL VMARK(F, BOFM) CALL VGET(F, TBUF, 2, NC) IF (.NOT.(NC .NE. 0 .AND. NC .NE. -10)) GOTO 2020 CALL VPOINT(F, BOFM) 2020 CONTINUE 2000 CONTINUE RETURN END C vget - get virtual record SUBROUTINE VGET(F, BUF, MAXC, NC) INTEGER F, MAXC, NC BYTE BUF(1) C vrec common - hold common variables for virtual record package COMMON/VREC/TMARK, CC, VBP, VSIZ, VBUF C temporary buffer to mark records INTEGER TMARK(3) C carriagecontrol type of file INTEGER CC C pointer to next record in vbuf INTEGER VBP C size of record in vbuf INTEGER VSIZ C holds physical record BYTE VBUF(512) IF (.NOT.(VSIZ .EQ. -10)) GOTO 2040 NC = - 10 GOTO 2050 2040 CONTINUE NC = 0 2060 CONTINUE IF (.NOT.(VBP .GT. VSIZ)) GOTO 2090 VBP = 0 CALL MARKR(F, TMARK) CALL GET(F, VBUF, 512, VSIZ) C BLOCK IO call bget(f, vbuf, BUFSIZ, vsiz) IF (.NOT.(VSIZ .LT. 0)) GOTO 2110 IF (.NOT.(VSIZ .NE. -10 .OR. CC .NE. 2)) GOTO 2130 NC = VSIZ 2130 CONTINUE GOTO 2080 2110 CONTINUE 2090 CONTINUE IF (.NOT.(CC .EQ. 3 .AND. VBP .NE. 0)) GOTO 2150 NC = 1 C insert FORTRAN carriagecontrol BUF(NC) = ' ' 2150 CONTINUE VBP = VBP + 1 2170 IF (.NOT.(VBP .LE. VSIZ)) GOTO 2190 IF (.NOT.(VBUF(VBP) .NE. 10)) GOTO 2200 IF (.NOT.(NC .LT. MAXC)) GOTO 2220 NC = NC + 1 BUF(NC) = VBUF(VBP) GOTO 2180 2220 CONTINUE NC = MAXC + 1 2230 CONTINUE GOTO 2210 2200 CONTINUE IF (.NOT.(NC .GT. 0 .AND. NC .LE. MAXC)) GOTO 2240 IF (.NOT.(BUF(NC) .EQ. 13)) GOTO 2260 NC = NC - 1 2260 CONTINUE 2240 CONTINUE GOTO 2080 2210 CONTINUE 2180 VBP = VBP + 1 GOTO 2170 2190 CONTINUE 2070 IF (.NOT.(CC .NE. 2)) GOTO 2060 2080 CONTINUE 2050 CONTINUE IF (.NOT.(NC .GT. MAXC)) GOTO 2280 NC = - 40 2280 CONTINUE RETURN END C vmark - mark virtual record SUBROUTINE VMARK(F, MARKB) INTEGER F, I INTEGER MARKB(4) C vrec common - hold common variables for virtual record package COMMON/VREC/TMARK, CC, VBP, VSIZ, VBUF C temporary buffer to mark records INTEGER TMARK(3) C carriagecontrol type of file INTEGER CC C pointer to next record in vbuf INTEGER VBP C size of record in vbuf INTEGER VSIZ C holds physical record BYTE VBUF(512) DO 2300 I = 1, 4 - 1 MARKB(I) = TMARK(I) 2300 CONTINUE MARKB(4) = VBP RETURN END C vpoint - point to virtual record SUBROUTINE VPOINT(F, MARKB) INTEGER F, I INTEGER MARKB(4) C vrec common - hold common variables for virtual record package COMMON/VREC/TMARK, CC, VBP, VSIZ, VBUF C temporary buffer to mark records INTEGER TMARK(3) C carriagecontrol type of file INTEGER CC C pointer to next record in vbuf INTEGER VBP C size of record in vbuf INTEGER VSIZ C holds physical record BYTE VBUF(512) CALL POINTR(F, MARKB) VBP = MARKB(4) DO 2320 I = 1, 4 - 1 TMARK(I) = MARKB(I) 2320 CONTINUE CALL GET(F, VBUF, 512, VSIZ) C BLOCK IO call bget(f, vbuf, BUFSIZ, vsiz) RETURN END C vskip - skip virtual records SUBROUTINE VSKIP(F, NTOSKP, NSKPED) INTEGER F INTEGER*4NTOSKP, NSKPED C vrec common - hold common variables for virtual record package COMMON/VREC/TMARK, CC, VBP, VSIZ, VBUF C temporary buffer to mark records INTEGER TMARK(3) C carriagecontrol type of file INTEGER CC C pointer to next record in vbuf INTEGER VBP C size of record in vbuf INTEGER VSIZ C holds physical record BYTE VBUF(512) NSKPED = 0 IF (.NOT.(VSIZ .NE. -10)) GOTO 2340 2360 IF (.NOT.(NSKPED .LT. NTOSKP)) GOTO 2380 2390 CONTINUE IF (.NOT.(VBP .GT. VSIZ)) GOTO 2420 VBP = 0 CALL MARKR(F, TMARK) CALL GET(F, VBUF, 512, VSIZ) C BLOCK IO call bget(f, vbuf, BUFSIZ, vsiz) IF (.NOT.(VSIZ .LT. 0)) GOTO 2440 IF (.NOT.(VSIZ .EQ. -10 .AND. CC .EQ. 2)) GOTO 2460 NSKPED = NSKPED + 1 2460 CONTINUE GOTO 2380 2440 CONTINUE 2420 CONTINUE VBP = VBP + 1 2480 IF (.NOT.(VBP .LE. VSIZ)) GOTO 2500 IF (.NOT.(VBUF(VBP) .EQ. 10)) GOTO 2510 GOTO 2410 2510 CONTINUE 2490 VBP = VBP + 1 GOTO 2480 2500 CONTINUE 2400 IF (.NOT.(CC .NE. 2)) GOTO 2390 2410 CONTINUE 2370 NSKPED = NSKPED + 1 GOTO 2360 2380 CONTINUE 2340 CONTINUE RETURN END C gftyp - get carriagecontrol and record types SUBROUTINE GFTYP(F, CC) INTEGER F, CC, RTYP, RSIZE, EFBK, FFBY, IER CALL GETCHA(F, RTYP, RSIZE, CC, EFBK, FFBY, IER) IF (.NOT.((CC .AND. 1) .NE. 0)) GOTO 2530 CC = 3 GOTO 2540 2530 CONTINUE IF (.NOT.((CC .AND. 2) .NE. 0 .OR. RTYP .EQ. 1)) GOTO 2550 C treat fixed length records as LIST CC = 1 GOTO 2540 2550 CONTINUE CC = 2 2540 CONTINUE RETURN END