1775Speter /* Copyright (c) 1979 Regents of the University of California */ 2775Speter 3*10841Speter static char sccsid[] = "@(#)stkrval.c 1.7 02/09/83"; 4775Speter 5775Speter #include "whoami.h" 6775Speter #include "0.h" 7775Speter #include "tree.h" 8775Speter #include "opcode.h" 9775Speter #include "objfmt.h" 10775Speter #ifdef PC 11775Speter # include "pcops.h" 12775Speter #endif PC 13775Speter 14775Speter /* 15775Speter * stkrval Rvalue - an expression, and coerce it to be a stack quantity. 16775Speter * 17775Speter * Contype is the type that the caller would prefer, nand is important 18775Speter * if constant sets or constant strings are involved, the latter 19775Speter * because of string padding. 20775Speter */ 21775Speter /* 22775Speter * for the obj version, this is a copy of rvalue hacked to use fancy new 23775Speter * push-onto-stack-and-convert opcodes. 24775Speter * for the pc version, i just call rvalue and convert if i have to, 25775Speter * based on the return type of rvalue. 26775Speter */ 27775Speter struct nl * 28775Speter stkrval(r, contype , required ) 29775Speter register int *r; 30775Speter struct nl *contype; 31775Speter long required; 32775Speter { 33775Speter register struct nl *p; 34775Speter register struct nl *q; 35775Speter register char *cp, *cp1; 36775Speter register int c, w; 37775Speter int **pt; 38775Speter long l; 39775Speter double f; 40775Speter 41775Speter if (r == NIL) 42775Speter return (NIL); 43775Speter if (nowexp(r)) 44775Speter return (NIL); 45775Speter /* 46775Speter * The root of the tree tells us what sort of expression we have. 47775Speter */ 48775Speter switch (r[0]) { 49775Speter 50775Speter /* 51775Speter * The constant nil 52775Speter */ 53775Speter case T_NIL: 54775Speter # ifdef OBJ 55775Speter put(2, O_CON14, 0); 56775Speter # endif OBJ 57775Speter # ifdef PC 58775Speter putleaf( P2ICON , 0 , 0 , P2INT , 0 ); 59775Speter # endif PC 60775Speter return (nl+TNIL); 61775Speter 62775Speter case T_FCALL: 63775Speter case T_VAR: 64775Speter p = lookup(r[2]); 65775Speter if (p == NIL || p->class == BADUSE) 66775Speter return (NIL); 67775Speter switch (p->class) { 68775Speter case VAR: 69775Speter /* 703080Smckusic * if a variable is 71775Speter * qualified then get 72775Speter * the rvalue by a 73775Speter * stklval and an ind. 74775Speter */ 75775Speter if (r[3] != NIL) 76775Speter goto ind; 77775Speter q = p->type; 78775Speter if (q == NIL) 79775Speter return (NIL); 80775Speter if (classify(q) == TSTR) 81775Speter return(stklval(r, NOFLAGS)); 82775Speter # ifdef OBJ 8310568Smckusick return (stackRV(p)); 84775Speter # endif OBJ 85775Speter # ifdef PC 8610360Smckusick q = rvalue( r , contype , required ); 8710360Smckusick if (isa(q, "sbci")) { 8810360Smckusick sconv(p2type(q),P2INT); 8910360Smckusick } 9010360Smckusick return q; 91775Speter # endif PC 92775Speter 93775Speter case WITHPTR: 94775Speter case REF: 95775Speter /* 96775Speter * A stklval for these 97775Speter * is actually what one 98775Speter * might consider a rvalue. 99775Speter */ 100775Speter ind: 101775Speter q = stklval(r, NOFLAGS); 102775Speter if (q == NIL) 103775Speter return (NIL); 104775Speter if (classify(q) == TSTR) 105775Speter return(q); 106775Speter # ifdef OBJ 107775Speter w = width(q); 108775Speter switch (w) { 109775Speter case 8: 110775Speter put(1, O_IND8); 111775Speter return(q); 112775Speter case 4: 113775Speter put(1, O_IND4); 114775Speter return(q); 115775Speter case 2: 116775Speter put(1, O_IND24); 117775Speter return(q); 118775Speter case 1: 119775Speter put(1, O_IND14); 120775Speter return(q); 121775Speter default: 122775Speter put(2, O_IND, w); 123775Speter return(q); 124775Speter } 125775Speter # endif OBJ 126775Speter # ifdef PC 127775Speter if ( required == RREQ ) { 128775Speter putop( P2UNARY P2MUL , p2type( q ) ); 12910360Smckusick if (isa(q,"sbci")) { 13010360Smckusick sconv(p2type(q),P2INT); 13110360Smckusick } 132775Speter } 133775Speter return q; 134775Speter # endif PC 135775Speter 136775Speter case CONST: 137775Speter if (r[3] != NIL) { 138775Speter error("%s is a constant and cannot be qualified", r[2]); 139775Speter return (NIL); 140775Speter } 141775Speter q = p->type; 142775Speter if (q == NIL) 143775Speter return (NIL); 144775Speter if (q == nl+TSTR) { 145775Speter /* 146775Speter * Find the size of the string 147775Speter * constant if needed. 148775Speter */ 149775Speter cp = p->ptr[0]; 150775Speter cstrng: 151775Speter cp1 = cp; 152775Speter for (c = 0; *cp++; c++) 153775Speter continue; 154*10841Speter w = c; 155775Speter if (contype != NIL && !opt('s')) { 156775Speter if (width(contype) < c && classify(contype) == TSTR) { 157775Speter error("Constant string too long"); 158775Speter return (NIL); 159775Speter } 160*10841Speter w = width(contype); 161775Speter } 162775Speter # ifdef OBJ 163*10841Speter put(2, O_LVCON, lenstr(cp1, w - c)); 164*10841Speter putstr(cp1, w - c); 165775Speter # endif OBJ 166775Speter # ifdef PC 167*10841Speter putCONG( cp1 , w , LREQ ); 168775Speter # endif PC 169775Speter /* 170775Speter * Define the string temporarily 171775Speter * so later people can know its 172775Speter * width. 173775Speter * cleaned out by stat. 174775Speter */ 175*10841Speter q = defnl(0, STR, 0, w); 176775Speter q->type = q; 177775Speter return (q); 178775Speter } 179775Speter if (q == nl+T1CHAR) { 180775Speter # ifdef OBJ 1813080Smckusic put(2, O_CONC4, (int)p->value[0]); 182775Speter # endif OBJ 183775Speter # ifdef PC 18410360Smckusick putleaf(P2ICON, p -> value[0], 0, P2INT, 0); 185775Speter # endif PC 186775Speter return(q); 187775Speter } 188775Speter /* 189775Speter * Every other kind of constant here 190775Speter */ 191775Speter # ifdef OBJ 192775Speter switch (width(q)) { 193775Speter case 8: 194775Speter #ifndef DEBUG 195775Speter put(2, O_CON8, p->real); 196775Speter return(q); 197775Speter #else 198775Speter if (hp21mx) { 199775Speter f = p->real; 200775Speter conv(&f); 201775Speter l = f.plong; 202775Speter put(2, O_CON4, l); 203775Speter } else 204775Speter put(2, O_CON8, p->real); 205775Speter return(q); 206775Speter #endif 207775Speter case 4: 208775Speter put(2, O_CON4, p->range[0]); 209775Speter return(q); 210775Speter case 2: 211775Speter put(2, O_CON24, (short)p->range[0]); 212775Speter return(q); 213775Speter case 1: 2143080Smckusic put(2, O_CON14, p->value[0]); 215775Speter return(q); 216775Speter default: 217775Speter panic("stkrval"); 218775Speter } 219775Speter # endif OBJ 220775Speter # ifdef PC 22110360Smckusick q = rvalue( r , contype , required ); 22210360Smckusick if (isa(q,"sbci")) { 22310360Smckusick sconv(p2type(q),P2INT); 22410360Smckusick } 22510360Smckusick return q; 226775Speter # endif PC 227775Speter 228775Speter case FUNC: 2291201Speter case FFUNC: 230775Speter /* 231775Speter * Function call 232775Speter */ 233775Speter pt = (int **)r[3]; 234775Speter if (pt != NIL) { 235775Speter switch (pt[1][0]) { 236775Speter case T_PTR: 237775Speter case T_ARGL: 238775Speter case T_ARY: 239775Speter case T_FIELD: 240775Speter error("Can't qualify a function result value"); 241775Speter return (NIL); 242775Speter } 243775Speter } 244775Speter # ifdef OBJ 245775Speter q = p->type; 246775Speter if (classify(q) == TSTR) { 247775Speter c = width(q); 248775Speter put(2, O_LVCON, even(c+1)); 249775Speter putstr("", c); 2503080Smckusic put(1, PTR_DUP); 251775Speter p = funccod(r); 252775Speter put(2, O_AS, c); 253775Speter return(p); 254775Speter } 255775Speter p = funccod(r); 256775Speter if (width(p) <= 2) 257775Speter put(1, O_STOI); 258775Speter # endif OBJ 259775Speter # ifdef PC 260775Speter p = pcfunccod( r ); 26110360Smckusick if (isa(p,"sbci")) { 26210360Smckusick sconv(p2type(p),P2INT); 26310360Smckusick } 264775Speter # endif PC 265775Speter return (p); 266775Speter 267775Speter case TYPE: 268775Speter error("Type names (e.g. %s) allowed only in declarations", p->symbol); 269775Speter return (NIL); 270775Speter 271775Speter case PROC: 2721201Speter case FPROC: 273775Speter error("Procedure %s found where expression required", p->symbol); 274775Speter return (NIL); 275775Speter default: 276775Speter panic("stkrvid"); 277775Speter } 278775Speter case T_PLUS: 279775Speter case T_MINUS: 280775Speter case T_NOT: 281775Speter case T_AND: 282775Speter case T_OR: 283775Speter case T_DIVD: 284775Speter case T_MULT: 285775Speter case T_SUB: 286775Speter case T_ADD: 287775Speter case T_MOD: 288775Speter case T_DIV: 289775Speter case T_EQ: 290775Speter case T_NE: 291775Speter case T_GE: 292775Speter case T_LE: 293775Speter case T_GT: 294775Speter case T_LT: 295775Speter case T_IN: 296775Speter p = rvalue(r, contype , required ); 297775Speter # ifdef OBJ 298775Speter if (width(p) <= 2) 299775Speter put(1, O_STOI); 300775Speter # endif OBJ 30110360Smckusick # ifdef PC 30210360Smckusick if (isa(p,"sbci")) { 30310360Smckusick sconv(p2type(p),P2INT); 30410360Smckusick } 30510360Smckusick # endif PC 306775Speter return (p); 307909Speter case T_CSET: 308909Speter p = rvalue(r, contype , required ); 309909Speter return (p); 310775Speter default: 311775Speter if (r[2] == NIL) 312775Speter return (NIL); 313775Speter switch (r[0]) { 314775Speter default: 315775Speter panic("stkrval3"); 316775Speter 317775Speter /* 318775Speter * An octal number 319775Speter */ 320775Speter case T_BINT: 321775Speter f = a8tol(r[2]); 322775Speter goto conint; 323775Speter 324775Speter /* 325775Speter * A decimal number 326775Speter */ 327775Speter case T_INT: 328775Speter f = atof(r[2]); 329775Speter conint: 330775Speter if (f > MAXINT || f < MININT) { 331775Speter error("Constant too large for this implementation"); 332775Speter return (NIL); 333775Speter } 334775Speter l = f; 335775Speter if (bytes(l, l) <= 2) { 336775Speter # ifdef OBJ 337775Speter put(2, O_CON24, (short)l); 338775Speter # endif OBJ 339775Speter # ifdef PC 340775Speter putleaf( P2ICON , (short) l , 0 , P2INT , 0 ); 341775Speter # endif PC 342775Speter return(nl+T4INT); 343775Speter } 344775Speter # ifdef OBJ 345775Speter put(2, O_CON4, l); 346775Speter # endif OBJ 347775Speter # ifdef PC 348775Speter putleaf( P2ICON , l , 0 , P2INT , 0 ); 349775Speter # endif PC 350775Speter return (nl+T4INT); 351775Speter 352775Speter /* 353775Speter * A floating point number 354775Speter */ 355775Speter case T_FINT: 356775Speter # ifdef OBJ 357775Speter put(2, O_CON8, atof(r[2])); 358775Speter # endif OBJ 359775Speter # ifdef PC 360775Speter putCON8( atof( r[2] ) ); 361775Speter # endif PC 362775Speter return (nl+TDOUBLE); 363775Speter 364775Speter /* 365775Speter * Constant strings. Note that constant characters 366775Speter * are constant strings of length one; there is 367775Speter * no constant string of length one. 368775Speter */ 369775Speter case T_STRNG: 370775Speter cp = r[2]; 371775Speter if (cp[1] == 0) { 372775Speter # ifdef OBJ 373775Speter put(2, O_CONC4, cp[0]); 374775Speter # endif OBJ 375775Speter # ifdef PC 37610360Smckusick putleaf( P2ICON , cp[0] , 0 , P2INT , 0 ); 377775Speter # endif PC 378775Speter return(nl+T1CHAR); 379775Speter } 380775Speter goto cstrng; 381775Speter } 382775Speter 383775Speter } 384775Speter } 38510568Smckusick 38610568Smckusick #ifdef OBJ 38710568Smckusick /* 38810568Smckusick * push a value onto the interpreter stack, longword aligned. 38910568Smckusick */ 39010568Smckusick stackRV(p) 39110568Smckusick struct nl *p; 39210568Smckusick { 39310568Smckusick struct nl *q; 39410568Smckusick int w, bn; 39510568Smckusick 39610568Smckusick q = p->type; 39710568Smckusick if (q == NIL) 39810568Smckusick return (NIL); 39910568Smckusick bn = BLOCKNO(p->nl_block); 40010568Smckusick w = width(q); 40110568Smckusick switch (w) { 40210568Smckusick case 8: 40310568Smckusick put(2, O_RV8 | bn << 8+INDX, (int)p->value[0]); 40410568Smckusick break; 40510568Smckusick case 4: 40610568Smckusick put(2, O_RV4 | bn << 8+INDX, (int)p->value[0]); 40710568Smckusick break; 40810568Smckusick case 2: 40910568Smckusick put(2, O_RV24 | bn << 8+INDX, (int)p->value[0]); 41010568Smckusick break; 41110568Smckusick case 1: 41210568Smckusick put(2, O_RV14 | bn << 8+INDX, (int)p->value[0]); 41310568Smckusick break; 41410568Smckusick default: 41510568Smckusick put(3, O_RV | bn << 8+INDX, (int)p->value[0], w); 41610568Smckusick break; 41710568Smckusick } 41810568Smckusick return (q); 41910568Smckusick } 42010568Smckusick #endif OBJ 421