Hi Jerry!
Am 27.05.26 um 3:12 AM schrieb Jerry D:
The attached patch with assistance implements the various rounding modes
for the WRITE with EX hexadecimal float output.
This continues the effort to get the full EX support completed. A
followup patch will take care of the READ EX portion.
This has been regression tested on x86_64.
OK for mainline?
This looks good to me, so good for mainline.
I see one issue when compiling on x86_64-pc-linux-gnu: the snprintf
in libgfortran/io/write_float.def has a mismatch between the format
and the passed parameter (llX == long long unsigned int vs.
GFC_UINTEGER_8). I tried to locally cast the passed value, see
attached patch. This got rid of the warning here.
Can you try yourself? Maybe this also fixes the failures on Power.
Thanks for the patch!
Harald
Regards,
Jerry
-----
Fortran: [PR93727] Add EX format rounding for truncated hex mantissa
Implement proper rounding of the hex mantissa in write_ex when the
user specifies a d smaller than full precision. All Fortran ROUND=
modes are supported: ROUND_NEAREST (ties-to-even), ROUND_COMPATIBLE
(ties away from zero), ROUND_UP, ROUND_DOWN, and ROUND_ZERO.
ROUND_PROCDEFINED and ROUND_UNSPECIFIED default to ROUND_NEAREST on
IEEE 754 systems, consistent with the decimal format behaviour.
Carry propagation handles the case where incrementing a string of
trailing F hex digits reaches the integer digit; if that overflows
(F → 16) the output is normalized by setting the integer digit to 8
and incrementing the binary exponent by one.
Assisted by: Claude Sonnet 4.6
PR fortran/93727
libgfortran/ChangeLog:
* io/write.c (write_ex): Replace simple truncation with
rounding-aware logic respecting dtp round_status. Add carry
propagation and integer-digit normalization.
gcc/testsuite/ChangeLog:
* gfortran.dg/EXformat_3.F90: New test covering rounding for
KIND=4, 8, 10, and 16: clear round-up, ties-to-even (truncate
and round-up cases), carry propagation, and normalization.
* gfortran.dg/EXrounding.F90: New test checking the various
rounding modes for all kinds.
---
diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index da31c8af51c..8b634f74bb2 100644
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -175,10 +175,10 @@ get_float_hex_string (const void *source, int kind, char *buffer,
frac_part = (GFC_UINTEGER_8) scalbn (mant - (double) int_part, 56 - 4);
if (is_negative)
result = snprintf (buffer, 25, "-0X%X.%13.13llXP%+d", int_part,
- (GFC_UINTEGER_8) frac_part, expon);
+ (long long unsigned) frac_part, expon);
else
result = snprintf (buffer, 25, "0X%X.%13.13llXP%+d", int_part,
- (GFC_UINTEGER_8) frac_part, expon);
+ (long long unsigned) frac_part, expon);
}
break;
#ifdef HAVE_GFC_REAL_10
@@ -235,10 +235,10 @@ get_float_hex_string (const void *source, int kind, char *buffer,
frac_part = (GFC_UINTEGER_8) scalbnl (mant - (GFC_REAL_10) int_part, 64 - 4);
if (is_negative)
result = snprintf (buffer, 28, "-0X%X.%15.15llXP%+d", int_part,
- (GFC_UINTEGER_8) frac_part, expon);
+ (long long unsigned) frac_part, expon);
else
result = snprintf (buffer, 28, "0X%X.%15.15llXP%+d", int_part,
- (GFC_UINTEGER_8) frac_part, expon);
+ (long long unsigned) frac_part, expon);
}
break;
#endif
@@ -302,12 +302,12 @@ get_float_hex_string (const void *source, int kind, char *buffer,
frac_lo = (GFC_UINTEGER_8) GFC_REAL_16_SCALBN (frac_lo_val, 112);
if (is_negative)
result = snprintf (buffer, 42, "-0X%X.%14.14llX%14.14llXP%+d",
- int_part, (GFC_UINTEGER_8) frac_hi,
- (GFC_UINTEGER_8) frac_lo, expon);
+ int_part, (long long unsigned) frac_hi,
+ (long long unsigned) frac_lo, expon);
else
result = snprintf (buffer, 42, "0X%X.%14.14llX%14.14llXP%+d",
- int_part, (GFC_UINTEGER_8) frac_hi,
- (GFC_UINTEGER_8) frac_lo, expon);
+ int_part, (long long unsigned) frac_hi,
+ (long long unsigned) frac_lo, expon);
}
break;
#endif /* HAVE_GFC_REAL_16 */
