1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)stkrval.c 1.5 01/17/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 w = width(q); 84 switch (w) { 85 case 8: 86 put(2, O_RV8 | bn << 8+INDX, 87 (int)p->value[0]); 88 return(q); 89 case 4: 90 put(2, O_RV4 | bn << 8+INDX, 91 (int)p->value[0]); 92 return(q); 93 case 2: 94 put(2, O_RV24 | bn << 8+INDX, 95 (int)p->value[0]); 96 return(q); 97 case 1: 98 put(2, O_RV14 | bn << 8+INDX, 99 (int)p->value[0]); 100 return(q); 101 default: 102 put(3, O_RV | bn << 8+INDX, 103 (int)p->value[0], w); 104 return(q); 105 } 106 # endif OBJ 107 # ifdef PC 108 q = rvalue( r , contype , required ); 109 if (isa(q, "sbci")) { 110 sconv(p2type(q),P2INT); 111 } 112 return q; 113 # endif PC 114 115 case WITHPTR: 116 case REF: 117 /* 118 * A stklval for these 119 * is actually what one 120 * might consider a rvalue. 121 */ 122 ind: 123 q = stklval(r, NOFLAGS); 124 if (q == NIL) 125 return (NIL); 126 if (classify(q) == TSTR) 127 return(q); 128 # ifdef OBJ 129 w = width(q); 130 switch (w) { 131 case 8: 132 put(1, O_IND8); 133 return(q); 134 case 4: 135 put(1, O_IND4); 136 return(q); 137 case 2: 138 put(1, O_IND24); 139 return(q); 140 case 1: 141 put(1, O_IND14); 142 return(q); 143 default: 144 put(2, O_IND, w); 145 return(q); 146 } 147 # endif OBJ 148 # ifdef PC 149 if ( required == RREQ ) { 150 putop( P2UNARY P2MUL , p2type( q ) ); 151 if (isa(q,"sbci")) { 152 sconv(p2type(q),P2INT); 153 } 154 } 155 return q; 156 # endif PC 157 158 case CONST: 159 if (r[3] != NIL) { 160 error("%s is a constant and cannot be qualified", r[2]); 161 return (NIL); 162 } 163 q = p->type; 164 if (q == NIL) 165 return (NIL); 166 if (q == nl+TSTR) { 167 /* 168 * Find the size of the string 169 * constant if needed. 170 */ 171 cp = p->ptr[0]; 172 cstrng: 173 cp1 = cp; 174 for (c = 0; *cp++; c++) 175 continue; 176 w = 0; 177 if (contype != NIL && !opt('s')) { 178 if (width(contype) < c && classify(contype) == TSTR) { 179 error("Constant string too long"); 180 return (NIL); 181 } 182 w = width(contype) - c; 183 } 184 # ifdef OBJ 185 put(2, O_LVCON, lenstr(cp1, w)); 186 putstr(cp1, w); 187 # endif OBJ 188 # ifdef PC 189 putCONG( cp1 , c + w , LREQ ); 190 # endif PC 191 /* 192 * Define the string temporarily 193 * so later people can know its 194 * width. 195 * cleaned out by stat. 196 */ 197 q = defnl(0, STR, 0, c); 198 q->type = q; 199 return (q); 200 } 201 if (q == nl+T1CHAR) { 202 # ifdef OBJ 203 put(2, O_CONC4, (int)p->value[0]); 204 # endif OBJ 205 # ifdef PC 206 putleaf(P2ICON, p -> value[0], 0, P2INT, 0); 207 # endif PC 208 return(q); 209 } 210 /* 211 * Every other kind of constant here 212 */ 213 # ifdef OBJ 214 switch (width(q)) { 215 case 8: 216 #ifndef DEBUG 217 put(2, O_CON8, p->real); 218 return(q); 219 #else 220 if (hp21mx) { 221 f = p->real; 222 conv(&f); 223 l = f.plong; 224 put(2, O_CON4, l); 225 } else 226 put(2, O_CON8, p->real); 227 return(q); 228 #endif 229 case 4: 230 put(2, O_CON4, p->range[0]); 231 return(q); 232 case 2: 233 put(2, O_CON24, (short)p->range[0]); 234 return(q); 235 case 1: 236 put(2, O_CON14, p->value[0]); 237 return(q); 238 default: 239 panic("stkrval"); 240 } 241 # endif OBJ 242 # ifdef PC 243 q = rvalue( r , contype , required ); 244 if (isa(q,"sbci")) { 245 sconv(p2type(q),P2INT); 246 } 247 return q; 248 # endif PC 249 250 case FUNC: 251 case FFUNC: 252 /* 253 * Function call 254 */ 255 pt = (int **)r[3]; 256 if (pt != NIL) { 257 switch (pt[1][0]) { 258 case T_PTR: 259 case T_ARGL: 260 case T_ARY: 261 case T_FIELD: 262 error("Can't qualify a function result value"); 263 return (NIL); 264 } 265 } 266 # ifdef OBJ 267 q = p->type; 268 if (classify(q) == TSTR) { 269 c = width(q); 270 put(2, O_LVCON, even(c+1)); 271 putstr("", c); 272 put(1, PTR_DUP); 273 p = funccod(r); 274 put(2, O_AS, c); 275 return(p); 276 } 277 p = funccod(r); 278 if (width(p) <= 2) 279 put(1, O_STOI); 280 # endif OBJ 281 # ifdef PC 282 p = pcfunccod( r ); 283 if (isa(p,"sbci")) { 284 sconv(p2type(p),P2INT); 285 } 286 # endif PC 287 return (p); 288 289 case TYPE: 290 error("Type names (e.g. %s) allowed only in declarations", p->symbol); 291 return (NIL); 292 293 case PROC: 294 case FPROC: 295 error("Procedure %s found where expression required", p->symbol); 296 return (NIL); 297 default: 298 panic("stkrvid"); 299 } 300 case T_PLUS: 301 case T_MINUS: 302 case T_NOT: 303 case T_AND: 304 case T_OR: 305 case T_DIVD: 306 case T_MULT: 307 case T_SUB: 308 case T_ADD: 309 case T_MOD: 310 case T_DIV: 311 case T_EQ: 312 case T_NE: 313 case T_GE: 314 case T_LE: 315 case T_GT: 316 case T_LT: 317 case T_IN: 318 p = rvalue(r, contype , required ); 319 # ifdef OBJ 320 if (width(p) <= 2) 321 put(1, O_STOI); 322 # endif OBJ 323 # ifdef PC 324 if (isa(p,"sbci")) { 325 sconv(p2type(p),P2INT); 326 } 327 # endif PC 328 return (p); 329 case T_CSET: 330 p = rvalue(r, contype , required ); 331 return (p); 332 default: 333 if (r[2] == NIL) 334 return (NIL); 335 switch (r[0]) { 336 default: 337 panic("stkrval3"); 338 339 /* 340 * An octal number 341 */ 342 case T_BINT: 343 f = a8tol(r[2]); 344 goto conint; 345 346 /* 347 * A decimal number 348 */ 349 case T_INT: 350 f = atof(r[2]); 351 conint: 352 if (f > MAXINT || f < MININT) { 353 error("Constant too large for this implementation"); 354 return (NIL); 355 } 356 l = f; 357 if (bytes(l, l) <= 2) { 358 # ifdef OBJ 359 put(2, O_CON24, (short)l); 360 # endif OBJ 361 # ifdef PC 362 putleaf( P2ICON , (short) l , 0 , P2INT , 0 ); 363 # endif PC 364 return(nl+T4INT); 365 } 366 # ifdef OBJ 367 put(2, O_CON4, l); 368 # endif OBJ 369 # ifdef PC 370 putleaf( P2ICON , l , 0 , P2INT , 0 ); 371 # endif PC 372 return (nl+T4INT); 373 374 /* 375 * A floating point number 376 */ 377 case T_FINT: 378 # ifdef OBJ 379 put(2, O_CON8, atof(r[2])); 380 # endif OBJ 381 # ifdef PC 382 putCON8( atof( r[2] ) ); 383 # endif PC 384 return (nl+TDOUBLE); 385 386 /* 387 * Constant strings. Note that constant characters 388 * are constant strings of length one; there is 389 * no constant string of length one. 390 */ 391 case T_STRNG: 392 cp = r[2]; 393 if (cp[1] == 0) { 394 # ifdef OBJ 395 put(2, O_CONC4, cp[0]); 396 # endif OBJ 397 # ifdef PC 398 putleaf( P2ICON , cp[0] , 0 , P2INT , 0 ); 399 # endif PC 400 return(nl+T1CHAR); 401 } 402 goto cstrng; 403 } 404 405 } 406 } 407