| 1 | /* Copyright (c) 1982 Regents of the University of California */ |
| 2 | |
| 3 | static char sccsid[] = "@(#)c.c 1.5 %G%"; |
| 4 | |
| 5 | /* |
| 6 | * C-dependent symbol routines. |
| 7 | */ |
| 8 | |
| 9 | #include "defs.h" |
| 10 | #include "symbols.h" |
| 11 | #include "printsym.h" |
| 12 | #include "languages.h" |
| 13 | #include "c.h" |
| 14 | #include "tree.h" |
| 15 | #include "eval.h" |
| 16 | #include "operators.h" |
| 17 | #include "mappings.h" |
| 18 | #include "process.h" |
| 19 | #include "runtime.h" |
| 20 | #include "machine.h" |
| 21 | |
| 22 | #ifndef public |
| 23 | # include "tree.h" |
| 24 | #endif |
| 25 | |
| 26 | #define isdouble(range) ( \ |
| 27 | range->symvalue.rangev.upper == 0 and range->symvalue.rangev.lower > 0 \ |
| 28 | ) |
| 29 | |
| 30 | #define isrange(t, name) (t->class == RANGE and istypename(t->type, name)) |
| 31 | |
| 32 | /* |
| 33 | * Initialize C language information. |
| 34 | */ |
| 35 | |
| 36 | public c_init() |
| 37 | { |
| 38 | Language lang; |
| 39 | |
| 40 | lang = language_define("c", ".c"); |
| 41 | language_setop(lang, L_PRINTDECL, c_printdecl); |
| 42 | language_setop(lang, L_PRINTVAL, c_printval); |
| 43 | language_setop(lang, L_TYPEMATCH, c_typematch); |
| 44 | language_setop(lang, L_BUILDAREF, c_buildaref); |
| 45 | language_setop(lang, L_EVALAREF, c_evalaref); |
| 46 | } |
| 47 | |
| 48 | /* |
| 49 | * Test if two types are compatible. |
| 50 | */ |
| 51 | |
| 52 | public Boolean c_typematch(type1, type2) |
| 53 | Symbol type1, type2; |
| 54 | { |
| 55 | Boolean b; |
| 56 | register Symbol t1, t2, tmp; |
| 57 | |
| 58 | t1 = type1; |
| 59 | t2 = type2; |
| 60 | if (t1 == t2) { |
| 61 | b = true; |
| 62 | } else { |
| 63 | t1 = rtype(t1); |
| 64 | t2 = rtype(t2); |
| 65 | if (t1->type == t_char or t1->type == t_int or t1->type == t_real) { |
| 66 | tmp = t1; |
| 67 | t1 = t2; |
| 68 | t2 = tmp; |
| 69 | } |
| 70 | b = (Boolean) ( |
| 71 | ( |
| 72 | isrange(t1, "int") and |
| 73 | (t2->type == t_int or t2->type == t_char) |
| 74 | ) or ( |
| 75 | isrange(t1, "char") and |
| 76 | (t2->type == t_char or t2->type == t_int) |
| 77 | ) or ( |
| 78 | t1->class == RANGE and isdouble(t1) and t2->type == t_real |
| 79 | ) or ( |
| 80 | t1->type == t2->type and ( |
| 81 | (t1->class == t2->class) or |
| 82 | (t1->class == SCAL and t2->class == CONST) or |
| 83 | (t1->class == CONST and t2->class == SCAL) |
| 84 | ) |
| 85 | ) |
| 86 | ); |
| 87 | } |
| 88 | return b; |
| 89 | } |
| 90 | |
| 91 | /* |
| 92 | * Decide if a field is a bit field. |
| 93 | */ |
| 94 | |
| 95 | private Boolean isbitfield(s) |
| 96 | register Symbol s; |
| 97 | { |
| 98 | Boolean b; |
| 99 | register Integer off, len; |
| 100 | register Symbol t; |
| 101 | |
| 102 | off = s->symvalue.field.offset; |
| 103 | len = s->symvalue.field.length; |
| 104 | if ((off mod BITSPERBYTE) != 0 or (len mod BITSPERBYTE) != 0) { |
| 105 | b = true; |
| 106 | } else { |
| 107 | t = rtype(s->type); |
| 108 | b = (Boolean) |
| 109 | (t->class == SCAL and len != (sizeof(int)*BITSPERBYTE) or |
| 110 | len != (size(t)*BITSPERBYTE) |
| 111 | ); |
| 112 | } |
| 113 | return b; |
| 114 | } |
| 115 | |
| 116 | /* |
| 117 | * Print out the declaration of a C variable. |
| 118 | */ |
| 119 | |
| 120 | public c_printdecl(s) |
| 121 | Symbol s; |
| 122 | { |
| 123 | printdecl(s, 0); |
| 124 | } |
| 125 | |
| 126 | private printdecl(s, indent) |
| 127 | register Symbol s; |
| 128 | Integer indent; |
| 129 | { |
| 130 | register Symbol t; |
| 131 | Boolean semicolon, newline; |
| 132 | |
| 133 | semicolon = true; |
| 134 | newline = true; |
| 135 | if (indent > 0) { |
| 136 | printf("%*c", indent, ' '); |
| 137 | } |
| 138 | if (s->class == TYPE) { |
| 139 | printf("typedef "); |
| 140 | } |
| 141 | switch (s->class) { |
| 142 | case CONST: |
| 143 | if (s->type->class == SCAL) { |
| 144 | printf("(enumeration constant, ord %ld)", |
| 145 | s->symvalue.iconval); |
| 146 | } else { |
| 147 | printf("const %s = ", symname(s)); |
| 148 | printval(s); |
| 149 | } |
| 150 | break; |
| 151 | |
| 152 | case TYPE: |
| 153 | case VAR: |
| 154 | if (s->class != TYPE) { |
| 155 | if (s->level == 2) { |
| 156 | printf("static "); |
| 157 | } else if (s->level < 0) { |
| 158 | printf("register "); |
| 159 | } |
| 160 | } |
| 161 | if (s->type->class == ARRAY) { |
| 162 | printtype(s->type, s->type->type, indent); |
| 163 | t = rtype(s->type->chain); |
| 164 | assert(t->class == RANGE); |
| 165 | printf(" %s[%d]", symname(s), t->symvalue.rangev.upper + 1); |
| 166 | } else { |
| 167 | printtype(s, s->type, indent); |
| 168 | if (s->type->class != PTR) { |
| 169 | printf(" "); |
| 170 | } |
| 171 | printf("%s", symname(s)); |
| 172 | } |
| 173 | break; |
| 174 | |
| 175 | case FIELD: |
| 176 | if (s->type->class == ARRAY) { |
| 177 | printtype(s->type, s->type->type, indent); |
| 178 | t = rtype(s->type->chain); |
| 179 | assert(t->class == RANGE); |
| 180 | printf(" %s[%d]", symname(s), t->symvalue.rangev.upper + 1); |
| 181 | } else { |
| 182 | printtype(s, s->type, indent); |
| 183 | if (s->type->class != PTR) { |
| 184 | printf(" "); |
| 185 | } |
| 186 | printf("%s", symname(s)); |
| 187 | } |
| 188 | if (isbitfield(s)) { |
| 189 | printf(" : %d", s->symvalue.field.length); |
| 190 | } |
| 191 | break; |
| 192 | |
| 193 | case TAG: |
| 194 | if (s->type == nil) { |
| 195 | findtype(s); |
| 196 | if (s->type == nil) { |
| 197 | error("unexpected missing type information"); |
| 198 | } |
| 199 | } |
| 200 | printtype(s, s->type, indent); |
| 201 | break; |
| 202 | |
| 203 | case RANGE: |
| 204 | case ARRAY: |
| 205 | case RECORD: |
| 206 | case VARNT: |
| 207 | case PTR: |
| 208 | semicolon = false; |
| 209 | printtype(s, s, indent); |
| 210 | break; |
| 211 | |
| 212 | case PROC: |
| 213 | semicolon = false; |
| 214 | printf("%s", symname(s)); |
| 215 | c_listparams(s); |
| 216 | newline = false; |
| 217 | break; |
| 218 | |
| 219 | case FUNC: |
| 220 | semicolon = false; |
| 221 | if (not istypename(s->type, "void")) { |
| 222 | printtype(s, s->type, indent); |
| 223 | printf(" "); |
| 224 | } |
| 225 | printf("%s", symname(s)); |
| 226 | c_listparams(s); |
| 227 | newline = false; |
| 228 | break; |
| 229 | |
| 230 | case MODULE: |
| 231 | semicolon = false; |
| 232 | printf("source file \"%s.c\"", symname(s)); |
| 233 | break; |
| 234 | |
| 235 | case PROG: |
| 236 | semicolon = false; |
| 237 | printf("executable file \"%s\"", symname(s)); |
| 238 | break; |
| 239 | |
| 240 | default: |
| 241 | error("class %s in c_printdecl", classname(s)); |
| 242 | } |
| 243 | if (semicolon) { |
| 244 | putchar(';'); |
| 245 | } |
| 246 | if (newline) { |
| 247 | putchar('\n'); |
| 248 | } |
| 249 | } |
| 250 | |
| 251 | /* |
| 252 | * Recursive whiz-bang procedure to print the type portion |
| 253 | * of a declaration. |
| 254 | * |
| 255 | * The symbol associated with the type is passed to allow |
| 256 | * searching for type names without getting "type blah = blah". |
| 257 | */ |
| 258 | |
| 259 | private printtype(s, t, indent) |
| 260 | Symbol s; |
| 261 | Symbol t; |
| 262 | Integer indent; |
| 263 | { |
| 264 | register Symbol i; |
| 265 | long r0, r1; |
| 266 | register String p; |
| 267 | |
| 268 | checkref(s); |
| 269 | checkref(t); |
| 270 | switch (t->class) { |
| 271 | case VAR: |
| 272 | case CONST: |
| 273 | case PROC: |
| 274 | panic("printtype: class %s", classname(t)); |
| 275 | break; |
| 276 | |
| 277 | case ARRAY: |
| 278 | printf("array["); |
| 279 | i = t->chain; |
| 280 | if (i != nil) { |
| 281 | for (;;) { |
| 282 | printtype(i, i, indent); |
| 283 | i = i->chain; |
| 284 | if (i == nil) { |
| 285 | break; |
| 286 | } |
| 287 | printf(", "); |
| 288 | } |
| 289 | } |
| 290 | printf("] of "); |
| 291 | printtype(t, t->type, indent); |
| 292 | break; |
| 293 | |
| 294 | case RECORD: |
| 295 | case VARNT: |
| 296 | printf("%s ", c_classname(t)); |
| 297 | if (s->name != nil and s->class == TAG) { |
| 298 | p = symname(s); |
| 299 | if (p[0] == '$' and p[1] == '$') { |
| 300 | printf("%s ", &p[2]); |
| 301 | } else { |
| 302 | printf("%s ", p); |
| 303 | } |
| 304 | } |
| 305 | printf("{\n", t->class == RECORD ? "struct" : "union"); |
| 306 | for (i = t->chain; i != nil; i = i->chain) { |
| 307 | assert(i->class == FIELD); |
| 308 | printdecl(i, indent+4); |
| 309 | } |
| 310 | if (indent > 0) { |
| 311 | printf("%*c", indent, ' '); |
| 312 | } |
| 313 | printf("}"); |
| 314 | break; |
| 315 | |
| 316 | case RANGE: |
| 317 | r0 = t->symvalue.rangev.lower; |
| 318 | r1 = t->symvalue.rangev.upper; |
| 319 | if (istypename(t->type, "char")) { |
| 320 | if (r0 < 0x20 or r0 > 0x7e) { |
| 321 | printf("%ld..", r0); |
| 322 | } else { |
| 323 | printf("'%c'..", (char) r0); |
| 324 | } |
| 325 | if (r1 < 0x20 or r1 > 0x7e) { |
| 326 | printf("\\%lo", r1); |
| 327 | } else { |
| 328 | printf("'%c'", (char) r1); |
| 329 | } |
| 330 | } else if (r0 > 0 and r1 == 0) { |
| 331 | printf("%ld byte real", r0); |
| 332 | } else if (r0 >= 0) { |
| 333 | printf("%lu..%lu", r0, r1); |
| 334 | } else { |
| 335 | printf("%ld..%ld", r0, r1); |
| 336 | } |
| 337 | break; |
| 338 | |
| 339 | case PTR: |
| 340 | printtype(t, t->type, indent); |
| 341 | if (t->type->class != PTR) { |
| 342 | printf(" "); |
| 343 | } |
| 344 | printf("*"); |
| 345 | break; |
| 346 | |
| 347 | case FUNC: |
| 348 | printtype(t, t->type, indent); |
| 349 | printf("()"); |
| 350 | break; |
| 351 | |
| 352 | case TYPE: |
| 353 | if (t->name != nil) { |
| 354 | printname(stdout, t); |
| 355 | } else { |
| 356 | printtype(t, t->type, indent); |
| 357 | } |
| 358 | break; |
| 359 | |
| 360 | case TYPEREF: |
| 361 | printf("@%s", symname(t)); |
| 362 | break; |
| 363 | |
| 364 | case SCAL: |
| 365 | printf("enum "); |
| 366 | if (s->name != nil and s->class == TAG) { |
| 367 | printf("%s ", symname(s)); |
| 368 | } |
| 369 | printf("{ "); |
| 370 | i = t->chain; |
| 371 | if (i != nil) { |
| 372 | for (;;) { |
| 373 | printf("%s", symname(i)); |
| 374 | i = i->chain; |
| 375 | if (i == nil) break; |
| 376 | printf(", "); |
| 377 | } |
| 378 | } |
| 379 | printf(" }"); |
| 380 | break; |
| 381 | |
| 382 | case TAG: |
| 383 | if (t->type == nil) { |
| 384 | printf("unresolved tag %s", symname(t)); |
| 385 | } else { |
| 386 | i = rtype(t->type); |
| 387 | printf("%s %s", c_classname(i), symname(t)); |
| 388 | } |
| 389 | break; |
| 390 | |
| 391 | default: |
| 392 | printf("(class %d)", t->class); |
| 393 | break; |
| 394 | } |
| 395 | } |
| 396 | |
| 397 | /* |
| 398 | * List the parameters of a procedure or function. |
| 399 | * No attempt is made to combine like types. |
| 400 | */ |
| 401 | |
| 402 | public c_listparams(s) |
| 403 | Symbol s; |
| 404 | { |
| 405 | register Symbol t; |
| 406 | |
| 407 | putchar('('); |
| 408 | for (t = s->chain; t != nil; t = t->chain) { |
| 409 | printf("%s", symname(t)); |
| 410 | if (t->chain != nil) { |
| 411 | printf(", "); |
| 412 | } |
| 413 | } |
| 414 | putchar(')'); |
| 415 | if (s->chain != nil) { |
| 416 | printf("\n"); |
| 417 | for (t = s->chain; t != nil; t = t->chain) { |
| 418 | if (t->class != VAR) { |
| 419 | panic("unexpected class %d for parameter", t->class); |
| 420 | } |
| 421 | printdecl(t, 0); |
| 422 | } |
| 423 | } else { |
| 424 | putchar('\n'); |
| 425 | } |
| 426 | } |
| 427 | |
| 428 | /* |
| 429 | * Print out the value on the top of the expression stack |
| 430 | * in the format for the type of the given symbol. |
| 431 | */ |
| 432 | |
| 433 | public c_printval(s) |
| 434 | Symbol s; |
| 435 | { |
| 436 | register Symbol t; |
| 437 | register Address a; |
| 438 | register int i, len; |
| 439 | |
| 440 | switch (s->class) { |
| 441 | case CONST: |
| 442 | case TYPE: |
| 443 | case VAR: |
| 444 | case REF: |
| 445 | case FVAR: |
| 446 | case TAG: |
| 447 | c_printval(s->type); |
| 448 | break; |
| 449 | |
| 450 | case FIELD: |
| 451 | if (isbitfield(s)) { |
| 452 | len = s->symvalue.field.length; |
| 453 | if (len <= BITSPERBYTE) { |
| 454 | i = pop(char); |
| 455 | } else if (len <= sizeof(short)*BITSPERBYTE) { |
| 456 | i = pop(short); |
| 457 | } else { |
| 458 | i = pop(long); |
| 459 | } |
| 460 | i >>= (s->symvalue.field.offset mod BITSPERBYTE); |
| 461 | i &= ((1 << len) - 1); |
| 462 | t = rtype(s->type); |
| 463 | if (t->class == SCAL) { |
| 464 | printenum(i, t); |
| 465 | } else { |
| 466 | printrange(i, t); |
| 467 | } |
| 468 | } else { |
| 469 | c_printval(s->type); |
| 470 | } |
| 471 | break; |
| 472 | |
| 473 | case ARRAY: |
| 474 | t = rtype(s->type); |
| 475 | if (t->class == RANGE and istypename(t->type, "char")) { |
| 476 | len = size(s); |
| 477 | sp -= len; |
| 478 | printf("\"%.*s\"", len, sp); |
| 479 | } else { |
| 480 | printarray(s); |
| 481 | } |
| 482 | break; |
| 483 | |
| 484 | case RECORD: |
| 485 | case VARNT: |
| 486 | c_printstruct(s); |
| 487 | break; |
| 488 | |
| 489 | case RANGE: |
| 490 | if (istypename(s->type, "boolean")) { |
| 491 | printrange(popsmall(s), s); |
| 492 | } else if (istypename(s->type, "char")) { |
| 493 | printrange(pop(char), s); |
| 494 | } else if (isdouble(s)) { |
| 495 | switch (s->symvalue.rangev.lower) { |
| 496 | case sizeof(float): |
| 497 | prtreal(pop(float)); |
| 498 | break; |
| 499 | |
| 500 | case sizeof(double): |
| 501 | prtreal(pop(double)); |
| 502 | break; |
| 503 | |
| 504 | default: |
| 505 | panic("bad real size %d", t->symvalue.rangev.lower); |
| 506 | break; |
| 507 | } |
| 508 | } else { |
| 509 | printrange(popsmall(s), s); |
| 510 | } |
| 511 | break; |
| 512 | |
| 513 | case PTR: |
| 514 | t = rtype(s->type); |
| 515 | a = pop(Address); |
| 516 | if (a == 0) { |
| 517 | printf("(nil)"); |
| 518 | } else if (t->class == RANGE and istypename(t->type, "char")) { |
| 519 | printstring(a); |
| 520 | } else { |
| 521 | printf("0x%x", a); |
| 522 | } |
| 523 | break; |
| 524 | |
| 525 | case SCAL: |
| 526 | i = pop(Integer); |
| 527 | printenum(i, s); |
| 528 | break; |
| 529 | |
| 530 | default: |
| 531 | if (ord(s->class) > ord(TYPEREF)) { |
| 532 | panic("printval: bad class %d", ord(s->class)); |
| 533 | } |
| 534 | error("don't know how to print a %s", c_classname(s)); |
| 535 | /* NOTREACHED */ |
| 536 | } |
| 537 | } |
| 538 | |
| 539 | /* |
| 540 | * Print out a C structure. |
| 541 | */ |
| 542 | |
| 543 | private c_printstruct(s) |
| 544 | Symbol s; |
| 545 | { |
| 546 | register Symbol f; |
| 547 | register Stack *savesp; |
| 548 | register Integer n, off, len; |
| 549 | |
| 550 | sp -= size(s); |
| 551 | savesp = sp; |
| 552 | printf("("); |
| 553 | f = s->chain; |
| 554 | for (;;) { |
| 555 | off = f->symvalue.field.offset; |
| 556 | len = f->symvalue.field.length; |
| 557 | n = (off + len + 7) div BITSPERBYTE; |
| 558 | sp += n; |
| 559 | printf("%s = ", symname(f)); |
| 560 | c_printval(f); |
| 561 | sp = savesp; |
| 562 | f = f->chain; |
| 563 | if (f == nil) break; |
| 564 | printf(", "); |
| 565 | } |
| 566 | printf(")"); |
| 567 | } |
| 568 | |
| 569 | /* |
| 570 | * Print out a range type (integer, char, or boolean). |
| 571 | */ |
| 572 | |
| 573 | private printrange(i, t) |
| 574 | Integer i; |
| 575 | register Symbol t; |
| 576 | { |
| 577 | if (istypename(t->type, "boolean")) { |
| 578 | printf(((Boolean) i) == true ? "true" : "false"); |
| 579 | } else if (istypename(t->type, "char")) { |
| 580 | putchar('\''); |
| 581 | printchar(i); |
| 582 | putchar('\''); |
| 583 | } else if (t->symvalue.rangev.lower >= 0) { |
| 584 | printf("%lu", i); |
| 585 | } else { |
| 586 | printf("%ld", i); |
| 587 | } |
| 588 | } |
| 589 | |
| 590 | /* |
| 591 | * Print out a null-terminated string (pointer to char) |
| 592 | * starting at the given address. |
| 593 | */ |
| 594 | |
| 595 | private printstring(addr) |
| 596 | Address addr; |
| 597 | { |
| 598 | register Address a; |
| 599 | register Integer i, len; |
| 600 | register Boolean endofstring; |
| 601 | union { |
| 602 | char ch[sizeof(Word)]; |
| 603 | int word; |
| 604 | } u; |
| 605 | |
| 606 | putchar('"'); |
| 607 | a = addr; |
| 608 | endofstring = false; |
| 609 | while (not endofstring) { |
| 610 | dread(&u, a, sizeof(u)); |
| 611 | i = 0; |
| 612 | do { |
| 613 | if (u.ch[i] == '\0') { |
| 614 | endofstring = true; |
| 615 | } else { |
| 616 | printchar(u.ch[i]); |
| 617 | } |
| 618 | ++i; |
| 619 | } while (i < sizeof(Word) and not endofstring); |
| 620 | a += sizeof(Word); |
| 621 | } |
| 622 | putchar('"'); |
| 623 | } |
| 624 | |
| 625 | /* |
| 626 | * Print out an enumerated value by finding the corresponding |
| 627 | * name in the enumeration list. |
| 628 | */ |
| 629 | |
| 630 | private printenum(i, t) |
| 631 | Integer i; |
| 632 | Symbol t; |
| 633 | { |
| 634 | register Symbol e; |
| 635 | |
| 636 | e = t->chain; |
| 637 | while (e != nil and e->symvalue.iconval != i) { |
| 638 | e = e->chain; |
| 639 | } |
| 640 | if (e != nil) { |
| 641 | printf("%s", symname(e)); |
| 642 | } else { |
| 643 | printf("%d", i); |
| 644 | } |
| 645 | } |
| 646 | |
| 647 | /* |
| 648 | * Return the C name for the particular class of a symbol. |
| 649 | */ |
| 650 | |
| 651 | public String c_classname(s) |
| 652 | Symbol s; |
| 653 | { |
| 654 | String str; |
| 655 | |
| 656 | switch (s->class) { |
| 657 | case RECORD: |
| 658 | str = "struct"; |
| 659 | break; |
| 660 | |
| 661 | case VARNT: |
| 662 | str = "union"; |
| 663 | break; |
| 664 | |
| 665 | case SCAL: |
| 666 | str = "enum"; |
| 667 | break; |
| 668 | |
| 669 | default: |
| 670 | str = classname(s); |
| 671 | } |
| 672 | return str; |
| 673 | } |
| 674 | public Node c_buildaref(a, slist) |
| 675 | Node a, slist; |
| 676 | { |
| 677 | register Symbol t; |
| 678 | register Node p; |
| 679 | Symbol etype, atype, eltype; |
| 680 | Node esub, r; |
| 681 | |
| 682 | r = a; |
| 683 | t = rtype(a->nodetype); |
| 684 | eltype = t->type; |
| 685 | if (t->class == PTR) { |
| 686 | p = slist->value.arg[0]; |
| 687 | if (not compatible(p->nodetype, t_int)) { |
| 688 | beginerrmsg(); |
| 689 | fprintf(stderr, "bad type for subscript of "); |
| 690 | prtree(stderr, a); |
| 691 | enderrmsg(); |
| 692 | } |
| 693 | r = build(O_MUL, p, build(O_LCON, (long) size(eltype))); |
| 694 | r = build(O_ADD, build(O_RVAL, a), r); |
| 695 | r->nodetype = eltype; |
| 696 | } else if (t->class != ARRAY) { |
| 697 | beginerrmsg(); |
| 698 | prtree(stderr, a); |
| 699 | fprintf(stderr, " is not an array"); |
| 700 | enderrmsg(); |
| 701 | } else { |
| 702 | p = slist; |
| 703 | t = t->chain; |
| 704 | for (; p != nil and t != nil; p = p->value.arg[1], t = t->chain) { |
| 705 | esub = p->value.arg[0]; |
| 706 | etype = rtype(esub->nodetype); |
| 707 | atype = rtype(t); |
| 708 | if (not compatible(atype, etype)) { |
| 709 | beginerrmsg(); |
| 710 | fprintf(stderr, "subscript "); |
| 711 | prtree(stderr, esub); |
| 712 | fprintf(stderr, " is the wrong type"); |
| 713 | enderrmsg(); |
| 714 | } |
| 715 | r = build(O_INDEX, r, esub); |
| 716 | r->nodetype = eltype; |
| 717 | } |
| 718 | if (p != nil or t != nil) { |
| 719 | beginerrmsg(); |
| 720 | if (p != nil) { |
| 721 | fprintf(stderr, "too many subscripts for "); |
| 722 | } else { |
| 723 | fprintf(stderr, "not enough subscripts for "); |
| 724 | } |
| 725 | prtree(stderr, a); |
| 726 | enderrmsg(); |
| 727 | } |
| 728 | } |
| 729 | return r; |
| 730 | } |
| 731 | |
| 732 | /* |
| 733 | * Evaluate a subscript index. |
| 734 | */ |
| 735 | |
| 736 | public int c_evalaref(s, i) |
| 737 | Symbol s; |
| 738 | long i; |
| 739 | { |
| 740 | long lb, ub; |
| 741 | |
| 742 | s = rtype(s)->chain; |
| 743 | lb = s->symvalue.rangev.lower; |
| 744 | ub = s->symvalue.rangev.upper; |
| 745 | if (i < lb or i > ub) { |
| 746 | error("subscript out of range"); |
| 747 | } |
| 748 | return (i - lb); |
| 749 | } |