C define(VAX) C location of system-wide "SYMBOLS." file C maximum field for integer strings C must be highest lu for standard files C C C C RATLIB utility routines - miscellaneous support for all programs C ================================================================ C C C Author: William P. Wood, Jr. C Computer Center C Institute For Cancer Research C 7701 Burholme Ave. C Philadelphia, Pa. 19111 C (215) 728 2760 C C Version: 2.0 C C Date: December 18, 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 alldig - return YES if str is all digits INTEGER FUNCTION ALLDIG(STR) INTEGER I BYTE STR(1) ALLDIG = 0 IF (.NOT.(STR(1) .EQ. 0)) GOTO 2000 RETURN 2000 CONTINUE I = 1 2020 IF (.NOT.(STR(I) .NE. 0)) GOTO 2040 IF (.NOT.(STR(I) .LT. 48 .OR. STR(I) .GT. 57)) GOTO 2050 RETURN 2050 CONTINUE 2030 I = I + 1 GOTO 2020 2040 CONTINUE ALLDIG = 1 RETURN END C ctoi - convert string at in(i) to integer, increment i INTEGER FUNCTION CTOI(IN, I) BYTE IN(1) INTEGER INDEXX INTEGER D, I LOGICAL NEG BYTE DIGITS(11) DATA DIGITS(1)/48/,DIGITS(2)/49/,DIGITS(3)/50/,DIGITS(4)/51/,DIGIT *S(5)/52/,DIGITS(6)/53/,DIGITS(7)/54/,DIGITS(8)/55/,DIGITS(9)/56/,D *IGITS(10)/57/,DIGITS(11)/0/ 2070 IF (.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9)) GOTO 2080 I = I + 1 GOTO 2070 2080 CONTINUE IF (.NOT.(IN(I) .EQ. 45)) GOTO 2090 NEG = .TRUE. I = I + 1 GOTO 2100 2090 CONTINUE NEG = .FALSE. 2100 CONTINUE CTOI = 0 2110 IF (.NOT.(IN(I) .NE. 0)) GOTO 2130 D = INDEXX(DIGITS, IN(I)) IF (.NOT.(D .EQ. 0)) GOTO 2140 C non-digit GOTO 2130 2140 CONTINUE CTOI = 10*CTOI + D - 1 2120 I = I + 1 GOTO 2110 2130 CONTINUE IF (.NOT.(NEG)) GOTO 2160 CTOI = - CTOI 2160 CONTINUE RETURN END C concat - concatenate two strings INTEGER FUNCTION CONCAT(S1, S2, LIM) BYTE S1(1), S2(1) INTEGER LIM, I, LENGTH, L L = LENGTH(S1) I = L + 1 2180 IF (.NOT.(I .LT. LIM .AND. S2(I-L) .NE. 0)) GOTO 2200 S1(I) = S2(I - L) 2190 I = I + 1 GOTO 2180 2200 CONTINUE S1(I) = 0 CONCAT = I - 1 RETURN END C equal - compare str1 to str2; return YES if equal, NO if not INTEGER FUNCTION EQUAL(STR1, STR2) BYTE STR1(1), STR2(1) INTEGER I I = 1 2210 IF (.NOT.(STR1(I) .EQ. STR2(I))) GOTO 2230 IF (.NOT.(STR1(I) .EQ. 0)) GOTO 2240 EQUAL = 1 RETURN 2240 CONTINUE 2220 I = I + 1 GOTO 2210 2230 CONTINUE EQUAL = 0 RETURN END C getwrd - get non-blank word from in(i) into out, increment i INTEGER FUNCTION GETWRD(IN, I, OUT) BYTE IN(1), OUT(1) INTEGER I, J 2260 IF (.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9)) GOTO 2270 I = I + 1 GOTO 2260 2270 CONTINUE J = 1 2280 IF (.NOT.(IN(I) .NE. 0 .AND. IN(I) .NE. 32 .AND. IN(I) .NE. 9 .AND *. IN(I) .NE. 10)) GOTO 2290 OUT(J) = IN(I) I = I + 1 J = J + 1 GOTO 2280 2290 CONTINUE OUT(J) = 0 GETWRD = J - 1 RETURN END C index - find character c in string str INTEGER FUNCTION INDEXX(STR, C) BYTE C, STR(1) INDEXX = 1 2300 IF (.NOT.(STR(INDEXX) .NE. 0)) GOTO 2320 IF (.NOT.(STR(INDEXX) .EQ. C)) GOTO 2330 RETURN 2330 CONTINUE 2310 INDEXX = INDEXX + 1 GOTO 2300 2320 CONTINUE INDEXX = 0 RETURN END C itoc - convert integer int to char string in str INTEGER FUNCTION ITOC(INT, STR, SIZE) INTEGER IABS, MOD INTEGER D, I, INT, INTVAL, J, K, SIZE BYTE STR(1) BYTE DIGITS(11) DATA DIGITS(1)/48/,DIGITS(2)/49/,DIGITS(3)/50/,DIGITS(4)/51/,DIGIT *S(5)/52/,DIGITS(6)/53/,DIGITS(7)/54/,DIGITS(8)/55/,DIGITS(9)/56/,D *IGITS(10)/57/,DIGITS(11)/0/ INTVAL = INT STR(1) = 0 I = 1 2350 CONTINUE C generate digits I = I + 1 D = MOD(INTVAL, 10) STR(I) = DIGITS(IABS(D) + 1) INTVAL = (INTVAL - D)/10 2360 IF (.NOT.(INTVAL .EQ. 0 .OR. I .GE. SIZE)) GOTO 2350 IF (.NOT.(INT .LT. 0 .AND. I .LT. SIZE)) GOTO 2380 C then sign I = I + 1 STR(I) = 45 2380 CONTINUE ITOC = I - 1 J = 1 2400 IF (.NOT.(J .LT. I)) GOTO 2420 C then reverse K = STR(I) STR(I) = STR(J) STR(J) = K I = I - 1 2410 J = J + 1 GOTO 2400 2420 CONTINUE RETURN END C itocrj - convert integer to character in a right-adjusted field INTEGER FUNCTION ITOCRJ(INT, STR, SIZE) INTEGER INT, SIZE, J INTEGER ITOC BYTE STR(1), TBUF(7) J = ITOC(INT, TBUF, 7) I = SIZE - 1 2430 IF (.NOT.(J .GT. 0 .AND. I .GT. 0)) GOTO 2450 STR(I) = TBUF(J) J = J - 1 2440 I = I - 1 GOTO 2430 2450 CONTINUE 2460 IF (.NOT.(I .GT. 0)) GOTO 2480 STR(I) = 32 2470 I = I - 1 GOTO 2460 2480 CONTINUE STR(SIZE) = 0 ITOCRJ = SIZE - 1 RETURN END C length - compute length of string INTEGER FUNCTION LENGTH(STR) BYTE STR(1) LENGTH = 0 2490 IF (.NOT.(STR(LENGTH+1) .NE. 0)) GOTO 2510 2500 LENGTH = LENGTH + 1 GOTO 2490 2510 CONTINUE RETURN END C putnum - put integer SUBROUTINE PUTNUM(INT, F) INTEGER INT, F, I, N BYTE CHARS(7) INTEGER ITOC N = ITOC(INT, CHARS, 7) I = 1 2520 IF (.NOT.(I .LE. N)) GOTO 2540 CALL PUTCH(CHARS(I), F) 2530 I = I + 1 GOTO 2520 2540 CONTINUE RETURN END C putdec - put decimal integer n in field width >= w SUBROUTINE PUTDEC(N, W) BYTE CHARS(7) INTEGER ITOC INTEGER I, N, ND, W ND = ITOC(N, CHARS, 7) I = ND + 1 2550 IF (.NOT.(I .LE. W)) GOTO 2570 CALL PUTC(32) 2560 I = I + 1 GOTO 2550 2570 CONTINUE I = 1 2580 IF (.NOT.(I .LE. ND)) GOTO 2600 CALL PUTC(CHARS(I)) 2590 I = I + 1 GOTO 2580 2600 CONTINUE RETURN END C scopy - copy string at from(i) to to(j) SUBROUTINE SCOPY(FROM, I, TO, J) BYTE FROM(1), TO(1) INTEGER I, J, K1, K2 K2 = J K1 = I 2610 IF (.NOT.(FROM(K1) .NE. 0)) GOTO 2630 TO(K2) = FROM(K1) K2 = K2 + 1 2620 K1 = K1 + 1 GOTO 2610 2630 CONTINUE TO(K2) = 0 RETURN END C type - determine type of character BYTE FUNCTION TYPE(C) BYTE C BYTE CTYPE(256) C A-Z and a-z are alphabetic; C 0-9 are digits; DATA CTYPE/128*0, 48*0, 10*2, 7*0, 26*3, 6*0, 26*3, 5*0/ TYPE = CTYPE(C + 129) IF (.NOT.(TYPE .EQ. 0)) GOTO 2640 TYPE = C C$ if( c >= DIG0 & c <= DIG9) C$ type = DIGIT C$ else if( c >= LETA & c <= LETZ) C$ type = LETTER C$ else if( c >= BIGA & c <= BIGZ) C$ type = LETTER C$ else C$ type = c 2640 CONTINUE RETURN END C fold - fold all letters to lower case SUBROUTINE FOLD(TOKEN) BYTE TOKEN(1) INTEGER I I = 1 2660 IF (.NOT.(TOKEN(I) .NE. 0)) GOTO 2680 IF (.NOT.(TOKEN(I) .GE. 65 .AND. TOKEN(I) .LE. 90)) GOTO 2690 TOKEN(I) = TOKEN(I) - 65 + 97 2690 CONTINUE 2670 I = I + 1 GOTO 2660 2680 CONTINUE RETURN END C clower - change letter to lower case BYTE FUNCTION CLOWER(C) BYTE C IF (.NOT.(C .GE. 65 .AND. C .LE. 90)) GOTO 2710 CLOWER = C - 65 + 97 GOTO 2720 2710 CONTINUE CLOWER = C 2720 CONTINUE RETURN END C cupper - change letter to upper case BYTE FUNCTION CUPPER(C) BYTE C IF (.NOT.(C .GE. 97 .AND. C .LE. 122)) GOTO 2730 CUPPER = C - 97 + 65 GOTO 2740 2730 CONTINUE CUPPER = C 2740 CONTINUE RETURN END C lower - fold all alphas to lower case SUBROUTINE LOWER(TOKEN) BYTE TOKEN(1) INTEGER I I = 1 2750 IF (.NOT.(TOKEN(I) .NE. 0)) GOTO 2770 IF (.NOT.(TOKEN(I) .GE. 65 .AND. TOKEN(I) .LE. 90)) GOTO 2780 TOKEN(I) = TOKEN(I) - 65 + 97 2780 CONTINUE 2760 I = I + 1 GOTO 2750 2770 CONTINUE RETURN END C upper - fold all alphas to upper case SUBROUTINE UPPER(TOKEN) BYTE TOKEN(1) INTEGER I I = 1 2800 IF (.NOT.(TOKEN(I) .NE. 0)) GOTO 2820 IF (.NOT.(TOKEN(I) .GE. 97 .AND. TOKEN(I) .LE. 122)) GOTO 2830 TOKEN(I) = TOKEN(I) - 97 + 65 2830 CONTINUE 2810 I = I + 1 GOTO 2800 2820 CONTINUE RETURN END C uniqm - find command string which matches input string uniquely SUBROUTINE UNIQM(IN, CMDSTR, CODE, RESULT) BYTE IN(1), CMDSTR(1) INTEGER CODE, RESULT, I IF (.NOT.(IN(1) .EQ. 0 .AND. CMDSTR(1) .NE. 0)) GOTO 2850 Cnull string must match exactly RETURN 2850 CONTINUE I = 1 2870 IF (.NOT.(IN(I) .NE. 0)) GOTO 2890 IF (.NOT.(IN(I) .NE. CMDSTR(I))) GOTO 2900 RETURN 2900 CONTINUE 2880 I = I + 1 GOTO 2870 2890 CONTINUE IF (.NOT.(RESULT .NE. 0)) GOTO 2920 RESULT = - 1 GOTO 2930 2920 CONTINUE IF (.NOT.(CODE .GE. 0)) GOTO 2940 RESULT = CODE GOTO 2930 2940 CONTINUE IF (.NOT.(CMDSTR(I) .EQ. 0)) GOTO 2960 C if code neg., must match exactly RESULT = - CODE 2960 CONTINUE 2930 CONTINUE RETURN END C pmatch - return YES if str1 is a partial match to str2 INTEGER FUNCTION PMATCH(STR1, STR2) BYTE STR1(1), STR2(1) INTEGER C C = 0 CALL UNIQM(STR1, STR2, 1, C) IF (.NOT.(C .EQ. 0)) GOTO 2980 PMATCH = 0 GOTO 2990 2980 CONTINUE PMATCH = 1 2990 CONTINUE RETURN END C search - find a pattern in a line INTEGER FUNCTION SEARCH(TEXT, PATTRN) BYTE TEXT(1), PATTRN(1) INTEGER N, M, J, LENGTH, I SEARCH = 0 M = LENGTH(PATTRN) IF (.NOT.(M .EQ. 0)) GOTO 3000 RETURN 3000 CONTINUE N = LENGTH(TEXT) J = M 3020 IF (.NOT.(J .LE. N)) GOTO 3030 DO 3040 I = M, 1, - 1 IF (.NOT.(TEXT(J-M+I) .NE. PATTRN(I))) GOTO 3060 J = J + 1 GOTO 3020 3060 CONTINUE 3040 CONTINUE SEARCH = J - M + 1 RETURN 3030 CONTINUE RETURN END C-h- conc 191 asc 3-oct-80 11:28:26 SUBROUTINE CONC(FIRST, SECOND, OUT) BYTE FIRST(1), SECOND(1), OUT(1) INTEGER I I = 1 CALL STCOPY(FIRST, 1, OUT, I) CALL SCOPY(SECOND, 1, OUT, I) RETURN END C-h- stcopy 201 asc 3-oct-80 11:28:26 SUBROUTINE STCOPY(IN, I, OUT, J) BYTE IN(1), OUT(1) INTEGER I, J, K K = I 3080 IF (.NOT.(IN(K) .NE. 0)) GOTO 3100 OUT(J) = IN(K) J = J + 1 3090 K = K + 1 GOTO 3080 3100 CONTINUE OUT(J) = 0 RETURN END C-h- skipbl 186 asc 3-oct-80 11:28:23 C# skipbl - skip blanks and tabs at lin(i) SUBROUTINE SKIPBL(LIN, I) BYTE LIN(1) INTEGER I 3110 IF (.NOT.(LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9)) GOTO 3120 I = I + 1 GOTO 3110 3120 CONTINUE RETURN END C bkscan - return index of first break char in str INTEGER FUNCTION BKSCAN(STR, BRK, I) BYTE STR(1), BRK(1) INTEGER INDEXX, I BKSCAN = I 3130 IF (.NOT.(STR(BKSCAN) .NE. 0)) GOTO 3150 IF (.NOT.(INDEXX(BRK, STR(BKSCAN)) .NE. 0)) GOTO 3160 GOTO 3150 3160 CONTINUE 3140 BKSCAN = BKSCAN + 1 GOTO 3130 3150 CONTINUE RETURN END C scan - return index of first char in str which isn't in scstr INTEGER FUNCTION SCAN(STR, SCSTR, I) BYTE STR(1), SCSTR(1) INTEGER INDEXX, I SCAN = I 3180 IF (.NOT.(STR(SCAN) .NE. 0)) GOTO 3200 IF (.NOT.(INDEXX(SCSTR, STR(SCAN)) .EQ. 0)) GOTO 3210 GOTO 3200 3210 CONTINUE 3190 SCAN = SCAN + 1 GOTO 3180 3200 CONTINUE RETURN END C eq - compare str1 to str2; return .true. if equal, .false. if not LOGICAL FUNCTION EQ(STR1, STR2) BYTE STR1(1), STR2(1) INTEGER I I = 1 3230 IF (.NOT.(STR1(I) .EQ. STR2(I))) GOTO 3250 IF (.NOT.(STR1(I) .EQ. 0)) GOTO 3260 EQ = (.TRUE.) RETURN 3260 CONTINUE 3240 I = I + 1 GOTO 3230 3250 CONTINUE EQ = (.FALSE.) RETURN END C indexq - find character c in string str, ignoring chars within quoted strings INTEGER FUNCTION INDEXQ(STR, C) BYTE C, STR(1) INTEGER NUQCP INDEXQ = NUQCP(STR, 1) 3280 IF (.NOT.(STR(INDEXQ) .NE. 0)) GOTO 3300 IF (.NOT.(STR(INDEXQ) .EQ. C)) GOTO 3310 RETURN 3310 CONTINUE 3290 INDEXQ = NUQCP(STR, INDEXQ + 1) GOTO 3280 3300 CONTINUE INDEXQ = 0 RETURN END C bkscnq - return index of first break char in str, ignore chars inside quotes INTEGER FUNCTION BKSCNQ(STR, BRK, I) BYTE STR(1), BRK(1) INTEGER INDEXX, NUQCP, I BKSCNQ = NUQCP(STR, I) 3330 IF (.NOT.(STR(BKSCNQ) .NE. 0)) GOTO 3350 IF (.NOT.(INDEXX(BRK, STR(BKSCNQ)) .NE. 0)) GOTO 3360 GOTO 3350 3360 CONTINUE 3340 BKSCNQ = NUQCP(STR, BKSCNQ + 1) GOTO 3330 3350 CONTINUE RETURN END C nuqcp - return postion of next char which isn't part of a quoted (") string INTEGER FUNCTION NUQCP(BUF, I) BYTE BUF(1) INTEGER I IF (.NOT.(BUF(I) .NE. '"')) GOTO 3380 NUQCP = (I) RETURN 3380 CONTINUE NUQCP = I + 1 3400 IF (.NOT.(BUF(NUQCP) .NE. 0)) GOTO 3420 IF (.NOT.(BUF(NUQCP) .EQ. '"')) GOTO 3430 NUQCP = NUQCP + 1 IF (.NOT.(BUF(NUQCP) .NE. '"')) GOTO 3450 RETURN 3450 CONTINUE 3430 CONTINUE 3410 NUQCP = NUQCP + 1 GOTO 3400 3420 CONTINUE END