Return to tree.c CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / pascal / pdx / sym

Annotation of 43BSDTahoe/ucb/pascal/pdx/sym/tree.c, revision 1.1

1.1     ! root        1: /*
        !             2:  * Copyright (c) 1980 Regents of the University of California.
        !             3:  * All rights reserved.  The Berkeley software License Agreement
        !             4:  * specifies the terms and conditions for redistribution.
        !             5:  */
        !             6: 
        !             7: #ifndef lint
        !             8: static char sccsid[] = "@(#)tree.c     5.2 (Berkeley) 4/7/87";
        !             9: #endif not lint
        !            10: 
        !            11: /*
        !            12:  * This module contains the interface between the SYM routines and
        !            13:  * the parse tree routines.  It would be nice if such a crude
        !            14:  * interface were not necessary, but some parts of tree building are
        !            15:  * language and hence SYM-representation dependent.  It's probably
        !            16:  * better to have tree-representation dependent code here than vice versa.
        !            17:  */
        !            18: 
        !            19: #include "defs.h"
        !            20: #include "tree.h"
        !            21: #include "sym.h"
        !            22: #include "btypes.h"
        !            23: #include "classes.h"
        !            24: #include "sym.rep"
        !            25: #include "tree/tree.rep"
        !            26: 
        !            27: typedef char *ARGLIST;
        !            28: 
        !            29: #define nextarg(arglist, type)  ((type *) (arglist += sizeof(type)))[-1]
        !            30: 
        !            31: LOCAL SYM *mkstring();
        !            32: LOCAL SYM *namenode();
        !            33: 
        !            34: /*
        !            35:  * Determine the type of a parse tree.  While we're at, check
        !            36:  * the parse tree out.
        !            37:  */
        !            38: 
        !            39: SYM *treetype(p, ap)
        !            40: register NODE *p;
        !            41: register ARGLIST ap;
        !            42: {
        !            43:     switch(p->op) {
        !            44:        case O_NAME: {
        !            45:            SYM *s;
        !            46: 
        !            47:            s = nextarg(ap, SYM *);
        !            48:            s = which(s);
        !            49:            return namenode(p, s);
        !            50:            /* NOTREACHED */
        !            51:        }
        !            52: 
        !            53:        case O_WHICH:
        !            54:            p->nameval = nextarg(ap, SYM *);
        !            55:            p->nameval = which(p->nameval);
        !            56:            return NIL;
        !            57: 
        !            58:        case O_LCON:
        !            59:            return t_int;
        !            60: 
        !            61:        case O_FCON:
        !            62:            return t_real;
        !            63: 
        !            64:        case O_SCON: {
        !            65:            char *cpy;
        !            66:            SYM *s;
        !            67: 
        !            68:            cpy = strdup(p->sconval);
        !            69:            p->sconval = cpy;
        !            70:            s = mkstring(p->sconval);
        !            71:            if (s == t_char) {
        !            72:                p->op = O_LCON;
        !            73:                p->lconval = p->sconval[0];
        !            74:            }
        !            75:            return s;
        !            76:        }
        !            77: 
        !            78:        case O_INDIR:
        !            79:            p->left = nextarg(ap, NODE *);
        !            80:            chkclass(p->left, PTR);
        !            81:            return rtype(p->left->nodetype)->type;
        !            82: 
        !            83:        case O_RVAL: {
        !            84:            NODE *p1;
        !            85: 
        !            86:            p1 = p->left;
        !            87:            p->nodetype = p1->nodetype;
        !            88:            if (p1->op == O_NAME) {
        !            89:                if (p1->nodetype->class == FUNC) {
        !            90:                    p->op = O_CALL;
        !            91:                    p->right = NIL;
        !            92:                } else if (p1->nameval->class == CONST) {
        !            93:                    if (p1->nameval->type == t_real->type) {
        !            94:                        p->op = O_FCON;
        !            95:                        p->fconval = p1->nameval->symvalue.fconval;
        !            96:                        p->nodetype = t_real;
        !            97:                        dispose(p1);
        !            98:                    } else {
        !            99:                        p->op = O_LCON;
        !           100:                        p->lconval = p1->nameval->symvalue.iconval;
        !           101:                        p->nodetype = p1->nameval->type;
        !           102:                        dispose(p1);
        !           103:                    }
        !           104:                }
        !           105:            }
        !           106:            return p->nodetype;
        !           107:            /* NOTREACHED */
        !           108:        }
        !           109: 
        !           110:        case O_CALL: {
        !           111:            SYM *s;
        !           112: 
        !           113:            p->left = nextarg(ap, NODE *);
        !           114:            p->right = nextarg(ap, NODE *);
        !           115:            s = p->left->nodetype;
        !           116:            if (isblock(s) && isbuiltin(s)) {
        !           117:                p->op = (OP) s->symvalue.token.tokval;
        !           118:                tfree(p->left);
        !           119:                p->left = p->right;
        !           120:                p->right = NIL;
        !           121:            }
        !           122:            return s->type;
        !           123:        }
        !           124: 
        !           125:        case O_ITOF:
        !           126:            return t_real;
        !           127: 
        !           128:        case O_NEG: {
        !           129:            SYM *s;
        !           130: 
        !           131:            p->left = nextarg(ap, NODE *);
        !           132:            s = p->left->nodetype;
        !           133:            if (!compatible(s, t_int)) {
        !           134:                if (!compatible(s, t_real)) {
        !           135:                    trerror("%t is improper type", p->left);
        !           136:                } else {
        !           137:                    p->op = O_NEGF;
        !           138:                }
        !           139:            }
        !           140:            return s;
        !           141:        }
        !           142: 
        !           143:        case O_ADD:
        !           144:        case O_SUB:
        !           145:        case O_MUL:
        !           146:        case O_LT:
        !           147:        case O_LE:
        !           148:        case O_GT:
        !           149:        case O_GE:
        !           150:        case O_EQ:
        !           151:        case O_NE:
        !           152:        {
        !           153:            BOOLEAN t1real, t2real;
        !           154:            SYM *t1, *t2;
        !           155: 
        !           156:            p->left = nextarg(ap, NODE *);
        !           157:            p->right = nextarg(ap, NODE *);
        !           158:            t1 = rtype(p->left->nodetype);
        !           159:            t2 = rtype(p->right->nodetype);
        !           160:            t1real = (t1 == t_real);
        !           161:            t2real = (t2 == t_real);
        !           162:            if (t1real || t2real) {
        !           163:                p->op++;
        !           164:                if (!t1real) {
        !           165:                    p->left = build(O_ITOF, p->left);
        !           166:                } else if (!t2real) {
        !           167:                    p->right = build(O_ITOF, p->right);
        !           168:                }
        !           169:            } else {
        !           170:                if (t1real) {
        !           171:                    convert(&p->left, t_int, O_NOP);
        !           172:                }
        !           173:                if (t2real) {
        !           174:                    convert(&p->right, t_int, O_NOP);
        !           175:                }
        !           176:            }
        !           177:            if (p->op >= O_LT) {
        !           178:                return t_boolean;
        !           179:            } else {
        !           180:                if (t1real || t2real) {
        !           181:                    return t_real;
        !           182:                } else {
        !           183:                    return t_int;
        !           184:                }
        !           185:            }
        !           186:            /* NOTREACHED */
        !           187:        }
        !           188: 
        !           189:        case O_DIVF:
        !           190:            p->left = nextarg(ap, NODE *);
        !           191:            p->right = nextarg(ap, NODE *);
        !           192:            convert(&p->left, t_real, O_ITOF);
        !           193:            convert(&p->right, t_real, O_ITOF);
        !           194:            return t_real;
        !           195: 
        !           196:        case O_DIV:
        !           197:        case O_MOD:
        !           198:            p->left = nextarg(ap, NODE *);
        !           199:            p->right = nextarg(ap, NODE *);
        !           200:            convert(&p->left, t_int, O_NOP);
        !           201:            convert(&p->right, t_int, O_NOP);
        !           202:            return t_int;
        !           203: 
        !           204:        case O_AND:
        !           205:        case O_OR:
        !           206:            p->left = nextarg(ap, NODE *);
        !           207:            p->right = nextarg(ap, NODE *);
        !           208:            chkboolean(p->left);
        !           209:            chkboolean(p->right);
        !           210:            return t_boolean;
        !           211: 
        !           212:        default:
        !           213:            return NIL;
        !           214:     }
        !           215: }
        !           216: 
        !           217: /*
        !           218:  * Create a node for a name.  The symbol for the name has already
        !           219:  * been chosen, either implicitly with "which" or explicitly from
        !           220:  * the dot routine.
        !           221:  */
        !           222: 
        !           223: LOCAL SYM *namenode(p, s)
        !           224: NODE *p;
        !           225: SYM *s;
        !           226: {
        !           227:     NODE *np;
        !           228: 
        !           229:     p->nameval = s;
        !           230:     if (s->class == REF) {
        !           231:        np = alloc(1, NODE);
        !           232:        *np = *p;
        !           233:        p->op = O_INDIR;
        !           234:        p->left = np;
        !           235:        np->nodetype = s;
        !           236:     }
        !           237:     if (s->class == CONST || s->class == VAR || s->class == FVAR) {
        !           238:        return s->type;
        !           239:     } else {
        !           240:        return s;
        !           241:     }
        !           242: }
        !           243: 
        !           244: /*
        !           245:  * Convert a tree to a type via a conversion operator;
        !           246:  * if this isn't possible generate an error.
        !           247:  *
        !           248:  * Note the tree is call by address, hence the #define below.
        !           249:  */
        !           250: 
        !           251: LOCAL convert(tp, typeto, op)
        !           252: NODE **tp;
        !           253: SYM *typeto;
        !           254: OP op;
        !           255: {
        !           256: #define tree    (*tp)
        !           257: 
        !           258:     SYM *s;
        !           259: 
        !           260:     s = rtype(tree->nodetype);
        !           261:     typeto = rtype(typeto);
        !           262:     if (typeto == t_real && compatible(s, t_int)) {
        !           263:        tree = build(op, tree);
        !           264:     } else if (!compatible(s, typeto)) {
        !           265:        trerror("%t is improper type");
        !           266:     } else if (op != O_NOP && s != typeto) {
        !           267:        tree = build(op, tree);
        !           268:     }
        !           269: 
        !           270: #undef tree
        !           271: }
        !           272: 
        !           273: /*
        !           274:  * Construct a node for the Pascal dot operator.
        !           275:  *
        !           276:  * If the left operand is not a record, but rather a procedure
        !           277:  * or function, then we interpret the "." as referencing an
        !           278:  * "invisible" variable; i.e. a variable within a dynamically
        !           279:  * active block but not within the static scope of the current procedure.
        !           280:  */
        !           281: 
        !           282: NODE *dot(record, field)
        !           283: NODE *record;
        !           284: SYM *field;
        !           285: {
        !           286:     register NODE *p;
        !           287:     register SYM *s;
        !           288: 
        !           289:     if (isblock(record->nodetype)) {
        !           290:        s = findsym(field, record->nodetype);
        !           291:        if (s == NIL) {
        !           292:            error("\"%s\" is not defined in \"%s\"",
        !           293:                field->symbol, record->nodetype->symbol);
        !           294:        }
        !           295:        p = alloc(1, NODE);
        !           296:        p->op = O_NAME;
        !           297:        p->nodetype = namenode(p, s);
        !           298:     } else {
        !           299:        s = findclass(field, FIELD);
        !           300:        if (s == NIL) {
        !           301:            error("\"%s\" is not a field", field->symbol);
        !           302:        }
        !           303:        field = s;
        !           304:        chkfield(record, field);
        !           305:        p = alloc(1, NODE);
        !           306:        p->op = O_ADD;
        !           307:        p->nodetype = field->type;
        !           308:        p->left = record;
        !           309:        p->right = build(O_LCON, (long) field->symvalue.offset);
        !           310:     }
        !           311:     return p;
        !           312: }
        !           313: 
        !           314: /*
        !           315:  * Return a tree corresponding to an array reference and do the
        !           316:  * error checking.
        !           317:  */
        !           318: 
        !           319: NODE *subscript(a, slist)
        !           320: NODE *a, *slist;
        !           321: {
        !           322:     register SYM *t;
        !           323:     register NODE *p;
        !           324:     SYM *etype, *atype, *eltype;
        !           325:     NODE *esub;
        !           326: 
        !           327:     t = rtype(a->nodetype);
        !           328:     if (t->class != ARRAY) {
        !           329:        trerror("%t is not an array", a);
        !           330:     }
        !           331:     eltype = t->type;
        !           332:     p = slist;
        !           333:     t = t->chain;
        !           334:     for (; p != NIL && t != NIL; p = p->right, t = t->chain) {
        !           335:        esub = p->left;
        !           336:        etype = rtype(esub->nodetype);
        !           337:        atype = rtype(t);
        !           338:        if (!compatible(atype, etype)) {
        !           339:            trerror("subscript %t is the wrong type", esub);
        !           340:        }
        !           341:        esub->nodetype = atype;
        !           342:     }
        !           343:     if (p != NIL) {
        !           344:        trerror("too many subscripts for %t", a);
        !           345:     } else if (t != NIL) {
        !           346:        trerror("not enough subscripts for %t", a);
        !           347:     }
        !           348:     p = alloc(1, NODE);
        !           349:     p->op = O_INDEX;
        !           350:     p->left = a;
        !           351:     p->right = slist;
        !           352:     p->nodetype = eltype;
        !           353:     return p;
        !           354: }
        !           355: 
        !           356: /*
        !           357:  * Evaluate a subscript (possibly more than one index).
        !           358:  */
        !           359: 
        !           360: long evalindex(arraytype, subs)
        !           361: SYM *arraytype;
        !           362: NODE *subs;
        !           363: {
        !           364:     long lb, ub, index, i;
        !           365:     SYM *t, *indextype;
        !           366:     NODE *p;
        !           367: 
        !           368:     t = rtype(arraytype);
        !           369:     if (t->class != ARRAY) {
        !           370:        panic("unexpected class %d in evalindex", t->class);
        !           371:     }
        !           372:     i = 0;
        !           373:     t = t->chain;
        !           374:     p = subs;
        !           375:     while (t != NIL) {
        !           376:        if (p == NIL) {
        !           377:            panic("unexpected end of subscript list in evalindex");
        !           378:        }
        !           379:        indextype = rtype(t);
        !           380:        lb = indextype->symvalue.rangev.lower;
        !           381:        ub = indextype->symvalue.rangev.upper;
        !           382:        eval(p->left);
        !           383:        index = popsmall(p->left->nodetype);
        !           384:        if (index < lb || index > ub) {
        !           385:            error("subscript value %d out of range %d..%d", index, lb, ub);
        !           386:        }
        !           387:        i = (ub-lb+1)*i + (index-lb);
        !           388:        t = t->chain;
        !           389:        p = p->right;
        !           390:     }
        !           391:     return i;
        !           392: }
        !           393: 
        !           394: /*
        !           395:  * Check that a record.field usage is proper.
        !           396:  */
        !           397: 
        !           398: LOCAL chkfield(r, f)
        !           399: NODE *r;
        !           400: SYM *f;
        !           401: {
        !           402:     register SYM *s;
        !           403: 
        !           404:     chkclass(r, RECORD);
        !           405: 
        !           406:     /*
        !           407:      * Don't do this for compiled code.
        !           408:      */
        !           409:     for (s = r->nodetype->chain; s != NIL; s = s->chain) {
        !           410:        if (s == f) {
        !           411:            break;
        !           412:        }
        !           413:     }
        !           414:     if (s == NIL) {
        !           415:        error("\"%s\" is not a field in specified record", f->symbol);
        !           416:     }
        !           417: }
        !           418: 
        !           419: /*
        !           420:  * Check to see if a tree is boolean-valued, if not it's an error.
        !           421:  */
        !           422: 
        !           423: chkboolean(p)
        !           424: register NODE *p;
        !           425: {
        !           426:     if (p->nodetype != t_boolean) {
        !           427:        trerror("found %t, expected boolean expression");
        !           428:     }
        !           429: }
        !           430: 
        !           431: /*
        !           432:  * Check to make sure the given tree has a type of the given class.
        !           433:  */
        !           434: 
        !           435: LOCAL chkclass(p, class)
        !           436: NODE *p;
        !           437: int class;
        !           438: {
        !           439:     SYM tmpsym;
        !           440: 
        !           441:     tmpsym.class = class;
        !           442:     if (p->nodetype->class != class) {
        !           443:        trerror("%t is not a %s", p, classname(&tmpsym));
        !           444:     }
        !           445: }
        !           446: 
        !           447: /*
        !           448:  * Construct a node for the type of a string.  While we're at it,
        !           449:  * scan the string for '' that collapse to ', and chop off the ends.
        !           450:  */
        !           451: 
        !           452: LOCAL SYM *mkstring(str)
        !           453: char *str;
        !           454: {
        !           455:     register char *p, *q;
        !           456:     SYM *s, *t;
        !           457:     static SYM zerosym;
        !           458: 
        !           459:     p = str;
        !           460:     q = str + 1;
        !           461:     while (*q != '\0') {
        !           462:        if (q[0] != '\'' || q[1] != '\'') {
        !           463:            *p = *q;
        !           464:            p++;
        !           465:        }
        !           466:        q++;
        !           467:     }
        !           468:     *--p = '\0';
        !           469:     if (p == str + 1) {
        !           470:        return t_char;
        !           471:     }
        !           472:     s = alloc(1, SYM);
        !           473:     *s = zerosym;
        !           474:     s->class = ARRAY;
        !           475:     s->type = t_char;
        !           476:     s->chain = alloc(1, SYM);
        !           477:     t = s->chain;
        !           478:     *t = zerosym;
        !           479:     t->class = RANGE;
        !           480:     t->type = t_int;
        !           481:     t->symvalue.rangev.lower = 1;
        !           482:     t->symvalue.rangev.upper = p - str + 1;
        !           483:     return s;
        !           484: }
        !           485: 
        !           486: /*
        !           487:  * Free up the space allocated for a string type.
        !           488:  */
        !           489: 
        !           490: unmkstring(s)
        !           491: SYM *s;
        !           492: {
        !           493:     dispose(s->chain);
        !           494: }

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