gethex.c revision 1.1.1.2 1 1.1 kleink /****************************************************************
2 1.1 kleink
3 1.1 kleink The author of this software is David M. Gay.
4 1.1 kleink
5 1.1 kleink Copyright (C) 1998 by Lucent Technologies
6 1.1 kleink All Rights Reserved
7 1.1 kleink
8 1.1 kleink Permission to use, copy, modify, and distribute this software and
9 1.1 kleink its documentation for any purpose and without fee is hereby
10 1.1 kleink granted, provided that the above copyright notice appear in all
11 1.1 kleink copies and that both that the copyright notice and this
12 1.1 kleink permission notice and warranty disclaimer appear in supporting
13 1.1 kleink documentation, and that the name of Lucent or any of its entities
14 1.1 kleink not be used in advertising or publicity pertaining to
15 1.1 kleink distribution of the software without specific, written prior
16 1.1 kleink permission.
17 1.1 kleink
18 1.1 kleink LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
19 1.1 kleink INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
20 1.1 kleink IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
21 1.1 kleink SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
22 1.1 kleink WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
23 1.1 kleink IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
24 1.1 kleink ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
25 1.1 kleink THIS SOFTWARE.
26 1.1 kleink
27 1.1 kleink ****************************************************************/
28 1.1 kleink
29 1.1 kleink /* Please send bug reports to David M. Gay (dmg at acm dot org,
30 1.1 kleink * with " at " changed at "@" and " dot " changed to "."). */
31 1.1 kleink
32 1.1 kleink #include "gdtoaimp.h"
33 1.1 kleink
34 1.1 kleink #ifdef USE_LOCALE
35 1.1 kleink #include "locale.h"
36 1.1 kleink #endif
37 1.1 kleink
38 1.1 kleink int
39 1.1 kleink #ifdef KR_headers
40 1.1 kleink gethex(sp, fpi, exp, bp, sign)
41 1.1 kleink CONST char **sp; FPI *fpi; Long *exp; Bigint **bp; int sign;
42 1.1 kleink #else
43 1.1 kleink gethex( CONST char **sp, FPI *fpi, Long *exp, Bigint **bp, int sign)
44 1.1 kleink #endif
45 1.1 kleink {
46 1.1 kleink Bigint *b;
47 1.1 kleink CONST unsigned char *decpt, *s0, *s, *s1;
48 1.1.1.2 christos int big, esign, havedig, irv, j, k, n, n0, nbits, up, zret;
49 1.1 kleink ULong L, lostbits, *x;
50 1.1 kleink Long e, e1;
51 1.1 kleink #ifdef USE_LOCALE
52 1.1.1.2 christos int i;
53 1.1.1.2 christos #ifdef NO_LOCALE_CACHE
54 1.1.1.2 christos const unsigned char *decimalpoint = (unsigned char*)localeconv()->decimal_point;
55 1.1 kleink #else
56 1.1.1.2 christos const unsigned char *decimalpoint;
57 1.1.1.2 christos static unsigned char *decimalpoint_cache;
58 1.1.1.2 christos if (!(s0 = decimalpoint_cache)) {
59 1.1.1.2 christos s0 = (unsigned char*)localeconv()->decimal_point;
60 1.1.1.2 christos if ((decimalpoint_cache = (char*)MALLOC(strlen(s0) + 1))) {
61 1.1.1.2 christos strcpy(decimalpoint_cache, s0);
62 1.1.1.2 christos s0 = decimalpoint_cache;
63 1.1.1.2 christos }
64 1.1.1.2 christos }
65 1.1.1.2 christos decimalpoint = s0;
66 1.1.1.2 christos #endif
67 1.1 kleink #endif
68 1.1 kleink
69 1.1 kleink if (!hexdig['0'])
70 1.1 kleink hexdig_init_D2A();
71 1.1.1.2 christos *bp = 0;
72 1.1 kleink havedig = 0;
73 1.1 kleink s0 = *(CONST unsigned char **)sp + 2;
74 1.1 kleink while(s0[havedig] == '0')
75 1.1 kleink havedig++;
76 1.1 kleink s0 += havedig;
77 1.1 kleink s = s0;
78 1.1 kleink decpt = 0;
79 1.1 kleink zret = 0;
80 1.1 kleink e = 0;
81 1.1.1.2 christos if (hexdig[*s])
82 1.1.1.2 christos havedig++;
83 1.1.1.2 christos else {
84 1.1 kleink zret = 1;
85 1.1.1.2 christos #ifdef USE_LOCALE
86 1.1.1.2 christos for(i = 0; decimalpoint[i]; ++i) {
87 1.1.1.2 christos if (s[i] != decimalpoint[i])
88 1.1.1.2 christos goto pcheck;
89 1.1.1.2 christos }
90 1.1.1.2 christos decpt = s += i;
91 1.1.1.2 christos #else
92 1.1.1.2 christos if (*s != '.')
93 1.1 kleink goto pcheck;
94 1.1 kleink decpt = ++s;
95 1.1.1.2 christos #endif
96 1.1 kleink if (!hexdig[*s])
97 1.1 kleink goto pcheck;
98 1.1 kleink while(*s == '0')
99 1.1 kleink s++;
100 1.1 kleink if (hexdig[*s])
101 1.1 kleink zret = 0;
102 1.1 kleink havedig = 1;
103 1.1 kleink s0 = s;
104 1.1 kleink }
105 1.1 kleink while(hexdig[*s])
106 1.1 kleink s++;
107 1.1.1.2 christos #ifdef USE_LOCALE
108 1.1.1.2 christos if (*s == *decimalpoint && !decpt) {
109 1.1.1.2 christos for(i = 1; decimalpoint[i]; ++i) {
110 1.1.1.2 christos if (s[i] != decimalpoint[i])
111 1.1.1.2 christos goto pcheck;
112 1.1.1.2 christos }
113 1.1.1.2 christos decpt = s += i;
114 1.1.1.2 christos #else
115 1.1.1.2 christos if (*s == '.' && !decpt) {
116 1.1 kleink decpt = ++s;
117 1.1.1.2 christos #endif
118 1.1 kleink while(hexdig[*s])
119 1.1 kleink s++;
120 1.1.1.2 christos }/*}*/
121 1.1 kleink if (decpt)
122 1.1 kleink e = -(((Long)(s-decpt)) << 2);
123 1.1 kleink pcheck:
124 1.1 kleink s1 = s;
125 1.1.1.2 christos big = esign = 0;
126 1.1 kleink switch(*s) {
127 1.1 kleink case 'p':
128 1.1 kleink case 'P':
129 1.1 kleink switch(*++s) {
130 1.1 kleink case '-':
131 1.1 kleink esign = 1;
132 1.1 kleink /* no break */
133 1.1 kleink case '+':
134 1.1 kleink s++;
135 1.1 kleink }
136 1.1 kleink if ((n = hexdig[*s]) == 0 || n > 0x19) {
137 1.1 kleink s = s1;
138 1.1 kleink break;
139 1.1 kleink }
140 1.1 kleink e1 = n - 0x10;
141 1.1.1.2 christos while((n = hexdig[*++s]) !=0 && n <= 0x19) {
142 1.1.1.2 christos if (e1 & 0xf8000000)
143 1.1.1.2 christos big = 1;
144 1.1 kleink e1 = 10*e1 + n - 0x10;
145 1.1.1.2 christos }
146 1.1 kleink if (esign)
147 1.1 kleink e1 = -e1;
148 1.1 kleink e += e1;
149 1.1 kleink }
150 1.1 kleink *sp = (char*)s;
151 1.1.1.2 christos if (!havedig)
152 1.1.1.2 christos *sp = (char*)s0 - 1;
153 1.1 kleink if (zret)
154 1.1.1.2 christos return STRTOG_Zero;
155 1.1.1.2 christos if (big) {
156 1.1.1.2 christos if (esign) {
157 1.1.1.2 christos switch(fpi->rounding) {
158 1.1.1.2 christos case FPI_Round_up:
159 1.1.1.2 christos if (sign)
160 1.1.1.2 christos break;
161 1.1.1.2 christos goto ret_tiny;
162 1.1.1.2 christos case FPI_Round_down:
163 1.1.1.2 christos if (!sign)
164 1.1.1.2 christos break;
165 1.1.1.2 christos goto ret_tiny;
166 1.1.1.2 christos }
167 1.1.1.2 christos goto retz;
168 1.1.1.2 christos ret_tiny:
169 1.1.1.2 christos b = Balloc(0);
170 1.1.1.2 christos b->wds = 1;
171 1.1.1.2 christos b->x[0] = 1;
172 1.1.1.2 christos goto dret;
173 1.1.1.2 christos }
174 1.1.1.2 christos switch(fpi->rounding) {
175 1.1.1.2 christos case FPI_Round_near:
176 1.1.1.2 christos goto ovfl1;
177 1.1.1.2 christos case FPI_Round_up:
178 1.1.1.2 christos if (!sign)
179 1.1.1.2 christos goto ovfl1;
180 1.1.1.2 christos goto ret_big;
181 1.1.1.2 christos case FPI_Round_down:
182 1.1.1.2 christos if (sign)
183 1.1.1.2 christos goto ovfl1;
184 1.1.1.2 christos goto ret_big;
185 1.1.1.2 christos }
186 1.1.1.2 christos ret_big:
187 1.1.1.2 christos nbits = fpi->nbits;
188 1.1.1.2 christos n0 = n = nbits >> kshift;
189 1.1.1.2 christos if (nbits & kmask)
190 1.1.1.2 christos ++n;
191 1.1.1.2 christos for(j = n, k = 0; j >>= 1; ++k);
192 1.1.1.2 christos *bp = b = Balloc(k);
193 1.1.1.2 christos b->wds = n;
194 1.1.1.2 christos for(j = 0; j < n0; ++j)
195 1.1.1.2 christos b->x[j] = ALL_ON;
196 1.1.1.2 christos if (n > n0)
197 1.1.1.2 christos b->x[j] = ULbits >> (ULbits - (nbits & kmask));
198 1.1.1.2 christos *exp = fpi->emin;
199 1.1.1.2 christos return STRTOG_Normal | STRTOG_Inexlo;
200 1.1.1.2 christos }
201 1.1 kleink n = s1 - s0 - 1;
202 1.1.1.2 christos for(k = 0; n > (1 << (kshift-2)) - 1; n >>= 1)
203 1.1 kleink k++;
204 1.1 kleink b = Balloc(k);
205 1.1 kleink x = b->x;
206 1.1 kleink n = 0;
207 1.1 kleink L = 0;
208 1.1.1.2 christos #ifdef USE_LOCALE
209 1.1.1.2 christos for(i = 0; decimalpoint[i+1]; ++i);
210 1.1.1.2 christos #endif
211 1.1 kleink while(s1 > s0) {
212 1.1.1.2 christos #ifdef USE_LOCALE
213 1.1.1.2 christos if (*--s1 == decimalpoint[i]) {
214 1.1.1.2 christos s1 -= i;
215 1.1 kleink continue;
216 1.1.1.2 christos }
217 1.1.1.2 christos #else
218 1.1.1.2 christos if (*--s1 == '.')
219 1.1.1.2 christos continue;
220 1.1.1.2 christos #endif
221 1.1.1.2 christos if (n == ULbits) {
222 1.1 kleink *x++ = L;
223 1.1 kleink L = 0;
224 1.1 kleink n = 0;
225 1.1 kleink }
226 1.1 kleink L |= (hexdig[*s1] & 0x0f) << n;
227 1.1 kleink n += 4;
228 1.1 kleink }
229 1.1 kleink *x++ = L;
230 1.1 kleink b->wds = n = x - b->x;
231 1.1.1.2 christos n = ULbits*n - hi0bits(L);
232 1.1 kleink nbits = fpi->nbits;
233 1.1 kleink lostbits = 0;
234 1.1 kleink x = b->x;
235 1.1 kleink if (n > nbits) {
236 1.1 kleink n -= nbits;
237 1.1 kleink if (any_on(b,n)) {
238 1.1 kleink lostbits = 1;
239 1.1 kleink k = n - 1;
240 1.1 kleink if (x[k>>kshift] & 1 << (k & kmask)) {
241 1.1 kleink lostbits = 2;
242 1.1.1.2 christos if (k > 0 && any_on(b,k))
243 1.1 kleink lostbits = 3;
244 1.1 kleink }
245 1.1 kleink }
246 1.1 kleink rshift(b, n);
247 1.1 kleink e += n;
248 1.1 kleink }
249 1.1 kleink else if (n < nbits) {
250 1.1 kleink n = nbits - n;
251 1.1 kleink b = lshift(b, n);
252 1.1 kleink e -= n;
253 1.1 kleink x = b->x;
254 1.1 kleink }
255 1.1 kleink if (e > fpi->emax) {
256 1.1 kleink ovfl:
257 1.1 kleink Bfree(b);
258 1.1.1.2 christos ovfl1:
259 1.1.1.2 christos #ifndef NO_ERRNO
260 1.1.1.2 christos errno = ERANGE;
261 1.1.1.2 christos #endif
262 1.1 kleink return STRTOG_Infinite | STRTOG_Overflow | STRTOG_Inexhi;
263 1.1 kleink }
264 1.1 kleink irv = STRTOG_Normal;
265 1.1 kleink if (e < fpi->emin) {
266 1.1 kleink irv = STRTOG_Denormal;
267 1.1 kleink n = fpi->emin - e;
268 1.1 kleink if (n >= nbits) {
269 1.1 kleink switch (fpi->rounding) {
270 1.1 kleink case FPI_Round_near:
271 1.1 kleink if (n == nbits && (n < 2 || any_on(b,n-1)))
272 1.1 kleink goto one_bit;
273 1.1 kleink break;
274 1.1 kleink case FPI_Round_up:
275 1.1 kleink if (!sign)
276 1.1 kleink goto one_bit;
277 1.1 kleink break;
278 1.1 kleink case FPI_Round_down:
279 1.1 kleink if (sign) {
280 1.1 kleink one_bit:
281 1.1 kleink x[0] = b->wds = 1;
282 1.1.1.2 christos dret:
283 1.1 kleink *bp = b;
284 1.1.1.2 christos *exp = fpi->emin;
285 1.1.1.2 christos #ifndef NO_ERRNO
286 1.1.1.2 christos errno = ERANGE;
287 1.1.1.2 christos #endif
288 1.1 kleink return STRTOG_Denormal | STRTOG_Inexhi
289 1.1 kleink | STRTOG_Underflow;
290 1.1 kleink }
291 1.1 kleink }
292 1.1 kleink Bfree(b);
293 1.1.1.2 christos retz:
294 1.1.1.2 christos #ifndef NO_ERRNO
295 1.1.1.2 christos errno = ERANGE;
296 1.1.1.2 christos #endif
297 1.1 kleink return STRTOG_Zero | STRTOG_Inexlo | STRTOG_Underflow;
298 1.1 kleink }
299 1.1 kleink k = n - 1;
300 1.1 kleink if (lostbits)
301 1.1 kleink lostbits = 1;
302 1.1 kleink else if (k > 0)
303 1.1 kleink lostbits = any_on(b,k);
304 1.1 kleink if (x[k>>kshift] & 1 << (k & kmask))
305 1.1 kleink lostbits |= 2;
306 1.1 kleink nbits -= n;
307 1.1 kleink rshift(b,n);
308 1.1 kleink e = fpi->emin;
309 1.1 kleink }
310 1.1 kleink if (lostbits) {
311 1.1 kleink up = 0;
312 1.1 kleink switch(fpi->rounding) {
313 1.1 kleink case FPI_Round_zero:
314 1.1 kleink break;
315 1.1 kleink case FPI_Round_near:
316 1.1 kleink if (lostbits & 2
317 1.1.1.2 christos && (lostbits | x[0]) & 1)
318 1.1 kleink up = 1;
319 1.1 kleink break;
320 1.1 kleink case FPI_Round_up:
321 1.1 kleink up = 1 - sign;
322 1.1 kleink break;
323 1.1 kleink case FPI_Round_down:
324 1.1 kleink up = sign;
325 1.1 kleink }
326 1.1 kleink if (up) {
327 1.1 kleink k = b->wds;
328 1.1 kleink b = increment(b);
329 1.1 kleink x = b->x;
330 1.1 kleink if (irv == STRTOG_Denormal) {
331 1.1 kleink if (nbits == fpi->nbits - 1
332 1.1 kleink && x[nbits >> kshift] & 1 << (nbits & kmask))
333 1.1 kleink irv = STRTOG_Normal;
334 1.1 kleink }
335 1.1 kleink else if (b->wds > k
336 1.1.1.2 christos || ((n = nbits & kmask) !=0
337 1.1.1.2 christos && hi0bits(x[k-1]) < 32-n)) {
338 1.1 kleink rshift(b,1);
339 1.1 kleink if (++e > fpi->emax)
340 1.1 kleink goto ovfl;
341 1.1 kleink }
342 1.1 kleink irv |= STRTOG_Inexhi;
343 1.1 kleink }
344 1.1 kleink else
345 1.1 kleink irv |= STRTOG_Inexlo;
346 1.1 kleink }
347 1.1 kleink *bp = b;
348 1.1 kleink *exp = e;
349 1.1 kleink return irv;
350 1.1 kleink }
351