2.9BSD - /usr/src/ucb/pascal/pi/var.c

   1: /*	@(#)var.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: /*
  17:  * Declare variables of a var part.  DPOFF1 is
  18:  * the local variable storage for all prog/proc/func
  19:  * modules aside from the block mark.  The total size
  20:  * of all the local variables is entered into the
  21:  * size array.
  22:  */
  23: varbeg()
  24: {
  25: 
  26: #ifndef PI1
  27:     if (parts & VPRT)
  28:         error("All variables must be declared in one var part");
  29:     parts |= VPRT;
  30: #endif
  31: #ifndef PI0
  32:     sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1;
  33: #endif
  34:     forechain = NIL;
  35: #ifdef PI0
  36:     send(REVVBEG);
  37: #endif
  38: }
  39: 
  40: var(vline, vidl, vtype)
  41: #ifdef PI0
  42:     int vline, *vidl, *vtype;
  43: {
  44:     register struct nl *np;
  45:     register int *vl;
  46: 
  47:     np = gtype(vtype);
  48:     line = vline;
  49:     for (vl = vidl; vl != NIL; vl = vl[2])
  50:         enter(defnl(vl[1], VAR, np, 0));
  51:     send(REVVAR, vline, vidl, vtype);
  52: #else
  53:     int vline;
  54:     register int *vidl;
  55:     int *vtype;
  56: {
  57:     register struct nl *np;
  58:     register struct om *op;
  59:     long w;
  60:     int o2;
  61: 
  62:     np = gtype(vtype);
  63:     line = vline;
  64:     w = (lwidth(np) + 1) &~ 1;
  65:     op = &sizes[cbn];
  66:     for (; vidl != NIL; vidl = vidl[2]) {
  67:         op->om_off -= w;
  68:         o2 = op->om_off;
  69:         enter(defnl(vidl[1], VAR, np, o2));
  70:     }
  71: #endif
  72: }
  73: 
  74: varend()
  75: {
  76: 
  77:     foredecl();
  78: #ifndef PI0
  79:     sizes[cbn].om_max = sizes[cbn].om_off;
  80: #else
  81:     send(REVVEND);
  82: #endif
  83: }
  84: 
  85: /*
  86:  * Evening
  87:  */
  88: even(w)
  89:     register int w;
  90: {
  91:     if (w < 0)
  92:         return (w & ~1);
  93:     return ((w+1) & ~1);
  94: }
  95: 
  96: /*
  97:  * Find the width of a type in bytes.
  98:  */
  99: width(np)
 100:     struct nl *np;
 101: {
 102: 
 103:     return (lwidth(np));
 104: }
 105: 
 106: long lwidth(np)
 107:     struct nl *np;
 108: {
 109:     register struct nl *p;
 110:     long w;
 111: 
 112:     p = np;
 113:     if (p == NIL)
 114:         return (0);
 115: loop:
 116:     switch (p->class) {
 117:         case TYPE:
 118:             switch (nloff(p)) {
 119:                 case TNIL:
 120:                     return (2);
 121:                 case TSTR:
 122:                 case TSET:
 123:                     panic("width");
 124:                 default:
 125:                     p = p->type;
 126:                     goto loop;
 127:             }
 128:         case ARRAY:
 129:             return (aryconst(p, 0));
 130:         case PTR:
 131:         case FILET:
 132:             return ( sizeof ( int * ) );
 133:         case RANGE:
 134:             if (p->type == nl+TDOUBLE)
 135: #ifdef DEBUG
 136:                 return (hp21mx ? 4 : 8);
 137: #else
 138:                 return (8);
 139: #endif
 140:         case SCAL:
 141:             return (bytes(p->range[0], p->range[1]));
 142:         case SET:
 143:             setran(p->type);
 144:             return ( (set.uprbp>>3) + 1);
 145:         case STR:
 146:         case RECORD:
 147:             return ( p->value[NL_OFFS] );
 148:         default:
 149:             panic("wclass");
 150:     }
 151: }
 152: 
 153: /*
 154:  * Return the width of an element
 155:  * of a n time subscripted np.
 156:  */
 157: long aryconst(np, n)
 158:     struct nl *np;
 159:     int n;
 160: {
 161:     register struct nl *p;
 162:     long s, d;
 163: 
 164:     if ((p = np) == NIL)
 165:         return (NIL);
 166:     if (p->class != ARRAY)
 167:         panic("ary");
 168:     s = width(p->type);
 169:     /*
 170: 	 * Arrays of anything but characters are word aligned.
 171: 	 */
 172:     if (s & 1)
 173:         if (s != 1)
 174:             s++;
 175:     /*
 176: 	 * Skip the first n subscripts
 177: 	 */
 178:     while (n >= 0) {
 179:         p = p->chain;
 180:         n--;
 181:     }
 182:     /*
 183: 	 * Sum across remaining subscripts.
 184: 	 */
 185:     while (p != NIL) {
 186:         if (p->class != RANGE && p->class != SCAL)
 187:             panic("aryran");
 188:         d = p->range[1] - p->range[0] + 1;
 189:         s *= d;
 190:         p = p->chain;
 191:     }
 192:     return (s);
 193: }
 194: 
 195: /*
 196:  * Find the lower bound of a set, and also its size in bits.
 197:  */
 198: setran(q)
 199:     struct nl *q;
 200: {
 201:     register lb, ub;
 202:     register struct nl *p;
 203: 
 204:     p = q;
 205:     if (p == NIL)
 206:         return (NIL);
 207:     lb = p->range[0];
 208:     ub = p->range[1];
 209:     if (p->class != RANGE && p->class != SCAL)
 210:         panic("setran");
 211:     set.lwrb = lb;
 212:     /* set.(upperbound prime) = number of bits - 1; */
 213:     set.uprbp = ub-lb;
 214: }
 215: 
 216: /*
 217:  * Return the number of bytes required to hold an arithmetic quantity
 218:  */
 219: bytes(lb, ub)
 220:     long lb, ub;
 221: {
 222: 
 223: #ifndef DEBUG
 224:     if (lb < -32768 || ub > 32767)
 225:         return (4);
 226:     else if (lb < -128 || ub > 127)
 227:         return (2);
 228: #else
 229:     if (!hp21mx && (lb < -32768 || ub > 32767))
 230:         return (4);
 231:     if (lb < -128 || ub > 127)
 232:         return (2);
 233: #endif
 234:     else
 235:         return (1);
 236: }

Defined functions