Return to GOTO.f CVS log

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

Annotation of researchv10no/cmd/pfort/GOTO.f, revision 1.1.1.1

1.1       root        1:       SUBROUTINE GOTO
                      2:       INTEGER STMT, PSTMT
                      3:       LOGICAL TOKLAB, DONE, ERR, SYSERR, ABORT
                      4:       COMMON /DETECT/ ERR, SYSERR, ABORT
                      5:       COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
                      6: C
                      7: C     PROCESSES UNCONDITIONAL, ASSIGNED, AND COMPUTED GOTO  STMTS
                      8: C
                      9:       IF (PSTMT.GE.NSTMT) GO TO 100
                     10:       DONE = .FALSE.
                     11: C
                     12: C     UNCONDITIONAL GOTO
                     13: C
                     14:       IF (TOKLAB(1,K2,K,.FALSE.)) GO TO 110
                     15: C
                     16: C     COMPUTED GOTO
                     17: C
                     18:       IF (SYSERR) GO TO 110
                     19:       IF (STMT(PSTMT).EQ.65) GO TO 70
                     20: C
                     21: C     ASSIGNED GOTO:  GOTO <VAR> , ( <LAB> , ETC. )
                     22: C
                     23:    10 CALL NEXTOK(PSTMT, K2, K)
                     24:       IF (K.NE.0) GO TO 100
                     25:       K = LOOKUP(K2,.FALSE.)
                     26:       IF (SYSERR) GO TO 110
                     27:       I1 = IGATT1(K,1)
                     28:       IF (I1.NE.0) GO TO 20
                     29:       I1 = 1
                     30:       IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) I1 = 2
                     31:       CALL SATT1(K, 1, I1)
                     32:    20 I2 = IGATT1(K,7)
                     33:       IF (MOD(I1,8).NE.2 .OR. I2.NE.0) CALL ERROR1(
                     34:      *    31H NOT AN INTEGER SCALAR VARIABLE, 31)
                     35:       I1 = IGATT1(K,8)
                     36:       IF (DONE) GO TO 40
                     37: C
                     38: C     CHECK FOR ASSIGN VARIABLE IN USAGE
                     39: C
                     40:       IF (I1.EQ.0) GO TO 30
                     41:       IF (I1.NE.8) CALL ERROR1(26H ID NOT AN ASSIGN VARIABLE, 26)
                     42:       GO TO 60
                     43:    30 CALL SATT1(K, 8, 8)
                     44:       GO TO 60
                     45: C
                     46: C     CHECK FOR VARIABLE IN USAGE
                     47: C
                     48:    40 IF (I1.EQ.0) GO TO 50
                     49:       IF (I1.NE.10) CALL ERROR1(19H ILLEGAL ID IN GOTO, 19)
                     50:       GO TO 130
                     51:    50 CALL SATT1(K, 8, 10)
                     52:       GO TO 130
                     53: C
                     54: C     LOOK FOR ","
                     55: C
                     56:    60 IF (STMT(K2).NE.68) GO TO 100
                     57:       K2 = K2 + 1
                     58:       DONE = .TRUE.
                     59:       IF (STMT(K2).NE.65) GO TO 100
                     60:       GO TO 80
                     61:    70 PSTMT = PSTMT + 1
                     62:       GO TO 90
                     63:    80 PSTMT = K2 + 1
                     64: C
                     65: C     LOOK FOR  ( <LAB> , ETC.)
                     66: C
                     67:    90 IF (PSTMT.GE.NSTMT) GO TO 100
                     68:       IF (.NOT.TOKLAB(1,K2,K,.FALSE.)) GO TO 100
                     69:       IF(SYSERR) GOTO 110
                     70:       IF (STMT(K2).EQ.68) GO TO 80
                     71:       IF (STMT(K2).NE.62) GO TO 100
                     72:       IF (DONE) GO TO 120
                     73:       DONE = .TRUE.
                     74:       IF (STMT(K2+1).NE.68) GO TO 100
                     75:       PSTMT = K2 + 2
                     76:       IF (PSTMT.LT.NSTMT) GO TO 10
                     77:   100 CALL ERROR1(15H ILLEGAL SYNTAX, 15)
                     78:   110 RETURN
                     79: C
                     80: C     CHECK END OF STMT IS REACHED
                     81: C
                     82:   120 K2 = K2 + 1
                     83:   130 IF (K2.NE.NSTMT) CALL ERROR1(
                     84:      *    34H EXTRANEOUS INFO AFTER END OF STMT, 34)
                     85:       GO TO 110
                     86:       END

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