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 bget - get logical record using multi-block reads C caution - mxbuf, the buffer size, must be even! INTEGER FUNCTION BGET(LUN, BUF, MXBUF, NC) INTEGER BUF(1) INTEGER LUN, MXBUF, NC, I, MXB COMMON/BLKIO/BLKPTR, BLKN, NREAD, RECLEN, EFBK, FFBY, FIXED, SEQ, *NOSPAN, BLKBUF C pointer to blkbuf INTEGER BLKPTR C next virtual block number to read INTEGER BLKN C number of words read INTEGER NREAD C record length for fixed length file INTEGER RECLEN C EOF block number INTEGER EFBK C first free byte in EOF block INTEGER FFBY C .true. if file has fixed len records LOGICAL FIXED C .true. if file has sequenced records LOGICAL SEQ C .true. if nospanblocks LOGICAL NOSPAN C block buffer INTEGER BLKBUF(0:5*256 - 1) DATA BLKN/1/, BLKPTR/0/, NREAD/0/ 10 CONTINUE 2000 IF (.NOT.(BLKPTR .GE. NREAD)) GOTO 2010 BLKPTR = BLKPTR - NREAD CALL DBKRD(LUN, BLKN, BLKBUF, 5*256, NREAD) IF (.NOT.(NREAD .LE. 0)) GOTO 2020 BLKN = BLKN - 5 NC = - 10 BGET = ( - 10) RETURN 2020 CONTINUE GOTO 2000 2010 CONTINUE IF (.NOT.(FIXED)) GOTO 2040 NC = RECLEN IF (.NOT.(NOSPAN)) GOTO 2060 IF (.NOT.(BLKPTR/256 .NE. (BLKPTR+NC/2+MOD(NC, 2)-1)/256)) GOT *O 2080 BLKPTR = 256*(BLKPTR/256 + 1) 2080 CONTINUE 2060 CONTINUE GOTO 2050 2040 CONTINUE NC = BLKBUF(BLKPTR) IF (.NOT.(NC .GE. 0)) GOTO 2100 IF (.NOT.(SEQ)) GOTO 2120 NC = NC - 2 BLKPTR = BLKPTR + 2 GOTO 2130 2120 CONTINUE BLKPTR = BLKPTR + 1 2130 CONTINUE GOTO 2110 2100 CONTINUE IF (.NOT.(NOSPAN)) GOTO 2140 BLKPTR = 256*(BLKPTR/256 + 1) GOTO 10 2140 CONTINUE 2110 CONTINUE 2050 CONTINUE IF (.NOT.(NC .GT. 0)) GOTO 2160 MXB = MXBUF/2 DO 2180 I = 1, NC/2 + MOD(NC, 2) IF (.NOT.(BLKPTR .GE. NREAD)) GOTO 2200 BLKPTR = BLKPTR - NREAD CALL DBKRD(LUN, BLKN, BLKBUF, 5*256, NREAD) IF (.NOT.(NREAD .LE. 0)) GOTO 2220 BLKN = BLKN - 5 NC = 2*(I - 1) GOTO 2190 2220 CONTINUE 2200 CONTINUE IF (.NOT.(I .LE. MXB)) GOTO 2240 BUF(I) = BLKBUF(BLKPTR) 2240 CONTINUE BLKPTR = BLKPTR + 1 2180 CONTINUE 2190 CONTINUE 2160 CONTINUE IF (.NOT.(NC .GT. MXBUF)) GOTO 2260 NC = - 40 BGET = - 40 GOTO 2270 2260 CONTINUE IF (.NOT.(NC .LT. 0)) GOTO 2280 NC = - 1053 BGET = - 1053 GOTO 2270 2280 CONTINUE BGET = 1 2270 CONTINUE RETURN END C skip - skip logical records using block i/o INTEGER FUNCTION SKIP(LUN, NTOSKP, NSKPED, IER) INTEGER LUN, IER, NW INTEGER*4NTOSKP, NSKPED LOGICAL FKREAD COMMON/BLKIO/BLKPTR, BLKN, NREAD, RECLEN, EFBK, FFBY, FIXED, SEQ, *NOSPAN, BLKBUF C pointer to blkbuf INTEGER BLKPTR C next virtual block number to read INTEGER BLKN C number of words read INTEGER NREAD C record length for fixed length file INTEGER RECLEN C EOF block number INTEGER EFBK C first free byte in EOF block INTEGER FFBY C .true. if file has fixed len records LOGICAL FIXED C .true. if file has sequenced records LOGICAL SEQ C .true. if nospanblocks LOGICAL NOSPAN C block buffer INTEGER BLKBUF(0:5*256 - 1) SKIP = 1 IER = 0 FKREAD = .FALSE. NSKPED = 0 2300 IF (.NOT.(NSKPED .LT. NTOSKP)) GOTO 2320 10 CONTINUE 2330 IF (.NOT.(BLKPTR .GE. NREAD)) GOTO 2340 BLKPTR = BLKPTR - NREAD IF (.NOT.(FIXED)) GOTO 2350 BLKN = BLKN + 5 NREAD = 5*256 IF (.NOT.(BLKN .GT. EFBK)) GOTO 2370 NREAD = MAX0(0, NREAD - (BLKN - EFBK)*256 + (FFBY + 1)/2) 2370 CONTINUE FKREAD = .TRUE. GOTO 2360 2350 CONTINUE CALL DBKRD(LUN, BLKN, BLKBUF, 5*256, NREAD) 2360 CONTINUE IF (.NOT.(NREAD .LE. 0)) GOTO 2390 BLKN = BLKN - 5 SKIP = - 10 IER = - 10 GOTO 2320 2390 CONTINUE GOTO 2330 2340 CONTINUE IF (.NOT.(FIXED)) GOTO 2410 NW = RECLEN/2 + MOD(RECLEN, 2) IF (.NOT.(NOSPAN)) GOTO 2430 IF (.NOT.(BLKPTR/256 .NE. (BLKPTR+NW-1)/256)) GOTO 2450 BLKPTR = 256*(BLKPTR/256 + 1) 2450 CONTINUE 2430 CONTINUE BLKPTR = BLKPTR + NW GOTO 2420 2410 CONTINUE IF (.NOT.(BLKBUF(BLKPTR) .GE. 0)) GOTO 2470 BLKPTR = BLKPTR + BLKBUF(BLKPTR)/2 + MOD(BLKBUF(BLKPTR), 2) + *1 GOTO 2420 2470 CONTINUE IF (.NOT.(NOSPAN)) GOTO 2490 BLKPTR = 256*(BLKPTR/256 + 1) GOTO 10 11 CONTINUE GOTO 2420 2490 CONTINUE SKIP = - 1053 IER = - 1053 GOTO 2320 2420 CONTINUE 2310 NSKPED = NSKPED + 1 GOTO 2300 2320 CONTINUE IF (.NOT.(FKREAD)) GOTO 2510 IF (.NOT.(NREAD .NE. 0)) GOTO 2530 BLKN = BLKN - 5 NREAD = 0 2530 CONTINUE 2510 CONTINUE RETURN END C markr - mark logical record SUBROUTINE MARKR(LUN, MRKBUF) INTEGER LUN, MRKBUF(2) COMMON/BLKIO/BLKPTR, BLKN, NREAD, RECLEN, EFBK, FFBY, FIXED, SEQ, *NOSPAN, BLKBUF C pointer to blkbuf INTEGER BLKPTR C next virtual block number to read INTEGER BLKN C number of words read INTEGER NREAD C record length for fixed length file INTEGER RECLEN C EOF block number INTEGER EFBK C first free byte in EOF block INTEGER FFBY C .true. if file has fixed len records LOGICAL FIXED C .true. if file has sequenced records LOGICAL SEQ C .true. if nospanblocks LOGICAL NOSPAN C block buffer INTEGER BLKBUF(0:5*256 - 1) IF (.NOT.(NREAD .LE. 0)) GOTO 2550 MRKBUF(1) = BLKN GOTO 2560 2550 CONTINUE MRKBUF(1) = BLKN - 5 2560 CONTINUE MRKBUF(2) = BLKPTR RETURN END C pointr - point to logical record SUBROUTINE POINTR(LUN, MRKBUF) INTEGER LUN, MRKBUF(2) COMMON/BLKIO/BLKPTR, BLKN, NREAD, RECLEN, EFBK, FFBY, FIXED, SEQ, *NOSPAN, BLKBUF C pointer to blkbuf INTEGER BLKPTR C next virtual block number to read INTEGER BLKN C number of words read INTEGER NREAD C record length for fixed length file INTEGER RECLEN C EOF block number INTEGER EFBK C first free byte in EOF block INTEGER FFBY C .true. if file has fixed len records LOGICAL FIXED C .true. if file has sequenced records LOGICAL SEQ C .true. if nospanblocks LOGICAL NOSPAN C block buffer INTEGER BLKBUF(0:5*256 - 1) IF (.NOT.(MRKBUF(1) .NE. BLKN-5 .OR. NREAD .EQ. 0)) GOTO 2570 BLKN = MRKBUF(1) NREAD = 0 2570 CONTINUE BLKPTR = MRKBUF(2) RETURN END C bopen - open file for block i/o SUBROUTINE BOPEN(LUN, FNAM, MODE, IER) BYTE FNAM(1), MODE INTEGER LUN, IER, IER2, RTYP, RATT COMMON/BLKIO/BLKPTR, BLKN, NREAD, RECLEN, EFBK, FFBY, FIXED, SEQ, *NOSPAN, BLKBUF C pointer to blkbuf INTEGER BLKPTR C next virtual block number to read INTEGER BLKN C number of words read INTEGER NREAD C record length for fixed length file INTEGER RECLEN C EOF block number INTEGER EFBK C first free byte in EOF block INTEGER FFBY C .true. if file has fixed len records LOGICAL FIXED C .true. if file has sequenced records LOGICAL SEQ C .true. if nospanblocks LOGICAL NOSPAN C block buffer INTEGER BLKBUF(0:5*256 - 1) CALL DBKOF(LUN, MODE, FNAM, - 1, 0, IER) IF (.NOT.(IER .EQ. 0)) GOTO 2590 CALL GETCHA(LUN, RTYP, RECLEN, RATT, EFBK, FFBY, IER2) IF (.NOT.(IER2 .NE. 0)) GOTO 2610 STOP'BOPEN -- Can''t get file characteristics!' 2610 CONTINUE FIXED = RTYP .EQ. 1 SEQ = RTYP .EQ. 3 NOSPAN = (RATT .AND. 8) .NE. 0 C$ if (nospan) C$ stop 'BOPEN -- Can''t read nospanblocks file!' 2590 CONTINUE RETURN END C bclose - close file SUBROUTINE BCLOSE(LUN, MODE, IER) INTEGER LUN, IER BYTE MODE COMMON/BLKIO/BLKPTR, BLKN, NREAD, RECLEN, EFBK, FFBY, FIXED, SEQ, *NOSPAN, BLKBUF C pointer to blkbuf INTEGER BLKPTR C next virtual block number to read INTEGER BLKN C number of words read INTEGER NREAD C record length for fixed length file INTEGER RECLEN C EOF block number INTEGER EFBK C first free byte in EOF block INTEGER FFBY C .true. if file has fixed len records LOGICAL FIXED C .true. if file has sequenced records LOGICAL SEQ C .true. if nospanblocks LOGICAL NOSPAN C block buffer INTEGER BLKBUF(0:5*256 - 1) CALL DBKCF(LUN, MODE, IER) BLKPTR = 0 NREAD = 0 BLKN = 1 RETURN END