19659Slinton /* Copyright (c) 1982 Regents of the University of California */ 29659Slinton 3*18213Slinton static char sccsid[] = "@(#)c.c 1.9 (Berkeley) 03/01/85"; 49659Slinton 5*18213Slinton static char rcsid[] = "$Header: c.c,v 1.5 84/12/26 10:38:23 linton Exp $"; 6*18213Slinton 79659Slinton /* 89659Slinton * C-dependent symbol routines. 99659Slinton */ 109659Slinton 119659Slinton #include "defs.h" 129659Slinton #include "symbols.h" 139659Slinton #include "printsym.h" 149659Slinton #include "languages.h" 159659Slinton #include "c.h" 169659Slinton #include "tree.h" 179659Slinton #include "eval.h" 189659Slinton #include "operators.h" 199659Slinton #include "mappings.h" 209659Slinton #include "process.h" 219659Slinton #include "runtime.h" 229659Slinton #include "machine.h" 239659Slinton 2412559Scsvaf #ifndef public 2512559Scsvaf # include "tree.h" 2612559Scsvaf #endif 2712559Scsvaf 289659Slinton #define isdouble(range) ( \ 299659Slinton range->symvalue.rangev.upper == 0 and range->symvalue.rangev.lower > 0 \ 309659Slinton ) 319659Slinton 329659Slinton #define isrange(t, name) (t->class == RANGE and istypename(t->type, name)) 339659Slinton 3416606Ssam private Language langC; 3516606Ssam 369659Slinton /* 379659Slinton * Initialize C language information. 389659Slinton */ 399659Slinton 409659Slinton public c_init() 419659Slinton { 4216606Ssam langC = language_define("c", ".c"); 4316606Ssam language_setop(langC, L_PRINTDECL, c_printdecl); 4416606Ssam language_setop(langC, L_PRINTVAL, c_printval); 4516606Ssam language_setop(langC, L_TYPEMATCH, c_typematch); 4616606Ssam language_setop(langC, L_BUILDAREF, c_buildaref); 4716606Ssam language_setop(langC, L_EVALAREF, c_evalaref); 4816606Ssam language_setop(langC, L_MODINIT, c_modinit); 4916606Ssam language_setop(langC, L_HASMODULES, c_hasmodules); 5016606Ssam language_setop(langC, L_PASSADDR, c_passaddr); 519659Slinton } 529659Slinton 539659Slinton /* 549659Slinton * Test if two types are compatible. 559659Slinton */ 569659Slinton 579659Slinton public Boolean c_typematch(type1, type2) 589659Slinton Symbol type1, type2; 599659Slinton { 609659Slinton Boolean b; 619659Slinton register Symbol t1, t2, tmp; 629659Slinton 639659Slinton t1 = type1; 649659Slinton t2 = type2; 659659Slinton if (t1 == t2) { 669659Slinton b = true; 679659Slinton } else { 689659Slinton t1 = rtype(t1); 699659Slinton t2 = rtype(t2); 7016606Ssam if (t1 == t_char->type or t1 == t_int->type or t1 == t_real->type) { 719659Slinton tmp = t1; 729659Slinton t1 = t2; 739659Slinton t2 = tmp; 749659Slinton } 759659Slinton b = (Boolean) ( 769659Slinton ( 779659Slinton isrange(t1, "int") and 7816606Ssam (t2 == t_int->type or t2 == t_char->type) 799659Slinton ) or ( 809659Slinton isrange(t1, "char") and 8116606Ssam (t2 == t_char->type or t2 == t_int->type) 829659Slinton ) or ( 8316606Ssam t1->class == RANGE and isdouble(t1) and t2 == t_real->type 8413839Slinton ) or ( 85*18213Slinton t1->class == RANGE and t2->class == RANGE and 86*18213Slinton t1->symvalue.rangev.lower == t2->symvalue.rangev.lower and 87*18213Slinton t1->symvalue.rangev.upper == t2->symvalue.rangev.upper 88*18213Slinton ) or ( 899659Slinton t1->type == t2->type and ( 909659Slinton (t1->class == t2->class) or 919659Slinton (t1->class == SCAL and t2->class == CONST) or 929659Slinton (t1->class == CONST and t2->class == SCAL) 939659Slinton ) 9416606Ssam ) or ( 9516606Ssam t1->class == PTR and c_typematch(t1->type, t_char) and 9616606Ssam t2->class == ARRAY and c_typematch(t2->type, t_char) and 9716606Ssam t2->language == primlang 989659Slinton ) 999659Slinton ); 1009659Slinton } 1019659Slinton return b; 1029659Slinton } 1039659Slinton 1049659Slinton /* 1059659Slinton * Print out the declaration of a C variable. 1069659Slinton */ 1079659Slinton 1089659Slinton public c_printdecl(s) 1099659Slinton Symbol s; 1109659Slinton { 1119659Slinton printdecl(s, 0); 1129659Slinton } 1139659Slinton 1149659Slinton private printdecl(s, indent) 1159659Slinton register Symbol s; 1169659Slinton Integer indent; 1179659Slinton { 1189659Slinton register Symbol t; 1199659Slinton Boolean semicolon, newline; 1209659Slinton 1219659Slinton semicolon = true; 1229659Slinton newline = true; 1239659Slinton if (indent > 0) { 1249659Slinton printf("%*c", indent, ' '); 1259659Slinton } 1269659Slinton if (s->class == TYPE) { 1279659Slinton printf("typedef "); 1289659Slinton } 1299659Slinton switch (s->class) { 1309659Slinton case CONST: 1319659Slinton if (s->type->class == SCAL) { 132*18213Slinton printf("enumeration constant with value "); 133*18213Slinton eval(s->symvalue.constval); 134*18213Slinton c_printval(s); 1359659Slinton } else { 1369659Slinton printf("const %s = ", symname(s)); 1379659Slinton printval(s); 1389659Slinton } 1399659Slinton break; 1409659Slinton 1419659Slinton case TYPE: 1429659Slinton case VAR: 143*18213Slinton if (s->class != TYPE and s->level < 0) { 144*18213Slinton printf("register "); 1459659Slinton } 1469659Slinton if (s->type->class == ARRAY) { 1479659Slinton printtype(s->type, s->type->type, indent); 1489659Slinton t = rtype(s->type->chain); 1499659Slinton assert(t->class == RANGE); 1509659Slinton printf(" %s[%d]", symname(s), t->symvalue.rangev.upper + 1); 1519659Slinton } else { 1529659Slinton printtype(s, s->type, indent); 1539659Slinton if (s->type->class != PTR) { 1549659Slinton printf(" "); 1559659Slinton } 1569659Slinton printf("%s", symname(s)); 1579659Slinton } 1589659Slinton break; 1599659Slinton 1609659Slinton case FIELD: 1619659Slinton if (s->type->class == ARRAY) { 1629659Slinton printtype(s->type, s->type->type, indent); 1639659Slinton t = rtype(s->type->chain); 1649659Slinton assert(t->class == RANGE); 1659659Slinton printf(" %s[%d]", symname(s), t->symvalue.rangev.upper + 1); 1669659Slinton } else { 1679659Slinton printtype(s, s->type, indent); 1689659Slinton if (s->type->class != PTR) { 1699659Slinton printf(" "); 1709659Slinton } 1719659Slinton printf("%s", symname(s)); 1729659Slinton } 1739659Slinton if (isbitfield(s)) { 1749659Slinton printf(" : %d", s->symvalue.field.length); 1759659Slinton } 1769659Slinton break; 1779659Slinton 1789659Slinton case TAG: 1799659Slinton if (s->type == nil) { 1809659Slinton findtype(s); 1819659Slinton if (s->type == nil) { 1829659Slinton error("unexpected missing type information"); 1839659Slinton } 1849659Slinton } 1859659Slinton printtype(s, s->type, indent); 1869659Slinton break; 1879659Slinton 1889659Slinton case RANGE: 1899659Slinton case ARRAY: 1909659Slinton case RECORD: 1919659Slinton case VARNT: 1929659Slinton case PTR: 193*18213Slinton case FFUNC: 1949659Slinton semicolon = false; 1959659Slinton printtype(s, s, indent); 1969659Slinton break; 1979659Slinton 198*18213Slinton case SCAL: 199*18213Slinton printf("(enumeration constant, value %d)", s->symvalue.iconval); 200*18213Slinton break; 201*18213Slinton 2029659Slinton case PROC: 2039659Slinton semicolon = false; 2049659Slinton printf("%s", symname(s)); 2059659Slinton c_listparams(s); 2069659Slinton newline = false; 2079659Slinton break; 2089659Slinton 2099659Slinton case FUNC: 2109659Slinton semicolon = false; 2119659Slinton if (not istypename(s->type, "void")) { 2129659Slinton printtype(s, s->type, indent); 2139659Slinton printf(" "); 2149659Slinton } 2159659Slinton printf("%s", symname(s)); 2169659Slinton c_listparams(s); 2179659Slinton newline = false; 2189659Slinton break; 2199659Slinton 2209659Slinton case MODULE: 2219659Slinton semicolon = false; 2229659Slinton printf("source file \"%s.c\"", symname(s)); 2239659Slinton break; 2249659Slinton 2259659Slinton case PROG: 2269659Slinton semicolon = false; 2279659Slinton printf("executable file \"%s\"", symname(s)); 2289659Slinton break; 2299659Slinton 2309659Slinton default: 231*18213Slinton printf("[%s]", classname(s)); 232*18213Slinton break; 2339659Slinton } 2349659Slinton if (semicolon) { 2359659Slinton putchar(';'); 2369659Slinton } 2379659Slinton if (newline) { 2389659Slinton putchar('\n'); 2399659Slinton } 2409659Slinton } 2419659Slinton 2429659Slinton /* 2439659Slinton * Recursive whiz-bang procedure to print the type portion 2449659Slinton * of a declaration. 2459659Slinton * 2469659Slinton * The symbol associated with the type is passed to allow 2479659Slinton * searching for type names without getting "type blah = blah". 2489659Slinton */ 2499659Slinton 2509659Slinton private printtype(s, t, indent) 2519659Slinton Symbol s; 2529659Slinton Symbol t; 2539659Slinton Integer indent; 2549659Slinton { 2559659Slinton register Symbol i; 2569659Slinton long r0, r1; 2579659Slinton register String p; 2589659Slinton 2599659Slinton checkref(s); 2609659Slinton checkref(t); 2619659Slinton switch (t->class) { 2629659Slinton case VAR: 2639659Slinton case CONST: 2649659Slinton case PROC: 2659659Slinton panic("printtype: class %s", classname(t)); 2669659Slinton break; 2679659Slinton 2689659Slinton case ARRAY: 2699659Slinton printf("array["); 2709659Slinton i = t->chain; 2719659Slinton if (i != nil) { 2729659Slinton for (;;) { 2739659Slinton printtype(i, i, indent); 2749659Slinton i = i->chain; 2759659Slinton if (i == nil) { 2769659Slinton break; 2779659Slinton } 2789659Slinton printf(", "); 2799659Slinton } 2809659Slinton } 2819659Slinton printf("] of "); 2829659Slinton printtype(t, t->type, indent); 2839659Slinton break; 2849659Slinton 2859659Slinton case RECORD: 2869659Slinton case VARNT: 2879659Slinton printf("%s ", c_classname(t)); 2889659Slinton if (s->name != nil and s->class == TAG) { 2899659Slinton p = symname(s); 2909659Slinton if (p[0] == '$' and p[1] == '$') { 2919659Slinton printf("%s ", &p[2]); 2929659Slinton } else { 2939659Slinton printf("%s ", p); 2949659Slinton } 2959659Slinton } 2969659Slinton printf("{\n", t->class == RECORD ? "struct" : "union"); 2979659Slinton for (i = t->chain; i != nil; i = i->chain) { 2989659Slinton assert(i->class == FIELD); 2999659Slinton printdecl(i, indent+4); 3009659Slinton } 3019659Slinton if (indent > 0) { 3029659Slinton printf("%*c", indent, ' '); 3039659Slinton } 3049659Slinton printf("}"); 3059659Slinton break; 3069659Slinton 3079659Slinton case RANGE: 3089659Slinton r0 = t->symvalue.rangev.lower; 3099659Slinton r1 = t->symvalue.rangev.upper; 3109659Slinton if (istypename(t->type, "char")) { 3119659Slinton if (r0 < 0x20 or r0 > 0x7e) { 3129659Slinton printf("%ld..", r0); 3139659Slinton } else { 3149659Slinton printf("'%c'..", (char) r0); 3159659Slinton } 3169659Slinton if (r1 < 0x20 or r1 > 0x7e) { 3179659Slinton printf("\\%lo", r1); 3189659Slinton } else { 3199659Slinton printf("'%c'", (char) r1); 3209659Slinton } 3219659Slinton } else if (r0 > 0 and r1 == 0) { 3229659Slinton printf("%ld byte real", r0); 3239659Slinton } else if (r0 >= 0) { 3249659Slinton printf("%lu..%lu", r0, r1); 3259659Slinton } else { 3269659Slinton printf("%ld..%ld", r0, r1); 3279659Slinton } 3289659Slinton break; 3299659Slinton 3309659Slinton case PTR: 3319659Slinton printtype(t, t->type, indent); 3329659Slinton if (t->type->class != PTR) { 3339659Slinton printf(" "); 3349659Slinton } 3359659Slinton printf("*"); 3369659Slinton break; 3379659Slinton 3389659Slinton case FUNC: 33916606Ssam case FFUNC: 3409659Slinton printtype(t, t->type, indent); 3419659Slinton printf("()"); 3429659Slinton break; 3439659Slinton 3449659Slinton case TYPE: 3459659Slinton if (t->name != nil) { 34616606Ssam printname(stdout, t); 3479659Slinton } else { 3489659Slinton printtype(t, t->type, indent); 3499659Slinton } 3509659Slinton break; 3519659Slinton 3529659Slinton case TYPEREF: 3539659Slinton printf("@%s", symname(t)); 3549659Slinton break; 3559659Slinton 3569659Slinton case SCAL: 3579659Slinton printf("enum "); 3589659Slinton if (s->name != nil and s->class == TAG) { 3599659Slinton printf("%s ", symname(s)); 3609659Slinton } 3619659Slinton printf("{ "); 3629659Slinton i = t->chain; 3639659Slinton if (i != nil) { 3649659Slinton for (;;) { 3659659Slinton printf("%s", symname(i)); 3669659Slinton i = i->chain; 3679659Slinton if (i == nil) break; 3689659Slinton printf(", "); 3699659Slinton } 3709659Slinton } 3719659Slinton printf(" }"); 3729659Slinton break; 3739659Slinton 3749659Slinton case TAG: 3759659Slinton if (t->type == nil) { 3769659Slinton printf("unresolved tag %s", symname(t)); 3779659Slinton } else { 3789659Slinton i = rtype(t->type); 3799659Slinton printf("%s %s", c_classname(i), symname(t)); 3809659Slinton } 3819659Slinton break; 3829659Slinton 3839659Slinton default: 3849659Slinton printf("(class %d)", t->class); 3859659Slinton break; 3869659Slinton } 3879659Slinton } 3889659Slinton 3899659Slinton /* 3909659Slinton * List the parameters of a procedure or function. 3919659Slinton * No attempt is made to combine like types. 3929659Slinton */ 3939659Slinton 3949659Slinton public c_listparams(s) 3959659Slinton Symbol s; 3969659Slinton { 3979659Slinton register Symbol t; 3989659Slinton 3999659Slinton putchar('('); 4009659Slinton for (t = s->chain; t != nil; t = t->chain) { 4019659Slinton printf("%s", symname(t)); 4029659Slinton if (t->chain != nil) { 4039659Slinton printf(", "); 4049659Slinton } 4059659Slinton } 4069659Slinton putchar(')'); 4079659Slinton if (s->chain != nil) { 4089659Slinton printf("\n"); 4099659Slinton for (t = s->chain; t != nil; t = t->chain) { 4109659Slinton if (t->class != VAR) { 4119659Slinton panic("unexpected class %d for parameter", t->class); 4129659Slinton } 4139659Slinton printdecl(t, 0); 4149659Slinton } 4159659Slinton } else { 4169659Slinton putchar('\n'); 4179659Slinton } 4189659Slinton } 4199659Slinton 4209659Slinton /* 4219659Slinton * Print out the value on the top of the expression stack 4229659Slinton * in the format for the type of the given symbol. 4239659Slinton */ 4249659Slinton 4259659Slinton public c_printval(s) 4269659Slinton Symbol s; 4279659Slinton { 4289659Slinton register Symbol t; 4299659Slinton register Address a; 43016606Ssam integer i, len; 4319659Slinton 4329659Slinton switch (s->class) { 4339659Slinton case CONST: 4349659Slinton case TYPE: 4359659Slinton case VAR: 4369659Slinton case REF: 4379659Slinton case FVAR: 4389659Slinton case TAG: 4399659Slinton c_printval(s->type); 4409659Slinton break; 4419659Slinton 4429659Slinton case FIELD: 4439659Slinton if (isbitfield(s)) { 44416606Ssam i = 0; 44516606Ssam popn(size(s), &i); 4469659Slinton i >>= (s->symvalue.field.offset mod BITSPERBYTE); 44716606Ssam i &= ((1 << s->symvalue.field.length) - 1); 4489659Slinton t = rtype(s->type); 4499659Slinton if (t->class == SCAL) { 450*18213Slinton printEnum(i, t); 4519659Slinton } else { 452*18213Slinton printRangeVal(i, t); 4539659Slinton } 4549659Slinton } else { 4559659Slinton c_printval(s->type); 4569659Slinton } 4579659Slinton break; 4589659Slinton 4599659Slinton case ARRAY: 4609659Slinton t = rtype(s->type); 46116606Ssam if ((t->class == RANGE and istypename(t->type, "char")) or 46216606Ssam t == t_char->type 46316606Ssam ) { 4649659Slinton len = size(s); 4659659Slinton sp -= len; 466*18213Slinton if (s->language == primlang) { 467*18213Slinton printf("%.*s", len, sp); 468*18213Slinton } else { 469*18213Slinton printf("\"%.*s\"", len, sp); 470*18213Slinton } 4719659Slinton } else { 4729659Slinton printarray(s); 4739659Slinton } 4749659Slinton break; 4759659Slinton 4769659Slinton case RECORD: 4779659Slinton c_printstruct(s); 4789659Slinton break; 4799659Slinton 4809659Slinton case RANGE: 481*18213Slinton if (s == t_boolean->type or istypename(s->type, "boolean")) { 482*18213Slinton printRangeVal(popsmall(s), s); 483*18213Slinton } else if (s == t_char->type or istypename(s->type, "char")) { 484*18213Slinton printRangeVal(pop(char), s); 485*18213Slinton } else if (s == t_real->type or isdouble(s)) { 4869659Slinton switch (s->symvalue.rangev.lower) { 4879659Slinton case sizeof(float): 4889659Slinton prtreal(pop(float)); 4899659Slinton break; 4909659Slinton 4919659Slinton case sizeof(double): 4929659Slinton prtreal(pop(double)); 4939659Slinton break; 4949659Slinton 4959659Slinton default: 4969659Slinton panic("bad real size %d", t->symvalue.rangev.lower); 4979659Slinton break; 4989659Slinton } 4999659Slinton } else { 500*18213Slinton printRangeVal(popsmall(s), s); 5019659Slinton } 5029659Slinton break; 5039659Slinton 5049659Slinton case PTR: 5059659Slinton t = rtype(s->type); 5069659Slinton a = pop(Address); 5079659Slinton if (a == 0) { 5089659Slinton printf("(nil)"); 5099659Slinton } else if (t->class == RANGE and istypename(t->type, "char")) { 510*18213Slinton printString(a, (boolean) (s->language != primlang)); 5119659Slinton } else { 5129659Slinton printf("0x%x", a); 5139659Slinton } 5149659Slinton break; 5159659Slinton 5169659Slinton case SCAL: 5179659Slinton i = pop(Integer); 518*18213Slinton printEnum(i, s); 5199659Slinton break; 5209659Slinton 521*18213Slinton /* 522*18213Slinton * Unresolved structure pointers? 523*18213Slinton */ 524*18213Slinton case BADUSE: 525*18213Slinton a = pop(Address); 526*18213Slinton printf("@%x", a); 527*18213Slinton break; 528*18213Slinton 5299659Slinton default: 5309659Slinton if (ord(s->class) > ord(TYPEREF)) { 5319659Slinton panic("printval: bad class %d", ord(s->class)); 5329659Slinton } 53314382Slinton sp -= size(s); 53416606Ssam printf("[%s]", c_classname(s)); 53514382Slinton break; 5369659Slinton } 5379659Slinton } 5389659Slinton 5399659Slinton /* 5409659Slinton * Print out a C structure. 5419659Slinton */ 5429659Slinton 543*18213Slinton private c_printstruct (s) 5449659Slinton Symbol s; 5459659Slinton { 546*18213Slinton Symbol f; 547*18213Slinton Stack *savesp; 548*18213Slinton integer n, off, len; 5499659Slinton 5509659Slinton sp -= size(s); 5519659Slinton savesp = sp; 5529659Slinton printf("("); 5539659Slinton f = s->chain; 5549659Slinton for (;;) { 5559659Slinton off = f->symvalue.field.offset; 5569659Slinton len = f->symvalue.field.length; 55716606Ssam n = (off + len + BITSPERBYTE - 1) div BITSPERBYTE; 5589659Slinton sp += n; 5599659Slinton printf("%s = ", symname(f)); 5609659Slinton c_printval(f); 5619659Slinton sp = savesp; 5629659Slinton f = f->chain; 5639659Slinton if (f == nil) break; 5649659Slinton printf(", "); 5659659Slinton } 5669659Slinton printf(")"); 5679659Slinton } 5689659Slinton 5699659Slinton /* 5709659Slinton * Return the C name for the particular class of a symbol. 5719659Slinton */ 5729659Slinton 5739659Slinton public String c_classname(s) 5749659Slinton Symbol s; 5759659Slinton { 5769659Slinton String str; 5779659Slinton 5789659Slinton switch (s->class) { 5799659Slinton case RECORD: 5809659Slinton str = "struct"; 5819659Slinton break; 5829659Slinton 5839659Slinton case VARNT: 5849659Slinton str = "union"; 5859659Slinton break; 5869659Slinton 5879659Slinton case SCAL: 5889659Slinton str = "enum"; 5899659Slinton break; 5909659Slinton 5919659Slinton default: 5929659Slinton str = classname(s); 5939659Slinton } 5949659Slinton return str; 5959659Slinton } 596*18213Slinton 59712533Scsvaf public Node c_buildaref(a, slist) 59812533Scsvaf Node a, slist; 59912533Scsvaf { 60012533Scsvaf register Symbol t; 60112533Scsvaf register Node p; 60212533Scsvaf Symbol etype, atype, eltype; 603*18213Slinton Node r, esub; 60412533Scsvaf 60512533Scsvaf t = rtype(a->nodetype); 60612533Scsvaf eltype = t->type; 60712533Scsvaf if (t->class == PTR) { 60812533Scsvaf p = slist->value.arg[0]; 60912533Scsvaf if (not compatible(p->nodetype, t_int)) { 61012533Scsvaf beginerrmsg(); 611*18213Slinton fprintf(stderr, "subscript must be integer-compatible"); 61212533Scsvaf enderrmsg(); 61312533Scsvaf } 61412533Scsvaf r = build(O_MUL, p, build(O_LCON, (long) size(eltype))); 61512533Scsvaf r = build(O_ADD, build(O_RVAL, a), r); 61612533Scsvaf r->nodetype = eltype; 61712533Scsvaf } else if (t->class != ARRAY) { 61812533Scsvaf beginerrmsg(); 619*18213Slinton fprintf(stderr, "\""); 62012533Scsvaf prtree(stderr, a); 621*18213Slinton fprintf(stderr, "\" is not an array"); 62212533Scsvaf enderrmsg(); 62312533Scsvaf } else { 624*18213Slinton r = a; 62512533Scsvaf p = slist; 62612533Scsvaf t = t->chain; 62712533Scsvaf for (; p != nil and t != nil; p = p->value.arg[1], t = t->chain) { 62812533Scsvaf esub = p->value.arg[0]; 62912533Scsvaf etype = rtype(esub->nodetype); 63012533Scsvaf atype = rtype(t); 63112533Scsvaf if (not compatible(atype, etype)) { 63212533Scsvaf beginerrmsg(); 633*18213Slinton fprintf(stderr, "subscript \""); 63412533Scsvaf prtree(stderr, esub); 635*18213Slinton fprintf(stderr, "\" is the wrong type"); 63612533Scsvaf enderrmsg(); 63712533Scsvaf } 63812533Scsvaf r = build(O_INDEX, r, esub); 63912533Scsvaf r->nodetype = eltype; 64012533Scsvaf } 64112533Scsvaf if (p != nil or t != nil) { 64212533Scsvaf beginerrmsg(); 64312533Scsvaf if (p != nil) { 644*18213Slinton fprintf(stderr, "too many subscripts for \""); 64512533Scsvaf } else { 646*18213Slinton fprintf(stderr, "not enough subscripts for \""); 64712533Scsvaf } 64812533Scsvaf prtree(stderr, a); 649*18213Slinton fprintf(stderr, "\""); 65012533Scsvaf enderrmsg(); 65112533Scsvaf } 65212533Scsvaf } 65312533Scsvaf return r; 65412533Scsvaf } 65512533Scsvaf 65612533Scsvaf /* 65712533Scsvaf * Evaluate a subscript index. 65812533Scsvaf */ 65912533Scsvaf 660*18213Slinton public c_evalaref(s, base, i) 66112533Scsvaf Symbol s; 662*18213Slinton Address base; 66312533Scsvaf long i; 66412533Scsvaf { 665*18213Slinton Symbol t; 66612533Scsvaf long lb, ub; 66712533Scsvaf 668*18213Slinton t = rtype(s); 669*18213Slinton s = t->chain; 67012533Scsvaf lb = s->symvalue.rangev.lower; 67112533Scsvaf ub = s->symvalue.rangev.upper; 67212533Scsvaf if (i < lb or i > ub) { 67312533Scsvaf error("subscript out of range"); 67412533Scsvaf } 675*18213Slinton push(long, base + (i - lb) * size(t->type)); 67612533Scsvaf } 67716606Ssam 67816606Ssam /* 67916606Ssam * Initialize typetable information. 68016606Ssam */ 68116606Ssam 68216606Ssam public c_modinit (typetable) 68316606Ssam Symbol typetable[]; 68416606Ssam { 68516606Ssam /* nothing right now */ 68616606Ssam } 68716606Ssam 68816606Ssam public boolean c_hasmodules () 68916606Ssam { 69016606Ssam return false; 69116606Ssam } 69216606Ssam 69316606Ssam public boolean c_passaddr (param, exprtype) 69416606Ssam Symbol param, exprtype; 69516606Ssam { 69616606Ssam boolean b; 69716606Ssam Symbol t; 69816606Ssam 69916606Ssam t = rtype(exprtype); 70016606Ssam b = (boolean) (t->class == ARRAY); 70116606Ssam return b; 70216606Ssam } 703