Return to GETTOK.f CVS log

Up to [Research Unix] / researchv10no / cmd / pfort

Annotation of researchv10no/cmd/pfort/GETTOK.f, revision 1.1

1.1     ! root        1:       INTEGER FUNCTION GETTOK(K1, K2)
        !             2: C
        !             3: C     GETTOK FINDS NEXT TOKEN IN STMT(K1)-STMT(K2-1)
        !             4: C     AND RETURNS A VALUE:
        !             5: C     0= DOUBLE PRECISION CONSTANT-
        !             6: C     2= INTEGER CONSTANT
        !             7: C     1= REAL CONSTANT-
        !             8: C     3= COMPLEX CONSTANT
        !             9: C     4= LOGICAL CONSTANT
        !            10: C     5= HOLLERITH CONSTANT
        !            11: C     6= ID
        !            12: C    >10=OPERATOR   (10+CODE FOR OPERATOR;HERE ARRAY AND FCN REFS ARE 16
        !            13: C
        !            14:       INTEGER PSTMT, STMT
        !            15:       LOGICAL ERR, SYSERR, ABORT, TOKLOP, TOKRL, TOKCOM, TOKLOG
        !            16:       COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
        !            17:       COMMON /DETECT/ ERR, SYSERR, ABORT
        !            18:    10 GETTOK = -1
        !            19:       IF (.NOT.TOKRL(K1,K2,K)) GO TO 20
        !            20:       GETTOK = 1
        !            21:       IF (K.EQ.0) GETTOK = 0
        !            22:       GO TO 40
        !            23:    20 CALL NEXTOK(K1, K2, K)
        !            24:       K = K + 1
        !            25:       GO TO (50, 30, 60, 70), K
        !            26:    30 GETTOK = 2
        !            27:    40 RETURN
        !            28: C
        !            29: C     PROCESS ID, SEE IF ITS A FCN  CALL OR ARRAY NAME
        !            30: C
        !            31:    50 GETTOK = 6
        !            32:       IF (STMT(K2).NE.65) GO TO 40
        !            33:       GETTOK = 16
        !            34:       K2 = K2 + 1
        !            35:       GO TO 40
        !            36:    60 GETTOK = 5
        !            37:       GO TO 40
        !            38:    70 K = STMT(K1)
        !            39:       IF (K.EQ.64) GO TO 100
        !            40:       IF (K.EQ.65) GO TO 80
        !            41:       IF (K.EQ.62) GETTOK = 12
        !            42:       IF (K.EQ.68) GETTOK = 18
        !            43:       IF (K.EQ.60 .OR. K.EQ.61) GETTOK = 11
        !            44:       IF (K.EQ.66 .OR. K.EQ.67) GETTOK = 17
        !            45:       IF (K2.EQ.K1+2) GETTOK = 13
        !            46:       IF (GETTOK+1) 40, 120, 40
        !            47:    80 GETTOK = 15
        !            48:       IF (TOKCOM(K1,K)) GO TO 90
        !            49:       GO TO 40
        !            50:    90 GETTOK = 3
        !            51:       K2 = K
        !            52:       GO TO 40
        !            53: C
        !            54: C     CHECK FOR LOGICAL CONSTANTS,OPERATORS
        !            55: C
        !            56:   100 IF (.NOT.TOKLOG(K1,K2)) GO TO 110
        !            57:       GETTOK = 4
        !            58:       GO TO 40
        !            59:   110 IF (.NOT.TOKLOP(K1,K2,K)) GO TO 120
        !            60:       GETTOK = K
        !            61:       GO TO 40
        !            62:   120 CALL ERROR1(26H ILLEGAL CHARACTER IGNORED, 26)
        !            63:       IF (K1+1.GE.NSTMT) GO TO 130
        !            64:       K1 = K1 + 1
        !            65:       GO TO 10
        !            66:   130 ERR = .TRUE.
        !            67:       RETURN
        !            68:       END

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.