121599Sdist /* 221599Sdist * Copyright (c) 1983 Regents of the University of California. 321599Sdist * All rights reserved. The Berkeley software License Agreement 421599Sdist * specifies the terms and conditions for redistribution. 521599Sdist */ 69659Slinton 721599Sdist #ifndef lint 8*33309Sdonn static char sccsid[] = "@(#)c.c 5.7 (Berkeley) 01/11/88"; 921599Sdist #endif not lint 109659Slinton 11*33309Sdonn static char rcsid[] = "$Header: c.c,v 1.4 88/01/12 00:46:21 donn Exp $"; 1218213Slinton 139659Slinton /* 149659Slinton * C-dependent symbol routines. 159659Slinton */ 169659Slinton 179659Slinton #include "defs.h" 189659Slinton #include "symbols.h" 199659Slinton #include "printsym.h" 209659Slinton #include "languages.h" 219659Slinton #include "c.h" 229659Slinton #include "tree.h" 239659Slinton #include "eval.h" 249659Slinton #include "operators.h" 259659Slinton #include "mappings.h" 269659Slinton #include "process.h" 279659Slinton #include "runtime.h" 289659Slinton #include "machine.h" 299659Slinton 3012559Scsvaf #ifndef public 31*33309Sdonn # include "tree.h" 3212559Scsvaf #endif 3312559Scsvaf 349659Slinton #define isdouble(range) ( \ 359659Slinton range->symvalue.rangev.upper == 0 and range->symvalue.rangev.lower > 0 \ 369659Slinton ) 379659Slinton 389659Slinton #define isrange(t, name) (t->class == RANGE and istypename(t->type, name)) 399659Slinton 4016606Ssam private Language langC; 41*33309Sdonn private Language langCplpl; 4216606Ssam 439659Slinton /* 449659Slinton * Initialize C language information. 459659Slinton */ 469659Slinton 479659Slinton public c_init() 489659Slinton { 4916606Ssam langC = language_define("c", ".c"); 5016606Ssam language_setop(langC, L_PRINTDECL, c_printdecl); 5116606Ssam language_setop(langC, L_PRINTVAL, c_printval); 5216606Ssam language_setop(langC, L_TYPEMATCH, c_typematch); 5316606Ssam language_setop(langC, L_BUILDAREF, c_buildaref); 5416606Ssam language_setop(langC, L_EVALAREF, c_evalaref); 5516606Ssam language_setop(langC, L_MODINIT, c_modinit); 5616606Ssam language_setop(langC, L_HASMODULES, c_hasmodules); 5716606Ssam language_setop(langC, L_PASSADDR, c_passaddr); 58*33309Sdonn 59*33309Sdonn langCplpl = language_define("c++", "..c"); 60*33309Sdonn language_setop(langCplpl, L_PRINTDECL, c_printdecl); 61*33309Sdonn language_setop(langCplpl, L_PRINTVAL, c_printval); 62*33309Sdonn language_setop(langCplpl, L_TYPEMATCH, c_typematch); 63*33309Sdonn language_setop(langCplpl, L_BUILDAREF, c_buildaref); 64*33309Sdonn language_setop(langCplpl, L_EVALAREF, c_evalaref); 65*33309Sdonn language_setop(langCplpl, L_MODINIT, c_modinit); 66*33309Sdonn language_setop(langCplpl, L_HASMODULES, c_hasmodules); 67*33309Sdonn language_setop(langCplpl, L_PASSADDR, c_passaddr); 689659Slinton } 699659Slinton 709659Slinton /* 719659Slinton * Test if two types are compatible. 729659Slinton */ 739659Slinton 749659Slinton public Boolean c_typematch(type1, type2) 759659Slinton Symbol type1, type2; 769659Slinton { 779659Slinton Boolean b; 789659Slinton register Symbol t1, t2, tmp; 799659Slinton 809659Slinton t1 = type1; 819659Slinton t2 = type2; 829659Slinton if (t1 == t2) { 839659Slinton b = true; 849659Slinton } else { 859659Slinton t1 = rtype(t1); 869659Slinton t2 = rtype(t2); 8716606Ssam if (t1 == t_char->type or t1 == t_int->type or t1 == t_real->type) { 889659Slinton tmp = t1; 899659Slinton t1 = t2; 909659Slinton t2 = tmp; 919659Slinton } 929659Slinton b = (Boolean) ( 939659Slinton ( 949659Slinton isrange(t1, "int") and 9516606Ssam (t2 == t_int->type or t2 == t_char->type) 969659Slinton ) or ( 979659Slinton isrange(t1, "char") and 9816606Ssam (t2 == t_char->type or t2 == t_int->type) 999659Slinton ) or ( 10016606Ssam t1->class == RANGE and isdouble(t1) and t2 == t_real->type 10113839Slinton ) or ( 10218213Slinton t1->class == RANGE and t2->class == RANGE and 10318213Slinton t1->symvalue.rangev.lower == t2->symvalue.rangev.lower and 10418213Slinton t1->symvalue.rangev.upper == t2->symvalue.rangev.upper 10518213Slinton ) or ( 1069659Slinton t1->type == t2->type and ( 1079659Slinton (t1->class == t2->class) or 1089659Slinton (t1->class == SCAL and t2->class == CONST) or 1099659Slinton (t1->class == CONST and t2->class == SCAL) 1109659Slinton ) 11116606Ssam ) or ( 11216606Ssam t1->class == PTR and c_typematch(t1->type, t_char) and 11316606Ssam t2->class == ARRAY and c_typematch(t2->type, t_char) and 11416606Ssam t2->language == primlang 1159659Slinton ) 1169659Slinton ); 1179659Slinton } 1189659Slinton return b; 1199659Slinton } 1209659Slinton 1219659Slinton /* 1229659Slinton * Print out the declaration of a C variable. 1239659Slinton */ 1249659Slinton 1259659Slinton public c_printdecl(s) 1269659Slinton Symbol s; 1279659Slinton { 1289659Slinton printdecl(s, 0); 1299659Slinton } 1309659Slinton 1319659Slinton private printdecl(s, indent) 1329659Slinton register Symbol s; 1339659Slinton Integer indent; 1349659Slinton { 1359659Slinton register Symbol t; 1369659Slinton Boolean semicolon, newline; 1379659Slinton 1389659Slinton semicolon = true; 1399659Slinton newline = true; 1409659Slinton if (indent > 0) { 1419659Slinton printf("%*c", indent, ' '); 1429659Slinton } 1439659Slinton if (s->class == TYPE) { 1449659Slinton printf("typedef "); 1459659Slinton } 1469659Slinton switch (s->class) { 1479659Slinton case CONST: 1489659Slinton if (s->type->class == SCAL) { 14918213Slinton printf("enumeration constant with value "); 15018213Slinton eval(s->symvalue.constval); 15118213Slinton c_printval(s); 1529659Slinton } else { 1539659Slinton printf("const %s = ", symname(s)); 1549659Slinton printval(s); 1559659Slinton } 1569659Slinton break; 1579659Slinton 1589659Slinton case TYPE: 1599659Slinton case VAR: 160*33309Sdonn if (s->class != TYPE and s->storage == INREG) { 16118213Slinton printf("register "); 1629659Slinton } 1639659Slinton if (s->type->class == ARRAY) { 1649659Slinton printtype(s->type, s->type->type, indent); 1659659Slinton t = rtype(s->type->chain); 1669659Slinton assert(t->class == RANGE); 1679659Slinton printf(" %s[%d]", symname(s), t->symvalue.rangev.upper + 1); 1689659Slinton } else { 1699659Slinton printtype(s, s->type, indent); 1709659Slinton if (s->type->class != PTR) { 1719659Slinton printf(" "); 1729659Slinton } 1739659Slinton printf("%s", symname(s)); 1749659Slinton } 1759659Slinton break; 1769659Slinton 1779659Slinton case FIELD: 1789659Slinton if (s->type->class == ARRAY) { 1799659Slinton printtype(s->type, s->type->type, indent); 1809659Slinton t = rtype(s->type->chain); 1819659Slinton assert(t->class == RANGE); 1829659Slinton printf(" %s[%d]", symname(s), t->symvalue.rangev.upper + 1); 1839659Slinton } else { 1849659Slinton printtype(s, s->type, indent); 1859659Slinton if (s->type->class != PTR) { 1869659Slinton printf(" "); 1879659Slinton } 1889659Slinton printf("%s", symname(s)); 1899659Slinton } 1909659Slinton if (isbitfield(s)) { 1919659Slinton printf(" : %d", s->symvalue.field.length); 1929659Slinton } 1939659Slinton break; 1949659Slinton 1959659Slinton case TAG: 1969659Slinton if (s->type == nil) { 1979659Slinton findtype(s); 1989659Slinton if (s->type == nil) { 1999659Slinton error("unexpected missing type information"); 2009659Slinton } 2019659Slinton } 2029659Slinton printtype(s, s->type, indent); 2039659Slinton break; 2049659Slinton 2059659Slinton case RANGE: 2069659Slinton case ARRAY: 2079659Slinton case RECORD: 2089659Slinton case VARNT: 2099659Slinton case PTR: 21018213Slinton case FFUNC: 2119659Slinton semicolon = false; 2129659Slinton printtype(s, s, indent); 2139659Slinton break; 2149659Slinton 21518213Slinton case SCAL: 21618213Slinton printf("(enumeration constant, value %d)", s->symvalue.iconval); 21718213Slinton break; 21818213Slinton 2199659Slinton case PROC: 2209659Slinton semicolon = false; 2219659Slinton printf("%s", symname(s)); 2229659Slinton c_listparams(s); 2239659Slinton newline = false; 2249659Slinton break; 2259659Slinton 2269659Slinton case FUNC: 2279659Slinton semicolon = false; 2289659Slinton if (not istypename(s->type, "void")) { 2299659Slinton printtype(s, s->type, indent); 2309659Slinton printf(" "); 2319659Slinton } 2329659Slinton printf("%s", symname(s)); 2339659Slinton c_listparams(s); 2349659Slinton newline = false; 2359659Slinton break; 2369659Slinton 2379659Slinton case MODULE: 2389659Slinton semicolon = false; 2399659Slinton printf("source file \"%s.c\"", symname(s)); 2409659Slinton break; 2419659Slinton 2429659Slinton case PROG: 2439659Slinton semicolon = false; 2449659Slinton printf("executable file \"%s\"", symname(s)); 2459659Slinton break; 2469659Slinton 2479659Slinton default: 24818213Slinton printf("[%s]", classname(s)); 24918213Slinton break; 2509659Slinton } 2519659Slinton if (semicolon) { 2529659Slinton putchar(';'); 2539659Slinton } 2549659Slinton if (newline) { 2559659Slinton putchar('\n'); 2569659Slinton } 2579659Slinton } 2589659Slinton 2599659Slinton /* 2609659Slinton * Recursive whiz-bang procedure to print the type portion 2619659Slinton * of a declaration. 2629659Slinton * 2639659Slinton * The symbol associated with the type is passed to allow 2649659Slinton * searching for type names without getting "type blah = blah". 2659659Slinton */ 2669659Slinton 2679659Slinton private printtype(s, t, indent) 2689659Slinton Symbol s; 2699659Slinton Symbol t; 2709659Slinton Integer indent; 2719659Slinton { 2729659Slinton register Symbol i; 2739659Slinton long r0, r1; 2749659Slinton register String p; 2759659Slinton 2769659Slinton checkref(s); 2779659Slinton checkref(t); 2789659Slinton switch (t->class) { 2799659Slinton case VAR: 2809659Slinton case CONST: 2819659Slinton case PROC: 2829659Slinton panic("printtype: class %s", classname(t)); 2839659Slinton break; 2849659Slinton 2859659Slinton case ARRAY: 2869659Slinton printf("array["); 2879659Slinton i = t->chain; 2889659Slinton if (i != nil) { 2899659Slinton for (;;) { 2909659Slinton printtype(i, i, indent); 2919659Slinton i = i->chain; 2929659Slinton if (i == nil) { 2939659Slinton break; 2949659Slinton } 2959659Slinton printf(", "); 2969659Slinton } 2979659Slinton } 2989659Slinton printf("] of "); 2999659Slinton printtype(t, t->type, indent); 3009659Slinton break; 3019659Slinton 3029659Slinton case RECORD: 3039659Slinton case VARNT: 3049659Slinton printf("%s ", c_classname(t)); 3059659Slinton if (s->name != nil and s->class == TAG) { 3069659Slinton p = symname(s); 3079659Slinton if (p[0] == '$' and p[1] == '$') { 3089659Slinton printf("%s ", &p[2]); 3099659Slinton } else { 3109659Slinton printf("%s ", p); 3119659Slinton } 3129659Slinton } 31331752Ssam printf("{\n"); 3149659Slinton for (i = t->chain; i != nil; i = i->chain) { 3159659Slinton assert(i->class == FIELD); 3169659Slinton printdecl(i, indent+4); 3179659Slinton } 3189659Slinton if (indent > 0) { 3199659Slinton printf("%*c", indent, ' '); 3209659Slinton } 3219659Slinton printf("}"); 3229659Slinton break; 3239659Slinton 3249659Slinton case RANGE: 3259659Slinton r0 = t->symvalue.rangev.lower; 3269659Slinton r1 = t->symvalue.rangev.upper; 3279659Slinton if (istypename(t->type, "char")) { 3289659Slinton if (r0 < 0x20 or r0 > 0x7e) { 3299659Slinton printf("%ld..", r0); 3309659Slinton } else { 3319659Slinton printf("'%c'..", (char) r0); 3329659Slinton } 3339659Slinton if (r1 < 0x20 or r1 > 0x7e) { 3349659Slinton printf("\\%lo", r1); 3359659Slinton } else { 3369659Slinton printf("'%c'", (char) r1); 3379659Slinton } 3389659Slinton } else if (r0 > 0 and r1 == 0) { 3399659Slinton printf("%ld byte real", r0); 3409659Slinton } else if (r0 >= 0) { 3419659Slinton printf("%lu..%lu", r0, r1); 3429659Slinton } else { 3439659Slinton printf("%ld..%ld", r0, r1); 3449659Slinton } 3459659Slinton break; 3469659Slinton 3479659Slinton case PTR: 3489659Slinton printtype(t, t->type, indent); 3499659Slinton if (t->type->class != PTR) { 3509659Slinton printf(" "); 3519659Slinton } 3529659Slinton printf("*"); 3539659Slinton break; 3549659Slinton 3559659Slinton case FUNC: 35616606Ssam case FFUNC: 3579659Slinton printtype(t, t->type, indent); 3589659Slinton printf("()"); 3599659Slinton break; 3609659Slinton 3619659Slinton case TYPE: 3629659Slinton if (t->name != nil) { 36316606Ssam printname(stdout, t); 3649659Slinton } else { 3659659Slinton printtype(t, t->type, indent); 3669659Slinton } 3679659Slinton break; 3689659Slinton 3699659Slinton case TYPEREF: 3709659Slinton printf("@%s", symname(t)); 3719659Slinton break; 3729659Slinton 3739659Slinton case SCAL: 3749659Slinton printf("enum "); 3759659Slinton if (s->name != nil and s->class == TAG) { 3769659Slinton printf("%s ", symname(s)); 3779659Slinton } 3789659Slinton printf("{ "); 3799659Slinton i = t->chain; 3809659Slinton if (i != nil) { 3819659Slinton for (;;) { 3829659Slinton printf("%s", symname(i)); 3839659Slinton i = i->chain; 3849659Slinton if (i == nil) break; 3859659Slinton printf(", "); 3869659Slinton } 3879659Slinton } 3889659Slinton printf(" }"); 3899659Slinton break; 3909659Slinton 3919659Slinton case TAG: 3929659Slinton if (t->type == nil) { 3939659Slinton printf("unresolved tag %s", symname(t)); 3949659Slinton } else { 3959659Slinton i = rtype(t->type); 3969659Slinton printf("%s %s", c_classname(i), symname(t)); 3979659Slinton } 3989659Slinton break; 3999659Slinton 4009659Slinton default: 4019659Slinton printf("(class %d)", t->class); 4029659Slinton break; 4039659Slinton } 4049659Slinton } 4059659Slinton 4069659Slinton /* 4079659Slinton * List the parameters of a procedure or function. 4089659Slinton * No attempt is made to combine like types. 4099659Slinton */ 4109659Slinton 4119659Slinton public c_listparams(s) 4129659Slinton Symbol s; 4139659Slinton { 4149659Slinton register Symbol t; 4159659Slinton 4169659Slinton putchar('('); 4179659Slinton for (t = s->chain; t != nil; t = t->chain) { 4189659Slinton printf("%s", symname(t)); 4199659Slinton if (t->chain != nil) { 4209659Slinton printf(", "); 4219659Slinton } 4229659Slinton } 4239659Slinton putchar(')'); 4249659Slinton if (s->chain != nil) { 4259659Slinton printf("\n"); 4269659Slinton for (t = s->chain; t != nil; t = t->chain) { 4279659Slinton if (t->class != VAR) { 4289659Slinton panic("unexpected class %d for parameter", t->class); 4299659Slinton } 4309659Slinton printdecl(t, 0); 4319659Slinton } 4329659Slinton } else { 4339659Slinton putchar('\n'); 4349659Slinton } 4359659Slinton } 4369659Slinton 4379659Slinton /* 4389659Slinton * Print out the value on the top of the expression stack 4399659Slinton * in the format for the type of the given symbol. 4409659Slinton */ 4419659Slinton 4429659Slinton public c_printval(s) 4439659Slinton Symbol s; 4449659Slinton { 4459659Slinton register Symbol t; 4469659Slinton register Address a; 44716606Ssam integer i, len; 44829869Smckusick register String str; 4499659Slinton 4509659Slinton switch (s->class) { 4519659Slinton case CONST: 4529659Slinton case TYPE: 4539659Slinton case VAR: 4549659Slinton case REF: 4559659Slinton case FVAR: 4569659Slinton case TAG: 4579659Slinton c_printval(s->type); 4589659Slinton break; 4599659Slinton 4609659Slinton case FIELD: 4619659Slinton if (isbitfield(s)) { 462*33309Sdonn i = extractField(s); 4639659Slinton t = rtype(s->type); 4649659Slinton if (t->class == SCAL) { 46518213Slinton printEnum(i, t); 4669659Slinton } else { 46718213Slinton printRangeVal(i, t); 4689659Slinton } 4699659Slinton } else { 4709659Slinton c_printval(s->type); 4719659Slinton } 4729659Slinton break; 4739659Slinton 4749659Slinton case ARRAY: 4759659Slinton t = rtype(s->type); 47616606Ssam if ((t->class == RANGE and istypename(t->type, "char")) or 47716606Ssam t == t_char->type 47816606Ssam ) { 4799659Slinton len = size(s); 48029869Smckusick str = (String) (sp -= len); 48129869Smckusick if (s->language != primlang) { 48229869Smckusick putchar('"'); 48318213Slinton } 48429869Smckusick while (--len > 0 and *str != '\0') { 48529869Smckusick printchar(*str++); 48629869Smckusick } 48729869Smckusick if (*str != '\0') { /* XXX - pitch trailing null */ 48829869Smckusick printchar(*str); 48929869Smckusick } 49029869Smckusick if (s->language != primlang) { 49129869Smckusick putchar('"'); 49229869Smckusick } 4939659Slinton } else { 4949659Slinton printarray(s); 4959659Slinton } 4969659Slinton break; 4979659Slinton 4989659Slinton case RECORD: 4999659Slinton c_printstruct(s); 5009659Slinton break; 5019659Slinton 5029659Slinton case RANGE: 50318213Slinton if (s == t_boolean->type or istypename(s->type, "boolean")) { 50418213Slinton printRangeVal(popsmall(s), s); 50518213Slinton } else if (s == t_char->type or istypename(s->type, "char")) { 50618213Slinton printRangeVal(pop(char), s); 50718213Slinton } else if (s == t_real->type or isdouble(s)) { 5089659Slinton switch (s->symvalue.rangev.lower) { 5099659Slinton case sizeof(float): 510*33309Sdonn prtreal((double) (pop(float))); 5119659Slinton break; 5129659Slinton 5139659Slinton case sizeof(double): 5149659Slinton prtreal(pop(double)); 5159659Slinton break; 5169659Slinton 5179659Slinton default: 5189659Slinton panic("bad real size %d", t->symvalue.rangev.lower); 5199659Slinton break; 5209659Slinton } 5219659Slinton } else { 52218213Slinton printRangeVal(popsmall(s), s); 5239659Slinton } 5249659Slinton break; 5259659Slinton 5269659Slinton case PTR: 5279659Slinton t = rtype(s->type); 5289659Slinton a = pop(Address); 5299659Slinton if (a == 0) { 5309659Slinton printf("(nil)"); 5319659Slinton } else if (t->class == RANGE and istypename(t->type, "char")) { 53218213Slinton printString(a, (boolean) (s->language != primlang)); 5339659Slinton } else { 5349659Slinton printf("0x%x", a); 5359659Slinton } 5369659Slinton break; 5379659Slinton 5389659Slinton case SCAL: 5399659Slinton i = pop(Integer); 54018213Slinton printEnum(i, s); 5419659Slinton break; 5429659Slinton 54318213Slinton /* 54418213Slinton * Unresolved structure pointers? 54518213Slinton */ 54618213Slinton case BADUSE: 54718213Slinton a = pop(Address); 54818213Slinton printf("@%x", a); 54918213Slinton break; 55018213Slinton 5519659Slinton default: 5529659Slinton if (ord(s->class) > ord(TYPEREF)) { 5539659Slinton panic("printval: bad class %d", ord(s->class)); 5549659Slinton } 55514382Slinton sp -= size(s); 55616606Ssam printf("[%s]", c_classname(s)); 55714382Slinton break; 5589659Slinton } 5599659Slinton } 5609659Slinton 5619659Slinton /* 5629659Slinton * Print out a C structure. 5639659Slinton */ 5649659Slinton 56518213Slinton private c_printstruct (s) 5669659Slinton Symbol s; 5679659Slinton { 56818213Slinton Symbol f; 56918213Slinton Stack *savesp; 57018213Slinton integer n, off, len; 5719659Slinton 5729659Slinton sp -= size(s); 5739659Slinton savesp = sp; 5749659Slinton printf("("); 5759659Slinton f = s->chain; 5769659Slinton for (;;) { 5779659Slinton off = f->symvalue.field.offset; 5789659Slinton len = f->symvalue.field.length; 57916606Ssam n = (off + len + BITSPERBYTE - 1) div BITSPERBYTE; 5809659Slinton sp += n; 5819659Slinton printf("%s = ", symname(f)); 5829659Slinton c_printval(f); 5839659Slinton sp = savesp; 5849659Slinton f = f->chain; 5859659Slinton if (f == nil) break; 5869659Slinton printf(", "); 5879659Slinton } 5889659Slinton printf(")"); 5899659Slinton } 5909659Slinton 5919659Slinton /* 5929659Slinton * Return the C name for the particular class of a symbol. 5939659Slinton */ 5949659Slinton 5959659Slinton public String c_classname(s) 5969659Slinton Symbol s; 5979659Slinton { 5989659Slinton String str; 5999659Slinton 6009659Slinton switch (s->class) { 6019659Slinton case RECORD: 6029659Slinton str = "struct"; 6039659Slinton break; 6049659Slinton 6059659Slinton case VARNT: 6069659Slinton str = "union"; 6079659Slinton break; 6089659Slinton 6099659Slinton case SCAL: 6109659Slinton str = "enum"; 6119659Slinton break; 6129659Slinton 6139659Slinton default: 6149659Slinton str = classname(s); 6159659Slinton } 6169659Slinton return str; 6179659Slinton } 61818213Slinton 61912533Scsvaf public Node c_buildaref(a, slist) 62012533Scsvaf Node a, slist; 62112533Scsvaf { 62212533Scsvaf register Symbol t; 62312533Scsvaf register Node p; 62412533Scsvaf Symbol etype, atype, eltype; 62518213Slinton Node r, esub; 62612533Scsvaf 62712533Scsvaf t = rtype(a->nodetype); 62812533Scsvaf eltype = t->type; 62912533Scsvaf if (t->class == PTR) { 63012533Scsvaf p = slist->value.arg[0]; 63112533Scsvaf if (not compatible(p->nodetype, t_int)) { 63212533Scsvaf beginerrmsg(); 63318213Slinton fprintf(stderr, "subscript must be integer-compatible"); 63412533Scsvaf enderrmsg(); 63512533Scsvaf } 63612533Scsvaf r = build(O_MUL, p, build(O_LCON, (long) size(eltype))); 63712533Scsvaf r = build(O_ADD, build(O_RVAL, a), r); 63812533Scsvaf r->nodetype = eltype; 63912533Scsvaf } else if (t->class != ARRAY) { 64012533Scsvaf beginerrmsg(); 64118213Slinton fprintf(stderr, "\""); 64212533Scsvaf prtree(stderr, a); 64318213Slinton fprintf(stderr, "\" is not an array"); 64412533Scsvaf enderrmsg(); 64512533Scsvaf } else { 64618213Slinton r = a; 64712533Scsvaf p = slist; 64812533Scsvaf t = t->chain; 64912533Scsvaf for (; p != nil and t != nil; p = p->value.arg[1], t = t->chain) { 65012533Scsvaf esub = p->value.arg[0]; 65112533Scsvaf etype = rtype(esub->nodetype); 65212533Scsvaf atype = rtype(t); 65312533Scsvaf if (not compatible(atype, etype)) { 65412533Scsvaf beginerrmsg(); 65518213Slinton fprintf(stderr, "subscript \""); 65612533Scsvaf prtree(stderr, esub); 65718213Slinton fprintf(stderr, "\" is the wrong type"); 65812533Scsvaf enderrmsg(); 65912533Scsvaf } 66012533Scsvaf r = build(O_INDEX, r, esub); 66112533Scsvaf r->nodetype = eltype; 66212533Scsvaf } 66312533Scsvaf if (p != nil or t != nil) { 66412533Scsvaf beginerrmsg(); 66512533Scsvaf if (p != nil) { 66618213Slinton fprintf(stderr, "too many subscripts for \""); 66712533Scsvaf } else { 66818213Slinton fprintf(stderr, "not enough subscripts for \""); 66912533Scsvaf } 67012533Scsvaf prtree(stderr, a); 67118213Slinton fprintf(stderr, "\""); 67212533Scsvaf enderrmsg(); 67312533Scsvaf } 67412533Scsvaf } 67512533Scsvaf return r; 67612533Scsvaf } 67712533Scsvaf 67812533Scsvaf /* 67912533Scsvaf * Evaluate a subscript index. 68012533Scsvaf */ 68112533Scsvaf 68218213Slinton public c_evalaref(s, base, i) 68312533Scsvaf Symbol s; 68418213Slinton Address base; 68512533Scsvaf long i; 68612533Scsvaf { 68718213Slinton Symbol t; 68812533Scsvaf long lb, ub; 68912533Scsvaf 69018213Slinton t = rtype(s); 69118213Slinton s = t->chain; 69212533Scsvaf lb = s->symvalue.rangev.lower; 69312533Scsvaf ub = s->symvalue.rangev.upper; 69412533Scsvaf if (i < lb or i > ub) { 69529869Smckusick warning("subscript out of range"); 69612533Scsvaf } 69718213Slinton push(long, base + (i - lb) * size(t->type)); 69812533Scsvaf } 69916606Ssam 70016606Ssam /* 70116606Ssam * Initialize typetable information. 70216606Ssam */ 70316606Ssam 70416606Ssam public c_modinit (typetable) 70516606Ssam Symbol typetable[]; 70616606Ssam { 70716606Ssam /* nothing right now */ 70816606Ssam } 70916606Ssam 71016606Ssam public boolean c_hasmodules () 71116606Ssam { 71216606Ssam return false; 71316606Ssam } 71416606Ssam 71516606Ssam public boolean c_passaddr (param, exprtype) 71616606Ssam Symbol param, exprtype; 71716606Ssam { 71816606Ssam boolean b; 71916606Ssam Symbol t; 72016606Ssam 72116606Ssam t = rtype(exprtype); 72216606Ssam b = (boolean) (t->class == ARRAY); 72316606Ssam return b; 72416606Ssam } 725