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

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.