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