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