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