![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lval.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 40BSD / cmd / pi|
Return to lval.c CVS log | Up to [CSRG BSD Unix] / 40BSD / cmd / pi |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2:
3: static char sccsid[] = "@(#)lval.c 1.1 8/27/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 "pc.h"
12: # include "pcops.h"
13: #endif PC
14:
15: extern int flagwas;
16: /*
17: * Lvalue computes the address
18: * of a qualified name and
19: * leaves it on the stack.
20: * for pc, it can be asked for either an lvalue or an rvalue.
21: * the semantics are the same, only the code is different.
22: */
23: struct nl *
24: lvalue(r, modflag , required )
25: int *r, modflag;
26: int required;
27: {
28: register struct nl *p;
29: struct nl *firstp, *lastp;
30: register *c, *co;
31: int f, o;
32: /*
33: * Note that the local optimizations
34: * done here for offsets would more
35: * appropriately be done in put.
36: */
37: int tr[2], trp[3];
38:
39: if (r == NIL) {
40: return (NIL);
41: }
42: if (nowexp(r)) {
43: return (NIL);
44: }
45: if (r[0] != T_VAR) {
46: error("Variable required"); /* Pass mesgs down from pt of call ? */
47: return (NIL);
48: }
49: # ifdef PC
50: /*
51: * pc requires a whole different control flow
52: */
53: return pclvalue( r , modflag , required );
54: # endif PC
55: firstp = p = lookup(r[2]);
56: if (p == NIL) {
57: return (NIL);
58: }
59: c = r[3];
60: if ((modflag & NOUSE) && !lptr(c)) {
61: p->nl_flags = flagwas;
62: }
63: if (modflag & MOD) {
64: p->nl_flags |= NMOD;
65: }
66: /*
67: * Only possibilities for p->class here
68: * are the named classes, i.e. CONST, TYPE
69: * VAR, PROC, FUNC, REF, or a WITHPTR.
70: */
71: switch (p->class) {
72: case WITHPTR:
73: /*
74: * Construct the tree implied by
75: * the with statement
76: */
77: trp[0] = T_LISTPP;
78: trp[1] = tr;
79: trp[2] = r[3];
80: tr[0] = T_FIELD;
81: tr[1] = r[2];
82: c = trp;
83: # ifdef PTREE
84: /*
85: * mung r[4] to say which field this T_VAR is
86: * for VarCopy
87: */
88: r[4] = reclook( p -> type , r[2] );
89: # endif
90: /* and fall through */
91: case REF:
92: /*
93: * Obtain the indirect word
94: * of the WITHPTR or REF
95: * as the base of our lvalue
96: */
97: put(2, PTR_RV | bn << 8+INDX , p->value[0] );
98: f = 0; /* have an lv on stack */
99: o = 0;
100: break;
101: case VAR:
102: f = 1; /* no lv on stack yet */
103: o = p->value[0];
104: break;
105: default:
106: error("%s %s found where variable required", classes[p->class], p->symbol);
107: return (NIL);
108: }
109: /*
110: * Loop and handle each
111: * qualification on the name
112: */
113: if (c == NIL && (modflag&ASGN) && p->value[NL_FORV]) {
114: error("Can't modify the for variable %s in the range of the loop", p->symbol);
115: return (NIL);
116: }
117: for (; c != NIL; c = c[2]) {
118: co = c[1];
119: if (co == NIL) {
120: return (NIL);
121: }
122: lastp = p;
123: p = p->type;
124: if (p == NIL) {
125: return (NIL);
126: }
127: switch (co[0]) {
128: case T_PTR:
129: /*
130: * Pointer qualification.
131: */
132: lastp->nl_flags |= NUSED;
133: if (p->class != PTR && p->class != FILET) {
134: error("^ allowed only on files and pointers, not on %ss", nameof(p));
135: goto bad;
136: }
137: if (f) {
138: put(2, PTR_RV | bn <<8+INDX , o );
139: } else {
140: if (o) {
141: put2(O_OFF, o);
142: }
143: put(1, PTR_IND);
144: }
145: /*
146: * Pointer cannot be
147: * nil and file cannot
148: * be at end-of-file.
149: */
150: put1(p->class == FILET ? O_FNIL : O_NIL);
151: f = o = 0;
152: continue;
153: case T_ARGL:
154: if (p->class != ARRAY) {
155: if (lastp == firstp) {
156: error("%s is a %s, not a function", r[2], classes[firstp->class]);
157: } else {
158: error("Illegal function qualificiation");
159: }
160: return (NIL);
161: }
162: recovered();
163: error("Pascal uses [] for subscripting, not ()");
164: case T_ARY:
165: if (p->class != ARRAY) {
166: error("Subscripting allowed only on arrays, not on %ss", nameof(p));
167: goto bad;
168: }
169: if (f) {
170: put2(O_LV | bn<<8+INDX, o);
171: } else {
172: if (o) {
173: put2(O_OFF, o);
174: }
175: }
176: switch (arycod(p, co[1])) {
177: case 0:
178: return (NIL);
179: case -1:
180: goto bad;
181: }
182: f = o = 0;
183: continue;
184: case T_FIELD:
185: /*
186: * Field names are just
187: * an offset with some
188: * semantic checking.
189: */
190: if (p->class != RECORD) {
191: error(". allowed only on records, not on %ss", nameof(p));
192: goto bad;
193: }
194: if (co[1] == NIL) {
195: return (NIL);
196: }
197: p = reclook(p, co[1]);
198: if (p == NIL) {
199: error("%s is not a field in this record", co[1]);
200: goto bad;
201: }
202: # ifdef PTREE
203: /*
204: * mung co[3] to indicate which field
205: * this is for SelCopy
206: */
207: co[3] = p;
208: # endif
209: if (modflag & MOD) {
210: p->nl_flags |= NMOD;
211: }
212: if ((modflag & NOUSE) == 0 || lptr(c[2])) {
213: p->nl_flags |= NUSED;
214: }
215: o += p->value[0];
216: continue;
217: default:
218: panic("lval2");
219: }
220: }
221: if (f) {
222: put2(O_LV | bn<<8+INDX, o);
223: } else {
224: if (o) {
225: put2(O_OFF, o);
226: }
227: }
228: return (p->type);
229: bad:
230: cerror("Error occurred on qualification of %s", r[2]);
231: return (NIL);
232: }
233:
234: lptr(c)
235: register int *c;
236: {
237: register int *co;
238:
239: for (; c != NIL; c = c[2]) {
240: co = c[1];
241: if (co == NIL) {
242: return (NIL);
243: }
244: switch (co[0]) {
245:
246: case T_PTR:
247: return (1);
248: case T_ARGL:
249: return (0);
250: case T_ARY:
251: case T_FIELD:
252: continue;
253: default:
254: panic("lptr");
255: }
256: }
257: return (0);
258: }
259:
260: /*
261: * Arycod does the
262: * code generation
263: * for subscripting.
264: */
265: arycod(np, el)
266: struct nl *np;
267: int *el;
268: {
269: register struct nl *p, *ap;
270: int i, d, v, v1;
271: int w;
272:
273: p = np;
274: if (el == NIL) {
275: return (0);
276: }
277: d = p->value[0];
278: /*
279: * Check each subscript
280: */
281: for (i = 1; i <= d; i++) {
282: if (el == NIL) {
283: error("Too few subscripts (%d given, %d required)", i-1, d);
284: return (-1);
285: }
286: p = p->chain;
287: # ifdef PC
288: precheck( p , "_SUBSC" , "_SUBSCZ" );
289: # endif PC
290: ap = rvalue(el[1], NLNIL , RREQ );
291: if (ap == NIL) {
292: return (0);
293: }
294: # ifdef PC
295: postcheck( p );
296: # endif PC
297: if (incompat(ap, p->type, el[1])) {
298: cerror("Array index type incompatible with declared index type");
299: if (d != 1) {
300: cerror("Error occurred on index number %d", i);
301: }
302: return (-1);
303: }
304: w = aryconst(np, i);
305: # ifdef OBJ
306: if (opt('t') == 0) {
307: switch (w) {
308: case 8:
309: w = 6;
310: case 4:
311: case 2:
312: case 1:
313: put2((width(ap) != 4 ? O_INX2P2 : O_INX4P2) | (w & ~1) << 7, ( short ) p->range[0]);
314: el = el[2];
315: continue;
316: }
317: }
318: put(4, width(ap) != 4 ? O_INX2 : O_INX4,w,( short ) p->range[0],
319: ( short ) ( p->range[1] - p->range[0] ) );
320: # endif OBJ
321: # ifdef PC
322: /*
323: * subtract off the lower bound
324: */
325: if ( p -> range[ 0 ] != 0 ) {
326: putleaf( P2ICON , p -> range[0] , 0 , P2INT , 0 );
327: putop( P2MINUS , P2INT );
328: }
329: /*
330: * multiply by the width of the elements
331: */
332: if ( w != 1 ) {
333: putleaf( P2ICON , w , 0 , P2INT , 0 );
334: putop( P2MUL , P2INT );
335: }
336: /*
337: * and add it to the base address
338: */
339: putop( P2PLUS , ADDTYPE( p2type( np -> type ) , P2PTR ) );
340: # endif PC
341: el = el[2];
342: }
343: if (el != NIL) {
344: do {
345: el = el[2];
346: i++;
347: } while (el != NIL);
348: error("Too many subscripts (%d given, %d required)", i-1, d);
349: return (-1);
350: }
351: return (1);
352: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.