static void
output_float (st_parameter_dt *dtp, const fnode *f, GFC_REAL_LARGEST value)
{
#if defined(HAVE_GFC_REAL_16) && __LDBL_DIG__ > 18
# define MIN_FIELD_WIDTH 46
#else
# define MIN_FIELD_WIDTH 31
#endif
#define STR(x) STR1(x)
#define STR1(x) #x
/* This must be large enough to accurately hold any value. */
char buffer[MIN_FIELD_WIDTH+1];
char *out;
char *digits;
int e;
char expchar;
format_token ft;
int w;
int d;
int edigits;
int ndigits;
/* Number of digits before the decimal point. */
int nbefore;
/* Number of zeros after the decimal point. */
int nzero;
/* Number of digits after the decimal point. */
int nafter;
/* Number of zeros after the decimal point, whatever the precision. */
int nzero_real;
int leadzero;
int nblanks;
int i;
sign_t sign;
double abslog;
ft = f->format;
w = f->u.real.w;
d = f->u.real.d;
nzero_real = -1;
/* We should always know the field width and precision. */
if (d < 0)
internal_error (&dtp->common, "Unspecified precision");
/* Use sprintf to print the number in the format +D.DDDDe+ddd
For an N digit exponent, this gives us (MIN_FIELD_WIDTH-5)-N digits
after the decimal point, plus another one before the decimal point. */
sign = calculate_sign (dtp, value < 0.0);
if (value < 0)
value = -value;
/* Printf always prints at least two exponent digits. */
if (value == 0)
edigits = 2;
else
{
#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
abslog = fabs((double) log10l(value));
#else
abslog = fabs(log10(value));
#endif
if (abslog < 100)
edigits = 2;
else
edigits = 1 + (int) log10(abslog);
}
if (ft == FMT_F || ft == FMT_EN
|| ((ft == FMT_D || ft == FMT_E) && dtp->u.p.scale_factor != 0))
{
/* Always convert at full precision to avoid double rounding. */
ndigits = MIN_FIELD_WIDTH - 4 - edigits;
}
else
{
/* We know the number of digits, so can let printf do the rounding
for us. */
if (ft == FMT_ES)
ndigits = d + 1;
else
ndigits = d;
if (ndigits > MIN_FIELD_WIDTH - 4 - edigits)
ndigits = MIN_FIELD_WIDTH - 4 - edigits;
}
/* # The result will always contain a decimal point, even if no
* digits follow it
*
* - The converted value is to be left adjusted on the field boundary
*
* + A sign (+ or -) always be placed before a number
*
* MIN_FIELD_WIDTH minimum field width
*
* * (ndigits-1) is used as the precision
*
* e format: [-]d.ddde±dd where there is one digit before the
* decimal-point character and the number of digits after it is
* equal to the precision. The exponent always contains at least two
* digits; if the value is zero, the exponent is 00.
*/
sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*"
GFC_REAL_LARGEST_FORMAT "e", ndigits - 1, value);
/* Check the resulting string has punctuation in the correct places. */
if (d != 0 && (buffer[2] != '.' || buffer[ndigits + 2] != 'e'))
internal_error (&dtp->common, "printf is broken");
/* Read the exponent back in. */
e = atoi (&buffer[ndigits + 3]) + 1;
/* Make sure zero comes out as 0.0e0. */
if (value == 0.0)
e = 0;
/* Normalize the fractional component. */
buffer[2] = buffer[1];
digits = &buffer[2];
/* Figure out where to place the decimal point. */
switch (ft)
{
case FMT_F:
nbefore = e + dtp->u.p.scale_factor;
if (nbefore < 0)
{
nzero = -nbefore;
nzero_real = nzero;
if (nzero > d)
nzero = d;
nafter = d - nzero;
nbefore = 0;
}
else
{
nzero = 0;
nafter = d;
}
expchar = 0;
break;
case FMT_E:
case FMT_D:
i = dtp->u.p.scale_factor;
if (value != 0.0)
e -= i;
if (i < 0)
{
nbefore = 0;
nzero = -i;
nafter = d + i;
}
else if (i > 0)
{
nbefore = i;
nzero = 0;
nafter = (d - i) + 1;
}
else /* i == 0 */
{
nbefore = 0;
nzero = 0;
nafter = d;
}
if (ft == FMT_E)
expchar = 'E';
else
expchar = 'D';
break;
case FMT_EN:
/* The exponent must be a multiple of three, with 1-3 digits before
the decimal point. */
if (value != 0.0)
e--;
if (e >= 0)
nbefore = e % 3;
else
{
nbefore = (-e) % 3;
if (nbefore != 0)
nbefore = 3 - nbefore;
}
e -= nbefore;
nbefore++;
nzero = 0;
nafter = d;
expchar = 'E';
break;
case FMT_ES:
if (value != 0.0)
e--;
nbefore = 1;
nzero = 0;
nafter = d;
expchar = 'E';
break;
default:
/* Should never happen. */
internal_error (&dtp->common, "Unexpected format token");
}
/* Round the value. */
if (nbefore + nafter == 0)
{
ndigits = 0;
if (nzero_real == d && digits[0] >= '5')
{
/* We rounded to zero but shouldn't have */
nzero--;
nafter = 1;
digits[0] = '1';
ndigits = 1;
}
}
else if (nbefore + nafter < ndigits)
{
ndigits = nbefore + nafter;
i = ndigits;
if (digits[i] >= '5')
{
/* Propagate the carry. */
for (i--; i >= 0; i--)
{
if (digits[i] != '9')
{
digits[i]++;
break;
}
digits[i] = '0';
}
if (i < 0)
{
/* The carry overflowed. Fortunately we have some spare space
at the start of the buffer. We may discard some digits, but
this is ok because we already know they are zero. */
digits--;
digits[0] = '1';
if (ft == FMT_F)
{
if (nzero > 0)
{
nzero--;
nafter++;
}
else
nbefore++;
}
else if (ft == FMT_EN)
{
nbefore++;
if (nbefore == 4)
{
nbefore = 1;
e += 3;
}
}
else
e++;
}
}
}
/* Calculate the format of the exponent field. */
if (expchar)
{
edigits = 1;
for (i = abs (e); i >= 10; i /= 10)
edigits++;
if (f->u.real.e < 0)
{
/* Width not specified. Must be no more than 3 digits. */
if (e > 999 || e < -999)
edigits = -1;
else
{
edigits = 4;
if (e > 99 || e < -99)
expchar = ' ';
}
}
else
{
/* Exponent width specified, check it is wide enough. */
if (edigits > f->u.real.e)
edigits = -1;
else
edigits = f->u.real.e + 2;
}
}
else
edigits = 0;
/* Pick a field size if none was specified. */
if (w <= 0)
w = nbefore + nzero + nafter + (sign != SIGN_NONE ? 2 : 1);
/* Create the ouput buffer. */
out = write_block (dtp, w);
if (out == NULL)
return;
/* Zero values always output as positive, even if the value was negative
before rounding. */
for (i = 0; i < ndigits; i++)
{
if (digits[i] != '0')
break;
}
if (i == ndigits)
sign = calculate_sign (dtp, 0);
/* Work out how much padding is needed. */
nblanks = w - (nbefore + nzero + nafter + edigits + 1);
if (sign != SIGN_NONE)
nblanks--;
/* Check the value fits in the specified field width. */
if (nblanks < 0 || edigits == -1)
{
star_fill (out, w);
return;
}
/* See if we have space for a zero before the decimal point. */
if (nbefore == 0 && nblanks > 0)
{
leadzero = 1;
nblanks--;
}
else
leadzero = 0;
/* Pad to full field width. */
if ( ( nblanks > 0 ) && !dtp->u.p.no_leading_blank)
{
memset (out, ' ', nblanks);
out += nblanks;
}
/* Output the initial sign (if any). */
if (sign == SIGN_PLUS)
*(out++) = '+';
else if (sign == SIGN_MINUS)
*(out++) = '-';
/* Output an optional leading zero. */
if (leadzero)
*(out++) = '0';
/* Output the part before the decimal point, padding with zeros. */
if (nbefore > 0)
{
if (nbefore > ndigits)
i = ndigits;
else
i = nbefore;
memcpy (out, digits, i);
while (i < nbefore)
out[i++] = '0';
digits += i;
ndigits -= i;
out += nbefore;
}
/* Output the decimal point. */
*(out++) = '.';
/* Output leading zeros after the decimal point. */
if (nzero > 0)
{
for (i = 0; i < nzero; i++)
*(out++) = '0';
}
/* Output digits after the decimal point, padding with zeros. */
if (nafter > 0)
{
if (nafter > ndigits)
i = ndigits;
else
i = nafter;
memcpy (out, digits, i);
while (i < nafter)
out[i++] = '0';
digits += i;
ndigits -= i;
out += nafter;
}
/* Output the exponent. */
if (expchar)
{
if (expchar != ' ')
{
*(out++) = expchar;
edigits--;
}
#if HAVE_SNPRINTF
snprintf (buffer, sizeof (buffer), "%+0*d", edigits, e);
#else
sprintf (buffer, "%+0*d", edigits, e);
#endif
memcpy (out, buffer, edigits);
}
if (dtp->u.p.no_leading_blank)
{
out += edigits;
memset( out , ' ' , nblanks );
dtp->u.p.no_leading_blank = 0;
}
#undef STR
#undef STR1
#undef MIN_FIELD_WIDTH
}
static void
write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
int len,
const char *(*conv) (GFC_INTEGER_LARGEST, char *, size_t))
{
GFC_INTEGER_LARGEST n = 0;
int w, m, digits, nsign, nzero, nblank;
char *p;
const char *q;
sign_t sign;
char itoa_buf[GFC_BTOA_BUF_SIZE];
w = f->u.integer.w;
m = f->format == FMT_G ? -1 : f->u.integer.m;
n = extract_int (source, len);
/* Special case: */
if (m == 0 && n == 0)
{
if (w == 0)
w = 1;
p = write_block (dtp, w);
if (p == NULL)
return;
memset (p, ' ', w);
goto done;
}
sign = calculate_sign (dtp, n < 0);
if (n < 0)
n = -n;
nsign = sign == S_NONE ? 0 : 1;
/* conv calls itoa which sets the negative sign needed
by write_integer. The sign '+' or '-' is set below based on sign
calculated above, so we just point past the sign in the string
before proceeding to avoid double signs in corner cases.
(see PR38504) */
q = conv (n, itoa_buf, sizeof (itoa_buf));
if (*q == '-')
q++;
digits = strlen (q);
/* Select a width if none was specified. The idea here is to always
print something. */
if (w == 0)
w = ((digits < m) ? m : digits) + nsign;
p = write_block (dtp, w);
if (p == NULL)
return;
nzero = 0;
if (digits < m)
nzero = m - digits;
/* See if things will work. */
nblank = w - (nsign + nzero + digits);
if (nblank < 0)
{
star_fill (p, w);
goto done;
}
memset (p, ' ', nblank);
p += nblank;
switch (sign)
{
case S_PLUS:
*p++ = '+';
break;
case S_MINUS:
*p++ = '-';
break;
case S_NONE:
break;
}
memset (p, '0', nzero);
p += nzero;
memcpy (p, q, digits);
done:
return;
}
static void
write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
int len,
const char *(*conv) (GFC_INTEGER_LARGEST, char *, size_t))
{
GFC_INTEGER_LARGEST n = 0;
int w, m, digits, nsign, nzero, nblank;
char *p;
const char *q;
sign_t sign;
char itoa_buf[GFC_BTOA_BUF_SIZE];
w = f->u.integer.w;
m = f->u.integer.m;
n = extract_int (source, len);
/* Special case: */
if (m == 0 && n == 0)
{
if (w == 0)
w = 1;
p = write_block (dtp, w);
if (p == NULL)
return;
memset (p, ' ', w);
goto done;
}
sign = calculate_sign (dtp, n < 0);
if (n < 0)
n = -n;
nsign = sign == SIGN_NONE ? 0 : 1;
q = conv (n, itoa_buf, sizeof (itoa_buf));
digits = strlen (q);
/* Select a width if none was specified. The idea here is to always
print something. */
if (w == 0)
w = ((digits < m) ? m : digits) + nsign;
p = write_block (dtp, w);
if (p == NULL)
return;
nzero = 0;
if (digits < m)
nzero = m - digits;
/* See if things will work. */
nblank = w - (nsign + nzero + digits);
if (nblank < 0)
{
star_fill (p, w);
goto done;
}
memset (p, ' ', nblank);
p += nblank;
switch (sign)
{
case SIGN_PLUS:
*p++ = '+';
break;
case SIGN_MINUS:
*p++ = '-';
break;
case SIGN_NONE:
break;
}
memset (p, '0', nzero);
p += nzero;
memcpy (p, q, digits);
done:
return;
}
