Commit | Line | Data |
---|---|---|
28e6b83a PK |
1 | /* Copyright (c) 1979 Regents of the University of California */ |
2 | ||
c4e911b6 | 3 | static char sccsid[] = "@(#)stkrval.c 1.3 %G%"; |
28e6b83a PK |
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: | |
c4e911b6 | 235 | case FFUNC: |
28e6b83a PK |
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: | |
c4e911b6 | 275 | case FPROC: |
28e6b83a PK |
276 | error("Procedure %s found where expression required", p->symbol); |
277 | return (NIL); | |
278 | default: | |
279 | panic("stkrvid"); | |
280 | } | |
28e6b83a PK |
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); | |
a26d837a PK |
305 | case T_CSET: |
306 | p = rvalue(r, contype , required ); | |
307 | return (p); | |
28e6b83a PK |
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 | } |