Home | History | Annotate | Line # | Download | only in gdtoa
gethex.c revision 1.3.14.1
      1  1.3.14.1     jdc /* $NetBSD: gethex.c,v 1.3.14.1 2008/04/08 21:10:55 jdc 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.1  kleink 	CONST unsigned char *decpt, *s0, *s, *s1;
     50       1.1  kleink 	int esign, havedig, irv, k, n, 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.1  kleink 	unsigned char decimalpoint = *localeconv()->decimal_point;
     55       1.1  kleink #else
     56       1.1  kleink #define decimalpoint '.'
     57       1.1  kleink #endif
     58       1.1  kleink 
     59       1.1  kleink 	if (!hexdig['0'])
     60       1.1  kleink 		hexdig_init_D2A();
     61       1.1  kleink 	havedig = 0;
     62       1.1  kleink 	s0 = *(CONST unsigned char **)sp + 2;
     63       1.1  kleink 	while(s0[havedig] == '0')
     64       1.1  kleink 		havedig++;
     65       1.1  kleink 	s0 += havedig;
     66       1.1  kleink 	s = s0;
     67       1.1  kleink 	decpt = 0;
     68       1.1  kleink 	zret = 0;
     69       1.1  kleink 	e = 0;
     70       1.1  kleink 	if (!hexdig[*s]) {
     71       1.1  kleink 		zret = 1;
     72       1.1  kleink 		if (*s != decimalpoint)
     73       1.1  kleink 			goto pcheck;
     74       1.1  kleink 		decpt = ++s;
     75       1.1  kleink 		if (!hexdig[*s])
     76       1.1  kleink 			goto pcheck;
     77       1.1  kleink 		while(*s == '0')
     78       1.1  kleink 			s++;
     79       1.1  kleink 		if (hexdig[*s])
     80       1.1  kleink 			zret = 0;
     81       1.1  kleink 		havedig = 1;
     82       1.1  kleink 		s0 = s;
     83       1.1  kleink 		}
     84       1.1  kleink 	while(hexdig[*s])
     85       1.1  kleink 		s++;
     86       1.1  kleink 	if (*s == decimalpoint && !decpt) {
     87       1.1  kleink 		decpt = ++s;
     88       1.1  kleink 		while(hexdig[*s])
     89       1.1  kleink 			s++;
     90       1.1  kleink 		}
     91       1.1  kleink 	if (decpt)
     92       1.1  kleink 		e = -(((Long)(s-decpt)) << 2);
     93       1.1  kleink  pcheck:
     94       1.1  kleink 	s1 = s;
     95       1.1  kleink 	switch(*s) {
     96       1.1  kleink 	  case 'p':
     97       1.1  kleink 	  case 'P':
     98       1.1  kleink 		esign = 0;
     99       1.1  kleink 		switch(*++s) {
    100       1.1  kleink 		  case '-':
    101       1.1  kleink 			esign = 1;
    102       1.2  kleink 			/* FALLTHROUGH */
    103       1.1  kleink 		  case '+':
    104       1.1  kleink 			s++;
    105       1.1  kleink 		  }
    106       1.1  kleink 		if ((n = hexdig[*s]) == 0 || n > 0x19) {
    107       1.1  kleink 			s = s1;
    108       1.1  kleink 			break;
    109       1.1  kleink 			}
    110       1.1  kleink 		e1 = n - 0x10;
    111       1.1  kleink 		while((n = hexdig[*++s]) !=0 && n <= 0x19)
    112       1.1  kleink 			e1 = 10*e1 + n - 0x10;
    113       1.1  kleink 		if (esign)
    114       1.1  kleink 			e1 = -e1;
    115       1.1  kleink 		e += e1;
    116       1.1  kleink 	  }
    117       1.2  kleink 	*sp = __UNCONST(s);
    118       1.1  kleink 	if (zret)
    119       1.1  kleink 		return havedig ? STRTOG_Zero : STRTOG_NoNumber;
    120       1.1  kleink 	n = s1 - s0 - 1;
    121       1.2  kleink 	for(k = 0; n > 7; n = (unsigned int)n >> 1)
    122       1.1  kleink 		k++;
    123       1.1  kleink 	b = Balloc(k);
    124  1.3.14.1     jdc 	if (b == NULL)
    125  1.3.14.1     jdc 		return STRTOG_NoMemory;
    126       1.1  kleink 	x = b->x;
    127       1.1  kleink 	n = 0;
    128       1.1  kleink 	L = 0;
    129       1.1  kleink 	while(s1 > s0) {
    130       1.1  kleink 		if (*--s1 == decimalpoint)
    131       1.1  kleink 			continue;
    132       1.1  kleink 		if (n == 32) {
    133       1.1  kleink 			*x++ = L;
    134       1.1  kleink 			L = 0;
    135       1.1  kleink 			n = 0;
    136       1.1  kleink 			}
    137       1.1  kleink 		L |= (hexdig[*s1] & 0x0f) << n;
    138       1.1  kleink 		n += 4;
    139       1.1  kleink 		}
    140       1.1  kleink 	*x++ = L;
    141       1.1  kleink 	b->wds = n = x - b->x;
    142       1.1  kleink 	n = 32*n - hi0bits(L);
    143       1.1  kleink 	nbits = fpi->nbits;
    144       1.1  kleink 	lostbits = 0;
    145       1.1  kleink 	x = b->x;
    146       1.1  kleink 	if (n > nbits) {
    147       1.1  kleink 		n -= nbits;
    148       1.1  kleink 		if (any_on(b,n)) {
    149       1.1  kleink 			lostbits = 1;
    150       1.1  kleink 			k = n - 1;
    151       1.2  kleink 			if (x[(unsigned int)k>>kshift] & 1 << (k & kmask)) {
    152       1.1  kleink 				lostbits = 2;
    153       1.1  kleink 				if (k > 1 && any_on(b,k-1))
    154       1.1  kleink 					lostbits = 3;
    155       1.1  kleink 				}
    156       1.1  kleink 			}
    157       1.1  kleink 		rshift(b, n);
    158       1.1  kleink 		e += n;
    159       1.1  kleink 		}
    160       1.1  kleink 	else if (n < nbits) {
    161       1.1  kleink 		n = nbits - n;
    162       1.1  kleink 		b = lshift(b, n);
    163  1.3.14.1     jdc 		if (b == NULL)
    164  1.3.14.1     jdc 			return STRTOG_NoMemory;
    165       1.1  kleink 		e -= n;
    166       1.1  kleink 		x = b->x;
    167       1.1  kleink 		}
    168       1.1  kleink 	if (e > fpi->emax) {
    169       1.1  kleink  ovfl:
    170       1.1  kleink 		Bfree(b);
    171       1.1  kleink 		*bp = 0;
    172       1.1  kleink 		return STRTOG_Infinite | STRTOG_Overflow | STRTOG_Inexhi;
    173       1.1  kleink 		}
    174       1.1  kleink 	irv = STRTOG_Normal;
    175       1.1  kleink 	if (e < fpi->emin) {
    176       1.1  kleink 		irv = STRTOG_Denormal;
    177       1.1  kleink 		n = fpi->emin - e;
    178       1.1  kleink 		if (n >= nbits) {
    179       1.1  kleink 			switch (fpi->rounding) {
    180       1.1  kleink 			  case FPI_Round_near:
    181       1.1  kleink 				if (n == nbits && (n < 2 || any_on(b,n-1)))
    182       1.1  kleink 					goto one_bit;
    183       1.1  kleink 				break;
    184       1.1  kleink 			  case FPI_Round_up:
    185       1.1  kleink 				if (!sign)
    186       1.1  kleink 					goto one_bit;
    187       1.1  kleink 				break;
    188       1.1  kleink 			  case FPI_Round_down:
    189       1.1  kleink 				if (sign) {
    190       1.1  kleink  one_bit:
    191       1.2  kleink 					*expt = fpi->emin;
    192       1.1  kleink 					x[0] = b->wds = 1;
    193       1.1  kleink 					*bp = b;
    194       1.1  kleink 					return STRTOG_Denormal | STRTOG_Inexhi
    195       1.1  kleink 						| STRTOG_Underflow;
    196       1.1  kleink 					}
    197       1.1  kleink 			  }
    198       1.1  kleink 			Bfree(b);
    199       1.1  kleink 			*bp = 0;
    200       1.1  kleink 			return STRTOG_Zero | STRTOG_Inexlo | STRTOG_Underflow;
    201       1.1  kleink 			}
    202       1.1  kleink 		k = n - 1;
    203       1.1  kleink 		if (lostbits)
    204       1.1  kleink 			lostbits = 1;
    205       1.1  kleink 		else if (k > 0)
    206       1.1  kleink 			lostbits = any_on(b,k);
    207       1.2  kleink 		if (x[(unsigned int)k>>kshift] & 1 << (k & kmask))
    208       1.1  kleink 			lostbits |= 2;
    209       1.1  kleink 		nbits -= n;
    210       1.1  kleink 		rshift(b,n);
    211       1.1  kleink 		e = fpi->emin;
    212       1.1  kleink 		}
    213       1.1  kleink 	if (lostbits) {
    214       1.1  kleink 		up = 0;
    215       1.1  kleink 		switch(fpi->rounding) {
    216       1.1  kleink 		  case FPI_Round_zero:
    217       1.1  kleink 			break;
    218       1.1  kleink 		  case FPI_Round_near:
    219       1.1  kleink 			if (lostbits & 2
    220       1.2  kleink 			 && (lostbits & 1) | (x[0] & 1))
    221       1.1  kleink 				up = 1;
    222       1.1  kleink 			break;
    223       1.1  kleink 		  case FPI_Round_up:
    224       1.1  kleink 			up = 1 - sign;
    225       1.1  kleink 			break;
    226       1.1  kleink 		  case FPI_Round_down:
    227       1.1  kleink 			up = sign;
    228       1.1  kleink 		  }
    229       1.1  kleink 		if (up) {
    230       1.1  kleink 			k = b->wds;
    231       1.1  kleink 			b = increment(b);
    232       1.1  kleink 			x = b->x;
    233       1.1  kleink 			if (irv == STRTOG_Denormal) {
    234       1.1  kleink 				if (nbits == fpi->nbits - 1
    235       1.2  kleink 				 && x[(unsigned int)nbits >> kshift] & 1 << (nbits & kmask))
    236       1.1  kleink 					irv =  STRTOG_Normal;
    237       1.1  kleink 				}
    238       1.1  kleink 			else if (b->wds > k
    239       1.2  kleink 			 || ((n = nbits & kmask) !=0
    240       1.2  kleink 			     && hi0bits(x[k-1]) < 32-n)) {
    241       1.1  kleink 				rshift(b,1);
    242       1.1  kleink 				if (++e > fpi->emax)
    243       1.1  kleink 					goto ovfl;
    244       1.1  kleink 				}
    245       1.1  kleink 			irv |= STRTOG_Inexhi;
    246       1.1  kleink 			}
    247       1.1  kleink 		else
    248       1.1  kleink 			irv |= STRTOG_Inexlo;
    249       1.1  kleink 		}
    250       1.1  kleink 	*bp = b;
    251       1.2  kleink 	*expt = e;
    252       1.1  kleink 	return irv;
    253       1.1  kleink 	}
    254