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 opndef - find and open file for reading using defaults in file name LOGICAL FUNCTION OPNDEF(LUN, FILE, PROMPT, NSELEC) IMPLICIT INTEGER(A - Z) BYTE FILE(1), FILE1(134) LOGICAL GETFIL 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/ C files - common area for file defaults and names COMMON/FILES/LFILE, NODE, DEV, UIC, NAME, EXT, CNODE, CDEV, CUIC, *CNAME, CEXT, CVER C current output file spec BYTE LFILE(99) C defaults constructed from input file spec on command line BYTE NODE(66) BYTE UIC(10) BYTE NAME(10) BYTE DEV(6) BYTE EXT(5) C current open input file spec fields BYTE CNODE(66) BYTE CDEV(6) BYTE CUIC(10) BYTE CNAME(10) BYTE CEXT(5) BYTE CVER(7) DATA LFILE(1)/0/ DATA NODE(1)/0/ DATA UIC(1)/0/ DATA NAME(1)/0/ DATA DEV(1)/83/,DEV(2)/89/,DEV(3)/58/,DEV(4)/0/ DATA EXT(1)/46/,EXT(2)/76/,EXT(3)/83/,EXT(4)/84/,EXT(5)/0/ DATA CNODE(1)/0/ DATA CDEV(1)/0/ DATA CUIC(1)/0/ DATA CNAME(1)/0/ DATA CEXT(1)/0/ DATA CVER(1)/0/ 2000 IF (.NOT.(GETFIL(FILE, NSELEC, PROMPT))) GOTO 2010 C try opening file with defaults applied CALL SCOPY(FILE, 1, FILE1, 1) CALL DEFNAM(FILE, NODE, DEV, UIC, NAME, EXT, .FALSE.) IF (.NOT.(FLAGS(4))) GOTO 2020 C open(unit=lun, name= file, type='old', shared, err= 10, C _ifdef(VAX) C blocksize=5120, useropen=gpopen, C _elsedef C blocksize=2048, C _enddef C carriagecontrol='list' RECORDIO _ifelse(,,,`, `)) CALL BOPEN(LUN, FILE, 'R', IER) IF (.NOT.(IER .NE. 0)) GOTO 2040 GOTO 10 2040 CONTINUE GOTO 2030 2020 CONTINUE C open(unit=lun, name= file, type='old', shared, err= 10, C _ifdef(VAX) C blocksize=5120, useropen=gpopen, C _elsedef C blocksize=2048, C _enddef C carriagecontrol='list' RECORDIO _ifelse( readonly,,,`, readonly`)) CALL BOPEN(LUN, FILE, 'R', IER) IF (.NOT.(IER .NE. 0)) GOTO 2060 GOTO 10 2060 CONTINUE 2030 CONTINUE GOTO 30 C now try file name as is, with DEFAULT$DISK and . as C default device and extension 10 CONTINUE CALL DEFNAM(FILE1, 0, 'SY:', 0, 0, '.', .FALSE.) IF (.NOT.(FLAGS(4))) GOTO 2080 C open(unit=lun, name= file1, type='old', shared, err= 20, C _ifdef(VAX) C blocksize=5120, useropen=gpopen, C _elsedef C blocksize=2048, C _enddef C carriagecontrol='list' RECORDIO _ifelse(,,,`, `)) CALL BOPEN(LUN, FILE1, 'R', IER) IF (.NOT.(IER .NE. 0)) GOTO 2100 GOTO 20 2100 CONTINUE GOTO 2090 2080 CONTINUE C open(unit=lun, name= file1, type='old', shared, err= 20, C _ifdef(VAX) C blocksize=5120, useropen=gpopen, C _elsedef C blocksize=2048, C _enddef C carriagecontrol='list' RECORDIO _ifelse( readonly,,,`, readonly`)) CALL BOPEN(LUN, FILE1, 'R', IER) IF (.NOT.(IER .NE. 0)) GOTO 2120 GOTO 20 2120 CONTINUE 2090 CONTINUE NODE(1) = 0 DEV(1) = 0 UIC(1) = 0 NAME(1) = 0 EXT(1) = 0 C reset defaults CALL DEFNAM(FILE1, NODE, DEV, UIC, NAME, EXT, .TRUE.) C return full file name CALL SCOPY(FILE1, 1, FILE, 1) C got one! 30 CONTINUE RANDAC = .TRUE. CALL GCCTYP(LUN, CC) CNODE(1) = 0 CDEV(1) = 0 CUIC(1) = 0 CNAME(1) = 0 CEXT(1) = 0 C set current input file spec fields CVER(1) = 0 CALL FPARSE(FILE, CNODE, CDEV, CUIC, CNAME, CEXT, CVER, .TRUE., *.FALSE.) OPNDEF = (.TRUE.) RETURN C here if unable to open a file 20 CONTINUE CALL SCOPY('LIST -- Error opening ', 1, FILE1, 1) CALL TTPUT(FILE1, CONCAT(FILE1, FILE, 134)) XSTAT = 2 C go try next file GOTO 2000 2010 CONTINUE OPNDEF = (.FALSE.) RETURN END C getfil - return selected file names one at a time from a list of file specs C separated by commas. C File specs may be a simple file name, or they may reference C an indirect file if @ is specified, or C file names may be selected by wild cards and/or switches. LOGICAL FUNCTION GETFIL(FILE, NSELEC, PROMPT) IMPLICIT INTEGER(A - Z) BYTE FILE(1), ANS(3), TERMC, FILIST(134) LOGICAL ISLIST, INBRAK, NXTFIL BYTE CUPPER C files - common area for file defaults and names COMMON/FILES/LFILE, NODE, DEV, UIC, NAME, EXT, CNODE, CDEV, CUIC, *CNAME, CEXT, CVER C current output file spec BYTE LFILE(99) C defaults constructed from input file spec on command line BYTE NODE(66) BYTE UIC(10) BYTE NAME(10) BYTE DEV(6) BYTE EXT(5) C current open input file spec fields BYTE CNODE(66) BYTE CDEV(6) BYTE CUIC(10) BYTE CNAME(10) BYTE CEXT(5) BYTE CVER(7) DATA LFILE(1)/0/ DATA NODE(1)/0/ DATA UIC(1)/0/ DATA NAME(1)/0/ DATA DEV(1)/83/,DEV(2)/89/,DEV(3)/58/,DEV(4)/0/ DATA EXT(1)/46/,EXT(2)/76/,EXT(3)/83/,EXT(4)/84/,EXT(5)/0/ DATA CNODE(1)/0/ DATA CDEV(1)/0/ DATA CUIC(1)/0/ DATA CNAME(1)/0/ DATA CEXT(1)/0/ DATA CVER(1)/0/ IF (.NOT.(NSELEC .EQ. 0)) GOTO 2140 IP = 0 CALL SCOPY(FILE, 1, FILIST, 1) NFILE = 0 ISLIST = .FALSE. 2140 CONTINUE 2160 CONTINUE IF (.NOT.(NFILE .EQ. 0)) GOTO 2190 INBRAK = .FALSE. J = NUQCP(FILIST, IP + 1) 2210 IF (.NOT.(FILIST(J) .NE. 0 .AND. (INBRAK .OR. FILIST(J) .NE. ' *,'))) GOTO 2230 IF (.NOT.(FILIST(J) .EQ. '[')) GOTO 2240 INBRAK = .TRUE. GOTO 2250 2240 CONTINUE IF (.NOT.(FILIST(J) .EQ. ']')) GOTO 2260 INBRAK = .FALSE. 2260 CONTINUE 2250 CONTINUE 2220 J = NUQCP(FILIST, J + 1) GOTO 2210 2230 CONTINUE IF (.NOT.(FILIST(J) .EQ. ',')) GOTO 2280 C this is a list of file names ISLIST = .TRUE. 2280 CONTINUE DO 2300 I = IP + 1, J FILE(I - IP) = FILIST(I) 2300 CONTINUE FILE(J - IP) = 0 IP = J IF (.NOT.(FILE(1) .EQ. '@')) GOTO 2320 C Indirect file name? NAMTYP = 2 GOTO 2330 2320 CONTINUE NAMTYP = 3 2330 CONTINUE 2190 CONTINUE NC = 0 2340 IF (.NOT.(NXTFIL(FILE, NFILE, NAMTYP))) GOTO 2350 IF (.NOT.(PROMPT .EQ. 0 .AND. (NAMTYP .NE. 0 .OR. ISLIST))) GO *TO 2360 PROMPT = 1 2360 CONTINUE IF (.NOT.(PROMPT .EQ. 1)) GOTO 2380 2400 CONTINUE CALL READPR(2, FILE, ANS, NC, 3, TERMC) 2410 IF (.NOT.(NC .EQ. -10 .OR. NC .GE. 0)) GOTO 2400 ANS(1) = CUPPER(ANS(1)) IF (.NOT.(NC .GT. 0 .AND. ANS(1) .EQ. 'G')) GOTO 2430 PROMPT = 2 2430 CONTINUE GOTO 2390 2380 CONTINUE IF (.NOT.(PROMPT .EQ. 2)) GOTO 2450 CALL TTPUT(FILE, 0) 2450 CONTINUE 2390 CONTINUE IF (.NOT.(NC .EQ. -10 .OR. PROMPT .NE. 1 .OR. (NC .GT. 0 .AND. * ANS(1) .EQ. 'Y'))) GOTO 2470 GOTO 2350 2470 CONTINUE GOTO 2340 2350 CONTINUE 2170 IF (.NOT.(NFILE .GT. 0 .OR. FILIST(IP) .EQ. 0 .OR. NC .EQ. -10)) G *OTO 2160 GETFIL = NFILE .GT. 0 .AND. NC .NE. - 10 IF (.NOT.(GETFIL)) GOTO 2490 NSELEC = NSELEC + 1 2490 CONTINUE IF (.NOT.(NC .EQ. -10)) GOTO 2510 CLOSE(UNIT = 5) 2510 CONTINUE RETURN END C nxtfil - apply defaults, return wild, indirect, or simple file LOGICAL FUNCTION NXTFIL(FILE, NFILE, NAMTYP) IMPLICIT INTEGER(A - Z) BYTE FILE(134), TFILE(134), T2FILE(134), SWTCHS(134) LOGICAL FWILD, WILD C files - common area for file defaults and names COMMON/FILES/LFILE, NODE, DEV, UIC, NAME, EXT, CNODE, CDEV, CUIC, *CNAME, CEXT, CVER C current output file spec BYTE LFILE(99) C defaults constructed from input file spec on command line BYTE NODE(66) BYTE UIC(10) BYTE NAME(10) BYTE DEV(6) BYTE EXT(5) C current open input file spec fields BYTE CNODE(66) BYTE CDEV(6) BYTE CUIC(10) BYTE CNAME(10) BYTE CEXT(5) BYTE CVER(7) DATA LFILE(1)/0/ DATA NODE(1)/0/ DATA UIC(1)/0/ DATA NAME(1)/0/ DATA DEV(1)/83/,DEV(2)/89/,DEV(3)/58/,DEV(4)/0/ DATA EXT(1)/46/,EXT(2)/76/,EXT(3)/83/,EXT(4)/84/,EXT(5)/0/ DATA CNODE(1)/0/ DATA CDEV(1)/0/ DATA CUIC(1)/0/ DATA CNAME(1)/0/ DATA CEXT(1)/0/ DATA CVER(1)/0/ 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/ IF (.NOT.(NAMTYP .EQ. 2)) GOTO 2530 CALL READF(5, FILE, TFILE, NFILE) IF (.NOT.(NFILE .GT. 0)) GOTO 2550 CALL SCOPY(TFILE, 1, FILE, 1) Creset defaults CALL DEFNAM(FILE, NODE, DEVICE, UIC, NAME, EXT, .TRUE.) 2550 CONTINUE GOTO 2540 2530 CONTINUE IF (.NOT.(NFILE .EQ. 0)) GOTO 2570 NAMTYP = 1 FWILD = WILD(FILE) I = BKSCNQ(FILE, '/', 1) C save switches CALL SCOPY(FILE, I, SWTCHS, 1) FILE(I) = 0 C save initial file spec CALL SCOPY(FILE, 1, T2FILE, 1) CALL DEFNAM(FILE, NODE, DEV, UIC, NAME, EXT, .TRUE.) CALL CONCAT(FILE, SWTCHS, 134) IF (.NOT.(.NOT.WILD(FILE))) GOTO 2590 CALL SCOPY(T2FILE, 1, TFILE, 1) NFILE = 1 NAMTYP = 0 GOTO 2600 2590 CONTINUE CALL FINDFL(5, FILE, TFILE, NFILE) IF (.NOT.(NFILE .EQ. 0)) GOTO 2610 C try again with no defaults IF (.NOT.(.NOT.FWILD)) GOTO 2630 CALL SCOPY(T2FILE, 1, TFILE, 1) NFILE = 1 NAMTYP = 0 GOTO 2640 2630 CONTINUE CALL DEFNAM(T2FILE, 0, 'SY:', 0, 0, '.', .FALSE.) CALL CONCAT(T2FILE, SWTCHS, 134) CALL FINDFL(5, T2FILE, TFILE, NFILE) IF (.NOT.(NFILE .NE. 0)) GOTO 2650 C reset defaults NODE(1) = 0 DEV(1) = 0 UIC(1) = 0 NAME(1) = 0 EXT(1) = 0 CALL DEFNAM(T2FILE, NODE, DEV, UIC, NAME, EXT, .TRUE.) 2650 CONTINUE 2640 CONTINUE 2610 CONTINUE 2600 CONTINUE IF (.NOT.(NFILE .EQ. 0)) GOTO 2670 CALL SCOPY('LIST -- Error opening ', 1, TFILE, 1) CALL TTPUT(TFILE, CONCAT(TFILE, FILE, 134)) XSTAT = 2 2670 CONTINUE GOTO 2540 2570 CONTINUE IF (.NOT.(NAMTYP .EQ. 0)) GOTO 2690 NFILE = 0 GOTO 2540 2690 CONTINUE CALL FINDFL(5, FILE, TFILE, NFILE) 2540 CONTINUE IF (.NOT.(NFILE .GT. 0)) GOTO 2710 CALL SCOPY(TFILE, 1, FILE, 1) NXTFIL = (.TRUE.) RETURN 2710 CONTINUE NXTFIL = (.FALSE.) RETURN END C wild - return true if file name contains wild card characters or switches LOGICAL FUNCTION WILD(FILE) BYTE FILE(1) INTEGER BKSCNQ IF (.NOT.(FILE(BKSCNQ(FILE, '/*?', 1)) .NE. 0)) GOTO 2730 WILD = (.TRUE.) RETURN 2730 CONTINUE WILD = (.FALSE.) RETURN END C readf - read in file names from indirect file SUBROUTINE READF(F, FILE, OUTFIL, NSELEC) INTEGER F, NSELEC, NC BYTE FILE(1), OUTFIL(1) IF (.NOT.(NSELEC .EQ. 0)) GOTO 2750 CALL DEFNAM(FILE(2), 0, 'SY:', 0, 0, '.CMD', .FALSE.) CLOSE(UNIT = F) OPEN(UNIT = F, NAME = FILE(2), TYPE = 'old', READONLY, SHARED, E *RR = 10) 2750 CONTINUE 2770 CONTINUE CALL GET(F, OUTFIL, 134 - 1, NC) 2780 IF (.NOT.(NC .NE. 0)) GOTO 2770 IF (.NOT.(NC .LT. 0)) GOTO 2800 NSELEC = 0 CLOSE(UNIT = F) GOTO 2810 2800 CONTINUE NSELEC = NSELEC + 1 OUTFIL(NC + 1) = 0 2810 CONTINUE RETURN 10 CONTINUE CALL ERR(FILE, 2, 'Can''t open file.') RETURN END C findfl - return matching file names one-by-one SUBROUTINE FINDFL(LUN, FILE, OUTFIL, N) BYTE FILE(99), OUTFIL(99) INTEGER LUN, N, SAVEN, 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 SAVEN = N IF (.NOT.(SAVEN .EQ. 0)) GOTO 2820 CALL QIOFN(3, IODET, 0, 0, IERR) 2820 CONTINUE CALL FNDFIL(LUN, FILE, OUTFIL, N) IF (.NOT.(SAVEN .EQ. 0)) GOTO 2840 CALL QIOFN(3, IOATT, 0, 0, IERR) 2840 CONTINUE RETURN END