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