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