1775Speter /* Copyright (c) 1979 Regents of the University of California */ 2775Speter 3*1201Speter static char sccsid[] = "@(#)stkrval.c 1.3 10/03/80"; 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 /* 70775Speter 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 83775Speter w = width(q); 84775Speter switch (w) { 85775Speter case 8: 86775Speter put(2, O_RV8 | bn << 8+INDX, p->value[0]); 87775Speter return(q); 88775Speter case 4: 89775Speter put(2, O_RV4 | bn << 8+INDX, p->value[0]); 90775Speter return(q); 91775Speter case 2: 92775Speter put(2, O_RV24 | bn << 8+INDX, p->value[0]); 93775Speter return(q); 94775Speter case 1: 95775Speter put(2, O_RV14 | bn << 8+INDX, p->value[0]); 96775Speter return(q); 97775Speter default: 98775Speter put(3, O_RV | bn << 8+INDX, p->value[0], w); 99775Speter return(q); 100775Speter } 101775Speter # endif OBJ 102775Speter # ifdef PC 103775Speter return rvalue( r , contype , required ); 104775Speter # endif PC 105775Speter 106775Speter case WITHPTR: 107775Speter case REF: 108775Speter /* 109775Speter * A stklval for these 110775Speter * is actually what one 111775Speter * might consider a rvalue. 112775Speter */ 113775Speter ind: 114775Speter q = stklval(r, NOFLAGS); 115775Speter if (q == NIL) 116775Speter return (NIL); 117775Speter if (classify(q) == TSTR) 118775Speter return(q); 119775Speter # ifdef OBJ 120775Speter w = width(q); 121775Speter switch (w) { 122775Speter case 8: 123775Speter put(1, O_IND8); 124775Speter return(q); 125775Speter case 4: 126775Speter put(1, O_IND4); 127775Speter return(q); 128775Speter case 2: 129775Speter put(1, O_IND24); 130775Speter return(q); 131775Speter case 1: 132775Speter put(1, O_IND14); 133775Speter return(q); 134775Speter default: 135775Speter put(2, O_IND, w); 136775Speter return(q); 137775Speter } 138775Speter # endif OBJ 139775Speter # ifdef PC 140775Speter if ( required == RREQ ) { 141775Speter putop( P2UNARY P2MUL , p2type( q ) ); 142775Speter } 143775Speter return q; 144775Speter # endif PC 145775Speter 146775Speter case CONST: 147775Speter if (r[3] != NIL) { 148775Speter error("%s is a constant and cannot be qualified", r[2]); 149775Speter return (NIL); 150775Speter } 151775Speter q = p->type; 152775Speter if (q == NIL) 153775Speter return (NIL); 154775Speter if (q == nl+TSTR) { 155775Speter /* 156775Speter * Find the size of the string 157775Speter * constant if needed. 158775Speter */ 159775Speter cp = p->ptr[0]; 160775Speter cstrng: 161775Speter cp1 = cp; 162775Speter for (c = 0; *cp++; c++) 163775Speter continue; 164775Speter w = 0; 165775Speter if (contype != NIL && !opt('s')) { 166775Speter if (width(contype) < c && classify(contype) == TSTR) { 167775Speter error("Constant string too long"); 168775Speter return (NIL); 169775Speter } 170775Speter w = width(contype) - c; 171775Speter } 172775Speter # ifdef OBJ 173775Speter put(2, O_LVCON, lenstr(cp1, w)); 174775Speter putstr(cp1, w); 175775Speter # endif OBJ 176775Speter # ifdef PC 177775Speter putCONG( cp1 , c + w , LREQ ); 178775Speter # endif PC 179775Speter /* 180775Speter * Define the string temporarily 181775Speter * so later people can know its 182775Speter * width. 183775Speter * cleaned out by stat. 184775Speter */ 185775Speter q = defnl(0, STR, 0, c); 186775Speter q->type = q; 187775Speter return (q); 188775Speter } 189775Speter if (q == nl+T1CHAR) { 190775Speter # ifdef OBJ 191775Speter put(2, O_CONC4, p->value[0]); 192775Speter # endif OBJ 193775Speter # ifdef PC 194775Speter putleaf( P2ICON , p -> value[0] , 0 , P2CHAR , 0 ); 195775Speter # endif PC 196775Speter return(q); 197775Speter } 198775Speter /* 199775Speter * Every other kind of constant here 200775Speter */ 201775Speter # ifdef OBJ 202775Speter switch (width(q)) { 203775Speter case 8: 204775Speter #ifndef DEBUG 205775Speter put(2, O_CON8, p->real); 206775Speter return(q); 207775Speter #else 208775Speter if (hp21mx) { 209775Speter f = p->real; 210775Speter conv(&f); 211775Speter l = f.plong; 212775Speter put(2, O_CON4, l); 213775Speter } else 214775Speter put(2, O_CON8, p->real); 215775Speter return(q); 216775Speter #endif 217775Speter case 4: 218775Speter put(2, O_CON4, p->range[0]); 219775Speter return(q); 220775Speter case 2: 221775Speter put(2, O_CON24, (short)p->range[0]); 222775Speter return(q); 223775Speter case 1: 224775Speter put(2, O_CON14, (short)p->range[0]); 225775Speter return(q); 226775Speter default: 227775Speter panic("stkrval"); 228775Speter } 229775Speter # endif OBJ 230775Speter # ifdef PC 231775Speter return rvalue( r , contype , required ); 232775Speter # endif PC 233775Speter 234775Speter case FUNC: 235*1201Speter case FFUNC: 236775Speter /* 237775Speter * Function call 238775Speter */ 239775Speter pt = (int **)r[3]; 240775Speter if (pt != NIL) { 241775Speter switch (pt[1][0]) { 242775Speter case T_PTR: 243775Speter case T_ARGL: 244775Speter case T_ARY: 245775Speter case T_FIELD: 246775Speter error("Can't qualify a function result value"); 247775Speter return (NIL); 248775Speter } 249775Speter } 250775Speter # ifdef OBJ 251775Speter q = p->type; 252775Speter if (classify(q) == TSTR) { 253775Speter c = width(q); 254775Speter put(2, O_LVCON, even(c+1)); 255775Speter putstr("", c); 256775Speter put(1, O_SDUP4); 257775Speter p = funccod(r); 258775Speter put(2, O_AS, c); 259775Speter return(p); 260775Speter } 261775Speter p = funccod(r); 262775Speter if (width(p) <= 2) 263775Speter put(1, O_STOI); 264775Speter # endif OBJ 265775Speter # ifdef PC 266775Speter p = pcfunccod( r ); 267775Speter # endif PC 268775Speter return (p); 269775Speter 270775Speter case TYPE: 271775Speter error("Type names (e.g. %s) allowed only in declarations", p->symbol); 272775Speter return (NIL); 273775Speter 274775Speter case PROC: 275*1201Speter case FPROC: 276775Speter error("Procedure %s found where expression required", p->symbol); 277775Speter return (NIL); 278775Speter default: 279775Speter panic("stkrvid"); 280775Speter } 281775Speter case T_PLUS: 282775Speter case T_MINUS: 283775Speter case T_NOT: 284775Speter case T_AND: 285775Speter case T_OR: 286775Speter case T_DIVD: 287775Speter case T_MULT: 288775Speter case T_SUB: 289775Speter case T_ADD: 290775Speter case T_MOD: 291775Speter case T_DIV: 292775Speter case T_EQ: 293775Speter case T_NE: 294775Speter case T_GE: 295775Speter case T_LE: 296775Speter case T_GT: 297775Speter case T_LT: 298775Speter case T_IN: 299775Speter p = rvalue(r, contype , required ); 300775Speter # ifdef OBJ 301775Speter if (width(p) <= 2) 302775Speter put(1, O_STOI); 303775Speter # endif OBJ 304775Speter return (p); 305909Speter case T_CSET: 306909Speter p = rvalue(r, contype , required ); 307909Speter return (p); 308775Speter default: 309775Speter if (r[2] == NIL) 310775Speter return (NIL); 311775Speter switch (r[0]) { 312775Speter default: 313775Speter panic("stkrval3"); 314775Speter 315775Speter /* 316775Speter * An octal number 317775Speter */ 318775Speter case T_BINT: 319775Speter f = a8tol(r[2]); 320775Speter goto conint; 321775Speter 322775Speter /* 323775Speter * A decimal number 324775Speter */ 325775Speter case T_INT: 326775Speter f = atof(r[2]); 327775Speter conint: 328775Speter if (f > MAXINT || f < MININT) { 329775Speter error("Constant too large for this implementation"); 330775Speter return (NIL); 331775Speter } 332775Speter l = f; 333775Speter if (bytes(l, l) <= 2) { 334775Speter # ifdef OBJ 335775Speter put(2, O_CON24, (short)l); 336775Speter # endif OBJ 337775Speter # ifdef PC 338775Speter putleaf( P2ICON , (short) l , 0 , P2INT , 0 ); 339775Speter # endif PC 340775Speter return(nl+T4INT); 341775Speter } 342775Speter # ifdef OBJ 343775Speter put(2, O_CON4, l); 344775Speter # endif OBJ 345775Speter # ifdef PC 346775Speter putleaf( P2ICON , l , 0 , P2INT , 0 ); 347775Speter # endif PC 348775Speter return (nl+T4INT); 349775Speter 350775Speter /* 351775Speter * A floating point number 352775Speter */ 353775Speter case T_FINT: 354775Speter # ifdef OBJ 355775Speter put(2, O_CON8, atof(r[2])); 356775Speter # endif OBJ 357775Speter # ifdef PC 358775Speter putCON8( atof( r[2] ) ); 359775Speter # endif PC 360775Speter return (nl+TDOUBLE); 361775Speter 362775Speter /* 363775Speter * Constant strings. Note that constant characters 364775Speter * are constant strings of length one; there is 365775Speter * no constant string of length one. 366775Speter */ 367775Speter case T_STRNG: 368775Speter cp = r[2]; 369775Speter if (cp[1] == 0) { 370775Speter # ifdef OBJ 371775Speter put(2, O_CONC4, cp[0]); 372775Speter # endif OBJ 373775Speter # ifdef PC 374775Speter putleaf( P2ICON , cp[0] , 0 , P2CHAR , 0 ); 375775Speter # endif PC 376775Speter return(nl+T1CHAR); 377775Speter } 378775Speter goto cstrng; 379775Speter } 380775Speter 381775Speter } 382775Speter } 383