/* smalatod.c (emx+gcc) -- Copyright (c) 1990-1996 by Eberhard Mattes */

#include <stdlib.h>
#include <math.h>
#include <float.h>
#include <locale.h>
#include <ctype.h>
#include <errno.h>
#include <emx/float.h>
#include <emx/locale.h>


const char * __small_atod (long double *p_result, const char *string,
                           int min_exp, int max_exp, int bias,
                           int mant_dig, int decimal_dig,
                           int max_10_exp, int min_den_10_exp)
{
  const unsigned char *s, *end;
  long double x, lim;
  long scale;
  char ok, dot, neg;
  int fpclass;
  union
  {
    long double ld;
    struct
    {
      unsigned long long mant;
      unsigned short exp;
    } x;
  } z;

  s = end = string;

  switch (mant_dig)
    {
    case 24:
      lim = FLT_MAX / 10.0;
      break;
    case 53:
      lim = DBL_MAX / 10.0;
      break;
    case 64:
      lim = LDBL_MAX / 10.0L;
      break;
    default:
      *p_result = NAN;
      return string;
    }

  while (isspace (*s))
    ++s;
  neg = 0;
  if (*s == '+')
    ++s;
  else if (*s == '-')
    {
      neg = 1; ++s;
    }

  if ((s[0] == 'i' || s[0] == 'I')
      && (s[1] == 'n' || s[1] == 'N')
      && (s[2] == 'f' || s[2] == 'F'))
    {
      s += 3;
      if ((s[0] == 'i' || s[0] == 'I')
          && (s[1] == 'n' || s[1] == 'N')
          && (s[2] == 'i' || s[2] == 'I')
          && (s[3] == 't' || s[3] == 'T')
          && (s[4] == 'y' || s[4] == 'Y'))
        s += 5;
      *p_result = neg ? -INFINITY : INFINITY;
      return s;
    }
  else if ((s[0] == 'n' || s[0] == 'N')
           && (s[1] == 'a' || s[1] == 'A')
           && (s[2] == 'n' || s[2] == 'N'))
    {
      s += 3;
      end = s;
      if (end[0] == '(')
        {
          ++end;
          while (*end == '_' || (*end >= '0' && *end <= '9')
                 || (*end >= 'a' && *end <= 'z')
                 || (*end >= 'A' && *end <= 'Z'))
            ++end;
          if (*end == ')')
            ++end;
          else
            end = s;
        }
      *p_result = NAN;
      return end;
    }

  /* Scan the entire mantissa, updating SCALE. */

  ok = dot = 0;
  x = 0.0; scale = 0;
  for (;;)
    {
      if (*s == (unsigned char)_cur_lconv.decimal_point[0] && !dot)
        {
          dot = 1;
          ++s;
        }
      else if (isdigit (*s))
        {
          ok = 1;
          if (x > lim)
            ++scale;            /* Overflow */
          else
            x = x * 10.0L + (*s - '0');
          ++s;
          if (dot)
            --scale;
        }
      else
        break;
    }

  if (!ok)
    {
      *p_result = 0.0;
      return string;
    }

  /* Scan the exponent. */

  end = s;
  if (*s == 'e' || *s == 'E')
    {
      char eneg;

      ++s; eneg = 0;
      if (*s == '+')
        ++s;
      else if (*s == '-')
        {
          eneg = 1; ++s;
        }
      if (isdigit (*s))         /* Note: strtol() skips whitespace! */
        {
          int saved_errno;
          long exp;
          const unsigned char *q;

          saved_errno = errno; errno = 0;
          exp = strtol (s, (char **)&q, 10);
          if (errno == ERANGE)
            {
              /* If the exponent overflows, we need a *very* long
                 mantissa to get a valid number.  Such a mantissa
                 doesn't fit into memory. */

              end = q;
              if (eneg)
                goto underflow;
              else
                goto overflow;
            }
          else if (errno == 0 && q != s)
            {
              end = q;

              /* TODO: check for integer overflow */

              if (eneg)
                scale -= exp;
              else
                scale += exp;
            }
          errno = saved_errno;
        }
    }

  /* Apply the scaling factor and the exponent.  Don't do this if X is
     0.0 to be able to detect underflow. */

  if (x == 0.0 || scale == 0)
    z.ld = x;
  else
    z.ld = x * _powl (10.0L, (long double)scale);

  switch (mant_dig)
    {
    case 24:
      fpclass = __fpclassifyf ((float)z.ld);
      break;
    case 53:
      fpclass = __fpclassify ((double)z.ld);
      break;
    case 64:
      fpclass = __fpclassifyl (z.ld);
      break;
    default:
      fpclass = FP_NAN;
      break;
    }

  switch (fpclass)
    {
    case FP_ZERO:
      if (x != 0.0)
        errno = ERANGE;
      break;
    case FP_INFINITE:
      errno = ERANGE;
      break;
    }

  *p_result = neg ? -z.ld : z.ld;
  return end;

overflow:
  *p_result = neg ? -HUGE_VALL : HUGE_VALL;
  errno = ERANGE;
  return end;

underflow:
  *p_result = neg ? -0.0 : 0.0;
  errno = ERANGE;
  return end;
}