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