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