Return to GOTO.f CVS log

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

researchv10 Norman

      SUBROUTINE GOTO
      INTEGER STMT, PSTMT
      LOGICAL TOKLAB, DONE, ERR, SYSERR, ABORT
      COMMON /DETECT/ ERR, SYSERR, ABORT
      COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
C
C     PROCESSES UNCONDITIONAL, ASSIGNED, AND COMPUTED GOTO  STMTS
C
      IF (PSTMT.GE.NSTMT) GO TO 100
      DONE = .FALSE.
C
C     UNCONDITIONAL GOTO
C
      IF (TOKLAB(1,K2,K,.FALSE.)) GO TO 110
C
C     COMPUTED GOTO
C
      IF (SYSERR) GO TO 110
      IF (STMT(PSTMT).EQ.65) GO TO 70
C
C     ASSIGNED GOTO:  GOTO <VAR> , ( <LAB> , ETC. )
C
   10 CALL NEXTOK(PSTMT, K2, K)
      IF (K.NE.0) GO TO 100
      K = LOOKUP(K2,.FALSE.)
      IF (SYSERR) GO TO 110
      I1 = IGATT1(K,1)
      IF (I1.NE.0) GO TO 20
      I1 = 1
      IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) I1 = 2
      CALL SATT1(K, 1, I1)
   20 I2 = IGATT1(K,7)
      IF (MOD(I1,8).NE.2 .OR. I2.NE.0) CALL ERROR1(
     *    31H NOT AN INTEGER SCALAR VARIABLE, 31)
      I1 = IGATT1(K,8)
      IF (DONE) GO TO 40
C
C     CHECK FOR ASSIGN VARIABLE IN USAGE
C
      IF (I1.EQ.0) GO TO 30
      IF (I1.NE.8) CALL ERROR1(26H ID NOT AN ASSIGN VARIABLE, 26)
      GO TO 60
   30 CALL SATT1(K, 8, 8)
      GO TO 60
C
C     CHECK FOR VARIABLE IN USAGE
C
   40 IF (I1.EQ.0) GO TO 50
      IF (I1.NE.10) CALL ERROR1(19H ILLEGAL ID IN GOTO, 19)
      GO TO 130
   50 CALL SATT1(K, 8, 10)
      GO TO 130
C
C     LOOK FOR ","
C
   60 IF (STMT(K2).NE.68) GO TO 100
      K2 = K2 + 1
      DONE = .TRUE.
      IF (STMT(K2).NE.65) GO TO 100
      GO TO 80
   70 PSTMT = PSTMT + 1
      GO TO 90
   80 PSTMT = K2 + 1
C
C     LOOK FOR  ( <LAB> , ETC.)
C
   90 IF (PSTMT.GE.NSTMT) GO TO 100
      IF (.NOT.TOKLAB(1,K2,K,.FALSE.)) GO TO 100
      IF(SYSERR) GOTO 110
      IF (STMT(K2).EQ.68) GO TO 80
      IF (STMT(K2).NE.62) GO TO 100
      IF (DONE) GO TO 120
      DONE = .TRUE.
      IF (STMT(K2+1).NE.68) GO TO 100
      PSTMT = K2 + 2
      IF (PSTMT.LT.NSTMT) GO TO 10
  100 CALL ERROR1(15H ILLEGAL SYNTAX, 15)
  110 RETURN
C
C     CHECK END OF STMT IS REACHED
C
  120 K2 = K2 + 1
  130 IF (K2.NE.NSTMT) CALL ERROR1(
     *    34H EXTRANEOUS INFO AFTER END OF STMT, 34)
      GO TO 110
      END

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