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