1 /*- 2 * Copyright (c) 1980, 1993 3 * The Regents of the University of California. All rights reserved. 4 * 5 * %sccs.include.redist.c% 6 */ 7 8 #ifndef lint 9 static char sccsid[] = "@(#)lval.c 8.1 (Berkeley) 06/06/93"; 10 #endif /* not lint */ 11 12 #include "whoami.h" 13 #include "0.h" 14 #include "tree.h" 15 #include "opcode.h" 16 #include "objfmt.h" 17 #include "tree_ty.h" 18 #ifdef PC 19 # include "pc.h" 20 # include <pcc.h> 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 */ 31 /*ARGSUSED*/ 32 struct nl * 33 lvalue(var, modflag , required ) 34 struct tnode *var; 35 int modflag; 36 int required; 37 { 38 #ifdef OBJ 39 register struct nl *p; 40 struct nl *firstp, *lastp; 41 register struct tnode *c, *co; 42 int f, o, s; 43 /* 44 * Note that the local optimizations 45 * done here for offsets would more 46 * appropriately be done in put. 47 */ 48 struct tnode tr; /* T_FIELD */ 49 struct tnode *tr_ptr; 50 struct tnode l_node; 51 #endif 52 53 if (var == TR_NIL) { 54 return (NLNIL); 55 } 56 if (nowexp(var)) { 57 return (NLNIL); 58 } 59 if (var->tag != T_VAR) { 60 error("Variable required"); /* Pass mesgs down from pt of call ? */ 61 return (NLNIL); 62 } 63 # ifdef PC 64 /* 65 * pc requires a whole different control flow 66 */ 67 return pclvalue( var , modflag , required ); 68 # endif PC 69 # ifdef OBJ 70 /* 71 * pi uses the rest of the function 72 */ 73 firstp = p = lookup(var->var_node.cptr); 74 if (p == NLNIL) { 75 return (NLNIL); 76 } 77 c = var->var_node.qual; 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 */ 89 tr_ptr = &l_node; 90 switch (p->class) { 91 case WITHPTR: 92 /* 93 * Construct the tree implied by 94 * the with statement 95 */ 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 */ 106 # ifdef PTREE 107 /* 108 * mung var->fields to say which field this T_VAR is 109 * for VarCopy 110 */ 111 112 /* problem! reclook returns struct nl* */ 113 114 var->var_node.fields = reclook( p -> type , 115 var->var_node.line_no ); 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 */ 124 (void) put(2, PTR_RV | bn << 8+INDX , (int)p->value[0] ); 125 f = 0; /* have an lv on stack */ 126 o = 0; 127 break; 128 case VAR: 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 } 136 break; 137 default: 138 error("%s %s found where variable required", classes[p->class], p->symbol); 139 return (NLNIL); 140 } 141 /* 142 * Loop and handle each 143 * qualification on the name 144 */ 145 if (c == TR_NIL && (modflag&ASGN) && ( p->value[NL_FORV] & FORVAR ) ) { 146 error("Can't modify the for variable %s in the range of the loop", p->symbol); 147 return (NLNIL); 148 } 149 s = 0; /* subscripts seen */ 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); 154 } 155 lastp = p; 156 p = p->type; 157 if (p == NLNIL) { 158 return (NLNIL); 159 } 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 } 168 switch (co->tag) { 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) { 179 if (p->class == FILET && bn != 0) 180 (void) put(2, O_LV | bn <<8+INDX , o ); 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 */ 200 (void) put(2, PTR_RV | bn <<8+INDX , o ); 201 } else { 202 if (o) { 203 (void) put(2, O_OFF, o); 204 } 205 if (p->class != FILET || bn == 0) 206 (void) put(1, PTR_IND); 207 } 208 /* 209 * Pointer cannot be 210 * nil and file cannot 211 * be at end-of-file. 212 */ 213 (void) put(1, p->class == FILET ? O_FNIL : O_NIL); 214 f = o = 0; 215 continue; 216 case T_ARGL: 217 if (p->class != ARRAY) { 218 if (lastp == firstp) { 219 error("%s is a %s, not a function", var->var_node.cptr, classes[firstp->class]); 220 } else { 221 error("Illegal function qualificiation"); 222 } 223 return (NLNIL); 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) { 233 if (bn == 0) 234 /* 235 * global variables are 236 * referenced through pointers 237 * on the stack 238 */ 239 (void) put(2, PTR_RV | bn<<8+INDX, o); 240 else 241 (void) put(2, O_LV | bn<<8+INDX, o); 242 } else { 243 if (o) { 244 (void) put(2, O_OFF, o); 245 } 246 } 247 switch(s = arycod(p,co->ary_node.expr_list,s)) { 248 /* 249 * This is the number of subscripts seen 250 */ 251 case 0: 252 return (NLNIL); 253 case -1: 254 goto bad; 255 } 256 if (s == p->value[0]) { 257 s = 0; 258 } else { 259 p = lastp; 260 } 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 } 273 /* must define the field node!! */ 274 if (co->field_node.id_ptr == NIL) { 275 return (NLNIL); 276 } 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); 280 goto bad; 281 } 282 # ifdef PTREE 283 /* 284 * mung co[3] to indicate which field 285 * this is for SelCopy 286 */ 287 co->field_node.nl_entry = p; 288 # endif 289 if (modflag & MOD) { 290 p->nl_flags |= NMOD; 291 } 292 if ((modflag & NOUSE) == 0 || 293 lptr(c->list_node.next)) { 294 /* figure out what kind of node c is !! */ 295 p->nl_flags |= NUSED; 296 } 297 o += p->value[0]; 298 continue; 299 default: 300 panic("lval2"); 301 } 302 } 303 if (s) { 304 error("Too few subscripts (%d given, %d required)", 305 s, p->type->value[0]); 306 return NLNIL; 307 } 308 if (f) { 309 if (bn == 0) 310 /* 311 * global variables are referenced through 312 * pointers on the stack 313 */ 314 (void) put(2, PTR_RV | bn<<8+INDX, o); 315 else 316 (void) put(2, O_LV | bn<<8+INDX, o); 317 } else { 318 if (o) { 319 (void) put(2, O_OFF, o); 320 } 321 } 322 return (p->type); 323 bad: 324 cerror("Error occurred on qualification of %s", var->var_node.cptr); 325 return (NLNIL); 326 # endif OBJ 327 } 328 329 int lptr(c) 330 register struct tnode *c; 331 { 332 register struct tnode *co; 333 334 for (; c != TR_NIL; c = c->list_node.next) { 335 co = c->list_node.list; 336 if (co == TR_NIL) { 337 return (NIL); 338 } 339 switch (co->tag) { 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. 359 * n is the number of 360 * subscripts already seen 361 * (CLN 09/13/83) 362 */ 363 int arycod(np, el, n) 364 struct nl *np; 365 struct tnode *el; 366 int n; 367 { 368 register struct nl *p, *ap; 369 long sub; 370 bool constsub; 371 extern bool constval(); 372 int i, d; /* v, v1; these aren't used */ 373 int w; 374 375 p = np; 376 if (el == TR_NIL) { 377 return (0); 378 } 379 d = p->value[0]; 380 for (i = 1; i <= n; i++) { 381 p = p->chain; 382 } 383 /* 384 * Check each subscript 385 */ 386 for (i = n+1; i <= d; i++) { 387 if (el == TR_NIL) { 388 return (i-1); 389 } 390 p = p->chain; 391 if (p == NLNIL) 392 return (0); 393 if ((p->class != CRANGE) && 394 (constsub = constval(el->list_node.list))) { 395 ap = con.ctype; 396 sub = con.crval; 397 if (sub < p->range[0] || sub > p->range[1]) { 398 error("Subscript value of %D is out of range", (char *) sub); 399 return (0); 400 } 401 sub -= p->range[0]; 402 } else { 403 # ifdef PC 404 precheck( p , "_SUBSC" , "_SUBSCZ" ); 405 # endif PC 406 ap = rvalue(el->list_node.list, NLNIL , RREQ ); 407 if (ap == NIL) { 408 return (0); 409 } 410 # ifdef PC 411 postcheck(p, ap); 412 sconv(p2type(ap),PCCT_INT); 413 # endif PC 414 } 415 if (incompat(ap, p->type, el->list_node.list)) { 416 cerror("Array index type incompatible with declared index type"); 417 if (d != 1) { 418 cerror("Error occurred on index number %d", (char *) i); 419 } 420 return (-1); 421 } 422 if (p->class == CRANGE) { 423 constsub = FALSE; 424 } else { 425 w = aryconst(np, i); 426 } 427 # ifdef OBJ 428 if (constsub) { 429 sub *= w; 430 if (sub != 0) { 431 w = bytes(sub, sub); 432 (void) put(2, w <= 2 ? O_CON2 : O_CON4, sub); 433 (void) gen(NIL, T_ADD, sizeof(char *), w); 434 } 435 el = el->list_node.next; 436 continue; 437 } 438 if (p->class == CRANGE) { 439 putcbnds(p, 0); 440 putcbnds(p, 1); 441 putcbnds(p, 2); 442 } else if (opt('t') == 0) { 443 switch (w) { 444 case 8: 445 w = 6; 446 case 4: 447 case 2: 448 case 1: 449 (void) put(2, (width(ap) != 4 ? O_INX2P2 : O_INX4P2) | (w & ~1) << 7, ( short ) p->range[0]); 450 el = el->list_node.next; 451 continue; 452 } 453 } 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 } 464 el = el->list_node.next; 465 continue; 466 # endif OBJ 467 # ifdef PC 468 /* 469 * subtract off the lower bound 470 */ 471 if (constsub) { 472 sub *= w; 473 if (sub != 0) { 474 putleaf( PCC_ICON , (int) sub , 0 , PCCT_INT , (char *) 0 ); 475 putop(PCC_PLUS, PCCM_ADDTYPE(p2type(np->type), PCCTM_PTR)); 476 } 477 el = el->list_node.next; 478 continue; 479 } 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 ) ); 487 putop( PCC_MINUS, PCCT_INT ); 488 /* 489 * and multiply by the width of the elements 490 */ 491 ap = p->nptr[2]; 492 putRV( 0 , (ap->nl_block & 037), ap->value[0], 493 ap->extra_flags, p2type( ap ) ); 494 putop( PCC_MUL , PCCT_INT ); 495 } else { 496 if ( p -> range[ 0 ] != 0 ) { 497 putleaf( PCC_ICON , (int) p -> range[0] , 0 , PCCT_INT , (char *) 0 ); 498 putop( PCC_MINUS , PCCT_INT ); 499 } 500 /* 501 * multiply by the width of the elements 502 */ 503 if ( w != 1 ) { 504 putleaf( PCC_ICON , w , 0 , PCCT_INT , (char *) 0 ); 505 putop( PCC_MUL , PCCT_INT ); 506 } 507 } 508 /* 509 * and add it to the base address 510 */ 511 putop( PCC_PLUS , PCCM_ADDTYPE( p2type( np -> type ) , PCCTM_PTR ) ); 512 el = el->list_node.next; 513 # endif PC 514 } 515 if (el != TR_NIL) { 516 if (np->type->class != ARRAY) { 517 do { 518 el = el->list_node.next; 519 i++; 520 } while (el != TR_NIL); 521 error("Too many subscripts (%d given, %d required)", (char *) (i-1), (char *) d); 522 return (-1); 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]); 554 } 555 } 556 #endif OBJ 557