gethex.c revision 165743
1210312Sjmallett/**************************************************************** 2210312Sjmallett 3210312SjmallettThe author of this software is David M. Gay. 4210312Sjmallett 5210312SjmallettCopyright (C) 1998 by Lucent Technologies 6210312SjmallettAll Rights Reserved 7210312Sjmallett 8210312SjmallettPermission to use, copy, modify, and distribute this software and 9210312Sjmallettits documentation for any purpose and without fee is hereby 10210312Sjmallettgranted, provided that the above copyright notice appear in all 11210312Sjmallettcopies and that both that the copyright notice and this 12210312Sjmallettpermission notice and warranty disclaimer appear in supporting 13210312Sjmallettdocumentation, and that the name of Lucent or any of its entities 14210312Sjmallettnot be used in advertising or publicity pertaining to 15210312Sjmallettdistribution of the software without specific, written prior 16210312Sjmallettpermission. 17210312Sjmallett 18210312SjmallettLUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, 19210312SjmallettINCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. 20210312SjmallettIN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY 21210312SjmallettSPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 22210312SjmallettWHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER 23210312SjmallettIN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, 24210312SjmallettARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF 25210312SjmallettTHIS SOFTWARE. 26210312Sjmallett 27210312Sjmallett****************************************************************/ 28210312Sjmallett 29210312Sjmallett/* Please send bug reports to David M. Gay (dmg at acm dot org, 30210312Sjmallett * with " at " changed at "@" and " dot " changed to "."). */ 31210312Sjmallett 32210312Sjmallett#include "gdtoaimp.h" 33210312Sjmallett 34210312Sjmallett#ifdef USE_LOCALE 35210312Sjmallett#include "locale.h" 36210312Sjmallett#endif 37210312Sjmallett 38210312Sjmallett int 39210312Sjmallett#ifdef KR_headers 40210312Sjmallettgethex(sp, fpi, exp, bp, sign) 41210312Sjmallett CONST char **sp; FPI *fpi; Long *exp; Bigint **bp; int sign; 42210312Sjmallett#else 43210312Sjmallettgethex( CONST char **sp, FPI *fpi, Long *exp, Bigint **bp, int sign) 44210312Sjmallett#endif 45210312Sjmallett{ 46210312Sjmallett Bigint *b; 47210312Sjmallett CONST unsigned char *decpt, *s0, *s, *s1; 48210312Sjmallett int esign, havedig, irv, k, n, nbits, up, zret; 49210312Sjmallett ULong L, lostbits, *x; 50210312Sjmallett Long e, e1; 51210312Sjmallett#ifdef USE_LOCALE 52210312Sjmallett unsigned char decimalpoint = *localeconv()->decimal_point; 53210312Sjmallett#else 54210312Sjmallett#define decimalpoint '.' 55210312Sjmallett#endif 56210312Sjmallett 57210312Sjmallett if (!hexdig['0']) 58210312Sjmallett hexdig_init_D2A(); 59210312Sjmallett havedig = 0; 60210312Sjmallett s0 = *(CONST unsigned char **)sp + 2; 61210312Sjmallett while(s0[havedig] == '0') 62210312Sjmallett havedig++; 63210312Sjmallett s0 += havedig; 64210312Sjmallett s = s0; 65210312Sjmallett decpt = 0; 66210312Sjmallett zret = 0; 67210312Sjmallett e = 0; 68210312Sjmallett if (!hexdig[*s]) { 69210312Sjmallett zret = 1; 70210312Sjmallett if (*s != decimalpoint) 71210312Sjmallett goto pcheck; 72210312Sjmallett decpt = ++s; 73210312Sjmallett if (!hexdig[*s]) 74210312Sjmallett goto pcheck; 75210312Sjmallett while(*s == '0') 76210312Sjmallett s++; 77210312Sjmallett if (hexdig[*s]) 78210312Sjmallett zret = 0; 79210312Sjmallett havedig = 1; 80210312Sjmallett s0 = s; 81210312Sjmallett } 82210312Sjmallett while(hexdig[*s]) 83210312Sjmallett s++; 84210312Sjmallett if (*s == decimalpoint && !decpt) { 85210312Sjmallett decpt = ++s; 86210312Sjmallett while(hexdig[*s]) 87210312Sjmallett s++; 88210312Sjmallett } 89210312Sjmallett if (decpt) 90210312Sjmallett e = -(((Long)(s-decpt)) << 2); 91210312Sjmallett pcheck: 92210312Sjmallett s1 = s; 93210312Sjmallett switch(*s) { 94210312Sjmallett case 'p': 95210312Sjmallett case 'P': 96210312Sjmallett esign = 0; 97210312Sjmallett switch(*++s) { 98210312Sjmallett case '-': 99210312Sjmallett esign = 1; 100210312Sjmallett /* no break */ 101210312Sjmallett case '+': 102210312Sjmallett s++; 103210312Sjmallett } 104210312Sjmallett if ((n = hexdig[*s]) == 0 || n > 0x19) { 105210312Sjmallett s = s1; 106210312Sjmallett break; 107210312Sjmallett } 108210312Sjmallett e1 = n - 0x10; 109210312Sjmallett while((n = hexdig[*++s]) !=0 && n <= 0x19) 110210312Sjmallett e1 = 10*e1 + n - 0x10; 111210312Sjmallett if (esign) 112210312Sjmallett e1 = -e1; 113210312Sjmallett e += e1; 114210312Sjmallett } 115210312Sjmallett *sp = (char*)s; 116210312Sjmallett if (zret) 117210312Sjmallett return havedig ? STRTOG_Zero : STRTOG_NoNumber; 118210312Sjmallett n = s1 - s0 - 1; 119210312Sjmallett for(k = 0; n > 7; n >>= 1) 120210312Sjmallett k++; 121210312Sjmallett b = Balloc(k); 122210312Sjmallett x = b->x; 123210312Sjmallett n = 0; 124210312Sjmallett L = 0; 125210312Sjmallett while(s1 > s0) { 126210312Sjmallett if (*--s1 == decimalpoint) 127210312Sjmallett continue; 128210312Sjmallett if (n == 32) { 129210312Sjmallett *x++ = L; 130210312Sjmallett L = 0; 131210312Sjmallett n = 0; 132210312Sjmallett } 133210312Sjmallett L |= (hexdig[*s1] & 0x0f) << n; 134210312Sjmallett n += 4; 135210312Sjmallett } 136210312Sjmallett *x++ = L; 137210312Sjmallett b->wds = n = x - b->x; 138210312Sjmallett n = 32*n - hi0bits(L); 139210312Sjmallett nbits = fpi->nbits; 140210312Sjmallett lostbits = 0; 141210312Sjmallett x = b->x; 142210312Sjmallett if (n > nbits) { 143210312Sjmallett n -= nbits; 144210312Sjmallett if (any_on(b,n)) { 145210312Sjmallett lostbits = 1; 146210312Sjmallett k = n - 1; 147210312Sjmallett if (x[k>>kshift] & 1 << (k & kmask)) { 148210312Sjmallett lostbits = 2; 149210312Sjmallett if (k > 1 && any_on(b,k-1)) 150210312Sjmallett lostbits = 3; 151210312Sjmallett } 152210312Sjmallett } 153210312Sjmallett rshift(b, n); 154210312Sjmallett e += n; 155210312Sjmallett } 156210312Sjmallett else if (n < nbits) { 157210312Sjmallett n = nbits - n; 158210312Sjmallett b = lshift(b, n); 159210312Sjmallett e -= n; 160210312Sjmallett x = b->x; 161210312Sjmallett } 162229118Shselasky if (e > fpi->emax) { 163210312Sjmallett ovfl: 164210312Sjmallett Bfree(b); 165210312Sjmallett *bp = 0; 166210312Sjmallett return STRTOG_Infinite | STRTOG_Overflow | STRTOG_Inexhi; 167210312Sjmallett } 168210312Sjmallett irv = STRTOG_Normal; 169210312Sjmallett if (e < fpi->emin) { 170210312Sjmallett irv = STRTOG_Denormal; 171210312Sjmallett n = fpi->emin - e; 172210312Sjmallett if (n >= nbits) { 173210312Sjmallett switch (fpi->rounding) { 174210312Sjmallett case FPI_Round_near: 175210312Sjmallett if (n == nbits && (n < 2 || any_on(b,n-1))) 176210312Sjmallett goto one_bit; 177210312Sjmallett break; 178210312Sjmallett case FPI_Round_up: 179210312Sjmallett if (!sign) 180210312Sjmallett goto one_bit; 181210312Sjmallett break; 182210312Sjmallett case FPI_Round_down: 183210312Sjmallett if (sign) { 184210312Sjmallett one_bit: 185210312Sjmallett *exp = fpi->emin; 186210312Sjmallett x[0] = b->wds = 1; 187210312Sjmallett *bp = b; 188210312Sjmallett return STRTOG_Denormal | STRTOG_Inexhi 189210312Sjmallett | STRTOG_Underflow; 190229096Shselasky } 191229096Shselasky } 192229096Shselasky Bfree(b); 193210312Sjmallett *bp = 0; 194229093Shselasky return STRTOG_Zero | STRTOG_Inexlo | STRTOG_Underflow; 195210312Sjmallett } 196210312Sjmallett k = n - 1; 197210312Sjmallett if (lostbits) 198229096Shselasky lostbits = 1; 199229096Shselasky else if (k > 0) 200229096Shselasky lostbits = any_on(b,k); 201210312Sjmallett if (x[k>>kshift] & 1 << (k & kmask)) 202210312Sjmallett lostbits |= 2; 203210312Sjmallett nbits -= n; 204210312Sjmallett rshift(b,n); 205210312Sjmallett e = fpi->emin; 206 } 207 if (lostbits) { 208 up = 0; 209 switch(fpi->rounding) { 210 case FPI_Round_zero: 211 break; 212 case FPI_Round_near: 213 if (lostbits & 2 214 && (lostbits & 1) | x[0] & 1) 215 up = 1; 216 break; 217 case FPI_Round_up: 218 up = 1 - sign; 219 break; 220 case FPI_Round_down: 221 up = sign; 222 } 223 if (up) { 224 k = b->wds; 225 b = increment(b); 226 x = b->x; 227 if (irv == STRTOG_Denormal) { 228 if (nbits == fpi->nbits - 1 229 && x[nbits >> kshift] & 1 << (nbits & kmask)) 230 irv = STRTOG_Normal; 231 } 232 else if (b->wds > k 233 || (n = nbits & kmask) !=0 234 && hi0bits(x[k-1]) < 32-n) { 235 rshift(b,1); 236 if (++e > fpi->emax) 237 goto ovfl; 238 } 239 irv |= STRTOG_Inexhi; 240 } 241 else 242 irv |= STRTOG_Inexlo; 243 } 244 *bp = b; 245 *exp = e; 246 return irv; 247 } 248