Return to c.c CVS log

Up to [CSRG BSD Unix] / 42BSD / ucb / dbx

Annotation of 42BSD/ucb/dbx/c.c, revision 1.1

1.1     ! root        1: /* Copyright (c) 1982 Regents of the University of California */
        !             2: 
        !             3: static char sccsid[] = "@(#)c.c 1.7 8/16/83";
        !             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:                printf("%s", symname(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:            c_printstruct(s);
        !           486:            break;
        !           487: 
        !           488:        case RANGE:
        !           489:            if (istypename(s->type, "boolean")) {
        !           490:                printrange(popsmall(s), s);
        !           491:            } else if (istypename(s->type, "char")) {
        !           492:                printrange(pop(char), s);
        !           493:            } else if (isdouble(s)) {
        !           494:                switch (s->symvalue.rangev.lower) {
        !           495:                    case sizeof(float):
        !           496:                        prtreal(pop(float));
        !           497:                        break;
        !           498: 
        !           499:                    case sizeof(double):
        !           500:                        prtreal(pop(double));
        !           501:                        break;
        !           502: 
        !           503:                    default:
        !           504:                        panic("bad real size %d", t->symvalue.rangev.lower);
        !           505:                        break;
        !           506:                }
        !           507:            } else {
        !           508:                printrange(popsmall(s), s);
        !           509:            }
        !           510:            break;
        !           511: 
        !           512:        case PTR:
        !           513:            t = rtype(s->type);
        !           514:            a = pop(Address);
        !           515:            if (a == 0) {
        !           516:                printf("(nil)");
        !           517:            } else if (t->class == RANGE and istypename(t->type, "char")) {
        !           518:                printstring(a);
        !           519:            } else {
        !           520:                printf("0x%x", a);
        !           521:            }
        !           522:            break;
        !           523: 
        !           524:        case SCAL:
        !           525:            i = pop(Integer);
        !           526:            printenum(i, s);
        !           527:            break;
        !           528: 
        !           529:        default:
        !           530:            if (ord(s->class) > ord(TYPEREF)) {
        !           531:                panic("printval: bad class %d", ord(s->class));
        !           532:            }
        !           533:            sp -= size(s);
        !           534:            printf("<%s>", c_classname(s));
        !           535:            break;
        !           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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.