1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)lval.c 1.3 01/10/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 if (p->class != FILET || bn == 0) 165 put(1, PTR_IND); 166 } 167 /* 168 * Pointer cannot be 169 * nil and file cannot 170 * be at end-of-file. 171 */ 172 put1(p->class == FILET ? O_FNIL : O_NIL); 173 f = o = 0; 174 continue; 175 case T_ARGL: 176 if (p->class != ARRAY) { 177 if (lastp == firstp) { 178 error("%s is a %s, not a function", r[2], classes[firstp->class]); 179 } else { 180 error("Illegal function qualificiation"); 181 } 182 return (NIL); 183 } 184 recovered(); 185 error("Pascal uses [] for subscripting, not ()"); 186 case T_ARY: 187 if (p->class != ARRAY) { 188 error("Subscripting allowed only on arrays, not on %ss", nameof(p)); 189 goto bad; 190 } 191 if (f) { 192 if (bn == 0) 193 /* 194 * global variables are 195 * referenced through pointers 196 * on the stack 197 */ 198 put2(PTR_RV | bn<<8+INDX, o); 199 else 200 put2(O_LV | bn<<8+INDX, o); 201 } else { 202 if (o) { 203 put2(O_OFF, o); 204 } 205 } 206 switch (arycod(p, co[1])) { 207 case 0: 208 return (NIL); 209 case -1: 210 goto bad; 211 } 212 f = o = 0; 213 continue; 214 case T_FIELD: 215 /* 216 * Field names are just 217 * an offset with some 218 * semantic checking. 219 */ 220 if (p->class != RECORD) { 221 error(". allowed only on records, not on %ss", nameof(p)); 222 goto bad; 223 } 224 if (co[1] == NIL) { 225 return (NIL); 226 } 227 p = reclook(p, co[1]); 228 if (p == NIL) { 229 error("%s is not a field in this record", co[1]); 230 goto bad; 231 } 232 # ifdef PTREE 233 /* 234 * mung co[3] to indicate which field 235 * this is for SelCopy 236 */ 237 co[3] = p; 238 # endif 239 if (modflag & MOD) { 240 p->nl_flags |= NMOD; 241 } 242 if ((modflag & NOUSE) == 0 || lptr(c[2])) { 243 p->nl_flags |= NUSED; 244 } 245 o += p->value[0]; 246 continue; 247 default: 248 panic("lval2"); 249 } 250 } 251 if (f) { 252 if (bn == 0) 253 /* 254 * global variables are referenced through 255 * pointers on the stack 256 */ 257 put2(PTR_RV | bn<<8+INDX, o); 258 else 259 put2(O_LV | bn<<8+INDX, o); 260 } else { 261 if (o) { 262 put2(O_OFF, o); 263 } 264 } 265 return (p->type); 266 bad: 267 cerror("Error occurred on qualification of %s", r[2]); 268 return (NIL); 269 } 270 271 lptr(c) 272 register int *c; 273 { 274 register int *co; 275 276 for (; c != NIL; c = c[2]) { 277 co = c[1]; 278 if (co == NIL) { 279 return (NIL); 280 } 281 switch (co[0]) { 282 283 case T_PTR: 284 return (1); 285 case T_ARGL: 286 return (0); 287 case T_ARY: 288 case T_FIELD: 289 continue; 290 default: 291 panic("lptr"); 292 } 293 } 294 return (0); 295 } 296 297 /* 298 * Arycod does the 299 * code generation 300 * for subscripting. 301 */ 302 arycod(np, el) 303 struct nl *np; 304 int *el; 305 { 306 register struct nl *p, *ap; 307 int i, d, v, v1; 308 int w; 309 310 p = np; 311 if (el == NIL) { 312 return (0); 313 } 314 d = p->value[0]; 315 /* 316 * Check each subscript 317 */ 318 for (i = 1; i <= d; i++) { 319 if (el == NIL) { 320 error("Too few subscripts (%d given, %d required)", i-1, d); 321 return (-1); 322 } 323 p = p->chain; 324 # ifdef PC 325 precheck( p , "_SUBSC" , "_SUBSCZ" ); 326 # endif PC 327 ap = rvalue(el[1], NLNIL , RREQ ); 328 if (ap == NIL) { 329 return (0); 330 } 331 # ifdef PC 332 postcheck( p ); 333 # endif PC 334 if (incompat(ap, p->type, el[1])) { 335 cerror("Array index type incompatible with declared index type"); 336 if (d != 1) { 337 cerror("Error occurred on index number %d", i); 338 } 339 return (-1); 340 } 341 w = aryconst(np, i); 342 # ifdef OBJ 343 if (opt('t') == 0) { 344 switch (w) { 345 case 8: 346 w = 6; 347 case 4: 348 case 2: 349 case 1: 350 put2((width(ap) != 4 ? O_INX2P2 : O_INX4P2) | (w & ~1) << 7, ( short ) p->range[0]); 351 el = el[2]; 352 continue; 353 } 354 } 355 put(4, width(ap) != 4 ? O_INX2 : O_INX4,w,( short ) p->range[0], 356 ( short ) ( p->range[1] ) ); 357 # endif OBJ 358 # ifdef PC 359 /* 360 * subtract off the lower bound 361 */ 362 if ( p -> range[ 0 ] != 0 ) { 363 putleaf( P2ICON , p -> range[0] , 0 , P2INT , 0 ); 364 putop( P2MINUS , P2INT ); 365 } 366 /* 367 * multiply by the width of the elements 368 */ 369 if ( w != 1 ) { 370 putleaf( P2ICON , w , 0 , P2INT , 0 ); 371 putop( P2MUL , P2INT ); 372 } 373 /* 374 * and add it to the base address 375 */ 376 putop( P2PLUS , ADDTYPE( p2type( np -> type ) , P2PTR ) ); 377 # endif PC 378 el = el[2]; 379 } 380 if (el != NIL) { 381 do { 382 el = el[2]; 383 i++; 384 } while (el != NIL); 385 error("Too many subscripts (%d given, %d required)", i-1, d); 386 return (-1); 387 } 388 return (1); 389 } 390