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

##### Functions

    arycod            X
    lptr              X
    lvalue            X

       1: /*	@(#)lval.c	2.2	SCCS id keyword	*/
       2: /* Copyright (c) 1979 Regents of the University of California */
       3: #
       4: /*
       5:  * pi - Pascal interpreter code translator
       6:  *
       7:  * Charles Haley, Bill Joy UCB
       8:  * Version 1.2 November 1978
       9:  */
      10:
      11: #include "whoami"
      12: #include "0.h"
      13: #include "tree.h"
      14: #include "opcode.h"
      15:
      16: extern  int flagwas;
      17: /*
      18:  * Lvalue computes the address
      19:  * of a qualified name and
      20:  * leaves it on the stack.
      21:  */
      22: struct nl *
      23: lvalue(r, modflag)
      24:     int *r, modflag;
      25: {
      26:     register struct nl *p;
      27:     struct nl *firstp, *lastp;
      28:     register *c, *co;
      29:     int f, o;
      30:     /*
      31: 	 * Note that the local optimizations
      32: 	 * done here for offsets would more
      33: 	 * appropriately be done in put.
      34: 	 */
      35:     int tr[2], trp[3];
      36:
      37:     if (r == NIL)
      38:         return (NIL);
      39:     if (nowexp(r))
      40:         return (NIL);
      41:     if (r[0] != T_VAR) {
      42:         error("Variable required"); /* Pass mesgs down from pt of call ? */
      43:         return (NIL);
      44:     }
      45:     firstp = p = lookup(r[2]);
      46:     if (p == NIL)
      47:         return (NIL);
      48:     c = r[3];
      49:     if ((modflag & NOUSE) && !lptr(c))
      50:         p->nl_flags = flagwas;
      51:     if (modflag & MOD)
      52:         p->nl_flags |= NMOD;
      53:     /*
      54: 	 * Only possibilities for p->class here
      55: 	 * are the named classes, i.e. CONST, TYPE
      56: 	 * VAR, PROC, FUNC, REF, or a WITHPTR.
      57: 	 */
      58:     switch (p->class) {
      59:         case WITHPTR:
      60:             /*
      61: 			 * Construct the tree implied by
      62: 			 * the with statement
      63: 			 */
      64:             trp[0] = T_LISTPP;
      65:             trp[1] = tr;
      66:             trp[2] = r[3];
      67:             tr[0] = T_FIELD;
      68:             tr[1] = r[2];
      69:             c = trp;
      70:         case REF:
      71:             /*
      72: 			 * Obtain the indirect word
      73: 			 * of the WITHPTR or REF
      74: 			 * as the base of our lvalue
      75: 			 */
      76: #ifdef  VAX
      77:             put2 ( O_RV4 | bn << 9 , p->value[0] );
      78: #else
      79:             put2(O_RV2 | bn << 9, p->value[0]);
      80: #endif
      81:             f = 0;      /* have an lv on stack */
      82:             o = 0;
      83:             break;
      84:         case VAR:
      85:             f = 1;      /* no lv on stack yet */
      86:             o = p->value[0];
      87:             break;
      88:         default:
      89:             error("%s %s found where variable required", classes[p->class], p->symbol);
      90:             return (NIL);
      91:     }
      92:     /*
      93: 	 * Loop and handle each
      94: 	 * qualification on the name
      95: 	 */
      96:     if (c == NIL && (modflag&ASGN) && p->value[NL_FORV]) {
      97:         error("Can't modify the for variable %s in the range of the loop", p->symbol);
      98:         return (NIL);
      99:     }
     100:     for (; c != NIL; c = c[2]) {
     101:         co = c[1];
     102:         if (co == NIL)
     103:             return (NIL);
     104:         lastp = p;
     105:         p = p->type;
     106:         if (p == NIL)
     107:             return (NIL);
     108:         switch (co[0]) {
     109:             case T_PTR:
     110:                 /*
     111: 				 * Pointer qualification.
     112: 				 */
     113:                 lastp->nl_flags |= NUSED;
     114:                 if (p->class != PTR && p->class != FILET) {
     115:                     error("^ allowed only on files and pointers, not on %ss", nameof(p));
     116:                     goto bad;
     117:                 }
     118:                 if (f)
     119: #ifdef  VAX
     120:                     put2 ( O_RV4 | bn << 9 , o );
     121: #else
     122:                     put2(O_RV2 | bn<<9, o);
     123: #endif
     124:                 else {
     125:                     if (o)
     126:                         put2(O_OFF, o);
     127: #ifdef  VAX
     128:                     put1 ( O_IND4 );
     129: #else
     130:                     put1(O_IND2);
     131: #endif
     132:                 }
     133:                 /*
     134: 				 * Pointer cannot be
     135: 				 * nil and file cannot
     136: 				 * be at end-of-file.
     137: 				 */
     138:                 put1(p->class == FILET ? O_FNIL : O_NIL);
     139:                 f = o = 0;
     140:                 continue;
     141:             case T_ARGL:
     142:                 if (p->class != ARRAY) {
     143:                     if (lastp == firstp)
     144:                         error("%s is a %s, not a function", r[2], classes[firstp->class]);
     145:                     else
     146:                         error("Illegal function qualificiation");
     147:                     return (NIL);
     148:                 }
     149:                 recovered();
     150:                 error("Pascal uses [] for subscripting, not ()");
     151:             case T_ARY:
     152:                 if (p->class != ARRAY) {
     153:                     error("Subscripting allowed only on arrays, not on %ss", nameof(p));
     154:                     goto bad;
     155:                 }
     156:                 if (f)
     157:                     put2(O_LV | bn<<9, o);
     158:                 else if (o)
     159:                     put2(O_OFF, o);
     160:                 switch (arycod(p, co[1])) {
     161:                     case 0:
     162:                         return (NIL);
     163:                     case -1:
     164:                         goto bad;
     165:                 }
     166:                 f = o = 0;
     167:                 continue;
     168:             case T_FIELD:
     169:                 /*
     170: 				 * Field names are just
     171: 				 * an offset with some
     172: 				 * semantic checking.
     173: 				 */
     174:                 if (p->class != RECORD) {
     175:                     error(". allowed only on records, not on %ss", nameof(p));
     176:                     goto bad;
     177:                 }
     178:                 if (co[1] == NIL)
     179:                     return (NIL);
     180:                 p = reclook(p, co[1]);
     181:                 if (p == NIL) {
     182:                     error("%s is not a field in this record", co[1]);
     183:                     goto bad;
     184:                 }
     185:                 if (modflag & MOD)
     186:                     p->nl_flags |= NMOD;
     187:                 if ((modflag & NOUSE) == 0 || lptr(c[2]))
     188:                     p->nl_flags |= NUSED;
     189:                 o += p->value[0];
     190:                 continue;
     191:             default:
     192:                 panic("lval2");
     193:         }
     194:     }
     195:     if (f)
     196:         put2(O_LV | bn<<9, o);
     197:     else if (o)
     198:         put2(O_OFF, o);
     199:     return (p->type);
     200: bad:
     201:     cerror("Error occurred on qualification of %s", r[2]);
     202:     return (NIL);
     203: }
     204:
     205: lptr(c)
     206:     register int *c;
     207: {
     208:     register int *co;
     209:
     210:     for (; c != NIL; c = c[2]) {
     211:         co = c[1];
     212:         if (co == NIL)
     213:             return (NIL);
     214:         switch (co[0]) {
     215:
     216:         case T_PTR:
     217:             return (1);
     218:         case T_ARGL:
     219:             return (0);
     220:         case T_ARY:
     221:         case T_FIELD:
     222:             continue;
     223:         default:
     224:             panic("lptr");
     225:         }
     226:     }
     227:     return (0);
     228: }
     229:
     230: /*
     231:  * Arycod does the
     232:  * code generation
     233:  * for subscripting.
     234:  */
     235: arycod(np, el)
     236:     struct nl *np;
     237:     int *el;
     238: {
     239:     register struct nl *p, *ap;
     240:     int i, d, v, v1;
     241:     int w;
     242:
     243:     p = np;
     244:     if (el == NIL)
     245:         return (0);
     246:     d = p->value[0];
     247:     /*
     248: 	 * Check each subscript
     249: 	 */
     250:     for (i = 1; i <= d; i++) {
     251:         if (el == NIL) {
     252:             error("Too few subscripts (%d given, %d required)", i-1, d);
     253:             return (-1);
     254:         }
     255:         p = p->chain;
     256:         ap = rvalue(el[1], NLNIL);
     257:         if (ap == NIL)
     258:             return (0);
     259:         if (incompat(ap, p->type, el[1])) {
     260:             cerror("Array index type incompatible with declared index type");
     261:             if (d != 1)
     262:                 cerror("Error occurred on index number %d", i);
     263:             return (-1);
     264:         }
     265:         w = aryconst(np, i);
     266:         if (opt('t') == 0)
     267:             switch (w) {
     268:             case 8:
     269:                 w = 6;
     270:             case 4:
     271:             case 2:
     272:             case 1:
     273:                 put2((width(ap) != 4 ? O_INX2P2 : O_INX4P2) | (w & ~1) << 7, ( short ) p->range[0]);
     274:                 el = el[2];
     275:                 continue;
     276:             }
     277:         put(4, width(ap) != 4 ? O_INX2 : O_INX4,w,( short ) p->range[0],
     278:                ( short ) ( p->range[1] - p->range[0] ) );
     279:         el = el[2];
     280:     }
     281:     if (el != NIL) {
     282:         do {
     283:             el = el[2];
     284:             i++;
     285:         } while (el != NIL);
     286:         error("Too many subscripts (%d given, %d required)", i-1, d);
     287:         return (-1);
     288:     }
     289:     return (1);
     290: }

#### Defined functions

arycod defined in line 235; used 1 times

- in line 160

lptr defined in line 205; used 2 times

- in line 49, 187

lvalue defined in line 22; used 15 times

- in /usr/src/ucb/pascal/pi/0.h line 635
- in /usr/src/ucb/pascal/pi/call.c line 58
- in /usr/src/ucb/pascal/pi/proc.c line 428, 516, 553, 604, 637, 684, 743, 750
- in /usr/src/ucb/pascal/pi/rval.c line 107
- in /usr/src/ucb/pascal/pi/stat.c line 181, 266, 382, 392

Last modified: 1981-07-10 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 654 |