gonzui

    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 David M. Gay (dmg at acm dot org,
   30:  * with " at " changed at "@" and " dot " changed to ".").      */
   31: 
   32: #include "gdtoaimp.h"
   33: 
   34: #ifdef USE_LOCALE
   35: #include "locale.h"
   36: #endif
   37: 
   38:  int
   39: #ifdef KR_headers
   40: gethex(sp, fpi, exp, bp, sign)
   41:         CONST char **sp; FPI *fpi; Long *exp; Bigint **bp; int sign;
   42: #else
   43: gethex( CONST char **sp, FPI *fpi, Long *exp, Bigint **bp, int sign)
   44: #endif
   45: {
   46:         Bigint *b;
   47:         CONST unsigned char *decpt, *s0, *s, *s1;
   48:         int big, esign, havedig, irv, j, k, n, n0, nbits, up, zret;
   49:         ULong L, lostbits, *x;
   50:         Long e, e1;
   51: #ifdef USE_LOCALE
   52:         int i;
   53: #ifdef NO_LOCALE_CACHE
   54:         const unsigned char *decimalpoint = (unsigned char*)localeconv()->decimal_point;
   55: #else
   56:         const unsigned char *decimalpoint;
   57:         static unsigned char *decimalpoint_cache;
   58:         if (!(s0 = decimalpoint_cache)) {
   59:                 s0 = (unsigned char*)localeconv()->decimal_point;
   60:                 if ((decimalpoint_cache = (char*)MALLOC(strlen(s0) + 1))) {
   61:                         strlcpy(decimalpoint_cache, s0, strlen(s0) + 1);
   62:                         s0 = decimalpoint_cache;
   63:                         }
   64:                 }
   65:         decimalpoint = s0;
   66: #endif
   67: #endif
   68: 
   69:         if (!hexdig['0'])
   70:                 hexdig_init_D2A();
   71:         *bp = 0;
   72:         havedig = 0;
   73:         s0 = *(CONST unsigned char **)sp + 2;
   74:         while(s0[havedig] == '0')
   75:                 havedig++;
   76:         s0 += havedig;
   77:         s = s0;
   78:         decpt = 0;
   79:         zret = 0;
   80:         e = 0;
   81:         if (hexdig[*s])
   82:                 havedig++;
   83:         else {
   84:                 zret = 1;
   85: #ifdef USE_LOCALE
   86:                 for(i = 0; decimalpoint[i]; ++i) {
   87:                         if (s[i] != decimalpoint[i])
   88:                                 goto pcheck;
   89:                         }
   90:                 decpt = s += i;
   91: #else
   92:                 if (*s != '.')
   93:                         goto pcheck;
   94:                 decpt = ++s;
   95: #endif
   96:                 if (!hexdig[*s])
   97:                         goto pcheck;
   98:                 while(*s == '0')
   99:                         s++;
  100:                 if (hexdig[*s])
  101:                         zret = 0;
  102:                 havedig = 1;
  103:                 s0 = s;
  104:                 }
  105:         while(hexdig[*s])
  106:                 s++;
  107: #ifdef USE_LOCALE
  108:         if (*s == *decimalpoint && !decpt) {
  109:                 for(i = 1; decimalpoint[i]; ++i) {
  110:                         if (s[i] != decimalpoint[i])
  111:                                 goto pcheck;
  112:                         }
  113:                 decpt = s += i;
  114: #else
  115:         if (*s == '.' && !decpt) {
  116:                 decpt = ++s;
  117: #endif
  118:                 while(hexdig[*s])
  119:                         s++;
  120:                 }/*}*/
  121:         if (decpt)
  122:                 e = -(((Long)(s-decpt)) << 2);
  123:  pcheck:
  124:         s1 = s;
  125:         big = esign = 0;
  126:         switch(*s) {
  127:           case 'p':
  128:           case 'P':
  129:                 switch(*++s) {
  130:                   case '-':
  131:                         esign = 1;
  132:                         /* no break */
  133:                   case '+':
  134:                         s++;
  135:                   }
  136:                 if ((n = hexdig[*s]) == 0 || n > 0x19) {
  137:                         s = s1;
  138:                         break;
  139:                         }
  140:                 e1 = n - 0x10;
  141:                 while((n = hexdig[*++s]) !=0 && n <= 0x19) {
  142:                         if (e1 & 0xf8000000)
  143:                                 big = 1;
  144:                         e1 = 10*e1 + n - 0x10;
  145:                         }
  146:                 if (esign)
  147:                         e1 = -e1;
  148:                 e += e1;
  149:           }
  150:         *sp = (char*)s;
  151:         if (!havedig)
  152:                 *sp = (char*)s0 - 1;
  153:         if (zret)
  154:                 return STRTOG_Zero;
  155:         if (big) {
  156:                 if (esign) {
  157:                         switch(fpi->rounding) {
  158:                           case FPI_Round_up:
  159:                                 if (sign)
  160:                                         break;
  161:                                 goto ret_tiny;
  162:                           case FPI_Round_down:
  163:                                 if (!sign)
  164:                                         break;
  165:                                 goto ret_tiny;
  166:                           }
  167:                         goto retz;
  168:  ret_tiny:
  169:                         b = Balloc(0);
  170:                         if (b == NULL)
  171:                                 return (STRTOG_NoMemory);
  172:                         b->wds = 1;
  173:                         b->x[0] = 1;
  174:                         goto dret;
  175:                         }
  176:                 switch(fpi->rounding) {
  177:                   case FPI_Round_near:
  178:                         goto ovfl1;
  179:                   case FPI_Round_up:
  180:                         if (!sign)
  181:                                 goto ovfl1;
  182:                         goto ret_big;
  183:                   case FPI_Round_down:
  184:                         if (sign)
  185:                                 goto ovfl1;
  186:                         goto ret_big;
  187:                   }
  188:  ret_big:
  189:                 nbits = fpi->nbits;
  190:                 n0 = n = nbits >> kshift;
  191:                 if (nbits & kmask)
  192:                         ++n;
  193:                 for(j = n, k = 0; j >>= 1; ++k);
  194:                 *bp = b = Balloc(k);
  195:                 if (*bp == NULL)
  196:                         return (STRTOG_NoMemory);
  197:                 b->wds = n;
  198:                 for(j = 0; j < n0; ++j)
  199:                         b->x[j] = ALL_ON;
  200:                 if (n > n0)
  201:                         b->x[j] = ULbits >> (ULbits - (nbits & kmask));
  202:                 *exp = fpi->emin;
  203:                 return STRTOG_Normal | STRTOG_Inexlo;
  204:                 }
  205:         n = s1 - s0 - 1;
  206:         for(k = 0; n > (1 << (kshift-2)) - 1; n >>= 1)
  207:                 k++;
  208:         b = Balloc(k);
  209:         if (b == NULL)
  210:                 return (STRTOG_NoMemory);
  211:         x = b->x;
  212:         n = 0;
  213:         L = 0;
  214: #ifdef USE_LOCALE
  215:         for(i = 0; decimalpoint[i+1]; ++i);
  216: #endif
  217:         while(s1 > s0) {
  218: #ifdef USE_LOCALE
  219:                 if (*--s1 == decimalpoint[i]) {
  220:                         s1 -= i;
  221:                         continue;
  222:                         }
  223: #else
  224:                 if (*--s1 == '.')
  225:                         continue;
  226: #endif
  227:                 if (n == ULbits) {
  228:                         *x++ = L;
  229:                         L = 0;
  230:                         n = 0;
  231:                         }
  232:                 L |= (hexdig[*s1] & 0x0f) << n;
  233:                 n += 4;
  234:                 }
  235:         *x++ = L;
  236:         b->wds = n = x - b->x;
  237:         n = ULbits*n - hi0bits(L);
  238:         nbits = fpi->nbits;
  239:         lostbits = 0;
  240:         x = b->x;
  241:         if (n > nbits) {
  242:                 n -= nbits;
  243:                 if (any_on(b,n)) {
  244:                         lostbits = 1;
  245:                         k = n - 1;
  246:                         if (x[k>>kshift] & 1 << (k & kmask)) {
  247:                                 lostbits = 2;
  248:                                 if (k > 0 && any_on(b,k))
  249:                                         lostbits = 3;
  250:                                 }
  251:                         }
  252:                 rshift(b, n);
  253:                 e += n;
  254:                 }
  255:         else if (n < nbits) {
  256:                 n = nbits - n;
  257:                 b = lshift(b, n);
  258:                 if (b == NULL)
  259:                         return (STRTOG_NoMemory);
  260:                 e -= n;
  261:                 x = b->x;
  262:                 }
  263:         if (e > fpi->emax) {
  264:  ovfl:
  265:                 Bfree(b);
  266:  ovfl1:
  267: #ifndef NO_ERRNO
  268:                 /*errno = ERANGE*/;
  269: #endif
  270:                 return STRTOG_Infinite | STRTOG_Overflow | STRTOG_Inexhi;
  271:                 }
  272:         irv = STRTOG_Normal;
  273:         if (e < fpi->emin) {
  274:                 irv = STRTOG_Denormal;
  275:                 n = fpi->emin - e;
  276:                 if (n >= nbits) {
  277:                         switch (fpi->rounding) {
  278:                           case FPI_Round_near:
  279:                                 if (n == nbits && (n < 2 || any_on(b,n-1)))
  280:                                         goto one_bit;
  281:                                 break;
  282:                           case FPI_Round_up:
  283:                                 if (!sign)
  284:                                         goto one_bit;
  285:                                 break;
  286:                           case FPI_Round_down:
  287:                                 if (sign) {
  288:  one_bit:
  289:                                         x[0] = b->wds = 1;
  290:  dret:
  291:                                         *bp = b;
  292:                                         *exp = fpi->emin;
  293: #ifndef NO_ERRNO
  294:                                         /*errno = ERANGE*/;
  295: #endif
  296:                                         return STRTOG_Denormal | STRTOG_Inexhi
  297:                                                 | STRTOG_Underflow;
  298:                                         }
  299:                           }
  300:                         Bfree(b);
  301:  retz:
  302: #ifndef NO_ERRNO
  303:                         /*errno = ERANGE*/;
  304: #endif
  305:                         return STRTOG_Zero | STRTOG_Inexlo | STRTOG_Underflow;
  306:                         }
  307:                 k = n - 1;
  308:                 if (lostbits)
  309:                         lostbits = 1;
  310:                 else if (k > 0)
  311:                         lostbits = any_on(b,k);
  312:                 if (x[k>>kshift] & 1 << (k & kmask))
  313:                         lostbits |= 2;
  314:                 nbits -= n;
  315:                 rshift(b,n);
  316:                 e = fpi->emin;
  317:                 }
  318:         if (lostbits) {
  319:                 up = 0;
  320:                 switch(fpi->rounding) {
  321:                   case FPI_Round_zero:
  322:                         break;
  323:                   case FPI_Round_near:
  324:                         if (lostbits & 2
  325:                          && (lostbits | x[0]) & 1)
  326:                                 up = 1;
  327:                         break;
  328:                   case FPI_Round_up:
  329:                         up = 1 - sign;
  330:                         break;
  331:                   case FPI_Round_down:
  332:                         up = sign;
  333:                   }
  334:                 if (up) {
  335:                         k = b->wds;
  336:                         b = increment(b);
  337:                         if (b == NULL)
  338:                                 return (STRTOG_NoMemory);
  339:                         x = b->x;
  340:                         if (irv == STRTOG_Denormal) {
  341:                                 if (nbits == fpi->nbits - 1
  342:                                  && x[nbits >> kshift] & 1 << (nbits & kmask))
  343:                                         irv =  STRTOG_Normal;
  344:                                 }
  345:                         else if (b->wds > k
  346:                          || ((n = nbits & kmask) !=0
  347:                               && hi0bits(x[k-1]) < 32-n)) {
  348:                                 rshift(b,1);
  349:                                 if (++e > fpi->emax)
  350:                                         goto ovfl;
  351:                                 }
  352:                         irv |= STRTOG_Inexhi;
  353:                         }
  354:                 else
  355:                         irv |= STRTOG_Inexlo;
  356:                 }
  357:         *bp = b;
  358:         *exp = e;
  359:         return irv;
  360:         }