Return to GETTOK.f CVS log

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

researchv10 Norman

      INTEGER FUNCTION GETTOK(K1, K2)
C
C     GETTOK FINDS NEXT TOKEN IN STMT(K1)-STMT(K2-1)
C     AND RETURNS A VALUE:
C     0= DOUBLE PRECISION CONSTANT-
C     2= INTEGER CONSTANT
C     1= REAL CONSTANT-
C     3= COMPLEX CONSTANT
C     4= LOGICAL CONSTANT
C     5= HOLLERITH CONSTANT
C     6= ID
C    >10=OPERATOR   (10+CODE FOR OPERATOR;HERE ARRAY AND FCN REFS ARE 16
C
      INTEGER PSTMT, STMT
      LOGICAL ERR, SYSERR, ABORT, TOKLOP, TOKRL, TOKCOM, TOKLOG
      COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
      COMMON /DETECT/ ERR, SYSERR, ABORT
   10 GETTOK = -1
      IF (.NOT.TOKRL(K1,K2,K)) GO TO 20
      GETTOK = 1
      IF (K.EQ.0) GETTOK = 0
      GO TO 40
   20 CALL NEXTOK(K1, K2, K)
      K = K + 1
      GO TO (50, 30, 60, 70), K
   30 GETTOK = 2
   40 RETURN
C
C     PROCESS ID, SEE IF ITS A FCN  CALL OR ARRAY NAME
C
   50 GETTOK = 6
      IF (STMT(K2).NE.65) GO TO 40
      GETTOK = 16
      K2 = K2 + 1
      GO TO 40
   60 GETTOK = 5
      GO TO 40
   70 K = STMT(K1)
      IF (K.EQ.64) GO TO 100
      IF (K.EQ.65) GO TO 80
      IF (K.EQ.62) GETTOK = 12
      IF (K.EQ.68) GETTOK = 18
      IF (K.EQ.60 .OR. K.EQ.61) GETTOK = 11
      IF (K.EQ.66 .OR. K.EQ.67) GETTOK = 17
      IF (K2.EQ.K1+2) GETTOK = 13
      IF (GETTOK+1) 40, 120, 40
   80 GETTOK = 15
      IF (TOKCOM(K1,K)) GO TO 90
      GO TO 40
   90 GETTOK = 3
      K2 = K
      GO TO 40
C
C     CHECK FOR LOGICAL CONSTANTS,OPERATORS
C
  100 IF (.NOT.TOKLOG(K1,K2)) GO TO 110
      GETTOK = 4
      GO TO 40
  110 IF (.NOT.TOKLOP(K1,K2,K)) GO TO 120
      GETTOK = K
      GO TO 40
  120 CALL ERROR1(26H ILLEGAL CHARACTER IGNORED, 26)
      IF (K1+1.GE.NSTMT) GO TO 130
      K1 = K1 + 1
      GO TO 10
  130 ERR = .TRUE.
      RETURN
      END

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