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*31752Ssam static char sccsid[] = "@(#)c.c 5.6 (Berkeley) 07/02/87"; 921599Sdist #endif not lint 109659Slinton 1118213Slinton static char rcsid[] = "$Header: c.c,v 1.5 84/12/26 10:38:23 linton 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 3112559Scsvaf # 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; 4116606Ssam 429659Slinton /* 439659Slinton * Initialize C language information. 449659Slinton */ 459659Slinton 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); 579659Slinton } 589659Slinton 599659Slinton /* 609659Slinton * Test if two types are compatible. 619659Slinton */ 629659Slinton 639659Slinton public Boolean c_typematch(type1, type2) 649659Slinton Symbol type1, type2; 659659Slinton { 669659Slinton Boolean b; 679659Slinton register Symbol t1, t2, tmp; 689659Slinton 699659Slinton t1 = type1; 709659Slinton t2 = type2; 719659Slinton if (t1 == t2) { 729659Slinton b = true; 739659Slinton } else { 749659Slinton t1 = rtype(t1); 759659Slinton t2 = rtype(t2); 7616606Ssam if (t1 == t_char->type or t1 == t_int->type or t1 == t_real->type) { 779659Slinton tmp = t1; 789659Slinton t1 = t2; 799659Slinton t2 = tmp; 809659Slinton } 819659Slinton b = (Boolean) ( 829659Slinton ( 839659Slinton isrange(t1, "int") and 8416606Ssam (t2 == t_int->type or t2 == t_char->type) 859659Slinton ) or ( 869659Slinton isrange(t1, "char") and 8716606Ssam (t2 == t_char->type or t2 == t_int->type) 889659Slinton ) or ( 8916606Ssam t1->class == RANGE and isdouble(t1) and t2 == t_real->type 9013839Slinton ) or ( 9118213Slinton t1->class == RANGE and t2->class == RANGE and 9218213Slinton t1->symvalue.rangev.lower == t2->symvalue.rangev.lower and 9318213Slinton t1->symvalue.rangev.upper == t2->symvalue.rangev.upper 9418213Slinton ) or ( 959659Slinton t1->type == t2->type and ( 969659Slinton (t1->class == t2->class) or 979659Slinton (t1->class == SCAL and t2->class == CONST) or 989659Slinton (t1->class == CONST and t2->class == SCAL) 999659Slinton ) 10016606Ssam ) or ( 10116606Ssam t1->class == PTR and c_typematch(t1->type, t_char) and 10216606Ssam t2->class == ARRAY and c_typematch(t2->type, t_char) and 10316606Ssam t2->language == primlang 1049659Slinton ) 1059659Slinton ); 1069659Slinton } 1079659Slinton return b; 1089659Slinton } 1099659Slinton 1109659Slinton /* 1119659Slinton * Print out the declaration of a C variable. 1129659Slinton */ 1139659Slinton 1149659Slinton public c_printdecl(s) 1159659Slinton Symbol s; 1169659Slinton { 1179659Slinton printdecl(s, 0); 1189659Slinton } 1199659Slinton 1209659Slinton private printdecl(s, indent) 1219659Slinton register Symbol s; 1229659Slinton Integer indent; 1239659Slinton { 1249659Slinton register Symbol t; 1259659Slinton Boolean semicolon, newline; 1269659Slinton 1279659Slinton semicolon = true; 1289659Slinton newline = true; 1299659Slinton if (indent > 0) { 1309659Slinton printf("%*c", indent, ' '); 1319659Slinton } 1329659Slinton if (s->class == TYPE) { 1339659Slinton printf("typedef "); 1349659Slinton } 1359659Slinton switch (s->class) { 1369659Slinton case CONST: 1379659Slinton if (s->type->class == SCAL) { 13818213Slinton printf("enumeration constant with value "); 13918213Slinton eval(s->symvalue.constval); 14018213Slinton c_printval(s); 1419659Slinton } else { 1429659Slinton printf("const %s = ", symname(s)); 1439659Slinton printval(s); 1449659Slinton } 1459659Slinton break; 1469659Slinton 1479659Slinton case TYPE: 1489659Slinton case VAR: 14918213Slinton if (s->class != TYPE and s->level < 0) { 15018213Slinton printf("register "); 1519659Slinton } 1529659Slinton if (s->type->class == ARRAY) { 1539659Slinton printtype(s->type, s->type->type, indent); 1549659Slinton t = rtype(s->type->chain); 1559659Slinton assert(t->class == RANGE); 1569659Slinton printf(" %s[%d]", symname(s), t->symvalue.rangev.upper + 1); 1579659Slinton } else { 1589659Slinton printtype(s, s->type, indent); 1599659Slinton if (s->type->class != PTR) { 1609659Slinton printf(" "); 1619659Slinton } 1629659Slinton printf("%s", symname(s)); 1639659Slinton } 1649659Slinton break; 1659659Slinton 1669659Slinton case FIELD: 1679659Slinton if (s->type->class == ARRAY) { 1689659Slinton printtype(s->type, s->type->type, indent); 1699659Slinton t = rtype(s->type->chain); 1709659Slinton assert(t->class == RANGE); 1719659Slinton printf(" %s[%d]", symname(s), t->symvalue.rangev.upper + 1); 1729659Slinton } else { 1739659Slinton printtype(s, s->type, indent); 1749659Slinton if (s->type->class != PTR) { 1759659Slinton printf(" "); 1769659Slinton } 1779659Slinton printf("%s", symname(s)); 1789659Slinton } 1799659Slinton if (isbitfield(s)) { 1809659Slinton printf(" : %d", s->symvalue.field.length); 1819659Slinton } 1829659Slinton break; 1839659Slinton 1849659Slinton case TAG: 1859659Slinton if (s->type == nil) { 1869659Slinton findtype(s); 1879659Slinton if (s->type == nil) { 1889659Slinton error("unexpected missing type information"); 1899659Slinton } 1909659Slinton } 1919659Slinton printtype(s, s->type, indent); 1929659Slinton break; 1939659Slinton 1949659Slinton case RANGE: 1959659Slinton case ARRAY: 1969659Slinton case RECORD: 1979659Slinton case VARNT: 1989659Slinton case PTR: 19918213Slinton case FFUNC: 2009659Slinton semicolon = false; 2019659Slinton printtype(s, s, indent); 2029659Slinton break; 2039659Slinton 20418213Slinton case SCAL: 20518213Slinton printf("(enumeration constant, value %d)", s->symvalue.iconval); 20618213Slinton break; 20718213Slinton 2089659Slinton case PROC: 2099659Slinton semicolon = false; 2109659Slinton printf("%s", symname(s)); 2119659Slinton c_listparams(s); 2129659Slinton newline = false; 2139659Slinton break; 2149659Slinton 2159659Slinton case FUNC: 2169659Slinton semicolon = false; 2179659Slinton if (not istypename(s->type, "void")) { 2189659Slinton printtype(s, s->type, indent); 2199659Slinton printf(" "); 2209659Slinton } 2219659Slinton printf("%s", symname(s)); 2229659Slinton c_listparams(s); 2239659Slinton newline = false; 2249659Slinton break; 2259659Slinton 2269659Slinton case MODULE: 2279659Slinton semicolon = false; 2289659Slinton printf("source file \"%s.c\"", symname(s)); 2299659Slinton break; 2309659Slinton 2319659Slinton case PROG: 2329659Slinton semicolon = false; 2339659Slinton printf("executable file \"%s\"", symname(s)); 2349659Slinton break; 2359659Slinton 2369659Slinton default: 23718213Slinton printf("[%s]", classname(s)); 23818213Slinton break; 2399659Slinton } 2409659Slinton if (semicolon) { 2419659Slinton putchar(';'); 2429659Slinton } 2439659Slinton if (newline) { 2449659Slinton putchar('\n'); 2459659Slinton } 2469659Slinton } 2479659Slinton 2489659Slinton /* 2499659Slinton * Recursive whiz-bang procedure to print the type portion 2509659Slinton * of a declaration. 2519659Slinton * 2529659Slinton * The symbol associated with the type is passed to allow 2539659Slinton * searching for type names without getting "type blah = blah". 2549659Slinton */ 2559659Slinton 2569659Slinton private printtype(s, t, indent) 2579659Slinton Symbol s; 2589659Slinton Symbol t; 2599659Slinton Integer indent; 2609659Slinton { 2619659Slinton register Symbol i; 2629659Slinton long r0, r1; 2639659Slinton register String p; 2649659Slinton 2659659Slinton checkref(s); 2669659Slinton checkref(t); 2679659Slinton switch (t->class) { 2689659Slinton case VAR: 2699659Slinton case CONST: 2709659Slinton case PROC: 2719659Slinton panic("printtype: class %s", classname(t)); 2729659Slinton break; 2739659Slinton 2749659Slinton case ARRAY: 2759659Slinton printf("array["); 2769659Slinton i = t->chain; 2779659Slinton if (i != nil) { 2789659Slinton for (;;) { 2799659Slinton printtype(i, i, indent); 2809659Slinton i = i->chain; 2819659Slinton if (i == nil) { 2829659Slinton break; 2839659Slinton } 2849659Slinton printf(", "); 2859659Slinton } 2869659Slinton } 2879659Slinton printf("] of "); 2889659Slinton printtype(t, t->type, indent); 2899659Slinton break; 2909659Slinton 2919659Slinton case RECORD: 2929659Slinton case VARNT: 2939659Slinton printf("%s ", c_classname(t)); 2949659Slinton if (s->name != nil and s->class == TAG) { 2959659Slinton p = symname(s); 2969659Slinton if (p[0] == '$' and p[1] == '$') { 2979659Slinton printf("%s ", &p[2]); 2989659Slinton } else { 2999659Slinton printf("%s ", p); 3009659Slinton } 3019659Slinton } 302*31752Ssam printf("{\n"); 3039659Slinton for (i = t->chain; i != nil; i = i->chain) { 3049659Slinton assert(i->class == FIELD); 3059659Slinton printdecl(i, indent+4); 3069659Slinton } 3079659Slinton if (indent > 0) { 3089659Slinton printf("%*c", indent, ' '); 3099659Slinton } 3109659Slinton printf("}"); 3119659Slinton break; 3129659Slinton 3139659Slinton case RANGE: 3149659Slinton r0 = t->symvalue.rangev.lower; 3159659Slinton r1 = t->symvalue.rangev.upper; 3169659Slinton if (istypename(t->type, "char")) { 3179659Slinton if (r0 < 0x20 or r0 > 0x7e) { 3189659Slinton printf("%ld..", r0); 3199659Slinton } else { 3209659Slinton printf("'%c'..", (char) r0); 3219659Slinton } 3229659Slinton if (r1 < 0x20 or r1 > 0x7e) { 3239659Slinton printf("\\%lo", r1); 3249659Slinton } else { 3259659Slinton printf("'%c'", (char) r1); 3269659Slinton } 3279659Slinton } else if (r0 > 0 and r1 == 0) { 3289659Slinton printf("%ld byte real", r0); 3299659Slinton } else if (r0 >= 0) { 3309659Slinton printf("%lu..%lu", r0, r1); 3319659Slinton } else { 3329659Slinton printf("%ld..%ld", r0, r1); 3339659Slinton } 3349659Slinton break; 3359659Slinton 3369659Slinton case PTR: 3379659Slinton printtype(t, t->type, indent); 3389659Slinton if (t->type->class != PTR) { 3399659Slinton printf(" "); 3409659Slinton } 3419659Slinton printf("*"); 3429659Slinton break; 3439659Slinton 3449659Slinton case FUNC: 34516606Ssam case FFUNC: 3469659Slinton printtype(t, t->type, indent); 3479659Slinton printf("()"); 3489659Slinton break; 3499659Slinton 3509659Slinton case TYPE: 3519659Slinton if (t->name != nil) { 35216606Ssam printname(stdout, t); 3539659Slinton } else { 3549659Slinton printtype(t, t->type, indent); 3559659Slinton } 3569659Slinton break; 3579659Slinton 3589659Slinton case TYPEREF: 3599659Slinton printf("@%s", symname(t)); 3609659Slinton break; 3619659Slinton 3629659Slinton case SCAL: 3639659Slinton printf("enum "); 3649659Slinton if (s->name != nil and s->class == TAG) { 3659659Slinton printf("%s ", symname(s)); 3669659Slinton } 3679659Slinton printf("{ "); 3689659Slinton i = t->chain; 3699659Slinton if (i != nil) { 3709659Slinton for (;;) { 3719659Slinton printf("%s", symname(i)); 3729659Slinton i = i->chain; 3739659Slinton if (i == nil) break; 3749659Slinton printf(", "); 3759659Slinton } 3769659Slinton } 3779659Slinton printf(" }"); 3789659Slinton break; 3799659Slinton 3809659Slinton case TAG: 3819659Slinton if (t->type == nil) { 3829659Slinton printf("unresolved tag %s", symname(t)); 3839659Slinton } else { 3849659Slinton i = rtype(t->type); 3859659Slinton printf("%s %s", c_classname(i), symname(t)); 3869659Slinton } 3879659Slinton break; 3889659Slinton 3899659Slinton default: 3909659Slinton printf("(class %d)", t->class); 3919659Slinton break; 3929659Slinton } 3939659Slinton } 3949659Slinton 3959659Slinton /* 3969659Slinton * List the parameters of a procedure or function. 3979659Slinton * No attempt is made to combine like types. 3989659Slinton */ 3999659Slinton 4009659Slinton public c_listparams(s) 4019659Slinton Symbol s; 4029659Slinton { 4039659Slinton register Symbol t; 4049659Slinton 4059659Slinton putchar('('); 4069659Slinton for (t = s->chain; t != nil; t = t->chain) { 4079659Slinton printf("%s", symname(t)); 4089659Slinton if (t->chain != nil) { 4099659Slinton printf(", "); 4109659Slinton } 4119659Slinton } 4129659Slinton putchar(')'); 4139659Slinton if (s->chain != nil) { 4149659Slinton printf("\n"); 4159659Slinton for (t = s->chain; t != nil; t = t->chain) { 4169659Slinton if (t->class != VAR) { 4179659Slinton panic("unexpected class %d for parameter", t->class); 4189659Slinton } 4199659Slinton printdecl(t, 0); 4209659Slinton } 4219659Slinton } else { 4229659Slinton putchar('\n'); 4239659Slinton } 4249659Slinton } 4259659Slinton 4269659Slinton /* 4279659Slinton * Print out the value on the top of the expression stack 4289659Slinton * in the format for the type of the given symbol. 4299659Slinton */ 4309659Slinton 4319659Slinton public c_printval(s) 4329659Slinton Symbol s; 4339659Slinton { 4349659Slinton register Symbol t; 4359659Slinton register Address a; 43616606Ssam integer i, len; 43729869Smckusick register String str; 4389659Slinton 4399659Slinton switch (s->class) { 4409659Slinton case CONST: 4419659Slinton case TYPE: 4429659Slinton case VAR: 4439659Slinton case REF: 4449659Slinton case FVAR: 4459659Slinton case TAG: 4469659Slinton c_printval(s->type); 4479659Slinton break; 4489659Slinton 4499659Slinton case FIELD: 4509659Slinton if (isbitfield(s)) { 45116606Ssam i = 0; 45216606Ssam popn(size(s), &i); 45329868Smckusick i = extractfield(i, s); 4549659Slinton t = rtype(s->type); 4559659Slinton if (t->class == SCAL) { 45618213Slinton printEnum(i, t); 4579659Slinton } else { 45818213Slinton printRangeVal(i, t); 4599659Slinton } 4609659Slinton } else { 4619659Slinton c_printval(s->type); 4629659Slinton } 4639659Slinton break; 4649659Slinton 4659659Slinton case ARRAY: 4669659Slinton t = rtype(s->type); 46716606Ssam if ((t->class == RANGE and istypename(t->type, "char")) or 46816606Ssam t == t_char->type 46916606Ssam ) { 4709659Slinton len = size(s); 47129869Smckusick str = (String) (sp -= len); 47229869Smckusick if (s->language != primlang) { 47329869Smckusick putchar('"'); 47418213Slinton } 47529869Smckusick while (--len > 0 and *str != '\0') { 47629869Smckusick printchar(*str++); 47729869Smckusick } 47829869Smckusick if (*str != '\0') { /* XXX - pitch trailing null */ 47929869Smckusick printchar(*str); 48029869Smckusick } 48129869Smckusick if (s->language != primlang) { 48229869Smckusick putchar('"'); 48329869Smckusick } 4849659Slinton } else { 4859659Slinton printarray(s); 4869659Slinton } 4879659Slinton break; 4889659Slinton 4899659Slinton case RECORD: 4909659Slinton c_printstruct(s); 4919659Slinton break; 4929659Slinton 4939659Slinton case RANGE: 49418213Slinton if (s == t_boolean->type or istypename(s->type, "boolean")) { 49518213Slinton printRangeVal(popsmall(s), s); 49618213Slinton } else if (s == t_char->type or istypename(s->type, "char")) { 49718213Slinton printRangeVal(pop(char), s); 49818213Slinton } else if (s == t_real->type or isdouble(s)) { 4999659Slinton switch (s->symvalue.rangev.lower) { 5009659Slinton case sizeof(float): 5019659Slinton prtreal(pop(float)); 5029659Slinton break; 5039659Slinton 5049659Slinton case sizeof(double): 5059659Slinton prtreal(pop(double)); 5069659Slinton break; 5079659Slinton 5089659Slinton default: 5099659Slinton panic("bad real size %d", t->symvalue.rangev.lower); 5109659Slinton break; 5119659Slinton } 5129659Slinton } else { 51318213Slinton printRangeVal(popsmall(s), s); 5149659Slinton } 5159659Slinton break; 5169659Slinton 5179659Slinton case PTR: 5189659Slinton t = rtype(s->type); 5199659Slinton a = pop(Address); 5209659Slinton if (a == 0) { 5219659Slinton printf("(nil)"); 5229659Slinton } else if (t->class == RANGE and istypename(t->type, "char")) { 52318213Slinton printString(a, (boolean) (s->language != primlang)); 5249659Slinton } else { 5259659Slinton printf("0x%x", a); 5269659Slinton } 5279659Slinton break; 5289659Slinton 5299659Slinton case SCAL: 5309659Slinton i = pop(Integer); 53118213Slinton printEnum(i, s); 5329659Slinton break; 5339659Slinton 53418213Slinton /* 53518213Slinton * Unresolved structure pointers? 53618213Slinton */ 53718213Slinton case BADUSE: 53818213Slinton a = pop(Address); 53918213Slinton printf("@%x", a); 54018213Slinton break; 54118213Slinton 5429659Slinton default: 5439659Slinton if (ord(s->class) > ord(TYPEREF)) { 5449659Slinton panic("printval: bad class %d", ord(s->class)); 5459659Slinton } 54614382Slinton sp -= size(s); 54716606Ssam printf("[%s]", c_classname(s)); 54814382Slinton break; 5499659Slinton } 5509659Slinton } 5519659Slinton 5529659Slinton /* 5539659Slinton * Print out a C structure. 5549659Slinton */ 5559659Slinton 55618213Slinton private c_printstruct (s) 5579659Slinton Symbol s; 5589659Slinton { 55918213Slinton Symbol f; 56018213Slinton Stack *savesp; 56118213Slinton integer n, off, len; 5629659Slinton 5639659Slinton sp -= size(s); 5649659Slinton savesp = sp; 5659659Slinton printf("("); 5669659Slinton f = s->chain; 5679659Slinton for (;;) { 5689659Slinton off = f->symvalue.field.offset; 5699659Slinton len = f->symvalue.field.length; 57016606Ssam n = (off + len + BITSPERBYTE - 1) div BITSPERBYTE; 5719659Slinton sp += n; 5729659Slinton printf("%s = ", symname(f)); 5739659Slinton c_printval(f); 5749659Slinton sp = savesp; 5759659Slinton f = f->chain; 5769659Slinton if (f == nil) break; 5779659Slinton printf(", "); 5789659Slinton } 5799659Slinton printf(")"); 5809659Slinton } 5819659Slinton 5829659Slinton /* 5839659Slinton * Return the C name for the particular class of a symbol. 5849659Slinton */ 5859659Slinton 5869659Slinton public String c_classname(s) 5879659Slinton Symbol s; 5889659Slinton { 5899659Slinton String str; 5909659Slinton 5919659Slinton switch (s->class) { 5929659Slinton case RECORD: 5939659Slinton str = "struct"; 5949659Slinton break; 5959659Slinton 5969659Slinton case VARNT: 5979659Slinton str = "union"; 5989659Slinton break; 5999659Slinton 6009659Slinton case SCAL: 6019659Slinton str = "enum"; 6029659Slinton break; 6039659Slinton 6049659Slinton default: 6059659Slinton str = classname(s); 6069659Slinton } 6079659Slinton return str; 6089659Slinton } 60918213Slinton 61012533Scsvaf public Node c_buildaref(a, slist) 61112533Scsvaf Node a, slist; 61212533Scsvaf { 61312533Scsvaf register Symbol t; 61412533Scsvaf register Node p; 61512533Scsvaf Symbol etype, atype, eltype; 61618213Slinton Node r, esub; 61712533Scsvaf 61812533Scsvaf t = rtype(a->nodetype); 61912533Scsvaf eltype = t->type; 62012533Scsvaf if (t->class == PTR) { 62112533Scsvaf p = slist->value.arg[0]; 62212533Scsvaf if (not compatible(p->nodetype, t_int)) { 62312533Scsvaf beginerrmsg(); 62418213Slinton fprintf(stderr, "subscript must be integer-compatible"); 62512533Scsvaf enderrmsg(); 62612533Scsvaf } 62712533Scsvaf r = build(O_MUL, p, build(O_LCON, (long) size(eltype))); 62812533Scsvaf r = build(O_ADD, build(O_RVAL, a), r); 62912533Scsvaf r->nodetype = eltype; 63012533Scsvaf } else if (t->class != ARRAY) { 63112533Scsvaf beginerrmsg(); 63218213Slinton fprintf(stderr, "\""); 63312533Scsvaf prtree(stderr, a); 63418213Slinton fprintf(stderr, "\" is not an array"); 63512533Scsvaf enderrmsg(); 63612533Scsvaf } else { 63718213Slinton r = a; 63812533Scsvaf p = slist; 63912533Scsvaf t = t->chain; 64012533Scsvaf for (; p != nil and t != nil; p = p->value.arg[1], t = t->chain) { 64112533Scsvaf esub = p->value.arg[0]; 64212533Scsvaf etype = rtype(esub->nodetype); 64312533Scsvaf atype = rtype(t); 64412533Scsvaf if (not compatible(atype, etype)) { 64512533Scsvaf beginerrmsg(); 64618213Slinton fprintf(stderr, "subscript \""); 64712533Scsvaf prtree(stderr, esub); 64818213Slinton fprintf(stderr, "\" is the wrong type"); 64912533Scsvaf enderrmsg(); 65012533Scsvaf } 65112533Scsvaf r = build(O_INDEX, r, esub); 65212533Scsvaf r->nodetype = eltype; 65312533Scsvaf } 65412533Scsvaf if (p != nil or t != nil) { 65512533Scsvaf beginerrmsg(); 65612533Scsvaf if (p != nil) { 65718213Slinton fprintf(stderr, "too many subscripts for \""); 65812533Scsvaf } else { 65918213Slinton fprintf(stderr, "not enough subscripts for \""); 66012533Scsvaf } 66112533Scsvaf prtree(stderr, a); 66218213Slinton fprintf(stderr, "\""); 66312533Scsvaf enderrmsg(); 66412533Scsvaf } 66512533Scsvaf } 66612533Scsvaf return r; 66712533Scsvaf } 66812533Scsvaf 66912533Scsvaf /* 67012533Scsvaf * Evaluate a subscript index. 67112533Scsvaf */ 67212533Scsvaf 67318213Slinton public c_evalaref(s, base, i) 67412533Scsvaf Symbol s; 67518213Slinton Address base; 67612533Scsvaf long i; 67712533Scsvaf { 67818213Slinton Symbol t; 67912533Scsvaf long lb, ub; 68012533Scsvaf 68118213Slinton t = rtype(s); 68218213Slinton s = t->chain; 68312533Scsvaf lb = s->symvalue.rangev.lower; 68412533Scsvaf ub = s->symvalue.rangev.upper; 68512533Scsvaf if (i < lb or i > ub) { 68629869Smckusick warning("subscript out of range"); 68712533Scsvaf } 68818213Slinton push(long, base + (i - lb) * size(t->type)); 68912533Scsvaf } 69016606Ssam 69116606Ssam /* 69216606Ssam * Initialize typetable information. 69316606Ssam */ 69416606Ssam 69516606Ssam public c_modinit (typetable) 69616606Ssam Symbol typetable[]; 69716606Ssam { 69816606Ssam /* nothing right now */ 69916606Ssam } 70016606Ssam 70116606Ssam public boolean c_hasmodules () 70216606Ssam { 70316606Ssam return false; 70416606Ssam } 70516606Ssam 70616606Ssam public boolean c_passaddr (param, exprtype) 70716606Ssam Symbol param, exprtype; 70816606Ssam { 70916606Ssam boolean b; 71016606Ssam Symbol t; 71116606Ssam 71216606Ssam t = rtype(exprtype); 71316606Ssam b = (boolean) (t->class == ARRAY); 71416606Ssam return b; 71516606Ssam } 716