Return to LIST.f CVS log

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

Annotation of researchv10dc/cmd/pfort/LIST.f, revision 1.1

1.1     ! root        1:       SUBROUTINE LIST
        !             2:       INTEGER STMT, PSTMT
        !             3:       LOGICAL ERR, SYSERR, ABORT, IDLIST, IDO, FINDO
        !             4:       LOGICAL SIO
        !             5:       COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
        !             6:       COMMON /DETECT/ ERR, SYSERR, ABORT
        !             7:       COMMON /LISTDO/ LPT, LEN, LS(64)
        !             8: C
        !             9: C     ROUTINE PROCESSES THE LIST CONSTRUCT, USED IN I-O STMTS
        !            10: C     LEV USED TO COUNT PARENTHESES LEVELS
        !            11: C
        !            12:       SIO = .FALSE.
        !            13:       LPT = LEN + 1
        !            14:       FINDO = .FALSE.
        !            15:       ICNT = 0
        !            16:       LEV = 0
        !            17:    10 IF (STMT(PSTMT).NE.65) GO TO 20
        !            18:       LEV = LEV + 1
        !            19:       IF (LEV.GT.ICNT) ICNT = ICNT + 1
        !            20:       PSTMT = PSTMT + 1
        !            21:       GO TO 10
        !            22:    20 IF (PSTMT.GE.NSTMT) GO TO 120
        !            23: C
        !            24: C     ALLOW <ID>=ARRAY,ARRAY ELE., VARIABLE
        !            25: C
        !            26:       IF (.NOT.IDLIST(IDO)) GO TO 130
        !            27: C
        !            28: C     FALSE RETURN SIGNIFIES ERROR IN IDLIST
        !            29: C     TRUE RETURN SIGNIFIES NO ERROR IN IDLIST
        !            30: C     IDO = .TRUE. MEANS , <DOSPEC> IS NEXT
        !            31: C     IDO = .FALSE. MEANS AT END-OF-STMT, ", (" , OR ")"
        !            32: C
        !            33: C      FOUND <DOSPEC> )
        !            34: C
        !            35:       IF (SYSERR) GO TO 130
        !            36:       IF (.NOT.IDO) GO TO 30
        !            37:       PSTMT = PSTMT + 1
        !            38:       GO TO 100
        !            39: C
        !            40: C      FOUND END OF SIMPLE LIST "( <IDLIST> )"
        !            41: C
        !            42:    30 IF (STMT(PSTMT).EQ.62) GO TO 60
        !            43:    40 IF (PSTMT.NE.NSTMT) GO TO 50
        !            44: C
        !            45: C     AT END OF STMT
        !            46: C
        !            47:       IF (FINDO) CALL LDOVAR
        !            48:       IF (LEV.NE.0) GO TO 120
        !            49:       GO TO 130
        !            50: C
        !            51: C      NEED "," AND NEW <LIST> CONSTRUCT
        !            52: C
        !            53:    50 IF (STMT(PSTMT).NE.68) GO TO 120
        !            54:       PSTMT = PSTMT + 1
        !            55:       GO TO 10
        !            56: C
        !            57: C     MUST CHECK FOR ILLEGALLY NESTED SIMPLE LISTS
        !            58: C     SIMPLE LIST= ( <IDLIST> )
        !            59: C     ICNT COUNTAINS LEVEL OF LAST SIMPLE LIST WITHIN A
        !            60: C      PARENTHESIZED EXPRESSION
        !            61: C
        !            62:    60 SIO = .TRUE.
        !            63:       IF (LEV.EQ.0) GO TO 120
        !            64:       PSTMT = PSTMT + 1
        !            65:       IF (ICNT.LE.LEV) GO TO 80
        !            66:    70 CALL ERROR1(28H ILLEGAL PARENTHESES NESTING, 28)
        !            67:       GO TO 130
        !            68:    80 LEV = LEV - 1
        !            69:       IF (LEV) 120, 110, 90
        !            70: C
        !            71: C     CHECK FOR CONSTRUCT FOLLOWING <DOSPEC>
        !            72: C
        !            73:    90 IF (STMT(PSTMT).EQ.62) GO TO 70
        !            74:       IF (STMT(PSTMT).NE.68) GO TO 120
        !            75:       CALL NEXTOK(PSTMT+1, K2, K)
        !            76:       IF (K.NE.0 .OR. STMT(K2).NE.63) GO TO 40
        !            77:       PSTMT = PSTMT + 1
        !            78: C
        !            79: C     LOOK FOR DOSPEC
        !            80: C
        !            81:   100 CALL DOSPEC(0, K2, .TRUE.)
        !            82:       IF (SYSERR .OR. ERR) GO TO 130
        !            83:       FINDO = .TRUE.
        !            84:       IF (STMT(K2).NE.62) GO TO 120
        !            85:       PSTMT = K2 + 1
        !            86:       IF (ICNT.GT.LEV) ICNT = ICNT - 1
        !            87:       GO TO 80
        !            88: C
        !            89: C     CHECK NESTED DOSPECS IN LIST
        !            90: C
        !            91:   110 IF (LEV.NE.0 .OR. .NOT.FINDO) GO TO 40
        !            92:       FINDO = .FALSE.
        !            93:       CALL LDOVAR
        !            94:       LPT = LEN + 1
        !            95:       GO TO 40
        !            96:   120 CALL ERROR1(20H ILLEGAL PUNCTUATION, 20)
        !            97:       IF (FINDO) CALL LDOVAR
        !            98:   130 IF (SIO) CALL ERROR1(34H REDUNDANT PARENTHESES ARE ILLEGAL, 34)
        !            99:       RETURN
        !           100:       END

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