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