Home | History | Annotate | Line # | Download | only in gdtoa
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