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