From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- libgfortran/io/write_float.def | 1087 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1087 insertions(+) create mode 100644 libgfortran/io/write_float.def (limited to 'libgfortran/io/write_float.def') diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def new file mode 100644 index 000000000..b72cf9f56 --- /dev/null +++ b/libgfortran/io/write_float.def @@ -0,0 +1,1087 @@ +/* Copyright (C) 2007, 2008, 2009, 2010, 2011 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 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 3, or (at your option) +any later version. + +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. + +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 +. */ + +#include "config.h" + +typedef enum +{ S_NONE, S_MINUS, S_PLUS } +sign_t; + +/* Given a flag that indicates if a value is negative or not, return a + sign_t that gives the sign that we need to produce. */ + +static sign_t +calculate_sign (st_parameter_dt *dtp, int negative_flag) +{ + sign_t s = S_NONE; + + if (negative_flag) + s = S_MINUS; + else + switch (dtp->u.p.sign_status) + { + case SIGN_SP: /* Show sign. */ + s = S_PLUS; + break; + case SIGN_SS: /* Suppress sign. */ + s = S_NONE; + break; + case SIGN_S: /* Processor defined. */ + case SIGN_UNSPECIFIED: + s = options.optional_plus ? S_PLUS : S_NONE; + break; + } + + return s; +} + + +/* Output a real number according to its format which is FMT_G free. */ + +static try +output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, + int sign_bit, bool zero_flag, int ndigits, int edigits) +{ + char *out; + char *digits; + int e; + 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; + /* 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; + + ft = f->format; + 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"); + + sign = calculate_sign (dtp, sign_bit); + + /* 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; + + /* Make sure zero comes out as 0.0e0. */ + if (zero_flag) + 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: + 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) + { + 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 (d <= 0 && i == 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) + { + generate_error (&dtp->common, LIBERROR_FORMAT, "Scale factor " + "out of range in format specifier 'E' or 'D'"); + return FAILURE; + } + + if (!zero_flag) + 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 (!zero_flag) + 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 (!zero_flag) + e--; + nbefore = 1; + nzero = 0; + nafter = d; + expchar = 'E'; + break; + + default: + /* Should never happen. */ + internal_error (&dtp->common, "Unexpected format token"); + } + + /* 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] >= 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] >= rchar) + { + /* 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++; + } + } + } + + skip: + + /* 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; + + /* 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++) + { + 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) + { + zero_flag = true; + /* The output is zero, so set the sign according to the sign bit unless + -fno-sign-zero was specified. */ + if (compile_options.sign_zero == 1) + sign = calculate_sign (dtp, sign_bit); + else + sign = calculate_sign (dtp, 0); + } + + /* Pick a field size if none was specified, taking into account small + values that may have been rounded to zero. */ + if (w <= 0) + { + if (zero_flag) + w = d + (sign != S_NONE ? 2 : 1) + (d == 0 ? 1 : 0); + else + { + w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1); + w = w == 1 ? 2 : w; + } + } + + /* Work out how much padding is needed. */ + nblanks = w - (nbefore + nzero + nafter + edigits + 1); + 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 FAILURE; + + /* Check the value fits in the specified field width. */ + if (nblanks < 0 || edigits == -1 || w == 1 || (w == 2 && sign != S_NONE)) + { + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *out4 = (gfc_char4_t *) out; + memset4 (out4, '*', w); + return FAILURE; + } + star_fill (out, w); + return FAILURE; + } + + /* See if we have space for a zero before the decimal point. */ + if (nbefore == 0 && nblanks > 0) + { + leadzero = 1; + nblanks--; + } + else + leadzero = 0; + + /* For internal character(kind=4) units, we duplicate the code used for + regular output slightly modified. This needs to be maintained + consistent with the regular code that follows this block. */ + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *out4 = (gfc_char4_t *) out; + /* Pad to full field width. */ + + if ( ( nblanks > 0 ) && !dtp->u.p.no_leading_blank) + { + memset4 (out4, ' ', nblanks); + out4 += nblanks; + } + + /* Output the initial sign (if any). */ + if (sign == S_PLUS) + *(out4++) = '+'; + else if (sign == S_MINUS) + *(out4++) = '-'; + + /* Output an optional leading zero. */ + if (leadzero) + *(out4++) = '0'; + + /* Output the part before the decimal point, padding with zeros. */ + if (nbefore > 0) + { + if (nbefore > ndigits) + { + i = ndigits; + memcpy4 (out4, digits, i); + ndigits = 0; + while (i < nbefore) + out4[i++] = '0'; + } + else + { + i = nbefore; + memcpy4 (out4, digits, i); + ndigits -= i; + } + + digits += i; + out4 += nbefore; + } + + /* Output the decimal point. */ + *(out4++) = dtp->u.p.current_unit->decimal_status + == DECIMAL_POINT ? '.' : ','; + + /* Output leading zeros after the decimal point. */ + if (nzero > 0) + { + for (i = 0; i < nzero; i++) + *(out4++) = '0'; + } + + /* Output digits after the decimal point, padding with zeros. */ + if (nafter > 0) + { + if (nafter > ndigits) + i = ndigits; + else + i = nafter; + + memcpy4 (out4, digits, i); + while (i < nafter) + out4[i++] = '0'; + + digits += i; + ndigits -= i; + out4 += nafter; + } + + /* Output the exponent. */ + if (expchar) + { + if (expchar != ' ') + { + *(out4++) = expchar; + edigits--; + } +#if HAVE_SNPRINTF + snprintf (buffer, size, "%+0*d", edigits, e); +#else + sprintf (buffer, "%+0*d", edigits, e); +#endif + memcpy4 (out4, buffer, edigits); + } + + if (dtp->u.p.no_leading_blank) + { + out4 += edigits; + memset4 (out4, ' ' , nblanks); + dtp->u.p.no_leading_blank = 0; + } + return SUCCESS; + } /* End of character(kind=4) internal unit code. */ + + /* 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 == S_PLUS) + *(out++) = '+'; + else if (sign == S_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; + memcpy (out, digits, i); + ndigits = 0; + while (i < nbefore) + out[i++] = '0'; + } + else + { + i = nbefore; + memcpy (out, digits, i); + ndigits -= i; + } + + digits += i; + out += nbefore; + } + + /* Output the decimal point. */ + *(out++) = dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? '.' : ','; + + /* 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, size, "%+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 + return SUCCESS; +} + + +/* Write "Infinite" or "Nan" as appropriate for the given format. */ + +static void +write_infnan (st_parameter_dt *dtp, const fnode *f, int isnan_flag, int sign_bit) +{ + char * p, fin; + int nb = 0; + sign_t sign; + int mark; + + if (f->format != FMT_B && f->format != FMT_O && f->format != FMT_Z) + { + sign = calculate_sign (dtp, sign_bit); + mark = (sign == S_PLUS || sign == S_MINUS) ? 8 : 7; + + nb = f->u.real.w; + + /* If the field width is zero, the processor must select a width + not zero. 4 is chosen to allow output of '-Inf' or '+Inf' */ + + if (nb == 0) + { + if (isnan_flag) + nb = 3; + else + nb = (sign == S_PLUS || sign == S_MINUS) ? 4 : 3; + } + p = write_block (dtp, nb); + if (p == NULL) + return; + if (nb < 3) + { + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memset4 (p4, '*', nb); + } + else + memset (p, '*', nb); + return; + } + + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memset4 (p4, ' ', nb); + } + else + memset(p, ' ', nb); + + if (!isnan_flag) + { + if (sign_bit) + { + /* If the sign is negative and the width is 3, there is + insufficient room to output '-Inf', so output asterisks */ + if (nb == 3) + { + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memset4 (p4, '*', nb); + } + else + memset (p, '*', nb); + return; + } + /* The negative sign is mandatory */ + fin = '-'; + } + else + /* The positive sign is optional, but we output it for + consistency */ + fin = '+'; + + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + + if (nb > mark) + /* We have room, so output 'Infinity' */ + memcpy4 (p4 + nb - 8, "Infinity", 8); + else + /* For the case of width equals mark, there is not enough room + for the sign and 'Infinity' so we go with 'Inf' */ + memcpy4 (p4 + nb - 3, "Inf", 3); + + if (sign == S_PLUS || sign == S_MINUS) + { + if (nb < 9 && nb > 3) + /* Put the sign in front of Inf */ + p4[nb - 4] = (gfc_char4_t) fin; + else if (nb > 8) + /* Put the sign in front of Infinity */ + p4[nb - 9] = (gfc_char4_t) fin; + } + return; + } + + if (nb > mark) + /* We have room, so output 'Infinity' */ + memcpy(p + nb - 8, "Infinity", 8); + else + /* For the case of width equals 8, there is not enough room + for the sign and 'Infinity' so we go with 'Inf' */ + memcpy(p + nb - 3, "Inf", 3); + + if (sign == S_PLUS || sign == S_MINUS) + { + if (nb < 9 && nb > 3) + p[nb - 4] = fin; /* Put the sign in front of Inf */ + else if (nb > 8) + p[nb - 9] = fin; /* Put the sign in front of Infinity */ + } + } + else + { + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memcpy4 (p4 + nb - 3, "NaN", 3); + } + else + memcpy(p + nb - 3, "NaN", 3); + } + return; + } +} + + +/* Returns the value of 10**d. */ + +#define CALCULATE_EXP(x) \ +inline static GFC_REAL_ ## x \ +calculate_exp_ ## x (int d)\ +{\ + int i;\ + GFC_REAL_ ## x r = 1.0;\ + for (i = 0; i< (d >= 0 ? d : -d); i++)\ + r *= 10;\ + r = (d >= 0) ? r : 1.0 / r;\ + return r;\ +} + +CALCULATE_EXP(4) + +CALCULATE_EXP(8) + +#ifdef HAVE_GFC_REAL_10 +CALCULATE_EXP(10) +#endif + +#ifdef HAVE_GFC_REAL_16 +CALCULATE_EXP(16) +#endif +#undef CALCULATE_EXP + +/* 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: + + Data Magnitude Equivalent Conversion + 0< m < 0.1-0.5*10**(-d-1) Ew.d[Ee] + m = 0 F(w-n).(d-1), n' ' + 0.1-0.5*10**(-d-1)<= m < 1-0.5*10**(-d) F(w-n).d, n' ' + 1-0.5*10**(-d)<= m < 10-0.5*10**(-d+1) F(w-n).(d-1), n' ' + 10-0.5*10**(-d+1)<= m < 100-0.5*10**(-d+2) F(w-n).(d-2), n' ' + ................ .......... + 10**(d-1)-0.5*10**(-1)<= m <10**d-0.5 F(w-n).0,n(' ') + m >= 10**d-0.5 Ew.d[Ee] + + notes: for Gw.d , n' ' means 4 blanks + for Gw.dEe, n' ' means e+2 blanks */ + +#define OUTPUT_FLOAT_FMT_G(x) \ +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 e = f->u.real.e;\ + int d = f->u.real.d;\ + int w = f->u.real.w;\ + fnode *newf;\ + GFC_REAL_ ## x rexp_d;\ + int low, high, mid;\ + int ubound, lbound;\ + char *p, pad = ' ';\ + int save_scale_factor, nb = 0;\ + try result;\ +\ + save_scale_factor = dtp->u.p.scale_factor;\ + newf = (fnode *) get_mem (sizeof (fnode));\ +\ + 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;\ + newf->u.real.w = w;\ + newf->u.real.d = d;\ + newf->u.real.e = e;\ + nb = 0;\ + goto finish;\ + }\ +\ + mid = 0;\ + low = 0;\ + high = d + 1;\ + lbound = 0;\ + ubound = d + 1;\ +\ + while (low <= high)\ + { \ + GFC_REAL_ ## x temp;\ + mid = (low + high) / 2;\ +\ + temp = (calculate_exp_ ## x (mid - 1) * (1 - 0.5 * rexp_d));\ +\ + if (m < temp)\ + { \ + ubound = mid;\ + if (ubound == lbound + 1)\ + break;\ + high = mid - 1;\ + }\ + else if (m > temp)\ + { \ + lbound = mid;\ + if (ubound == lbound + 1)\ + { \ + mid ++;\ + break;\ + }\ + low = mid + 1;\ + }\ + else\ + {\ + mid++;\ + break;\ + }\ + }\ +\ + if (e > 4)\ + e = 4;\ + if (e < 0)\ + nb = 4;\ + else\ + nb = e + 2;\ +\ + nb = nb >= w ? 0 : 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);\ +\ + dtp->u.p.scale_factor = 0;\ +\ + finish:\ + result = output_float (dtp, newf, buffer, size, sign_bit, zero_flag, \ + ndigits, edigits);\ + dtp->u.p.scale_factor = save_scale_factor;\ +\ + free (newf);\ +\ + if (nb > 0 && !dtp->u.p.g0_no_blanks)\ + {\ + p = write_block (dtp, nb);\ + if (p == NULL)\ + return;\ + if (result == FAILURE)\ + pad = '*';\ + if (unlikely (is_char4_unit (dtp)))\ + {\ + gfc_char4_t *p4 = (gfc_char4_t *) p;\ + memset4 (p4, pad, nb);\ + }\ + else\ + memset (p, pad, nb);\ + }\ +}\ + +OUTPUT_FLOAT_FMT_G(4) + +OUTPUT_FLOAT_FMT_G(8) + +#ifdef HAVE_GFC_REAL_10 +OUTPUT_FLOAT_FMT_G(10) +#endif + +#ifdef HAVE_GFC_REAL_16 +OUTPUT_FLOAT_FMT_G(16) +#endif + +#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 \ +snprintf (buffer, size, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \ + "e", ndigits - 1, tmp); + +#define DTOAL \ +snprintf (buffer, size, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \ + "Le", ndigits - 1, tmp); + +#else + +#define DTOA \ +sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \ + "e", ndigits - 1, tmp); + +#define DTOAL \ +sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \ + "Le", ndigits - 1, tmp); + +#endif + +#if defined(GFC_REAL_16_IS_FLOAT128) +#define DTOAQ \ +__qmath_(quadmath_snprintf) (buffer, sizeof buffer, \ + "%+-#" STR(MIN_FIELD_WIDTH) ".*" \ + "Qe", ndigits - 1, tmp); +#endif + +#define WRITE_FLOAT(x,y)\ +{\ + GFC_REAL_ ## x tmp;\ + tmp = * (GFC_REAL_ ## x *)source;\ + sign_bit = signbit (tmp);\ + if (!isfinite (tmp))\ + { \ + write_infnan (dtp, f, isnan (tmp), sign_bit);\ + return;\ + }\ + tmp = sign_bit ? -tmp : tmp;\ + zero_flag = (tmp == 0.0);\ +\ + DTOA ## y\ +\ + if (f->format != FMT_G)\ + output_float (dtp, f, buffer, size, sign_bit, zero_flag, ndigits, \ + edigits);\ + else \ + output_float_FMT_G_ ## x (dtp, f, tmp, buffer, size, sign_bit, \ + zero_flag, ndigits, edigits);\ +}\ + +/* Output a real number according to its format. */ + +static void +write_float (st_parameter_dt *dtp, const fnode *f, const char *source, int len) +{ + +#if defined(HAVE_GFC_REAL_16) || __LDBL_DIG__ > 18 +# define MIN_FIELD_WIDTH 48 +#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]; + int sign_bit, ndigits, edigits; + bool zero_flag; + size_t size; + + size = MIN_FIELD_WIDTH+1; + + /* printf pads blanks for us on the exponent so we just need it big enough + 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; + } + + switch (len) + { + case 4: + WRITE_FLOAT(4,) + break; + + case 8: + WRITE_FLOAT(8,) + break; + +#ifdef HAVE_GFC_REAL_10 + case 10: + WRITE_FLOAT(10,L) + break; +#endif +#ifdef HAVE_GFC_REAL_16 + case 16: +# ifdef GFC_REAL_16_IS_FLOAT128 + WRITE_FLOAT(16,Q) +# else + WRITE_FLOAT(16,L) +# endif + break; +#endif + default: + internal_error (NULL, "bad real kind"); + } +} -- cgit v1.2.3