121599Sdist /* 2*38105Sbostic * Copyright (c) 1983 The Regents of the University of California. 3*38105Sbostic * All rights reserved. 4*38105Sbostic * 5*38105Sbostic * Redistribution and use in source and binary forms are permitted 6*38105Sbostic * provided that the above copyright notice and this paragraph are 7*38105Sbostic * duplicated in all such forms and that any documentation, 8*38105Sbostic * advertising materials, and other materials related to such 9*38105Sbostic * distribution and use acknowledge that the software was developed 10*38105Sbostic * by the University of California, Berkeley. The name of the 11*38105Sbostic * University may not be used to endorse or promote products derived 12*38105Sbostic * from this software without specific prior written permission. 13*38105Sbostic * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR 14*38105Sbostic * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED 15*38105Sbostic * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. 1621599Sdist */ 179659Slinton 1821599Sdist #ifndef lint 19*38105Sbostic static char sccsid[] = "@(#)c.c 5.9 (Berkeley) 05/23/89"; 20*38105Sbostic #endif /* not lint */ 219659Slinton 229659Slinton /* 239659Slinton * C-dependent symbol routines. 249659Slinton */ 259659Slinton 269659Slinton #include "defs.h" 279659Slinton #include "symbols.h" 289659Slinton #include "printsym.h" 299659Slinton #include "languages.h" 309659Slinton #include "c.h" 319659Slinton #include "tree.h" 329659Slinton #include "eval.h" 339659Slinton #include "operators.h" 349659Slinton #include "mappings.h" 359659Slinton #include "process.h" 369659Slinton #include "runtime.h" 379659Slinton #include "machine.h" 389659Slinton 3912559Scsvaf #ifndef public 4033309Sdonn # include "tree.h" 4112559Scsvaf #endif 4212559Scsvaf 439659Slinton #define isdouble(range) ( \ 449659Slinton range->symvalue.rangev.upper == 0 and range->symvalue.rangev.lower > 0 \ 459659Slinton ) 469659Slinton 479659Slinton #define isrange(t, name) (t->class == RANGE and istypename(t->type, name)) 489659Slinton 4916606Ssam private Language langC; 5033309Sdonn private Language langCplpl; 5116606Ssam 529659Slinton /* 539659Slinton * Initialize C language information. 549659Slinton */ 559659Slinton 569659Slinton public c_init() 579659Slinton { 5816606Ssam langC = language_define("c", ".c"); 5916606Ssam language_setop(langC, L_PRINTDECL, c_printdecl); 6016606Ssam language_setop(langC, L_PRINTVAL, c_printval); 6116606Ssam language_setop(langC, L_TYPEMATCH, c_typematch); 6216606Ssam language_setop(langC, L_BUILDAREF, c_buildaref); 6316606Ssam language_setop(langC, L_EVALAREF, c_evalaref); 6416606Ssam language_setop(langC, L_MODINIT, c_modinit); 6516606Ssam language_setop(langC, L_HASMODULES, c_hasmodules); 6616606Ssam language_setop(langC, L_PASSADDR, c_passaddr); 6733309Sdonn 6833309Sdonn langCplpl = language_define("c++", "..c"); 6933309Sdonn language_setop(langCplpl, L_PRINTDECL, c_printdecl); 7033309Sdonn language_setop(langCplpl, L_PRINTVAL, c_printval); 7133309Sdonn language_setop(langCplpl, L_TYPEMATCH, c_typematch); 7233309Sdonn language_setop(langCplpl, L_BUILDAREF, c_buildaref); 7333309Sdonn language_setop(langCplpl, L_EVALAREF, c_evalaref); 7433309Sdonn language_setop(langCplpl, L_MODINIT, c_modinit); 7533309Sdonn language_setop(langCplpl, L_HASMODULES, c_hasmodules); 7633309Sdonn language_setop(langCplpl, L_PASSADDR, c_passaddr); 779659Slinton } 789659Slinton 799659Slinton /* 809659Slinton * Test if two types are compatible. 819659Slinton */ 829659Slinton 839659Slinton public Boolean c_typematch(type1, type2) 849659Slinton Symbol type1, type2; 859659Slinton { 869659Slinton Boolean b; 879659Slinton register Symbol t1, t2, tmp; 889659Slinton 899659Slinton t1 = type1; 909659Slinton t2 = type2; 919659Slinton if (t1 == t2) { 929659Slinton b = true; 939659Slinton } else { 949659Slinton t1 = rtype(t1); 959659Slinton t2 = rtype(t2); 9616606Ssam if (t1 == t_char->type or t1 == t_int->type or t1 == t_real->type) { 979659Slinton tmp = t1; 989659Slinton t1 = t2; 999659Slinton t2 = tmp; 1009659Slinton } 1019659Slinton b = (Boolean) ( 1029659Slinton ( 10334258Sdonn isrange(t1, "int") and !isdouble(t1) /* sigh */ and 10416606Ssam (t2 == t_int->type or t2 == t_char->type) 1059659Slinton ) or ( 1069659Slinton isrange(t1, "char") and 10716606Ssam (t2 == t_char->type or t2 == t_int->type) 1089659Slinton ) or ( 10916606Ssam t1->class == RANGE and isdouble(t1) and t2 == t_real->type 11013839Slinton ) or ( 11118213Slinton t1->class == RANGE and t2->class == RANGE and 11218213Slinton t1->symvalue.rangev.lower == t2->symvalue.rangev.lower and 11318213Slinton t1->symvalue.rangev.upper == t2->symvalue.rangev.upper 11418213Slinton ) or ( 11534258Sdonn t1->class != RANGE and t1->type == t2->type and ( 1169659Slinton (t1->class == t2->class) or 1179659Slinton (t1->class == SCAL and t2->class == CONST) or 1189659Slinton (t1->class == CONST and t2->class == SCAL) 1199659Slinton ) 12016606Ssam ) or ( 12116606Ssam t1->class == PTR and c_typematch(t1->type, t_char) and 12216606Ssam t2->class == ARRAY and c_typematch(t2->type, t_char) and 12316606Ssam t2->language == primlang 1249659Slinton ) 1259659Slinton ); 1269659Slinton } 1279659Slinton return b; 1289659Slinton } 1299659Slinton 1309659Slinton /* 1319659Slinton * Print out the declaration of a C variable. 1329659Slinton */ 1339659Slinton 1349659Slinton public c_printdecl(s) 1359659Slinton Symbol s; 1369659Slinton { 1379659Slinton printdecl(s, 0); 1389659Slinton } 1399659Slinton 1409659Slinton private printdecl(s, indent) 1419659Slinton register Symbol s; 1429659Slinton Integer indent; 1439659Slinton { 1449659Slinton register Symbol t; 1459659Slinton Boolean semicolon, newline; 1469659Slinton 1479659Slinton semicolon = true; 1489659Slinton newline = true; 1499659Slinton if (indent > 0) { 1509659Slinton printf("%*c", indent, ' '); 1519659Slinton } 1529659Slinton if (s->class == TYPE) { 1539659Slinton printf("typedef "); 1549659Slinton } 1559659Slinton switch (s->class) { 1569659Slinton case CONST: 1579659Slinton if (s->type->class == SCAL) { 15818213Slinton printf("enumeration constant with value "); 15918213Slinton eval(s->symvalue.constval); 16018213Slinton c_printval(s); 1619659Slinton } else { 1629659Slinton printf("const %s = ", symname(s)); 1639659Slinton printval(s); 1649659Slinton } 1659659Slinton break; 1669659Slinton 1679659Slinton case TYPE: 1689659Slinton case VAR: 16933309Sdonn if (s->class != TYPE and s->storage == INREG) { 17018213Slinton printf("register "); 1719659Slinton } 1729659Slinton if (s->type->class == ARRAY) { 1739659Slinton printtype(s->type, s->type->type, indent); 1749659Slinton t = rtype(s->type->chain); 1759659Slinton assert(t->class == RANGE); 1769659Slinton printf(" %s[%d]", symname(s), t->symvalue.rangev.upper + 1); 1779659Slinton } else { 1789659Slinton printtype(s, s->type, indent); 1799659Slinton if (s->type->class != PTR) { 1809659Slinton printf(" "); 1819659Slinton } 1829659Slinton printf("%s", symname(s)); 1839659Slinton } 1849659Slinton break; 1859659Slinton 1869659Slinton case FIELD: 1879659Slinton if (s->type->class == ARRAY) { 1889659Slinton printtype(s->type, s->type->type, indent); 1899659Slinton t = rtype(s->type->chain); 1909659Slinton assert(t->class == RANGE); 1919659Slinton printf(" %s[%d]", symname(s), t->symvalue.rangev.upper + 1); 1929659Slinton } else { 1939659Slinton printtype(s, s->type, indent); 1949659Slinton if (s->type->class != PTR) { 1959659Slinton printf(" "); 1969659Slinton } 1979659Slinton printf("%s", symname(s)); 1989659Slinton } 1999659Slinton if (isbitfield(s)) { 2009659Slinton printf(" : %d", s->symvalue.field.length); 2019659Slinton } 2029659Slinton break; 2039659Slinton 2049659Slinton case TAG: 2059659Slinton if (s->type == nil) { 2069659Slinton findtype(s); 2079659Slinton if (s->type == nil) { 2089659Slinton error("unexpected missing type information"); 2099659Slinton } 2109659Slinton } 2119659Slinton printtype(s, s->type, indent); 2129659Slinton break; 2139659Slinton 2149659Slinton case RANGE: 2159659Slinton case ARRAY: 2169659Slinton case RECORD: 2179659Slinton case VARNT: 2189659Slinton case PTR: 21918213Slinton case FFUNC: 2209659Slinton semicolon = false; 2219659Slinton printtype(s, s, indent); 2229659Slinton break; 2239659Slinton 22418213Slinton case SCAL: 22518213Slinton printf("(enumeration constant, value %d)", s->symvalue.iconval); 22618213Slinton break; 22718213Slinton 2289659Slinton case PROC: 2299659Slinton semicolon = false; 2309659Slinton printf("%s", symname(s)); 2319659Slinton c_listparams(s); 2329659Slinton newline = false; 2339659Slinton break; 2349659Slinton 2359659Slinton case FUNC: 2369659Slinton semicolon = false; 2379659Slinton if (not istypename(s->type, "void")) { 2389659Slinton printtype(s, s->type, indent); 2399659Slinton printf(" "); 2409659Slinton } 2419659Slinton printf("%s", symname(s)); 2429659Slinton c_listparams(s); 2439659Slinton newline = false; 2449659Slinton break; 2459659Slinton 2469659Slinton case MODULE: 2479659Slinton semicolon = false; 2489659Slinton printf("source file \"%s.c\"", symname(s)); 2499659Slinton break; 2509659Slinton 2519659Slinton case PROG: 2529659Slinton semicolon = false; 2539659Slinton printf("executable file \"%s\"", symname(s)); 2549659Slinton break; 2559659Slinton 2569659Slinton default: 25718213Slinton printf("[%s]", classname(s)); 25818213Slinton break; 2599659Slinton } 2609659Slinton if (semicolon) { 2619659Slinton putchar(';'); 2629659Slinton } 2639659Slinton if (newline) { 2649659Slinton putchar('\n'); 2659659Slinton } 2669659Slinton } 2679659Slinton 2689659Slinton /* 2699659Slinton * Recursive whiz-bang procedure to print the type portion 2709659Slinton * of a declaration. 2719659Slinton * 2729659Slinton * The symbol associated with the type is passed to allow 2739659Slinton * searching for type names without getting "type blah = blah". 2749659Slinton */ 2759659Slinton 2769659Slinton private printtype(s, t, indent) 2779659Slinton Symbol s; 2789659Slinton Symbol t; 2799659Slinton Integer indent; 2809659Slinton { 2819659Slinton register Symbol i; 2829659Slinton long r0, r1; 2839659Slinton register String p; 2849659Slinton 2859659Slinton checkref(s); 2869659Slinton checkref(t); 2879659Slinton switch (t->class) { 2889659Slinton case VAR: 2899659Slinton case CONST: 2909659Slinton case PROC: 2919659Slinton panic("printtype: class %s", classname(t)); 2929659Slinton break; 2939659Slinton 2949659Slinton case ARRAY: 2959659Slinton printf("array["); 2969659Slinton i = t->chain; 2979659Slinton if (i != nil) { 2989659Slinton for (;;) { 2999659Slinton printtype(i, i, indent); 3009659Slinton i = i->chain; 3019659Slinton if (i == nil) { 3029659Slinton break; 3039659Slinton } 3049659Slinton printf(", "); 3059659Slinton } 3069659Slinton } 3079659Slinton printf("] of "); 3089659Slinton printtype(t, t->type, indent); 3099659Slinton break; 3109659Slinton 3119659Slinton case RECORD: 3129659Slinton case VARNT: 3139659Slinton printf("%s ", c_classname(t)); 3149659Slinton if (s->name != nil and s->class == TAG) { 3159659Slinton p = symname(s); 3169659Slinton if (p[0] == '$' and p[1] == '$') { 3179659Slinton printf("%s ", &p[2]); 3189659Slinton } else { 3199659Slinton printf("%s ", p); 3209659Slinton } 3219659Slinton } 32231752Ssam printf("{\n"); 3239659Slinton for (i = t->chain; i != nil; i = i->chain) { 3249659Slinton assert(i->class == FIELD); 3259659Slinton printdecl(i, indent+4); 3269659Slinton } 3279659Slinton if (indent > 0) { 3289659Slinton printf("%*c", indent, ' '); 3299659Slinton } 3309659Slinton printf("}"); 3319659Slinton break; 3329659Slinton 3339659Slinton case RANGE: 3349659Slinton r0 = t->symvalue.rangev.lower; 3359659Slinton r1 = t->symvalue.rangev.upper; 3369659Slinton if (istypename(t->type, "char")) { 3379659Slinton if (r0 < 0x20 or r0 > 0x7e) { 3389659Slinton printf("%ld..", r0); 3399659Slinton } else { 3409659Slinton printf("'%c'..", (char) r0); 3419659Slinton } 3429659Slinton if (r1 < 0x20 or r1 > 0x7e) { 3439659Slinton printf("\\%lo", r1); 3449659Slinton } else { 3459659Slinton printf("'%c'", (char) r1); 3469659Slinton } 3479659Slinton } else if (r0 > 0 and r1 == 0) { 3489659Slinton printf("%ld byte real", r0); 3499659Slinton } else if (r0 >= 0) { 3509659Slinton printf("%lu..%lu", r0, r1); 3519659Slinton } else { 3529659Slinton printf("%ld..%ld", r0, r1); 3539659Slinton } 3549659Slinton break; 3559659Slinton 3569659Slinton case PTR: 3579659Slinton printtype(t, t->type, indent); 3589659Slinton if (t->type->class != PTR) { 3599659Slinton printf(" "); 3609659Slinton } 3619659Slinton printf("*"); 3629659Slinton break; 3639659Slinton 3649659Slinton case FUNC: 36516606Ssam case FFUNC: 3669659Slinton printtype(t, t->type, indent); 3679659Slinton printf("()"); 3689659Slinton break; 3699659Slinton 3709659Slinton case TYPE: 3719659Slinton if (t->name != nil) { 37216606Ssam printname(stdout, t); 3739659Slinton } else { 3749659Slinton printtype(t, t->type, indent); 3759659Slinton } 3769659Slinton break; 3779659Slinton 3789659Slinton case TYPEREF: 3799659Slinton printf("@%s", symname(t)); 3809659Slinton break; 3819659Slinton 3829659Slinton case SCAL: 3839659Slinton printf("enum "); 3849659Slinton if (s->name != nil and s->class == TAG) { 3859659Slinton printf("%s ", symname(s)); 3869659Slinton } 3879659Slinton printf("{ "); 3889659Slinton i = t->chain; 3899659Slinton if (i != nil) { 3909659Slinton for (;;) { 3919659Slinton printf("%s", symname(i)); 3929659Slinton i = i->chain; 3939659Slinton if (i == nil) break; 3949659Slinton printf(", "); 3959659Slinton } 3969659Slinton } 3979659Slinton printf(" }"); 3989659Slinton break; 3999659Slinton 4009659Slinton case TAG: 4019659Slinton if (t->type == nil) { 4029659Slinton printf("unresolved tag %s", symname(t)); 4039659Slinton } else { 4049659Slinton i = rtype(t->type); 4059659Slinton printf("%s %s", c_classname(i), symname(t)); 4069659Slinton } 4079659Slinton break; 4089659Slinton 4099659Slinton default: 4109659Slinton printf("(class %d)", t->class); 4119659Slinton break; 4129659Slinton } 4139659Slinton } 4149659Slinton 4159659Slinton /* 4169659Slinton * List the parameters of a procedure or function. 4179659Slinton * No attempt is made to combine like types. 4189659Slinton */ 4199659Slinton 4209659Slinton public c_listparams(s) 4219659Slinton Symbol s; 4229659Slinton { 4239659Slinton register Symbol t; 4249659Slinton 4259659Slinton putchar('('); 4269659Slinton for (t = s->chain; t != nil; t = t->chain) { 4279659Slinton printf("%s", symname(t)); 4289659Slinton if (t->chain != nil) { 4299659Slinton printf(", "); 4309659Slinton } 4319659Slinton } 4329659Slinton putchar(')'); 4339659Slinton if (s->chain != nil) { 4349659Slinton printf("\n"); 4359659Slinton for (t = s->chain; t != nil; t = t->chain) { 4369659Slinton if (t->class != VAR) { 4379659Slinton panic("unexpected class %d for parameter", t->class); 4389659Slinton } 4399659Slinton printdecl(t, 0); 4409659Slinton } 4419659Slinton } else { 4429659Slinton putchar('\n'); 4439659Slinton } 4449659Slinton } 4459659Slinton 4469659Slinton /* 4479659Slinton * Print out the value on the top of the expression stack 4489659Slinton * in the format for the type of the given symbol. 4499659Slinton */ 4509659Slinton 4519659Slinton public c_printval(s) 4529659Slinton Symbol s; 4539659Slinton { 4549659Slinton register Symbol t; 4559659Slinton register Address a; 45616606Ssam integer i, len; 45729869Smckusick register String str; 4589659Slinton 4599659Slinton switch (s->class) { 4609659Slinton case CONST: 4619659Slinton case TYPE: 4629659Slinton case VAR: 4639659Slinton case REF: 4649659Slinton case FVAR: 4659659Slinton case TAG: 4669659Slinton c_printval(s->type); 4679659Slinton break; 4689659Slinton 4699659Slinton case FIELD: 4709659Slinton if (isbitfield(s)) { 47133309Sdonn i = extractField(s); 4729659Slinton t = rtype(s->type); 4739659Slinton if (t->class == SCAL) { 47418213Slinton printEnum(i, t); 4759659Slinton } else { 47618213Slinton printRangeVal(i, t); 4779659Slinton } 4789659Slinton } else { 4799659Slinton c_printval(s->type); 4809659Slinton } 4819659Slinton break; 4829659Slinton 4839659Slinton case ARRAY: 4849659Slinton t = rtype(s->type); 48516606Ssam if ((t->class == RANGE and istypename(t->type, "char")) or 48616606Ssam t == t_char->type 48716606Ssam ) { 4889659Slinton len = size(s); 48929869Smckusick str = (String) (sp -= len); 49029869Smckusick if (s->language != primlang) { 49129869Smckusick putchar('"'); 49218213Slinton } 49329869Smckusick while (--len > 0 and *str != '\0') { 49429869Smckusick printchar(*str++); 49529869Smckusick } 49629869Smckusick if (*str != '\0') { /* XXX - pitch trailing null */ 49729869Smckusick printchar(*str); 49829869Smckusick } 49929869Smckusick if (s->language != primlang) { 50029869Smckusick putchar('"'); 50129869Smckusick } 5029659Slinton } else { 5039659Slinton printarray(s); 5049659Slinton } 5059659Slinton break; 5069659Slinton 5079659Slinton case RECORD: 5089659Slinton c_printstruct(s); 5099659Slinton break; 5109659Slinton 5119659Slinton case RANGE: 51218213Slinton if (s == t_boolean->type or istypename(s->type, "boolean")) { 51318213Slinton printRangeVal(popsmall(s), s); 51418213Slinton } else if (s == t_char->type or istypename(s->type, "char")) { 51518213Slinton printRangeVal(pop(char), s); 51618213Slinton } else if (s == t_real->type or isdouble(s)) { 5179659Slinton switch (s->symvalue.rangev.lower) { 5189659Slinton case sizeof(float): 51933309Sdonn prtreal((double) (pop(float))); 5209659Slinton break; 5219659Slinton 5229659Slinton case sizeof(double): 5239659Slinton prtreal(pop(double)); 5249659Slinton break; 5259659Slinton 5269659Slinton default: 5279659Slinton panic("bad real size %d", t->symvalue.rangev.lower); 5289659Slinton break; 5299659Slinton } 5309659Slinton } else { 53118213Slinton printRangeVal(popsmall(s), s); 5329659Slinton } 5339659Slinton break; 5349659Slinton 5359659Slinton case PTR: 5369659Slinton t = rtype(s->type); 5379659Slinton a = pop(Address); 5389659Slinton if (a == 0) { 5399659Slinton printf("(nil)"); 5409659Slinton } else if (t->class == RANGE and istypename(t->type, "char")) { 54118213Slinton printString(a, (boolean) (s->language != primlang)); 5429659Slinton } else { 5439659Slinton printf("0x%x", a); 5449659Slinton } 5459659Slinton break; 5469659Slinton 5479659Slinton case SCAL: 5489659Slinton i = pop(Integer); 54918213Slinton printEnum(i, s); 5509659Slinton break; 5519659Slinton 55218213Slinton /* 55318213Slinton * Unresolved structure pointers? 55418213Slinton */ 55518213Slinton case BADUSE: 55618213Slinton a = pop(Address); 55718213Slinton printf("@%x", a); 55818213Slinton break; 55918213Slinton 5609659Slinton default: 5619659Slinton if (ord(s->class) > ord(TYPEREF)) { 5629659Slinton panic("printval: bad class %d", ord(s->class)); 5639659Slinton } 56414382Slinton sp -= size(s); 56516606Ssam printf("[%s]", c_classname(s)); 56614382Slinton break; 5679659Slinton } 5689659Slinton } 5699659Slinton 5709659Slinton /* 5719659Slinton * Print out a C structure. 5729659Slinton */ 5739659Slinton 57418213Slinton private c_printstruct (s) 5759659Slinton Symbol s; 5769659Slinton { 57718213Slinton Symbol f; 57818213Slinton Stack *savesp; 57918213Slinton integer n, off, len; 5809659Slinton 5819659Slinton sp -= size(s); 5829659Slinton savesp = sp; 5839659Slinton printf("("); 5849659Slinton f = s->chain; 5859659Slinton for (;;) { 5869659Slinton off = f->symvalue.field.offset; 5879659Slinton len = f->symvalue.field.length; 58816606Ssam n = (off + len + BITSPERBYTE - 1) div BITSPERBYTE; 5899659Slinton sp += n; 5909659Slinton printf("%s = ", symname(f)); 5919659Slinton c_printval(f); 5929659Slinton sp = savesp; 5939659Slinton f = f->chain; 5949659Slinton if (f == nil) break; 5959659Slinton printf(", "); 5969659Slinton } 5979659Slinton printf(")"); 5989659Slinton } 5999659Slinton 6009659Slinton /* 6019659Slinton * Return the C name for the particular class of a symbol. 6029659Slinton */ 6039659Slinton 6049659Slinton public String c_classname(s) 6059659Slinton Symbol s; 6069659Slinton { 6079659Slinton String str; 6089659Slinton 6099659Slinton switch (s->class) { 6109659Slinton case RECORD: 6119659Slinton str = "struct"; 6129659Slinton break; 6139659Slinton 6149659Slinton case VARNT: 6159659Slinton str = "union"; 6169659Slinton break; 6179659Slinton 6189659Slinton case SCAL: 6199659Slinton str = "enum"; 6209659Slinton break; 6219659Slinton 6229659Slinton default: 6239659Slinton str = classname(s); 6249659Slinton } 6259659Slinton return str; 6269659Slinton } 62718213Slinton 62812533Scsvaf public Node c_buildaref(a, slist) 62912533Scsvaf Node a, slist; 63012533Scsvaf { 63112533Scsvaf register Symbol t; 63212533Scsvaf register Node p; 63312533Scsvaf Symbol etype, atype, eltype; 63418213Slinton Node r, esub; 63512533Scsvaf 63612533Scsvaf t = rtype(a->nodetype); 63712533Scsvaf eltype = t->type; 63812533Scsvaf if (t->class == PTR) { 63912533Scsvaf p = slist->value.arg[0]; 64012533Scsvaf if (not compatible(p->nodetype, t_int)) { 64112533Scsvaf beginerrmsg(); 64218213Slinton fprintf(stderr, "subscript must be integer-compatible"); 64312533Scsvaf enderrmsg(); 64412533Scsvaf } 64512533Scsvaf r = build(O_MUL, p, build(O_LCON, (long) size(eltype))); 64612533Scsvaf r = build(O_ADD, build(O_RVAL, a), r); 64712533Scsvaf r->nodetype = eltype; 64812533Scsvaf } else if (t->class != ARRAY) { 64912533Scsvaf beginerrmsg(); 65018213Slinton fprintf(stderr, "\""); 65112533Scsvaf prtree(stderr, a); 65218213Slinton fprintf(stderr, "\" is not an array"); 65312533Scsvaf enderrmsg(); 65412533Scsvaf } else { 65518213Slinton r = a; 65612533Scsvaf p = slist; 65712533Scsvaf t = t->chain; 65812533Scsvaf for (; p != nil and t != nil; p = p->value.arg[1], t = t->chain) { 65912533Scsvaf esub = p->value.arg[0]; 66012533Scsvaf etype = rtype(esub->nodetype); 66112533Scsvaf atype = rtype(t); 66212533Scsvaf if (not compatible(atype, etype)) { 66312533Scsvaf beginerrmsg(); 66418213Slinton fprintf(stderr, "subscript \""); 66512533Scsvaf prtree(stderr, esub); 66618213Slinton fprintf(stderr, "\" is the wrong type"); 66712533Scsvaf enderrmsg(); 66812533Scsvaf } 66912533Scsvaf r = build(O_INDEX, r, esub); 67012533Scsvaf r->nodetype = eltype; 67112533Scsvaf } 67212533Scsvaf if (p != nil or t != nil) { 67312533Scsvaf beginerrmsg(); 67412533Scsvaf if (p != nil) { 67518213Slinton fprintf(stderr, "too many subscripts for \""); 67612533Scsvaf } else { 67718213Slinton fprintf(stderr, "not enough subscripts for \""); 67812533Scsvaf } 67912533Scsvaf prtree(stderr, a); 68018213Slinton fprintf(stderr, "\""); 68112533Scsvaf enderrmsg(); 68212533Scsvaf } 68312533Scsvaf } 68412533Scsvaf return r; 68512533Scsvaf } 68612533Scsvaf 68712533Scsvaf /* 68812533Scsvaf * Evaluate a subscript index. 68912533Scsvaf */ 69012533Scsvaf 69118213Slinton public c_evalaref(s, base, i) 69212533Scsvaf Symbol s; 69318213Slinton Address base; 69412533Scsvaf long i; 69512533Scsvaf { 69618213Slinton Symbol t; 69712533Scsvaf long lb, ub; 69812533Scsvaf 69918213Slinton t = rtype(s); 70018213Slinton s = t->chain; 70112533Scsvaf lb = s->symvalue.rangev.lower; 70212533Scsvaf ub = s->symvalue.rangev.upper; 70312533Scsvaf if (i < lb or i > ub) { 70429869Smckusick warning("subscript out of range"); 70512533Scsvaf } 70618213Slinton push(long, base + (i - lb) * size(t->type)); 70712533Scsvaf } 70816606Ssam 70916606Ssam /* 71016606Ssam * Initialize typetable information. 71116606Ssam */ 71216606Ssam 71316606Ssam public c_modinit (typetable) 71416606Ssam Symbol typetable[]; 71516606Ssam { 71616606Ssam /* nothing right now */ 71716606Ssam } 71816606Ssam 71916606Ssam public boolean c_hasmodules () 72016606Ssam { 72116606Ssam return false; 72216606Ssam } 72316606Ssam 72416606Ssam public boolean c_passaddr (param, exprtype) 72516606Ssam Symbol param, exprtype; 72616606Ssam { 72716606Ssam boolean b; 72816606Ssam Symbol t; 72916606Ssam 73016606Ssam t = rtype(exprtype); 73116606Ssam b = (boolean) (t->class == ARRAY); 73216606Ssam return b; 73316606Ssam } 734