![[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] / 42BSD / ucb / pascal / src|
Return to lval.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[] = "@(#)lval.c 1.10 10/24/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 "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: # ifdef OBJ
56: /*
57: * pi uses the rest of the function
58: */
59: firstp = p = lookup(r[2]);
60: if (p == NIL) {
61: return (NIL);
62: }
63: c = r[3];
64: if ((modflag & NOUSE) && !lptr(c)) {
65: p->nl_flags = flagwas;
66: }
67: if (modflag & MOD) {
68: p->nl_flags |= NMOD;
69: }
70: /*
71: * Only possibilities for p->class here
72: * are the named classes, i.e. CONST, TYPE
73: * VAR, PROC, FUNC, REF, or a WITHPTR.
74: */
75: switch (p->class) {
76: case WITHPTR:
77: /*
78: * Construct the tree implied by
79: * the with statement
80: */
81: trp[0] = T_LISTPP;
82: trp[1] = tr;
83: trp[2] = r[3];
84: tr[0] = T_FIELD;
85: tr[1] = r[2];
86: c = trp;
87: # ifdef PTREE
88: /*
89: * mung r[4] to say which field this T_VAR is
90: * for VarCopy
91: */
92: r[4] = reclook( p -> type , r[2] );
93: # endif
94: /* and fall through */
95: case REF:
96: /*
97: * Obtain the indirect word
98: * of the WITHPTR or REF
99: * as the base of our lvalue
100: */
101: put(2, PTR_RV | bn << 8+INDX , (int)p->value[0] );
102: f = 0; /* have an lv on stack */
103: o = 0;
104: break;
105: case VAR:
106: f = 1; /* no lv on stack yet */
107: o = p->value[0];
108: break;
109: default:
110: error("%s %s found where variable required", classes[p->class], p->symbol);
111: return (NIL);
112: }
113: /*
114: * Loop and handle each
115: * qualification on the name
116: */
117: if (c == NIL && (modflag&ASGN) && ( p->value[NL_FORV] & FORVAR ) ) {
118: error("Can't modify the for variable %s in the range of the loop", p->symbol);
119: return (NIL);
120: }
121: for (; c != NIL; c = c[2]) {
122: co = c[1];
123: if (co == NIL) {
124: return (NIL);
125: }
126: lastp = p;
127: p = p->type;
128: if (p == NIL) {
129: return (NIL);
130: }
131: switch (co[0]) {
132: case T_PTR:
133: /*
134: * Pointer qualification.
135: */
136: lastp->nl_flags |= NUSED;
137: if (p->class != PTR && p->class != FILET) {
138: error("^ allowed only on files and pointers, not on %ss", nameof(p));
139: goto bad;
140: }
141: if (f) {
142: if (p->class == FILET && bn != 0)
143: put(2, O_LV | bn <<8+INDX , o );
144: else
145: /*
146: * this is the indirection from
147: * the address of the pointer
148: * to the pointer itself.
149: * kirk sez:
150: * fnil doesn't want this.
151: * and does it itself for files
152: * since only it knows where the
153: * actual window is.
154: * but i have to do this for
155: * regular pointers.
156: * This is further complicated by
157: * the fact that global variables
158: * are referenced through pointers
159: * on the stack. Thus an RV on a
160: * global variable is the same as
161: * an LV of a non-global one ?!?
162: */
163: put(2, PTR_RV | bn <<8+INDX , o );
164: } else {
165: if (o) {
166: put(2, O_OFF, o);
167: }
168: if (p->class != FILET || bn == 0)
169: put(1, PTR_IND);
170: }
171: /*
172: * Pointer cannot be
173: * nil and file cannot
174: * be at end-of-file.
175: */
176: put(1, p->class == FILET ? O_FNIL : O_NIL);
177: f = o = 0;
178: continue;
179: case T_ARGL:
180: if (p->class != ARRAY) {
181: if (lastp == firstp) {
182: error("%s is a %s, not a function", r[2], classes[firstp->class]);
183: } else {
184: error("Illegal function qualificiation");
185: }
186: return (NIL);
187: }
188: recovered();
189: error("Pascal uses [] for subscripting, not ()");
190: case T_ARY:
191: if (p->class != ARRAY) {
192: error("Subscripting allowed only on arrays, not on %ss", nameof(p));
193: goto bad;
194: }
195: if (f) {
196: if (bn == 0)
197: /*
198: * global variables are
199: * referenced through pointers
200: * on the stack
201: */
202: put(2, PTR_RV | bn<<8+INDX, o);
203: else
204: put(2, O_LV | bn<<8+INDX, o);
205: } else {
206: if (o) {
207: put(2, O_OFF, o);
208: }
209: }
210: switch (arycod(p, co[1])) {
211: case 0:
212: return (NIL);
213: case -1:
214: goto bad;
215: }
216: f = o = 0;
217: continue;
218: case T_FIELD:
219: /*
220: * Field names are just
221: * an offset with some
222: * semantic checking.
223: */
224: if (p->class != RECORD) {
225: error(". allowed only on records, not on %ss", nameof(p));
226: goto bad;
227: }
228: if (co[1] == NIL) {
229: return (NIL);
230: }
231: p = reclook(p, co[1]);
232: if (p == NIL) {
233: error("%s is not a field in this record", co[1]);
234: goto bad;
235: }
236: # ifdef PTREE
237: /*
238: * mung co[3] to indicate which field
239: * this is for SelCopy
240: */
241: co[3] = p;
242: # endif
243: if (modflag & MOD) {
244: p->nl_flags |= NMOD;
245: }
246: if ((modflag & NOUSE) == 0 || lptr(c[2])) {
247: p->nl_flags |= NUSED;
248: }
249: o += p->value[0];
250: continue;
251: default:
252: panic("lval2");
253: }
254: }
255: if (f) {
256: if (bn == 0)
257: /*
258: * global variables are referenced through
259: * pointers on the stack
260: */
261: put(2, PTR_RV | bn<<8+INDX, o);
262: else
263: put(2, O_LV | bn<<8+INDX, o);
264: } else {
265: if (o) {
266: put(2, O_OFF, o);
267: }
268: }
269: return (p->type);
270: bad:
271: cerror("Error occurred on qualification of %s", r[2]);
272: return (NIL);
273: # endif OBJ
274: }
275:
276: lptr(c)
277: register int *c;
278: {
279: register int *co;
280:
281: for (; c != NIL; c = c[2]) {
282: co = c[1];
283: if (co == NIL) {
284: return (NIL);
285: }
286: switch (co[0]) {
287:
288: case T_PTR:
289: return (1);
290: case T_ARGL:
291: return (0);
292: case T_ARY:
293: case T_FIELD:
294: continue;
295: default:
296: panic("lptr");
297: }
298: }
299: return (0);
300: }
301:
302: /*
303: * Arycod does the
304: * code generation
305: * for subscripting.
306: */
307: arycod(np, el)
308: struct nl *np;
309: int *el;
310: {
311: register struct nl *p, *ap;
312: long sub;
313: bool constsub;
314: int i, d, v, v1;
315: int w;
316:
317: p = np;
318: if (el == NIL) {
319: return (0);
320: }
321: d = p->value[0];
322: /*
323: * Check each subscript
324: */
325: for (i = 1; i <= d; i++) {
326: if (el == NIL) {
327: error("Too few subscripts (%d given, %d required)", i-1, d);
328: return (-1);
329: }
330: p = p->chain;
331: if (constsub = constval(el[1])) {
332: ap = con.ctype;
333: sub = con.crval;
334: if (sub < p->range[0] || sub > p->range[1]) {
335: error("Subscript value of %D is out of range", sub);
336: return (0);
337: }
338: sub -= p->range[0];
339: } else {
340: # ifdef PC
341: precheck( p , "_SUBSC" , "_SUBSCZ" );
342: # endif PC
343: ap = rvalue(el[1], NLNIL , RREQ );
344: if (ap == NIL) {
345: return (0);
346: }
347: # ifdef PC
348: postcheck(p, ap);
349: sconv(p2type(ap),P2INT);
350: # endif PC
351: }
352: if (incompat(ap, p->type, el[1])) {
353: cerror("Array index type incompatible with declared index type");
354: if (d != 1) {
355: cerror("Error occurred on index number %d", i);
356: }
357: return (-1);
358: }
359: w = aryconst(np, i);
360: # ifdef OBJ
361: if (constsub) {
362: sub *= w;
363: if (sub != 0) {
364: w = bytes(sub, sub);
365: put(2, w <= 2 ? O_CON2 : O_CON4, sub);
366: gen(NIL, T_ADD, sizeof(char *), w);
367: }
368: el = el[2];
369: continue;
370: }
371: if (opt('t') == 0) {
372: switch (w) {
373: case 8:
374: w = 6;
375: case 4:
376: case 2:
377: case 1:
378: put(2, (width(ap) != 4 ? O_INX2P2 : O_INX4P2) | (w & ~1) << 7, ( short ) p->range[0]);
379: el = el[2];
380: continue;
381: }
382: }
383: put(4, width(ap) != 4 ? O_INX2 : O_INX4, w,
384: (short)p->range[0], (short)(p->range[1]));
385: el = el[2];
386: continue;
387: # endif OBJ
388: # ifdef PC
389: /*
390: * subtract off the lower bound
391: */
392: if (constsub) {
393: sub *= w;
394: if (sub != 0) {
395: putleaf( P2ICON , sub , 0 , P2INT , 0 );
396: putop(P2PLUS, ADDTYPE(p2type(np->type), P2PTR));
397: }
398: el = el[2];
399: continue;
400: }
401: if ( p -> range[ 0 ] != 0 ) {
402: putleaf( P2ICON , p -> range[0] , 0 , P2INT , 0 );
403: putop( P2MINUS , P2INT );
404: }
405: /*
406: * multiply by the width of the elements
407: */
408: if ( w != 1 ) {
409: putleaf( P2ICON , w , 0 , P2INT , 0 );
410: putop( P2MUL , P2INT );
411: }
412: /*
413: * and add it to the base address
414: */
415: putop( P2PLUS , ADDTYPE( p2type( np -> type ) , P2PTR ) );
416: # endif PC
417: el = el[2];
418: }
419: if (el != NIL) {
420: do {
421: el = el[2];
422: i++;
423: } while (el != NIL);
424: error("Too many subscripts (%d given, %d required)", i-1, d);
425: return (-1);
426: }
427: return (1);
428: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.