![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to stkrval.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 40BSD / cmd / pi|
Return to stkrval.c CVS log | Up to [CSRG BSD Unix] / 40BSD / cmd / pi |
1.1 ! root 1: /* Copyright (c) 1979 Regents of the University of California */ ! 2: ! 3: static char sccsid[] = "@(#)stkrval.c 1.3 10/2/80"; ! 4: ! 5: #include "whoami.h" ! 6: #include "0.h" ! 7: #include "tree.h" ! 8: #include "opcode.h" ! 9: #include "objfmt.h" ! 10: #ifdef PC ! 11: # include "pcops.h" ! 12: #endif PC ! 13: ! 14: /* ! 15: * stkrval Rvalue - an expression, and coerce it to be a stack quantity. ! 16: * ! 17: * Contype is the type that the caller would prefer, nand is important ! 18: * if constant sets or constant strings are involved, the latter ! 19: * because of string padding. ! 20: */ ! 21: /* ! 22: * for the obj version, this is a copy of rvalue hacked to use fancy new ! 23: * push-onto-stack-and-convert opcodes. ! 24: * for the pc version, i just call rvalue and convert if i have to, ! 25: * based on the return type of rvalue. ! 26: */ ! 27: struct nl * ! 28: stkrval(r, contype , required ) ! 29: register int *r; ! 30: struct nl *contype; ! 31: long required; ! 32: { ! 33: register struct nl *p; ! 34: register struct nl *q; ! 35: register char *cp, *cp1; ! 36: register int c, w; ! 37: int **pt; ! 38: long l; ! 39: double f; ! 40: ! 41: if (r == NIL) ! 42: return (NIL); ! 43: if (nowexp(r)) ! 44: return (NIL); ! 45: /* ! 46: * The root of the tree tells us what sort of expression we have. ! 47: */ ! 48: switch (r[0]) { ! 49: ! 50: /* ! 51: * The constant nil ! 52: */ ! 53: case T_NIL: ! 54: # ifdef OBJ ! 55: put(2, O_CON14, 0); ! 56: # endif OBJ ! 57: # ifdef PC ! 58: putleaf( P2ICON , 0 , 0 , P2INT , 0 ); ! 59: # endif PC ! 60: return (nl+TNIL); ! 61: ! 62: case T_FCALL: ! 63: case T_VAR: ! 64: p = lookup(r[2]); ! 65: if (p == NIL || p->class == BADUSE) ! 66: return (NIL); ! 67: switch (p->class) { ! 68: case VAR: ! 69: /* ! 70: if a variable is ! 71: * qualified then get ! 72: * the rvalue by a ! 73: * stklval and an ind. ! 74: */ ! 75: if (r[3] != NIL) ! 76: goto ind; ! 77: q = p->type; ! 78: if (q == NIL) ! 79: return (NIL); ! 80: if (classify(q) == TSTR) ! 81: return(stklval(r, NOFLAGS)); ! 82: # ifdef OBJ ! 83: w = width(q); ! 84: switch (w) { ! 85: case 8: ! 86: put(2, O_RV8 | bn << 8+INDX, p->value[0]); ! 87: return(q); ! 88: case 4: ! 89: put(2, O_RV4 | bn << 8+INDX, p->value[0]); ! 90: return(q); ! 91: case 2: ! 92: put(2, O_RV24 | bn << 8+INDX, p->value[0]); ! 93: return(q); ! 94: case 1: ! 95: put(2, O_RV14 | bn << 8+INDX, p->value[0]); ! 96: return(q); ! 97: default: ! 98: put(3, O_RV | bn << 8+INDX, p->value[0], w); ! 99: return(q); ! 100: } ! 101: # endif OBJ ! 102: # ifdef PC ! 103: return rvalue( r , contype , required ); ! 104: # endif PC ! 105: ! 106: case WITHPTR: ! 107: case REF: ! 108: /* ! 109: * A stklval for these ! 110: * is actually what one ! 111: * might consider a rvalue. ! 112: */ ! 113: ind: ! 114: q = stklval(r, NOFLAGS); ! 115: if (q == NIL) ! 116: return (NIL); ! 117: if (classify(q) == TSTR) ! 118: return(q); ! 119: # ifdef OBJ ! 120: w = width(q); ! 121: switch (w) { ! 122: case 8: ! 123: put(1, O_IND8); ! 124: return(q); ! 125: case 4: ! 126: put(1, O_IND4); ! 127: return(q); ! 128: case 2: ! 129: put(1, O_IND24); ! 130: return(q); ! 131: case 1: ! 132: put(1, O_IND14); ! 133: return(q); ! 134: default: ! 135: put(2, O_IND, w); ! 136: return(q); ! 137: } ! 138: # endif OBJ ! 139: # ifdef PC ! 140: if ( required == RREQ ) { ! 141: putop( P2UNARY P2MUL , p2type( q ) ); ! 142: } ! 143: return q; ! 144: # endif PC ! 145: ! 146: case CONST: ! 147: if (r[3] != NIL) { ! 148: error("%s is a constant and cannot be qualified", r[2]); ! 149: return (NIL); ! 150: } ! 151: q = p->type; ! 152: if (q == NIL) ! 153: return (NIL); ! 154: if (q == nl+TSTR) { ! 155: /* ! 156: * Find the size of the string ! 157: * constant if needed. ! 158: */ ! 159: cp = p->ptr[0]; ! 160: cstrng: ! 161: cp1 = cp; ! 162: for (c = 0; *cp++; c++) ! 163: continue; ! 164: w = 0; ! 165: if (contype != NIL && !opt('s')) { ! 166: if (width(contype) < c && classify(contype) == TSTR) { ! 167: error("Constant string too long"); ! 168: return (NIL); ! 169: } ! 170: w = width(contype) - c; ! 171: } ! 172: # ifdef OBJ ! 173: put(2, O_LVCON, lenstr(cp1, w)); ! 174: putstr(cp1, w); ! 175: # endif OBJ ! 176: # ifdef PC ! 177: putCONG( cp1 , c + w , LREQ ); ! 178: # endif PC ! 179: /* ! 180: * Define the string temporarily ! 181: * so later people can know its ! 182: * width. ! 183: * cleaned out by stat. ! 184: */ ! 185: q = defnl(0, STR, 0, c); ! 186: q->type = q; ! 187: return (q); ! 188: } ! 189: if (q == nl+T1CHAR) { ! 190: # ifdef OBJ ! 191: put(2, O_CONC4, p->value[0]); ! 192: # endif OBJ ! 193: # ifdef PC ! 194: putleaf( P2ICON , p -> value[0] , 0 , P2CHAR , 0 ); ! 195: # endif PC ! 196: return(q); ! 197: } ! 198: /* ! 199: * Every other kind of constant here ! 200: */ ! 201: # ifdef OBJ ! 202: switch (width(q)) { ! 203: case 8: ! 204: #ifndef DEBUG ! 205: put(2, O_CON8, p->real); ! 206: return(q); ! 207: #else ! 208: if (hp21mx) { ! 209: f = p->real; ! 210: conv(&f); ! 211: l = f.plong; ! 212: put(2, O_CON4, l); ! 213: } else ! 214: put(2, O_CON8, p->real); ! 215: return(q); ! 216: #endif ! 217: case 4: ! 218: put(2, O_CON4, p->range[0]); ! 219: return(q); ! 220: case 2: ! 221: put(2, O_CON24, (short)p->range[0]); ! 222: return(q); ! 223: case 1: ! 224: put(2, O_CON14, (short)p->range[0]); ! 225: return(q); ! 226: default: ! 227: panic("stkrval"); ! 228: } ! 229: # endif OBJ ! 230: # ifdef PC ! 231: return rvalue( r , contype , required ); ! 232: # endif PC ! 233: ! 234: case FUNC: ! 235: case FFUNC: ! 236: /* ! 237: * Function call ! 238: */ ! 239: pt = (int **)r[3]; ! 240: if (pt != NIL) { ! 241: switch (pt[1][0]) { ! 242: case T_PTR: ! 243: case T_ARGL: ! 244: case T_ARY: ! 245: case T_FIELD: ! 246: error("Can't qualify a function result value"); ! 247: return (NIL); ! 248: } ! 249: } ! 250: # ifdef OBJ ! 251: q = p->type; ! 252: if (classify(q) == TSTR) { ! 253: c = width(q); ! 254: put(2, O_LVCON, even(c+1)); ! 255: putstr("", c); ! 256: put(1, O_SDUP4); ! 257: p = funccod(r); ! 258: put(2, O_AS, c); ! 259: return(p); ! 260: } ! 261: p = funccod(r); ! 262: if (width(p) <= 2) ! 263: put(1, O_STOI); ! 264: # endif OBJ ! 265: # ifdef PC ! 266: p = pcfunccod( r ); ! 267: # endif PC ! 268: return (p); ! 269: ! 270: case TYPE: ! 271: error("Type names (e.g. %s) allowed only in declarations", p->symbol); ! 272: return (NIL); ! 273: ! 274: case PROC: ! 275: case FPROC: ! 276: error("Procedure %s found where expression required", p->symbol); ! 277: return (NIL); ! 278: default: ! 279: panic("stkrvid"); ! 280: } ! 281: case T_PLUS: ! 282: case T_MINUS: ! 283: case T_NOT: ! 284: case T_AND: ! 285: case T_OR: ! 286: case T_DIVD: ! 287: case T_MULT: ! 288: case T_SUB: ! 289: case T_ADD: ! 290: case T_MOD: ! 291: case T_DIV: ! 292: case T_EQ: ! 293: case T_NE: ! 294: case T_GE: ! 295: case T_LE: ! 296: case T_GT: ! 297: case T_LT: ! 298: case T_IN: ! 299: p = rvalue(r, contype , required ); ! 300: # ifdef OBJ ! 301: if (width(p) <= 2) ! 302: put(1, O_STOI); ! 303: # endif OBJ ! 304: return (p); ! 305: case T_CSET: ! 306: p = rvalue(r, contype , required ); ! 307: return (p); ! 308: default: ! 309: if (r[2] == NIL) ! 310: return (NIL); ! 311: switch (r[0]) { ! 312: default: ! 313: panic("stkrval3"); ! 314: ! 315: /* ! 316: * An octal number ! 317: */ ! 318: case T_BINT: ! 319: f = a8tol(r[2]); ! 320: goto conint; ! 321: ! 322: /* ! 323: * A decimal number ! 324: */ ! 325: case T_INT: ! 326: f = atof(r[2]); ! 327: conint: ! 328: if (f > MAXINT || f < MININT) { ! 329: error("Constant too large for this implementation"); ! 330: return (NIL); ! 331: } ! 332: l = f; ! 333: if (bytes(l, l) <= 2) { ! 334: # ifdef OBJ ! 335: put(2, O_CON24, (short)l); ! 336: # endif OBJ ! 337: # ifdef PC ! 338: putleaf( P2ICON , (short) l , 0 , P2INT , 0 ); ! 339: # endif PC ! 340: return(nl+T4INT); ! 341: } ! 342: # ifdef OBJ ! 343: put(2, O_CON4, l); ! 344: # endif OBJ ! 345: # ifdef PC ! 346: putleaf( P2ICON , l , 0 , P2INT , 0 ); ! 347: # endif PC ! 348: return (nl+T4INT); ! 349: ! 350: /* ! 351: * A floating point number ! 352: */ ! 353: case T_FINT: ! 354: # ifdef OBJ ! 355: put(2, O_CON8, atof(r[2])); ! 356: # endif OBJ ! 357: # ifdef PC ! 358: putCON8( atof( r[2] ) ); ! 359: # endif PC ! 360: return (nl+TDOUBLE); ! 361: ! 362: /* ! 363: * Constant strings. Note that constant characters ! 364: * are constant strings of length one; there is ! 365: * no constant string of length one. ! 366: */ ! 367: case T_STRNG: ! 368: cp = r[2]; ! 369: if (cp[1] == 0) { ! 370: # ifdef OBJ ! 371: put(2, O_CONC4, cp[0]); ! 372: # endif OBJ ! 373: # ifdef PC ! 374: putleaf( P2ICON , cp[0] , 0 , P2CHAR , 0 ); ! 375: # endif PC ! 376: return(nl+T1CHAR); ! 377: } ! 378: goto cstrng; ! 379: } ! 380: ! 381: } ! 382: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.