```   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

radix defined in line 246; used 1 times
ston defined in line 69; used 2 times

#### Defined macros

BIG defined in line 64; used 2 times
 Last modified: 1984-11-18 Generated: 2016-12-26 Generated by src2html V0.67 page hit count: 1251