# 2.11BSD#431 - /usr/src/ucb/PORT/pascal/src/lval.c

##### Functions

    arycod            X
    lptr              X
    lvalue            X
    putcbnds          X

       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

arycod defined in line 362; used 4 times

- in line 246, 523
- in /usr/src/ucb/PORT/pascal/src/pclval.c line 218, 324

lptr defined in line 328; used 4 times

- in line 77, 292
- in /usr/src/ucb/PORT/pascal/src/pclval.c line 73, 359

lvalue defined in line 31; used 14 times

- in /usr/src/ucb/PORT/pascal/src/0.h line 760
- in /usr/src/ucb/PORT/pascal/src/call.c line 223
- in /usr/src/ucb/PORT/pascal/src/forop.c line 161, 288, 334
- in /usr/src/ucb/PORT/pascal/src/pcproc.c line 1003, 1081
- in /usr/src/ucb/PORT/pascal/src/rval.c line 185
- in /usr/src/ucb/PORT/pascal/src/stat.c line 261, 366, 383, 407, 527
- in /usr/src/ucb/PORT/pascal/src/stklval.c line 33

putcbnds defined in line 536; used 7 times

- in line 438-440(3)
- in /usr/src/ucb/PORT/pascal/src/call.c line 294
- in /usr/src/ucb/PORT/pascal/src/stat.c line 462-467(3)

#### Defined variables

sccsid defined in line 8; never used

Last modified: 1985-07-27 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1550 |