-/* Copyright (C) 2007 Free Software Foundation, Inc.
+/* Copyright (C) 2007, 2008, 2009, 2010 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
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
any later version.
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file. (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
-You should have received a copy of the GNU General Public License
-along with Libgfortran; see the file COPYING. If not, write to
-the Free Software Foundation, 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
#include "config.h"
typedef enum
-{ SIGN_NONE, SIGN_MINUS, SIGN_PLUS }
+{ S_NONE, S_MINUS, S_PLUS }
sign_t;
/* Given a flag that indicates if a value is negative or not, return a
static sign_t
calculate_sign (st_parameter_dt *dtp, int negative_flag)
{
- sign_t s = SIGN_NONE;
+ sign_t s = S_NONE;
if (negative_flag)
- s = SIGN_MINUS;
+ s = S_MINUS;
else
switch (dtp->u.p.sign_status)
{
- case SIGN_SP:
- s = SIGN_PLUS;
+ case SIGN_SP: /* Show sign. */
+ s = S_PLUS;
break;
- case SIGN_SS:
- s = SIGN_NONE;
+ case SIGN_SS: /* Suppress sign. */
+ s = S_NONE;
break;
- case SIGN_S:
- s = options.optional_plus ? SIGN_PLUS : SIGN_NONE;
+ case SIGN_S: /* Processor defined. */
+ case SIGN_UNSPECIFIED:
+ s = options.optional_plus ? S_PLUS : S_NONE;
break;
}
char *out;
char *digits;
int e;
- char expchar;
+ char expchar, rchar;
format_token ft;
int w;
int d;
w = f->u.real.w;
d = f->u.real.d;
+ rchar = '5';
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, sign_bit);
-
- /* # 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.
- */
-
- /* Check the given string has punctuation in the correct places. */
- if (d != 0 && (buffer[2] != '.' || buffer[ndigits + 2] != 'e'))
- internal_error (&dtp->common, "printf is broken");
+
+ /* The following code checks the given string has punctuation in the correct
+ places. Uncomment if needed for debugging.
+ if (d != 0 && ((buffer[2] != '.' && buffer[2] != ',')
+ || buffer[ndigits + 2] != 'e'))
+ internal_error (&dtp->common, "printf is broken"); */
/* Read the exponent back in. */
e = atoi (&buffer[ndigits + 3]) + 1;
sign = calculate_sign (dtp, sign_bit);
else
sign = calculate_sign (dtp, 0);
+
+ /* Handle special cases. */
+ if (w == 0)
+ w = d + 2;
+
+ /* For this one we choose to not output a decimal point.
+ F95 10.5.1.2.1 */
+ if (w == 1 && ft == FMT_F)
+ {
+ out = write_block (dtp, w);
+ if (out == NULL)
+ return;
+ *out = '0';
+ return;
+ }
+
}
/* Normalize the fractional component. */
switch (ft)
{
case FMT_F:
+ if (d == 0 && e <= 0 && dtp->u.p.scale_factor == 0)
+ {
+ memmove (digits + 1, digits, ndigits - 1);
+ digits[0] = '0';
+ e++;
+ }
+
nbefore = e + dtp->u.p.scale_factor;
if (nbefore < 0)
{
internal_error (&dtp->common, "Unexpected format token");
}
- /* Round the value. */
+ /* 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_ZERO: /* Do nothing and truncation occurs. */
+ goto skip;
+ case ROUND_UP:
+ if (sign_bit)
+ goto skip;
+ rchar = '0';
+ break;
+ case ROUND_DOWN:
+ if (!sign_bit)
+ goto skip;
+ rchar = '0';
+ break;
+ case ROUND_NEAREST:
+ /* Round compatible unless there is a tie. A tie is a 5 with
+ all trailing zero's. */
+ i = nafter + nbefore;
+ if (digits[i] == '5')
+ {
+ for(i++ ; i < ndigits; i++)
+ {
+ if (digits[i] != '0')
+ goto do_rnd;
+ }
+ /* It is a tie so round to even. */
+ switch (digits[nafter + nbefore - 1])
+ {
+ case '1':
+ case '3':
+ case '5':
+ case '7':
+ case '9':
+ /* If odd, round away from zero to even. */
+ break;
+ default:
+ /* If even, skip rounding, truncate to even. */
+ goto skip;
+ }
+ }
+ /* Fall through. */
+ case ROUND_PROCDEFINED:
+ case ROUND_UNSPECIFIED:
+ case ROUND_COMPATIBLE:
+ rchar = '5';
+ /* Just fall through and do the actual rounding. */
+ }
+
+ do_rnd:
+
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;
- }
+ if (nzero_real == d && digits[0] >= rchar)
+ {
+ /* 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')
+ if (digits[i] >= rchar)
{
/* Propagate the carry. */
for (i--; i >= 0; i--)
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. */
+ /* 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)
}
}
+ skip:
+
/* Calculate the format of the exponent field. */
if (expchar)
{
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++)
sign = calculate_sign (dtp, 0);
}
+ /* Pick a field size if none was specified. */
+ if (w <= 0)
+ w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1);
+
/* Work out how much padding is needed. */
nblanks = w - (nbefore + nzero + nafter + edigits + 1);
- if (sign != SIGN_NONE)
+ if (sign != S_NONE)
nblanks--;
+ if (dtp->u.p.g0_no_blanks)
+ {
+ w -= nblanks;
+ nblanks = 0;
+ }
+
+ /* Create the ouput buffer. */
+ out = write_block (dtp, w);
+ if (out == NULL)
+ return;
+
/* Check the value fits in the specified field width. */
if (nblanks < 0 || edigits == -1)
{
}
/* Output the initial sign (if any). */
- if (sign == SIGN_PLUS)
+ if (sign == S_PLUS)
*(out++) = '+';
- else if (sign == SIGN_MINUS)
+ else if (sign == S_MINUS)
*(out++) = '-';
/* Output an optional leading zero. */
digits += i;
out += nbefore;
}
+
/* Output the decimal point. */
- *(out++) = '.';
+ *(out++) = dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? '.' : ',';
/* Output leading zeros after the decimal point. */
if (nzero > 0)
#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
int d = f->u.real.d;\
int w = f->u.real.w;\
fnode *newf;\
- GFC_REAL_ ## x exp_d;\
+ GFC_REAL_ ## x rexp_d;\
int low, high, mid;\
int ubound, lbound;\
char *p;\
int save_scale_factor, nb = 0;\
\
save_scale_factor = dtp->u.p.scale_factor;\
- newf = get_mem (sizeof (fnode));\
+ newf = (fnode *) get_mem (sizeof (fnode));\
\
- exp_d = calculate_exp_ ## x (d);\
- if ((m > 0.0 && m < 0.1 - 0.05 / exp_d) || (m >= exp_d - 0.5 ) ||\
+ rexp_d = calculate_exp_ ## x (-d);\
+ if ((m > 0.0 && m < 0.1 - 0.05 * rexp_d) || (rexp_d * (m + 0.5) >= 1.0) ||\
((m == 0.0) && !(compile_options.allow_std & GFC_STD_F2003)))\
{ \
newf->format = FMT_E;\
GFC_REAL_ ## x temp;\
mid = (low + high) / 2;\
\
- temp = 0.1 * calculate_exp_ ## x (mid) - 0.5\
- * calculate_exp_ ## x (mid - d - 1);\
+ temp = (calculate_exp_ ## x (mid - 1) * (1 - 0.5 * rexp_d));\
\
if (m < temp)\
{ \
low = mid + 1;\
}\
else\
- break;\
+ {\
+ mid++;\
+ break;\
+ }\
}\
\
if (e < 0)\
edigits);\
dtp->u.p.scale_factor = save_scale_factor;\
\
- free_mem(newf);\
+ free (newf);\
\
- if (nb > 0)\
+ if (nb > 0 && !dtp->u.p.g0_no_blanks)\
{ \
p = write_block (dtp, nb);\
if (p == NULL)\
#undef OUTPUT_FLOAT_FMT_G
+
/* Define a macro to build code for write_float. */
+ /* Note: Before output_float is called, sprintf is used to print to buffer 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.
+
+ # 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. */
+
#ifdef HAVE_SNPRINTF
#define DTOA \
{\
GFC_REAL_ ## x tmp;\
tmp = * (GFC_REAL_ ## x *)source;\
- sign_bit = signbit (tmp);\
+ sign_bit = __builtin_signbit (tmp);\
if (!isfinite (tmp))\
{ \
write_infnan (dtp, f, isnan (tmp), sign_bit);\
return;\
}\
tmp = sign_bit ? -tmp : tmp;\
- if (f->u.real.d == 0 && f->format == FMT_F)\
- {\
- if (tmp < 0.5)\
- tmp = 0.0;\
- else if (tmp < 1.0)\
- tmp = tmp + 0.5;\
- }\
zero_flag = (tmp == 0.0);\
\
DTOA ## y\
OSDN Git Service
