# 2.11BSD#431 - /usr/src/ucb/PORT/pascal/pdx/sym/tree.c

##### Functions

    chkboolean        X
    chkclass          X
    chkfield          X
    convert           X
    dot               X
    evalindex         X
    mkstring          X
    namenode          X
    subscript         X
    treetype          X
    unmkstring        X

##### Macros

    nextarg           X
    tree              X

##### typedef's

    ARGLIST           X

       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.1 (Berkeley) 6/6/85";
       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, *q;
      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: #   if (!isvax)
     410:     for (s = r->nodetype->chain; s != NIL; s = s->chain) {
     411:         if (s == f) {
     412:         break;
     413:         }
     414:     }
     415:     if (s == NIL) {
     416:         error("\"%s\" is not a field in specified record", f->symbol);
     417:     }
     418: #   endif
     419: }
     420:
     421: /*
     422:  * Check to see if a tree is boolean-valued, if not it's an error.
     423:  */
     424:
     425: chkboolean(p)
     426: register NODE *p;
     427: {
     428:     if (p->nodetype != t_boolean) {
     429:     trerror("found %t, expected boolean expression");
     430:     }
     431: }
     432:
     433: /*
     434:  * Check to make sure the given tree has a type of the given class.
     435:  */
     436:
     437: LOCAL chkclass(p, class)
     438: NODE *p;
     439: int class;
     440: {
     441:     SYM tmpsym;
     442:
     443:     tmpsym.class = class;
     444:     if (p->nodetype->class != class) {
     445:     trerror("%t is not a %s", p, classname(&tmpsym));
     446:     }
     447: }
     448:
     449: /*
     450:  * Construct a node for the type of a string.  While we're at it,
     451:  * scan the string for '' that collapse to ', and chop off the ends.
     452:  */
     453:
     454: LOCAL SYM *mkstring(str)
     455: char *str;
     456: {
     457:     register char *p, *q;
     458:     SYM *s, *t;
     459:     static SYM zerosym;
     460:
     461:     p = str;
     462:     q = str + 1;
     463:     while (*q != '\0') {
     464:     if (q[0] != '\'' || q[1] != '\'') {
     465:         *p = *q;
     466:         p++;
     467:     }
     468:     q++;
     469:     }
     470:     *--p = '\0';
     471:     if (p == str + 1) {
     472:     return t_char;
     473:     }
     474:     s = alloc(1, SYM);
     475:     *s = zerosym;
     476:     s->class = ARRAY;
     477:     s->type = t_char;
     478:     s->chain = alloc(1, SYM);
     479:     t = s->chain;
     480:     *t = zerosym;
     481:     t->class = RANGE;
     482:     t->type = t_int;
     483:     t->symvalue.rangev.lower = 1;
     484:     t->symvalue.rangev.upper = p - str + 1;
     485:     return s;
     486: }
     487:
     488: /*
     489:  * Free up the space allocated for a string type.
     490:  */
     491:
     492: unmkstring(s)
     493: SYM *s;
     494: {
     495:     dispose(s->chain);
     496: }

#### Defined functions

chkboolean defined in line 425; used 2 times

- in line 208-209(2)

chkclass defined in line 437; used 2 times

- in line 80, 404

chkfield defined in line 398; used 1 times

- in line 304

convert defined in line 251; used 6 times

- in line 171-174(2), 192-193(2), 200-201(2)

dot defined in line 282; never used
evalindex defined in line 360; never used
mkstring defined in line 454; used 2 times

- in line 31, 70

namenode defined in line 223; used 3 times

- in line 32, 49, 297

subscript defined in line 319; never used
treetype defined in line 39; never used
unmkstring defined in line 492; never used

#### Defined variables

sccsid defined in line 8; never used

#### Defined typedef's

ARGLIST defined in line 27; used 1 times

- in line 41

#### Defined macros

nextarg defined in line 29; used 14 times

- in line 47, 54, 79, 113-114(2), 131, 156-157(2), 190-191(2), 198-199(2), 206-207(2)

tree defined in line 256; used 6 times

- in line 260-270(6)

Last modified: 1985-06-06 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 825 |