| 1 | /****************************************************************
|
|---|
| 2 |
|
|---|
| 3 | The author of this software is David M. Gay.
|
|---|
| 4 |
|
|---|
| 5 | Copyright (C) 1998 by Lucent Technologies
|
|---|
| 6 | All Rights Reserved
|
|---|
| 7 |
|
|---|
| 8 | Permission to use, copy, modify, and distribute this software and
|
|---|
| 9 | its documentation for any purpose and without fee is hereby
|
|---|
| 10 | granted, provided that the above copyright notice appear in all
|
|---|
| 11 | copies and that both that the copyright notice and this
|
|---|
| 12 | permission notice and warranty disclaimer appear in supporting
|
|---|
| 13 | documentation, and that the name of Lucent or any of its entities
|
|---|
| 14 | not be used in advertising or publicity pertaining to
|
|---|
| 15 | distribution of the software without specific, written prior
|
|---|
| 16 | permission.
|
|---|
| 17 |
|
|---|
| 18 | LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
|---|
| 19 | INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
|
|---|
| 20 | IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
|
|---|
| 21 | SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
|---|
| 22 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
|
|---|
| 23 | IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
|
|---|
| 24 | ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
|
|---|
| 25 | THIS SOFTWARE.
|
|---|
| 26 |
|
|---|
| 27 | ****************************************************************/
|
|---|
| 28 |
|
|---|
| 29 | /* Please send bug reports to
|
|---|
| 30 | David M. Gay
|
|---|
| 31 | dmg@acm.org
|
|---|
| 32 | */
|
|---|
| 33 |
|
|---|
| 34 | #include "gdtoaimp.h"
|
|---|
| 35 |
|
|---|
| 36 | #ifdef USE_LOCALE
|
|---|
| 37 | #include "locale.h"
|
|---|
| 38 | #endif
|
|---|
| 39 |
|
|---|
| 40 | int
|
|---|
| 41 | #ifdef KR_headers
|
|---|
| 42 | gethex(sp, fpi, exp, bp, sign)
|
|---|
| 43 | CONST char **sp; FPI *fpi; Long *exp; Bigint **bp; int sign;
|
|---|
| 44 | #else
|
|---|
| 45 | gethex( CONST char **sp, FPI *fpi, Long *exp, Bigint **bp, int sign)
|
|---|
| 46 | #endif
|
|---|
| 47 | {
|
|---|
| 48 | Bigint *b;
|
|---|
| 49 | CONST unsigned char *decpt, *s0, *s, *s1;
|
|---|
| 50 | int esign, havedig, irv, k, n, nbits, up;
|
|---|
| 51 | ULong L, lostbits, *x;
|
|---|
| 52 | Long e, e1;
|
|---|
| 53 | #ifdef USE_LOCALE
|
|---|
| 54 | unsigned char decimalpoint = *localeconv()->decimal_point;
|
|---|
| 55 | #else
|
|---|
| 56 | #define decimalpoint '.'
|
|---|
| 57 | #endif
|
|---|
| 58 |
|
|---|
| 59 | if (!hexdig['0'])
|
|---|
| 60 | hexdig_init_D2A();
|
|---|
| 61 | havedig = 0;
|
|---|
| 62 | s0 = *(CONST unsigned char **)sp + 2;
|
|---|
| 63 | while(s0[havedig] == '0')
|
|---|
| 64 | havedig++;
|
|---|
| 65 | s0 += havedig;
|
|---|
| 66 | s = s0;
|
|---|
| 67 | decpt = 0;
|
|---|
| 68 | if (!hexdig[*s]) {
|
|---|
| 69 | if (*s == decimalpoint) {
|
|---|
| 70 | decpt = ++s;
|
|---|
| 71 | if (!hexdig[*s])
|
|---|
| 72 | goto ret0;
|
|---|
| 73 | }
|
|---|
| 74 | else {
|
|---|
| 75 | ret0:
|
|---|
| 76 | *sp = (char*)s;
|
|---|
| 77 | return havedig ? STRTOG_Zero : STRTOG_NoNumber;
|
|---|
| 78 | }
|
|---|
| 79 | while(*s == '0')
|
|---|
| 80 | s++;
|
|---|
| 81 | havedig = 1;
|
|---|
| 82 | if (!hexdig[*s])
|
|---|
| 83 | goto ret0;
|
|---|
| 84 | s0 = s;
|
|---|
| 85 | }
|
|---|
| 86 | while(hexdig[*s])
|
|---|
| 87 | s++;
|
|---|
| 88 | if (*s == decimalpoint && !decpt) {
|
|---|
| 89 | decpt = ++s;
|
|---|
| 90 | while(hexdig[*s])
|
|---|
| 91 | s++;
|
|---|
| 92 | }
|
|---|
| 93 | e = 0;
|
|---|
| 94 | if (decpt)
|
|---|
| 95 | e = -(((Long)(s-decpt)) << 2);
|
|---|
| 96 | s1 = s;
|
|---|
| 97 | switch(*s) {
|
|---|
| 98 | case 'p':
|
|---|
| 99 | case 'P':
|
|---|
| 100 | esign = 0;
|
|---|
| 101 | switch(*++s) {
|
|---|
| 102 | case '-':
|
|---|
| 103 | esign = 1;
|
|---|
| 104 | /* no break */
|
|---|
| 105 | case '+':
|
|---|
| 106 | s++;
|
|---|
| 107 | }
|
|---|
| 108 | if ((n = hexdig[*s]) == 0 || n > 0x19) {
|
|---|
| 109 | s = s1;
|
|---|
| 110 | break;
|
|---|
| 111 | }
|
|---|
| 112 | e1 = n - 0x10;
|
|---|
| 113 | while((n = hexdig[*++s]) !=0 && n <= 0x19)
|
|---|
| 114 | e1 = 10*e1 + n - 0x10;
|
|---|
| 115 | if (esign)
|
|---|
| 116 | e1 = -e1;
|
|---|
| 117 | e += e1;
|
|---|
| 118 | }
|
|---|
| 119 | *sp = (char*)s;
|
|---|
| 120 | n = s1 - s0 - 1;
|
|---|
| 121 | for(k = 0; n > 7; n >>= 1)
|
|---|
| 122 | k++;
|
|---|
| 123 | b = Balloc(k);
|
|---|
| 124 | x = b->x;
|
|---|
| 125 | n = 0;
|
|---|
| 126 | L = 0;
|
|---|
| 127 | while(s1 > s0) {
|
|---|
| 128 | if (*--s1 == decimalpoint)
|
|---|
| 129 | continue;
|
|---|
| 130 | if (n == 32) {
|
|---|
| 131 | *x++ = L;
|
|---|
| 132 | L = 0;
|
|---|
| 133 | n = 0;
|
|---|
| 134 | }
|
|---|
| 135 | L |= (hexdig[*s1] & 0x0f) << n;
|
|---|
| 136 | n += 4;
|
|---|
| 137 | }
|
|---|
| 138 | *x++ = L;
|
|---|
| 139 | b->wds = n = x - b->x;
|
|---|
| 140 | n = 32*n - hi0bits(L);
|
|---|
| 141 | nbits = fpi->nbits;
|
|---|
| 142 | lostbits = 0;
|
|---|
| 143 | x = b->x;
|
|---|
| 144 | if (n > nbits) {
|
|---|
| 145 | n -= nbits;
|
|---|
| 146 | if (any_on(b,n)) {
|
|---|
| 147 | lostbits = 1;
|
|---|
| 148 | k = n - 1;
|
|---|
| 149 | if (x[k>>kshift] & 1 << (k & kmask)) {
|
|---|
| 150 | lostbits = 2;
|
|---|
| 151 | if (k > 1 && any_on(b,k-1))
|
|---|
| 152 | lostbits = 3;
|
|---|
| 153 | }
|
|---|
| 154 | }
|
|---|
| 155 | rshift(b, n);
|
|---|
| 156 | e += n;
|
|---|
| 157 | }
|
|---|
| 158 | else if (n < nbits) {
|
|---|
| 159 | n = nbits - n;
|
|---|
| 160 | b = lshift(b, n);
|
|---|
| 161 | e -= n;
|
|---|
| 162 | x = b->x;
|
|---|
| 163 | }
|
|---|
| 164 | if (e > fpi->emax) {
|
|---|
| 165 | ovfl:
|
|---|
| 166 | Bfree(b);
|
|---|
| 167 | *bp = 0;
|
|---|
| 168 | return STRTOG_Infinite | STRTOG_Overflow | STRTOG_Inexhi;
|
|---|
| 169 | }
|
|---|
| 170 | irv = STRTOG_Normal;
|
|---|
| 171 | if (e < fpi->emin) {
|
|---|
| 172 | irv = STRTOG_Denormal;
|
|---|
| 173 | n = fpi->emin - e;
|
|---|
| 174 | if (n >= nbits) {
|
|---|
| 175 | switch (fpi->rounding) {
|
|---|
| 176 | case FPI_Round_near:
|
|---|
| 177 | if (n == nbits && (n < 2 || any_on(b,n-1)))
|
|---|
| 178 | goto one_bit;
|
|---|
| 179 | break;
|
|---|
| 180 | case FPI_Round_up:
|
|---|
| 181 | if (!sign)
|
|---|
| 182 | goto one_bit;
|
|---|
| 183 | break;
|
|---|
| 184 | case FPI_Round_down:
|
|---|
| 185 | if (sign) {
|
|---|
| 186 | one_bit:
|
|---|
| 187 | *exp = fpi->emin;
|
|---|
| 188 | x[0] = b->wds = 1;
|
|---|
| 189 | *bp = b;
|
|---|
| 190 | return STRTOG_Denormal | STRTOG_Inexhi
|
|---|
| 191 | | STRTOG_Underflow;
|
|---|
| 192 | }
|
|---|
| 193 | }
|
|---|
| 194 | Bfree(b);
|
|---|
| 195 | *bp = 0;
|
|---|
| 196 | return STRTOG_Zero | STRTOG_Inexlo | STRTOG_Underflow;
|
|---|
| 197 | }
|
|---|
| 198 | k = n - 1;
|
|---|
| 199 | if (lostbits)
|
|---|
| 200 | lostbits = 1;
|
|---|
| 201 | else if (k > 0)
|
|---|
| 202 | lostbits = any_on(b,k);
|
|---|
| 203 | if (x[k>>kshift] & 1 << (k & kmask))
|
|---|
| 204 | lostbits |= 2;
|
|---|
| 205 | nbits -= n;
|
|---|
| 206 | rshift(b,n);
|
|---|
| 207 | e = fpi->emin;
|
|---|
| 208 | }
|
|---|
| 209 | if (lostbits) {
|
|---|
| 210 | up = 0;
|
|---|
| 211 | switch(fpi->rounding) {
|
|---|
| 212 | case FPI_Round_zero:
|
|---|
| 213 | break;
|
|---|
| 214 | case FPI_Round_near:
|
|---|
| 215 | if (lostbits & 2
|
|---|
| 216 | && (lostbits & 1) | x[0] & 1)
|
|---|
| 217 | up = 1;
|
|---|
| 218 | break;
|
|---|
| 219 | case FPI_Round_up:
|
|---|
| 220 | up = 1 - sign;
|
|---|
| 221 | break;
|
|---|
| 222 | case FPI_Round_down:
|
|---|
| 223 | up = sign;
|
|---|
| 224 | }
|
|---|
| 225 | if (up) {
|
|---|
| 226 | k = b->wds;
|
|---|
| 227 | b = increment(b);
|
|---|
| 228 | x = b->x;
|
|---|
| 229 | if (irv == STRTOG_Denormal) {
|
|---|
| 230 | if (nbits == fpi->nbits - 1
|
|---|
| 231 | && x[nbits >> kshift] & 1 << (nbits & kmask))
|
|---|
| 232 | irv = STRTOG_Normal;
|
|---|
| 233 | }
|
|---|
| 234 | else if (b->wds > k
|
|---|
| 235 | || (n = nbits & kmask) !=0
|
|---|
| 236 | && hi0bits(x[k-1]) < 32-n) {
|
|---|
| 237 | rshift(b,1);
|
|---|
| 238 | if (++e > fpi->emax)
|
|---|
| 239 | goto ovfl;
|
|---|
| 240 | }
|
|---|
| 241 | irv |= STRTOG_Inexhi;
|
|---|
| 242 | }
|
|---|
| 243 | else
|
|---|
| 244 | irv |= STRTOG_Inexlo;
|
|---|
| 245 | }
|
|---|
| 246 | *bp = b;
|
|---|
| 247 | *exp = e;
|
|---|
| 248 | return irv;
|
|---|
| 249 | }
|
|---|
