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(DEBUG) C define(MacroWsrch) C define(CLASSES) C wpat - compile wild pattern LOGICAL FUNCTION WPAT(PAT, PATP, SPCIAL, AUX, MAXAUX) IMPLICIT INTEGER(A - Z) BYTE PAT(1), AUX(1), SPCIAL(1), CUPPER LOGICAL EOL, LITRAL, ADDCHR LASTOR = 1 PATP = PATP - 1 LITRAL = .FALSE. PATTYP = 0 2000 CONTINUE AUXP = LASTOR + 1 EOL = .FALSE. PATP = PATP + 1 IF (.NOT.(PAT(PATP) .EQ. SPCIAL(6))) GOTO 2030 C negate pattern? IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2050 GOTO 10 2050 CONTINUE AUX(AUXP) = 1 .OR. PATTYP PATP = PATP + 1 GOTO 2040 2030 CONTINUE IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2070 GOTO 10 2070 CONTINUE AUX(AUXP) = PATTYP 2040 CONTINUE AUXP = AUXP + 1 IF (.NOT.(PAT(PATP) .EQ. SPCIAL(7))) GOTO 2090 C match beginning of line? PATP = PATP + 1 GOTO 2100 2090 CONTINUE IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2110 GOTO 10 2110 CONTINUE AUX(AUXP) = - 128 AUXP = AUXP + 1 2100 CONTINUE 2130 IF (.NOT.(PAT(PATP) .NE. 0)) GOTO 2150 IF (.NOT.(LITRAL .AND. PAT(PATP) .NE. SPCIAL(10))) GOTO 2160 IF (.NOT.(.NOT.ADDCHR(PAT(PATP), AUX, AUXP, MAXAUX, LITRAL)) *) GOTO 2180 GOTO 10 2180 CONTINUE GOTO 2170 2160 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(10))) GOTO 2200 IF (.NOT.(PAT(PATP+1) .NE. SPCIAL(10))) GOTO 2220 LITRAL = .NOT.LITRAL GOTO 2230 2220 CONTINUE IF (.NOT.(.NOT.ADDCHR(SPCIAL(10), AUX, AUXP, MAXAUX, LITRA *L))) GOTO 2240 GOTO 10 2240 CONTINUE PATP = PATP + 1 2230 CONTINUE GOTO 2170 2200 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(1) .OR. PAT(PATP) .EQ. SPCIAL( *4) .OR. PAT(PATP) .EQ. SPCIAL(5))) GOTO 2260 GOTO 2150 2260 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(2))) GOTO 2280 IF (.NOT.(AUXP-1 .GT. MAXAUX)) GOTO 2300 GOTO 10 2300 CONTINUE IF (.NOT.(AUX(AUXP-1) .NE. -128)) GOTO 2320 C collapse multiple wild chars IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2340 GOTO 10 2340 CONTINUE AUX(AUXP) = - 128 AUXP = AUXP + 1 2320 CONTINUE GOTO 2170 2280 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(3))) GOTO 2360 IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2380 GOTO 10 2380 CONTINUE AUX(AUXP) = - 127 AUXP = AUXP + 1 GOTO 2170 2360 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(9) .AND. PAT(PATP+1) .NE. 0)) *GOTO 2400 PATP = PATP + 1 IF (.NOT.(.NOT.ADDCHR(CUPPER(PAT(PATP))-64, AUX, AUXP, MAXAU *X, LITRAL))) GOTO 2420 GOTO 10 2420 CONTINUE GOTO 2170 2400 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 2440 EOL = .TRUE. GOTO 2170 2440 CONTINUE IF (.NOT.(PAT(PATP) .EQ. SPCIAL(11))) GOTO 2460 IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2480 GOTO 10 2480 CONTINUE AUX(AUXP) = - 126 AUXP = AUXP + 1 GOTO 2170 2460 CONTINUE IF (.NOT.(.NOT.ADDCHR(PAT(PATP), AUX, AUXP, MAXAUX, LITRAL)) *) GOTO 2500 GOTO 10 2500 CONTINUE 2170 CONTINUE 2140 PATP = PATP + 1 GOTO 2130 2150 CONTINUE IF (.NOT.(.NOT.EOL)) GOTO 2520 IF (.NOT.(AUXP-1 .GT. MAXAUX)) GOTO 2540 GOTO 10 2540 CONTINUE IF (.NOT.(AUX(AUXP-1) .NE. -128)) GOTO 2560 C collapse multiple wild chars IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2580 GOTO 10 2580 CONTINUE AUX(AUXP) = - 128 AUXP = AUXP + 1 2560 CONTINUE 2520 CONTINUE IF (.NOT.(AUXP-LASTOR .GT. 127)) GOTO 2600 GOTO 10 2600 CONTINUE IF (.NOT.(LASTOR .GT. MAXAUX)) GOTO 2620 GOTO 10 2620 CONTINUE AUX(LASTOR) = AUXP - LASTOR LASTOR = AUXP IF (.NOT.(PAT(PATP) .EQ. SPCIAL(5))) GOTO 2640 PATTYP = 2 GOTO 2650 2640 CONTINUE PATTYP = 0 2650 CONTINUE 2010 IF (.NOT.(PAT(PATP) .EQ. SPCIAL(1) .OR. PAT(PATP) .EQ. 0)) GOTO 20 *00 IF (.NOT.(LASTOR .GT. MAXAUX)) GOTO 2660 GOTO 10 2660 CONTINUE AUX(LASTOR) = 0 IF (.NOT.(PAT(PATP) .NE. 0)) GOTO 2680 PATP = PATP + 1 2680 CONTINUE WPAT = (.TRUE.) RETURN C error exit 10 CONTINUE WPAT = (.FALSE.) 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 2700 C convert to lower case; ASCII only! C = CHAR - 'A' + 'a' GOTO 2710 2700 CONTINUE C = CHAR 2710 CONTINUE IF (.NOT.(AUXP .GT. MAXAUX)) GOTO 2720 GOTO 10 2720 CONTINUE AUX(AUXP) = C IF (.NOT.(C .GE. 'a' .AND. C .LE. 'z' .AND. .NOT.LITRAL)) GOTO 274 *0 IF (.NOT.(AUXP+1 .GT. MAXAUX)) GOTO 2760 GOTO 10 2760 CONTINUE AUX(AUXP + 1) = 32 C mask to convert text to upper case GOTO 2750 2740 CONTINUE IF (.NOT.(AUXP+1 .GT. MAXAUX)) GOTO 2780 GOTO 10 2780 CONTINUE AUX(AUXP + 1) = 0 2750 CONTINUE AUXP = AUXP + 2 ADDCHR = (.TRUE.) RETURN C error exit 10 CONTINUE ADDCHR = (.FALSE.) RETURN END C wsrch - search text for wild pattern INTEGER FUNCTION WSRCH(TEXT, TEXTL, PAT) BYTE TEXT(1), PAT(1) INTEGER TEXTL, TP, PP, ET, EP, BP, STAR, MARK LOGICAL SUCCES, T C A-Z and a-z are alphabetic, 0-9 are numeric, rest are break characters BYTE CTYPE(256) DATA CTYPE/128* - 126, 48* - 126, 10* - 122, 7* - 126, 26* - 124, *6* - 126, 26* - 124, 5* - 126/ SUCCES = .FALSE. ET = TEXTL + 1 PP = 1 2800 IF (.NOT.(PAT(PP) .NE. 0)) GOTO 2820 BP = PP EP = PP + PAT(PP) PP = PP + 2 TP = 1 STAR = 0 T = ((PAT(BP + 1) .AND. 1) .NE. 0) 2830 IF (.NOT.(TP .LT. ET .AND. PP .LT. EP)) GOTO 2840 IF (.NOT.(PAT(PP) .LT. 0)) GOTO 2850 I2870 = (PAT(PP)) GOTO 2870 2890 CONTINUE PP = PP + 1 STAR = PP IF (.NOT.(PP .EQ. BP+2+1 .AND. PP .LT. EP .AND. PAT(PP) .E *Q. -126)) GOTO 2900 C try to match from line beginning PP = PP + 1 MARK = TP - 1 GOTO 2910 2900 CONTINUE MARK = TP 2910 CONTINUE GOTO 2880 2920 CONTINUE TP = TP + 1 PP = PP + 1 GOTO 2880 2930 CONTINUE IF (.NOT.(CTYPE(TEXT(TP)+129) .EQ. PAT(PP))) GOTO 2940 TP = TP + 1 PP = PP + 1 GOTO 2950 2940 CONTINUE GOTO 5 2950 CONTINUE GOTO 2880 2870 CONTINUE IF (I2870 .EQ. -128) GOTO 2890 IF (I2870 .EQ. -127) GOTO 2920 GOTO 2930 2880 CONTINUE GOTO 2860 2850 CONTINUE IF (.NOT.(PAT(PP) .EQ. (TEXT(TP) .OR. PAT(PP+1)))) GOTO 2960 TP = TP + 1 PP = PP + 2 GOTO 2860 2960 CONTINUE C match failed 5 IF (.NOT.(STAR .EQ. 0)) GOTO 2980 GOTO 2840 2980 CONTINUE 10 PP = STAR MARK = MARK + 1 TP = MARK 2860 CONTINUE GOTO 2830 2840 CONTINUE IF (.NOT.(TP .EQ. ET .AND. PP .EQ. EP)) GOTO 3000 C matched to end? T = .NOT.T GOTO 3010 3000 CONTINUE IF (.NOT.(EP-2 .EQ. BP)) GOTO 3020 C null pattern? GOTO 3010 3020 CONTINUE IF (.NOT.(PAT(EP-1) .EQ. -128 .AND. PP .GE. EP-1)) GOTO 3040 C matched to end wild? T = .NOT.T GOTO 3010 3040 CONTINUE IF (.NOT.(PP .LT. EP .AND. TP .EQ. ET)) GOTO 3060 C $BREAK at EOL? IF (.NOT.(PAT(PP) .EQ. -126 .AND. PP .EQ. EP-2 .AND. PAT(EP-1) * .EQ. -128)) GOTO 3080 T = .NOT.T 3080 CONTINUE GOTO 3010 3060 CONTINUE IF (.NOT.(TP .LT. ET .AND. STAR .NE. 0)) GOTO 3100 C matched pat but not at end GOTO 10 3100 CONTINUE 3010 CONTINUE IF (.NOT.(((PAT(BP+1) .AND. 2) .NE. 0))) GOTO 3120 SUCCES = SUCCES .AND. T GOTO 3130 3120 CONTINUE SUCCES = SUCCES .OR. T 3130 CONTINUE 2810 PP = EP GOTO 2800 2820 CONTINUE IF (.NOT.(SUCCES)) GOTO 3140 WSRCH = (1) RETURN 3140 CONTINUE WSRCH = (0) RETURN 3150 CONTINUE END