1 /* Copyright (C) 2007-2013 Free Software Foundation, Inc.
2 Contributed by Andy Vaught
3 Write float code factoring to this file by Jerry DeLisle
4 F2003 I/O support contributed by Jerry DeLisle
6 This file is part of the GNU Fortran runtime library (libgfortran).
8 Libgfortran is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 Libgfortran is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 Under Section 7 of GPL version 3, you are granted additional
19 permissions described in the GCC Runtime Library Exception, version
20 3.1, as published by the Free Software Foundation.
22 You should have received a copy of the GNU General Public License and
23 a copy of the GCC Runtime Library Exception along with this program;
24 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
25 <http://www.gnu.org/licenses/>. */
30 { S_NONE, S_MINUS, S_PLUS }
33 /* Given a flag that indicates if a value is negative or not, return a
34 sign_t that gives the sign that we need to produce. */
37 calculate_sign (st_parameter_dt *dtp, int negative_flag)
44 switch (dtp->u.p.sign_status)
46 case SIGN_SP: /* Show sign. */
49 case SIGN_SS: /* Suppress sign. */
52 case SIGN_S: /* Processor defined. */
53 case SIGN_UNSPECIFIED:
54 s = options.optional_plus ? S_PLUS : S_NONE;
62 /* Determine the precision except for EN format. For G format,
63 determines an upper bound to be used for sizing the buffer. */
66 determine_precision (st_parameter_dt * dtp, const fnode * f, int len)
68 int precision = f->u.real.d;
74 precision += dtp->u.p.scale_factor;
77 /* Scale factor has no effect on output. */
81 /* See F2008 10.7.2.3.3.6 */
82 if (dtp->u.p.scale_factor <= 0)
83 precision += dtp->u.p.scale_factor - 1;
89 /* If the scale factor has a large negative value, we must do our
90 own rounding? Use ROUND='NEAREST', which should be what snprintf
93 (dtp->u.p.current_unit->round_status == ROUND_UNSPECIFIED
94 || dtp->u.p.current_unit->round_status == ROUND_PROCDEFINED))
95 dtp->u.p.current_unit->round_status = ROUND_NEAREST;
97 /* Add extra guard digits up to at least full precision when we do
99 if (dtp->u.p.current_unit->round_status != ROUND_UNSPECIFIED
100 && dtp->u.p.current_unit->round_status != ROUND_PROCDEFINED)
102 precision += 2 * len + 4;
111 /* Output a real number according to its format which is FMT_G free. */
114 output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
115 int nprinted, int precision, int sign_bit, bool zero_flag)
122 /* Number of digits before the decimal point. */
124 /* Number of zeros after the decimal point. */
126 /* Number of digits after the decimal point. */
128 /* Number of zeros after the decimal point, whatever the precision. */
132 int ndigits, edigits;
138 p = dtp->u.p.scale_factor;
143 /* We should always know the field width and precision. */
145 internal_error (&dtp->common, "Unspecified precision");
147 sign = calculate_sign (dtp, sign_bit);
149 /* Calculate total number of digits. */
151 ndigits = nprinted - 2;
153 ndigits = precision + 1;
155 /* Read the exponent back in. */
157 e = atoi (&buffer[ndigits + 3]) + 1;
161 /* Make sure zero comes out as 0.0e0. */
165 /* Normalize the fractional component. */
168 buffer[2] = buffer[1];
174 /* Figure out where to place the decimal point. */
178 nbefore = ndigits - precision;
179 /* Make sure the decimal point is a '.'; depending on the
180 locale, this might not be the case otherwise. */
181 digits[nbefore] = '.';
187 memmove (digits + nbefore, digits + nbefore + 1, p);
188 digits[nbefore + p] = '.';
194 nzero = nzero_real = 0;
198 if (nbefore + p >= 0)
201 memmove (digits + nbefore + p + 1, digits + nbefore + p, -p);
203 digits[nbefore] = '.';
208 nzero = -(nbefore + p);
209 memmove (digits + 1, digits, nbefore);
211 nafter = d + nbefore;
221 nzero = nzero_real = 0;
225 while (digits[0] == '0' && nbefore > 0)
233 /* If we need to do rounding ourselves, get rid of the dot by
234 moving the fractional part. */
235 if (dtp->u.p.current_unit->round_status != ROUND_UNSPECIFIED
236 && dtp->u.p.current_unit->round_status != ROUND_PROCDEFINED)
237 memmove (digits + nbefore, digits + nbefore + 1, ndigits - nbefore);
242 i = dtp->u.p.scale_factor;
243 if (d <= 0 && p == 0)
245 generate_error (&dtp->common, LIBERROR_FORMAT, "Precision not "
246 "greater than zero in format specifier 'E' or 'D'");
249 if (p <= -d || p >= d + 2)
251 generate_error (&dtp->common, LIBERROR_FORMAT, "Scale factor "
252 "out of range in format specifier 'E' or 'D'");
268 nafter = (d - p) + 1;
284 /* The exponent must be a multiple of three, with 1-3 digits before
285 the decimal point. */
294 nbefore = 3 - nbefore;
313 /* Should never happen. */
314 internal_error (&dtp->common, "Unexpected format token");
320 /* Round the value. The value being rounded is an unsigned magnitude. */
321 switch (dtp->u.p.current_unit->round_status)
323 /* For processor defined and unspecified rounding we use
324 snprintf to print the exact number of digits needed, and thus
325 let snprintf handle the rounding. On system claiming support
326 for IEEE 754, this ought to be round to nearest, ties to
327 even, corresponding to the Fortran ROUND='NEAREST'. */
328 case ROUND_PROCDEFINED:
329 case ROUND_UNSPECIFIED:
330 case ROUND_ZERO: /* Do nothing and truncation occurs. */
341 /* Round compatible unless there is a tie. A tie is a 5 with
342 all trailing zero's. */
343 i = nafter + nbefore;
344 if (digits[i] == '5')
346 for(i++ ; i < ndigits; i++)
348 if (digits[i] != '0')
351 /* It is a tie so round to even. */
352 switch (digits[nafter + nbefore - 1])
359 /* If odd, round away from zero to even. */
362 /* If even, skip rounding, truncate to even. */
367 /* The ROUND_COMPATIBLE is rounding away from zero when there is a tie. */
368 case ROUND_COMPATIBLE:
376 if (w > 0 && d == 0 && p == 0)
378 /* Scan for trailing zeros to see if we really need to round it. */
379 for(i = nbefore + nafter; i < ndigits; i++)
381 if (digits[i] != '0')
388 if (nbefore + nafter == 0)
391 if (nzero_real == d && digits[0] >= rchar)
393 /* We rounded to zero but shouldn't have */
400 else if (nbefore + nafter < ndigits)
402 i = ndigits = nbefore + nafter;
403 if (digits[i] >= rchar)
405 /* Propagate the carry. */
406 for (i--; i >= 0; i--)
408 if (digits[i] != '9')
418 /* The carry overflowed. Fortunately we have some spare
419 space at the start of the buffer. We may discard some
420 digits, but this is ok because we already know they are
434 else if (ft == FMT_EN)
451 /* Calculate the format of the exponent field. */
455 for (i = abs (e); i >= 10; i /= 10)
460 /* Width not specified. Must be no more than 3 digits. */
461 if (e > 999 || e < -999)
466 if (e > 99 || e < -99)
472 /* Exponent width specified, check it is wide enough. */
473 if (edigits > f->u.real.e)
476 edigits = f->u.real.e + 2;
482 /* Scan the digits string and count the number of zeros. If we make it
483 all the way through the loop, we know the value is zero after the
484 rounding completed above. */
486 for (i = 0; i < ndigits + hasdot; i++)
488 if (digits[i] == '.')
490 else if (digits[i] != '0')
494 /* To format properly, we need to know if the rounded result is zero and if
495 so, we set the zero_flag which may have been already set for
497 if (i == ndigits + hasdot)
500 /* The output is zero, so set the sign according to the sign bit unless
501 -fno-sign-zero was specified. */
502 if (compile_options.sign_zero == 1)
503 sign = calculate_sign (dtp, sign_bit);
505 sign = calculate_sign (dtp, 0);
508 /* Pick a field size if none was specified, taking into account small
509 values that may have been rounded to zero. */
513 w = d + (sign != S_NONE ? 2 : 1) + (d == 0 ? 1 : 0);
516 w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1);
521 /* Work out how much padding is needed. */
522 nblanks = w - (nbefore + nzero + nafter + edigits + 1);
526 if (dtp->u.p.g0_no_blanks)
532 /* Create the ouput buffer. */
533 out = write_block (dtp, w);
537 /* Check the value fits in the specified field width. */
538 if (nblanks < 0 || edigits == -1 || w == 1 || (w == 2 && sign != S_NONE))
540 if (unlikely (is_char4_unit (dtp)))
542 gfc_char4_t *out4 = (gfc_char4_t *) out;
543 memset4 (out4, '*', w);
550 /* See if we have space for a zero before the decimal point. */
551 if (nbefore == 0 && nblanks > 0)
559 /* For internal character(kind=4) units, we duplicate the code used for
560 regular output slightly modified. This needs to be maintained
561 consistent with the regular code that follows this block. */
562 if (unlikely (is_char4_unit (dtp)))
564 gfc_char4_t *out4 = (gfc_char4_t *) out;
565 /* Pad to full field width. */
567 if ( ( nblanks > 0 ) && !dtp->u.p.no_leading_blank)
569 memset4 (out4, ' ', nblanks);
573 /* Output the initial sign (if any). */
576 else if (sign == S_MINUS)
579 /* Output an optional leading zero. */
583 /* Output the part before the decimal point, padding with zeros. */
586 if (nbefore > ndigits)
589 memcpy4 (out4, digits, i);
597 memcpy4 (out4, digits, i);
605 /* Output the decimal point. */
606 *(out4++) = dtp->u.p.current_unit->decimal_status
607 == DECIMAL_POINT ? '.' : ',';
609 && (dtp->u.p.current_unit->round_status == ROUND_UNSPECIFIED
610 || dtp->u.p.current_unit->round_status == ROUND_PROCDEFINED))
613 /* Output leading zeros after the decimal point. */
616 for (i = 0; i < nzero; i++)
620 /* Output digits after the decimal point, padding with zeros. */
623 if (nafter > ndigits)
628 memcpy4 (out4, digits, i);
637 /* Output the exponent. */
645 snprintf (buffer, size, "%+0*d", edigits, e);
646 memcpy4 (out4, buffer, edigits);
649 if (dtp->u.p.no_leading_blank)
652 memset4 (out4, ' ' , nblanks);
653 dtp->u.p.no_leading_blank = 0;
656 } /* End of character(kind=4) internal unit code. */
658 /* Pad to full field width. */
660 if ( ( nblanks > 0 ) && !dtp->u.p.no_leading_blank)
662 memset (out, ' ', nblanks);
666 /* Output the initial sign (if any). */
669 else if (sign == S_MINUS)
672 /* Output an optional leading zero. */
676 /* Output the part before the decimal point, padding with zeros. */
679 if (nbefore > ndigits)
682 memcpy (out, digits, i);
690 memcpy (out, digits, i);
698 /* Output the decimal point. */
699 *(out++) = dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? '.' : ',';
701 && (dtp->u.p.current_unit->round_status == ROUND_UNSPECIFIED
702 || dtp->u.p.current_unit->round_status == ROUND_PROCDEFINED))
705 /* Output leading zeros after the decimal point. */
708 for (i = 0; i < nzero; i++)
712 /* Output digits after the decimal point, padding with zeros. */
715 if (nafter > ndigits)
720 memcpy (out, digits, i);
729 /* Output the exponent. */
737 snprintf (buffer, size, "%+0*d", edigits, e);
738 memcpy (out, buffer, edigits);
741 if (dtp->u.p.no_leading_blank)
744 memset( out , ' ' , nblanks );
745 dtp->u.p.no_leading_blank = 0;
752 /* Write "Infinite" or "Nan" as appropriate for the given format. */
755 write_infnan (st_parameter_dt *dtp, const fnode *f, int isnan_flag, int sign_bit)
762 if (f->format != FMT_B && f->format != FMT_O && f->format != FMT_Z)
764 sign = calculate_sign (dtp, sign_bit);
765 mark = (sign == S_PLUS || sign == S_MINUS) ? 8 : 7;
769 /* If the field width is zero, the processor must select a width
770 not zero. 4 is chosen to allow output of '-Inf' or '+Inf' */
772 if ((nb == 0) || dtp->u.p.g0_no_blanks)
777 nb = (sign == S_PLUS || sign == S_MINUS) ? 4 : 3;
779 p = write_block (dtp, nb);
784 if (unlikely (is_char4_unit (dtp)))
786 gfc_char4_t *p4 = (gfc_char4_t *) p;
787 memset4 (p4, '*', nb);
794 if (unlikely (is_char4_unit (dtp)))
796 gfc_char4_t *p4 = (gfc_char4_t *) p;
797 memset4 (p4, ' ', nb);
806 /* If the sign is negative and the width is 3, there is
807 insufficient room to output '-Inf', so output asterisks */
810 if (unlikely (is_char4_unit (dtp)))
812 gfc_char4_t *p4 = (gfc_char4_t *) p;
813 memset4 (p4, '*', nb);
819 /* The negative sign is mandatory */
823 /* The positive sign is optional, but we output it for
827 if (unlikely (is_char4_unit (dtp)))
829 gfc_char4_t *p4 = (gfc_char4_t *) p;
832 /* We have room, so output 'Infinity' */
833 memcpy4 (p4 + nb - 8, "Infinity", 8);
835 /* For the case of width equals mark, there is not enough room
836 for the sign and 'Infinity' so we go with 'Inf' */
837 memcpy4 (p4 + nb - 3, "Inf", 3);
839 if (sign == S_PLUS || sign == S_MINUS)
841 if (nb < 9 && nb > 3)
842 /* Put the sign in front of Inf */
843 p4[nb - 4] = (gfc_char4_t) fin;
845 /* Put the sign in front of Infinity */
846 p4[nb - 9] = (gfc_char4_t) fin;
852 /* We have room, so output 'Infinity' */
853 memcpy(p + nb - 8, "Infinity", 8);
855 /* For the case of width equals 8, there is not enough room
856 for the sign and 'Infinity' so we go with 'Inf' */
857 memcpy(p + nb - 3, "Inf", 3);
859 if (sign == S_PLUS || sign == S_MINUS)
861 if (nb < 9 && nb > 3)
862 p[nb - 4] = fin; /* Put the sign in front of Inf */
864 p[nb - 9] = fin; /* Put the sign in front of Infinity */
869 if (unlikely (is_char4_unit (dtp)))
871 gfc_char4_t *p4 = (gfc_char4_t *) p;
872 memcpy4 (p4 + nb - 3, "NaN", 3);
875 memcpy(p + nb - 3, "NaN", 3);
882 /* Returns the value of 10**d. */
884 #define CALCULATE_EXP(x) \
885 static GFC_REAL_ ## x \
886 calculate_exp_ ## x (int d)\
889 GFC_REAL_ ## x r = 1.0;\
890 for (i = 0; i< (d >= 0 ? d : -d); i++)\
892 r = (d >= 0) ? r : 1.0 / r;\
900 #ifdef HAVE_GFC_REAL_10
904 #ifdef HAVE_GFC_REAL_16
910 /* Define a macro to build code for write_float. */
912 /* Note: Before output_float is called, snprintf is used to print to buffer the
913 number in the format +D.DDDDe+ddd.
915 # The result will always contain a decimal point, even if no
918 - The converted value is to be left adjusted on the field boundary
920 + A sign (+ or -) always be placed before a number
922 * prec is used as the precision
924 e format: [-]d.ddde±dd where there is one digit before the
925 decimal-point character and the number of digits after it is
926 equal to the precision. The exponent always contains at least two
927 digits; if the value is zero, the exponent is 00. */
930 #define TOKENPASTE(x, y) TOKENPASTE2(x, y)
931 #define TOKENPASTE2(x, y) x ## y
933 #define DTOA(suff,prec,val) TOKENPASTE(DTOA2,suff)(prec,val)
935 #define DTOA2(prec,val) \
936 snprintf (buffer, size, "%+-#.*e", (prec), (val))
938 #define DTOA2L(prec,val) \
939 snprintf (buffer, size, "%+-#.*Le", (prec), (val))
942 #if defined(GFC_REAL_16_IS_FLOAT128)
943 #define DTOA2Q(prec,val) \
944 __qmath_(quadmath_snprintf) (buffer, size, "%+-#.*Qe", (prec), (val))
947 #define FDTOA(suff,prec,val) TOKENPASTE(FDTOA2,suff)(prec,val)
949 /* For F format, we print to the buffer with f format. */
950 #define FDTOA2(prec,val) \
951 snprintf (buffer, size, "%+-#.*f", (prec), (val))
953 #define FDTOA2L(prec,val) \
954 snprintf (buffer, size, "%+-#.*Lf", (prec), (val))
957 #if defined(GFC_REAL_16_IS_FLOAT128)
958 #define FDTOA2Q(prec,val) \
959 __qmath_(quadmath_snprintf) (buffer, size, "%+-#.*Qf", \
964 #if defined(GFC_REAL_16_IS_FLOAT128)
965 #define ISFINITE2Q(val) finiteq(val)
967 #define ISFINITE2(val) isfinite(val)
968 #define ISFINITE2L(val) isfinite(val)
970 #define ISFINITE(suff,val) TOKENPASTE(ISFINITE2,suff)(val)
973 #if defined(GFC_REAL_16_IS_FLOAT128)
974 #define SIGNBIT2Q(val) signbitq(val)
976 #define SIGNBIT2(val) signbit(val)
977 #define SIGNBIT2L(val) signbit(val)
979 #define SIGNBIT(suff,val) TOKENPASTE(SIGNBIT2,suff)(val)
982 #if defined(GFC_REAL_16_IS_FLOAT128)
983 #define ISNAN2Q(val) isnanq(val)
985 #define ISNAN2(val) isnan(val)
986 #define ISNAN2L(val) isnan(val)
988 #define ISNAN(suff,val) TOKENPASTE(ISNAN2,suff)(val)
992 /* Generate corresponding I/O format for FMT_G and output.
993 The rules to translate FMT_G to FMT_E or FMT_F from DEC fortran
994 LRM (table 11-2, Chapter 11, "I/O Formatting", P11-25) is:
996 Data Magnitude Equivalent Conversion
997 0< m < 0.1-0.5*10**(-d-1) Ew.d[Ee]
998 m = 0 F(w-n).(d-1), n' '
999 0.1-0.5*10**(-d-1)<= m < 1-0.5*10**(-d) F(w-n).d, n' '
1000 1-0.5*10**(-d)<= m < 10-0.5*10**(-d+1) F(w-n).(d-1), n' '
1001 10-0.5*10**(-d+1)<= m < 100-0.5*10**(-d+2) F(w-n).(d-2), n' '
1002 ................ ..........
1003 10**(d-1)-0.5*10**(-1)<= m <10**d-0.5 F(w-n).0,n(' ')
1004 m >= 10**d-0.5 Ew.d[Ee]
1006 notes: for Gw.d , n' ' means 4 blanks
1007 for Gw.dEe, n' ' means e+2 blanks
1008 for rounding modes adjustment, r, See Fortran F2008 10.7.5.2.2
1009 the asm volatile is required for 32-bit x86 platforms. */
1011 #define OUTPUT_FLOAT_FMT_G(x,y) \
1013 output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
1014 GFC_REAL_ ## x m, char *buffer, size_t size, \
1015 int sign_bit, bool zero_flag, int comp_d) \
1017 int e = f->u.real.e;\
1018 int d = f->u.real.d;\
1019 int w = f->u.real.w;\
1021 GFC_REAL_ ## x rexp_d, r = 0.5;\
1022 int low, high, mid;\
1023 int ubound, lbound;\
1024 char *p, pad = ' ';\
1025 int save_scale_factor, nb = 0;\
1027 int nprinted, precision;\
1029 save_scale_factor = dtp->u.p.scale_factor;\
1031 switch (dtp->u.p.current_unit->round_status)\
1034 r = sign_bit ? 1.0 : 0.0;\
1046 rexp_d = calculate_exp_ ## x (-d);\
1047 if ((m > 0.0 && ((m < 0.1 - 0.1 * r * rexp_d) || (rexp_d * (m + r) >= 1.0)))\
1048 || ((m == 0.0) && !(compile_options.allow_std\
1049 & (GFC_STD_F2003 | GFC_STD_F2008))))\
1051 newf.format = FMT_E;\
1053 newf.u.real.d = d - comp_d;\
1056 precision = determine_precision (dtp, &newf, x);\
1057 nprinted = DTOA(y,precision,m); \
1067 while (low <= high)\
1069 volatile GFC_REAL_ ## x temp;\
1070 mid = (low + high) / 2;\
1072 temp = (calculate_exp_ ## x (mid - 1) * (1 - r * rexp_d));\
1077 if (ubound == lbound + 1)\
1084 if (ubound == lbound + 1)\
1098 nb = e <= 0 ? 4 : e + 2;\
1099 nb = nb >= w ? w - 1 : nb;\
1100 newf.format = FMT_F;\
1101 newf.u.real.w = w - nb;\
1102 newf.u.real.d = m == 0.0 ? d - 1 : -(mid - d - 1) ;\
1103 dtp->u.p.scale_factor = 0;\
1104 precision = determine_precision (dtp, &newf, x); \
1105 nprinted = FDTOA(y,precision,m); \
1108 result = output_float (dtp, &newf, buffer, size, nprinted, precision,\
1109 sign_bit, zero_flag);\
1110 dtp->u.p.scale_factor = save_scale_factor;\
1113 if (nb > 0 && !dtp->u.p.g0_no_blanks)\
1115 p = write_block (dtp, nb);\
1120 if (unlikely (is_char4_unit (dtp)))\
1122 gfc_char4_t *p4 = (gfc_char4_t *) p;\
1123 memset4 (p4, pad, nb);\
1126 memset (p, pad, nb);\
1130 OUTPUT_FLOAT_FMT_G(4,)
1132 OUTPUT_FLOAT_FMT_G(8,)
1134 #ifdef HAVE_GFC_REAL_10
1135 OUTPUT_FLOAT_FMT_G(10,L)
1138 #ifdef HAVE_GFC_REAL_16
1139 # ifdef GFC_REAL_16_IS_FLOAT128
1140 OUTPUT_FLOAT_FMT_G(16,Q)
1142 OUTPUT_FLOAT_FMT_G(16,L)
1146 #undef OUTPUT_FLOAT_FMT_G
1149 /* EN format is tricky since the number of significant digits depends
1150 on the magnitude. Solve it by first printing a temporary value and
1151 figure out the number of significant digits from the printed
1154 #define EN_PREC(x,y)\
1156 GFC_REAL_ ## x tmp; \
1157 tmp = * (GFC_REAL_ ## x *)source; \
1158 if (ISFINITE (y,tmp)) \
1159 nprinted = DTOA(y,0,tmp); \
1165 determine_en_precision (st_parameter_dt *dtp, const fnode *f,
1166 const char *source, int len)
1170 const size_t size = 10;
1182 #ifdef HAVE_GFC_REAL_10
1187 #ifdef HAVE_GFC_REAL_16
1189 # ifdef GFC_REAL_16_IS_FLOAT128
1197 internal_error (NULL, "bad real kind");
1203 int e = atoi (&buffer[5]);
1204 int nbefore; /* digits before decimal point - 1. */
1211 nbefore = 3 - nbefore;
1213 int prec = f->u.real.d + nbefore;
1214 if (dtp->u.p.current_unit->round_status != ROUND_UNSPECIFIED
1215 && dtp->u.p.current_unit->round_status != ROUND_PROCDEFINED)
1216 prec += 2 * len + 4;
1221 #define WRITE_FLOAT(x,y)\
1223 GFC_REAL_ ## x tmp;\
1224 tmp = * (GFC_REAL_ ## x *)source;\
1225 sign_bit = SIGNBIT (y,tmp);\
1226 if (!ISFINITE (y,tmp))\
1228 write_infnan (dtp, f, ISNAN (y,tmp), sign_bit);\
1231 tmp = sign_bit ? -tmp : tmp;\
1232 zero_flag = (tmp == 0.0);\
1233 if (f->format == FMT_G)\
1234 output_float_FMT_G_ ## x (dtp, f, tmp, buffer, size, sign_bit, \
1235 zero_flag, comp_d);\
1238 if (f->format == FMT_F)\
1239 nprinted = FDTOA(y,precision,tmp); \
1241 nprinted = DTOA(y,precision,tmp); \
1242 output_float (dtp, f, buffer, size, nprinted, precision,\
1243 sign_bit, zero_flag);\
1247 /* Output a real number according to its format. */
1250 write_float (st_parameter_dt *dtp, const fnode *f, const char *source, \
1251 int len, int comp_d)
1253 int sign_bit, nprinted;
1254 int precision; /* Precision for snprintf call. */
1257 if (f->format != FMT_EN)
1258 precision = determine_precision (dtp, f, len);
1260 precision = determine_en_precision (dtp, f, source, len);
1262 /* 4932 is the maximum exponent of long double and quad precision, 3
1263 extra characters for the sign, the decimal point, and the
1264 trailing null, and finally some extra digits depending on the
1265 requested precision. */
1266 const size_t size = 4932 + 3 + precision;
1279 #ifdef HAVE_GFC_REAL_10
1284 #ifdef HAVE_GFC_REAL_16
1286 # ifdef GFC_REAL_16_IS_FLOAT128
1294 internal_error (NULL, "bad real kind");