|
|
1.1 root 1: LOGICAL FUNCTION IDLIST(IDO)
2: INTEGER PSTMT, STMT
3: LOGICAL ERR, SYSERR, ABORT, IDO
4: COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
5: COMMON /DETECT/ ERR, SYSERR, ABORT
6: C
7: C RECOGNIZES IDLIST=<ID> �, <ID>! ;LAST <ID> CANNOT BE FOLLOWED BY
8: C A '='; IDLIST MUST CONTAIN AT LEAST ONE ID. IDLIST=.FALSE. WILL
9: C BE RETURNED FOR AN IRRECOVERABLE SYNTAX ERROR.
10: C IDO SET TO .TRUE. WHEN <IDLIST> IS FOLLOWED BY <DOSPEC>
11: C
12: IDO = .FALSE.
13: IDLIST = .TRUE.
14: IF (PSTMT.GE.NSTMT) GO TO 60
15: CALL NEXTOK(PSTMT, K2, K)
16: IF (K.NE.0) GO TO 60
17: IF (STMT(K2).EQ.63) GO TO 20
18: CALL ID(K2)
19: IF (ERR .OR. SYSERR) GO TO 20
20: 10 PSTMT = K2
21: IF (STMT(PSTMT).EQ.68 .AND. STMT(PSTMT+1).EQ.65 .OR.
22: * STMT(PSTMT).EQ.62 .OR. PSTMT.EQ.NSTMT) GO TO 30
23: IF (STMT(PSTMT).EQ.68) GO TO 50
24: CALL ERROR1(35H ILLEGAL TOKEN FOLLOWING IDENTIFIER, 35)
25: 20 IDLIST = .FALSE.
26: ERR = .FALSE.
27: 30 RETURN
28: 40 IDO = .TRUE.
29: GO TO 30
30: C
31: C MAKE SURE <ID> = ISN'T NEXT CONSTRUCT
32: C
33: 50 K2 = K2 + 1
34: IF (K2.GE.NSTMT) GO TO 60
35: CALL NEXTOK(K2, K3, K)
36: IF (STMT(K3).EQ.63) GO TO 40
37: PSTMT = K2
38: K2 = K3
39: CALL ID(K2)
40: IF (ERR .OR. SYSERR) GO TO 20
41: GO TO 10
42: 60 CALL ERROR1(23H ILLEGAL SYNTAX IN LIST, 23)
43: GO TO 20
44: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.