![[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] / 42BSD / ucb / dbx|
Return to symbols.c CVS log | Up to [CSRG BSD Unix] / 42BSD / ucb / dbx |
1.1 root 1: /* Copyright (c) 1982 Regents of the University of California */
2:
3: static char sccsid[] = "@(#)symbols.c 1.11 8/16/83";
4:
5: /*
6: * Symbol management.
7: */
8:
9: #include "defs.h"
10: #include "symbols.h"
11: #include "languages.h"
12: #include "printsym.h"
13: #include "tree.h"
14: #include "operators.h"
15: #include "eval.h"
16: #include "mappings.h"
17: #include "events.h"
18: #include "process.h"
19: #include "runtime.h"
20: #include "machine.h"
21: #include "names.h"
22:
23: #ifndef public
24: typedef struct Symbol *Symbol;
25:
26: #include "machine.h"
27: #include "names.h"
28: #include "languages.h"
29:
30: /*
31: * Symbol classes
32: */
33:
34: typedef enum {
35: BADUSE, CONST, TYPE, VAR, ARRAY, PTRFILE, RECORD, FIELD,
36: PROC, FUNC, FVAR, REF, PTR, FILET, SET, RANGE,
37: LABEL, WITHPTR, SCAL, STR, PROG, IMPROPER, VARNT,
38: FPROC, FFUNC, MODULE, TAG, COMMON, TYPEREF
39: } Symclass;
40:
41: typedef enum { R_CONST, R_TEMP, R_ARG, R_ADJUST } Rangetype;
42:
43: struct Symbol {
44: Name name;
45: Language language;
46: Symclass class : 8;
47: Integer level : 8;
48: Symbol type;
49: Symbol chain;
50: union {
51: int offset; /* variable address */
52: long iconval; /* integer constant value */
53: double fconval; /* floating constant value */
54: struct { /* field offset and size (both in bits) */
55: int offset;
56: int length;
57: } field;
58: struct { /* common offset and chain; used to relocate */
59: int offset; /* vars in global BSS */
60: Symbol chain;
61: } common;
62: struct { /* range bounds */
63: Rangetype lowertype : 16;
64: Rangetype uppertype : 16;
65: long lower;
66: long upper;
67: } rangev;
68: struct {
69: int offset : 16; /* offset for of function value */
70: Boolean src : 8; /* true if there is source line info */
71: Boolean inline : 8; /* true if no separate act. rec. */
72: Address beginaddr; /* address of function code */
73: } funcv;
74: struct { /* variant record info */
75: int size;
76: Symbol vtorec;
77: Symbol vtag;
78: } varnt;
79: } symvalue;
80: Symbol block; /* symbol containing this symbol */
81: Symbol next_sym; /* hash chain */
82: };
83:
84: /*
85: * Basic types.
86: */
87:
88: Symbol t_boolean;
89: Symbol t_char;
90: Symbol t_int;
91: Symbol t_real;
92: Symbol t_nil;
93:
94: Symbol program;
95: Symbol curfunc;
96:
97: #define symname(s) ident(s->name)
98: #define codeloc(f) ((f)->symvalue.funcv.beginaddr)
99: #define isblock(s) (Boolean) ( \
100: s->class == FUNC or s->class == PROC or \
101: s->class == MODULE or s->class == PROG \
102: )
103:
104: #define nosource(f) (not (f)->symvalue.funcv.src)
105: #define isinline(f) ((f)->symvalue.funcv.inline)
106:
107: #include "tree.h"
108:
109: /*
110: * Some macros to make finding a symbol with certain attributes.
111: */
112:
113: #define find(s, withname) \
114: { \
115: s = lookup(withname); \
116: while (s != nil and not (s->name == (withname) and
117:
118: #define where /* qualification */
119:
120: #define endfind(s) )) { \
121: s = s->next_sym; \
122: } \
123: }
124:
125: #endif
126:
127: /*
128: * Symbol table structure currently does not support deletions.
129: */
130:
131: #define HASHTABLESIZE 2003
132:
133: private Symbol hashtab[HASHTABLESIZE];
134:
135: #define hash(name) ((((unsigned) name) >> 2) mod HASHTABLESIZE)
136:
137: /*
138: * Allocate a new symbol.
139: */
140:
141: #define SYMBLOCKSIZE 100
142:
143: typedef struct Sympool {
144: struct Symbol sym[SYMBLOCKSIZE];
145: struct Sympool *prevpool;
146: } *Sympool;
147:
148: private Sympool sympool = nil;
149: private Integer nleft = 0;
150:
151: public Symbol symbol_alloc()
152: {
153: register Sympool newpool;
154:
155: if (nleft <= 0) {
156: newpool = new(Sympool);
157: bzero(newpool, sizeof(newpool));
158: newpool->prevpool = sympool;
159: sympool = newpool;
160: nleft = SYMBLOCKSIZE;
161: }
162: --nleft;
163: return &(sympool->sym[nleft]);
164: }
165:
166:
167: public symbol_dump(func)
168: Symbol func;
169: {
170: register Symbol s;
171: register Integer i;
172:
173: printf(" symbols in %s \n",symname(func));
174: for (i = 0; i< HASHTABLESIZE; i++) {
175: for (s = hashtab[i]; s != nil; s = s->next_sym) {
176: if (s->block == func) {
177: psym(s);
178: }
179: }
180: }
181: }
182:
183: /*
184: * Free all the symbols currently allocated.
185: */
186:
187: public symbol_free()
188: {
189: Sympool s, t;
190: register Integer i;
191:
192: s = sympool;
193: while (s != nil) {
194: t = s->prevpool;
195: dispose(s);
196: s = t;
197: }
198: for (i = 0; i < HASHTABLESIZE; i++) {
199: hashtab[i] = nil;
200: }
201: sympool = nil;
202: nleft = 0;
203: }
204:
205: /*
206: * Create a new symbol with the given attributes.
207: */
208:
209: public Symbol newSymbol(name, blevel, class, type, chain)
210: Name name;
211: Integer blevel;
212: Symclass class;
213: Symbol type;
214: Symbol chain;
215: {
216: register Symbol s;
217:
218: s = symbol_alloc();
219: s->name = name;
220: s->level = blevel;
221: s->class = class;
222: s->type = type;
223: s->chain = chain;
224: return s;
225: }
226:
227: /*
228: * Insert a symbol into the hash table.
229: */
230:
231: public Symbol insert(name)
232: Name name;
233: {
234: register Symbol s;
235: register unsigned int h;
236:
237: h = hash(name);
238: s = symbol_alloc();
239: s->name = name;
240: s->next_sym = hashtab[h];
241: hashtab[h] = s;
242: return s;
243: }
244:
245: /*
246: * Symbol lookup.
247: */
248:
249: public Symbol lookup(name)
250: Name name;
251: {
252: register Symbol s;
253: register unsigned int h;
254:
255: h = hash(name);
256: s = hashtab[h];
257: while (s != nil and s->name != name) {
258: s = s->next_sym;
259: }
260: return s;
261: }
262:
263: /*
264: * Dump out all the variables associated with the given
265: * procedure, function, or program at the given recursive level.
266: *
267: * This is quite inefficient. We traverse the entire symbol table
268: * each time we're called. The assumption is that this routine
269: * won't be called frequently enough to merit improved performance.
270: */
271:
272: public dumpvars(f, frame)
273: Symbol f;
274: Frame frame;
275: {
276: register Integer i;
277: register Symbol s;
278:
279: for (i = 0; i < HASHTABLESIZE; i++) {
280: for (s = hashtab[i]; s != nil; s = s->next_sym) {
281: if (container(s) == f) {
282: if (should_print(s)) {
283: printv(s, frame);
284: putchar('\n');
285: } else if (s->class == MODULE) {
286: dumpvars(s, frame);
287: }
288: }
289: }
290: }
291: }
292:
293: /*
294: * Create base types.
295: */
296:
297: public symbols_init()
298: {
299: t_boolean = maketype("$boolean", 0L, 1L);
300: t_int = maketype("$integer", 0x80000000L, 0x7fffffffL);
301: t_char = maketype("$char", 0L, 127L);
302: t_real = maketype("$real", 8L, 0L);
303: t_nil = maketype("$nil", 0L, 0L);
304: }
305:
306: /*
307: * Create a builtin type.
308: * Builtin types are circular in that btype->type->type = btype.
309: */
310:
311: public Symbol maketype(name, lower, upper)
312: String name;
313: long lower;
314: long upper;
315: {
316: register Symbol s;
317:
318: s = newSymbol(identname(name, true), 0, TYPE, nil, nil);
319: s->language = findlanguage(".c");
320: s->type = newSymbol(nil, 0, RANGE, s, nil);
321: s->type->symvalue.rangev.lower = lower;
322: s->type->symvalue.rangev.upper = upper;
323: return s;
324: }
325:
326: /*
327: * These functions are now compiled inline.
328: *
329: * public String symname(s)
330: Symbol s;
331: {
332: checkref(s);
333: return ident(s->name);
334: }
335:
336: *
337: * public Address codeloc(f)
338: Symbol f;
339: {
340: checkref(f);
341: if (not isblock(f)) {
342: panic("codeloc: \"%s\" is not a block", ident(f->name));
343: }
344: return f->symvalue.funcv.beginaddr;
345: }
346: *
347: */
348:
349: /*
350: * Reduce type to avoid worrying about type names.
351: */
352:
353: public Symbol rtype(type)
354: Symbol type;
355: {
356: register Symbol t;
357:
358: t = type;
359: if (t != nil) {
360: if (t->class == VAR or t->class == FIELD or t->class == REF ) {
361: t = t->type;
362: }
363: while (t->class == TYPE or t->class == TAG) {
364: t = t->type;
365: }
366: }
367: return t;
368: }
369:
370: public Integer level(s)
371: Symbol s;
372: {
373: checkref(s);
374: return s->level;
375: }
376:
377: public Symbol container(s)
378: Symbol s;
379: {
380: checkref(s);
381: return s->block;
382: }
383:
384: /*
385: * Return the object address of the given symbol.
386: *
387: * There are the following possibilities:
388: *
389: * globals - just take offset
390: * locals - take offset from locals base
391: * arguments - take offset from argument base
392: * register - offset is register number
393: */
394:
395: #define isglobal(s) (s->level == 1 or s->level == 2)
396: #define islocaloff(s) (s->level >= 3 and s->symvalue.offset < 0)
397: #define isparamoff(s) (s->level >= 3 and s->symvalue.offset >= 0)
398: #define isreg(s) (s->level < 0)
399:
400: public Address address(s, frame)
401: Symbol s;
402: Frame frame;
403: {
404: register Frame frp;
405: register Address addr;
406: register Symbol cur;
407:
408: checkref(s);
409: if (not isactive(s->block)) {
410: error("\"%s\" is not currently defined", symname(s));
411: } else if (isglobal(s)) {
412: addr = s->symvalue.offset;
413: } else {
414: frp = frame;
415: if (frp == nil) {
416: cur = s->block;
417: while (cur != nil and cur->class == MODULE) {
418: cur = cur->block;
419: }
420: if (cur == nil) {
421: cur = whatblock(pc);
422: }
423: frp = findframe(cur);
424: if (frp == nil) {
425: panic("unexpected nil frame for \"%s\"", symname(s));
426: }
427: }
428: if (islocaloff(s)) {
429: addr = locals_base(frp) + s->symvalue.offset;
430: } else if (isparamoff(s)) {
431: addr = args_base(frp) + s->symvalue.offset;
432: } else if (isreg(s)) {
433: addr = savereg(s->symvalue.offset, frp);
434: } else {
435: panic("address: bad symbol \"%s\"", symname(s));
436: }
437: }
438: return addr;
439: }
440:
441: /*
442: * Define a symbol used to access register values.
443: */
444:
445: public defregname(n, r)
446: Name n;
447: Integer r;
448: {
449: register Symbol s, t;
450:
451: s = insert(n);
452: t = newSymbol(nil, 0, PTR, t_int, nil);
453: t->language = findlanguage(".s");
454: s->language = t->language;
455: s->class = VAR;
456: s->level = -3;
457: s->type = t;
458: s->block = program;
459: s->symvalue.offset = r;
460: }
461:
462: /*
463: * Resolve an "abstract" type reference.
464: *
465: * It is possible in C to define a pointer to a type, but never define
466: * the type in a particular source file. Here we try to resolve
467: * the type definition. This is problematic, it is possible to
468: * have multiple, different definitions for the same name type.
469: */
470:
471: public findtype(s)
472: Symbol s;
473: {
474: register Symbol t, u, prev;
475:
476: u = s;
477: prev = nil;
478: while (u != nil and u->class != BADUSE) {
479: if (u->name != nil) {
480: prev = u;
481: }
482: u = u->type;
483: }
484: if (prev == nil) {
485: error("couldn't find link to type reference");
486: }
487: find(t, prev->name) where
488: t->type != nil and t->class == prev->class and
489: t->type->class != BADUSE and t->block->class == MODULE
490: endfind(t);
491: if (t == nil) {
492: error("couldn't resolve reference");
493: } else {
494: prev->type = t->type;
495: }
496: }
497:
498: /*
499: * Find the size in bytes of the given type.
500: *
501: * This is probably the WRONG thing to do. The size should be kept
502: * as an attribute in the symbol information as is done for structures
503: * and fields. I haven't gotten around to cleaning this up yet.
504: */
505:
506: #define MAXUCHAR 255
507: #define MAXUSHORT 65535L
508: #define MINCHAR -128
509: #define MAXCHAR 127
510: #define MINSHORT -32768
511: #define MAXSHORT 32767
512:
513: public Integer size(sym)
514: Symbol sym;
515: {
516: register Symbol s, t;
517: register int nel, elsize;
518: long lower, upper;
519: int r;
520:
521: t = sym;
522: checkref(t);
523: switch (t->class) {
524: case RANGE:
525: lower = t->symvalue.rangev.lower;
526: upper = t->symvalue.rangev.upper;
527: if (upper == 0 and lower > 0) { /* real */
528: r = lower;
529: } else if (
530: (lower >= MINCHAR and upper <= MAXCHAR) or
531: (lower >= 0 and upper <= MAXUCHAR)
532: ) {
533: r = sizeof(char);
534: } else if (
535: (lower >= MINSHORT and upper <= MAXSHORT) or
536: (lower >= 0 and upper <= MAXUSHORT)
537: ) {
538: r = sizeof(short);
539: } else {
540: r = sizeof(long);
541: }
542: break;
543:
544: case ARRAY:
545: elsize = size(t->type);
546: nel = 1;
547: for (t = t->chain; t != nil; t = t->chain) {
548: if (t->symvalue.rangev.lowertype == R_ARG or
549: t->symvalue.rangev.lowertype == R_TEMP) {
550: if (not getbound(t, t->symvalue.rangev.lower,
551: t->symvalue.rangev.lowertype, &lower)) {
552: error("dynamic bounds not currently available");
553: }
554: } else {
555: lower = t->symvalue.rangev.lower;
556: }
557: if (t->symvalue.rangev.uppertype == R_ARG or
558: t->symvalue.rangev.uppertype == R_TEMP) {
559: if (not getbound(t, t->symvalue.rangev.upper,
560: t->symvalue.rangev.uppertype, &upper)) {
561: error("dynamic bounds nor currently available");
562: }
563: } else {
564: upper = t->symvalue.rangev.upper;
565: }
566: nel *= (upper-lower+1);
567: }
568: r = nel*elsize;
569: break;
570:
571: case REF:
572: case VAR:
573: case FVAR:
574: r = size(t->type);
575: /*
576: *
577: if (r < sizeof(Word) and isparam(t)) {
578: r = sizeof(Word);
579: }
580: */
581: break;
582:
583: case CONST:
584: r = size(t->type);
585: break;
586:
587: case TYPE:
588: if (t->type->class == PTR and t->type->type->class == BADUSE) {
589: findtype(t);
590: }
591: r = size(t->type);
592: break;
593:
594: case TAG:
595: r = size(t->type);
596: break;
597:
598: case FIELD:
599: r = (t->symvalue.field.length + 7) div 8;
600: break;
601:
602: case RECORD:
603: case VARNT:
604: r = t->symvalue.offset;
605: if (r == 0 and t->chain != nil) {
606: panic("missing size information for record");
607: }
608: break;
609:
610: case PTR:
611: case FILET:
612: r = sizeof(Word);
613: break;
614:
615: case SCAL:
616: r = sizeof(Word);
617: /*
618: *
619: if (t->symvalue.iconval > 255) {
620: r = sizeof(short);
621: } else {
622: r = sizeof(char);
623: }
624: *
625: */
626: break;
627:
628: case FPROC:
629: case FFUNC:
630: r = sizeof(Word);
631: break;
632:
633: case PROC:
634: case FUNC:
635: case MODULE:
636: case PROG:
637: r = sizeof(Symbol);
638: break;
639:
640: default:
641: if (ord(t->class) > ord(TYPEREF)) {
642: panic("size: bad class (%d)", ord(t->class));
643: } else {
644: error("improper operation on a %s", classname(t));
645: }
646: /* NOTREACHED */
647: }
648: return r;
649: }
650:
651: /*
652: * Test if a symbol is a parameter. This is true if there
653: * is a cycle from s->block to s via chain pointers.
654: */
655:
656: public Boolean isparam(s)
657: Symbol s;
658: {
659: register Symbol t;
660:
661: t = s->block;
662: while (t != nil and t != s) {
663: t = t->chain;
664: }
665: return (Boolean) (t != nil);
666: }
667:
668: /*
669: * Test if a symbol is a var parameter, i.e. has class REF.
670: */
671:
672: public Boolean isvarparam(s)
673: Symbol s;
674: {
675: return (Boolean) (s->class == REF);
676: }
677:
678: /*
679: * Test if a symbol is a variable (actually any addressible quantity
680: * with do).
681: */
682:
683: public Boolean isvariable(s)
684: register Symbol s;
685: {
686: return (Boolean) (s->class == VAR or s->class == FVAR or s->class == REF);
687: }
688:
689: /*
690: * Test if a symbol is a block, e.g. function, procedure, or the
691: * main program.
692: *
693: * This function is now expanded inline for efficiency.
694: *
695: * public Boolean isblock(s)
696: register Symbol s;
697: {
698: return (Boolean) (
699: s->class == FUNC or s->class == PROC or
700: s->class == MODULE or s->class == PROG
701: );
702: }
703: *
704: */
705:
706: /*
707: * Test if a symbol is a module.
708: */
709:
710: public Boolean ismodule(s)
711: register Symbol s;
712: {
713: return (Boolean) (s->class == MODULE);
714: }
715:
716: /*
717: * Test if a symbol is builtin, that is, a predefined type or
718: * reserved word.
719: */
720:
721: public Boolean isbuiltin(s)
722: register Symbol s;
723: {
724: return (Boolean) (s->level == 0 and s->class != PROG and s->class != VAR);
725: }
726:
727: /*
728: * Test if two types match.
729: * Equivalent names implies a match in any language.
730: *
731: * Special symbols must be handled with care.
732: */
733:
734: public Boolean compatible(t1, t2)
735: register Symbol t1, t2;
736: {
737: Boolean b;
738:
739: if (t1 == t2) {
740: b = true;
741: } else if (t1 == nil or t2 == nil) {
742: b = false;
743: } else if (t1 == procsym) {
744: b = isblock(t2);
745: } else if (t2 == procsym) {
746: b = isblock(t1);
747: } else if (t1->language == nil) {
748: b = (Boolean) (t2->language == nil or
749: (*language_op(t2->language, L_TYPEMATCH))(t1, t2));
750: } else if (t2->language == nil) {
751: b = (Boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2);
752: } else if ( isbuiltin(t1) or isbuiltin(t1->type) ) {
753: b = (Boolean) (*language_op(t2->language, L_TYPEMATCH))(t1, t2);
754: } else {
755: b = (Boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2);
756: }
757: return b;
758: }
759:
760: /*
761: * Check for a type of the given name.
762: */
763:
764: public Boolean istypename(type, name)
765: Symbol type;
766: String name;
767: {
768: Symbol t;
769: Boolean b;
770:
771: t = type;
772: checkref(t);
773: b = (Boolean) (
774: t->class == TYPE and t->name == identname(name, true)
775: );
776: return b;
777: }
778:
779: /*
780: * Test if the name of a symbol is uniquely defined or not.
781: */
782:
783: public Boolean isambiguous(s)
784: register Symbol s;
785: {
786: register Symbol t;
787:
788: find(t, s->name) where t != s endfind(t);
789: return (Boolean) (t != nil);
790: }
791:
792: typedef char *Arglist;
793:
794: #define nextarg(type) ((type *) (ap += sizeof(type)))[-1]
795:
796: private Symbol mkstring();
797: private Symbol namenode();
798:
799: /*
800: * Determine the type of a parse tree.
801: * Also make some symbol-dependent changes to the tree such as
802: * changing removing RVAL nodes for constant symbols.
803: */
804:
805: public assigntypes(p)
806: register Node p;
807: {
808: register Node p1;
809: register Symbol s;
810:
811: switch (p->op) {
812: case O_SYM:
813: p->nodetype = namenode(p);
814: break;
815:
816: case O_LCON:
817: p->nodetype = t_int;
818: break;
819:
820: case O_FCON:
821: p->nodetype = t_real;
822: break;
823:
824: case O_SCON:
825: p->value.scon = strdup(p->value.scon);
826: s = mkstring(p->value.scon);
827: if (s == t_char) {
828: p->op = O_LCON;
829: p->value.lcon = p->value.scon[0];
830: }
831: p->nodetype = s;
832: break;
833:
834: case O_INDIR:
835: p1 = p->value.arg[0];
836: chkclass(p1, PTR);
837: p->nodetype = rtype(p1->nodetype)->type;
838: break;
839:
840: case O_DOT:
841: p->nodetype = p->value.arg[1]->value.sym;
842: break;
843:
844: case O_RVAL:
845: p1 = p->value.arg[0];
846: p->nodetype = p1->nodetype;
847: if (p1->op == O_SYM) {
848: if (p1->nodetype->class == FUNC) {
849: p->op = O_CALL;
850: p->value.arg[1] = nil;
851: } else if (p1->value.sym->class == CONST) {
852: if (compatible(p1->value.sym->type, t_real)) {
853: p->op = O_FCON;
854: p->value.fcon = p1->value.sym->symvalue.fconval;
855: p->nodetype = t_real;
856: dispose(p1);
857: } else {
858: p->op = O_LCON;
859: p->value.lcon = p1->value.sym->symvalue.iconval;
860: p->nodetype = p1->value.sym->type;
861: dispose(p1);
862: }
863: } else if (isreg(p1->value.sym)) {
864: p->op = O_SYM;
865: p->value.sym = p1->value.sym;
866: dispose(p1);
867: }
868: } else if (p1->op == O_INDIR and p1->value.arg[0]->op == O_SYM) {
869: s = p1->value.arg[0]->value.sym;
870: if (isreg(s)) {
871: p1->op = O_SYM;
872: dispose(p1->value.arg[0]);
873: p1->value.sym = s;
874: p1->nodetype = s;
875: }
876: }
877: break;
878:
879: case O_CALL:
880: p1 = p->value.arg[0];
881: p->nodetype = rtype(p1->nodetype)->type;
882: break;
883:
884: case O_TYPERENAME:
885: p->nodetype = p->value.arg[1]->nodetype;
886: break;
887:
888: case O_ITOF:
889: p->nodetype = t_real;
890: break;
891:
892: case O_NEG:
893: s = p->value.arg[0]->nodetype;
894: if (not compatible(s, t_int)) {
895: if (not compatible(s, t_real)) {
896: beginerrmsg();
897: prtree(stderr, p->value.arg[0]);
898: fprintf(stderr, "is improper type");
899: enderrmsg();
900: } else {
901: p->op = O_NEGF;
902: }
903: }
904: p->nodetype = s;
905: break;
906:
907: case O_ADD:
908: case O_SUB:
909: case O_MUL:
910: case O_LT:
911: case O_LE:
912: case O_GT:
913: case O_GE:
914: case O_EQ:
915: case O_NE:
916: {
917: Boolean t1real, t2real;
918: Symbol t1, t2;
919:
920: t1 = rtype(p->value.arg[0]->nodetype);
921: t2 = rtype(p->value.arg[1]->nodetype);
922: t1real = compatible(t1, t_real);
923: t2real = compatible(t2, t_real);
924: if (t1real or t2real) {
925: p->op = (Operator) (ord(p->op) + 1);
926: if (not t1real) {
927: p->value.arg[0] = build(O_ITOF, p->value.arg[0]);
928: } else if (not t2real) {
929: p->value.arg[1] = build(O_ITOF, p->value.arg[1]);
930: }
931: } else {
932: if (t1real) {
933: convert(&(p->value.arg[0]), t_int, O_NOP);
934: }
935: if (t2real) {
936: convert(&(p->value.arg[1]), t_int, O_NOP);
937: }
938: }
939: if (ord(p->op) >= ord(O_LT)) {
940: p->nodetype = t_boolean;
941: } else {
942: if (t1real or t2real) {
943: p->nodetype = t_real;
944: } else {
945: p->nodetype = t_int;
946: }
947: }
948: break;
949: }
950:
951: case O_DIVF:
952: convert(&(p->value.arg[0]), t_real, O_ITOF);
953: convert(&(p->value.arg[1]), t_real, O_ITOF);
954: p->nodetype = t_real;
955: break;
956:
957: case O_DIV:
958: case O_MOD:
959: convert(&(p->value.arg[0]), t_int, O_NOP);
960: convert(&(p->value.arg[1]), t_int, O_NOP);
961: p->nodetype = t_int;
962: break;
963:
964: case O_AND:
965: case O_OR:
966: chkboolean(p->value.arg[0]);
967: chkboolean(p->value.arg[1]);
968: p->nodetype = t_boolean;
969: break;
970:
971: case O_QLINE:
972: p->nodetype = t_int;
973: break;
974:
975: default:
976: p->nodetype = nil;
977: break;
978: }
979: }
980:
981: /*
982: * Create a node for a name. The symbol for the name has already
983: * been chosen, either implicitly with "which" or explicitly from
984: * the dot routine.
985: */
986:
987: private Symbol namenode(p)
988: Node p;
989: {
990: register Symbol r, s;
991: register Node np;
992:
993: s = p->value.sym;
994: if (s->class == REF) {
995: np = new(Node);
996: np->op = p->op;
997: np->nodetype = s;
998: np->value.sym = s;
999: p->op = O_INDIR;
1000: p->value.arg[0] = np;
1001: }
1002: /*
1003: * Old way
1004: *
1005: if (s->class == CONST or s->class == VAR or s->class == FVAR) {
1006: r = s->type;
1007: } else {
1008: r = s;
1009: }
1010: *
1011: */
1012: return s;
1013: }
1014:
1015: /*
1016: * Convert a tree to a type via a conversion operator;
1017: * if this isn't possible generate an error.
1018: *
1019: * Note the tree is call by address, hence the #define below.
1020: */
1021:
1022: private convert(tp, typeto, op)
1023: Node *tp;
1024: Symbol typeto;
1025: Operator op;
1026: {
1027: #define tree (*tp)
1028:
1029: Symbol s;
1030:
1031: s = rtype(tree->nodetype);
1032: typeto = rtype(typeto);
1033: if (compatible(typeto, t_real) and compatible(s, t_int)) {
1034: tree = build(op, tree);
1035: } else if (not compatible(s, typeto)) {
1036: beginerrmsg();
1037: prtree(stderr, s);
1038: fprintf(stderr, " is improper type");
1039: enderrmsg();
1040: } else if (op != O_NOP and s != typeto) {
1041: tree = build(op, tree);
1042: }
1043:
1044: #undef tree
1045: }
1046:
1047: /*
1048: * Construct a node for the dot operator.
1049: *
1050: * If the left operand is not a record, but rather a procedure
1051: * or function, then we interpret the "." as referencing an
1052: * "invisible" variable; i.e. a variable within a dynamically
1053: * active block but not within the static scope of the current procedure.
1054: */
1055:
1056: public Node dot(record, fieldname)
1057: Node record;
1058: Name fieldname;
1059: {
1060: register Node p;
1061: register Symbol s, t;
1062:
1063: if (isblock(record->nodetype)) {
1064: find(s, fieldname) where
1065: s->block == record->nodetype and
1066: s->class != FIELD and s->class != TAG
1067: endfind(s);
1068: if (s == nil) {
1069: beginerrmsg();
1070: fprintf(stderr, "\"%s\" is not defined in ", ident(fieldname));
1071: printname(stderr, record->nodetype);
1072: enderrmsg();
1073: }
1074: p = new(Node);
1075: p->op = O_SYM;
1076: p->value.sym = s;
1077: p->nodetype = namenode(p);
1078: } else {
1079: p = record;
1080: t = rtype(p->nodetype);
1081: if (t->class == PTR) {
1082: s = findfield(fieldname, t->type);
1083: } else {
1084: s = findfield(fieldname, t);
1085: }
1086: if (s == nil) {
1087: beginerrmsg();
1088: fprintf(stderr, "\"%s\" is not a field in ", ident(fieldname));
1089: prtree(stderr, record);
1090: enderrmsg();
1091: }
1092: if (t->class == PTR and not isreg(record->nodetype)) {
1093: p = build(O_INDIR, record);
1094: }
1095: p = build(O_DOT, p, build(O_SYM, s));
1096: }
1097: return p;
1098: }
1099:
1100: /*
1101: * Return a tree corresponding to an array reference and do the
1102: * error checking.
1103: */
1104:
1105: public Node subscript(a, slist)
1106: Node a, slist;
1107: {
1108: Symbol t;
1109:
1110: t = rtype(a->nodetype);
1111: if(t->language == nil) {
1112: error("unknown language");
1113: }
1114: else {
1115: return ( (Node)
1116: (*language_op(t->language, L_BUILDAREF)) (a,slist)
1117: );
1118: }
1119: }
1120:
1121: /*
1122: * Evaluate a subscript index.
1123: */
1124:
1125: public int evalindex(s, i)
1126: Symbol s;
1127: long i;
1128: {
1129: Symbol t;
1130:
1131: t = rtype(s);
1132: if(t->language == nil) {
1133: error("unknown language");
1134: }
1135: else {
1136: return (
1137: (*language_op(t->language, L_EVALAREF)) (s,i)
1138: );
1139: }
1140: }
1141:
1142: /*
1143: * Check to see if a tree is boolean-valued, if not it's an error.
1144: */
1145:
1146: public chkboolean(p)
1147: register Node p;
1148: {
1149: if (p->nodetype != t_boolean) {
1150: beginerrmsg();
1151: fprintf(stderr, "found ");
1152: prtree(stderr, p);
1153: fprintf(stderr, ", expected boolean expression");
1154: enderrmsg();
1155: }
1156: }
1157:
1158: /*
1159: * Check to make sure the given tree has a type of the given class.
1160: */
1161:
1162: private chkclass(p, class)
1163: Node p;
1164: Symclass class;
1165: {
1166: struct Symbol tmpsym;
1167:
1168: tmpsym.class = class;
1169: if (rtype(p->nodetype)->class != class) {
1170: beginerrmsg();
1171: fprintf(stderr, "\"");
1172: prtree(stderr, p);
1173: fprintf(stderr, "\" is not a %s", classname(&tmpsym));
1174: enderrmsg();
1175: }
1176: }
1177:
1178: /*
1179: * Construct a node for the type of a string. While we're at it,
1180: * scan the string for '' that collapse to ', and chop off the ends.
1181: */
1182:
1183: private Symbol mkstring(str)
1184: String str;
1185: {
1186: register char *p, *q;
1187: register Symbol s;
1188:
1189: p = str;
1190: q = str;
1191: while (*p != '\0') {
1192: if (*p == '\\') {
1193: ++p;
1194: }
1195: *q = *p;
1196: ++p;
1197: ++q;
1198: }
1199: *q = '\0';
1200: s = newSymbol(nil, 0, ARRAY, t_char, nil);
1201: s->language = findlanguage(".s");
1202: s->chain = newSymbol(nil, 0, RANGE, t_int, nil);
1203: s->chain->language = s->language;
1204: s->chain->symvalue.rangev.lower = 1;
1205: s->chain->symvalue.rangev.upper = p - str + 1;
1206: return s;
1207: }
1208:
1209: /*
1210: * Free up the space allocated for a string type.
1211: */
1212:
1213: public unmkstring(s)
1214: Symbol s;
1215: {
1216: dispose(s->chain);
1217: }
1218:
1219: /*
1220: * Figure out the "current" variable or function being referred to,
1221: * this is either the active one or the most visible from the
1222: * current scope.
1223: */
1224:
1225: public Symbol which(n)
1226: Name n;
1227: {
1228: register Symbol s, p, t, f;
1229:
1230: find(s, n) where s->class != FIELD and s->class != TAG endfind(s);
1231: if (s == nil) {
1232: s = lookup(n);
1233: }
1234: if (s == nil) {
1235: error("\"%s\" is not defined", ident(n));
1236: } else if (s == program or isbuiltin(s)) {
1237: t = s;
1238: } else {
1239: /*
1240: * Old way
1241: *
1242: if (not isactive(program)) {
1243: f = program;
1244: } else {
1245: f = whatblock(pc);
1246: if (f == nil) {
1247: panic("no block for addr 0x%x", pc);
1248: }
1249: }
1250: *
1251: * Now start with curfunc.
1252: */
1253: p = curfunc;
1254: do {
1255: find(t, n) where
1256: t->block == p and t->class != FIELD and t->class != TAG
1257: endfind(t);
1258: p = p->block;
1259: } while (t == nil and p != nil);
1260: if (t == nil) {
1261: t = s;
1262: }
1263: }
1264: return t;
1265: }
1266:
1267: /*
1268: * Find the symbol which is has the same name and scope as the
1269: * given symbol but is of the given field. Return nil if there is none.
1270: */
1271:
1272: public Symbol findfield(fieldname, record)
1273: Name fieldname;
1274: Symbol record;
1275: {
1276: register Symbol t;
1277:
1278: t = rtype(record)->chain;
1279: while (t != nil and t->name != fieldname) {
1280: t = t->chain;
1281: }
1282: return t;
1283: }
1284:
1285: public Boolean getbound(s,off,type,valp)
1286: Symbol s;
1287: int off;
1288: Rangetype type;
1289: int *valp;
1290: {
1291: Frame frp;
1292: Address addr;
1293: Symbol cur;
1294:
1295: if (not isactive(s->block)) {
1296: return(false);
1297: }
1298: cur = s->block;
1299: while (cur != nil and cur->class == MODULE) { /* WHY*/
1300: cur = cur->block;
1301: }
1302: if(cur == nil) {
1303: cur = whatblock(pc);
1304: }
1305: frp = findframe(cur);
1306: if (frp == nil) {
1307: return(false);
1308: }
1309: if(type == R_TEMP) addr = locals_base(frp) + off;
1310: else if (type == R_ARG) addr = args_base(frp) + off;
1311: else return(false);
1312: dread(valp,addr,sizeof(long));
1313: return(true);
1314: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.