# 2.11BSD#431 - /usr/src/ucb/pascal/pi/rval.c

##### Functions

    nocomp            X
    rvalue            X

##### Variables

    inemptyline       X

       1: /*	@(#)rval.c	2.4	SCCS id keyword	*/
       2: /* Copyright (c) 1979 Regents of the University of California */
       3: #
       4: /*
       5:  * pi - Pascal interpreter code translator
       6:  *
       7:  * Charles Haley, Bill Joy UCB
       8:  * Version 1.2 Novmeber 1978
       9:  */
      10:
      11: #include "whoami"
      12: #include "0.h"
      13: #include "tree.h"
      14: #include "opcode.h"
      15:
      16: extern  char *opnames[];
      17:
      18: short inemptyline = 0;
      19:
      20: /*
      21:  * Rvalue - an expression.
      22:  *
      23:  * Contype is the type that the caller would prefer, nand is important
      24:  * if constant sets or constant strings are involved, the latter
      25:  * because of string padding.
      26:  */
      27: struct nl *
      28: rvalue(r, contype)
      29:     int *r;
      30:     struct nl *contype;
      31: {
      32:     register struct nl *p, *p1;
      33:     register struct nl *q;
      34:     int c, c1, *rt, w, g;
      35:     char *cp, *cp1, *opname;
      36:     long l;
      37:     double f;
      38:
      39:     if (r == NIL)
      40:         return (NIL);
      41:     if (nowexp(r))
      42:         return (NIL);
      43:     /*
      44: 	 * Pick up the name of the operation
      45: 	 * for future error messages.
      46: 	 */
      47:     if (r[0] <= T_IN)
      48:         opname = opnames[r[0]];
      49:
      50:     /*
      51: 	 * The root of the tree tells us what sort of expression we have.
      52: 	 */
      53:     switch (r[0]) {
      54:
      55:     /*
      56: 	 * The constant nil
      57: 	 */
      58:     case T_NIL:
      59:         put2(O_CON2, 0);
      60:         return (nl+TNIL);
      61:
      62:     /*
      63: 	 * Function call with arguments.
      64: 	 */
      65:     case T_FCALL:
      66:         return (funccod(r));
      67:
      68:     case T_VAR:
      69:         p = lookup(r[2]);
      70:         if (p == NIL || p->class == BADUSE)
      71:             return (NIL);
      72:         switch (p->class) {
      73:             case VAR:
      74:                 /*
      75: 				 * If a variable is
      76: 				 * qualified then get
      77: 				 * the rvalue by a
      78: 				 * lvalue and an ind.
      79: 				 */
      80:                 if (r[3] != NIL)
      81:                     goto ind;
      82:                 q = p->type;
      83:                 if (q == NIL)
      84:                     return (NIL);
      85:                 w = width(q);
      86:                 switch (w) {
      87:                     case 8:
      88:                         w = 6;
      89:                     case 4:
      90:                     case 2:
      91:                     case 1:
      92:                         put2(O_RV1 + (w >> 1) | bn << 9, p->value[0]);
      93:                         break;
      94:                     default:
      95:                         put3(O_RV | bn << 9, p->value[0], w);
      96:                 }
      97:                 return (q);
      98:
      99:             case WITHPTR:
     100:             case REF:
     101:                 /*
     102: 				 * A lvalue for these
     103: 				 * is actually what one
     104: 				 * might consider a rvalue.
     105: 				 */
     106: ind:
     107:                 q = lvalue(r, NOMOD);
     108:                 if (q == NIL)
     109:                     return (NIL);
     110:                 w = width(q);
     111:                 switch (w) {
     112:                     case 8:
     113:                         w = 6;
     114:                     case 4:
     115:                     case 2:
     116:                     case 1:
     117:                         put1(O_IND1 + (w >> 1));
     118:                         break;
     119:                     default:
     120:                         put2(O_IND, w);
     121:                 }
     122:                 return (q);
     123:
     124:             case CONST:
     125:                 if (r[3] != NIL) {
     126:                     error("%s is a constant and cannot be qualified", r[2]);
     127:                     return (NIL);
     128:                 }
     129:                 q = p->type;
     130:                 if (q == NIL)
     131:                     return (NIL);
     132:                 if (q == nl+TSTR) {
     133:                     /*
     134: 					 * Find the size of the string
     135: 					 * constant if needed.
     136: 					 */
     137:                     cp = p->ptr[0];
     138: cstrng:
     139:                     cp1 = cp;
     140:                     for (c = 0; *cp++; c++)
     141:                         continue;
     142:                     if (contype != NIL && !opt('s')) {
     143:                         if (width(contype) < c && classify(contype) == TSTR) {
     144:                             error("Constant string too long");
     145:                             return (NIL);
     146:                         }
     147:                         c = width(contype);
     148:                     }
     149:                     put( 2 + (sizeof ( char * )/sizeof ( short )) , O_CONG, c, cp1);
     150:                     /*
     151: 					 * Define the string temporarily
     152: 					 * so later people can know its
     153: 					 * width.
     154: 					 * cleaned out by stat.
     155: 					 */
     156:                     q = defnl(0, STR, 0, c);
     157:                     q->type = q;
     158:                     return (q);
     159:                 }
     160:                 if (q == nl+T1CHAR) {
     161:                     put2(O_CONC, p->value[0]);
     162:                     return (q);
     163:                 }
     164:                 /*
     165: 				 * Every other kind of constant here
     166: 				 */
     167:                 switch (width(q)) {
     168:                 case 8:
     169: #ifndef DEBUG
     170:                     put(5, O_CON8, p->real);
     171: #else
     172:                     if (hp21mx) {
     173:                         f = p->real;
     174:                         conv(&f);
     175:                         l = f.plong;
     176:                         put( 3 , O_CON4, l);
     177:                     } else
     178:                         put(5, O_CON8, p->real);
     179: #endif
     180:                     break;
     181:                 case 4:
     182:                     put( 3 , O_CON4, p->range[0]);
     183:                     break;
     184:                 case 2:
     185:                     put2(O_CON2, ( short ) p->range[0]);
     186:                     break;
     187:                 case 1:
     188:                     put2(O_CON1, p->value[0]);
     189:                     break;
     190:                 default:
     191:                     panic("rval");
     192:                 }
     193:                 return (q);
     194:
     195:             case FUNC:
     196:                 /*
     197: 				 * Function call with no arguments.
     198: 				 */
     199:                 if (r[3]) {
     200:                     error("Can't qualify a function result value");
     201:                     return (NIL);
     202:                 }
     203:                 return (funccod((int *) r));
     204:
     205:             case TYPE:
     206:                 error("Type names (e.g. %s) allowed only in declarations", p->symbol);
     207:                 return (NIL);
     208:
     209:             case PROC:
     210:                 error("Procedure %s found where expression required", p->symbol);
     211:                 return (NIL);
     212:             default:
     213:                 panic("rvid");
     214:         }
     215:     /*
     216: 	 * Constant sets
     217: 	 */
     218:     case T_CSET:
     219:         return (cset(r, contype, NIL));
     220:
     221:     /*
     222: 	 * Unary plus and minus
     223: 	 */
     224:     case T_PLUS:
     225:     case T_MINUS:
     226:         q = rvalue(r[2], NIL);
     227:         if (q == NIL)
     228:             return (NIL);
     229:         if (isnta(q, "id")) {
     230:             error("Operand of %s must be integer or real, not %s", opname, nameof(q));
     231:             return (NIL);
     232:         }
     233:         if (r[0] == T_MINUS) {
     234:             put1(O_NEG2 + (width(q) >> 2));
     235:             return (isa(q, "d") ? q : nl+T4INT);
     236:         }
     237:         return (q);
     238:
     239:     case T_NOT:
     240:         q = rvalue(r[2], NIL);
     241:         if (q == NIL)
     242:             return (NIL);
     243:         if (isnta(q, "b")) {
     244:             error("not must operate on a Boolean, not %s", nameof(q));
     245:             return (NIL);
     246:         }
     247:         put1(O_NOT);
     248:         return (nl+T1BOOL);
     249:
     250:     case T_AND:
     251:     case T_OR:
     252:         p = rvalue(r[2], NIL);
     253:         p1 = rvalue(r[3], NIL);
     254:         if (p == NIL || p1 == NIL)
     255:             return (NIL);
     256:         if (isnta(p, "b")) {
     257:             error("Left operand of %s must be Boolean, not %s", opname, nameof(p));
     258:             return (NIL);
     259:         }
     260:         if (isnta(p1, "b")) {
     261:             error("Right operand of %s must be Boolean, not %s", opname, nameof(p1));
     262:             return (NIL);
     263:         }
     264:         put1(r[0] == T_AND ? O_AND : O_OR);
     265:         return (nl+T1BOOL);
     266:
     267:     case T_DIVD:
     268:         p = rvalue(r[2], NIL);
     269:         p1 = rvalue(r[3], NIL);
     270:         if (p == NIL || p1 == NIL)
     271:             return (NIL);
     272:         if (isnta(p, "id")) {
     273:             error("Left operand of / must be integer or real, not %s", nameof(p));
     274:             return (NIL);
     275:         }
     276:         if (isnta(p1, "id")) {
     277:             error("Right operand of / must be integer or real, not %s", nameof(p1));
     278:             return (NIL);
     279:         }
     280:         return (gen(NIL, r[0], width(p), width(p1)));
     281:
     282:     case T_MULT:
     283:     case T_SUB:
     284:     case T_ADD:
     285:         /*
     286: 		 * If the context hasn't told us
     287: 		 * the type and a constant set is
     288: 		 * present on the left we need to infer
     289: 		 * the type from the right if possible
     290: 		 * before generating left side code.
     291: 		 */
     292:         if (contype == NIL && (rt = r[2]) != NIL && rt[1] == SAWCON) {
     293:             codeoff();
     294:             contype = rvalue(r[3], NIL);
     295:             codeon();
     296:             if (contype == NIL)
     297:                 return (NIL);
     298:         }
     299:         p = rvalue(r[2], contype);
     300:         p1 = rvalue(r[3], p);
     301:         if (p == NIL || p1 == NIL)
     302:             return (NIL);
     303:         if (isa(p, "id") && isa(p1, "id"))
     304:             return (gen(NIL, r[0], width(p), width(p1)));
     305:         if (isa(p, "t") && isa(p1, "t")) {
     306:             if (p != p1) {
     307:                 error("Set types of operands of %s must be identical", opname);
     308:                 return (NIL);
     309:             }
     310:             gen(TSET, r[0], width(p), 0);
     311:             /*
     312: 			 * Note that set was filled in by the call
     313: 			 * to width above.
     314: 			 */
     315:             if (r[0] == T_SUB)
     316:                 put2(NIL, 0177777 << ((set.uprbp & 017) + 1));
     317:             return (p);
     318:         }
     319:         if (isnta(p, "idt")) {
     320:             error("Left operand of %s must be integer, real or set, not %s", opname, nameof(p));
     321:             return (NIL);
     322:         }
     323:         if (isnta(p1, "idt")) {
     324:             error("Right operand of %s must be integer, real or set, not %s", opname, nameof(p1));
     325:             return (NIL);
     326:         }
     327:         error("Cannot mix sets with integers and reals as operands of %s", opname);
     328:         return (NIL);
     329:
     330:     case T_MOD:
     331:     case T_DIV:
     332:         p = rvalue(r[2], NIL);
     333:         p1 = rvalue(r[3], NIL);
     334:         if (p == NIL || p1 == NIL)
     335:             return (NIL);
     336:         if (isnta(p, "i")) {
     337:             error("Left operand of %s must be integer, not %s", opname, nameof(p));
     338:             return (NIL);
     339:         }
     340:         if (isnta(p1, "i")) {
     341:             error("Right operand of %s must be integer, not %s", opname, nameof(p1));
     342:             return (NIL);
     343:         }
     344:         return (gen(NIL, r[0], width(p), width(p1)));
     345:
     346:     case T_EQ:
     347:     case T_NE:
     348:     case T_GE:
     349:     case T_LE:
     350:     case T_GT:
     351:     case T_LT:
     352:         /*
     353: 		 * Since there can be no, a priori, knowledge
     354: 		 * of the context type should a constant string
     355: 		 * or set arise, we must poke around to find such
     356: 		 * a type if possible.  Since constant strings can
     357: 		 * always masquerade as identifiers, this is always
     358: 		 * necessary.
     359: 		 */
     360:         codeoff();
     361:         p1 = rvalue(r[3], NIL);
     362:         codeon();
     363:         if (p1 == NIL)
     364:             return (NIL);
     365:         contype = p1;
     366:         if (p1 == nl+TSET || p1->class == STR) {
     367:             /*
     368: 			 * For constant strings we want
     369: 			 * the longest type so as to be
     370: 			 * able to do padding (more importantly
     371: 			 * avoiding truncation). For clarity,
     372: 			 * we get this length here.
     373: 			 */
     374:             codeoff();
     375:             p = rvalue(r[2], NIL);
     376:             codeon();
     377:             if (p == NIL)
     378:                 return (NIL);
     379:             if (p1 == nl+TSET || width(p) > width(p1))
     380:                 contype = p;
     381:         }
     382:         /*
     383: 		 * Now we generate code for
     384: 		 * the operands of the relational
     385: 		 * operation.
     386: 		 */
     387:         p = rvalue(r[2], contype);
     388:         if (p == NIL)
     389:             return (NIL);
     390:         p1 = rvalue(r[3], p);
     391:         if (p1 == NIL)
     392:             return (NIL);
     393:         c = classify(p);
     394:         c1 = classify(p1);
     395:         if (nocomp(c) || nocomp(c1))
     396:             return (NIL);
     397:         g = NIL;
     398:         switch (c) {
     399:             case TBOOL:
     400:             case TCHAR:
     401:                 if (c != c1)
     402:                     goto clash;
     403:                 break;
     404:             case TINT:
     405:             case TDOUBLE:
     406:                 if (c1 != TINT && c1 != TDOUBLE)
     407:                     goto clash;
     408:                 break;
     409:             case TSCAL:
     410:                 if (c1 != TSCAL)
     411:                     goto clash;
     412:                 if (scalar(p) != scalar(p1))
     413:                     goto nonident;
     414:                 break;
     415:             case TSET:
     416:                 if (c1 != TSET)
     417:                     goto clash;
     418:                 if (p != p1)
     419:                     goto nonident;
     420:                 g = TSET;
     421:                 break;
     422:             case TPTR:
     423:             case TNIL:
     424:                 if (c1 != TPTR && c1 != TNIL)
     425:                     goto clash;
     426:                 if (r[0] != T_EQ && r[0] != T_NE) {
     427:                     error("%s not allowed on pointers - only allow = and <>" , opname );
     428:                     return (NIL);
     429:                 }
     430:                 break;
     431:             case TSTR:
     432:                 if (c1 != TSTR)
     433:                     goto clash;
     434:                 if (width(p) != width(p1)) {
     435:                     error("Strings not same length in %s comparison", opname);
     436:                     return (NIL);
     437:                 }
     438:                 g = TSTR;
     439:                 break;
     440:             default:
     441:                 panic("rval2");
     442:         }
     443:         return (gen(g, r[0], width(p), width(p1)));
     444: clash:
     445:         error("%ss and %ss cannot be compared - operator was %s", clnames[c], clnames[c1], opname);
     446:         return (NIL);
     447: nonident:
     448:         error("%s types must be identical in comparisons - operator was %s", clnames[c1], opname);
     449:         return (NIL);
     450:
     451:     case T_IN:
     452:         rt = r[3];
     453:         if (rt != NIL && rt[0] == T_CSET)
     454:             p1 = cset(rt, NLNIL, 1);
     455:         else {
     456:             p1 = rvalue(r[3], NIL);
     457:             rt = NIL;
     458:         }
     459:         if (p1 == nl+TSET) {
     460:             if ( line != inemptyline ) {
     461:                 inemptyline = line;
     462:                 warning();
     463:                 error("... in [] makes little sense, since it is always false!");
     464:             }
     465:             put2(O_CON1, 0);
     466:             return (nl+T1BOOL);
     467:         }
     468:         p = rvalue(r[2], NIL);
     469:         if (p == NIL || p1 == NIL)
     470:             return (NIL);
     471:         if (p1->class != SET) {
     472:             error("Right operand of 'in' must be a set, not %s", nameof(p1));
     473:             return (NIL);
     474:         }
     475:         if (incompat(p, p1->type, r[2])) {
     476:             cerror("Index type clashed with set component type for 'in'");
     477:             return (NIL);
     478:         }
     479:         convert(p, nl+T2INT);
     480:         setran(p1->type);
     481:         if (rt == NIL)
     482:             put4(O_IN, width(p1), set.lwrb, set.uprbp);
     483:         else
     484:             put1(O_INCT);
     485:         return (nl+T1BOOL);
     486:
     487:     default:
     488:         if (r[2] == NIL)
     489:             return (NIL);
     490:         switch (r[0]) {
     491:         default:
     492:             panic("rval3");
     493:
     494:
     495:         /*
     496: 		 * An octal number
     497: 		 */
     498:         case T_BINT:
     499:             f = a8tol(r[2]);
     500:             goto conint;
     501:
     502:         /*
     503: 		 * A decimal number
     504: 		 */
     505:         case T_INT:
     506:             f = atof(r[2]);
     507: conint:
     508:             if (f > MAXINT || f < MININT) {
     509:                 error("Constant too large for this implementation");
     510:                 return (NIL);
     511:             }
     512:             l = f;
     513:             if (bytes(l, l) <= 2) {
     514:                 put2(O_CON2, ( short ) l);
     515:                 return (nl+T2INT);
     516:             }
     517:             put( 3 , O_CON4, l);
     518:             return (nl+T4INT);
     519:
     520:         /*
     521: 		 * A floating point number
     522: 		 */
     523:         case T_FINT:
     524:             put(5, O_CON8, atof(r[2]));
     525:             return (nl+TDOUBLE);
     526:
     527:         /*
     528: 		 * Constant strings.  Note that constant characters
     529: 		 * are constant strings of length one; there is
     530: 		 * no constant string of length one.
     531: 		 */
     532:         case T_STRNG:
     533:             cp = r[2];
     534:             if (cp[1] == 0) {
     535:                 put2(O_CONC, cp[0]);
     536:                 return (nl+T1CHAR);
     537:             }
     538:             goto cstrng;
     539:         }
     540:
     541:     }
     542: }
     543:
     544: /*
     545:  * Can a class appear
     546:  * in a comparison ?
     547:  */
     548: nocomp(c)
     549:     int c;
     550: {
     551:
     552:     switch (c) {
     553:         case TFILE:
     554:         case TARY:
     555:         case TREC:
     556:             error("%ss may not participate in comparisons", clnames[c]);
     557:             return (1);
     558:     }
     559:     return (NIL);
     560: }

#### Defined functions

nocomp defined in line 548; used 2 times

- in line 395(2)

rvalue defined in line 27; used 61 times

- in line 226, 240, 252-253(2), 268-269(2), 294-300(3), 332-333(2), 361, 375, 387-390(2), 456, 468
- in /usr/src/ucb/pascal/pi/0.h line 636
- in /usr/src/ucb/pascal/pi/call.c line 70, 102
- in /usr/src/ucb/pascal/pi/case.c line 52
- in /usr/src/ucb/pascal/pi/conv.c line 86
- in /usr/src/ucb/pascal/pi/cset.c line 50, 110-112(2), 119, 127
- in /usr/src/ucb/pascal/pi/func.c line 114
- in /usr/src/ucb/pascal/pi/lval.c line 256
- in /usr/src/ucb/pascal/pi/proc.c line 132, 170, 184, 241, 251, 277-282(2), 303, 382, 396, 444, 495, 530, 628, 652, 669, 692, 707, 738
- in /usr/src/ucb/pascal/pi/stat.c line 236, 268-272(2), 319, 327, 350, 362, 388-393(2), 425, 480, 518, 545

#### Defined variables

inemptyline defined in line 18; used 2 times

- in line 460-461(2)

Last modified: 1983-03-17 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1328 |