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