Commit | Line | Data |
---|---|---|
5ab61658 BJ |
1 | /* Copyright (c) 1979 Regents of the University of California */ |
2 | # | |
3 | /* | |
4 | * pi - Pascal interpreter code translator | |
5 | * | |
6 | * Charles Haley, Bill Joy UCB | |
7 | * Version 1.1 February 1978 | |
8 | * | |
9 | * | |
10 | * pxp - Pascal execution profiler | |
11 | * | |
12 | * Bill Joy UCB | |
13 | * Version 1.1 February 1978 | |
14 | */ | |
15 | ||
16 | #include "0.h" | |
17 | #include "yy.h" | |
18 | ||
19 | #ifdef PI | |
20 | extern int *yypv; | |
21 | /* | |
22 | * Determine whether the identifier whose name | |
23 | * is "cp" can possibly be a kind, which is a | |
24 | * namelist class. We look through the symbol | |
25 | * table for the first instance of cp as a non-field, | |
26 | * and at all instances of cp as a field. | |
27 | * If any of these are ok, we return true, else false. | |
28 | * It would be much better to handle with's correctly, | |
29 | * even to just know whether we are in a with at all. | |
30 | * | |
31 | * Note that we don't disallow constants on the lhs of assignment. | |
32 | */ | |
33 | identis(cp, kind) | |
34 | register char *cp; | |
35 | int kind; | |
36 | { | |
37 | register struct nl *p; | |
38 | int i; | |
39 | ||
40 | /* | |
41 | * Cp is NIL when error recovery inserts it. | |
42 | */ | |
43 | if (cp == NIL) | |
44 | return (1); | |
45 | ||
46 | /* | |
47 | * Record kind we want for possible later use by yyrecover | |
48 | */ | |
49 | yyidwant = kind; | |
50 | yyidhave = NIL; | |
51 | i = ( (int) cp ) & 077; | |
52 | for (p = disptab[i]; p != NIL; p = p->nl_next) | |
53 | if (p->symbol == cp) { | |
54 | if (yyidok(p, kind)) | |
55 | goto gotit; | |
56 | if (p->class != FIELD && p->class != BADUSE) | |
57 | break; | |
58 | } | |
59 | if (p != NIL) | |
60 | for (p = p->nl_next; p != NIL; p = p->nl_next) | |
61 | if (p->symbol == cp && p->class == FIELD && yyidok(p, kind)) | |
62 | goto gotit; | |
63 | return (0); | |
64 | gotit: | |
65 | if (p->class == BADUSE && !Recovery) { | |
66 | yybadref(p, OY.Yyeline); | |
67 | yypv[0] = NIL; | |
68 | } | |
69 | return (1); | |
70 | } | |
71 | \f | |
72 | /* | |
73 | * A bad reference to the identifier cp on line | |
74 | * line and use implying the addition of kindmask | |
75 | * to the mask of kind information. | |
76 | */ | |
77 | yybaduse(cp, line, kindmask) | |
78 | register char *cp; | |
79 | int line, kindmask; | |
80 | { | |
81 | register struct nl *p, *oldp; | |
82 | int i; | |
83 | ||
84 | i = ( (int) cp ) & 077; | |
85 | for (p = disptab[i]; p != NIL; p = p->nl_next) | |
86 | if (p->symbol == cp) | |
87 | break; | |
88 | oldp = p; | |
89 | if (p == NIL || p->class != BADUSE) | |
90 | p = enter(defnl(cp, BADUSE, 0, 0)); | |
91 | p->value[NL_KINDS] =| kindmask; | |
92 | yybadref(p, line); | |
93 | return (oldp); | |
94 | } | |
95 | ||
96 | /* | |
97 | * ud is initialized so that esavestr will allocate | |
98 | * sizeof ( struct udinfo ) bytes for the 'real' struct udinfo | |
99 | */ | |
100 | struct udinfo ud = { ~0 , ~0 , 0}; | |
101 | /* | |
102 | * Record a reference to an undefined identifier, | |
103 | * or one which is improperly used. | |
104 | */ | |
105 | yybadref(p, line) | |
106 | register struct nl *p; | |
107 | int line; | |
108 | { | |
109 | register struct udinfo *udp; | |
110 | ||
111 | if (p->chain != NIL && p->chain->ud_line == line) | |
112 | return; | |
113 | udp = esavestr(&ud); | |
114 | udp->ud_line = line; | |
115 | udp->ud_next = p->chain; | |
116 | p->chain = udp; | |
117 | } | |
118 | ||
119 | #define varkinds ((1<<CONST)|(1<<VAR)|(1<<REF)|(1<<ARRAY)|(1<<PTR)|(1<<RECORD)|(1<<FIELD)|(1<<FUNC)|(1<<FVAR)) | |
120 | /* | |
121 | * Is the symbol in the p entry of the namelist | |
122 | * even possibly a kind kind? If not, update | |
123 | * what we have based on this encounter. | |
124 | */ | |
125 | yyidok(p, kind) | |
126 | register struct nl *p; | |
127 | int kind; | |
128 | { | |
129 | ||
130 | if (p->class == BADUSE) { | |
131 | if (kind == VAR) | |
132 | return (p->value[0] & varkinds); | |
133 | return (p->value[0] & (1 << kind)); | |
134 | } | |
135 | if (yyidok1(p, kind)) | |
136 | return (1); | |
137 | if (yyidhave != NIL) | |
138 | yyidhave = IMPROPER; | |
139 | else | |
140 | yyidhave = p->class; | |
141 | return (0); | |
142 | } | |
143 | ||
144 | yyidok1(p, kind) | |
145 | register struct nl *p; | |
146 | int kind; | |
147 | { | |
148 | int i; | |
149 | ||
150 | switch (kind) { | |
151 | case FUNC: | |
152 | if (p->class == FVAR) | |
153 | return(1); | |
154 | case CONST: | |
155 | case TYPE: | |
156 | case PROC: | |
157 | case FIELD: | |
158 | return (p->class == kind); | |
159 | case VAR: | |
160 | return (p->class == CONST || yyisvar(p, NIL)); | |
161 | case ARRAY: | |
162 | case RECORD: | |
163 | return (yyisvar(p, kind)); | |
164 | case PTRFILE: | |
165 | return (yyisvar(p, PTR) || yyisvar(p, FILET)); | |
166 | } | |
167 | } | |
168 | ||
169 | yyisvar(p, class) | |
170 | register struct nl *p; | |
171 | int class; | |
172 | { | |
173 | ||
174 | switch (p->class) { | |
175 | case FIELD: | |
176 | case VAR: | |
177 | case REF: | |
178 | case FVAR: | |
179 | /* | |
180 | * We would prefer to return | |
181 | * parameterless functions only. | |
182 | */ | |
183 | case FUNC: | |
184 | return (class == NIL || (p->type != NIL && p->type->class == class)); | |
185 | } | |
186 | return (0); | |
187 | } | |
188 | #endif | |
189 | #ifdef PXP | |
190 | #ifndef DEBUG | |
191 | identis() | |
192 | { | |
193 | ||
194 | return (1); | |
195 | } | |
196 | #endif | |
197 | #ifdef DEBUG | |
198 | extern char *classes[]; | |
199 | ||
200 | char kindchars[] "UCTVAQRDPF"; | |
201 | /* | |
202 | * Fake routine "identis" for pxp when testing error recovery. | |
203 | * Looks at letters in variable names to answer questions | |
204 | * about attributes. Mapping is | |
205 | * C const_id | |
206 | * T type_id | |
207 | * V var_id also if any of AQRDF | |
208 | * A array_id | |
209 | * Q ptr_id | |
210 | * R record_id | |
211 | * D field_id D for "dot" | |
212 | * P proc_id | |
213 | * F func_id | |
214 | */ | |
215 | identis(cp, kind) | |
216 | register char *cp; | |
217 | int kind; | |
218 | { | |
219 | register char *dp; | |
220 | char kindch; | |
221 | ||
222 | /* | |
223 | * Don't do anything unless -T | |
224 | */ | |
225 | if (!typetest) | |
226 | return (1); | |
227 | ||
228 | /* | |
229 | * Inserted symbols are always correct | |
230 | */ | |
231 | if (cp == NIL) | |
232 | return (1); | |
233 | /* | |
234 | * Set up the names for error messages | |
235 | */ | |
236 | yyidwant = classes[kind]; | |
237 | for (dp = kindchars; *dp; dp++) | |
238 | if (any(cp, *dp)) { | |
239 | yyidhave = classes[dp - kindchars]; | |
240 | break; | |
241 | } | |
242 | ||
243 | /* | |
244 | * U in the name means undefined | |
245 | */ | |
246 | if (any(cp, 'U')) | |
247 | return (0); | |
248 | ||
249 | kindch = kindchars[kind]; | |
250 | if (kindch == 'V') | |
251 | for (dp = "AQRDF"; *dp; dp++) | |
252 | if (any(cp, *dp)) | |
253 | return (1); | |
254 | return (any(cp, kindch)); | |
255 | } | |
256 | #endif | |
257 | #endif |