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