Return to LIST.f CVS log

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

Annotation of researchv10no/cmd/pfort/LIST.f, revision 1.1.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.