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