-/* Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012
- Free Software Foundation, Inc.
+/* Copyright (C) 2007-2015 Free Software Foundation, Inc.
Contributed by Andy Vaught
Write float code factoring to this file by Jerry DeLisle
F2003 I/O support contributed by Jerry DeLisle
/* Output a real number according to its format which is FMT_G free. */
-static try
+static bool
output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
int nprinted, int precision, int sign_bit, bool zero_flag)
{
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 ndigits, edigits;
p = dtp->u.p.scale_factor;
rchar = '5';
- nzero_real = -1;
/* We should always know the field width and precision. */
if (d < 0)
/* Make sure the decimal point is a '.'; depending on the
locale, this might not be the case otherwise. */
digits[nbefore] = '.';
- if (digits[0] == '0' && nbefore == 1)
- {
- digits++;
- nbefore--;
- ndigits--;
- }
- //printf("nbefore: %d, digits: %s\n", nbefore, digits);
if (p != 0)
{
if (p > 0)
if (nafter < 0)
nafter = 0;
nafter = d;
- nzero = nzero_real = 0;
- //printf("digits: %s\n", digits);
+ nzero = 0;
}
else /* p < 0 */
{
nafter = d + nbefore;
nbefore = 0;
}
- nzero_real = nzero;
if (nzero > d)
nzero = d;
}
}
else
{
- nzero = nzero_real = 0;
+ nzero = 0;
nafter = d;
}
+ while (digits[0] == '0' && nbefore > 0)
+ {
+ digits++;
+ nbefore--;
+ ndigits--;
+ }
+
expchar = 0;
/* If we need to do rounding ourselves, get rid of the dot by
moving the fractional part. */
if (dtp->u.p.current_unit->round_status != ROUND_UNSPECIFIED
&& dtp->u.p.current_unit->round_status != ROUND_PROCDEFINED)
memmove (digits + nbefore, digits + nbefore + 1, ndigits - nbefore);
- //printf("nbefore after p handling: %d, digits: %s\n", nbefore, digits);
break;
case FMT_E:
{
generate_error (&dtp->common, LIBERROR_FORMAT, "Precision not "
"greater than zero in format specifier 'E' or 'D'");
- return FAILURE;
+ return false;
}
if (p <= -d || p >= d + 2)
{
generate_error (&dtp->common, LIBERROR_FORMAT, "Scale factor "
"out of range in format specifier 'E' or 'D'");
- return FAILURE;
+ return false;
}
if (!zero_flag)
/* Round compatible unless there is a tie. A tie is a 5 with
all trailing zero's. */
i = nafter + nbefore;
- //printf("I = %d, digits = %s, nbefore = %d\n", i, digits, nbefore);
if (digits[i] == '5')
{
for(i++ ; i < ndigits; i++)
updown:
rchar = '0';
- if (w > 0 && d == 0 && p == 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++)
do_rnd:
if (nbefore + nafter == 0)
+ /* Handle the case Fw.0 and value < 1.0 */
{
ndigits = 0;
- if (nzero_real == d && digits[0] >= rchar)
+ if (digits[0] >= rchar)
{
/* We rounded to zero but shouldn't have */
- nzero--;
- nafter = 1;
+ nbefore = 1;
+ digits--;
digits[0] = '1';
ndigits = 1;
}
else if (nbefore + nafter < ndigits)
{
i = ndigits = nbefore + nafter;
- //printf("i: %d, digits: %s, nbefore: %d, nafter: %d\n", i, digits, nbefore, nafter);
if (digits[i] >= rchar)
{
/* Propagate the carry. */
/* Scan the digits string and count the number of zeros. If we make it
all the way through the loop, we know the value is zero after the
rounding completed above. */
- for (i = 0; i < ndigits; i++)
+ int hasdot = 0;
+ for (i = 0; i < ndigits + hasdot; i++)
{
- if (digits[i] != '0' && digits[i] != '.')
+ if (digits[i] == '.')
+ hasdot = 1;
+ else if (digits[i] != '0')
break;
}
/* To format properly, we need to know if the rounded result is zero and if
so, we set the zero_flag which may have been already set for
actual zero. */
- if (i == ndigits)
+ if (i == ndigits + hasdot)
{
zero_flag = true;
/* The output is zero, so set the sign according to the sign bit unless
/* Create the ouput buffer. */
out = write_block (dtp, w);
if (out == NULL)
- return FAILURE;
+ return false;
/* Check the value fits in the specified field width. */
if (nblanks < 0 || edigits == -1 || w == 1 || (w == 2 && sign != S_NONE))
{
gfc_char4_t *out4 = (gfc_char4_t *) out;
memset4 (out4, '*', w);
- return FAILURE;
+ return false;
}
star_fill (out, w);
- return FAILURE;
+ return false;
}
/* See if we have space for a zero before the decimal point. */
memset4 (out4, ' ' , nblanks);
dtp->u.p.no_leading_blank = 0;
}
- return SUCCESS;
+ return true;
} /* End of character(kind=4) internal unit code. */
/* Pad to full field width. */
dtp->u.p.no_leading_blank = 0;
}
- return SUCCESS;
+ return true;
}
#endif
+#if defined(GFC_REAL_16_IS_FLOAT128)
+#define ISFINITE2Q(val) finiteq(val)
+#endif
+#define ISFINITE2(val) isfinite(val)
+#define ISFINITE2L(val) isfinite(val)
+
+#define ISFINITE(suff,val) TOKENPASTE(ISFINITE2,suff)(val)
+
+
+#if defined(GFC_REAL_16_IS_FLOAT128)
+#define SIGNBIT2Q(val) signbitq(val)
+#endif
+#define SIGNBIT2(val) signbit(val)
+#define SIGNBIT2L(val) signbit(val)
+
+#define SIGNBIT(suff,val) TOKENPASTE(SIGNBIT2,suff)(val)
+
+
+#if defined(GFC_REAL_16_IS_FLOAT128)
+#define ISNAN2Q(val) isnanq(val)
+#endif
+#define ISNAN2(val) isnan(val)
+#define ISNAN2L(val) isnan(val)
+
+#define ISNAN(suff,val) TOKENPASTE(ISNAN2,suff)(val)
+
+
+
/* Generate corresponding I/O format for FMT_G and output.
The rules to translate FMT_G to FMT_E or FMT_F from DEC fortran
LRM (table 11-2, Chapter 11, "I/O Formatting", P11-25) is:
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;\
+ bool result;\
int nprinted, precision;\
+ volatile GFC_REAL_ ## x temp;\
\
save_scale_factor = dtp->u.p.scale_factor;\
\
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;\
\
while (low <= high)\
{ \
- volatile GFC_REAL_ ## x temp;\
mid = (low + high) / 2;\
\
- temp = (calculate_exp_ ## x (mid - 1) * (1 - r * rexp_d));\
+ temp = (calculate_exp_ ## x (mid - 1) * r_sc);\
\
if (m < temp)\
{ \
p = write_block (dtp, nb);\
if (p == NULL)\
return;\
- if (result == FAILURE)\
+ if (!result)\
pad = '*';\
if (unlikely (is_char4_unit (dtp)))\
{\
/* EN format is tricky since the number of significant digits depends
on the magnitude. Solve it by first printing a temporary value and
figure out the number of significant digits from the printed
- exponent. */
+ exponent. Values y, 0.95*10.0**e <= y <10.0**e, are rounded to
+ 10.0**e even when the final result will not be rounded to 10.0**e.
+ For these values the exponent returned by atoi has to be decremented
+ by one. The values y in the ranges
+ (1000.0-0.5*10.0**(-d))*10.0**(3*n) <= y < 10.0*(3*(n+1))
+ (100.0-0.5*10.0**(-d))*10.0**(3*n) <= y < 10.0*(3*n+2)
+ (10.0-0.5*10.0**(-d))*10.0**(3*n) <= y < 10.0*(3*n+1)
+ are correctly rounded respectively to 1.0...0*10.0*(3*(n+1)),
+ 100.0...0*10.0*(3*n), and 10.0...0*10.0*(3*n), where 0...0
+ represents d zeroes, by the lines 279 to 297. */
#define EN_PREC(x,y)\
{\
- GFC_REAL_ ## x tmp; \
- tmp = * (GFC_REAL_ ## x *)source; \
- if (isfinite (tmp)) \
- nprinted = DTOA(y,0,tmp); \
+ volatile GFC_REAL_ ## x tmp, one = 1.0;\
+ tmp = * (GFC_REAL_ ## x *)source;\
+ if (ISFINITE (y,tmp))\
+ {\
+ nprinted = DTOA(y,0,tmp);\
+ int e = atoi (&buffer[4]);\
+ if (buffer[1] == '1')\
+ {\
+ tmp = (calculate_exp_ ## x (-e)) * tmp;\
+ tmp = one - (tmp < 0 ? -tmp : tmp); \
+ if (tmp > 0)\
+ e = e - 1;\
+ }\
+ nbefore = e%3;\
+ if (nbefore < 0)\
+ nbefore = 3 + nbefore;\
+ }\
else\
nprinted = -1;\
}\
int nprinted;
char buffer[10];
const size_t size = 10;
+ int nbefore; /* digits before decimal point - 1. */
switch (len)
{
if (nprinted == -1)
return -1;
- int e = atoi (&buffer[5]);
- int nbefore; /* digits before decimal point - 1. */
- if (e >= 0)
- nbefore = e % 3;
- else
- {
- nbefore = (-e) % 3;
- if (nbefore != 0)
- nbefore = 3 - nbefore;
- }
int prec = f->u.real.d + nbefore;
if (dtp->u.p.current_unit->round_status != ROUND_UNSPECIFIED
&& dtp->u.p.current_unit->round_status != ROUND_PROCDEFINED)
{\
GFC_REAL_ ## x tmp;\
tmp = * (GFC_REAL_ ## x *)source;\
- sign_bit = signbit (tmp);\
- if (!isfinite (tmp))\
+ sign_bit = SIGNBIT (y,tmp);\
+ if (!ISFINITE (y,tmp))\
{ \
- write_infnan (dtp, f, isnan (tmp), sign_bit);\
+ write_infnan (dtp, f, ISNAN (y,tmp), sign_bit);\
return;\
}\
tmp = sign_bit ? -tmp : tmp;\
trailing null, and finally some extra digits depending on the
requested precision. */
const size_t size = 4932 + 3 + precision;
- char buffer[size];
+#define BUF_STACK_SZ 5000
+ char buf_stack[BUF_STACK_SZ];
+ char *buffer;
+ if (size > BUF_STACK_SZ)
+ buffer = xmalloc (size);
+ else
+ buffer = buf_stack;
switch (len)
{
default:
internal_error (NULL, "bad real kind");
}
+ if (size > BUF_STACK_SZ)
+ free (buffer);
}
projects / gcc.git / blobdiff