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