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(DEBUG) C wpat - compile wild pattern INTEGER FUNCTION WPAT(PAT, PATP, SPCIAL, AUX, MAXAUX) IMPLICIT INTEGER(A - Z) BYTE PAT(1), AUX(1), SPCIAL(1), COLB(4), CUPPER INTEGER*2LOCOL, HICOL LOGICAL LITRAL, ADDCHR EQUIVALENCE(LOCOL, COLB), (HICOL, COLB(3)) BEGPAT = 1 PATP = PATP - 1 LITRAL = .FALSE. PATTYP = 0 2000 CONTINUE AUXP = BEGPAT + 1 PATP = PATP + 1 IF (.NOT.(PAT(PATP) .EQ. SPCIAL(14))) GOTO 2030 C column range? PATP = PATP + 1 K = SCAN(PAT, '1234567890', PATP) IF (.NOT.(PAT(K) .EQ. SPCIAL(16))) GOTO 2050 LOCOL = 1 IF (.NOT.(K .GT. PATP)) GOTO 2070 DECODE(K-PATP, 2090, PAT(PATP), ERR=20) LOCOL 2090 FORMAT(I) 2070 CONTINUE IF (.NOT.(LOCOL .LE. 0)) GOTO 2100 GOTO 20 2100 CONTINUE PATP = K + 1 HICOL = 32767 K = SCAN(PAT, '1234567890', PATP) IF (.NOT.(K .GT. PATP)) GOTO 2120 DECODE(K-PATP, 2140, PAT(PATP), ERR=20) HICOL 2140 FORMAT(I) 2120 CONTINUE IF (.NOT.(LOCOL .GT. HICOL)) GOTO 2150 GOTO 20 2150 CONTINUE C zero relative LOCOL = LOCOL - 1 PATP = K IF (.NOT.(PAT(PATP) .NE. SPCIAL(15))) GOTO 2170 GOTO 20 2170 CONTINUE PATP = PATP + 1 PATTYP = 4 .OR. PATTYP GOTO 2060 2050 CONTINUE PATP = K GOTO 20 2060 CONTINUE 2030 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(6))) GOTO 2190 C negate pattern? PATTYP = 1 .OR. PATTYP PATP = PATP + 1 2190 CONTINUE IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2210 GOTO 10 2210 CONTINUE AUX(AUXP) = PATTYP AUXP = AUXP + 1 IF (.NOT.((PATTYP .AND. 4) .NE. 0)) GOTO 2230 DO 2250 K = 0, 3 IF (.NOT.(AUXP+K .GT. MAXAUX)) GOTO 2270 GOTO 10 2270 CONTINUE AUX(AUXP + K) = COLB(K + 1) 2250 CONTINUE AUXP = AUXP + 4 2230 CONTINUE BP = AUXP IF (.NOT.(PAT(PATP) .EQ. SPCIAL(7))) GOTO 2290 C match beginning of line? PATP = PATP + 1 IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2310 GOTO 10 2310 CONTINUE AUX(AUXP) = - 124 AUXP = AUXP + 1 2290 CONTINUE 2330 IF (.NOT.(PAT(PATP) .NE. 0)) GOTO 2350 IF (.NOT.(PAT(PATP) .EQ. SPCIAL(10))) GOTO 2360 IF (.NOT.(PAT(PATP+1) .NE. SPCIAL(10) .OR. .NOT.LITRAL)) GOT *O 2380 LITRAL = .NOT.LITRAL GOTO 2390 2380 CONTINUE IF (.NOT.(.NOT.ADDCHR(SPCIAL(10), AUX, AUXP, MAXAUX, LITRA *L))) GOTO 2400 GOTO 10 2400 CONTINUE PATP = PATP + 1 2390 CONTINUE GOTO 2370 2360 CONTINUE IF (.NOT.(LITRAL)) GOTO 2420 IF (.NOT.(.NOT.ADDCHR(PAT(PATP), AUX, AUXP, MAXAUX, LITRAL)) *) GOTO 2440 GOTO 10 2440 CONTINUE GOTO 2370 2420 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(1) .OR. PAT(PATP) .EQ. SPCIAL( *4) .OR. PAT(PATP) .EQ. SPCIAL(5))) GOTO 2460 GOTO 2350 2460 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(2))) GOTO 2480 IF (.NOT.(AUXP .GT. BP .AND. AUX(AUXP-1) .NE. -128)) GOTO 25 *00 C collapse multiple wild chars IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2520 GOTO 10 2520 CONTINUE AUX(AUXP) = - 128 AUXP = AUXP + 1 2500 CONTINUE GOTO 2370 2480 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(3))) GOTO 2540 IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2560 GOTO 10 2560 CONTINUE AUX(AUXP) = - 127 AUXP = AUXP + 1 GOTO 2370 2540 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(9) .AND. PAT(PATP+1) .NE. 0)) *GOTO 2580 PATP = PATP + 1 IF (.NOT.(.NOT.ADDCHR(CUPPER(PAT(PATP))-64, AUX, AUXP, MAXAU *X, LITRAL))) GOTO 2600 GOTO 10 2600 CONTINUE GOTO 2370 2580 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(8) .AND. (PAT(PATP+1) .EQ. SPC *IAL(1) .OR. PAT(PATP+1) .EQ. SPCIAL(4) .OR. PAT(PATP+1) .EQ. 0 .OR *. PAT(PATP+1) .EQ. SPCIAL(5)))) GOTO 2620 IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2640 GOTO 10 2640 CONTINUE AUX(AUXP) = - 125 AUXP = AUXP + 1 GOTO 2370 2620 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(11))) GOTO 2660 IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2680 GOTO 10 2680 CONTINUE AUX(AUXP) = - 126 AUXP = AUXP + 1 GOTO 2370 2660 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(12))) GOTO 2700 IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2720 GOTO 10 2720 CONTINUE AUX(AUXP) = - 123 AUXP = AUXP + 1 GOTO 2370 2700 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(13))) GOTO 2740 IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2760 GOTO 10 2760 CONTINUE AUX(AUXP) = - 122 AUXP = AUXP + 1 GOTO 2370 2740 CONTINUE IF (.NOT.(.NOT.ADDCHR(PAT(PATP), AUX, AUXP, MAXAUX, LITRAL)) *) GOTO 2780 GOTO 10 2780 CONTINUE 2370 CONTINUE 2340 PATP = PATP + 1 GOTO 2330 2350 CONTINUE IF (.NOT.(AUXP .GT. BP .AND. AUX(AUXP-1) .EQ. -128)) GOTO 2800 C delete wild char at end of pattern AUXP = AUXP - 1 2800 CONTINUE IF (.NOT.(AUXP-BEGPAT .GT. 255)) GOTO 2820 GOTO 10 2820 CONTINUE IF (.NOT.(BEGPAT .GT. MAXAUX)) GOTO 2840 GOTO 10 2840 CONTINUE AUX(BEGPAT) = AUXP - BEGPAT - 128 BEGPAT = AUXP IF (.NOT.(PAT(PATP) .EQ. SPCIAL(5))) GOTO 2860 PATTYP = 2 GOTO 2870 2860 CONTINUE PATTYP = 0 2870 CONTINUE 2010 IF (.NOT.(PAT(PATP) .EQ. SPCIAL(1) .OR. PAT(PATP) .EQ. 0)) GOTO 20 *00 IF (.NOT.(BEGPAT .GT. MAXAUX)) GOTO 2880 GOTO 10 2880 CONTINUE AUX(BEGPAT) = - 128 IF (.NOT.(PAT(PATP) .NE. 0)) GOTO 2900 PATP = PATP + 1 2900 CONTINUE WPAT = (1) RETURN C pattern too long 10 CONTINUE WPAT = (2) RETURN C bad column range 20 CONTINUE WPAT = (4) RETURN END C addchr - add a character to the aux array LOGICAL FUNCTION ADDCHR(CHAR, AUX, AUXP, MAXAUX, LITRAL) BYTE CHAR, AUX(1), C INTEGER MAXAUX, AUXP LOGICAL LITRAL IF (.NOT.(CHAR .GE. 'A' .AND. CHAR .LE. 'Z' .AND. .NOT.LITRAL)) GO *TO 2920 C convert to lower case; ASCII only! C = CHAR - 'A' + 'a' GOTO 2930 2920 CONTINUE C = CHAR 2930 CONTINUE IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2940 GOTO 10 2940 CONTINUE AUX(AUXP) = C IF (.NOT.(C .GE. 'a' .AND. C .LE. 'z' .AND. .NOT.LITRAL)) GOTO 296 *0 IF (.NOT.(AUXP+1 .GT. MAXAUX)) GOTO 2980 GOTO 10 2980 CONTINUE AUX(AUXP + 1) = 32 C mask to convert text to lower case GOTO 2970 2960 CONTINUE IF (.NOT.(AUXP+1 .GT. MAXAUX)) GOTO 3000 GOTO 10 3000 CONTINUE AUX(AUXP + 1) = 0 2970 CONTINUE AUXP = AUXP + 2 ADDCHR = (.TRUE.) RETURN C error exit 10 CONTINUE ADDCHR = (.FALSE.) RETURN END