![[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] / 42BSD / ucb / pascal / src|
Return to stkrval.c CVS log | Up to [CSRG BSD Unix] / 42BSD / ucb / pascal / src |
1.1 ! root 1: /* Copyright (c) 1979 Regents of the University of California */ ! 2: ! 3: static char sccsid[] = "@(#)stkrval.c 1.7 2/9/83"; ! 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: return (stackRV(p)); ! 84: # endif OBJ ! 85: # ifdef PC ! 86: q = rvalue( r , contype , required ); ! 87: if (isa(q, "sbci")) { ! 88: sconv(p2type(q),P2INT); ! 89: } ! 90: return q; ! 91: # endif PC ! 92: ! 93: case WITHPTR: ! 94: case REF: ! 95: /* ! 96: * A stklval for these ! 97: * is actually what one ! 98: * might consider a rvalue. ! 99: */ ! 100: ind: ! 101: q = stklval(r, NOFLAGS); ! 102: if (q == NIL) ! 103: return (NIL); ! 104: if (classify(q) == TSTR) ! 105: return(q); ! 106: # ifdef OBJ ! 107: w = width(q); ! 108: switch (w) { ! 109: case 8: ! 110: put(1, O_IND8); ! 111: return(q); ! 112: case 4: ! 113: put(1, O_IND4); ! 114: return(q); ! 115: case 2: ! 116: put(1, O_IND24); ! 117: return(q); ! 118: case 1: ! 119: put(1, O_IND14); ! 120: return(q); ! 121: default: ! 122: put(2, O_IND, w); ! 123: return(q); ! 124: } ! 125: # endif OBJ ! 126: # ifdef PC ! 127: if ( required == RREQ ) { ! 128: putop( P2UNARY P2MUL , p2type( q ) ); ! 129: if (isa(q,"sbci")) { ! 130: sconv(p2type(q),P2INT); ! 131: } ! 132: } ! 133: return q; ! 134: # endif PC ! 135: ! 136: case CONST: ! 137: if (r[3] != NIL) { ! 138: error("%s is a constant and cannot be qualified", r[2]); ! 139: return (NIL); ! 140: } ! 141: q = p->type; ! 142: if (q == NIL) ! 143: return (NIL); ! 144: if (q == nl+TSTR) { ! 145: /* ! 146: * Find the size of the string ! 147: * constant if needed. ! 148: */ ! 149: cp = p->ptr[0]; ! 150: cstrng: ! 151: cp1 = cp; ! 152: for (c = 0; *cp++; c++) ! 153: continue; ! 154: w = c; ! 155: if (contype != NIL && !opt('s')) { ! 156: if (width(contype) < c && classify(contype) == TSTR) { ! 157: error("Constant string too long"); ! 158: return (NIL); ! 159: } ! 160: w = width(contype); ! 161: } ! 162: # ifdef OBJ ! 163: put(2, O_LVCON, lenstr(cp1, w - c)); ! 164: putstr(cp1, w - c); ! 165: # endif OBJ ! 166: # ifdef PC ! 167: putCONG( cp1 , w , LREQ ); ! 168: # endif PC ! 169: /* ! 170: * Define the string temporarily ! 171: * so later people can know its ! 172: * width. ! 173: * cleaned out by stat. ! 174: */ ! 175: q = defnl(0, STR, 0, w); ! 176: q->type = q; ! 177: return (q); ! 178: } ! 179: if (q == nl+T1CHAR) { ! 180: # ifdef OBJ ! 181: put(2, O_CONC4, (int)p->value[0]); ! 182: # endif OBJ ! 183: # ifdef PC ! 184: putleaf(P2ICON, p -> value[0], 0, P2INT, 0); ! 185: # endif PC ! 186: return(q); ! 187: } ! 188: /* ! 189: * Every other kind of constant here ! 190: */ ! 191: # ifdef OBJ ! 192: switch (width(q)) { ! 193: case 8: ! 194: #ifndef DEBUG ! 195: put(2, O_CON8, p->real); ! 196: return(q); ! 197: #else ! 198: if (hp21mx) { ! 199: f = p->real; ! 200: conv(&f); ! 201: l = f.plong; ! 202: put(2, O_CON4, l); ! 203: } else ! 204: put(2, O_CON8, p->real); ! 205: return(q); ! 206: #endif ! 207: case 4: ! 208: put(2, O_CON4, p->range[0]); ! 209: return(q); ! 210: case 2: ! 211: put(2, O_CON24, (short)p->range[0]); ! 212: return(q); ! 213: case 1: ! 214: put(2, O_CON14, p->value[0]); ! 215: return(q); ! 216: default: ! 217: panic("stkrval"); ! 218: } ! 219: # endif OBJ ! 220: # ifdef PC ! 221: q = rvalue( r , contype , required ); ! 222: if (isa(q,"sbci")) { ! 223: sconv(p2type(q),P2INT); ! 224: } ! 225: return q; ! 226: # endif PC ! 227: ! 228: case FUNC: ! 229: case FFUNC: ! 230: /* ! 231: * Function call ! 232: */ ! 233: pt = (int **)r[3]; ! 234: if (pt != NIL) { ! 235: switch (pt[1][0]) { ! 236: case T_PTR: ! 237: case T_ARGL: ! 238: case T_ARY: ! 239: case T_FIELD: ! 240: error("Can't qualify a function result value"); ! 241: return (NIL); ! 242: } ! 243: } ! 244: # ifdef OBJ ! 245: q = p->type; ! 246: if (classify(q) == TSTR) { ! 247: c = width(q); ! 248: put(2, O_LVCON, even(c+1)); ! 249: putstr("", c); ! 250: put(1, PTR_DUP); ! 251: p = funccod(r); ! 252: put(2, O_AS, c); ! 253: return(p); ! 254: } ! 255: p = funccod(r); ! 256: if (width(p) <= 2) ! 257: put(1, O_STOI); ! 258: # endif OBJ ! 259: # ifdef PC ! 260: p = pcfunccod( r ); ! 261: if (isa(p,"sbci")) { ! 262: sconv(p2type(p),P2INT); ! 263: } ! 264: # endif PC ! 265: return (p); ! 266: ! 267: case TYPE: ! 268: error("Type names (e.g. %s) allowed only in declarations", p->symbol); ! 269: return (NIL); ! 270: ! 271: case PROC: ! 272: case FPROC: ! 273: error("Procedure %s found where expression required", p->symbol); ! 274: return (NIL); ! 275: default: ! 276: panic("stkrvid"); ! 277: } ! 278: case T_PLUS: ! 279: case T_MINUS: ! 280: case T_NOT: ! 281: case T_AND: ! 282: case T_OR: ! 283: case T_DIVD: ! 284: case T_MULT: ! 285: case T_SUB: ! 286: case T_ADD: ! 287: case T_MOD: ! 288: case T_DIV: ! 289: case T_EQ: ! 290: case T_NE: ! 291: case T_GE: ! 292: case T_LE: ! 293: case T_GT: ! 294: case T_LT: ! 295: case T_IN: ! 296: p = rvalue(r, contype , required ); ! 297: # ifdef OBJ ! 298: if (width(p) <= 2) ! 299: put(1, O_STOI); ! 300: # endif OBJ ! 301: # ifdef PC ! 302: if (isa(p,"sbci")) { ! 303: sconv(p2type(p),P2INT); ! 304: } ! 305: # endif PC ! 306: return (p); ! 307: case T_CSET: ! 308: p = rvalue(r, contype , required ); ! 309: return (p); ! 310: default: ! 311: if (r[2] == NIL) ! 312: return (NIL); ! 313: switch (r[0]) { ! 314: default: ! 315: panic("stkrval3"); ! 316: ! 317: /* ! 318: * An octal number ! 319: */ ! 320: case T_BINT: ! 321: f = a8tol(r[2]); ! 322: goto conint; ! 323: ! 324: /* ! 325: * A decimal number ! 326: */ ! 327: case T_INT: ! 328: f = atof(r[2]); ! 329: conint: ! 330: if (f > MAXINT || f < MININT) { ! 331: error("Constant too large for this implementation"); ! 332: return (NIL); ! 333: } ! 334: l = f; ! 335: if (bytes(l, l) <= 2) { ! 336: # ifdef OBJ ! 337: put(2, O_CON24, (short)l); ! 338: # endif OBJ ! 339: # ifdef PC ! 340: putleaf( P2ICON , (short) l , 0 , P2INT , 0 ); ! 341: # endif PC ! 342: return(nl+T4INT); ! 343: } ! 344: # ifdef OBJ ! 345: put(2, O_CON4, l); ! 346: # endif OBJ ! 347: # ifdef PC ! 348: putleaf( P2ICON , l , 0 , P2INT , 0 ); ! 349: # endif PC ! 350: return (nl+T4INT); ! 351: ! 352: /* ! 353: * A floating point number ! 354: */ ! 355: case T_FINT: ! 356: # ifdef OBJ ! 357: put(2, O_CON8, atof(r[2])); ! 358: # endif OBJ ! 359: # ifdef PC ! 360: putCON8( atof( r[2] ) ); ! 361: # endif PC ! 362: return (nl+TDOUBLE); ! 363: ! 364: /* ! 365: * Constant strings. Note that constant characters ! 366: * are constant strings of length one; there is ! 367: * no constant string of length one. ! 368: */ ! 369: case T_STRNG: ! 370: cp = r[2]; ! 371: if (cp[1] == 0) { ! 372: # ifdef OBJ ! 373: put(2, O_CONC4, cp[0]); ! 374: # endif OBJ ! 375: # ifdef PC ! 376: putleaf( P2ICON , cp[0] , 0 , P2INT , 0 ); ! 377: # endif PC ! 378: return(nl+T1CHAR); ! 379: } ! 380: goto cstrng; ! 381: } ! 382: ! 383: } ! 384: } ! 385: ! 386: #ifdef OBJ ! 387: /* ! 388: * push a value onto the interpreter stack, longword aligned. ! 389: */ ! 390: stackRV(p) ! 391: struct nl *p; ! 392: { ! 393: struct nl *q; ! 394: int w, bn; ! 395: ! 396: q = p->type; ! 397: if (q == NIL) ! 398: return (NIL); ! 399: bn = BLOCKNO(p->nl_block); ! 400: w = width(q); ! 401: switch (w) { ! 402: case 8: ! 403: put(2, O_RV8 | bn << 8+INDX, (int)p->value[0]); ! 404: break; ! 405: case 4: ! 406: put(2, O_RV4 | bn << 8+INDX, (int)p->value[0]); ! 407: break; ! 408: case 2: ! 409: put(2, O_RV24 | bn << 8+INDX, (int)p->value[0]); ! 410: break; ! 411: case 1: ! 412: put(2, O_RV14 | bn << 8+INDX, (int)p->value[0]); ! 413: break; ! 414: default: ! 415: put(3, O_RV | bn << 8+INDX, (int)p->value[0], w); ! 416: break; ! 417: } ! 418: return (q); ! 419: } ! 420: #endif OBJ
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.