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