![[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] / 43BSDReno / pgrm / dbx|
Return to symbols.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / pgrm / dbx |
1.1 root 1: /*
2: * Copyright (c) 1983 The Regents of the University of California.
3: * All rights reserved.
4: *
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.
18: */
19:
20: #ifndef lint
21: static char sccsid[] = "@(#)symbols.c 5.8 (Berkeley) 6/1/90";
22: #endif /* not lint */
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"
48: #include "tree.h"
49:
50: /*
51: * Symbol classes
52: */
53:
54: typedef enum {
55: BADUSE, CONST, TYPE, VAR, ARRAY, OPENARRAY, DYNARRAY, SUBARRAY,
56: PTRFILE, RECORD, FIELD,
57: PROC, FUNC, FVAR, REF, PTR, FILET, SET, RANGE,
58: LABEL, WITHPTR, SCAL, STR, PROG, IMPROPER, VARNT,
59: FPROC, FFUNC, MODULE, TAG, COMMON, EXTREF, TYPEREF
60: } Symclass;
61:
62: typedef enum { R_CONST, R_TEMP, R_ARG, R_ADJUST } Rangetype;
63:
64: #define INREG 0
65: #define STK 1
66: #define EXT 2
67:
68: typedef unsigned int Storage;
69:
70: struct Symbol {
71: Name name;
72: Language language;
73: Symclass class : 8;
74: Storage storage : 2;
75: unsigned int level : 6; /* for variables stored on stack only */
76: Symbol type;
77: Symbol chain;
78: union {
79: Node constval; /* value of constant symbol */
80: int offset; /* variable address */
81: long iconval; /* integer constant value */
82: double fconval; /* floating constant value */
83: int ndims; /* no. of dimensions for dynamic/sub-arrays */
84: struct { /* field offset and size (both in bits) */
85: int offset;
86: int length;
87: } field;
88: struct { /* common offset and chain; used to relocate */
89: int offset; /* vars in global BSS */
90: Symbol chain;
91: } common;
92: struct { /* range bounds */
93: Rangetype lowertype : 16;
94: Rangetype uppertype : 16;
95: long lower;
96: long upper;
97: } rangev;
98: struct {
99: int offset : 16; /* offset for of function value */
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;
104: Address beginaddr; /* address of function code */
105: } funcv;
106: struct { /* variant record info */
107: int size;
108: Symbol vtorec;
109: Symbol vtag;
110: } varnt;
111: String typeref; /* type defined by "<module>:<type>" */
112: Symbol extref; /* indirect symbol for external reference */
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;
127: Symbol t_addr;
128:
129: Symbol program;
130: Symbol curfunc;
131:
132: boolean showaggrs;
133:
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: )
140: #define isroutine(s) (Boolean) ( \
141: s->class == FUNC or s->class == PROC \
142: )
143:
144: #define nosource(f) (not (f)->symvalue.funcv.src)
145: #define isinline(f) ((f)->symvalue.funcv.inline)
146:
147: #define isreg(s) (s->storage == INREG)
148:
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.
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.
173: */
174:
175: #define HASHTABLESIZE 8192
176:
177: private Symbol hashtab[HASHTABLESIZE];
178:
179: #define hash(name) ((((unsigned) name) >> 2) & (HASHTABLESIZE - 1))
180:
181: /*
182: * Allocate a new symbol.
183: */
184:
185: #define SYMBLOCKSIZE 1000
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;
194:
195: public Symbol symbol_alloc()
196: {
197: register Sympool newpool;
198:
199: if (nleft <= 0) {
200: newpool = new(Sympool);
201: bzero(newpool, sizeof(*newpool));
202: newpool->prevpool = sympool;
203: sympool = newpool;
204: nleft = SYMBLOCKSIZE;
205: }
206: --nleft;
207: return &(sympool->sym[nleft]);
208: }
209:
210: public symbol_dump (func)
211: Symbol func;
212: {
213: register Symbol s;
214: register integer i;
215:
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: }
224: }
225:
226: /*
227: * Free all the symbols currently allocated.
228: */
229:
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;
263: s->language = primlang;
264: s->storage = EXT;
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:
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:
335: /*
336: * Dump out all the variables associated with the given
337: * procedure, function, or program associated with the given stack frame.
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:
370: private Symbol maketype(name, lower, upper)
371: String name;
372: long lower;
373: long upper;
374: {
375: register Symbol s;
376: Name n;
377:
378: if (name == nil) {
379: n = nil;
380: } else {
381: n = identname(name, true);
382: }
383: s = insert(n);
384: s->language = primlang;
385: s->level = 0;
386: s->class = TYPE;
387: s->type = nil;
388: s->chain = nil;
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: /*
396: * Create the builtin symbols.
397: */
398:
399: public symbols_init ()
400: {
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;
423: }
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) {
436: if (t->class == VAR or t->class == CONST or
437: t->class == FIELD or t->class == REF
438: ) {
439: t = t->type;
440: }
441: if (t->class == TYPEREF) {
442: resolveRef(t);
443: }
444: while (t->class == TYPE or t->class == TAG) {
445: t = t->type;
446: if (t->class == TYPEREF) {
447: resolveRef(t);
448: }
449: }
450: }
451: return t;
452: }
453:
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:
532: public integer regnum (s)
533: Symbol s;
534: {
535: integer r;
536:
537: checkref(s);
538: if (s->storage == INREG) {
539: r = s->symvalue.offset;
540: } else {
541: r = -1;
542: }
543: return r;
544: }
545:
546: public Symbol container(s)
547: Symbol s;
548: {
549: checkref(s);
550: return s->block;
551: }
552:
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:
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:
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)
577:
578: public Address address (s, frame)
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) {
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: }
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:
626: public defregname (n, r)
627: Name n;
628: integer r;
629: {
630: Symbol s;
631:
632: s = insert(n);
633: s->language = t_addr->language;
634: s->class = VAR;
635: s->storage = INREG;
636: s->level = 3;
637: s->type = t_addr;
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: }
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: }
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:
692: #define MAXUCHAR 255
693: #define MAXUSHORT 65535L
694: #define MINCHAR -128
695: #define MAXCHAR 127
696: #define MINSHORT -32768
697: #define MAXSHORT 32767
698:
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 {
729: error("[internal error: unexpected array bound type]");
730: }
731: }
732:
733: public integer size(sym)
734: Symbol sym;
735: {
736: register Symbol s, t, u;
737: register integer nel, elsize;
738: long lower, upper;
739: integer r, off, len;
740:
741: t = sym;
742: checkref(t);
743: if (t->class == TYPEREF) {
744: resolveRef(t);
745: }
746: switch (t->class) {
747: case RANGE:
748: lower = t->symvalue.rangev.lower;
749: upper = t->symvalue.rangev.upper;
750: if (upper == 0 and lower > 0) {
751: /* real */
752: r = lower;
753: } else if (lower > upper) {
754: /* unsigned long */
755: r = sizeof(long);
756: } else if (
757: (lower >= MINCHAR and upper <= MAXCHAR) or
758: (lower >= 0 and upper <= MAXUCHAR)
759: ) {
760: r = sizeof(char);
761: } else if (
762: (lower >= MINSHORT and upper <= MAXSHORT) or
763: (lower >= 0 and upper <= MAXUSHORT)
764: ) {
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) {
775: u = rtype(t);
776: findbounds(u, &lower, &upper);
777: nel *= (upper-lower+1);
778: }
779: r = nel*elsize;
780: break;
781:
782: case OPENARRAY:
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:
791: case REF:
792: case VAR:
793: r = size(t->type);
794: /*
795: *
796: if (r < sizeof(Word) and isparam(t)) {
797: r = sizeof(Word);
798: }
799: */
800: break;
801:
802: case FVAR:
803: case CONST:
804: case TAG:
805: r = size(t->type);
806: break;
807:
808: case TYPE:
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
815: if (t->type->class == PTR and t->type->type->class == BADUSE) {
816: findtype(t);
817: }
818: # endif
819: r = size(t->type);
820: break;
821:
822: case FIELD:
823: off = t->symvalue.field.offset;
824: len = t->symvalue.field.length;
825: r = (off + len + 7) div 8 - (off div 8);
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:
837: case TYPEREF:
838: case FILET:
839: r = sizeof(Word);
840: break;
841:
842: case SCAL:
843: r = sizeof(Word);
844: /*
845: *
846: if (t->symvalue.iconval > 255) {
847: r = sizeof(short);
848: } else {
849: r = sizeof(char);
850: }
851: *
852: */
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:
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:
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:
893: default:
894: if (ord(t->class) > ord(TYPEREF)) {
895: panic("size: bad class (%d)", ord(t->class));
896: } else {
897: fprintf(stderr, "can't compute size of a %s\n", classname(t));
898: }
899: r = 0;
900: break;
901: }
902: return r;
903: }
904:
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);
919: if (t->class == OPENARRAY) {
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:
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: /*
950: * Test if a type is an open array parameter type.
951: */
952:
953: public boolean isopenarray (type)
954: Symbol type;
955: {
956: Symbol t;
957:
958: t = rtype(type);
959: return (boolean) (t->class == OPENARRAY);
960: }
961:
962: /*
963: * Test if a symbol is a var parameter, i.e. has class REF.
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)
978: Symbol s;
979: {
980: return (Boolean) (s->class == VAR or s->class == FVAR or s->class == REF);
981: }
982:
983: /*
984: * Test if a symbol is a constant.
985: */
986:
987: public Boolean isconst(s)
988: Symbol s;
989: {
990: return (Boolean) (s->class == CONST);
991: }
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:
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:
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:
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;
1075: Symbol rt1, rt2;
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) {
1086: if (t2->language == nil) {
1087: b = false;
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));
1096: } else {
1097: b = (boolean) (*language_op(t2->language, L_TYPEMATCH))(t1, t2);
1098: }
1099: } else {
1100: b = (boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2);
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: {
1113: register Symbol t;
1114: Boolean b;
1115:
1116: t = type;
1117: if (t == nil) {
1118: b = false;
1119: } else {
1120: b = (Boolean) (
1121: t->class == TYPE and streq(ident(t->name), name)
1122: );
1123: }
1124: return b;
1125: }
1126:
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:
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();
1168:
1169: /*
1170: * Determine the type of a parse tree.
1171: *
1172: * Also make some symbol-dependent changes to the tree such as
1173: * removing indirection for constant or register symbols.
1174: */
1175:
1176: public assigntypes (p)
1177: register Node p;
1178: {
1179: register Node p1;
1180: register Symbol s;
1181:
1182: switch (p->op) {
1183: case O_SYM:
1184: p->nodetype = p->value.sym;
1185: break;
1186:
1187: case O_LCON:
1188: p->nodetype = t_int;
1189: break;
1190:
1191: case O_CCON:
1192: p->nodetype = t_char;
1193: break;
1194:
1195: case O_FCON:
1196: p->nodetype = t_real;
1197: break;
1198:
1199: case O_SCON:
1200: p->nodetype = mkstring(p->value.scon);
1201: break;
1202:
1203: case O_INDIR:
1204: p1 = p->value.arg[0];
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: }
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) {
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);
1229: } else if (p1->value.sym->class == CONST) {
1230: p->op = p1->op;
1231: p->value = p1->value;
1232: p->nodetype = p1->nodetype;
1233: dispose(p1);
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:
1250: case O_COMMA:
1251: p->nodetype = p->value.arg[0]->nodetype;
1252: break;
1253:
1254: case O_CALLPROC:
1255: case O_CALL:
1256: p1 = p->value.arg[0];
1257: p->nodetype = rtype(p1->nodetype)->type;
1258: break;
1259:
1260: case O_TYPERENAME:
1261: p->nodetype = p->value.arg[1]->nodetype;
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();
1273: fprintf(stderr, "\"");
1274: prtree(stderr, p->value.arg[0]);
1275: fprintf(stderr, "\" is improper type");
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:
1287: binaryop(p, nil);
1288: break;
1289:
1290: case O_LT:
1291: case O_LE:
1292: case O_GT:
1293: case O_GE:
1294: case O_EQ:
1295: case O_NE:
1296: binaryop(p, t_boolean);
1297: break;
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:
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:
1377: /*
1378: * Convert a tree to a type via a conversion operator;
1379: * if this isn't possible generate an error.
1380: */
1381:
1382: private convert(tp, typeto, op)
1383: Node *tp;
1384: Symbol typeto;
1385: Operator op;
1386: {
1387: Node tree;
1388: Symbol s, t;
1389:
1390: tree = *tp;
1391: s = rtype(tree->nodetype);
1392: t = rtype(typeto);
1393: if (compatible(t, t_real) and compatible(s, t_int)) {
1394: /* we can convert int => floating but not the reverse */
1395: tree = build(op, tree);
1396: } else if (not compatible(s, t)) {
1397: beginerrmsg();
1398: prtree(stderr, tree);
1399: fprintf(stderr, ": illegal type in operation");
1400: enderrmsg();
1401: }
1402: *tp = tree;
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: {
1418: register Node rec, p;
1419: register Symbol s, t;
1420:
1421: rec = record;
1422: if (isblock(rec->nodetype)) {
1423: find(s, fieldname) where
1424: s->block == rec->nodetype and
1425: s->class != FIELD
1426: endfind(s);
1427: if (s == nil) {
1428: beginerrmsg();
1429: fprintf(stderr, "\"%s\" is not defined in ", ident(fieldname));
1430: printname(stderr, rec->nodetype);
1431: enderrmsg();
1432: }
1433: p = new(Node);
1434: p->op = O_SYM;
1435: p->value.sym = s;
1436: p->nodetype = s;
1437: } else {
1438: p = rec;
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));
1448: prtree(stderr, rec);
1449: enderrmsg();
1450: }
1451: if (t->class != PTR or isreg(rec->nodetype)) {
1452: p = unrval(p);
1453: }
1454: p->nodetype = t_addr;
1455: p = build(O_DOT, p, build(O_SYM, s));
1456: }
1457: return build(O_RVAL, p);
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: {
1468: Symbol t;
1469: Node p;
1470:
1471: t = rtype(a->nodetype);
1472: if (t->language == nil or t->language == primlang) {
1473: p = (Node) (*language_op(findlanguage(".s"), L_BUILDAREF))(a, slist);
1474: } else {
1475: p = (Node) (*language_op(t->language, L_BUILDAREF))(a, slist);
1476: }
1477: return build(O_RVAL, p);
1478: }
1479:
1480: /*
1481: * Evaluate a subscript index.
1482: */
1483:
1484: public int evalindex(s, base, i)
1485: Symbol s;
1486: Address base;
1487: long i;
1488: {
1489: Symbol t;
1490: int r;
1491:
1492: t = rtype(s);
1493: if (t->language == nil or t->language == primlang) {
1494: r = ((*language_op(findlanguage(".s"), L_EVALAREF)) (s, base, i));
1495: } else {
1496: r = ((*language_op(t->language, L_EVALAREF)) (s, base, i));
1497: }
1498: return r;
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:
1517: /*
1518: * Construct a node for the type of a string.
1519: */
1520:
1521: private Symbol mkstring(str)
1522: String str;
1523: {
1524: register Symbol s;
1525:
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;
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: /*
1545: * Figure out the "current" variable or function being referred to
1546: * by the name n.
1547: */
1548:
1549: private boolean stwhich(), dynwhich();
1550:
1551: public Symbol which (n)
1552: Name n;
1553: {
1554: Symbol s;
1555:
1556: s = lookup(n);
1557: if (s == nil) {
1558: error("\"%s\" is not defined", ident(n));
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;
1605: } else {
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);
1649: }
1650: }
1651: return b;
1652: }
1653:
1654: /*
1655: * Find the symbol that has the same name and scope as the
1656: * given symbol but is of the given field. Return nil if there is none.
1657: */
1658:
1659: public Symbol findfield (fieldname, record)
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: }
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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.