{
char *out;
char *digits;
- int e;
+ int e, w, d, p, i;
char expchar, rchar;
format_token ft;
- int w;
- int d;
/* Number of digits before the decimal point. */
int nbefore;
/* Number of zeros after the decimal point. */
int nzero_real;
int leadzero;
int nblanks;
- int i;
sign_t sign;
ft = f->format;
w = f->u.real.w;
d = f->u.real.d;
+ p = dtp->u.p.scale_factor;
rchar = '5';
nzero_real = -1;
switch (ft)
{
case FMT_F:
- if (d == 0 && e <= 0 && dtp->u.p.scale_factor == 0)
+ if (d == 0 && e <= 0 && p == 0)
{
memmove (digits + 1, digits, ndigits - 1);
digits[0] = '0';
e++;
}
- nbefore = e + dtp->u.p.scale_factor;
+ nbefore = e + p;
if (nbefore < 0)
{
nzero = -nbefore;
case FMT_E:
case FMT_D:
i = dtp->u.p.scale_factor;
- if (d <= 0 && i == 0)
+ if (d <= 0 && p == 0)
{
generate_error (&dtp->common, LIBERROR_FORMAT, "Precision not "
"greater than zero in format specifier 'E' or 'D'");
return FAILURE;
}
- if (i <= -d || i >= d + 2)
+ if (p <= -d || p >= d + 2)
{
generate_error (&dtp->common, LIBERROR_FORMAT, "Scale factor "
"out of range in format specifier 'E' or 'D'");
}
if (!zero_flag)
- e -= i;
- if (i < 0)
+ e -= p;
+ if (p < 0)
{
nbefore = 0;
- nzero = -i;
- nafter = d + i;
+ nzero = -p;
+ nafter = d + p;
}
- else if (i > 0)
+ else if (p > 0)
{
- nbefore = i;
+ nbefore = p;
nzero = 0;
- nafter = (d - i) + 1;
+ nafter = (d - p) + 1;
}
- else /* i == 0 */
+ else /* p == 0 */
{
nbefore = 0;
nzero = 0;
if (zero_flag)
goto skip;
+
/* Round the value. The value being rounded is an unsigned magnitude.
The ROUND_COMPATIBLE is rounding away from zero when there is a tie. */
switch (dtp->u.p.current_unit->round_status)
case ROUND_UP:
if (sign_bit)
goto skip;
- rchar = '0';
- break;
+ goto updown;
case ROUND_DOWN:
if (!sign_bit)
goto skip;
- rchar = '0';
- break;
+ goto updown;
case ROUND_NEAREST:
/* Round compatible unless there is a tie. A tie is a 5 with
all trailing zero's. */
if (digits[i] != '0')
goto do_rnd;
}
- /* It is a tie so round to even. */
+ /* It is a tie so round to even. */
switch (digits[nafter + nbefore - 1])
{
case '1':
case ROUND_UNSPECIFIED:
case ROUND_COMPATIBLE:
rchar = '5';
- /* Just fall through and do the actual rounding. */
+ goto do_rnd;
+ }
+
+ updown:
+
+ rchar = '0';
+ if (ft != FMT_F && w > 0 && d == 0 && p == 0)
+ nbefore = 1;
+ /* Scan for trailing zeros to see if we really need to round it. */
+ for(i = nbefore + nafter; i < ndigits; i++)
+ {
+ if (digits[i] != '0')
+ goto do_rnd;
}
+ goto skip;
do_rnd:
if (nbefore + nafter == 0)
{
ndigits = 0;
- if (nzero_real == d && digits[0] >= rchar)
+ if ((d == 0 || nzero_real == d) && digits[0] >= rchar)
{
/* We rounded to zero but shouldn't have */
- nzero--;
- nafter = 1;
+ if (d != 0)
+ {
+ nzero--;
+ nafter = 1;
+ }
+ else
+ {
+ /* Handle the case Fw.0 and value < 1.0 */
+ nbefore = 1;
+ digits--;
+ }
digits[0] = '1';
ndigits = 1;
}
}
else if (nbefore + nafter < ndigits)
{
- ndigits = nbefore + nafter;
- i = ndigits;
+ i = ndigits = nbefore + nafter;
if (digits[i] >= rchar)
{
/* Propagate the carry. */
/* Returns the value of 10**d. */
#define CALCULATE_EXP(x) \
-inline static GFC_REAL_ ## x \
+static GFC_REAL_ ## x \
calculate_exp_ ## x (int d)\
{\
int i;\
static void \
output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
GFC_REAL_ ## x m, char *buffer, size_t size, \
- int sign_bit, bool zero_flag, int ndigits, int edigits) \
+ int sign_bit, bool zero_flag, int ndigits, \
+ int edigits, int comp_d) \
{ \
int e = f->u.real.e;\
int d = f->u.real.d;\
int w = f->u.real.w;\
fnode *newf;\
- GFC_REAL_ ## x rexp_d, r = 0.5;\
+ GFC_REAL_ ## x exp_d, r = 0.5, r_sc;\
int low, high, mid;\
int ubound, lbound;\
char *p, pad = ' ';\
int save_scale_factor, nb = 0;\
try result;\
+ volatile GFC_REAL_ ## x temp;\
\
save_scale_factor = dtp->u.p.scale_factor;\
newf = (fnode *) get_mem (sizeof (fnode));\
break;\
}\
\
- rexp_d = calculate_exp_ ## x (-d);\
- if ((m > 0.0 && ((m < 0.1 - 0.1 * r * rexp_d) || (rexp_d * (m + r) >= 1.0)))\
+ exp_d = calculate_exp_ ## x (d);\
+ r_sc = (1 - r / exp_d);\
+ temp = 0.1 * r_sc;\
+ if ((m > 0.0 && ((m < temp) || (r >= (exp_d - m))))\
|| ((m == 0.0) && !(compile_options.allow_std\
- & (GFC_STD_F2003 | GFC_STD_F2008))))\
+ & (GFC_STD_F2003 | GFC_STD_F2008)))\
+ || d == 0)\
{ \
newf->format = FMT_E;\
newf->u.real.w = w;\
- newf->u.real.d = d;\
+ newf->u.real.d = d - comp_d;\
newf->u.real.e = e;\
nb = 0;\
goto finish;\
\
while (low <= high)\
{ \
- GFC_REAL_ ## x temp;\
mid = (low + high) / 2;\
\
- temp = (calculate_exp_ ## x (mid - 1) * (1 - r * rexp_d));\
- asm volatile ("" : "+m" (temp));\
+ temp = (calculate_exp_ ## x (mid - 1) * r_sc);\
\
if (m < temp)\
{ \
}\
}\
\
- if (e > 4)\
- e = 4;\
- if (e < 0)\
- nb = 4;\
- else\
- nb = e + 2;\
-\
- nb = nb >= w ? 0 : nb;\
+ nb = e <= 0 ? 4 : e + 2;\
+ nb = nb >= w ? w - 1 : nb;\
newf->format = FMT_F;\
- newf->u.real.w = f->u.real.w - nb;\
-\
- if (m == 0.0)\
- newf->u.real.d = d - 1;\
- else\
- newf->u.real.d = - (mid - d - 1);\
-\
+ newf->u.real.w = w - nb;\
+ newf->u.real.d = m == 0.0 ? d - 1 : -(mid - d - 1) ;\
dtp->u.p.scale_factor = 0;\
\
finish:\
gfc_char4_t *p4 = (gfc_char4_t *) p;\
memset4 (p4, pad, nb);\
}\
- else\
+ else \
memset (p, pad, nb);\
}\
}\
edigits);\
else \
output_float_FMT_G_ ## x (dtp, f, tmp, buffer, size, sign_bit, \
- zero_flag, ndigits, edigits);\
+ zero_flag, ndigits, edigits, comp_d);\
}\
/* Output a real number according to its format. */
static void
-write_float (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
+write_float (st_parameter_dt *dtp, const fnode *f, const char *source, \
+ int len, int comp_d)
{
#if defined(HAVE_GFC_REAL_16) || __LDBL_DIG__ > 18
-# define MIN_FIELD_WIDTH 48
+# define MIN_FIELD_WIDTH 49
#else
-# define MIN_FIELD_WIDTH 31
+# define MIN_FIELD_WIDTH 32
#endif
#define STR(x) STR1(x)
#define STR1(x) #x
to handle the largest number of exponent digits expected. */
edigits=4;
- if (f->format == FMT_F || f->format == FMT_EN || f->format == FMT_G
- || ((f->format == FMT_D || f->format == FMT_E)
- && dtp->u.p.scale_factor != 0))
- {
- /* Always convert at full precision to avoid double rounding. */
- ndigits = MIN_FIELD_WIDTH - 4 - edigits;
- }
- else
- {
- /* The number of digits is known, so let printf do the rounding. */
- if (f->format == FMT_ES)
- ndigits = f->u.real.d + 1;
- else
- ndigits = f->u.real.d;
- if (ndigits > MIN_FIELD_WIDTH - 4 - edigits)
- ndigits = MIN_FIELD_WIDTH - 4 - edigits;
- }
+ /* Always convert at full precision to avoid double rounding. */
+ ndigits = MIN_FIELD_WIDTH - 4 - edigits;
switch (len)
{