![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to SUBS.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / pfort|
Return to SUBS.f CVS log | Up to [Research Unix] / researchv10no / cmd / pfort |
1.1 root 1: SUBROUTINE SUBS(K2, NO)
2: INTEGER STMT, PSTMT
3: LOGICAL ERR, SYSERR, ABORT, TOKPNO
4: COMMON /DETECT/ ERR, SYSERR, ABORT
5: COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
6: C
7: C STMT(PSTMT)-STMT(K2-1) CONTAIN SUBSCRIPT CONSTRUCT
8: C NO IS NUMBER OF SUBSCRIPTS EXPECTED
9: C ROUTINE CHECKS SYNTAX AND NUMBER OF SUBSCRIPTS
10: C IF FLUSH OF CONSTRUCT IS NECESSARY, AND NSTMT IS REACHED
11: C ERR=.TRUE.
12: C
13: ICNT = 0
14: 10 CALL NEXTOK(PSTMT, K2, K)
15: IF (K.EQ.0) GO TO 70
16: IF (TOKPNO(PSTMT,K2,LL)) GO TO 60
17: 20 CALL ERROR1(28H ILLEGAL SYNTAX OF SUBSCRIPT, 28)
18: C
19: C FLUSH TO END OF SUBSCRIPT CONSTRUCTION
20: C
21: 30 IF (STMT(K2).EQ.62) GO TO 40
22: K2 = K2 + 1
23: IF (K2.LT.NSTMT) GO TO 30
24: ERR = .TRUE.
25: GO TO 50
26: 40 K2 = K2 + 1
27: 50 RETURN
28: 60 IF (STMT(K2).NE.66) GO TO 130
29: PSTMT = K2 + 1
30: IF (PSTMT.GE.NSTMT) GO TO 20
31: CALL NEXTOK(PSTMT, K2, K)
32: IF (K.NE.0) GO TO 20
33: C
34: C ACESS SYMBOL TABLE ENTRY FOR VARIABLE TO DETERMINE
35: C USAGE AND TYPE
36: C
37: 70 KQ = LOOKUP(K2,.FALSE.)
38: IF (SYSERR) GO TO 30
39: I1 = IGATT1(KQ,1)
40: I1 = MOD(I1,8)
41: I2 = IGATT1(KQ,7)
42: I3 = IGATT1(KQ,8)
43: IF (I3.EQ.0) GO TO 90
44: IF (I3.EQ.10) GO TO 100
45: 80 CALL ERROR1(43H ILLEGAL VARIABLE IN SUBSCRIPT CONSTRUCTION, 43)
46: GO TO 120
47: 90 CALL SATT1(KQ, 8, 10)
48: C
49: C IMPLICITLY TYPE VARIABLES FIRST ENCOUNTERED IN SUBSCRIPT
50: C CONSTRUCT
51: C
52: 100 IF (I1.GT.0) GO TO 110
53: I1 = 1
54: IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) I1 = 2
55: CALL SATT1(KQ, 1, I1)
56: 110 IF (I2.NE.0 .OR. I1.NE.2) GO TO 80
57: 120 IF (STMT(K2).NE.60 .AND. STMT(K2).NE.61) GO TO 130
58: CALL NEXTOK(K2+1, K3, K)
59: IF (K.NE.1) GO TO 20
60: K2 = K3
61: 130 ICNT = ICNT + 1
62: IF (STMT(K2).EQ.68) GO TO 140
63: IF (STMT(K2).NE.62) GO TO 20
64: IF (NO.NE.ICNT) CALL ERROR1(34H INCOMPATIBLE NUMBER OF SUBSCRIPTS,
65: * 34)
66: IF (ICNT.GT.3) CALL ERROR1(20H TOO MANY SUBSCRIPTS, 20)
67: GO TO 40
68: 140 PSTMT = K2 + 1
69: IF (PSTMT.GE.NSTMT) GO TO 20
70: GO TO 10
71: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.