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     ! 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.