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