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

##### Functions

    compat            X
    conv              X
    convert           X
    rangechk          X

       1: /*	@(#)conv.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: #ifdef PI
      13: #include "0.h"
      14: #include "opcode.h"
      15:
      16: #ifndef PI0
      17: /*
      18:  * Convert a p1 into a p2.
      19:  * Mostly used for different
      20:  * length integers and "to real" conversions.
      21:  */
      22: convert(p1, p2)
      23:     struct nl *p1, *p2;
      24: {
      25:     if (p1 == NIL || p2 == NIL)
      26:         return;
      27:     switch (width(p1) - width(p2)) {
      28:         case -7:
      29:         case -6:
      30:             put1(O_STOD);
      31:             return;
      32:         case -4:
      33:             put1(O_ITOD);
      34:             return;
      35:         case -3:
      36:         case -2:
      37:             put1(O_STOI);
      38:             return;
      39:         case -1:
      40:         case 0:
      41:         case 1:
      42:             return;
      43:         case 2:
      44:         case 3:
      45:             put1(O_ITOS);
      46:             return;
      47:         default:
      48:             panic("convert");
      49:     }
      50: }
      51: #endif
      52:
      53: /*
      54:  * Compat tells whether
      55:  * p1 and p2 are compatible
      56:  * types for an assignment like
      57:  * context, i.e. value parameters,
      58:  * indicies for 'in', etc.
      59:  */
      60: compat(p1, p2, t)
      61:     struct nl *p1, *p2;
      62: {
      63:     register c1, c2;
      64:
      65:     c1 = classify(p1);
      66:     if (c1 == NIL)
      67:         return (NIL);
      68:     c2 = classify(p2);
      69:     if (c2 == NIL)
      70:         return (NIL);
      71:     switch (c1) {
      72:         case TBOOL:
      73:         case TCHAR:
      74:             if (c1 == c2)
      75:                 return (1);
      76:             break;
      77:         case TINT:
      78:             if (c2 == TINT)
      79:                 return (1);
      80:         case TDOUBLE:
      81:             if (c2 == TDOUBLE)
      82:                 return (1);
      83: #ifndef PI0
      84:             if (c2 == TINT && divflg == 0) {
      85:                 divchk= 1;
      86:                 c1 = classify(rvalue(t, NLNIL));
      87:                 divchk = NIL;
      88:                 if (c1 == TINT) {
      89:                     error("Type clash: real is incompatible with integer");
      90:                     cerror("This resulted because you used '/' which always returns real rather");
      91:                     cerror("than 'div' which divides integers and returns integers");
      92:                     divflg = 1;
      93:                     return (NIL);
      94:                 }
      95:             }
      96: #endif
      97:             break;
      98:         case TSCAL:
      99:             if (c2 != TSCAL)
     100:                 break;
     101:             if (scalar(p1) != scalar(p2)) {
     102:                 derror("Type clash: non-identical scalar types");
     103:                 return (NIL);
     104:             }
     105:             return (1);
     106:         case TSTR:
     107:             if (c2 != TSTR)
     108:                 break;
     109:             if (width(p1) != width(p2)) {
     110:                 derror("Type clash: unequal length strings");
     111:                 return (NIL);
     112:             }
     113:             return (1);
     114:         case TNIL:
     115:             if (c2 != TPTR)
     116:                 break;
     117:             return (1);
     118:         case TFILE:
     119:             if (c1 != c2)
     120:                 break;
     121:             derror("Type clash: files not allowed in this context");
     122:             return (NIL);
     123:         default:
     124:             if (c1 != c2)
     125:                 break;
     126:             if (p1 != p2) {
     127:                 derror("Type clash: non-identical %s types", clnames[c1]);
     128:                 return (NIL);
     129:             }
     130:             if (p1->nl_flags & NFILES) {
     131:                 derror("Type clash: %ss with file components not allowed in this context", clnames[c1]);
     132:                 return (NIL);
     133:             }
     134:             return (1);
     135:     }
     136:     derror("Type clash: %s is incompatible with %s", clnames[c1], clnames[c2]);
     137:     return (NIL);
     138: }
     139:
     140: #ifndef PI0
     141: /*
     142:  * Rangechk generates code to
     143:  * check if the type p on top
     144:  * of the stack is in range for
     145:  * assignment to a variable
     146:  * of type q.
     147:  */
     148: rangechk(p, q)
     149:     struct nl *p, *q;
     150: {
     151:     register struct nl *rp;
     152:     register op;
     153:     int wq, wrp;
     154:
     155:     if (opt('t') == 0)
     156:         return;
     157:     rp = p;
     158:     if (rp == NIL)
     159:         return;
     160:     if (q == NIL)
     161:         return;
     162:     /*
     163: 	 * When op is 1 we are checking length
     164: 	 * 4 numbers against length 2 bounds,
     165: 	 * and adding it to the opcode forces
     166: 	 * generation of appropriate tests.
     167: 	 */
     168:     op = 0;
     169:     wq = width(q);
     170:     wrp = width(rp);
     171:     op = wq != wrp && (wq == 4 || wrp == 4);
     172:     if (rp->class == TYPE)
     173:         rp = rp->type;
     174:     switch (rp->class) {
     175:     case RANGE:
     176:         if (rp->range[0] != 0) {
     177: #ifndef DEBUG
     178:             if (wrp <= 2)
     179:                 put3(O_RANG2+op, ( short ) rp->range[0],
     180:                          ( short ) rp->range[1]);
     181:             else if (rp != nl+T4INT)
     182:                 put(5, O_RANG4+op, rp->range[0], rp->range[1] );
     183: #else
     184:             if (!hp21mx) {
     185:                 if (wrp <= 2)
     186:                     put3(O_RANG2+op,( short ) rp->range[0],
     187:                             ( short ) rp->range[1]);
     188:                 else if (rp != nl+T4INT)
     189:                     put(5,O_RANG4+op,rp->range[0],
     190:                              rp->range[1]);
     191:             } else
     192:                 if (rp != nl+T2INT && rp != nl+T4INT)
     193:                     put3(O_RANG2+op,( short ) rp->range[0],
     194:                             ( short ) rp->range[1]);
     195: #endif
     196:             break;
     197:         }
     198:         /*
     199: 		 * Range whose lower bounds are
     200: 		 * zero can be treated as scalars.
     201: 		 */
     202:     case SCAL:
     203:         if (wrp <= 2)
     204:             put2(O_RSNG2+op, ( short ) rp->range[1]);
     205:         else
     206:             put( 3 , O_RSNG4+op, rp->range[1]);
     207:         break;
     208:     default:
     209:         panic("rangechk");
     210:     }
     211: }
     212: #endif
     213: #endif
     214:
     215: #ifdef DEBUG
     216: conv(dub)
     217:     int *dub;
     218: {
     219:     int newfp[2];
     220:     double *dp = dub;
     221:     long *lp = dub;
     222:     register int exp;
     223:     long mant;
     224:
     225:     newfp[0] = dub[0] & 0100000;
     226:     newfp[1] = 0;
     227:     if (*dp == 0.0)
     228:         goto ret;
     229:     exp = ((dub[0] >> 7) & 0377) - 0200;
     230:     if (exp < 0) {
     231:         newfp[1] = 1;
     232:         exp = -exp;
     233:     }
     234:     if (exp > 63)
     235:         exp = 63;
     236:     dub[0] &= ~0177600;
     237:     dub[0] |= 0200;
     238:     mant = *lp;
     239:     mant <<= 8;
     240:     if (newfp[0])
     241:         mant = -mant;
     242:     newfp[0] |= (mant >> 17) & 077777;
     243:     newfp[1] |= (((int) (mant >> 1)) & 0177400) | (exp << 1);
     244: ret:
     245:     dub[0] = newfp[0];
     246:     dub[1] = newfp[1];
     247: }
     248: #endif

#### Defined functions

compat defined in line 60; never used
conv defined in line 216; used 1 times

- in /usr/src/ucb/pascal/pi/rval.c line 174

convert defined in line 22; used 12 times

- in /usr/src/ucb/pascal/pi/call.c line 80
- in /usr/src/ucb/pascal/pi/cset.c line 118, 125, 133
- in /usr/src/ucb/pascal/pi/func.c line 128, 145
- in /usr/src/ucb/pascal/pi/proc.c line 289, 312, 449, 635, 699
- in /usr/src/ucb/pascal/pi/rval.c line 479

rangechk defined in line 148; used 5 times

- in /usr/src/ucb/pascal/pi/call.c line 78
- in /usr/src/ucb/pascal/pi/proc.c line 451, 471
- in /usr/src/ucb/pascal/pi/stat.c line 284, 396

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