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