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