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 INDEX 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 = INDEX(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 INDEX(STR, C) BYTE C, STR(1) INDEX = 1 2300 IF (.NOT.(STR(INDEX) .NE. 0)) GOTO 2320 IF (.NOT.(STR(INDEX) .EQ. C)) GOTO 2330 RETURN 2330 CONTINUE 2310 INDEX = INDEX + 1 GOTO 2300 2320 CONTINUE INDEX = 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 INDEX, I BKSCAN = I 3130 IF (.NOT.(STR(BKSCAN) .NE. 0)) GOTO 3150 IF (.NOT.(INDEX(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 INDEX, I SCAN = I 3180 IF (.NOT.(STR(SCAN) .NE. 0)) GOTO 3200 IF (.NOT.(INDEX(SCSTR, STR(SCAN)) .EQ. 0)) GOTO 3210 GOTO 3200 3210 CONTINUE 3190 SCAN = SCAN + 1 GOTO 3180 3200 CONTINUE RETURN END C# esc - map array(i) into escaped character if appropriate BYTE FUNCTION ESC(ARRAY, I) BYTE ARRAY(1), CUPPER INTEGER I IF (.NOT.(ARRAY(I) .NE. 64)) GOTO 3230 ESC = ARRAY(I) GOTO 3240 3230 CONTINUE IF (.NOT.(ARRAY(I+1) .EQ. 0)) GOTO 3250 C ESCAPE not special at end ESC = 64 GOTO 3240 3250 CONTINUE I = I + 1 I3270 = (CUPPER(ARRAY(I))) GOTO 3270 3290 CONTINUE ESC = 8 GOTO 3280 3300 CONTINUE ESC = 0 GOTO 3280 3310 CONTINUE ESC = 12 GOTO 3280 3320 CONTINUE ESC = 7 GOTO 3280 3330 CONTINUE ESC = 10 GOTO 3280 3340 CONTINUE ESC = 10 GOTO 3280 3350 CONTINUE ESC = 13 GOTO 3280 3360 CONTINUE ESC = 9 GOTO 3280 3370 CONTINUE ESC = 11 GOTO 3280 3380 CONTINUE ESC = 27 GOTO 3280 3390 CONTINUE ESC = 0 J = I 3400 IF (.NOT.(J .LT. I+3 .AND. (ARRAY(J) .GE. 48 .AND. ARRAY(J) .L *E. 55))) GOTO 3420 ESC = 8*ESC + (ARRAY(J) - 48) 3410 J = J + 1 GOTO 3400 3420 CONTINUE I = J - 1 GOTO 3280 3430 CONTINUE ESC = ARRAY(I) GOTO 3280 3270 CONTINUE IF (I3270 .EQ. 36) GOTO 3380 IF (I3270 .GE. 48 .AND. I3270 .LE. 55) GOTO 3390 IF (I3270 .EQ. 66) GOTO 3290 IF (I3270 .EQ. 69) GOTO 3300 IF (I3270 .EQ. 70) GOTO 3310 IF (I3270 .EQ. 71) GOTO 3320 IF (I3270 .EQ. 76) GOTO 3330 IF (I3270 .EQ. 78) GOTO 3340 IF (I3270 .EQ. 82) GOTO 3350 IF (I3270 .EQ. 84) GOTO 3360 IF (I3270 .EQ. 86) GOTO 3370 GOTO 3430 3280 CONTINUE 3240 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 3440 IF (.NOT.(STR1(I) .EQ. STR2(I))) GOTO 3460 IF (.NOT.(STR1(I) .EQ. 0)) GOTO 3470 EQ = (.TRUE.) RETURN 3470 CONTINUE 3450 I = I + 1 GOTO 3440 3460 CONTINUE EQ = (.FALSE.) RETURN END