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 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, NC INTEGER*2BOFM(3) BYTE TBUF(2) C vrec common - hold common variables for virtual record package COMMON/VREC/TMARK, CC, VBP, VSIZ, GETSTA, BADBUF, VBUF C temporary buffer to mark records INTEGER*2TMARK(2) C carriagecontrol type of file INTEGER CC C pointer to next record in vbuf INTEGER VBP C size of physical record in vbuf INTEGER VSIZ C holds status of last get INTEGER GETSTA C .true. when vbuf buffer overflowed LOGICAL BADBUF C holds physical record BYTE VBUF(512) CALL GCCTYP(F, CC) VBP = 0 VSIZ = - 1 BADBUF = .FALSE. 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 INTEGER FUNCTION VGET(F, BUF, MAXC, NC) INTEGER F, MAXC, NC C integer get INTEGER BGET BYTE BUF(1) C vrec common - hold common variables for virtual record package COMMON/VREC/TMARK, CC, VBP, VSIZ, GETSTA, BADBUF, VBUF C temporary buffer to mark records INTEGER*2TMARK(2) C carriagecontrol type of file INTEGER CC C pointer to next record in vbuf INTEGER VBP C size of physical record in vbuf INTEGER VSIZ C holds status of last get INTEGER GETSTA C .true. when vbuf buffer overflowed LOGICAL BADBUF 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 IF (.NOT.(BADBUF)) GOTO 2110 CALL REAERR(0, - 1054, 0) BADBUF = .FALSE. 2110 CONTINUE VBP = 0 CALL MARKR(F, TMARK) C getsta = get(f, vbuf, BUFSIZ, vsiz) GETSTA = BGET(F, VBUF, 512, VSIZ) IF (.NOT.(VSIZ .LT. 0)) GOTO 2130 IF (.NOT.(VSIZ .EQ. -40)) GOTO 2150 VSIZ = 512 BADBUF = .TRUE. GOTO 2160 2150 CONTINUE IF (.NOT.(VSIZ .NE. -10 .OR. CC .NE. 2)) GOTO 2170 NC = VSIZ 2170 CONTINUE GOTO 2080 2160 CONTINUE 2130 CONTINUE 2090 CONTINUE IF (.NOT.(CC .EQ. 3 .AND. VBP .NE. 0)) GOTO 2190 NC = 1 IF (.NOT.(MAXC .GE. 1)) GOTO 2210 C insert FORTRAN carriagecontrol BUF(1) = ' ' 2210 CONTINUE 2190 CONTINUE VBP = VBP + 1 2230 IF (.NOT.(VBP .LE. VSIZ)) GOTO 2250 IF (.NOT.(VBUF(VBP) .NE. 10)) GOTO 2260 IF (.NOT.(NC .LT. MAXC)) GOTO 2280 NC = NC + 1 BUF(NC) = VBUF(VBP) GOTO 2240 2280 CONTINUE NC = MAXC + 1 2290 CONTINUE GOTO 2270 2260 CONTINUE IF (.NOT.(NC .GT. 0 .AND. NC .LE. MAXC)) GOTO 2300 IF (.NOT.(BUF(NC) .EQ. 13)) GOTO 2320 NC = NC - 1 2320 CONTINUE 2300 CONTINUE GOTO 2080 2270 CONTINUE 2240 VBP = VBP + 1 GOTO 2230 2250 CONTINUE 2070 IF (.NOT.(CC .NE. 2)) GOTO 2060 2080 CONTINUE 2050 CONTINUE IF (.NOT.(NC .GT. MAXC)) GOTO 2340 NC = - 40 2340 CONTINUE VGET = (GETSTA) RETURN END C vmark - mark virtual record SUBROUTINE VMARK(F, MARKB) INTEGER F, I INTEGER*2MARKB(3) C vrec common - hold common variables for virtual record package COMMON/VREC/TMARK, CC, VBP, VSIZ, GETSTA, BADBUF, VBUF C temporary buffer to mark records INTEGER*2TMARK(2) C carriagecontrol type of file INTEGER CC C pointer to next record in vbuf INTEGER VBP C size of physical record in vbuf INTEGER VSIZ C holds status of last get INTEGER GETSTA C .true. when vbuf buffer overflowed LOGICAL BADBUF C holds physical record BYTE VBUF(512) DO 2360 I = 1, 3 - 1 MARKB(I) = TMARK(I) 2360 CONTINUE MARKB(3) = VBP RETURN END C vpoint - point to virtual record SUBROUTINE VPOINT(F, MARKB) INTEGER F, I INTEGER*2MARKB(3) C vrec common - hold common variables for virtual record package COMMON/VREC/TMARK, CC, VBP, VSIZ, GETSTA, BADBUF, VBUF C temporary buffer to mark records INTEGER*2TMARK(2) C carriagecontrol type of file INTEGER CC C pointer to next record in vbuf INTEGER VBP C size of physical record in vbuf INTEGER VSIZ C holds status of last get INTEGER GETSTA C .true. when vbuf buffer overflowed LOGICAL BADBUF C holds physical record BYTE VBUF(512) CALL POINTR(F, MARKB) VBP = MARKB(3) DO 2380 I = 1, 3 - 1 TMARK(I) = MARKB(I) C call get(f, vbuf, BUFSIZ, vsiz) 2380 CONTINUE CALL BGET(F, VBUF, 512, VSIZ) IF (.NOT.(VSIZ .EQ. -40)) GOTO 2400 VSIZ = 512 BADBUF = .TRUE. GOTO 2410 2400 CONTINUE BADBUF = .FALSE. 2410 CONTINUE RETURN END C vskip - skip virtual records INTEGER FUNCTION VSKIP(F, NTOSKP, NSKPED, IER) INTEGER F, IER C integer get INTEGER BGET INTEGER*4NTOSKP, NSKPED C vrec common - hold common variables for virtual record package COMMON/VREC/TMARK, CC, VBP, VSIZ, GETSTA, BADBUF, VBUF C temporary buffer to mark records INTEGER*2TMARK(2) C carriagecontrol type of file INTEGER CC C pointer to next record in vbuf INTEGER VBP C size of physical record in vbuf INTEGER VSIZ C holds status of last get INTEGER GETSTA C .true. when vbuf buffer overflowed LOGICAL BADBUF C holds physical record BYTE VBUF(512) NSKPED = 0 IF (.NOT.(VSIZ .NE. -10)) GOTO 2420 2440 IF (.NOT.(NSKPED .LT. NTOSKP)) GOTO 2460 2470 CONTINUE IF (.NOT.(VBP .GT. VSIZ)) GOTO 2500 IF (.NOT.(BADBUF)) GOTO 2520 CALL REAERR(0, - 1054, NSKPED) BADBUF = .FALSE. 2520 CONTINUE VBP = 0 CALL MARKR(F, TMARK) C getsta = get(f, vbuf, BUFSIZ, vsiz) GETSTA = BGET(F, VBUF, 512, VSIZ) IF (.NOT.(VSIZ .LT. 0)) GOTO 2540 IF (.NOT.(VSIZ .EQ. -40)) GOTO 2560 VSIZ = 512 BADBUF = .TRUE. GOTO 2570 2560 CONTINUE IF (.NOT.(VSIZ .EQ. -10 .AND. CC .EQ. 2)) GOTO 2580 NSKPED = NSKPED + 1 2580 CONTINUE GOTO 2460 2570 CONTINUE 2540 CONTINUE 2500 CONTINUE VBP = VBP + 1 2600 IF (.NOT.(VBP .LE. VSIZ)) GOTO 2620 IF (.NOT.(VBUF(VBP) .EQ. 10)) GOTO 2630 GOTO 2490 2630 CONTINUE 2610 VBP = VBP + 1 GOTO 2600 2620 CONTINUE 2480 IF (.NOT.(CC .NE. 2)) GOTO 2470 2490 CONTINUE 2450 NSKPED = NSKPED + 1 GOTO 2440 2460 CONTINUE 2420 CONTINUE IER = 0 IF (.NOT.(VSIZ .LT. 0)) GOTO 2650 IER = VSIZ 2650 CONTINUE VSKIP = (GETSTA) RETURN END C gcctyp - get carriagecontrol for unit f SUBROUTINE GCCTYP(F, CC) INTEGER F, CC, RTYPE, RSIZE, EFBK, FFBY, IER CALL GETCHA(F, RTYPE, RSIZE, CC, EFBK, FFBY, IER) IF (.NOT.((CC .AND. 2) .NE. 0 .OR. RTYPE .EQ. 1)) GOTO 2670 C treat fixed length records as LIST CC = 1 GOTO 2680 2670 CONTINUE IF (.NOT.((CC .AND. 1) .NE. 0)) GOTO 2690 CC = 3 GOTO 2680 2690 CONTINUE CC = 2 2680 CONTINUE RETURN END