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