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