4.3BSD - /usr/src/ucb/pascal/src/lval.c

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

Defined functions

Defined variables