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