![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to TOKLAB.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 TOKLAB.f CVS log | Up to [Research Unix] / researchv10no / cmd / pfort |
1.1 root 1: LOGICAL FUNCTION TOKLAB(K1, K2, KK, DEF)
2: INTEGER STMT, PSTMT, SYMHD, DSA, PDSA, BNEXT, DOPT, DOLIST
3: LOGICAL DEF, NON0, SYSERR, ABORT, ERR
4: COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
5: COMMON /TABL/ NEXT, LABHD, SYMHD, BNEXT
6: COMMON /CTABL/ LDSA, PDSA, DSA(5000)
7: COMMON /DETECT/ ERR, SYSERR, ABORT
8: COMMON /DOS/ DOPT, LDO, DOLIST(192)
9: COMMON /FACTS/ NAME, NOST, ITYPE, IASF
10: C
11: C LOOKS FOR DEFNS OF LABEL IF DEF = .TRUE., ELSE LOOKS FOR
12: C REFS. IF IT FINDS A LABEL TOKLAB=.TRUE.
13: C IN REFERENCE LABEL IS IN STMT(PSTMT)-STMT(K2-1)
14: C IN DEFN LABEL IS IN STMT(1)-STMT(K2-1)
15: C KK IS SYMBOL TABLE INDEX OF LABEL
16: C K1 IS TYPE OF LABEL EXPECTED OR DEFINED--1-EXECUTABLE
17: C 2-NONEXECUTABLE, 3-FORMAT
18: C IN REF, ROUTINE SETS USAGE OF SYMBOL AND CHECKS FOR
19: C COMPATIBLE REFERENCES(I.E. GOTO 5 AND WRITE(6,5) ARE INCOMPAT.)
20: C IN DEF, ROUTINE SETS USAGE OF SYMBOL, CHECKS FOR DUPLICATE
21: C DEFNS, CHECKS FOR COMPATIBLITY BETWEEN DEFN AND PREVIOUS
22: C REFS, CREATES SCOPE AREA FOR LABEL INITIALIZING WORD1 TO
23: C CURRENT HEADING STMT NO ON DOLIST AND WORD2 TO CURRENT LEVEL
24: C IN REFS AND DEFS LABELS MUST BE POSITIVE NUMBERS
25: C
26: TOKLAB = .FALSE.
27: IF (DEF) GO TO 80
28: NON0 = .FALSE.
29: J = PSTMT + 4
30: IF (J.GT.NSTMT) J = NSTMT
31: K3 = PSTMT
32: DO 10 K2 = PSTMT,J
33: IF(STMT(K2).GT.9 .OR. STMT(K2).LT.0) GOTO 60
34: IF(STMT(K2) .GT. 0) NON0 = .TRUE.
35: IF(.NOT.NON0) K3 = K3+1
36: 10 CONTINUE
37: K2 = J+1
38: IF(.NOT.NON0) GOTO 70
39: C NOTE CAN CHANGE PSTMT HERE BECAUSE WE KNOW WE HAVE A LAB
40: 20 PSTMT = K3
41: KK = LOOKUP(K2,.TRUE.)
42: IF (SYSERR) GO TO 50
43: IF (ITYPE.EQ.14) DSA(BNEXT+1) = -DSA(BNEXT+1)
44: I = IGATT1(KK,8)
45: IF (I.EQ.0) CALL SATT1(KK, 8, 9)
46: I1 = IGATT1(KK,1)
47: IF (I1.NE.0) GO TO 30
48: CALL SATT1(KK, 1, K1)
49: GO TO 40
50: 30 IF (K1.NE.I1) CALL ERROR1(30H INCOMPATIBLE LABEL REFERENCES, 30)
51: 40 TOKLAB = .TRUE.
52: 50 RETURN
53: 60 IF (K2.EQ.PSTMT) GO TO 50
54: IF (NON0) GO TO 20
55: 70 CALL ERROR1(30H LABEL MUST BE POSITIVE NUMBER, 30)
56: GO TO 50
57: C
58: C TAKES DEF OF LABEL; CHECKS FOR DUPLICATE DEFS.; SETS DEFINED
59: C BIT IN SYMBOL TABLE; STORES BEGINNING BINDING STMT NO
60: C
61: 80 K2 = 0
62: NON0 = .FALSE.
63: DO 90 I=1,5
64: IF (STMT(I).EQ.69) GO TO 90
65: IF ((STMT(I).GT.9) .OR. (STMT(I).LT.0)) GO TO 140
66: IF (STMT(I).GT.0) NON0 = .TRUE.
67: IF (.NOT.NON0) GO TO 90
68: K2 = K2 + 1
69: STMT(K2) = STMT(I)
70: 90 CONTINUE
71: IF (K2.EQ.0) GO TO 50
72: IF (.NOT.NON0) GO TO 70
73: K2 = K2 + 1
74: KK = LOOKUP(K2,.TRUE.)
75: IF (SYSERR) GO TO 50
76: I = IGATT1(KK,2)
77: IF (I.EQ.1) GO TO 120
78: CALL SATT1(KK, 2, 1)
79: CALL SATT1(KK, 8, 9)
80: I1 = IGATT1(KK,1)
81: IF (I1.EQ.0) GO TO 100
82: IF (I1.EQ.K1) GO TO 110
83: CALL ERROR1(44H ILLEGAL REFERENCE TO LABEL IN PREVIOUS CODE, 44)
84: 100 CALL SATT1(KK, 1, K1)
85: 110 IF (K1.NE.1) GO TO 40
86: IF (NEXT+2.GE.BNEXT) GO TO 130
87: DSA(KK+2) = NEXT
88: DSA(NEXT) = DOLIST(DOPT)
89: DSA(NEXT+1) = -DOPT/6
90: NEXT = NEXT + 2
91: GO TO 40
92: 120 CALL ERROR1(16H DUPLICATE LABEL, 16)
93: GO TO 50
94: 130 CALL ERROR1(33H IN TOKLAB, TABLE OVERFLOW OF DSA, 33)
95: SYSERR = .TRUE.
96: GO TO 50
97: 140 CALL ERROR1(24H ILLEGAL SYMBOL IN LABEL, 24)
98: GO TO 50
99: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.