Commit | Line | Data |
---|---|---|
2a24676e | 1 | /* |
8a90f3aa KB |
2 | * Copyright (c) 1983 The Regents of the University of California. |
3 | * All rights reserved. | |
4 | * | |
1c15e888 C |
5 | * Redistribution and use in source and binary forms are permitted |
6 | * provided that: (1) source distributions retain this entire copyright | |
7 | * notice and comment, and (2) distributions including binaries display | |
8 | * the following acknowledgement: ``This product includes software | |
9 | * developed by the University of California, Berkeley and its contributors'' | |
10 | * in the documentation or other materials provided with the distribution | |
11 | * and in all advertising materials mentioning features or use of this | |
12 | * software. Neither the name of the University nor the names of its | |
13 | * contributors may be used to endorse or promote products derived | |
14 | * from this software without specific prior written permission. | |
15 | * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR | |
16 | * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED | |
17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. | |
2a24676e | 18 | */ |
8a21415b | 19 | |
2a24676e | 20 | #ifndef lint |
1c15e888 | 21 | static char sccsid[] = "@(#)symbols.c 5.8 (Berkeley) 6/1/90"; |
8a90f3aa | 22 | #endif /* not lint */ |
8a21415b ML |
23 | |
24 | /* | |
25 | * Symbol management. | |
26 | */ | |
27 | ||
28 | #include "defs.h" | |
29 | #include "symbols.h" | |
30 | #include "languages.h" | |
31 | #include "printsym.h" | |
32 | #include "tree.h" | |
33 | #include "operators.h" | |
34 | #include "eval.h" | |
35 | #include "mappings.h" | |
36 | #include "events.h" | |
37 | #include "process.h" | |
38 | #include "runtime.h" | |
39 | #include "machine.h" | |
40 | #include "names.h" | |
41 | ||
42 | #ifndef public | |
43 | typedef struct Symbol *Symbol; | |
44 | ||
45 | #include "machine.h" | |
46 | #include "names.h" | |
47 | #include "languages.h" | |
0022c355 | 48 | #include "tree.h" |
8a21415b ML |
49 | |
50 | /* | |
51 | * Symbol classes | |
52 | */ | |
53 | ||
54 | typedef enum { | |
d244f11c DS |
55 | BADUSE, CONST, TYPE, VAR, ARRAY, OPENARRAY, DYNARRAY, SUBARRAY, |
56 | PTRFILE, RECORD, FIELD, | |
f128b014 | 57 | PROC, FUNC, FVAR, REF, PTR, FILET, SET, RANGE, |
8a21415b | 58 | LABEL, WITHPTR, SCAL, STR, PROG, IMPROPER, VARNT, |
2fd0f574 | 59 | FPROC, FFUNC, MODULE, TAG, COMMON, EXTREF, TYPEREF |
8a21415b ML |
60 | } Symclass; |
61 | ||
f128b014 AF |
62 | typedef enum { R_CONST, R_TEMP, R_ARG, R_ADJUST } Rangetype; |
63 | ||
d244f11c DS |
64 | #define INREG 0 |
65 | #define STK 1 | |
66 | #define EXT 2 | |
67 | ||
48f60939 | 68 | typedef unsigned int Storage; |
d244f11c | 69 | |
8a21415b ML |
70 | struct Symbol { |
71 | Name name; | |
72 | Language language; | |
d244f11c DS |
73 | Symclass class : 8; |
74 | Storage storage : 2; | |
75 | unsigned int level : 6; /* for variables stored on stack only */ | |
8a21415b ML |
76 | Symbol type; |
77 | Symbol chain; | |
78 | union { | |
0022c355 | 79 | Node constval; /* value of constant symbol */ |
8a21415b ML |
80 | int offset; /* variable address */ |
81 | long iconval; /* integer constant value */ | |
82 | double fconval; /* floating constant value */ | |
0022c355 | 83 | int ndims; /* no. of dimensions for dynamic/sub-arrays */ |
8a21415b ML |
84 | struct { /* field offset and size (both in bits) */ |
85 | int offset; | |
86 | int length; | |
87 | } field; | |
f128b014 AF |
88 | struct { /* common offset and chain; used to relocate */ |
89 | int offset; /* vars in global BSS */ | |
90 | Symbol chain; | |
91 | } common; | |
8a21415b | 92 | struct { /* range bounds */ |
f128b014 AF |
93 | Rangetype lowertype : 16; |
94 | Rangetype uppertype : 16; | |
8a21415b ML |
95 | long lower; |
96 | long upper; | |
97 | } rangev; | |
5455a470 ML |
98 | struct { |
99 | int offset : 16; /* offset for of function value */ | |
2fd0f574 SL |
100 | Boolean src : 1; /* true if there is source line info */ |
101 | Boolean inline : 1; /* true if no separate act. rec. */ | |
102 | Boolean intern : 1; /* internal calling sequence */ | |
103 | int unused : 13; | |
5455a470 | 104 | Address beginaddr; /* address of function code */ |
8a21415b ML |
105 | } funcv; |
106 | struct { /* variant record info */ | |
107 | int size; | |
108 | Symbol vtorec; | |
109 | Symbol vtag; | |
110 | } varnt; | |
2fd0f574 SL |
111 | String typeref; /* type defined by "<module>:<type>" */ |
112 | Symbol extref; /* indirect symbol for external reference */ | |
8a21415b ML |
113 | } symvalue; |
114 | Symbol block; /* symbol containing this symbol */ | |
115 | Symbol next_sym; /* hash chain */ | |
116 | }; | |
117 | ||
118 | /* | |
119 | * Basic types. | |
120 | */ | |
121 | ||
122 | Symbol t_boolean; | |
123 | Symbol t_char; | |
124 | Symbol t_int; | |
125 | Symbol t_real; | |
126 | Symbol t_nil; | |
0022c355 | 127 | Symbol t_addr; |
8a21415b ML |
128 | |
129 | Symbol program; | |
130 | Symbol curfunc; | |
131 | ||
0022c355 ML |
132 | boolean showaggrs; |
133 | ||
8a21415b ML |
134 | #define symname(s) ident(s->name) |
135 | #define codeloc(f) ((f)->symvalue.funcv.beginaddr) | |
136 | #define isblock(s) (Boolean) ( \ | |
137 | s->class == FUNC or s->class == PROC or \ | |
138 | s->class == MODULE or s->class == PROG \ | |
139 | ) | |
2fd0f574 SL |
140 | #define isroutine(s) (Boolean) ( \ |
141 | s->class == FUNC or s->class == PROC \ | |
142 | ) | |
8a21415b | 143 | |
5455a470 | 144 | #define nosource(f) (not (f)->symvalue.funcv.src) |
8584b807 | 145 | #define isinline(f) ((f)->symvalue.funcv.inline) |
5455a470 | 146 | |
d244f11c | 147 | #define isreg(s) (s->storage == INREG) |
ffb79108 | 148 | |
8a21415b ML |
149 | #include "tree.h" |
150 | ||
151 | /* | |
152 | * Some macros to make finding a symbol with certain attributes. | |
153 | */ | |
154 | ||
155 | #define find(s, withname) \ | |
156 | { \ | |
157 | s = lookup(withname); \ | |
158 | while (s != nil and not (s->name == (withname) and | |
159 | ||
160 | #define where /* qualification */ | |
161 | ||
162 | #define endfind(s) )) { \ | |
163 | s = s->next_sym; \ | |
164 | } \ | |
165 | } | |
166 | ||
167 | #endif | |
168 | ||
169 | /* | |
170 | * Symbol table structure currently does not support deletions. | |
d244f11c DS |
171 | * Hash table size is a power of two to make hashing faster. |
172 | * Using a non-prime is ok since we aren't doing rehashing. | |
8a21415b ML |
173 | */ |
174 | ||
d244f11c | 175 | #define HASHTABLESIZE 8192 |
8a21415b ML |
176 | |
177 | private Symbol hashtab[HASHTABLESIZE]; | |
178 | ||
d244f11c | 179 | #define hash(name) ((((unsigned) name) >> 2) & (HASHTABLESIZE - 1)) |
8a21415b ML |
180 | |
181 | /* | |
182 | * Allocate a new symbol. | |
183 | */ | |
184 | ||
d244f11c | 185 | #define SYMBLOCKSIZE 1000 |
8a21415b ML |
186 | |
187 | typedef struct Sympool { | |
188 | struct Symbol sym[SYMBLOCKSIZE]; | |
189 | struct Sympool *prevpool; | |
190 | } *Sympool; | |
191 | ||
192 | private Sympool sympool = nil; | |
193 | private Integer nleft = 0; | |
8a21415b ML |
194 | |
195 | public Symbol symbol_alloc() | |
196 | { | |
197 | register Sympool newpool; | |
198 | ||
199 | if (nleft <= 0) { | |
200 | newpool = new(Sympool); | |
d244f11c | 201 | bzero(newpool, sizeof(*newpool)); |
8a21415b ML |
202 | newpool->prevpool = sympool; |
203 | sympool = newpool; | |
204 | nleft = SYMBLOCKSIZE; | |
205 | } | |
206 | --nleft; | |
207 | return &(sympool->sym[nleft]); | |
208 | } | |
209 | ||
0022c355 | 210 | public symbol_dump (func) |
f128b014 AF |
211 | Symbol func; |
212 | { | |
0022c355 ML |
213 | register Symbol s; |
214 | register integer i; | |
f128b014 | 215 | |
0022c355 ML |
216 | printf(" symbols in %s \n",symname(func)); |
217 | for (i = 0; i < HASHTABLESIZE; i++) { | |
218 | for (s = hashtab[i]; s != nil; s = s->next_sym) { | |
219 | if (s->block == func) { | |
220 | psym(s); | |
221 | } | |
222 | } | |
223 | } | |
f128b014 AF |
224 | } |
225 | ||
8a21415b ML |
226 | /* |
227 | * Free all the symbols currently allocated. | |
228 | */ | |
0022c355 | 229 | |
8a21415b ML |
230 | public symbol_free() |
231 | { | |
232 | Sympool s, t; | |
233 | register Integer i; | |
234 | ||
235 | s = sympool; | |
236 | while (s != nil) { | |
237 | t = s->prevpool; | |
238 | dispose(s); | |
239 | s = t; | |
240 | } | |
241 | for (i = 0; i < HASHTABLESIZE; i++) { | |
242 | hashtab[i] = nil; | |
243 | } | |
244 | sympool = nil; | |
245 | nleft = 0; | |
246 | } | |
247 | ||
248 | /* | |
249 | * Create a new symbol with the given attributes. | |
250 | */ | |
251 | ||
252 | public Symbol newSymbol(name, blevel, class, type, chain) | |
253 | Name name; | |
254 | Integer blevel; | |
255 | Symclass class; | |
256 | Symbol type; | |
257 | Symbol chain; | |
258 | { | |
259 | register Symbol s; | |
260 | ||
261 | s = symbol_alloc(); | |
262 | s->name = name; | |
0022c355 | 263 | s->language = primlang; |
d244f11c | 264 | s->storage = EXT; |
8a21415b ML |
265 | s->level = blevel; |
266 | s->class = class; | |
267 | s->type = type; | |
268 | s->chain = chain; | |
269 | return s; | |
270 | } | |
271 | ||
272 | /* | |
273 | * Insert a symbol into the hash table. | |
274 | */ | |
275 | ||
276 | public Symbol insert(name) | |
277 | Name name; | |
278 | { | |
279 | register Symbol s; | |
280 | register unsigned int h; | |
281 | ||
282 | h = hash(name); | |
283 | s = symbol_alloc(); | |
284 | s->name = name; | |
285 | s->next_sym = hashtab[h]; | |
286 | hashtab[h] = s; | |
287 | return s; | |
288 | } | |
289 | ||
290 | /* | |
291 | * Symbol lookup. | |
292 | */ | |
293 | ||
294 | public Symbol lookup(name) | |
295 | Name name; | |
296 | { | |
297 | register Symbol s; | |
298 | register unsigned int h; | |
299 | ||
300 | h = hash(name); | |
301 | s = hashtab[h]; | |
302 | while (s != nil and s->name != name) { | |
303 | s = s->next_sym; | |
304 | } | |
305 | return s; | |
306 | } | |
307 | ||
2fd0f574 SL |
308 | /* |
309 | * Delete a symbol from the symbol table. | |
310 | */ | |
311 | ||
312 | public delete (s) | |
313 | Symbol s; | |
314 | { | |
315 | register Symbol t; | |
316 | register unsigned int h; | |
317 | ||
318 | h = hash(s->name); | |
319 | t = hashtab[h]; | |
320 | if (t == nil) { | |
321 | panic("delete of non-symbol '%s'", symname(s)); | |
322 | } else if (t == s) { | |
323 | hashtab[h] = s->next_sym; | |
324 | } else { | |
325 | while (t->next_sym != s) { | |
326 | t = t->next_sym; | |
327 | if (t == nil) { | |
328 | panic("delete of non-symbol '%s'", symname(s)); | |
329 | } | |
330 | } | |
331 | t->next_sym = s->next_sym; | |
332 | } | |
333 | } | |
334 | ||
8a21415b ML |
335 | /* |
336 | * Dump out all the variables associated with the given | |
0022c355 | 337 | * procedure, function, or program associated with the given stack frame. |
8a21415b ML |
338 | * |
339 | * This is quite inefficient. We traverse the entire symbol table | |
340 | * each time we're called. The assumption is that this routine | |
341 | * won't be called frequently enough to merit improved performance. | |
342 | */ | |
343 | ||
344 | public dumpvars(f, frame) | |
345 | Symbol f; | |
346 | Frame frame; | |
347 | { | |
348 | register Integer i; | |
349 | register Symbol s; | |
350 | ||
351 | for (i = 0; i < HASHTABLESIZE; i++) { | |
352 | for (s = hashtab[i]; s != nil; s = s->next_sym) { | |
353 | if (container(s) == f) { | |
354 | if (should_print(s)) { | |
355 | printv(s, frame); | |
356 | putchar('\n'); | |
357 | } else if (s->class == MODULE) { | |
358 | dumpvars(s, frame); | |
359 | } | |
360 | } | |
361 | } | |
362 | } | |
363 | } | |
364 | ||
365 | /* | |
366 | * Create a builtin type. | |
367 | * Builtin types are circular in that btype->type->type = btype. | |
368 | */ | |
369 | ||
0022c355 | 370 | private Symbol maketype(name, lower, upper) |
8a21415b ML |
371 | String name; |
372 | long lower; | |
373 | long upper; | |
374 | { | |
375 | register Symbol s; | |
0022c355 | 376 | Name n; |
8a21415b | 377 | |
0022c355 ML |
378 | if (name == nil) { |
379 | n = nil; | |
380 | } else { | |
381 | n = identname(name, true); | |
382 | } | |
383 | s = insert(n); | |
2fd0f574 | 384 | s->language = primlang; |
0022c355 ML |
385 | s->level = 0; |
386 | s->class = TYPE; | |
387 | s->type = nil; | |
388 | s->chain = nil; | |
8a21415b ML |
389 | s->type = newSymbol(nil, 0, RANGE, s, nil); |
390 | s->type->symvalue.rangev.lower = lower; | |
391 | s->type->symvalue.rangev.upper = upper; | |
392 | return s; | |
393 | } | |
394 | ||
395 | /* | |
0022c355 ML |
396 | * Create the builtin symbols. |
397 | */ | |
8a21415b | 398 | |
0022c355 | 399 | public symbols_init () |
8a21415b | 400 | { |
0022c355 ML |
401 | Symbol s; |
402 | ||
403 | t_boolean = maketype("$boolean", 0L, 1L); | |
404 | t_int = maketype("$integer", 0x80000000L, 0x7fffffffL); | |
405 | t_char = maketype("$char", 0L, 255L); | |
406 | t_real = maketype("$real", 8L, 0L); | |
407 | t_nil = maketype("$nil", 0L, 0L); | |
408 | t_addr = insert(identname("$address", true)); | |
409 | t_addr->language = primlang; | |
410 | t_addr->level = 0; | |
411 | t_addr->class = TYPE; | |
412 | t_addr->type = newSymbol(nil, 1, PTR, t_int, nil); | |
413 | s = insert(identname("true", true)); | |
414 | s->class = CONST; | |
415 | s->type = t_boolean; | |
416 | s->symvalue.constval = build(O_LCON, 1L); | |
417 | s->symvalue.constval->nodetype = t_boolean; | |
418 | s = insert(identname("false", true)); | |
419 | s->class = CONST; | |
420 | s->type = t_boolean; | |
421 | s->symvalue.constval = build(O_LCON, 0L); | |
422 | s->symvalue.constval->nodetype = t_boolean; | |
8a21415b | 423 | } |
8a21415b ML |
424 | |
425 | /* | |
426 | * Reduce type to avoid worrying about type names. | |
427 | */ | |
428 | ||
429 | public Symbol rtype(type) | |
430 | Symbol type; | |
431 | { | |
432 | register Symbol t; | |
433 | ||
434 | t = type; | |
435 | if (t != nil) { | |
0022c355 ML |
436 | if (t->class == VAR or t->class == CONST or |
437 | t->class == FIELD or t->class == REF | |
438 | ) { | |
8a21415b ML |
439 | t = t->type; |
440 | } | |
2fd0f574 SL |
441 | if (t->class == TYPEREF) { |
442 | resolveRef(t); | |
443 | } | |
8a21415b ML |
444 | while (t->class == TYPE or t->class == TAG) { |
445 | t = t->type; | |
2fd0f574 SL |
446 | if (t->class == TYPEREF) { |
447 | resolveRef(t); | |
448 | } | |
8a21415b ML |
449 | } |
450 | } | |
451 | return t; | |
452 | } | |
453 | ||
2fd0f574 SL |
454 | /* |
455 | * Find the end of a module name. Return nil if there is none | |
456 | * in the given string. | |
457 | */ | |
458 | ||
459 | private String findModuleMark (s) | |
460 | String s; | |
461 | { | |
462 | register char *p, *r; | |
463 | register boolean done; | |
464 | ||
465 | p = s; | |
466 | done = false; | |
467 | do { | |
468 | if (*p == ':') { | |
469 | done = true; | |
470 | r = p; | |
471 | } else if (*p == '\0') { | |
472 | done = true; | |
473 | r = nil; | |
474 | } else { | |
475 | ++p; | |
476 | } | |
477 | } while (not done); | |
478 | return r; | |
479 | } | |
480 | ||
481 | /* | |
482 | * Resolve a type reference by modifying to be the appropriate type. | |
483 | * | |
484 | * If the reference has a name, then it refers to an opaque type and | |
485 | * the actual type is directly accessible. Otherwise, we must use | |
486 | * the type reference string, which is of the form "module:{module:}name". | |
487 | */ | |
488 | ||
489 | public resolveRef (t) | |
490 | Symbol t; | |
491 | { | |
492 | register char *p; | |
493 | char *start; | |
494 | Symbol s, m, outer; | |
495 | Name n; | |
496 | ||
497 | if (t->name != nil) { | |
498 | s = t; | |
499 | } else { | |
500 | start = t->symvalue.typeref; | |
501 | outer = program; | |
502 | p = findModuleMark(start); | |
503 | while (p != nil) { | |
504 | *p = '\0'; | |
505 | n = identname(start, true); | |
506 | find(m, n) where m->block == outer endfind(m); | |
507 | if (m == nil) { | |
508 | p = nil; | |
509 | outer = nil; | |
510 | s = nil; | |
511 | } else { | |
512 | outer = m; | |
513 | start = p + 1; | |
514 | p = findModuleMark(start); | |
515 | } | |
516 | } | |
517 | if (outer != nil) { | |
518 | n = identname(start, true); | |
519 | find(s, n) where s->block == outer endfind(s); | |
520 | } | |
521 | } | |
522 | if (s != nil and s->type != nil) { | |
523 | t->name = s->type->name; | |
524 | t->class = s->type->class; | |
525 | t->type = s->type->type; | |
526 | t->chain = s->type->chain; | |
527 | t->symvalue = s->type->symvalue; | |
528 | t->block = s->type->block; | |
529 | } | |
530 | } | |
531 | ||
0022c355 | 532 | public integer regnum (s) |
8a21415b ML |
533 | Symbol s; |
534 | { | |
0022c355 ML |
535 | integer r; |
536 | ||
8a21415b | 537 | checkref(s); |
d244f11c | 538 | if (s->storage == INREG) { |
0022c355 ML |
539 | r = s->symvalue.offset; |
540 | } else { | |
541 | r = -1; | |
542 | } | |
543 | return r; | |
8a21415b ML |
544 | } |
545 | ||
546 | public Symbol container(s) | |
547 | Symbol s; | |
548 | { | |
549 | checkref(s); | |
550 | return s->block; | |
551 | } | |
552 | ||
0022c355 ML |
553 | public Node constval(s) |
554 | Symbol s; | |
555 | { | |
556 | checkref(s); | |
557 | if (s->class != CONST) { | |
558 | error("[internal error: constval(non-CONST)]"); | |
559 | } | |
560 | return s->symvalue.constval; | |
561 | } | |
562 | ||
8a21415b ML |
563 | /* |
564 | * Return the object address of the given symbol. | |
565 | * | |
566 | * There are the following possibilities: | |
567 | * | |
568 | * globals - just take offset | |
569 | * locals - take offset from locals base | |
570 | * arguments - take offset from argument base | |
571 | * register - offset is register number | |
572 | */ | |
573 | ||
d244f11c DS |
574 | #define isglobal(s) (s->storage == EXT) |
575 | #define islocaloff(s) (s->storage == STK and s->symvalue.offset < 0) | |
576 | #define isparamoff(s) (s->storage == STK and s->symvalue.offset >= 0) | |
8a21415b | 577 | |
0022c355 | 578 | public Address address (s, frame) |
8a21415b ML |
579 | Symbol s; |
580 | Frame frame; | |
581 | { | |
582 | register Frame frp; | |
583 | register Address addr; | |
584 | register Symbol cur; | |
585 | ||
586 | checkref(s); | |
587 | if (not isactive(s->block)) { | |
588 | error("\"%s\" is not currently defined", symname(s)); | |
589 | } else if (isglobal(s)) { | |
590 | addr = s->symvalue.offset; | |
591 | } else { | |
592 | frp = frame; | |
593 | if (frp == nil) { | |
594 | cur = s->block; | |
595 | while (cur != nil and cur->class == MODULE) { | |
596 | cur = cur->block; | |
597 | } | |
598 | if (cur == nil) { | |
0022c355 ML |
599 | frp = nil; |
600 | } else { | |
601 | frp = findframe(cur); | |
602 | if (frp == nil) { | |
603 | error("[internal error: unexpected nil frame for \"%s\"]", | |
604 | symname(s) | |
605 | ); | |
606 | } | |
8a21415b ML |
607 | } |
608 | } | |
609 | if (islocaloff(s)) { | |
610 | addr = locals_base(frp) + s->symvalue.offset; | |
611 | } else if (isparamoff(s)) { | |
612 | addr = args_base(frp) + s->symvalue.offset; | |
613 | } else if (isreg(s)) { | |
614 | addr = savereg(s->symvalue.offset, frp); | |
615 | } else { | |
616 | panic("address: bad symbol \"%s\"", symname(s)); | |
617 | } | |
618 | } | |
619 | return addr; | |
620 | } | |
621 | ||
622 | /* | |
623 | * Define a symbol used to access register values. | |
624 | */ | |
625 | ||
0022c355 | 626 | public defregname (n, r) |
8a21415b | 627 | Name n; |
0022c355 | 628 | integer r; |
8a21415b | 629 | { |
0022c355 | 630 | Symbol s; |
8a21415b ML |
631 | |
632 | s = insert(n); | |
0022c355 | 633 | s->language = t_addr->language; |
8a21415b | 634 | s->class = VAR; |
d244f11c DS |
635 | s->storage = INREG; |
636 | s->level = 3; | |
0022c355 | 637 | s->type = t_addr; |
8a21415b ML |
638 | s->symvalue.offset = r; |
639 | } | |
640 | ||
641 | /* | |
642 | * Resolve an "abstract" type reference. | |
643 | * | |
644 | * It is possible in C to define a pointer to a type, but never define | |
645 | * the type in a particular source file. Here we try to resolve | |
646 | * the type definition. This is problematic, it is possible to | |
647 | * have multiple, different definitions for the same name type. | |
648 | */ | |
649 | ||
650 | public findtype(s) | |
651 | Symbol s; | |
652 | { | |
653 | register Symbol t, u, prev; | |
654 | ||
655 | u = s; | |
656 | prev = nil; | |
657 | while (u != nil and u->class != BADUSE) { | |
658 | if (u->name != nil) { | |
659 | prev = u; | |
660 | } | |
661 | u = u->type; | |
662 | } | |
663 | if (prev == nil) { | |
664 | error("couldn't find link to type reference"); | |
665 | } | |
0022c355 ML |
666 | t = lookup(prev->name); |
667 | while (t != nil and | |
668 | not ( | |
669 | t != prev and t->name == prev->name and | |
670 | t->block->class == MODULE and t->class == prev->class and | |
671 | t->type != nil and t->type->type != nil and | |
672 | t->type->type->class != BADUSE | |
673 | ) | |
674 | ) { | |
675 | t = t->next_sym; | |
676 | } | |
8a21415b ML |
677 | if (t == nil) { |
678 | error("couldn't resolve reference"); | |
679 | } else { | |
680 | prev->type = t->type; | |
681 | } | |
682 | } | |
683 | ||
684 | /* | |
685 | * Find the size in bytes of the given type. | |
686 | * | |
687 | * This is probably the WRONG thing to do. The size should be kept | |
688 | * as an attribute in the symbol information as is done for structures | |
689 | * and fields. I haven't gotten around to cleaning this up yet. | |
690 | */ | |
691 | ||
f128b014 AF |
692 | #define MAXUCHAR 255 |
693 | #define MAXUSHORT 65535L | |
8a21415b ML |
694 | #define MINCHAR -128 |
695 | #define MAXCHAR 127 | |
696 | #define MINSHORT -32768 | |
697 | #define MAXSHORT 32767 | |
698 | ||
2fd0f574 SL |
699 | public findbounds (u, lower, upper) |
700 | Symbol u; | |
701 | long *lower, *upper; | |
702 | { | |
703 | Rangetype lbt, ubt; | |
704 | long lb, ub; | |
705 | ||
706 | if (u->class == RANGE) { | |
707 | lbt = u->symvalue.rangev.lowertype; | |
708 | ubt = u->symvalue.rangev.uppertype; | |
709 | lb = u->symvalue.rangev.lower; | |
710 | ub = u->symvalue.rangev.upper; | |
711 | if (lbt == R_ARG or lbt == R_TEMP) { | |
712 | if (not getbound(u, lb, lbt, lower)) { | |
713 | error("dynamic bounds not currently available"); | |
714 | } | |
715 | } else { | |
716 | *lower = lb; | |
717 | } | |
718 | if (ubt == R_ARG or ubt == R_TEMP) { | |
719 | if (not getbound(u, ub, ubt, upper)) { | |
720 | error("dynamic bounds not currently available"); | |
721 | } | |
722 | } else { | |
723 | *upper = ub; | |
724 | } | |
725 | } else if (u->class == SCAL) { | |
726 | *lower = 0; | |
727 | *upper = u->symvalue.iconval - 1; | |
728 | } else { | |
0022c355 | 729 | error("[internal error: unexpected array bound type]"); |
2fd0f574 SL |
730 | } |
731 | } | |
732 | ||
733 | public integer size(sym) | |
734 | Symbol sym; | |
735 | { | |
736 | register Symbol s, t, u; | |
737 | register integer nel, elsize; | |
8a21415b | 738 | long lower, upper; |
2fd0f574 | 739 | integer r, off, len; |
8a21415b ML |
740 | |
741 | t = sym; | |
742 | checkref(t); | |
2fd0f574 SL |
743 | if (t->class == TYPEREF) { |
744 | resolveRef(t); | |
745 | } | |
8a21415b ML |
746 | switch (t->class) { |
747 | case RANGE: | |
748 | lower = t->symvalue.rangev.lower; | |
749 | upper = t->symvalue.rangev.upper; | |
2fd0f574 SL |
750 | if (upper == 0 and lower > 0) { |
751 | /* real */ | |
8a21415b | 752 | r = lower; |
2fd0f574 SL |
753 | } else if (lower > upper) { |
754 | /* unsigned long */ | |
755 | r = sizeof(long); | |
99552332 | 756 | } else if ( |
f128b014 AF |
757 | (lower >= MINCHAR and upper <= MAXCHAR) or |
758 | (lower >= 0 and upper <= MAXUCHAR) | |
759 | ) { | |
8a21415b | 760 | r = sizeof(char); |
f128b014 AF |
761 | } else if ( |
762 | (lower >= MINSHORT and upper <= MAXSHORT) or | |
763 | (lower >= 0 and upper <= MAXUSHORT) | |
764 | ) { | |
8a21415b ML |
765 | r = sizeof(short); |
766 | } else { | |
767 | r = sizeof(long); | |
768 | } | |
769 | break; | |
770 | ||
771 | case ARRAY: | |
772 | elsize = size(t->type); | |
773 | nel = 1; | |
774 | for (t = t->chain; t != nil; t = t->chain) { | |
2fd0f574 SL |
775 | u = rtype(t); |
776 | findbounds(u, &lower, &upper); | |
8a21415b ML |
777 | nel *= (upper-lower+1); |
778 | } | |
779 | r = nel*elsize; | |
780 | break; | |
781 | ||
d244f11c | 782 | case OPENARRAY: |
0022c355 ML |
783 | case DYNARRAY: |
784 | r = (t->symvalue.ndims + 1) * sizeof(Word); | |
785 | break; | |
786 | ||
787 | case SUBARRAY: | |
788 | r = (2 * t->symvalue.ndims + 1) * sizeof(Word); | |
789 | break; | |
790 | ||
f128b014 | 791 | case REF: |
8a21415b | 792 | case VAR: |
8a21415b | 793 | r = size(t->type); |
61f87176 ML |
794 | /* |
795 | * | |
99552332 | 796 | if (r < sizeof(Word) and isparam(t)) { |
8a21415b ML |
797 | r = sizeof(Word); |
798 | } | |
f128b014 | 799 | */ |
8a21415b ML |
800 | break; |
801 | ||
0022c355 | 802 | case FVAR: |
8a21415b | 803 | case CONST: |
0022c355 | 804 | case TAG: |
8a21415b ML |
805 | r = size(t->type); |
806 | break; | |
807 | ||
808 | case TYPE: | |
d244f11c DS |
809 | /* |
810 | * This causes problems on the IRIS because of the compiler bug | |
811 | * with stab offsets for parameters. Not sure it's really | |
812 | * necessary anyway. | |
813 | */ | |
814 | # ifndef IRIS | |
8a21415b ML |
815 | if (t->type->class == PTR and t->type->type->class == BADUSE) { |
816 | findtype(t); | |
817 | } | |
d244f11c | 818 | # endif |
8a21415b ML |
819 | r = size(t->type); |
820 | break; | |
821 | ||
8a21415b | 822 | case FIELD: |
2fd0f574 SL |
823 | off = t->symvalue.field.offset; |
824 | len = t->symvalue.field.length; | |
825 | r = (off + len + 7) div 8 - (off div 8); | |
8a21415b ML |
826 | break; |
827 | ||
828 | case RECORD: | |
829 | case VARNT: | |
830 | r = t->symvalue.offset; | |
831 | if (r == 0 and t->chain != nil) { | |
832 | panic("missing size information for record"); | |
833 | } | |
834 | break; | |
835 | ||
836 | case PTR: | |
0022c355 | 837 | case TYPEREF: |
8a21415b ML |
838 | case FILET: |
839 | r = sizeof(Word); | |
840 | break; | |
841 | ||
842 | case SCAL: | |
5e86df1e ML |
843 | r = sizeof(Word); |
844 | /* | |
845 | * | |
8a21415b ML |
846 | if (t->symvalue.iconval > 255) { |
847 | r = sizeof(short); | |
848 | } else { | |
849 | r = sizeof(char); | |
850 | } | |
5e86df1e ML |
851 | * |
852 | */ | |
8a21415b ML |
853 | break; |
854 | ||
855 | case FPROC: | |
856 | case FFUNC: | |
857 | r = sizeof(Word); | |
858 | break; | |
859 | ||
860 | case PROC: | |
861 | case FUNC: | |
862 | case MODULE: | |
863 | case PROG: | |
864 | r = sizeof(Symbol); | |
865 | break; | |
866 | ||
2fd0f574 SL |
867 | case SET: |
868 | u = rtype(t->type); | |
869 | switch (u->class) { | |
870 | case RANGE: | |
871 | r = u->symvalue.rangev.upper - u->symvalue.rangev.lower + 1; | |
872 | break; | |
873 | ||
874 | case SCAL: | |
875 | r = u->symvalue.iconval; | |
876 | break; | |
877 | ||
878 | default: | |
879 | error("expected range for set base type"); | |
880 | break; | |
881 | } | |
882 | r = (r + BITSPERBYTE - 1) div BITSPERBYTE; | |
883 | break; | |
884 | ||
0022c355 ML |
885 | /* |
886 | * These can happen in C (unfortunately) for unresolved type references | |
887 | * Assume they are pointers. | |
888 | */ | |
889 | case BADUSE: | |
890 | r = sizeof(Address); | |
891 | break; | |
892 | ||
8a21415b ML |
893 | default: |
894 | if (ord(t->class) > ord(TYPEREF)) { | |
895 | panic("size: bad class (%d)", ord(t->class)); | |
896 | } else { | |
0022c355 | 897 | fprintf(stderr, "can't compute size of a %s\n", classname(t)); |
8a21415b | 898 | } |
2fd0f574 SL |
899 | r = 0; |
900 | break; | |
8a21415b | 901 | } |
8a21415b ML |
902 | return r; |
903 | } | |
904 | ||
0022c355 ML |
905 | /* |
906 | * Return the size associated with a symbol that takes into account | |
907 | * reference parameters. This might be better as the normal size function, but | |
908 | * too many places already depend on it working the way it does. | |
909 | */ | |
910 | ||
911 | public integer psize (s) | |
912 | Symbol s; | |
913 | { | |
914 | integer r; | |
915 | Symbol t; | |
916 | ||
917 | if (s->class == REF) { | |
918 | t = rtype(s->type); | |
d244f11c | 919 | if (t->class == OPENARRAY) { |
0022c355 ML |
920 | r = (t->symvalue.ndims + 1) * sizeof(Word); |
921 | } else if (t->class == SUBARRAY) { | |
922 | r = (2 * t->symvalue.ndims + 1) * sizeof(Word); | |
923 | } else { | |
924 | r = sizeof(Word); | |
925 | } | |
926 | } else { | |
927 | r = size(s); | |
928 | } | |
929 | return r; | |
930 | } | |
931 | ||
8a21415b ML |
932 | /* |
933 | * Test if a symbol is a parameter. This is true if there | |
934 | * is a cycle from s->block to s via chain pointers. | |
935 | */ | |
936 | ||
937 | public Boolean isparam(s) | |
938 | Symbol s; | |
939 | { | |
940 | register Symbol t; | |
941 | ||
942 | t = s->block; | |
943 | while (t != nil and t != s) { | |
944 | t = t->chain; | |
945 | } | |
946 | return (Boolean) (t != nil); | |
947 | } | |
948 | ||
949 | /* | |
2fd0f574 SL |
950 | * Test if a type is an open array parameter type. |
951 | */ | |
952 | ||
0022c355 ML |
953 | public boolean isopenarray (type) |
954 | Symbol type; | |
2fd0f574 | 955 | { |
0022c355 ML |
956 | Symbol t; |
957 | ||
958 | t = rtype(type); | |
d244f11c | 959 | return (boolean) (t->class == OPENARRAY); |
2fd0f574 SL |
960 | } |
961 | ||
962 | /* | |
0022c355 | 963 | * Test if a symbol is a var parameter, i.e. has class REF. |
8a21415b ML |
964 | */ |
965 | ||
966 | public Boolean isvarparam(s) | |
967 | Symbol s; | |
968 | { | |
969 | return (Boolean) (s->class == REF); | |
970 | } | |
971 | ||
972 | /* | |
973 | * Test if a symbol is a variable (actually any addressible quantity | |
974 | * with do). | |
975 | */ | |
976 | ||
977 | public Boolean isvariable(s) | |
0022c355 | 978 | Symbol s; |
8a21415b ML |
979 | { |
980 | return (Boolean) (s->class == VAR or s->class == FVAR or s->class == REF); | |
981 | } | |
982 | ||
983 | /* | |
0022c355 ML |
984 | * Test if a symbol is a constant. |
985 | */ | |
986 | ||
987 | public Boolean isconst(s) | |
988 | Symbol s; | |
8a21415b | 989 | { |
0022c355 | 990 | return (Boolean) (s->class == CONST); |
8a21415b | 991 | } |
8a21415b ML |
992 | |
993 | /* | |
994 | * Test if a symbol is a module. | |
995 | */ | |
996 | ||
997 | public Boolean ismodule(s) | |
998 | register Symbol s; | |
999 | { | |
1000 | return (Boolean) (s->class == MODULE); | |
1001 | } | |
1002 | ||
2fd0f574 SL |
1003 | /* |
1004 | * Mark a procedure or function as internal, meaning that it is called | |
1005 | * with a different calling sequence. | |
1006 | */ | |
1007 | ||
1008 | public markInternal (s) | |
1009 | Symbol s; | |
1010 | { | |
1011 | s->symvalue.funcv.intern = true; | |
1012 | } | |
1013 | ||
1014 | public boolean isinternal (s) | |
1015 | Symbol s; | |
1016 | { | |
1017 | return s->symvalue.funcv.intern; | |
1018 | } | |
1019 | ||
0022c355 ML |
1020 | /* |
1021 | * Decide if a field begins or ends on a bit rather than byte boundary. | |
1022 | */ | |
1023 | ||
1024 | public Boolean isbitfield(s) | |
1025 | register Symbol s; | |
1026 | { | |
1027 | boolean b; | |
1028 | register integer off, len; | |
1029 | register Symbol t; | |
1030 | ||
1031 | off = s->symvalue.field.offset; | |
1032 | len = s->symvalue.field.length; | |
1033 | if ((off mod BITSPERBYTE) != 0 or (len mod BITSPERBYTE) != 0) { | |
1034 | b = true; | |
1035 | } else { | |
1036 | t = rtype(s->type); | |
1037 | b = (Boolean) ( | |
1038 | (t->class == SCAL and len != (sizeof(int)*BITSPERBYTE)) or | |
1039 | len != (size(t)*BITSPERBYTE) | |
1040 | ); | |
1041 | } | |
1042 | return b; | |
1043 | } | |
1044 | ||
1045 | private boolean primlang_typematch (t1, t2) | |
1046 | Symbol t1, t2; | |
1047 | { | |
1048 | return (boolean) ( | |
1049 | (t1 == t2) or | |
1050 | ( | |
1051 | t1->class == RANGE and t2->class == RANGE and | |
1052 | t1->symvalue.rangev.lower == t2->symvalue.rangev.lower and | |
1053 | t1->symvalue.rangev.upper == t2->symvalue.rangev.upper | |
1054 | ) or ( | |
1055 | t1->class == PTR and t2->class == RANGE and | |
1056 | t2->symvalue.rangev.upper >= t2->symvalue.rangev.lower | |
1057 | ) or ( | |
1058 | t2->class == PTR and t1->class == RANGE and | |
1059 | t1->symvalue.rangev.upper >= t1->symvalue.rangev.lower | |
1060 | ) | |
1061 | ); | |
1062 | } | |
1063 | ||
8a21415b ML |
1064 | /* |
1065 | * Test if two types match. | |
1066 | * Equivalent names implies a match in any language. | |
1067 | * | |
1068 | * Special symbols must be handled with care. | |
1069 | */ | |
1070 | ||
1071 | public Boolean compatible(t1, t2) | |
1072 | register Symbol t1, t2; | |
1073 | { | |
1074 | Boolean b; | |
2fd0f574 | 1075 | Symbol rt1, rt2; |
8a21415b ML |
1076 | |
1077 | if (t1 == t2) { | |
1078 | b = true; | |
1079 | } else if (t1 == nil or t2 == nil) { | |
1080 | b = false; | |
1081 | } else if (t1 == procsym) { | |
1082 | b = isblock(t2); | |
1083 | } else if (t2 == procsym) { | |
1084 | b = isblock(t1); | |
1085 | } else if (t1->language == nil) { | |
2fd0f574 SL |
1086 | if (t2->language == nil) { |
1087 | b = false; | |
d244f11c DS |
1088 | } else if (t2->language == primlang) { |
1089 | b = (boolean) primlang_typematch(rtype(t1), rtype(t2)); | |
1090 | } else { | |
1091 | b = (boolean) (*language_op(t2->language, L_TYPEMATCH))(t1, t2); | |
1092 | } | |
1093 | } else if (t1->language == primlang) { | |
1094 | if (t2->language == primlang or t2->language == nil) { | |
1095 | b = primlang_typematch(rtype(t1), rtype(t2)); | |
2fd0f574 SL |
1096 | } else { |
1097 | b = (boolean) (*language_op(t2->language, L_TYPEMATCH))(t1, t2); | |
1098 | } | |
8a21415b | 1099 | } else { |
2fd0f574 | 1100 | b = (boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2); |
8a21415b ML |
1101 | } |
1102 | return b; | |
1103 | } | |
1104 | ||
1105 | /* | |
1106 | * Check for a type of the given name. | |
1107 | */ | |
1108 | ||
1109 | public Boolean istypename(type, name) | |
1110 | Symbol type; | |
1111 | String name; | |
1112 | { | |
0022c355 | 1113 | register Symbol t; |
8a21415b ML |
1114 | Boolean b; |
1115 | ||
1116 | t = type; | |
0022c355 ML |
1117 | if (t == nil) { |
1118 | b = false; | |
1119 | } else { | |
1120 | b = (Boolean) ( | |
1121 | t->class == TYPE and streq(ident(t->name), name) | |
1122 | ); | |
1123 | } | |
8a21415b ML |
1124 | return b; |
1125 | } | |
1126 | ||
2fd0f574 SL |
1127 | /* |
1128 | * Determine if a (value) parameter should actually be passed by address. | |
1129 | */ | |
1130 | ||
1131 | public boolean passaddr (p, exprtype) | |
1132 | Symbol p, exprtype; | |
1133 | { | |
1134 | boolean b; | |
1135 | Language def; | |
1136 | ||
1137 | if (p == nil) { | |
1138 | def = findlanguage(".c"); | |
1139 | b = (boolean) (*language_op(def, L_PASSADDR))(p, exprtype); | |
1140 | } else if (p->language == nil or p->language == primlang) { | |
1141 | b = false; | |
1142 | } else if (isopenarray(p->type)) { | |
1143 | b = true; | |
1144 | } else { | |
1145 | b = (boolean) (*language_op(p->language, L_PASSADDR))(p, exprtype); | |
1146 | } | |
1147 | return b; | |
1148 | } | |
1149 | ||
8a21415b ML |
1150 | /* |
1151 | * Test if the name of a symbol is uniquely defined or not. | |
1152 | */ | |
1153 | ||
1154 | public Boolean isambiguous(s) | |
1155 | register Symbol s; | |
1156 | { | |
1157 | register Symbol t; | |
1158 | ||
1159 | find(t, s->name) where t != s endfind(t); | |
1160 | return (Boolean) (t != nil); | |
1161 | } | |
1162 | ||
1163 | typedef char *Arglist; | |
1164 | ||
1165 | #define nextarg(type) ((type *) (ap += sizeof(type)))[-1] | |
1166 | ||
1167 | private Symbol mkstring(); | |
8a21415b ML |
1168 | |
1169 | /* | |
1170 | * Determine the type of a parse tree. | |
0022c355 | 1171 | * |
8a21415b | 1172 | * Also make some symbol-dependent changes to the tree such as |
0022c355 | 1173 | * removing indirection for constant or register symbols. |
8a21415b ML |
1174 | */ |
1175 | ||
0022c355 | 1176 | public assigntypes (p) |
8a21415b ML |
1177 | register Node p; |
1178 | { | |
1179 | register Node p1; | |
1180 | register Symbol s; | |
1181 | ||
1182 | switch (p->op) { | |
1183 | case O_SYM: | |
0022c355 | 1184 | p->nodetype = p->value.sym; |
8a21415b ML |
1185 | break; |
1186 | ||
1187 | case O_LCON: | |
1188 | p->nodetype = t_int; | |
1189 | break; | |
1190 | ||
0022c355 ML |
1191 | case O_CCON: |
1192 | p->nodetype = t_char; | |
1193 | break; | |
1194 | ||
8a21415b ML |
1195 | case O_FCON: |
1196 | p->nodetype = t_real; | |
1197 | break; | |
1198 | ||
1199 | case O_SCON: | |
0022c355 | 1200 | p->nodetype = mkstring(p->value.scon); |
8a21415b ML |
1201 | break; |
1202 | ||
1203 | case O_INDIR: | |
1204 | p1 = p->value.arg[0]; | |
0022c355 ML |
1205 | s = rtype(p1->nodetype); |
1206 | if (s->class != PTR) { | |
1207 | beginerrmsg(); | |
1208 | fprintf(stderr, "\""); | |
1209 | prtree(stderr, p1); | |
1210 | fprintf(stderr, "\" is not a pointer"); | |
1211 | enderrmsg(); | |
1212 | } | |
8a21415b ML |
1213 | p->nodetype = rtype(p1->nodetype)->type; |
1214 | break; | |
1215 | ||
1216 | case O_DOT: | |
1217 | p->nodetype = p->value.arg[1]->value.sym; | |
1218 | break; | |
1219 | ||
1220 | case O_RVAL: | |
1221 | p1 = p->value.arg[0]; | |
1222 | p->nodetype = p1->nodetype; | |
1223 | if (p1->op == O_SYM) { | |
0022c355 ML |
1224 | if (p1->nodetype->class == PROC or p->nodetype->class == FUNC) { |
1225 | p->op = p1->op; | |
1226 | p->value.sym = p1->value.sym; | |
1227 | p->nodetype = p1->nodetype; | |
1228 | dispose(p1); | |
8a21415b | 1229 | } else if (p1->value.sym->class == CONST) { |
0022c355 ML |
1230 | p->op = p1->op; |
1231 | p->value = p1->value; | |
1232 | p->nodetype = p1->nodetype; | |
1233 | dispose(p1); | |
8a21415b ML |
1234 | } else if (isreg(p1->value.sym)) { |
1235 | p->op = O_SYM; | |
1236 | p->value.sym = p1->value.sym; | |
1237 | dispose(p1); | |
1238 | } | |
1239 | } else if (p1->op == O_INDIR and p1->value.arg[0]->op == O_SYM) { | |
1240 | s = p1->value.arg[0]->value.sym; | |
1241 | if (isreg(s)) { | |
1242 | p1->op = O_SYM; | |
1243 | dispose(p1->value.arg[0]); | |
1244 | p1->value.sym = s; | |
1245 | p1->nodetype = s; | |
1246 | } | |
1247 | } | |
1248 | break; | |
1249 | ||
0022c355 ML |
1250 | case O_COMMA: |
1251 | p->nodetype = p->value.arg[0]->nodetype; | |
1252 | break; | |
1253 | ||
1254 | case O_CALLPROC: | |
8a21415b ML |
1255 | case O_CALL: |
1256 | p1 = p->value.arg[0]; | |
74dabb40 ML |
1257 | p->nodetype = rtype(p1->nodetype)->type; |
1258 | break; | |
1259 | ||
1260 | case O_TYPERENAME: | |
1261 | p->nodetype = p->value.arg[1]->nodetype; | |
8a21415b ML |
1262 | break; |
1263 | ||
1264 | case O_ITOF: | |
1265 | p->nodetype = t_real; | |
1266 | break; | |
1267 | ||
1268 | case O_NEG: | |
1269 | s = p->value.arg[0]->nodetype; | |
1270 | if (not compatible(s, t_int)) { | |
1271 | if (not compatible(s, t_real)) { | |
1272 | beginerrmsg(); | |
2fd0f574 | 1273 | fprintf(stderr, "\""); |
8a21415b | 1274 | prtree(stderr, p->value.arg[0]); |
2fd0f574 | 1275 | fprintf(stderr, "\" is improper type"); |
8a21415b ML |
1276 | enderrmsg(); |
1277 | } else { | |
1278 | p->op = O_NEGF; | |
1279 | } | |
1280 | } | |
1281 | p->nodetype = s; | |
1282 | break; | |
1283 | ||
1284 | case O_ADD: | |
1285 | case O_SUB: | |
1286 | case O_MUL: | |
2fd0f574 SL |
1287 | binaryop(p, nil); |
1288 | break; | |
1289 | ||
8a21415b ML |
1290 | case O_LT: |
1291 | case O_LE: | |
1292 | case O_GT: | |
1293 | case O_GE: | |
1294 | case O_EQ: | |
1295 | case O_NE: | |
2fd0f574 | 1296 | binaryop(p, t_boolean); |
8a21415b | 1297 | break; |
8a21415b ML |
1298 | |
1299 | case O_DIVF: | |
1300 | convert(&(p->value.arg[0]), t_real, O_ITOF); | |
1301 | convert(&(p->value.arg[1]), t_real, O_ITOF); | |
1302 | p->nodetype = t_real; | |
1303 | break; | |
1304 | ||
1305 | case O_DIV: | |
1306 | case O_MOD: | |
1307 | convert(&(p->value.arg[0]), t_int, O_NOP); | |
1308 | convert(&(p->value.arg[1]), t_int, O_NOP); | |
1309 | p->nodetype = t_int; | |
1310 | break; | |
1311 | ||
1312 | case O_AND: | |
1313 | case O_OR: | |
1314 | chkboolean(p->value.arg[0]); | |
1315 | chkboolean(p->value.arg[1]); | |
1316 | p->nodetype = t_boolean; | |
1317 | break; | |
1318 | ||
1319 | case O_QLINE: | |
1320 | p->nodetype = t_int; | |
1321 | break; | |
1322 | ||
1323 | default: | |
1324 | p->nodetype = nil; | |
1325 | break; | |
1326 | } | |
1327 | } | |
1328 | ||
2fd0f574 SL |
1329 | /* |
1330 | * Process a binary arithmetic or relational operator. | |
1331 | * Convert from integer to real if necessary. | |
1332 | */ | |
1333 | ||
1334 | private binaryop (p, t) | |
1335 | Node p; | |
1336 | Symbol t; | |
1337 | { | |
1338 | Node p1, p2; | |
1339 | Boolean t1real, t2real; | |
1340 | Symbol t1, t2; | |
1341 | ||
1342 | p1 = p->value.arg[0]; | |
1343 | p2 = p->value.arg[1]; | |
1344 | t1 = rtype(p1->nodetype); | |
1345 | t2 = rtype(p2->nodetype); | |
1346 | t1real = compatible(t1, t_real); | |
1347 | t2real = compatible(t2, t_real); | |
1348 | if (t1real or t2real) { | |
1349 | p->op = (Operator) (ord(p->op) + 1); | |
1350 | if (not t1real) { | |
1351 | p->value.arg[0] = build(O_ITOF, p1); | |
1352 | } else if (not t2real) { | |
1353 | p->value.arg[1] = build(O_ITOF, p2); | |
1354 | } | |
1355 | p->nodetype = t_real; | |
1356 | } else { | |
1357 | if (size(p1->nodetype) > sizeof(integer)) { | |
1358 | beginerrmsg(); | |
1359 | fprintf(stderr, "operation not defined on \""); | |
1360 | prtree(stderr, p1); | |
1361 | fprintf(stderr, "\""); | |
1362 | enderrmsg(); | |
1363 | } else if (size(p2->nodetype) > sizeof(integer)) { | |
1364 | beginerrmsg(); | |
1365 | fprintf(stderr, "operation not defined on \""); | |
1366 | prtree(stderr, p2); | |
1367 | fprintf(stderr, "\""); | |
1368 | enderrmsg(); | |
1369 | } | |
1370 | p->nodetype = t_int; | |
1371 | } | |
1372 | if (t != nil) { | |
1373 | p->nodetype = t; | |
1374 | } | |
1375 | } | |
1376 | ||
8a21415b ML |
1377 | /* |
1378 | * Convert a tree to a type via a conversion operator; | |
1379 | * if this isn't possible generate an error. | |
8a21415b ML |
1380 | */ |
1381 | ||
1382 | private convert(tp, typeto, op) | |
1383 | Node *tp; | |
1384 | Symbol typeto; | |
1385 | Operator op; | |
1386 | { | |
2fd0f574 SL |
1387 | Node tree; |
1388 | Symbol s, t; | |
8a21415b | 1389 | |
2fd0f574 | 1390 | tree = *tp; |
8a21415b | 1391 | s = rtype(tree->nodetype); |
2fd0f574 SL |
1392 | t = rtype(typeto); |
1393 | if (compatible(t, t_real) and compatible(s, t_int)) { | |
53296b71 | 1394 | /* we can convert int => floating but not the reverse */ |
8a21415b | 1395 | tree = build(op, tree); |
2fd0f574 | 1396 | } else if (not compatible(s, t)) { |
8a21415b | 1397 | beginerrmsg(); |
2fd0f574 | 1398 | prtree(stderr, tree); |
53296b71 | 1399 | fprintf(stderr, ": illegal type in operation"); |
8a21415b | 1400 | enderrmsg(); |
8a21415b | 1401 | } |
2fd0f574 | 1402 | *tp = tree; |
8a21415b ML |
1403 | } |
1404 | ||
1405 | /* | |
1406 | * Construct a node for the dot operator. | |
1407 | * | |
1408 | * If the left operand is not a record, but rather a procedure | |
1409 | * or function, then we interpret the "." as referencing an | |
1410 | * "invisible" variable; i.e. a variable within a dynamically | |
1411 | * active block but not within the static scope of the current procedure. | |
1412 | */ | |
1413 | ||
1414 | public Node dot(record, fieldname) | |
1415 | Node record; | |
1416 | Name fieldname; | |
1417 | { | |
0022c355 | 1418 | register Node rec, p; |
8a21415b ML |
1419 | register Symbol s, t; |
1420 | ||
0022c355 ML |
1421 | rec = record; |
1422 | if (isblock(rec->nodetype)) { | |
8a21415b | 1423 | find(s, fieldname) where |
0022c355 ML |
1424 | s->block == rec->nodetype and |
1425 | s->class != FIELD | |
8a21415b ML |
1426 | endfind(s); |
1427 | if (s == nil) { | |
1428 | beginerrmsg(); | |
1429 | fprintf(stderr, "\"%s\" is not defined in ", ident(fieldname)); | |
0022c355 | 1430 | printname(stderr, rec->nodetype); |
8a21415b ML |
1431 | enderrmsg(); |
1432 | } | |
1433 | p = new(Node); | |
1434 | p->op = O_SYM; | |
1435 | p->value.sym = s; | |
0022c355 | 1436 | p->nodetype = s; |
8a21415b | 1437 | } else { |
0022c355 | 1438 | p = rec; |
8a21415b ML |
1439 | t = rtype(p->nodetype); |
1440 | if (t->class == PTR) { | |
1441 | s = findfield(fieldname, t->type); | |
1442 | } else { | |
1443 | s = findfield(fieldname, t); | |
1444 | } | |
1445 | if (s == nil) { | |
1446 | beginerrmsg(); | |
1447 | fprintf(stderr, "\"%s\" is not a field in ", ident(fieldname)); | |
0022c355 | 1448 | prtree(stderr, rec); |
8a21415b ML |
1449 | enderrmsg(); |
1450 | } | |
0022c355 ML |
1451 | if (t->class != PTR or isreg(rec->nodetype)) { |
1452 | p = unrval(p); | |
8a21415b | 1453 | } |
0022c355 | 1454 | p->nodetype = t_addr; |
8a21415b ML |
1455 | p = build(O_DOT, p, build(O_SYM, s)); |
1456 | } | |
0022c355 | 1457 | return build(O_RVAL, p); |
8a21415b ML |
1458 | } |
1459 | ||
1460 | /* | |
1461 | * Return a tree corresponding to an array reference and do the | |
1462 | * error checking. | |
1463 | */ | |
1464 | ||
1465 | public Node subscript(a, slist) | |
1466 | Node a, slist; | |
1467 | { | |
2fd0f574 | 1468 | Symbol t; |
0022c355 | 1469 | Node p; |
f128b014 | 1470 | |
2fd0f574 | 1471 | t = rtype(a->nodetype); |
0022c355 ML |
1472 | if (t->language == nil or t->language == primlang) { |
1473 | p = (Node) (*language_op(findlanguage(".s"), L_BUILDAREF))(a, slist); | |
2fd0f574 | 1474 | } else { |
0022c355 | 1475 | p = (Node) (*language_op(t->language, L_BUILDAREF))(a, slist); |
2fd0f574 | 1476 | } |
0022c355 | 1477 | return build(O_RVAL, p); |
8a21415b ML |
1478 | } |
1479 | ||
1480 | /* | |
1481 | * Evaluate a subscript index. | |
1482 | */ | |
1483 | ||
0022c355 | 1484 | public int evalindex(s, base, i) |
8a21415b | 1485 | Symbol s; |
0022c355 | 1486 | Address base; |
8a21415b ML |
1487 | long i; |
1488 | { | |
2fd0f574 | 1489 | Symbol t; |
0022c355 | 1490 | int r; |
f128b014 | 1491 | |
2fd0f574 | 1492 | t = rtype(s); |
0022c355 ML |
1493 | if (t->language == nil or t->language == primlang) { |
1494 | r = ((*language_op(findlanguage(".s"), L_EVALAREF)) (s, base, i)); | |
2fd0f574 | 1495 | } else { |
0022c355 | 1496 | r = ((*language_op(t->language, L_EVALAREF)) (s, base, i)); |
2fd0f574 | 1497 | } |
0022c355 | 1498 | return r; |
8a21415b ML |
1499 | } |
1500 | ||
1501 | /* | |
1502 | * Check to see if a tree is boolean-valued, if not it's an error. | |
1503 | */ | |
1504 | ||
1505 | public chkboolean(p) | |
1506 | register Node p; | |
1507 | { | |
1508 | if (p->nodetype != t_boolean) { | |
1509 | beginerrmsg(); | |
1510 | fprintf(stderr, "found "); | |
1511 | prtree(stderr, p); | |
1512 | fprintf(stderr, ", expected boolean expression"); | |
1513 | enderrmsg(); | |
1514 | } | |
1515 | } | |
1516 | ||
8a21415b | 1517 | /* |
2fd0f574 | 1518 | * Construct a node for the type of a string. |
8a21415b ML |
1519 | */ |
1520 | ||
1521 | private Symbol mkstring(str) | |
1522 | String str; | |
1523 | { | |
8a21415b ML |
1524 | register Symbol s; |
1525 | ||
0022c355 ML |
1526 | s = newSymbol(nil, 0, ARRAY, t_char, nil); |
1527 | s->chain = newSymbol(nil, 0, RANGE, t_int, nil); | |
1528 | s->chain->language = s->language; | |
1529 | s->chain->symvalue.rangev.lower = 1; | |
1530 | s->chain->symvalue.rangev.upper = strlen(str) + 1; | |
8a21415b ML |
1531 | return s; |
1532 | } | |
1533 | ||
1534 | /* | |
1535 | * Free up the space allocated for a string type. | |
1536 | */ | |
1537 | ||
1538 | public unmkstring(s) | |
1539 | Symbol s; | |
1540 | { | |
1541 | dispose(s->chain); | |
1542 | } | |
1543 | ||
1544 | /* | |
0022c355 ML |
1545 | * Figure out the "current" variable or function being referred to |
1546 | * by the name n. | |
8a21415b ML |
1547 | */ |
1548 | ||
0022c355 ML |
1549 | private boolean stwhich(), dynwhich(); |
1550 | ||
1551 | public Symbol which (n) | |
8a21415b ML |
1552 | Name n; |
1553 | { | |
0022c355 | 1554 | Symbol s; |
8a21415b | 1555 | |
0022c355 | 1556 | s = lookup(n); |
8a21415b ML |
1557 | if (s == nil) { |
1558 | error("\"%s\" is not defined", ident(n)); | |
0022c355 ML |
1559 | } else if (not stwhich(&s) and isambiguous(s) and not dynwhich(&s)) { |
1560 | printf("[using "); | |
1561 | printname(stdout, s); | |
1562 | printf("]\n"); | |
1563 | } | |
1564 | return s; | |
1565 | } | |
1566 | ||
1567 | /* | |
1568 | * Static search. | |
1569 | */ | |
1570 | ||
1571 | private boolean stwhich (var_s) | |
1572 | Symbol *var_s; | |
1573 | { | |
1574 | Name n; /* name of desired symbol */ | |
1575 | Symbol s; /* iteration variable for symbols with name n */ | |
1576 | Symbol f; /* iteration variable for blocks containing s */ | |
1577 | integer count; /* number of levels from s->block to curfunc */ | |
1578 | Symbol t; /* current best answer for stwhich(n) */ | |
1579 | integer mincount; /* relative level for current best answer (t) */ | |
1580 | boolean b; /* return value, true if symbol found */ | |
1581 | ||
1582 | s = *var_s; | |
1583 | n = s->name; | |
1584 | t = s; | |
1585 | mincount = 10000; /* force first match to set mincount */ | |
1586 | do { | |
1587 | if (s->name == n and s->class != FIELD and s->class != TAG) { | |
1588 | f = curfunc; | |
1589 | count = 0; | |
1590 | while (f != nil and f != s->block) { | |
1591 | ++count; | |
1592 | f = f->block; | |
1593 | } | |
1594 | if (f != nil and count < mincount) { | |
1595 | t = s; | |
1596 | mincount = count; | |
1597 | b = true; | |
1598 | } | |
1599 | } | |
1600 | s = s->next_sym; | |
1601 | } while (s != nil); | |
1602 | if (mincount != 10000) { | |
1603 | *var_s = t; | |
1604 | b = true; | |
8a21415b | 1605 | } else { |
0022c355 ML |
1606 | b = false; |
1607 | } | |
1608 | return b; | |
1609 | } | |
1610 | ||
1611 | /* | |
1612 | * Dynamic search. | |
1613 | */ | |
1614 | ||
1615 | private boolean dynwhich (var_s) | |
1616 | Symbol *var_s; | |
1617 | { | |
1618 | Name n; /* name of desired symbol */ | |
1619 | Symbol s; /* iteration variable for possible symbols */ | |
1620 | Symbol f; /* iteration variable for active functions */ | |
1621 | Frame frp; /* frame associated with stack walk */ | |
1622 | boolean b; /* return value */ | |
1623 | ||
1624 | f = curfunc; | |
1625 | frp = curfuncframe(); | |
1626 | n = (*var_s)->name; | |
1627 | b = false; | |
1628 | if (frp != nil) { | |
1629 | frp = nextfunc(frp, &f); | |
1630 | while (frp != nil) { | |
1631 | s = *var_s; | |
1632 | while (s != nil and | |
1633 | ( | |
1634 | s->name != n or s->block != f or | |
1635 | s->class == FIELD or s->class == TAG | |
1636 | ) | |
1637 | ) { | |
1638 | s = s->next_sym; | |
1639 | } | |
1640 | if (s != nil) { | |
1641 | *var_s = s; | |
1642 | b = true; | |
1643 | break; | |
1644 | } | |
1645 | if (f == program) { | |
1646 | break; | |
1647 | } | |
1648 | frp = nextfunc(frp, &f); | |
8a21415b ML |
1649 | } |
1650 | } | |
0022c355 | 1651 | return b; |
8a21415b ML |
1652 | } |
1653 | ||
1654 | /* | |
0022c355 | 1655 | * Find the symbol that has the same name and scope as the |
8a21415b ML |
1656 | * given symbol but is of the given field. Return nil if there is none. |
1657 | */ | |
1658 | ||
0022c355 | 1659 | public Symbol findfield (fieldname, record) |
8a21415b ML |
1660 | Name fieldname; |
1661 | Symbol record; | |
1662 | { | |
1663 | register Symbol t; | |
1664 | ||
1665 | t = rtype(record)->chain; | |
1666 | while (t != nil and t->name != fieldname) { | |
1667 | t = t->chain; | |
1668 | } | |
1669 | return t; | |
1670 | } | |
f128b014 AF |
1671 | |
1672 | public Boolean getbound(s,off,type,valp) | |
1673 | Symbol s; | |
1674 | int off; | |
1675 | Rangetype type; | |
1676 | int *valp; | |
1677 | { | |
1678 | Frame frp; | |
1679 | Address addr; | |
1680 | Symbol cur; | |
1681 | ||
1682 | if (not isactive(s->block)) { | |
1683 | return(false); | |
1684 | } | |
1685 | cur = s->block; | |
1686 | while (cur != nil and cur->class == MODULE) { /* WHY*/ | |
1687 | cur = cur->block; | |
1688 | } | |
1689 | if(cur == nil) { | |
1690 | cur = whatblock(pc); | |
1691 | } | |
1692 | frp = findframe(cur); | |
1693 | if (frp == nil) { | |
1694 | return(false); | |
1695 | } | |
1696 | if(type == R_TEMP) addr = locals_base(frp) + off; | |
1697 | else if (type == R_ARG) addr = args_base(frp) + off; | |
1698 | else return(false); | |
1699 | dread(valp,addr,sizeof(long)); | |
1700 | return(true); | |
1701 | } |