Return to c.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / pgrm / dbx

Annotation of 43BSDReno/pgrm/dbx/c.c, revision 1.1

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

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