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