4.3BSD - /usr/src/new/icon/rt/cvnum.c

   1: #include "../h/ctype.h"
   2: #include "../h/rt.h"
   3: #include <math.h>
   4: 
   5: /*
   6:  * cvnum - convert the value represented by d into a numeric quantity and
   7:  *  place the value into *result.  T_LONGINT is returned for integer and
   8:  *  long integer results; T_REAL for real results, and NULL is returned
   9:  *  if d can't be converted to a numeric quantity.
  10:  */
  11: 
  12: cvnum(d, result)
  13: register struct descrip *d;
  14: union numeric *result;
  15:    {
  16:    char sbuf[MAXSTRING];
  17:    extern char *cvstr();
  18: 
  19:    DeRef(*d)
  20: 
  21:    if (QUAL(*d)) {
  22:       /*
  23:        * d is a string.  Convert it into an integer by first converting
  24:        *  it into a C-style string and then converting that string into
  25:        *  an integer with ston.
  26:        */
  27:       qtos(d, sbuf);
  28:       return (ston(sbuf, result));
  29:       }
  30: 
  31:    switch (TYPE(*d)) {
  32:       case T_INTEGER:
  33:          /*
  34:           * d is already an integer.  Cast the value into a long.
  35:           */
  36:          result->integer = (long)INTVAL(*d);
  37:          return (T_LONGINT);
  38: #ifdef LONGS
  39:       case T_LONGINT:
  40:          /*
  41:           * d is a long integer.  Assign it to *i and return.
  42:           */
  43:          result->integer = BLKLOC(*d)->intval;
  44:          return (T_LONGINT);
  45: #endif LONGS
  46: 
  47:       case T_REAL:
  48:          /*
  49:           * d is a real number, return it.
  50:           */
  51:          result->real = BLKLOC(*d)->realblk.realval;
  52:          return (T_REAL);
  53:       default:
  54:          /*
  55:           * d is not already numeric, try to convert it to a string and
  56:           *  then try to convert the string to an integer.
  57:           */
  58:          if (cvstr(d, sbuf) == NULL)
  59:             return (NULL);
  60:          return (ston(STRLOC(*d), result));
  61:       }
  62:    }
  63: 
  64: #define BIG 72057594037927936.  /* numbers larger than 2^56 lose precision */
  65: 
  66: /*
  67:  * ston - convert a string to a numeric quantity if possible.
  68:  */
  69: static ston(s, result)
  70: register char *s;
  71: union numeric *result;
  72:    {
  73:    register int c;
  74:    int realflag = 0;    /* indicates a real number */
  75:    char msign = '+';    /* sign of mantissa */
  76:    char esign = '+';    /* sign of exponent */
  77:    double mantissa = 0; /* scaled mantissa with no fractional part */
  78:    int scale = 0;   /* number of decimal places to shift mantissa */
  79:    int digits = 0;  /* total number of digits seen */
  80:    int sdigits = 0; /* number of significant digits seen */
  81:    int exponent = 0;    /* exponent part of real number */
  82:    double fiveto;   /* holds 5^scale */
  83:    double power;    /* holds successive squares of 5 to compute fiveto */
  84:    extern int errno;
  85: 
  86:    c = *s++;
  87: 
  88:    /*
  89:     * Skip leading white space.
  90:     */
  91:    while (isspace(c))
  92:       c = *s++;
  93: 
  94:    /*
  95:     * Check for sign.
  96:     */
  97:    if (c == '+' || c == '-') {
  98:       msign = c;
  99:       c = *s++;
 100:       }
 101: 
 102:    /*
 103:     * Get integer part of mantissa.
 104:     */
 105:    while (isdigit(c)) {
 106:       digits++;
 107:       if (mantissa < BIG) {
 108:          mantissa = mantissa * 10 + (c - '0');
 109:          if (mantissa > 0.0)
 110:             sdigits++;
 111:          }
 112:       else
 113:          scale++;
 114:       c = *s++;
 115:       }
 116: 
 117:    /*
 118:     * Check for based integer.
 119:     */
 120:    if (c == 'r' || c == 'R')
 121:       return (radix(msign, (int)mantissa, s, result));
 122: 
 123:    /*
 124:     * Get fractional part of mantissa.
 125:     */
 126:    if (c == '.') {
 127:       realflag++;
 128:       c = *s++;
 129:       while (isdigit(c)) {
 130:          digits++;
 131:          if (mantissa < BIG) {
 132:             mantissa = mantissa * 10 + (c - '0');
 133:             scale--;
 134:             if (mantissa > 0.0)
 135:                sdigits++;
 136:             }
 137:          c = *s++;
 138:          }
 139:       }
 140: 
 141:    /*
 142:     * Check that at least one digit has been seen so far.
 143:     */
 144:    if (digits == 0)
 145:       return (NULL);
 146: 
 147:    /*
 148:     * Get exponent part.
 149:     */
 150:    if (c == 'e' || c == 'E') {
 151:       realflag++;
 152:       c = *s++;
 153:       if (c == '+' || c == '-') {
 154:          esign = c;
 155:          c = *s++;
 156:          }
 157:       if (!isdigit(c))
 158:          return (NULL);
 159:       while (isdigit(c)) {
 160:          exponent = exponent * 10 + (c - '0');
 161:          c = *s++;
 162:          }
 163:       scale += (esign == '+')? exponent : -exponent;
 164:       }
 165: 
 166:    /*
 167:     * Skip trailing white space.
 168:     */
 169:    while (isspace(c))
 170:       c = *s++;
 171: 
 172:    /*
 173:     * Check that entire string has been consumed.
 174:     */
 175:    if (c != '\0')
 176:       return (NULL);
 177: 
 178:    /*
 179:     * Test for integer.
 180:     */
 181:    if (!realflag && mantissa >= MINLONG && mantissa <= MAXLONG) {
 182:       result->integer = (msign == '+')? mantissa : -mantissa;
 183:       return (T_LONGINT);
 184:       }
 185: 
 186:    /*
 187:     * Rough tests for overflow and underflow.
 188:     */
 189:    if (sdigits + scale > LGHUGE)
 190:       return (NULL);
 191: 
 192:    if (sdigits + scale < -LGHUGE) {
 193:       result->real = 0.0;
 194:       return (T_REAL);
 195:       }
 196: 
 197:    /*
 198:     * Put the number together by multiplying the mantissa by 5^scale and
 199:     *  then using ldexp() to multiply by 2^scale.
 200:     */
 201: 
 202: #ifdef PDP11
 203:    /*
 204:     * Load floating point status register on PDP-11.
 205:     */
 206:    ldfps(0200);
 207: #endif PDP11
 208:    exponent = (scale > 0)? scale : -scale;
 209:    fiveto = 1.0;
 210:    power = 5.0;
 211:    for (;;) {
 212:       if (exponent & 01)
 213:          fiveto *= power;
 214:       exponent >>= 1;
 215:       if (exponent == 0)
 216:          break;
 217:       power *= power;
 218:       }
 219:    if (scale > 0)
 220:       mantissa *= fiveto;
 221:    else
 222:       mantissa /= fiveto;
 223: 
 224:    errno = 0;
 225:    mantissa = ldexp(mantissa, scale);
 226: #ifdef PDP11
 227:    /*
 228:     * Load floating point status register on PDP-11
 229:     */
 230:    ldfps(03200);
 231: #endif PDP11
 232:    if (errno > 0 && mantissa > 0)
 233:       /*
 234:        * ldexp caused overflow.
 235:        */
 236:       return (NULL);
 237: 
 238:    result->real = (msign == '+')? mantissa : -mantissa;
 239:    return (T_REAL);
 240:    }
 241: 
 242: /*
 243:  * radix - convert string s in radix r into an integer in *result.  sign
 244:  *  will be either '+' or '-'.
 245:  */
 246: static radix(sign, r, s, result)
 247: char sign;
 248: register int r;
 249: register char *s;
 250: union numeric *result;
 251:    {
 252:    register int c;
 253:    long num;
 254: 
 255:    if (r < 2 || r > 36)
 256:       return (NULL);
 257: 
 258:    c = *s++;
 259:    num = 0L;
 260:    while (isalnum(c)) {
 261:       c = tonum(c);
 262:       if (c >= r)
 263:          return (NULL);
 264:       num = num * r + c;
 265:       c = *s++;
 266:       }
 267: 
 268:    while (isspace(c))
 269:       c = *s++;
 270: 
 271:    if (c != '\0')
 272:       return (NULL);
 273: 
 274:    result->integer = (sign == '+')? num : -num;
 275:    return (T_LONGINT);
 276:    }

Defined functions

Defined macros