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