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) 07/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 556