|
|
1.1 root 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:
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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.