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 438