![[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] / 43BSDTahoe / ucb / pascal / src|
Return to lval.c CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / 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[] = "@(#)lval.c 5.2 (Berkeley) 7/26/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: #include "tree_ty.h"
17: #ifdef PC
18: # include "pc.h"
19: # include <pcc.h>
20: #endif PC
21:
22: extern int flagwas;
23: /*
24: * Lvalue computes the address
25: * of a qualified name and
26: * leaves it on the stack.
27: * for pc, it can be asked for either an lvalue or an rvalue.
28: * the semantics are the same, only the code is different.
29: */
30: /*ARGSUSED*/
31: struct nl *
32: lvalue(var, modflag , required )
33: struct tnode *var;
34: int modflag;
35: int required;
36: {
37: #ifdef OBJ
38: register struct nl *p;
39: struct nl *firstp, *lastp;
40: register struct tnode *c, *co;
41: int f, o, s;
42: /*
43: * Note that the local optimizations
44: * done here for offsets would more
45: * appropriately be done in put.
46: */
47: struct tnode tr; /* T_FIELD */
48: struct tnode *tr_ptr;
49: struct tnode l_node;
50: #endif
51:
52: if (var == TR_NIL) {
53: return (NLNIL);
54: }
55: if (nowexp(var)) {
56: return (NLNIL);
57: }
58: if (var->tag != T_VAR) {
59: error("Variable required"); /* Pass mesgs down from pt of call ? */
60: return (NLNIL);
61: }
62: # ifdef PC
63: /*
64: * pc requires a whole different control flow
65: */
66: return pclvalue( var , modflag , required );
67: # endif PC
68: # ifdef OBJ
69: /*
70: * pi uses the rest of the function
71: */
72: firstp = p = lookup(var->var_node.cptr);
73: if (p == NLNIL) {
74: return (NLNIL);
75: }
76: c = var->var_node.qual;
77: if ((modflag & NOUSE) && !lptr(c)) {
78: p->nl_flags = flagwas;
79: }
80: if (modflag & MOD) {
81: p->nl_flags |= NMOD;
82: }
83: /*
84: * Only possibilities for p->class here
85: * are the named classes, i.e. CONST, TYPE
86: * VAR, PROC, FUNC, REF, or a WITHPTR.
87: */
88: tr_ptr = &l_node;
89: switch (p->class) {
90: case WITHPTR:
91: /*
92: * Construct the tree implied by
93: * the with statement
94: */
95: l_node.tag = T_LISTPP;
96:
97: /* the cast has got to go but until the node is figured
98: out it stays */
99:
100: tr_ptr->list_node.list = (&tr);
101: tr_ptr->list_node.next = var->var_node.qual;
102: tr.tag = T_FIELD;
103: tr.field_node.id_ptr = var->var_node.cptr;
104: c = tr_ptr; /* c is a ptr to a tnode */
105: # ifdef PTREE
106: /*
107: * mung var->fields to say which field this T_VAR is
108: * for VarCopy
109: */
110:
111: /* problem! reclook returns struct nl* */
112:
113: var->var_node.fields = reclook( p -> type ,
114: var->var_node.line_no );
115: # endif
116: /* and fall through */
117: case REF:
118: /*
119: * Obtain the indirect word
120: * of the WITHPTR or REF
121: * as the base of our lvalue
122: */
123: (void) put(2, PTR_RV | bn << 8+INDX , (int)p->value[0] );
124: f = 0; /* have an lv on stack */
125: o = 0;
126: break;
127: case VAR:
128: if (p->type->class != CRANGE) {
129: f = 1; /* no lv on stack yet */
130: o = p->value[0];
131: } else {
132: error("Conformant array bound %s found where variable required", p->symbol);
133: return(NLNIL);
134: }
135: break;
136: default:
137: error("%s %s found where variable required", classes[p->class], p->symbol);
138: return (NLNIL);
139: }
140: /*
141: * Loop and handle each
142: * qualification on the name
143: */
144: if (c == TR_NIL && (modflag&ASGN) && ( p->value[NL_FORV] & FORVAR ) ) {
145: error("Can't modify the for variable %s in the range of the loop", p->symbol);
146: return (NLNIL);
147: }
148: s = 0; /* subscripts seen */
149: for (; c != TR_NIL; c = c->list_node.next) {
150: co = c->list_node.list; /* co is a ptr to a tnode */
151: if (co == TR_NIL) {
152: return (NLNIL);
153: }
154: lastp = p;
155: p = p->type;
156: if (p == NLNIL) {
157: return (NLNIL);
158: }
159: /*
160: * If we haven't seen enough subscripts, and the next
161: * qualification isn't array reference, then it's an error.
162: */
163: if (s && co->tag != T_ARY) {
164: error("Too few subscripts (%d given, %d required)",
165: s, p->value[0]);
166: }
167: switch (co->tag) {
168: case T_PTR:
169: /*
170: * Pointer qualification.
171: */
172: lastp->nl_flags |= NUSED;
173: if (p->class != PTR && p->class != FILET) {
174: error("^ allowed only on files and pointers, not on %ss", nameof(p));
175: goto bad;
176: }
177: if (f) {
178: if (p->class == FILET && bn != 0)
179: (void) put(2, O_LV | bn <<8+INDX , o );
180: else
181: /*
182: * this is the indirection from
183: * the address of the pointer
184: * to the pointer itself.
185: * kirk sez:
186: * fnil doesn't want this.
187: * and does it itself for files
188: * since only it knows where the
189: * actual window is.
190: * but i have to do this for
191: * regular pointers.
192: * This is further complicated by
193: * the fact that global variables
194: * are referenced through pointers
195: * on the stack. Thus an RV on a
196: * global variable is the same as
197: * an LV of a non-global one ?!?
198: */
199: (void) put(2, PTR_RV | bn <<8+INDX , o );
200: } else {
201: if (o) {
202: (void) put(2, O_OFF, o);
203: }
204: if (p->class != FILET || bn == 0)
205: (void) put(1, PTR_IND);
206: }
207: /*
208: * Pointer cannot be
209: * nil and file cannot
210: * be at end-of-file.
211: */
212: (void) put(1, p->class == FILET ? O_FNIL : O_NIL);
213: f = o = 0;
214: continue;
215: case T_ARGL:
216: if (p->class != ARRAY) {
217: if (lastp == firstp) {
218: error("%s is a %s, not a function", var->var_node.cptr, classes[firstp->class]);
219: } else {
220: error("Illegal function qualificiation");
221: }
222: return (NLNIL);
223: }
224: recovered();
225: error("Pascal uses [] for subscripting, not ()");
226: case T_ARY:
227: if (p->class != ARRAY) {
228: error("Subscripting allowed only on arrays, not on %ss", nameof(p));
229: goto bad;
230: }
231: if (f) {
232: if (bn == 0)
233: /*
234: * global variables are
235: * referenced through pointers
236: * on the stack
237: */
238: (void) put(2, PTR_RV | bn<<8+INDX, o);
239: else
240: (void) put(2, O_LV | bn<<8+INDX, o);
241: } else {
242: if (o) {
243: (void) put(2, O_OFF, o);
244: }
245: }
246: switch(s = arycod(p,co->ary_node.expr_list,s)) {
247: /*
248: * This is the number of subscripts seen
249: */
250: case 0:
251: return (NLNIL);
252: case -1:
253: goto bad;
254: }
255: if (s == p->value[0]) {
256: s = 0;
257: } else {
258: p = lastp;
259: }
260: f = o = 0;
261: continue;
262: case T_FIELD:
263: /*
264: * Field names are just
265: * an offset with some
266: * semantic checking.
267: */
268: if (p->class != RECORD) {
269: error(". allowed only on records, not on %ss", nameof(p));
270: goto bad;
271: }
272: /* must define the field node!! */
273: if (co->field_node.id_ptr == NIL) {
274: return (NLNIL);
275: }
276: p = reclook(p, co->field_node.id_ptr);
277: if (p == NLNIL) {
278: error("%s is not a field in this record", co->field_node.id_ptr);
279: goto bad;
280: }
281: # ifdef PTREE
282: /*
283: * mung co[3] to indicate which field
284: * this is for SelCopy
285: */
286: co->field_node.nl_entry = p;
287: # endif
288: if (modflag & MOD) {
289: p->nl_flags |= NMOD;
290: }
291: if ((modflag & NOUSE) == 0 ||
292: lptr(c->list_node.next)) {
293: /* figure out what kind of node c is !! */
294: p->nl_flags |= NUSED;
295: }
296: o += p->value[0];
297: continue;
298: default:
299: panic("lval2");
300: }
301: }
302: if (s) {
303: error("Too few subscripts (%d given, %d required)",
304: s, p->type->value[0]);
305: return NLNIL;
306: }
307: if (f) {
308: if (bn == 0)
309: /*
310: * global variables are referenced through
311: * pointers on the stack
312: */
313: (void) put(2, PTR_RV | bn<<8+INDX, o);
314: else
315: (void) put(2, O_LV | bn<<8+INDX, o);
316: } else {
317: if (o) {
318: (void) put(2, O_OFF, o);
319: }
320: }
321: return (p->type);
322: bad:
323: cerror("Error occurred on qualification of %s", var->var_node.cptr);
324: return (NLNIL);
325: # endif OBJ
326: }
327:
328: int lptr(c)
329: register struct tnode *c;
330: {
331: register struct tnode *co;
332:
333: for (; c != TR_NIL; c = c->list_node.next) {
334: co = c->list_node.list;
335: if (co == TR_NIL) {
336: return (NIL);
337: }
338: switch (co->tag) {
339:
340: case T_PTR:
341: return (1);
342: case T_ARGL:
343: return (0);
344: case T_ARY:
345: case T_FIELD:
346: continue;
347: default:
348: panic("lptr");
349: }
350: }
351: return (0);
352: }
353:
354: /*
355: * Arycod does the
356: * code generation
357: * for subscripting.
358: * n is the number of
359: * subscripts already seen
360: * (CLN 09/13/83)
361: */
362: int arycod(np, el, n)
363: struct nl *np;
364: struct tnode *el;
365: int n;
366: {
367: register struct nl *p, *ap;
368: long sub;
369: bool constsub;
370: extern bool constval();
371: int i, d; /* v, v1; these aren't used */
372: int w;
373:
374: p = np;
375: if (el == TR_NIL) {
376: return (0);
377: }
378: d = p->value[0];
379: for (i = 1; i <= n; i++) {
380: p = p->chain;
381: }
382: /*
383: * Check each subscript
384: */
385: for (i = n+1; i <= d; i++) {
386: if (el == TR_NIL) {
387: return (i-1);
388: }
389: p = p->chain;
390: if (p == NLNIL)
391: return (0);
392: if ((p->class != CRANGE) &&
393: (constsub = constval(el->list_node.list))) {
394: ap = con.ctype;
395: sub = con.crval;
396: if (sub < p->range[0] || sub > p->range[1]) {
397: error("Subscript value of %D is out of range", (char *) sub);
398: return (0);
399: }
400: sub -= p->range[0];
401: } else {
402: # ifdef PC
403: precheck( p , "_SUBSC" , "_SUBSCZ" );
404: # endif PC
405: ap = rvalue(el->list_node.list, NLNIL , RREQ );
406: if (ap == NIL) {
407: return (0);
408: }
409: # ifdef PC
410: postcheck(p, ap);
411: sconv(p2type(ap),PCCT_INT);
412: # endif PC
413: }
414: if (incompat(ap, p->type, el->list_node.list)) {
415: cerror("Array index type incompatible with declared index type");
416: if (d != 1) {
417: cerror("Error occurred on index number %d", (char *) i);
418: }
419: return (-1);
420: }
421: if (p->class == CRANGE) {
422: constsub = FALSE;
423: } else {
424: w = aryconst(np, i);
425: }
426: # ifdef OBJ
427: if (constsub) {
428: sub *= w;
429: if (sub != 0) {
430: w = bytes(sub, sub);
431: (void) put(2, w <= 2 ? O_CON2 : O_CON4, sub);
432: (void) gen(NIL, T_ADD, sizeof(char *), w);
433: }
434: el = el->list_node.next;
435: continue;
436: }
437: if (p->class == CRANGE) {
438: putcbnds(p, 0);
439: putcbnds(p, 1);
440: putcbnds(p, 2);
441: } else if (opt('t') == 0) {
442: switch (w) {
443: case 8:
444: w = 6;
445: case 4:
446: case 2:
447: case 1:
448: (void) put(2, (width(ap) != 4 ? O_INX2P2 : O_INX4P2) | (w & ~1) << 7, ( short ) p->range[0]);
449: el = el->list_node.next;
450: continue;
451: }
452: }
453: if (p->class == CRANGE) {
454: if (width(p) == 4) {
455: put(1, width(ap) != 4 ? O_VINX42 : O_VINX4);
456: } else {
457: put(1, width(ap) != 4 ? O_VINX2 : O_VINX24);
458: }
459: } else {
460: put(4, width(ap) != 4 ? O_INX2 : O_INX4, w,
461: (short)p->range[0], (short)(p->range[1]));
462: }
463: el = el->list_node.next;
464: continue;
465: # endif OBJ
466: # ifdef PC
467: /*
468: * subtract off the lower bound
469: */
470: if (constsub) {
471: sub *= w;
472: if (sub != 0) {
473: putleaf( PCC_ICON , (int) sub , 0 , PCCT_INT , (char *) 0 );
474: putop(PCC_PLUS, PCCM_ADDTYPE(p2type(np->type), PCCTM_PTR));
475: }
476: el = el->list_node.next;
477: continue;
478: }
479: if (p->class == CRANGE) {
480: /*
481: * if conformant array, subtract off lower bound
482: */
483: ap = p->nptr[0];
484: putRV(ap->symbol, (ap->nl_block & 037), ap->value[0],
485: ap->extra_flags, p2type( ap ) );
486: putop( PCC_MINUS, PCCT_INT );
487: /*
488: * and multiply by the width of the elements
489: */
490: ap = p->nptr[2];
491: putRV( 0 , (ap->nl_block & 037), ap->value[0],
492: ap->extra_flags, p2type( ap ) );
493: putop( PCC_MUL , PCCT_INT );
494: } else {
495: if ( p -> range[ 0 ] != 0 ) {
496: putleaf( PCC_ICON , (int) p -> range[0] , 0 , PCCT_INT , (char *) 0 );
497: putop( PCC_MINUS , PCCT_INT );
498: }
499: /*
500: * multiply by the width of the elements
501: */
502: if ( w != 1 ) {
503: putleaf( PCC_ICON , w , 0 , PCCT_INT , (char *) 0 );
504: putop( PCC_MUL , PCCT_INT );
505: }
506: }
507: /*
508: * and add it to the base address
509: */
510: putop( PCC_PLUS , PCCM_ADDTYPE( p2type( np -> type ) , PCCTM_PTR ) );
511: el = el->list_node.next;
512: # endif PC
513: }
514: if (el != TR_NIL) {
515: if (np->type->class != ARRAY) {
516: do {
517: el = el->list_node.next;
518: i++;
519: } while (el != TR_NIL);
520: error("Too many subscripts (%d given, %d required)", (char *) (i-1), (char *) d);
521: return (-1);
522: } else {
523: return(arycod(np->type, el, d));
524: }
525: }
526: return (d);
527: }
528:
529: #ifdef OBJ
530: /*
531: * Put out the conformant array bounds (lower bound, upper bound or width)
532: * for conformant array type ctype.
533: * The value of i determines which is being put
534: * i = 0: lower bound, i=1: upper bound, i=2: width
535: */
536: putcbnds(ctype, i)
537: struct nl *ctype;
538: int i;
539: {
540: switch(width(ctype->type)) {
541: case 1:
542: put(2, O_RV1 | (ctype->nl_block & 037) << 8+INDX,
543: (int)ctype->nptr[i]->value[0]);
544: break;
545: case 2:
546: put(2, O_RV2 | (ctype->nl_block & 037) << 8+INDX,
547: (int)ctype->nptr[i]->value[0]);
548: break;
549: case 4:
550: default:
551: put(2, O_RV4 | (ctype->nl_block & 037) << 8+INDX,
552: (int)ctype->nptr[i]->value[0]);
553: }
554: }
555: #endif OBJ
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.