1 /*
2 * Copyright (c) 1983 The Regents of the University of California.
3 * All rights reserved.
4 *
5 * %sccs.include.redist.c%
6 */
7
8 #ifndef lint
9 static char sccsid[] = "@(#)check.c 5.4 (Berkeley) 06/01/90";
10 #endif /* not lint */
11
12 /*
13 * Check a tree for semantic correctness.
14 */
15
16 #include "defs.h"
17 #include "tree.h"
18 #include "operators.h"
19 #include "events.h"
20 #include "symbols.h"
21 #include "scanner.h"
22 #include "source.h"
23 #include "object.h"
24 #include "mappings.h"
25 #include "process.h"
26 #include <signal.h>
27
28 #ifndef public
29 #endif
30
31 /*
32 * Check that the nodes in a tree have the correct arguments
33 * in order to be evaluated. Basically the error checking here
34 * frees the evaluation routines from worrying about anything
35 * except dynamic errors, e.g. subscript out of range.
36 */
37
check(p)38 public check(p)
39 register Node p;
40 {
41 Node p1, p2;
42 Address addr;
43 Symbol f;
44
45 checkref(p);
46 switch (p->op) {
47 case O_ASSIGN:
48 p1 = p->value.arg[0];
49 p2 = p->value.arg[1];
50 if (varIsSet("$unsafeassign")) {
51 if (size(p1->nodetype) != size(p2->nodetype)) {
52 error("incompatible sizes");
53 }
54 } else if (not compatible(p1->nodetype, p2->nodetype)) {
55 error("incompatible types");
56 }
57 break;
58
59 case O_CATCH:
60 case O_IGNORE:
61 if (p->value.lcon < 0 or p->value.lcon > NSIG) {
62 error("invalid signal number");
63 }
64 break;
65
66 case O_CONT:
67 if (p->value.lcon != DEFSIG and (
68 p->value.lcon < 0 or p->value.lcon > NSIG)
69 ) {
70 error("invalid signal number");
71 }
72 break;
73
74 case O_DUMP:
75 if (p->value.arg[0] != nil) {
76 if (p->value.arg[0]->op == O_SYM) {
77 f = p->value.arg[0]->value.sym;
78 if (not isblock(f)) {
79 error("\"%s\" is not a block", symname(f));
80 }
81 } else {
82 beginerrmsg();
83 fprintf(stderr, "expected a symbol, found \"");
84 prtree(stderr, p->value.arg[0]);
85 fprintf(stderr, "\"");
86 enderrmsg();
87 }
88 }
89 break;
90
91 case O_LIST:
92 if (p->value.arg[0]->op == O_SYM) {
93 f = p->value.arg[0]->value.sym;
94 if (not isblock(f) or ismodule(f)) {
95 error("\"%s\" is not a procedure or function", symname(f));
96 }
97 addr = firstline(f);
98 if (addr == NOADDR) {
99 error("\"%s\" is empty", symname(f));
100 }
101 }
102 break;
103
104 case O_TRACE:
105 case O_TRACEI:
106 chktrace(p);
107 break;
108
109 case O_STOP:
110 case O_STOPI:
111 chkstop(p);
112 break;
113
114 case O_CALLPROC:
115 case O_CALL:
116 if (not isroutine(p->value.arg[0]->nodetype)) {
117 beginerrmsg();
118 fprintf(stderr, "\"");
119 prtree(stderr, p->value.arg[0]);
120 fprintf(stderr, "\" not call-able");
121 enderrmsg();
122 }
123 break;
124
125 case O_WHEREIS:
126 if (p->value.arg[0]->op == O_SYM and
127 p->value.arg[0]->value.sym == nil) {
128 error("symbol not defined");
129 }
130 break;
131
132 default:
133 break;
134 }
135 }
136
137 /*
138 * Check arguments to a trace command.
139 */
140
chktrace(p)141 private chktrace(p)
142 Node p;
143 {
144 Node exp, place, cond;
145
146 exp = p->value.arg[0];
147 place = p->value.arg[1];
148 cond = p->value.arg[2];
149 if (exp == nil) {
150 chkblock(place);
151 } else if (exp->op == O_LCON or exp->op == O_QLINE) {
152 if (place != nil) {
153 error("unexpected \"at\" or \"in\"");
154 }
155 if (p->op == O_TRACE) {
156 chkline(exp);
157 } else {
158 chkaddr(exp);
159 }
160 } else if (place != nil and (place->op == O_QLINE or place->op == O_LCON)) {
161 if (p->op == O_TRACE) {
162 chkline(place);
163 } else {
164 chkaddr(place);
165 }
166 } else {
167 if (exp->op != O_RVAL and exp->op != O_SYM and exp->op != O_CALL) {
168 error("can't trace expressions");
169 }
170 chkblock(place);
171 }
172 }
173
174 /*
175 * Check arguments to a stop command.
176 */
177
chkstop(p)178 private chkstop(p)
179 Node p;
180 {
181 Node exp, place, cond;
182
183 exp = p->value.arg[0];
184 place = p->value.arg[1];
185 cond = p->value.arg[2];
186 if (exp != nil) {
187 if (exp->op != O_RVAL and exp->op != O_SYM and exp->op != O_LCON) {
188 beginerrmsg();
189 fprintf(stderr, "expected variable, found ");
190 prtree(stderr, exp);
191 enderrmsg();
192 }
193 chkblock(place);
194 } else if (place != nil) {
195 if (place->op == O_SYM) {
196 chkblock(place);
197 } else {
198 if (p->op == O_STOP) {
199 chkline(place);
200 } else {
201 chkaddr(place);
202 }
203 }
204 }
205 }
206
207 /*
208 * Check to see that the given node specifies some subprogram.
209 * Nil is ok since that means the entire program.
210 */
211
chkblock(b)212 private chkblock(b)
213 Node b;
214 {
215 Symbol p, outer;
216
217 if (b != nil) {
218 if (b->op != O_SYM) {
219 beginerrmsg();
220 fprintf(stderr, "expected subprogram, found ");
221 prtree(stderr, b);
222 enderrmsg();
223 } else if (ismodule(b->value.sym)) {
224 outer = b->value.sym;
225 while (outer != nil) {
226 find(p, outer->name) where p->block == outer endfind(p);
227 if (p == nil) {
228 outer = nil;
229 error("\"%s\" is not a subprogram", symname(b->value.sym));
230 } else if (ismodule(p)) {
231 outer = p;
232 } else {
233 outer = nil;
234 b->value.sym = p;
235 }
236 }
237 } else if (
238 b->value.sym->class == VAR and
239 b->value.sym->name == b->value.sym->block->name and
240 b->value.sym->block->class == FUNC
241 ) {
242 b->value.sym = b->value.sym->block;
243 } else if (not isblock(b->value.sym)) {
244 error("\"%s\" is not a subprogram", symname(b->value.sym));
245 }
246 }
247 }
248
249 /*
250 * Check to make sure a node corresponds to a source line.
251 */
252
chkline(p)253 private chkline(p)
254 Node p;
255 {
256 if (p == nil) {
257 error("missing line");
258 } else if (p->op != O_QLINE and p->op != O_LCON) {
259 error("expected source line number, found \"%t\"", p);
260 }
261 }
262
263 /*
264 * Check to make sure a node corresponds to an address.
265 */
266
chkaddr(p)267 private chkaddr(p)
268 Node p;
269 {
270 if (p == nil) {
271 error("missing address");
272 } else if (p->op != O_LCON and p->op != O_QLINE) {
273 beginerrmsg();
274 fprintf(stderr, "expected address, found \"");
275 prtree(stderr, p);
276 fprintf(stderr, "\"");
277 enderrmsg();
278 }
279 }
280