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
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
|
Last modified: 1983-03-17
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 1294 |
|