![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to stkrval.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 41BSD / cmd / pi|
Return to stkrval.c CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / pi |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2:
3: static char sccsid[] = "@(#)stkrval.c 1.3 10/2/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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.