1 /* Copyright (C
) 2007, 2008, 2009, 2010, 2011, 2012
2 Free Software Foundation
, Inc.
3 Contributed by Andy Vaught
4 Write float code factoring to this file by Jerry DeLisle
5 F2003 I
/O support contributed by Jerry DeLisle
7 This file is part of the GNU Fortran runtime
library (libgfortran
).
9 Libgfortran is free software
; you can redistribute it and
/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation
; either version
3, or (at your option
)
14 Libgfortran is distributed in the hope that it will be useful
,
15 but WITHOUT ANY WARRANTY
; without even the implied warranty of
16 MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 Under Section
7 of GPL version
3, you are granted additional
20 permissions described in the GCC Runtime Library Exception
, version
21 3.1, as published by the Free Software Foundation.
23 You should have received a copy of the GNU General Public License and
24 a copy of the GCC Runtime Library Exception along with this program
;
25 see the files COPYING3 and COPYING.RUNTIME respectively. If not
, see
26 <http
://www.gnu.org
/licenses
/>.
*/
31 { S_NONE
, S_MINUS
, S_PLUS
}
34 /* Given a flag that indicates if a value is negative or not
, return a
35 sign_t that gives the sign that we need to produce.
*/
38 calculate_sign (st_parameter_dt
*dtp
, int negative_flag
)
45 switch (dtp
->u.p.sign_status
)
47 case SIGN_SP
: /* Show sign.
*/
50 case SIGN_SS
: /* Suppress sign.
*/
53 case SIGN_S
: /* Processor defined.
*/
54 case SIGN_UNSPECIFIED
:
55 s
= options.optional_plus ? S_PLUS
: S_NONE
;
63 /* Determine the precision except for EN format. For G format
,
64 determines an upper bound to be used for sizing the buffer.
*/
67 determine_precision (st_parameter_dt
* dtp
, const fnode
* f
, int len
)
69 int precision
= f
->u.real.d
;
75 precision
+= dtp
->u.p.scale_factor
;
78 /* Scale factor has no effect on output.
*/
82 /* See F2008
10.7.2.3.3.6 */
83 if (dtp
->u.p.scale_factor
<= 0)
84 precision
+= dtp
->u.p.scale_factor
- 1;
90 /* If the scale factor has a large negative value
, we must do our
91 own rounding? Use ROUND
='NEAREST', which should be what snprintf
94 (dtp
->u.p.current_unit
->round_status
== ROUND_UNSPECIFIED
95 || dtp
->u.p.current_unit
->round_status
== ROUND_PROCDEFINED
))
96 dtp
->u.p.current_unit
->round_status
= ROUND_NEAREST
;
98 /* Add extra guard digits up to at least full precision when we do
100 if (dtp
->u.p.current_unit
->round_status
!= ROUND_UNSPECIFIED
101 && dtp
->u.p.current_unit
->round_status
!= ROUND_PROCDEFINED
)
103 precision
+= 2 * len
+ 4;
112 /* Output a real number according to its format which is FMT_G free.
*/
115 output_float (st_parameter_dt
*dtp
, const fnode
*f
, char
*buffer
, size_t size
,
116 int nprinted
, int precision
, int sign_bit
, bool zero_flag
)
123 /* Number of digits before the decimal point.
*/
125 /* Number of zeros after the decimal point.
*/
127 /* Number of digits after the decimal point.
*/
129 /* Number of zeros after the decimal point
, whatever the precision.
*/
133 int ndigits
, edigits
;
139 p
= dtp
->u.p.scale_factor
;
144 /* We should always know the field width and precision.
*/
146 internal_error (&dtp
->common
, "Unspecified precision");
148 sign
= calculate_sign (dtp
, sign_bit
);
150 /* Calculate total number of digits.
*/
152 ndigits
= nprinted
- 2;
154 ndigits
= precision
+ 1;
156 /* Read the exponent back in.
*/
158 e
= atoi (&buffer
[ndigits
+ 3]) + 1;
162 /* Make sure zero comes out as
0.0e0.
*/
166 /* Normalize the fractional component.
*/
169 buffer
[2] = buffer
[1];
175 /* Figure out where to place the decimal point.
*/
179 nbefore
= ndigits
- precision
;
180 /* Make sure the decimal point is a
'.'; depending on the
181 locale
, this might not be the case otherwise.
*/
182 digits
[nbefore
] = '.';
188 memmove (digits
+ nbefore
, digits
+ nbefore
+ 1, p
);
189 digits
[nbefore
+ p
] = '.';
195 nzero
= nzero_real
= 0;
199 if (nbefore
+ p
>= 0)
202 memmove (digits
+ nbefore
+ p
+ 1, digits
+ nbefore
+ p
, -p
);
204 digits
[nbefore
] = '.';
209 nzero
= -(nbefore
+ p
);
210 memmove (digits
+ 1, digits
, nbefore
);
212 nafter
= d
+ nbefore
;
222 nzero
= nzero_real
= 0;
226 while (digits
[0] == '0' && nbefore
> 0)
234 /* If we need to do rounding ourselves
, get rid of the dot by
235 moving the fractional part.
*/
236 if (dtp
->u.p.current_unit
->round_status
!= ROUND_UNSPECIFIED
237 && dtp
->u.p.current_unit
->round_status
!= ROUND_PROCDEFINED
)
238 memmove (digits
+ nbefore
, digits
+ nbefore
+ 1, ndigits
- nbefore
);
243 i
= dtp
->u.p.scale_factor
;
244 if (d
<= 0 && p
== 0)
246 generate_error (&dtp
->common
, LIBERROR_FORMAT
, "Precision not "
247 "greater than zero in format specifier 'E' or 'D'");
250 if (p
<= -d || p
>= d
+ 2)
252 generate_error (&dtp
->common
, LIBERROR_FORMAT
, "Scale factor "
253 "out of range in format specifier 'E' or 'D'");
269 nafter
= (d
- p
) + 1;
285 /* The exponent must be a multiple of three
, with
1-3 digits before
286 the decimal point.
*/
295 nbefore
= 3 - nbefore
;
314 /* Should never happen.
*/
315 internal_error (&dtp
->common
, "Unexpected format token");
321 /* Round the value. The value being rounded is an unsigned magnitude.
*/
322 switch (dtp
->u.p.current_unit
->round_status
)
324 /* For processor defined and unspecified rounding we use
325 snprintf to print the exact number of digits needed
, and thus
326 let snprintf handle the rounding. On system claiming support
327 for IEEE
754, this ought to be round to nearest
, ties to
328 even
, corresponding to the Fortran ROUND
='NEAREST'.
*/
329 case ROUND_PROCDEFINED
:
330 case ROUND_UNSPECIFIED
:
331 case ROUND_ZERO
: /* Do nothing and truncation occurs.
*/
342 /* Round compatible unless there is a tie. A tie is a
5 with
343 all trailing zero
's. */
344 i = nafter + nbefore;
345 if (digits[i] == '5')
347 for(i++ ; i < ndigits; i++)
349 if (digits[i] != '0')
352 /* It is a tie so round to even. */
353 switch (digits[nafter + nbefore - 1])
360 /* If odd, round away from zero to even. */
363 /* If even, skip rounding, truncate to even. */
368 /* The ROUND_COMPATIBLE is rounding away from zero when there is a tie. */
369 case ROUND_COMPATIBLE:
377 if (w > 0 && d == 0 && p == 0)
379 /* Scan for trailing zeros to see if we really need to round it. */
380 for(i = nbefore + nafter; i < ndigits; i++)
382 if (digits[i] != '0')
389 if (nbefore + nafter == 0)
392 if (nzero_real == d && digits[0] >= rchar)
394 /* We rounded to zero but shouldn't have
*/
401 else
if (nbefore
+ nafter
< ndigits
)
403 i
= ndigits
= nbefore
+ nafter
;
404 if (digits
[i
] >= rchar
)
406 /* Propagate the carry.
*/
407 for (i
--; i
>= 0; i
--)
409 if (digits
[i
] != '9')
419 /* The carry overflowed. Fortunately we have some spare
420 space at the start of the buffer. We may discard some
421 digits
, but this is ok because we already know they are
435 else
if (ft
== FMT_EN
)
452 /* Calculate the format of the exponent field.
*/
456 for (i
= abs (e
); i
>= 10; i
/= 10)
461 /* Width not specified. Must be no more than
3 digits.
*/
462 if (e
> 999 || e
< -999)
467 if (e
> 99 || e
< -99)
473 /* Exponent width specified
, check it is wide enough.
*/
474 if (edigits
> f
->u.real.e
)
477 edigits
= f
->u.real.e
+ 2;
483 /* Scan the digits string and count the number of zeros. If we make it
484 all the way through the loop
, we know the value is zero after the
485 rounding completed above.
*/
486 for (i
= 0; i
< ndigits
; i
++)
488 if (digits
[i
] != '0' && digits
[i
] != '.')
492 /* To format properly
, we need to know if the rounded result is zero and if
493 so
, we set the zero_flag which may have been already set for
498 /* The output is zero
, so set the sign according to the sign bit unless
499 -fno
-sign
-zero was specified.
*/
500 if (compile_options.sign_zero
== 1)
501 sign
= calculate_sign (dtp
, sign_bit
);
503 sign
= calculate_sign (dtp
, 0);
506 /* Pick a field size if none was specified
, taking into account small
507 values that may have been rounded to zero.
*/
511 w
= d
+ (sign
!= S_NONE ?
2 : 1) + (d
== 0 ?
1 : 0);
514 w
= nbefore
+ nzero
+ nafter
+ (sign
!= S_NONE ?
2 : 1);
519 /* Work out how much padding is needed.
*/
520 nblanks
= w
- (nbefore
+ nzero
+ nafter
+ edigits
+ 1);
524 if (dtp
->u.p.g0_no_blanks
)
530 /* Create the ouput buffer.
*/
531 out
= write_block (dtp
, w
);
535 /* Check the value fits in the specified field width.
*/
536 if (nblanks
< 0 || edigits
== -1 || w
== 1 ||
(w
== 2 && sign
!= S_NONE
))
538 if (unlikely (is_char4_unit (dtp
)))
540 gfc_char4_t
*out4
= (gfc_char4_t *) out
;
541 memset4 (out4
, '*', w
);
548 /* See if we have space for a zero before the decimal point.
*/
549 if (nbefore
== 0 && nblanks
> 0)
557 /* For internal
character(kind
=4) units
, we duplicate the code used for
558 regular output slightly modified. This needs to be maintained
559 consistent with the regular code that follows this block.
*/
560 if (unlikely (is_char4_unit (dtp
)))
562 gfc_char4_t
*out4
= (gfc_char4_t *) out
;
563 /* Pad to full field width.
*/
565 if ( ( nblanks
> 0 ) && !dtp
->u.p.no_leading_blank
)
567 memset4 (out4
, ' ', nblanks
);
571 /* Output the initial
sign (if any
).
*/
574 else
if (sign
== S_MINUS
)
577 /* Output an optional leading zero.
*/
581 /* Output the part before the decimal point
, padding with zeros.
*/
584 if (nbefore
> ndigits
)
587 memcpy4 (out4
, digits
, i
);
595 memcpy4 (out4
, digits
, i
);
603 /* Output the decimal point.
*/
604 *(out4
++) = dtp
->u.p.current_unit
->decimal_status
605 == DECIMAL_POINT ?
'.' : ',';
607 && (dtp
->u.p.current_unit
->round_status
== ROUND_UNSPECIFIED
608 || dtp
->u.p.current_unit
->round_status
== ROUND_PROCDEFINED
))
611 /* Output leading zeros after the decimal point.
*/
614 for (i
= 0; i
< nzero
; i
++)
618 /* Output digits after the decimal point
, padding with zeros.
*/
621 if (nafter
> ndigits
)
626 memcpy4 (out4
, digits
, i
);
635 /* Output the exponent.
*/
643 snprintf (buffer
, size
, "%+0*d", edigits
, e
);
644 memcpy4 (out4
, buffer
, edigits
);
647 if (dtp
->u.p.no_leading_blank
)
650 memset4 (out4
, ' ' , nblanks
);
651 dtp
->u.p.no_leading_blank
= 0;
654 } /* End of
character(kind
=4) internal unit code.
*/
656 /* Pad to full field width.
*/
658 if ( ( nblanks
> 0 ) && !dtp
->u.p.no_leading_blank
)
660 memset (out
, ' ', nblanks
);
664 /* Output the initial
sign (if any
).
*/
667 else
if (sign
== S_MINUS
)
670 /* Output an optional leading zero.
*/
674 /* Output the part before the decimal point
, padding with zeros.
*/
677 if (nbefore
> ndigits
)
680 memcpy (out
, digits
, i
);
688 memcpy (out
, digits
, i
);
696 /* Output the decimal point.
*/
697 *(out
++) = dtp
->u.p.current_unit
->decimal_status
== DECIMAL_POINT ?
'.' : ',';
699 && (dtp
->u.p.current_unit
->round_status
== ROUND_UNSPECIFIED
700 || dtp
->u.p.current_unit
->round_status
== ROUND_PROCDEFINED
))
703 /* Output leading zeros after the decimal point.
*/
706 for (i
= 0; i
< nzero
; i
++)
710 /* Output digits after the decimal point
, padding with zeros.
*/
713 if (nafter
> ndigits
)
718 memcpy (out
, digits
, i
);
727 /* Output the exponent.
*/
735 snprintf (buffer
, size
, "%+0*d", edigits
, e
);
736 memcpy (out
, buffer
, edigits
);
739 if (dtp
->u.p.no_leading_blank
)
742 memset( out
, ' ' , nblanks
);
743 dtp
->u.p.no_leading_blank
= 0;
750 /* Write
"Infinite" or
"Nan" as appropriate for the given format.
*/
753 write_infnan (st_parameter_dt
*dtp
, const fnode
*f
, int isnan_flag
, int sign_bit
)
760 if (f
->format
!= FMT_B
&& f
->format
!= FMT_O
&& f
->format
!= FMT_Z
)
762 sign
= calculate_sign (dtp
, sign_bit
);
763 mark
= (sign
== S_PLUS || sign
== S_MINUS
) ?
8 : 7;
767 /* If the field width is zero
, the processor must select a width
768 not zero.
4 is chosen to allow output of
'-Inf' or
'+Inf' */
770 if ((nb
== 0) || dtp
->u.p.g0_no_blanks
)
775 nb
= (sign
== S_PLUS || sign
== S_MINUS
) ?
4 : 3;
777 p
= write_block (dtp
, nb
);
782 if (unlikely (is_char4_unit (dtp
)))
784 gfc_char4_t
*p4
= (gfc_char4_t *) p
;
785 memset4 (p4
, '*', nb
);
792 if (unlikely (is_char4_unit (dtp
)))
794 gfc_char4_t
*p4
= (gfc_char4_t *) p
;
795 memset4 (p4
, ' ', nb
);
804 /* If the sign is negative and the width is
3, there is
805 insufficient room to output
'-Inf', so output asterisks
*/
808 if (unlikely (is_char4_unit (dtp
)))
810 gfc_char4_t
*p4
= (gfc_char4_t *) p
;
811 memset4 (p4
, '*', nb
);
817 /* The negative sign is mandatory
*/
821 /* The positive sign is optional
, but we output it for
825 if (unlikely (is_char4_unit (dtp
)))
827 gfc_char4_t
*p4
= (gfc_char4_t *) p
;
830 /* We have room
, so output
'Infinity' */
831 memcpy4 (p4
+ nb
- 8, "Infinity", 8);
833 /* For the case of width equals mark
, there is not enough room
834 for the sign and
'Infinity' so we go with
'Inf' */
835 memcpy4 (p4
+ nb
- 3, "Inf", 3);
837 if (sign
== S_PLUS || sign
== S_MINUS
)
839 if (nb
< 9 && nb
> 3)
840 /* Put the sign in front of Inf
*/
841 p4
[nb
- 4] = (gfc_char4_t
) fin
;
843 /* Put the sign in front of Infinity
*/
844 p4
[nb
- 9] = (gfc_char4_t
) fin
;
850 /* We have room
, so output
'Infinity' */
851 memcpy(p
+ nb
- 8, "Infinity", 8);
853 /* For the case of width equals
8, there is not enough room
854 for the sign and
'Infinity' so we go with
'Inf' */
855 memcpy(p
+ nb
- 3, "Inf", 3);
857 if (sign
== S_PLUS || sign
== S_MINUS
)
859 if (nb
< 9 && nb
> 3)
860 p
[nb
- 4] = fin
; /* Put the sign in front of Inf
*/
862 p
[nb
- 9] = fin
; /* Put the sign in front of Infinity
*/
867 if (unlikely (is_char4_unit (dtp
)))
869 gfc_char4_t
*p4
= (gfc_char4_t *) p
;
870 memcpy4 (p4
+ nb
- 3, "NaN", 3);
873 memcpy(p
+ nb
- 3, "NaN", 3);
880 /* Returns the value of
10**d.
*/
882 #define
CALCULATE_EXP(x
) \
883 static GFC_REAL_ ## x \
884 calculate_exp_ ##
x (int d
)\
887 GFC_REAL_ ## x r
= 1.0;\
888 for (i
= 0; i
< (d
>= 0 ? d
: -d
); i
++)\
890 r
= (d
>= 0) ? r
: 1.0 / r
;\
898 #ifdef HAVE_GFC_REAL_10
902 #ifdef HAVE_GFC_REAL_16
908 /* Define a macro to build code for write_float.
*/
910 /* Note
: Before output_float is called
, snprintf is used to print to buffer the
911 number in the format
+D.DDDDe
+ddd.
913 # The result will always contain a decimal point
, even if no
916 - The converted value is to be left adjusted on the field boundary
918 + A
sign (+ or
-) always be placed before a number
920 * prec is used as the precision
922 e format
: [-]d.ddde±dd where there is one digit before the
923 decimal
-point character and the number of digits after it is
924 equal to the precision. The exponent always contains at least two
925 digits
; if the value is zero
, the exponent is
00.
*/
928 #define
TOKENPASTE(x
, y
) TOKENPASTE2(x
, y
)
929 #define
TOKENPASTE2(x
, y
) x ## y
931 #define
DTOA(suff
,prec
,val
) TOKENPASTE(DTOA2
,suff
)(prec
,val
)
933 #define
DTOA2(prec
,val
) \
934 snprintf (buffer
, size
, "%+-#.*e", (prec
), (val
))
936 #define
DTOA2L(prec
,val
) \
937 snprintf (buffer
, size
, "%+-#.*Le", (prec
), (val
))
940 #if
defined(GFC_REAL_16_IS_FLOAT128
)
941 #define
DTOA2Q(prec
,val
) \
942 __qmath_(quadmath_snprintf
) (buffer
, size
, "%+-#.*Qe", (prec
), (val
))
945 #define
FDTOA(suff
,prec
,val
) TOKENPASTE(FDTOA2
,suff
)(prec
,val
)
947 /* For F format
, we print to the buffer with f format.
*/
948 #define
FDTOA2(prec
,val
) \
949 snprintf (buffer
, size
, "%+-#.*f", (prec
), (val
))
951 #define
FDTOA2L(prec
,val
) \
952 snprintf (buffer
, size
, "%+-#.*Lf", (prec
), (val
))
955 #if
defined(GFC_REAL_16_IS_FLOAT128
)
956 #define
FDTOA2Q(prec
,val
) \
957 __qmath_(quadmath_snprintf
) (buffer
, size
, "%+-#.*Qf", \
962 /* Generate corresponding I
/O format for FMT_G and output.
963 The rules to translate FMT_G to FMT_E or FMT_F from
DEC fortran
964 LRM (table
11-2, Chapter
11, "I/O Formatting", P11
-25) is
:
966 Data Magnitude Equivalent Conversion
967 0< m
< 0.1-0.5*10**(-d
-1) Ew.d
[Ee
]
968 m
= 0 F(w
-n
).
(d
-1), n
' '
969 0.1-0.5*10**(-d
-1)<= m
< 1-0.5*10**(-d
) F(w
-n
).d
, n
' '
970 1-0.5*10**(-d
)<= m
< 10-0.5*10**(-d
+1) F(w
-n
).
(d
-1), n
' '
971 10-0.5*10**(-d
+1)<= m
< 100-0.5*10**(-d
+2) F(w
-n
).
(d
-2), n
' '
972 ................ ..........
973 10**(d
-1)-0.5*10**(-1)<= m
<10**d
-0.5 F(w
-n
).0,n(' ')
974 m
>= 10**d
-0.5 Ew.d
[Ee
]
976 notes
: for Gw.d
, n
' ' means
4 blanks
977 for Gw.dEe
, n
' ' means e
+2 blanks
978 for rounding modes adjustment
, r
, See Fortran F2008
10.7.5.2.2
979 the asm volatile is required for
32-bit x86 platforms.
*/
981 #define
OUTPUT_FLOAT_FMT_G(x
,y
) \
983 output_float_FMT_G_ ##
x (st_parameter_dt
*dtp
, const fnode
*f
, \
984 GFC_REAL_ ## x m
, char
*buffer
, size_t size
, \
985 int sign_bit
, bool zero_flag
, int comp_d
) \
987 int e
= f
->u.real.e
;\
988 int d
= f
->u.real.d
;\
989 int w
= f
->u.real.w
;\
991 GFC_REAL_ ## x rexp_d
, r
= 0.5;\
995 int save_scale_factor
, nb
= 0;\
997 int nprinted
, precision
;\
999 save_scale_factor
= dtp
->u.p.scale_factor
;\
1001 switch (dtp
->u.p.current_unit
->round_status
)\
1004 r
= sign_bit ?
1.0 : 0.0;\
1016 rexp_d
= calculate_exp_ ##
x (-d
);\
1017 if ((m
> 0.0 && ((m
< 0.1 - 0.1 * r
* rexp_d
) ||
(rexp_d
* (m
+ r
) >= 1.0)))\
1018 ||
((m
== 0.0) && !(compile_options.allow_std\
1019 & (GFC_STD_F2003 | GFC_STD_F2008
))))\
1021 newf.format
= FMT_E
;\
1023 newf.u.real.d
= d
- comp_d
;\
1026 precision
= determine_precision (dtp
, &newf
, x
);\
1027 nprinted
= DTOA(y
,precision
,m
); \
1037 while (low
<= high
)\
1039 volatile GFC_REAL_ ## x temp
;\
1040 mid
= (low
+ high
) / 2;\
1042 temp
= (calculate_exp_ ##
x (mid
- 1) * (1 - r
* rexp_d
));\
1047 if (ubound
== lbound
+ 1)\
1054 if (ubound
== lbound
+ 1)\
1068 nb
= e
<= 0 ?
4 : e
+ 2;\
1069 nb
= nb
>= w ? w
- 1 : nb
;\
1070 newf.format
= FMT_F
;\
1071 newf.u.real.w
= w
- nb
;\
1072 newf.u.real.d
= m
== 0.0 ? d
- 1 : -(mid
- d
- 1) ;\
1073 dtp
->u.p.scale_factor
= 0;\
1074 precision
= determine_precision (dtp
, &newf
, x
); \
1075 nprinted
= FDTOA(y
,precision
,m
); \
1078 result
= output_float (dtp
, &newf
, buffer
, size
, nprinted
, precision
,\
1079 sign_bit
, zero_flag
);\
1080 dtp
->u.p.scale_factor
= save_scale_factor
;\
1083 if (nb
> 0 && !dtp
->u.p.g0_no_blanks
)\
1085 p
= write_block (dtp
, nb
);\
1088 if (result
== FAILURE
)\
1090 if (unlikely (is_char4_unit (dtp
)))\
1092 gfc_char4_t
*p4
= (gfc_char4_t *) p
;\
1093 memset4 (p4
, pad
, nb
);\
1096 memset (p
, pad
, nb
);\
1100 OUTPUT_FLOAT_FMT_G(4,)
1102 OUTPUT_FLOAT_FMT_G(8,)
1104 #ifdef HAVE_GFC_REAL_10
1105 OUTPUT_FLOAT_FMT_G(10,L
)
1108 #ifdef HAVE_GFC_REAL_16
1109 # ifdef GFC_REAL_16_IS_FLOAT128
1110 OUTPUT_FLOAT_FMT_G(16,Q
)
1112 OUTPUT_FLOAT_FMT_G(16,L
)
1116 #undef OUTPUT_FLOAT_FMT_G
1119 /* EN format is tricky since the number of significant digits depends
1120 on the magnitude. Solve it by first printing a temporary value and
1121 figure out the number of significant digits from the printed
1124 #define
EN_PREC(x
,y
)\
1126 GFC_REAL_ ## x tmp
; \
1127 tmp
= * (GFC_REAL_ ## x *)source
; \
1128 if (isfinite (tmp
)) \
1129 nprinted
= DTOA(y
,0,tmp
); \
1135 determine_en_precision (st_parameter_dt
*dtp
, const fnode
*f
,
1136 const char
*source
, int len
)
1140 const size_t size
= 10;
1152 #ifdef HAVE_GFC_REAL_10
1157 #ifdef HAVE_GFC_REAL_16
1159 # ifdef GFC_REAL_16_IS_FLOAT128
1167 internal_error (NULL
, "bad real kind");
1173 int e
= atoi (&buffer
[5]);
1174 int nbefore
; /* digits before decimal point
- 1.
*/
1181 nbefore
= 3 - nbefore
;
1183 int prec
= f
->u.real.d
+ nbefore
;
1184 if (dtp
->u.p.current_unit
->round_status
!= ROUND_UNSPECIFIED
1185 && dtp
->u.p.current_unit
->round_status
!= ROUND_PROCDEFINED
)
1186 prec
+= 2 * len
+ 4;
1191 #define
WRITE_FLOAT(x
,y
)\
1193 GFC_REAL_ ## x tmp
;\
1194 tmp
= * (GFC_REAL_ ## x *)source
;\
1195 sign_bit
= signbit (tmp
);\
1196 if (!isfinite (tmp
))\
1198 write_infnan (dtp
, f
, isnan (tmp
), sign_bit
);\
1201 tmp
= sign_bit ?
-tmp
: tmp
;\
1202 zero_flag
= (tmp
== 0.0);\
1203 if (f
->format
== FMT_G
)\
1204 output_float_FMT_G_ ##
x (dtp
, f
, tmp
, buffer
, size
, sign_bit
, \
1205 zero_flag
, comp_d
);\
1208 if (f
->format
== FMT_F
)\
1209 nprinted
= FDTOA(y
,precision
,tmp
); \
1211 nprinted
= DTOA(y
,precision
,tmp
); \
1212 output_float (dtp
, f
, buffer
, size
, nprinted
, precision
,\
1213 sign_bit
, zero_flag
);\
1217 /* Output a real number according to its format.
*/
1220 write_float (st_parameter_dt
*dtp
, const fnode
*f
, const char
*source
, \
1221 int len
, int comp_d
)
1223 int sign_bit
, nprinted
;
1224 int precision
; /* Precision for snprintf call.
*/
1227 if (f
->format
!= FMT_EN
)
1228 precision
= determine_precision (dtp
, f
, len
);
1230 precision
= determine_en_precision (dtp
, f
, source
, len
);
1232 /* 4932 is the maximum exponent of long double and quad precision
, 3
1233 extra characters for the sign
, the decimal point
, and the
1234 trailing null
, and finally some extra digits depending on the
1235 requested precision.
*/
1236 const size_t size
= 4932 + 3 + precision
;
1249 #ifdef HAVE_GFC_REAL_10
1254 #ifdef HAVE_GFC_REAL_16
1256 # ifdef GFC_REAL_16_IS_FLOAT128
1264 internal_error (NULL
, "bad real kind");