1*21599Sdist /* 2*21599Sdist * Copyright (c) 1983 Regents of the University of California. 3*21599Sdist * All rights reserved. The Berkeley software License Agreement 4*21599Sdist * specifies the terms and conditions for redistribution. 5*21599Sdist */ 69659Slinton 7*21599Sdist #ifndef lint 8*21599Sdist static char sccsid[] = "@(#)c.c 5.1 (Berkeley) 05/31/85"; 9*21599Sdist #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 } 3029659Slinton printf("{\n", t->class == RECORD ? "struct" : "union"); 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; 4379659Slinton 4389659Slinton switch (s->class) { 4399659Slinton case CONST: 4409659Slinton case TYPE: 4419659Slinton case VAR: 4429659Slinton case REF: 4439659Slinton case FVAR: 4449659Slinton case TAG: 4459659Slinton c_printval(s->type); 4469659Slinton break; 4479659Slinton 4489659Slinton case FIELD: 4499659Slinton if (isbitfield(s)) { 45016606Ssam i = 0; 45116606Ssam popn(size(s), &i); 4529659Slinton i >>= (s->symvalue.field.offset mod BITSPERBYTE); 45316606Ssam i &= ((1 << s->symvalue.field.length) - 1); 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); 4719659Slinton sp -= len; 47218213Slinton if (s->language == primlang) { 47318213Slinton printf("%.*s", len, sp); 47418213Slinton } else { 47518213Slinton printf("\"%.*s\"", len, sp); 47618213Slinton } 4779659Slinton } else { 4789659Slinton printarray(s); 4799659Slinton } 4809659Slinton break; 4819659Slinton 4829659Slinton case RECORD: 4839659Slinton c_printstruct(s); 4849659Slinton break; 4859659Slinton 4869659Slinton case RANGE: 48718213Slinton if (s == t_boolean->type or istypename(s->type, "boolean")) { 48818213Slinton printRangeVal(popsmall(s), s); 48918213Slinton } else if (s == t_char->type or istypename(s->type, "char")) { 49018213Slinton printRangeVal(pop(char), s); 49118213Slinton } else if (s == t_real->type or isdouble(s)) { 4929659Slinton switch (s->symvalue.rangev.lower) { 4939659Slinton case sizeof(float): 4949659Slinton prtreal(pop(float)); 4959659Slinton break; 4969659Slinton 4979659Slinton case sizeof(double): 4989659Slinton prtreal(pop(double)); 4999659Slinton break; 5009659Slinton 5019659Slinton default: 5029659Slinton panic("bad real size %d", t->symvalue.rangev.lower); 5039659Slinton break; 5049659Slinton } 5059659Slinton } else { 50618213Slinton printRangeVal(popsmall(s), s); 5079659Slinton } 5089659Slinton break; 5099659Slinton 5109659Slinton case PTR: 5119659Slinton t = rtype(s->type); 5129659Slinton a = pop(Address); 5139659Slinton if (a == 0) { 5149659Slinton printf("(nil)"); 5159659Slinton } else if (t->class == RANGE and istypename(t->type, "char")) { 51618213Slinton printString(a, (boolean) (s->language != primlang)); 5179659Slinton } else { 5189659Slinton printf("0x%x", a); 5199659Slinton } 5209659Slinton break; 5219659Slinton 5229659Slinton case SCAL: 5239659Slinton i = pop(Integer); 52418213Slinton printEnum(i, s); 5259659Slinton break; 5269659Slinton 52718213Slinton /* 52818213Slinton * Unresolved structure pointers? 52918213Slinton */ 53018213Slinton case BADUSE: 53118213Slinton a = pop(Address); 53218213Slinton printf("@%x", a); 53318213Slinton break; 53418213Slinton 5359659Slinton default: 5369659Slinton if (ord(s->class) > ord(TYPEREF)) { 5379659Slinton panic("printval: bad class %d", ord(s->class)); 5389659Slinton } 53914382Slinton sp -= size(s); 54016606Ssam printf("[%s]", c_classname(s)); 54114382Slinton break; 5429659Slinton } 5439659Slinton } 5449659Slinton 5459659Slinton /* 5469659Slinton * Print out a C structure. 5479659Slinton */ 5489659Slinton 54918213Slinton private c_printstruct (s) 5509659Slinton Symbol s; 5519659Slinton { 55218213Slinton Symbol f; 55318213Slinton Stack *savesp; 55418213Slinton integer n, off, len; 5559659Slinton 5569659Slinton sp -= size(s); 5579659Slinton savesp = sp; 5589659Slinton printf("("); 5599659Slinton f = s->chain; 5609659Slinton for (;;) { 5619659Slinton off = f->symvalue.field.offset; 5629659Slinton len = f->symvalue.field.length; 56316606Ssam n = (off + len + BITSPERBYTE - 1) div BITSPERBYTE; 5649659Slinton sp += n; 5659659Slinton printf("%s = ", symname(f)); 5669659Slinton c_printval(f); 5679659Slinton sp = savesp; 5689659Slinton f = f->chain; 5699659Slinton if (f == nil) break; 5709659Slinton printf(", "); 5719659Slinton } 5729659Slinton printf(")"); 5739659Slinton } 5749659Slinton 5759659Slinton /* 5769659Slinton * Return the C name for the particular class of a symbol. 5779659Slinton */ 5789659Slinton 5799659Slinton public String c_classname(s) 5809659Slinton Symbol s; 5819659Slinton { 5829659Slinton String str; 5839659Slinton 5849659Slinton switch (s->class) { 5859659Slinton case RECORD: 5869659Slinton str = "struct"; 5879659Slinton break; 5889659Slinton 5899659Slinton case VARNT: 5909659Slinton str = "union"; 5919659Slinton break; 5929659Slinton 5939659Slinton case SCAL: 5949659Slinton str = "enum"; 5959659Slinton break; 5969659Slinton 5979659Slinton default: 5989659Slinton str = classname(s); 5999659Slinton } 6009659Slinton return str; 6019659Slinton } 60218213Slinton 60312533Scsvaf public Node c_buildaref(a, slist) 60412533Scsvaf Node a, slist; 60512533Scsvaf { 60612533Scsvaf register Symbol t; 60712533Scsvaf register Node p; 60812533Scsvaf Symbol etype, atype, eltype; 60918213Slinton Node r, esub; 61012533Scsvaf 61112533Scsvaf t = rtype(a->nodetype); 61212533Scsvaf eltype = t->type; 61312533Scsvaf if (t->class == PTR) { 61412533Scsvaf p = slist->value.arg[0]; 61512533Scsvaf if (not compatible(p->nodetype, t_int)) { 61612533Scsvaf beginerrmsg(); 61718213Slinton fprintf(stderr, "subscript must be integer-compatible"); 61812533Scsvaf enderrmsg(); 61912533Scsvaf } 62012533Scsvaf r = build(O_MUL, p, build(O_LCON, (long) size(eltype))); 62112533Scsvaf r = build(O_ADD, build(O_RVAL, a), r); 62212533Scsvaf r->nodetype = eltype; 62312533Scsvaf } else if (t->class != ARRAY) { 62412533Scsvaf beginerrmsg(); 62518213Slinton fprintf(stderr, "\""); 62612533Scsvaf prtree(stderr, a); 62718213Slinton fprintf(stderr, "\" is not an array"); 62812533Scsvaf enderrmsg(); 62912533Scsvaf } else { 63018213Slinton r = a; 63112533Scsvaf p = slist; 63212533Scsvaf t = t->chain; 63312533Scsvaf for (; p != nil and t != nil; p = p->value.arg[1], t = t->chain) { 63412533Scsvaf esub = p->value.arg[0]; 63512533Scsvaf etype = rtype(esub->nodetype); 63612533Scsvaf atype = rtype(t); 63712533Scsvaf if (not compatible(atype, etype)) { 63812533Scsvaf beginerrmsg(); 63918213Slinton fprintf(stderr, "subscript \""); 64012533Scsvaf prtree(stderr, esub); 64118213Slinton fprintf(stderr, "\" is the wrong type"); 64212533Scsvaf enderrmsg(); 64312533Scsvaf } 64412533Scsvaf r = build(O_INDEX, r, esub); 64512533Scsvaf r->nodetype = eltype; 64612533Scsvaf } 64712533Scsvaf if (p != nil or t != nil) { 64812533Scsvaf beginerrmsg(); 64912533Scsvaf if (p != nil) { 65018213Slinton fprintf(stderr, "too many subscripts for \""); 65112533Scsvaf } else { 65218213Slinton fprintf(stderr, "not enough subscripts for \""); 65312533Scsvaf } 65412533Scsvaf prtree(stderr, a); 65518213Slinton fprintf(stderr, "\""); 65612533Scsvaf enderrmsg(); 65712533Scsvaf } 65812533Scsvaf } 65912533Scsvaf return r; 66012533Scsvaf } 66112533Scsvaf 66212533Scsvaf /* 66312533Scsvaf * Evaluate a subscript index. 66412533Scsvaf */ 66512533Scsvaf 66618213Slinton public c_evalaref(s, base, i) 66712533Scsvaf Symbol s; 66818213Slinton Address base; 66912533Scsvaf long i; 67012533Scsvaf { 67118213Slinton Symbol t; 67212533Scsvaf long lb, ub; 67312533Scsvaf 67418213Slinton t = rtype(s); 67518213Slinton s = t->chain; 67612533Scsvaf lb = s->symvalue.rangev.lower; 67712533Scsvaf ub = s->symvalue.rangev.upper; 67812533Scsvaf if (i < lb or i > ub) { 67912533Scsvaf error("subscript out of range"); 68012533Scsvaf } 68118213Slinton push(long, base + (i - lb) * size(t->type)); 68212533Scsvaf } 68316606Ssam 68416606Ssam /* 68516606Ssam * Initialize typetable information. 68616606Ssam */ 68716606Ssam 68816606Ssam public c_modinit (typetable) 68916606Ssam Symbol typetable[]; 69016606Ssam { 69116606Ssam /* nothing right now */ 69216606Ssam } 69316606Ssam 69416606Ssam public boolean c_hasmodules () 69516606Ssam { 69616606Ssam return false; 69716606Ssam } 69816606Ssam 69916606Ssam public boolean c_passaddr (param, exprtype) 70016606Ssam Symbol param, exprtype; 70116606Ssam { 70216606Ssam boolean b; 70316606Ssam Symbol t; 70416606Ssam 70516606Ssam t = rtype(exprtype); 70616606Ssam b = (boolean) (t->class == ARRAY); 70716606Ssam return b; 70816606Ssam } 709