![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to cvnum.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / icon / rt|
Return to cvnum.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / icon / rt |
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.