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