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. 34)) GOTO 3380
        NUQCP = (I)
        RETURN
3380  CONTINUE
      NUQCP = I + 1
3400  IF (.NOT.(BUF(NUQCP) .NE. 0)) GOTO 3420
        IF (.NOT.(BUF(NUQCP) .EQ. 34)) GOTO 3430
          NUQCP = NUQCP + 1
          IF (.NOT.(BUF(NUQCP) .NE. 34)) GOTO 3450
            RETURN
3450      CONTINUE
3430    CONTINUE
3410    NUQCP = NUQCP + 1
      GOTO 3400
3420  CONTINUE
      RETURN
      END
