Return to cvnum.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / rt

Annotation of 43BSD/contrib/icon/rt/cvnum.c, revision 1.1

1.1     ! root        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:    }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.