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