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