source: branches/libc-0.6/src/gcc/libf2c/libI77/wref.c

#include "f2c.h"
#include "fio.h"
#ifndef VAX
#include <ctype.h>
#endif

#undef abs
#undef min
#undef max
#include <stdlib.h>
#include <string.h>

#include "fmt.h"
#include "fp.h"

int
wrt_E (ufloat * p, int w, int d, int e, ftnlen len)
{
  char buf[FMAX + EXPMAXDIGS + 4], *s, *se;
  int d1, delta, e1, i, sign, signspace;
  double dd;
#ifdef WANT_LEAD_0
  int insert0 = 0;
#endif
#ifndef VAX
  int e0 = e;
#endif

  if (e <= 0)
    e = 2;
  if (f__scale)
    {
      if (f__scale >= d + 2 || f__scale <= -d)
        goto nogood;
    }
  if (f__scale <= 0)
    --d;
  if (len == sizeof (real))
    dd = p->pf;
  else
    dd = p->pd;
  if (dd < 0.)
    {
      signspace = sign = 1;
      dd = -dd;
    }
  else
    {
      sign = 0;
      signspace = (int) f__cplus;
#ifndef VAX
      if (!dd)
        dd = 0.;                /* avoid -0 */
#endif
    }
  delta = w - (2                /* for the . and the d adjustment above */
               + 2 /* for the E+ */  + signspace + d + e);
#ifdef WANT_LEAD_0
  if (f__scale <= 0 && delta > 0)
    {
      delta--;
      insert0 = 1;
    }
  else
#endif
  if (delta < 0)
    {
    nogood:
      while (--w >= 0)
        PUT ('*');
      return (0);
    }
  if (f__scale < 0)
    d += f__scale;
  if (d > FMAX)
    {
      d1 = d - FMAX;
      d = FMAX;
    }
  else
    d1 = 0;
  sprintf (buf, "%#.*E", d, dd);
#ifndef VAX
  /* check for NaN, Infinity */
  if (!isdigit ((unsigned char) buf[0]))
    {
      switch (buf[0])
        {
        case 'n':
        case 'N':
          signspace = 0;        /* no sign for NaNs */
        }
      delta = w - strlen (buf) - signspace;
      if (delta < 0)
        goto nogood;
      while (--delta >= 0)
        PUT (' ');
      if (signspace)
        PUT (sign ? '-' : '+');
      for (s = buf; *s; s++)
        PUT (*s);
      return 0;
    }
#endif
  se = buf + d + 3;
#ifdef GOOD_SPRINTF_EXPONENT    /* When possible, exponent has 2 digits. */
  if (f__scale != 1 && dd)
    sprintf (se, "%+.2d", atoi (se) + 1 - f__scale);
#else
  if (dd)
    sprintf (se, "%+.2d", atoi (se) + 1 - f__scale);
  else
    strcpy (se, "+00");
#endif
  s = ++se;
  if (e < 2)
    {
      if (*s != '0')
        goto nogood;
    }
#ifndef VAX
  /* accommodate 3 significant digits in exponent */
  if (s[2])
    {
#ifdef Pedantic
      if (!e0 && !s[3])
        for (s -= 2, e1 = 2; s[0] = s[1]; s++);

      /* Pedantic gives the behavior that Fortran 77 specifies,       */
      /* i.e., requires that E be specified for exponent fields       */
      /* of more than 3 digits.  With Pedantic undefined, we get      */
      /* the behavior that Cray displays -- you get a bigger          */
      /* exponent field if it fits.   */
#else
      if (!e0)
        {
          for (s -= 2, e1 = 2; (s[0] = s[1]); s++)
#ifdef CRAY
            delta--;
          if ((delta += 4) < 0)
            goto nogood
#endif
              ;
        }
#endif
      else if (e0 >= 0)
        goto shift;
      else
        e1 = e;
    }
  else
  shift:
#endif
    for (s += 2, e1 = 2; *s; ++e1, ++s)
      if (e1 >= e)
        goto nogood;
  while (--delta >= 0)
    PUT (' ');
  if (signspace)
    PUT (sign ? '-' : '+');
  s = buf;
  i = f__scale;
  if (f__scale <= 0)
    {
#ifdef WANT_LEAD_0
      if (insert0)
        PUT ('0');
#endif
      PUT ('.');
      for (; i < 0; ++i)
        PUT ('0');
      PUT (*s);
      s += 2;
    }
  else if (f__scale > 1)
    {
      PUT (*s);
      s += 2;
      while (--i > 0)
        PUT (*s++);
      PUT ('.');
    }
  if (d1)
    {
      se -= 2;
      while (s < se)
        PUT (*s++);
      se += 2;
      do
        PUT ('0');
      while (--d1 > 0);
    }
  while (s < se)
    PUT (*s++);
  if (e < 2)
    PUT (s[1]);
  else
    {
      while (++e1 <= e)
        PUT ('0');
      while (*s)
        PUT (*s++);
    }
  return 0;
}

int
wrt_F (ufloat * p, int w, int d, ftnlen len)
{
  int d1, sign, n;
  double x;
  char *b, buf[MAXINTDIGS + MAXFRACDIGS + 4], *s;

  x = (len == sizeof (real) ? p->pf : p->pd);
  if (d < MAXFRACDIGS)
    d1 = 0;
  else
    {
      d1 = d - MAXFRACDIGS;
      d = MAXFRACDIGS;
    }
  if (x < 0.)
    {
      x = -x;
      sign = 1;
    }
  else
    {
      sign = 0;
#ifndef VAX
      if (!x)
        x = 0.;
#endif
    }

  if ((n = f__scale))
    {
      if (n > 0)
        do
          x *= 10.;
        while (--n > 0);
      else
        do
          x *= 0.1;
        while (++n < 0);
    }

#ifdef USE_STRLEN
  sprintf (b = buf, "%#.*f", d, x);
  n = strlen (b) + d1;
#else
  n = sprintf (b = buf, "%#.*f", d, x) + d1;
#endif

#ifndef WANT_LEAD_0
  if (buf[0] == '0' && d)
    {
      ++b;
      --n;
    }
#endif
  if (sign)
    {
      /* check for all zeros */
      for (s = b;;)
        {
          while (*s == '0')
            s++;
          switch (*s)
            {
            case '.':
              s++;
              continue;
            case 0:
              sign = 0;
            }
          break;
        }
    }
  if (sign || f__cplus)
    ++n;
  if (n > w)
    {
#ifdef WANT_LEAD_0
      if (buf[0] == '0' && --n == w)
        ++b;
      else
#endif
        {
          while (--w >= 0)
            PUT ('*');
          return 0;
        }
    }
  for (w -= n; --w >= 0;)
    PUT (' ');
  if (sign)
    PUT ('-');
  else if (f__cplus)
    PUT ('+');
  while ((n = *b++))
    PUT (n);
  while (--d1 >= 0)
    PUT ('0');
  return 0;
}