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
