C max card size
C maximum field for integer strings
C must be 2 more than MAXCARD
C must be highest lu for standard files
C
C
C
C    RATFIV structured Fortran compiler
C    ==================================
C
C         Authors: Original by B. Kernighan and P. J. Plauger,
C                  with rewrites and enhancements by David Hanson and
C                  friends (U. of Arizona), Joe Sventek and Debbie
C                  Scherrer (Lawrence Berkely Laboratory), and
C                  William Wood (Institute For Cancer Research).
C
C         Address: William Wood
C                  Computer Center
C                  Institute For Cancer Research
C                  7701 Burholme Ave.
C                  Philadelphia, Pa. 19111
C                  (215) 728 2760
C
C         Version: 1.0
C
C         Date:   May 14, 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      *      THIS SOFTWARE WAS DESIGNED FOR USE ON A        *
C      *      PDP-11/70 OPERATING UNDER IAS V3.0 USING       *
C      *      THE FORTRAN-IV PLUS COMPILER.                  *
C      *                                                     *
C      *******************************************************
C
C========== miscellaneous support for all programs ==========
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. '0' .OR. STR(I) .GT. '9')) 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 MINUS
C   string digits "0123456789"
      BYTE DIGITS(11)
      DATA MINUS/'-'/
      DATA DIGITS(1)/'0'/
      DATA DIGITS(2)/'1'/
      DATA DIGITS(3)/'2'/
      DATA DIGITS(4)/'3'/
      DATA DIGITS(5)/'4'/
      DATA DIGITS(6)/'5'/
      DATA DIGITS(7)/'6'/
      DATA DIGITS(8)/'7'/
      DATA DIGITS(9)/'8'/
      DATA DIGITS(10)/'9'/
      DATA DIGITS(11)/0/
2070  IF (.NOT.(IN(I) .EQ. ' ' .OR. IN(I) .EQ. 9)) GOTO 2080
        I = I + 1
        GOTO 2070
2080  CONTINUE
      IF (.NOT.(IN(I) .EQ. MINUS)) 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. ' ' .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. ' ' .AND. IN(I) .NE. 9 .AN
     *D. IN(I) .NE. 13)) 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)
C   string digits "0123456789"
      BYTE DIGITS(11)
      DATA DIGITS(1)/'0'/
      DATA DIGITS(2)/'1'/
      DATA DIGITS(3)/'2'/
      DATA DIGITS(4)/'3'/
      DATA DIGITS(5)/'4'/
      DATA DIGITS(6)/'5'/
      DATA DIGITS(7)/'6'/
      DATA DIGITS(8)/'7'/
      DATA DIGITS(9)/'8'/
      DATA DIGITS(10)/'9'/
      DATA 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
2370  CONTINUE
      IF (.NOT.(INT .LT. 0 .AND. I .LT. SIZE)) GOTO 2380
C then sign
        I = I + 1
        STR(I) = '-'
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(10)
      J = ITOC(INT, TBUF, 10)
      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) = ' '
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)
C<wpw>      integer->character
      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(10)
      INTEGER ITOC
      N = ITOC(INT, CHARS, 10)
      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(10)
      INTEGER ITOC
      INTEGER I, N, ND, W
      ND = ITOC(N, CHARS, 10)
      I = ND + 1
2550  IF (.NOT.(I .LE. W)) GOTO 2570
        CALL PUTC(' ')
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( - 128:127)
C A-Z and a-z are alphabetic;
C 0-9 are digits;
      DATA CTYPE/128*0, 48*0, 10*2, 7*0, 26*1, 6*0, 26*1, 5*0/
      TYPE = CTYPE(C)
      IF (.NOT.(TYPE .EQ. 0)) GOTO 2640
        TYPE = C
C$   if( c >= '0' & c <= '9' )
C$      type = DIGIT
C$   else if( c >= 'a' & c <= 'z' )
C$      type = LETTER
C$   else if( c >= 'A' & c <= 'Z' )
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. 'A' .AND. TOKEN(I) .LE. 'Z')) GOTO 2690
          TOKEN(I) = TOKEN(I) - 'A' + 'a'
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. 'A' .AND. C .LE. 'Z')) GOTO 2710
        CLOWER = C - 'A' + 'a'
        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. 'a' .AND. C .LE. 'z')) GOTO 2730
        CUPPER = C - 'a' + 'A'
        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. 'A' .AND. TOKEN(I) .LE. 'Z')) GOTO 2780
          TOKEN(I) = TOKEN(I) - 'A' + 'a'
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. 'a' .AND. TOKEN(I) .LE. 'z')) GOTO 2830
          TOKEN(I) = TOKEN(I) - 'a' + 'A'
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 2950
2940     CONTINUE
          IF (.NOT.(CMDSTR(I) .EQ. 0)) GOTO 2960
C if code neg., must match exactly
            RESULT =  - CODE
2960      CONTINUE
2950    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
3050    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)
      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 |*a not special at end 
          ESC = 64
          GOTO 3260
3250     CONTINUE
          I = I + 1
          IF (.NOT.(ARRAY(I) .EQ. 110 .OR. ARRAY(I) .EQ. 78)) GOTO 3270
            ESC = 13
            GOTO 3280
3270       CONTINUE
            IF (.NOT.(ARRAY(I) .EQ. 116 .OR. ARRAY(I) .EQ. 84)) GOTO 329
     *0
              ESC = 9
              GOTO 3300
3290         CONTINUE
              IF (.NOT.(ARRAY(I) .EQ. 98 .OR. ARRAY(I) .EQ. 66)) GOTO 33
     *10
                ESC = 32
                GOTO 3320
3310           CONTINUE
                ESC = ARRAY(I)
3320          CONTINUE
3300        CONTINUE
3280      CONTINUE
3260    CONTINUE
3240  CONTINUE
      RETURN
      END
