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