1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)stkrval.c 1.2 09/24/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 /* 236 * Function call 237 */ 238 pt = (int **)r[3]; 239 if (pt != NIL) { 240 switch (pt[1][0]) { 241 case T_PTR: 242 case T_ARGL: 243 case T_ARY: 244 case T_FIELD: 245 error("Can't qualify a function result value"); 246 return (NIL); 247 } 248 } 249 # ifdef OBJ 250 q = p->type; 251 if (classify(q) == TSTR) { 252 c = width(q); 253 put(2, O_LVCON, even(c+1)); 254 putstr("", c); 255 put(1, O_SDUP4); 256 p = funccod(r); 257 put(2, O_AS, c); 258 return(p); 259 } 260 p = funccod(r); 261 if (width(p) <= 2) 262 put(1, O_STOI); 263 # endif OBJ 264 # ifdef PC 265 p = pcfunccod( r ); 266 # endif PC 267 return (p); 268 269 case TYPE: 270 error("Type names (e.g. %s) allowed only in declarations", p->symbol); 271 return (NIL); 272 273 case PROC: 274 error("Procedure %s found where expression required", p->symbol); 275 return (NIL); 276 default: 277 panic("stkrvid"); 278 } 279 case T_PLUS: 280 case T_MINUS: 281 case T_NOT: 282 case T_AND: 283 case T_OR: 284 case T_DIVD: 285 case T_MULT: 286 case T_SUB: 287 case T_ADD: 288 case T_MOD: 289 case T_DIV: 290 case T_EQ: 291 case T_NE: 292 case T_GE: 293 case T_LE: 294 case T_GT: 295 case T_LT: 296 case T_IN: 297 p = rvalue(r, contype , required ); 298 # ifdef OBJ 299 if (width(p) <= 2) 300 put(1, O_STOI); 301 # endif OBJ 302 return (p); 303 case T_CSET: 304 p = rvalue(r, contype , required ); 305 return (p); 306 default: 307 if (r[2] == NIL) 308 return (NIL); 309 switch (r[0]) { 310 default: 311 panic("stkrval3"); 312 313 /* 314 * An octal number 315 */ 316 case T_BINT: 317 f = a8tol(r[2]); 318 goto conint; 319 320 /* 321 * A decimal number 322 */ 323 case T_INT: 324 f = atof(r[2]); 325 conint: 326 if (f > MAXINT || f < MININT) { 327 error("Constant too large for this implementation"); 328 return (NIL); 329 } 330 l = f; 331 if (bytes(l, l) <= 2) { 332 # ifdef OBJ 333 put(2, O_CON24, (short)l); 334 # endif OBJ 335 # ifdef PC 336 putleaf( P2ICON , (short) l , 0 , P2INT , 0 ); 337 # endif PC 338 return(nl+T4INT); 339 } 340 # ifdef OBJ 341 put(2, O_CON4, l); 342 # endif OBJ 343 # ifdef PC 344 putleaf( P2ICON , l , 0 , P2INT , 0 ); 345 # endif PC 346 return (nl+T4INT); 347 348 /* 349 * A floating point number 350 */ 351 case T_FINT: 352 # ifdef OBJ 353 put(2, O_CON8, atof(r[2])); 354 # endif OBJ 355 # ifdef PC 356 putCON8( atof( r[2] ) ); 357 # endif PC 358 return (nl+TDOUBLE); 359 360 /* 361 * Constant strings. Note that constant characters 362 * are constant strings of length one; there is 363 * no constant string of length one. 364 */ 365 case T_STRNG: 366 cp = r[2]; 367 if (cp[1] == 0) { 368 # ifdef OBJ 369 put(2, O_CONC4, cp[0]); 370 # endif OBJ 371 # ifdef PC 372 putleaf( P2ICON , cp[0] , 0 , P2CHAR , 0 ); 373 # endif PC 374 return(nl+T1CHAR); 375 } 376 goto cstrng; 377 } 378 379 } 380 } 381