121599Sdist /*
238105Sbostic * Copyright (c) 1983 The Regents of the University of California.
338105Sbostic * All rights reserved.
438105Sbostic *
5*42683Sbostic * %sccs.include.redist.c%
621599Sdist */
79659Slinton
821599Sdist #ifndef lint
9*42683Sbostic static char sccsid[] = "@(#)c.c 5.10 (Berkeley) 06/01/90";
1038105Sbostic #endif /* not lint */
119659Slinton
129659Slinton /*
139659Slinton * C-dependent symbol routines.
149659Slinton */
159659Slinton
169659Slinton #include "defs.h"
179659Slinton #include "symbols.h"
189659Slinton #include "printsym.h"
199659Slinton #include "languages.h"
209659Slinton #include "c.h"
219659Slinton #include "tree.h"
229659Slinton #include "eval.h"
239659Slinton #include "operators.h"
249659Slinton #include "mappings.h"
259659Slinton #include "process.h"
269659Slinton #include "runtime.h"
279659Slinton #include "machine.h"
289659Slinton
2912559Scsvaf #ifndef public
3033309Sdonn # include "tree.h"
3112559Scsvaf #endif
3212559Scsvaf
339659Slinton #define isdouble(range) ( \
349659Slinton range->symvalue.rangev.upper == 0 and range->symvalue.rangev.lower > 0 \
359659Slinton )
369659Slinton
379659Slinton #define isrange(t, name) (t->class == RANGE and istypename(t->type, name))
389659Slinton
3916606Ssam private Language langC;
4033309Sdonn private Language langCplpl;
4116606Ssam
429659Slinton /*
439659Slinton * Initialize C language information.
449659Slinton */
459659Slinton
c_init()469659Slinton public c_init()
479659Slinton {
4816606Ssam langC = language_define("c", ".c");
4916606Ssam language_setop(langC, L_PRINTDECL, c_printdecl);
5016606Ssam language_setop(langC, L_PRINTVAL, c_printval);
5116606Ssam language_setop(langC, L_TYPEMATCH, c_typematch);
5216606Ssam language_setop(langC, L_BUILDAREF, c_buildaref);
5316606Ssam language_setop(langC, L_EVALAREF, c_evalaref);
5416606Ssam language_setop(langC, L_MODINIT, c_modinit);
5516606Ssam language_setop(langC, L_HASMODULES, c_hasmodules);
5616606Ssam language_setop(langC, L_PASSADDR, c_passaddr);
5733309Sdonn
5833309Sdonn langCplpl = language_define("c++", "..c");
5933309Sdonn language_setop(langCplpl, L_PRINTDECL, c_printdecl);
6033309Sdonn language_setop(langCplpl, L_PRINTVAL, c_printval);
6133309Sdonn language_setop(langCplpl, L_TYPEMATCH, c_typematch);
6233309Sdonn language_setop(langCplpl, L_BUILDAREF, c_buildaref);
6333309Sdonn language_setop(langCplpl, L_EVALAREF, c_evalaref);
6433309Sdonn language_setop(langCplpl, L_MODINIT, c_modinit);
6533309Sdonn language_setop(langCplpl, L_HASMODULES, c_hasmodules);
6633309Sdonn language_setop(langCplpl, L_PASSADDR, c_passaddr);
679659Slinton }
689659Slinton
699659Slinton /*
709659Slinton * Test if two types are compatible.
719659Slinton */
729659Slinton
c_typematch(type1,type2)739659Slinton public Boolean c_typematch(type1, type2)
749659Slinton Symbol type1, type2;
759659Slinton {
769659Slinton Boolean b;
779659Slinton register Symbol t1, t2, tmp;
789659Slinton
799659Slinton t1 = type1;
809659Slinton t2 = type2;
819659Slinton if (t1 == t2) {
829659Slinton b = true;
839659Slinton } else {
849659Slinton t1 = rtype(t1);
859659Slinton t2 = rtype(t2);
8616606Ssam if (t1 == t_char->type or t1 == t_int->type or t1 == t_real->type) {
879659Slinton tmp = t1;
889659Slinton t1 = t2;
899659Slinton t2 = tmp;
909659Slinton }
919659Slinton b = (Boolean) (
929659Slinton (
9334258Sdonn isrange(t1, "int") and !isdouble(t1) /* sigh */ and
9416606Ssam (t2 == t_int->type or t2 == t_char->type)
959659Slinton ) or (
969659Slinton isrange(t1, "char") and
9716606Ssam (t2 == t_char->type or t2 == t_int->type)
989659Slinton ) or (
9916606Ssam t1->class == RANGE and isdouble(t1) and t2 == t_real->type
10013839Slinton ) or (
10118213Slinton t1->class == RANGE and t2->class == RANGE and
10218213Slinton t1->symvalue.rangev.lower == t2->symvalue.rangev.lower and
10318213Slinton t1->symvalue.rangev.upper == t2->symvalue.rangev.upper
10418213Slinton ) or (
10534258Sdonn t1->class != RANGE and t1->type == t2->type and (
1069659Slinton (t1->class == t2->class) or
1079659Slinton (t1->class == SCAL and t2->class == CONST) or
1089659Slinton (t1->class == CONST and t2->class == SCAL)
1099659Slinton )
11016606Ssam ) or (
11116606Ssam t1->class == PTR and c_typematch(t1->type, t_char) and
11216606Ssam t2->class == ARRAY and c_typematch(t2->type, t_char) and
11316606Ssam t2->language == primlang
1149659Slinton )
1159659Slinton );
1169659Slinton }
1179659Slinton return b;
1189659Slinton }
1199659Slinton
1209659Slinton /*
1219659Slinton * Print out the declaration of a C variable.
1229659Slinton */
1239659Slinton
c_printdecl(s)1249659Slinton public c_printdecl(s)
1259659Slinton Symbol s;
1269659Slinton {
1279659Slinton printdecl(s, 0);
1289659Slinton }
1299659Slinton
printdecl(s,indent)1309659Slinton private printdecl(s, indent)
1319659Slinton register Symbol s;
1329659Slinton Integer indent;
1339659Slinton {
1349659Slinton register Symbol t;
1359659Slinton Boolean semicolon, newline;
1369659Slinton
1379659Slinton semicolon = true;
1389659Slinton newline = true;
1399659Slinton if (indent > 0) {
1409659Slinton printf("%*c", indent, ' ');
1419659Slinton }
1429659Slinton if (s->class == TYPE) {
1439659Slinton printf("typedef ");
1449659Slinton }
1459659Slinton switch (s->class) {
1469659Slinton case CONST:
1479659Slinton if (s->type->class == SCAL) {
14818213Slinton printf("enumeration constant with value ");
14918213Slinton eval(s->symvalue.constval);
15018213Slinton c_printval(s);
1519659Slinton } else {
1529659Slinton printf("const %s = ", symname(s));
1539659Slinton printval(s);
1549659Slinton }
1559659Slinton break;
1569659Slinton
1579659Slinton case TYPE:
1589659Slinton case VAR:
15933309Sdonn if (s->class != TYPE and s->storage == INREG) {
16018213Slinton printf("register ");
1619659Slinton }
1629659Slinton if (s->type->class == ARRAY) {
1639659Slinton printtype(s->type, s->type->type, indent);
1649659Slinton t = rtype(s->type->chain);
1659659Slinton assert(t->class == RANGE);
1669659Slinton printf(" %s[%d]", symname(s), t->symvalue.rangev.upper + 1);
1679659Slinton } else {
1689659Slinton printtype(s, s->type, indent);
1699659Slinton if (s->type->class != PTR) {
1709659Slinton printf(" ");
1719659Slinton }
1729659Slinton printf("%s", symname(s));
1739659Slinton }
1749659Slinton break;
1759659Slinton
1769659Slinton case FIELD:
1779659Slinton if (s->type->class == ARRAY) {
1789659Slinton printtype(s->type, s->type->type, indent);
1799659Slinton t = rtype(s->type->chain);
1809659Slinton assert(t->class == RANGE);
1819659Slinton printf(" %s[%d]", symname(s), t->symvalue.rangev.upper + 1);
1829659Slinton } else {
1839659Slinton printtype(s, s->type, indent);
1849659Slinton if (s->type->class != PTR) {
1859659Slinton printf(" ");
1869659Slinton }
1879659Slinton printf("%s", symname(s));
1889659Slinton }
1899659Slinton if (isbitfield(s)) {
1909659Slinton printf(" : %d", s->symvalue.field.length);
1919659Slinton }
1929659Slinton break;
1939659Slinton
1949659Slinton case TAG:
1959659Slinton if (s->type == nil) {
1969659Slinton findtype(s);
1979659Slinton if (s->type == nil) {
1989659Slinton error("unexpected missing type information");
1999659Slinton }
2009659Slinton }
2019659Slinton printtype(s, s->type, indent);
2029659Slinton break;
2039659Slinton
2049659Slinton case RANGE:
2059659Slinton case ARRAY:
2069659Slinton case RECORD:
2079659Slinton case VARNT:
2089659Slinton case PTR:
20918213Slinton case FFUNC:
2109659Slinton semicolon = false;
2119659Slinton printtype(s, s, indent);
2129659Slinton break;
2139659Slinton
21418213Slinton case SCAL:
21518213Slinton printf("(enumeration constant, value %d)", s->symvalue.iconval);
21618213Slinton break;
21718213Slinton
2189659Slinton case PROC:
2199659Slinton semicolon = false;
2209659Slinton printf("%s", symname(s));
2219659Slinton c_listparams(s);
2229659Slinton newline = false;
2239659Slinton break;
2249659Slinton
2259659Slinton case FUNC:
2269659Slinton semicolon = false;
2279659Slinton if (not istypename(s->type, "void")) {
2289659Slinton printtype(s, s->type, indent);
2299659Slinton printf(" ");
2309659Slinton }
2319659Slinton printf("%s", symname(s));
2329659Slinton c_listparams(s);
2339659Slinton newline = false;
2349659Slinton break;
2359659Slinton
2369659Slinton case MODULE:
2379659Slinton semicolon = false;
2389659Slinton printf("source file \"%s.c\"", symname(s));
2399659Slinton break;
2409659Slinton
2419659Slinton case PROG:
2429659Slinton semicolon = false;
2439659Slinton printf("executable file \"%s\"", symname(s));
2449659Slinton break;
2459659Slinton
2469659Slinton default:
24718213Slinton printf("[%s]", classname(s));
24818213Slinton break;
2499659Slinton }
2509659Slinton if (semicolon) {
2519659Slinton putchar(';');
2529659Slinton }
2539659Slinton if (newline) {
2549659Slinton putchar('\n');
2559659Slinton }
2569659Slinton }
2579659Slinton
2589659Slinton /*
2599659Slinton * Recursive whiz-bang procedure to print the type portion
2609659Slinton * of a declaration.
2619659Slinton *
2629659Slinton * The symbol associated with the type is passed to allow
2639659Slinton * searching for type names without getting "type blah = blah".
2649659Slinton */
2659659Slinton
printtype(s,t,indent)2669659Slinton private printtype(s, t, indent)
2679659Slinton Symbol s;
2689659Slinton Symbol t;
2699659Slinton Integer indent;
2709659Slinton {
2719659Slinton register Symbol i;
2729659Slinton long r0, r1;
2739659Slinton register String p;
2749659Slinton
2759659Slinton checkref(s);
2769659Slinton checkref(t);
2779659Slinton switch (t->class) {
2789659Slinton case VAR:
2799659Slinton case CONST:
2809659Slinton case PROC:
2819659Slinton panic("printtype: class %s", classname(t));
2829659Slinton break;
2839659Slinton
2849659Slinton case ARRAY:
2859659Slinton printf("array[");
2869659Slinton i = t->chain;
2879659Slinton if (i != nil) {
2889659Slinton for (;;) {
2899659Slinton printtype(i, i, indent);
2909659Slinton i = i->chain;
2919659Slinton if (i == nil) {
2929659Slinton break;
2939659Slinton }
2949659Slinton printf(", ");
2959659Slinton }
2969659Slinton }
2979659Slinton printf("] of ");
2989659Slinton printtype(t, t->type, indent);
2999659Slinton break;
3009659Slinton
3019659Slinton case RECORD:
3029659Slinton case VARNT:
3039659Slinton printf("%s ", c_classname(t));
3049659Slinton if (s->name != nil and s->class == TAG) {
3059659Slinton p = symname(s);
3069659Slinton if (p[0] == '$' and p[1] == '$') {
3079659Slinton printf("%s ", &p[2]);
3089659Slinton } else {
3099659Slinton printf("%s ", p);
3109659Slinton }
3119659Slinton }
31231752Ssam printf("{\n");
3139659Slinton for (i = t->chain; i != nil; i = i->chain) {
3149659Slinton assert(i->class == FIELD);
3159659Slinton printdecl(i, indent+4);
3169659Slinton }
3179659Slinton if (indent > 0) {
3189659Slinton printf("%*c", indent, ' ');
3199659Slinton }
3209659Slinton printf("}");
3219659Slinton break;
3229659Slinton
3239659Slinton case RANGE:
3249659Slinton r0 = t->symvalue.rangev.lower;
3259659Slinton r1 = t->symvalue.rangev.upper;
3269659Slinton if (istypename(t->type, "char")) {
3279659Slinton if (r0 < 0x20 or r0 > 0x7e) {
3289659Slinton printf("%ld..", r0);
3299659Slinton } else {
3309659Slinton printf("'%c'..", (char) r0);
3319659Slinton }
3329659Slinton if (r1 < 0x20 or r1 > 0x7e) {
3339659Slinton printf("\\%lo", r1);
3349659Slinton } else {
3359659Slinton printf("'%c'", (char) r1);
3369659Slinton }
3379659Slinton } else if (r0 > 0 and r1 == 0) {
3389659Slinton printf("%ld byte real", r0);
3399659Slinton } else if (r0 >= 0) {
3409659Slinton printf("%lu..%lu", r0, r1);
3419659Slinton } else {
3429659Slinton printf("%ld..%ld", r0, r1);
3439659Slinton }
3449659Slinton break;
3459659Slinton
3469659Slinton case PTR:
3479659Slinton printtype(t, t->type, indent);
3489659Slinton if (t->type->class != PTR) {
3499659Slinton printf(" ");
3509659Slinton }
3519659Slinton printf("*");
3529659Slinton break;
3539659Slinton
3549659Slinton case FUNC:
35516606Ssam case FFUNC:
3569659Slinton printtype(t, t->type, indent);
3579659Slinton printf("()");
3589659Slinton break;
3599659Slinton
3609659Slinton case TYPE:
3619659Slinton if (t->name != nil) {
36216606Ssam printname(stdout, t);
3639659Slinton } else {
3649659Slinton printtype(t, t->type, indent);
3659659Slinton }
3669659Slinton break;
3679659Slinton
3689659Slinton case TYPEREF:
3699659Slinton printf("@%s", symname(t));
3709659Slinton break;
3719659Slinton
3729659Slinton case SCAL:
3739659Slinton printf("enum ");
3749659Slinton if (s->name != nil and s->class == TAG) {
3759659Slinton printf("%s ", symname(s));
3769659Slinton }
3779659Slinton printf("{ ");
3789659Slinton i = t->chain;
3799659Slinton if (i != nil) {
3809659Slinton for (;;) {
3819659Slinton printf("%s", symname(i));
3829659Slinton i = i->chain;
3839659Slinton if (i == nil) break;
3849659Slinton printf(", ");
3859659Slinton }
3869659Slinton }
3879659Slinton printf(" }");
3889659Slinton break;
3899659Slinton
3909659Slinton case TAG:
3919659Slinton if (t->type == nil) {
3929659Slinton printf("unresolved tag %s", symname(t));
3939659Slinton } else {
3949659Slinton i = rtype(t->type);
3959659Slinton printf("%s %s", c_classname(i), symname(t));
3969659Slinton }
3979659Slinton break;
3989659Slinton
3999659Slinton default:
4009659Slinton printf("(class %d)", t->class);
4019659Slinton break;
4029659Slinton }
4039659Slinton }
4049659Slinton
4059659Slinton /*
4069659Slinton * List the parameters of a procedure or function.
4079659Slinton * No attempt is made to combine like types.
4089659Slinton */
4099659Slinton
c_listparams(s)4109659Slinton public c_listparams(s)
4119659Slinton Symbol s;
4129659Slinton {
4139659Slinton register Symbol t;
4149659Slinton
4159659Slinton putchar('(');
4169659Slinton for (t = s->chain; t != nil; t = t->chain) {
4179659Slinton printf("%s", symname(t));
4189659Slinton if (t->chain != nil) {
4199659Slinton printf(", ");
4209659Slinton }
4219659Slinton }
4229659Slinton putchar(')');
4239659Slinton if (s->chain != nil) {
4249659Slinton printf("\n");
4259659Slinton for (t = s->chain; t != nil; t = t->chain) {
4269659Slinton if (t->class != VAR) {
4279659Slinton panic("unexpected class %d for parameter", t->class);
4289659Slinton }
4299659Slinton printdecl(t, 0);
4309659Slinton }
4319659Slinton } else {
4329659Slinton putchar('\n');
4339659Slinton }
4349659Slinton }
4359659Slinton
4369659Slinton /*
4379659Slinton * Print out the value on the top of the expression stack
4389659Slinton * in the format for the type of the given symbol.
4399659Slinton */
4409659Slinton
c_printval(s)4419659Slinton public c_printval(s)
4429659Slinton Symbol s;
4439659Slinton {
4449659Slinton register Symbol t;
4459659Slinton register Address a;
44616606Ssam integer i, len;
44729869Smckusick register String str;
4489659Slinton
4499659Slinton switch (s->class) {
4509659Slinton case CONST:
4519659Slinton case TYPE:
4529659Slinton case VAR:
4539659Slinton case REF:
4549659Slinton case FVAR:
4559659Slinton case TAG:
4569659Slinton c_printval(s->type);
4579659Slinton break;
4589659Slinton
4599659Slinton case FIELD:
4609659Slinton if (isbitfield(s)) {
46133309Sdonn i = extractField(s);
4629659Slinton t = rtype(s->type);
4639659Slinton if (t->class == SCAL) {
46418213Slinton printEnum(i, t);
4659659Slinton } else {
46618213Slinton printRangeVal(i, t);
4679659Slinton }
4689659Slinton } else {
4699659Slinton c_printval(s->type);
4709659Slinton }
4719659Slinton break;
4729659Slinton
4739659Slinton case ARRAY:
4749659Slinton t = rtype(s->type);
47516606Ssam if ((t->class == RANGE and istypename(t->type, "char")) or
47616606Ssam t == t_char->type
47716606Ssam ) {
4789659Slinton len = size(s);
47929869Smckusick str = (String) (sp -= len);
48029869Smckusick if (s->language != primlang) {
48129869Smckusick putchar('"');
48218213Slinton }
48329869Smckusick while (--len > 0 and *str != '\0') {
48429869Smckusick printchar(*str++);
48529869Smckusick }
48629869Smckusick if (*str != '\0') { /* XXX - pitch trailing null */
48729869Smckusick printchar(*str);
48829869Smckusick }
48929869Smckusick if (s->language != primlang) {
49029869Smckusick putchar('"');
49129869Smckusick }
4929659Slinton } else {
4939659Slinton printarray(s);
4949659Slinton }
4959659Slinton break;
4969659Slinton
4979659Slinton case RECORD:
4989659Slinton c_printstruct(s);
4999659Slinton break;
5009659Slinton
5019659Slinton case RANGE:
50218213Slinton if (s == t_boolean->type or istypename(s->type, "boolean")) {
50318213Slinton printRangeVal(popsmall(s), s);
50418213Slinton } else if (s == t_char->type or istypename(s->type, "char")) {
50518213Slinton printRangeVal(pop(char), s);
50618213Slinton } else if (s == t_real->type or isdouble(s)) {
5079659Slinton switch (s->symvalue.rangev.lower) {
5089659Slinton case sizeof(float):
50933309Sdonn prtreal((double) (pop(float)));
5109659Slinton break;
5119659Slinton
5129659Slinton case sizeof(double):
5139659Slinton prtreal(pop(double));
5149659Slinton break;
5159659Slinton
5169659Slinton default:
5179659Slinton panic("bad real size %d", t->symvalue.rangev.lower);
5189659Slinton break;
5199659Slinton }
5209659Slinton } else {
52118213Slinton printRangeVal(popsmall(s), s);
5229659Slinton }
5239659Slinton break;
5249659Slinton
5259659Slinton case PTR:
5269659Slinton t = rtype(s->type);
5279659Slinton a = pop(Address);
5289659Slinton if (a == 0) {
5299659Slinton printf("(nil)");
5309659Slinton } else if (t->class == RANGE and istypename(t->type, "char")) {
53118213Slinton printString(a, (boolean) (s->language != primlang));
5329659Slinton } else {
5339659Slinton printf("0x%x", a);
5349659Slinton }
5359659Slinton break;
5369659Slinton
5379659Slinton case SCAL:
5389659Slinton i = pop(Integer);
53918213Slinton printEnum(i, s);
5409659Slinton break;
5419659Slinton
54218213Slinton /*
54318213Slinton * Unresolved structure pointers?
54418213Slinton */
54518213Slinton case BADUSE:
54618213Slinton a = pop(Address);
54718213Slinton printf("@%x", a);
54818213Slinton break;
54918213Slinton
5509659Slinton default:
5519659Slinton if (ord(s->class) > ord(TYPEREF)) {
5529659Slinton panic("printval: bad class %d", ord(s->class));
5539659Slinton }
55414382Slinton sp -= size(s);
55516606Ssam printf("[%s]", c_classname(s));
55614382Slinton break;
5579659Slinton }
5589659Slinton }
5599659Slinton
5609659Slinton /*
5619659Slinton * Print out a C structure.
5629659Slinton */
5639659Slinton
c_printstruct(s)56418213Slinton private c_printstruct (s)
5659659Slinton Symbol s;
5669659Slinton {
56718213Slinton Symbol f;
56818213Slinton Stack *savesp;
56918213Slinton integer n, off, len;
5709659Slinton
5719659Slinton sp -= size(s);
5729659Slinton savesp = sp;
5739659Slinton printf("(");
5749659Slinton f = s->chain;
5759659Slinton for (;;) {
5769659Slinton off = f->symvalue.field.offset;
5779659Slinton len = f->symvalue.field.length;
57816606Ssam n = (off + len + BITSPERBYTE - 1) div BITSPERBYTE;
5799659Slinton sp += n;
5809659Slinton printf("%s = ", symname(f));
5819659Slinton c_printval(f);
5829659Slinton sp = savesp;
5839659Slinton f = f->chain;
5849659Slinton if (f == nil) break;
5859659Slinton printf(", ");
5869659Slinton }
5879659Slinton printf(")");
5889659Slinton }
5899659Slinton
5909659Slinton /*
5919659Slinton * Return the C name for the particular class of a symbol.
5929659Slinton */
5939659Slinton
c_classname(s)5949659Slinton public String c_classname(s)
5959659Slinton Symbol s;
5969659Slinton {
5979659Slinton String str;
5989659Slinton
5999659Slinton switch (s->class) {
6009659Slinton case RECORD:
6019659Slinton str = "struct";
6029659Slinton break;
6039659Slinton
6049659Slinton case VARNT:
6059659Slinton str = "union";
6069659Slinton break;
6079659Slinton
6089659Slinton case SCAL:
6099659Slinton str = "enum";
6109659Slinton break;
6119659Slinton
6129659Slinton default:
6139659Slinton str = classname(s);
6149659Slinton }
6159659Slinton return str;
6169659Slinton }
61718213Slinton
c_buildaref(a,slist)61812533Scsvaf public Node c_buildaref(a, slist)
61912533Scsvaf Node a, slist;
62012533Scsvaf {
62112533Scsvaf register Symbol t;
62212533Scsvaf register Node p;
62312533Scsvaf Symbol etype, atype, eltype;
62418213Slinton Node r, esub;
62512533Scsvaf
62612533Scsvaf t = rtype(a->nodetype);
62712533Scsvaf eltype = t->type;
62812533Scsvaf if (t->class == PTR) {
62912533Scsvaf p = slist->value.arg[0];
63012533Scsvaf if (not compatible(p->nodetype, t_int)) {
63112533Scsvaf beginerrmsg();
63218213Slinton fprintf(stderr, "subscript must be integer-compatible");
63312533Scsvaf enderrmsg();
63412533Scsvaf }
63512533Scsvaf r = build(O_MUL, p, build(O_LCON, (long) size(eltype)));
63612533Scsvaf r = build(O_ADD, build(O_RVAL, a), r);
63712533Scsvaf r->nodetype = eltype;
63812533Scsvaf } else if (t->class != ARRAY) {
63912533Scsvaf beginerrmsg();
64018213Slinton fprintf(stderr, "\"");
64112533Scsvaf prtree(stderr, a);
64218213Slinton fprintf(stderr, "\" is not an array");
64312533Scsvaf enderrmsg();
64412533Scsvaf } else {
64518213Slinton r = a;
64612533Scsvaf p = slist;
64712533Scsvaf t = t->chain;
64812533Scsvaf for (; p != nil and t != nil; p = p->value.arg[1], t = t->chain) {
64912533Scsvaf esub = p->value.arg[0];
65012533Scsvaf etype = rtype(esub->nodetype);
65112533Scsvaf atype = rtype(t);
65212533Scsvaf if (not compatible(atype, etype)) {
65312533Scsvaf beginerrmsg();
65418213Slinton fprintf(stderr, "subscript \"");
65512533Scsvaf prtree(stderr, esub);
65618213Slinton fprintf(stderr, "\" is the wrong type");
65712533Scsvaf enderrmsg();
65812533Scsvaf }
65912533Scsvaf r = build(O_INDEX, r, esub);
66012533Scsvaf r->nodetype = eltype;
66112533Scsvaf }
66212533Scsvaf if (p != nil or t != nil) {
66312533Scsvaf beginerrmsg();
66412533Scsvaf if (p != nil) {
66518213Slinton fprintf(stderr, "too many subscripts for \"");
66612533Scsvaf } else {
66718213Slinton fprintf(stderr, "not enough subscripts for \"");
66812533Scsvaf }
66912533Scsvaf prtree(stderr, a);
67018213Slinton fprintf(stderr, "\"");
67112533Scsvaf enderrmsg();
67212533Scsvaf }
67312533Scsvaf }
67412533Scsvaf return r;
67512533Scsvaf }
67612533Scsvaf
67712533Scsvaf /*
67812533Scsvaf * Evaluate a subscript index.
67912533Scsvaf */
68012533Scsvaf
c_evalaref(s,base,i)68118213Slinton public c_evalaref(s, base, i)
68212533Scsvaf Symbol s;
68318213Slinton Address base;
68412533Scsvaf long i;
68512533Scsvaf {
68618213Slinton Symbol t;
68712533Scsvaf long lb, ub;
68812533Scsvaf
68918213Slinton t = rtype(s);
69018213Slinton s = t->chain;
69112533Scsvaf lb = s->symvalue.rangev.lower;
69212533Scsvaf ub = s->symvalue.rangev.upper;
69312533Scsvaf if (i < lb or i > ub) {
69429869Smckusick warning("subscript out of range");
69512533Scsvaf }
69618213Slinton push(long, base + (i - lb) * size(t->type));
69712533Scsvaf }
69816606Ssam
69916606Ssam /*
70016606Ssam * Initialize typetable information.
70116606Ssam */
70216606Ssam
c_modinit(typetable)70316606Ssam public c_modinit (typetable)
70416606Ssam Symbol typetable[];
70516606Ssam {
70616606Ssam /* nothing right now */
70716606Ssam }
70816606Ssam
c_hasmodules()70916606Ssam public boolean c_hasmodules ()
71016606Ssam {
71116606Ssam return false;
71216606Ssam }
71316606Ssam
c_passaddr(param,exprtype)71416606Ssam public boolean c_passaddr (param, exprtype)
71516606Ssam Symbol param, exprtype;
71616606Ssam {
71716606Ssam boolean b;
71816606Ssam Symbol t;
71916606Ssam
72016606Ssam t = rtype(exprtype);
72116606Ssam b = (boolean) (t->class == ARRAY);
72216606Ssam return b;
72316606Ssam }
724