https://gcc.gnu.org/g:aacccc01d2bb3dd76ee37281b9f2f04aa9c13f5c
commit r17-848-gaacccc01d2bb3dd76ee37281b9f2f04aa9c13f5c Author: Jerry DeLisle <[email protected]> Date: Sat May 23 20:28:43 2026 -0700 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. * io/write_float.def: Change use of GFC_UINTEGER_8 to long long unsigned. 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: --- gcc/testsuite/gfortran.dg/EXformat_3.F90 | 157 ++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/EXrounding.F90 | 200 +++++++++++++++++++++++++++++++ libgfortran/io/write.c | 105 +++++++++++++++- libgfortran/io/write_float.def | 30 ++--- 4 files changed, 476 insertions(+), 16 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/EXformat_3.F90 b/gcc/testsuite/gfortran.dg/EXformat_3.F90 new file mode 100644 index 000000000000..8f3b8bd2a7f0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/EXformat_3.F90 @@ -0,0 +1,157 @@ +! { dg-do run } +! PR93727 Test EX format rounding of truncated hex mantissa. +! Verifies ROUND_NEAREST (round-to-nearest ties-to-even) when the +! user specifies a d less than full precision. +program main + implicit none + call test04 + call test08 + call test10 + call test16 + +contains + +subroutine test04 + real(kind=4) :: r4 + character(kind=1,len=40) :: s + + ! Carry propagates through all fractional digits into integer digit; + ! integer F overflows -> normalize to 8 with exponent incremented. + ! huge(1.0_4) = 0XF.FFFFFP+124 + ! d=4: first dropped F > 8, all frac digits carry to 0, F+1 -> 8, exp 125 + r4 = huge(1.0_4) + write(s, '(EX0.4)') r4 + if (s(1:13) /= '0X8.0000P+125') stop 1 + +end subroutine test04 + +subroutine test08 + real(kind=8) :: r8 + character(kind=1,len=40) :: s + + ! Round up: first dropped digit B (=11) > 8, with carry through F into D. + ! -pi*25 = -0X9.D14707B63DFBP+3 (12 significant frac digits, 13th = 0) + ! d=11 keeps D14707B63DF, first dropped B -> round up + ! last kept F + 1 = 0 carry, D + 1 = E, result: -0X9.D14707B63E0P+3 + r8 = -3.14159682678_8 * 25._8 + write(s, '(EX0.11)') r8 + if (s(1:19) /= '-0X9.D14707B63E0P+3') stop 2 + + ! Tie, last kept digit even (C=12) -> truncate (round to even). + ! 10.736328125 = 0XA.BC8000000000P+0 + ! d=2: first dropped 8, tail zeros, C even -> truncate -> 0XA.BCP+0 + r8 = 10.736328125_8 + write(s, '(EX0.2)') r8 + if (s(1:9) /= '0XA.BCP+0') stop 3 + + ! Tie, last kept digit odd (B=11) -> round up (round to even). + ! 10.732421875 = 0XA.BB8000000000P+0 + ! d=2: first dropped 8, tail zeros, B odd -> round up, B+1=C -> 0XA.BCP+0 + r8 = 10.732421875_8 + write(s, '(EX0.2)') r8 + if (s(1:9) /= '0XA.BCP+0') stop 4 + + ! Round up: first dropped digit 9 > 8, no carry. + ! 10.736572265625 = 0XA.BC9000000000P+0 + ! d=2: first dropped 9 > 8 -> round up, C+1=D -> 0XA.BDP+0 + r8 = 10.736572265625_8 + write(s, '(EX0.2)') r8 + if (s(1:9) /= '0XA.BDP+0') stop 5 + +end subroutine test08 + +#ifdef __GFC_REAL_10__ +subroutine test10 + real(kind=10) :: r10 + character(kind=1,len=40) :: s + + ! Tie, last kept digit even (C=12) -> truncate. + ! 10.736328125 = 0XA.BC8000000000000P+0 (15 frac digits) + ! d=2: first dropped 8, tail zeros, C even -> truncate -> 0XA.BCP+0 + r10 = 10.736328125_10 + write(s, '(EX0.2)') r10 + if (s(1:9) /= '0XA.BCP+0') stop 6 + + ! Tie, last kept digit odd (B=11) -> round up. + ! 10.732421875 = 0XA.BB8000000000000P+0 + ! d=2: first dropped 8, tail zeros, B odd -> round up -> 0XA.BCP+0 + r10 = 10.732421875_10 + write(s, '(EX0.2)') r10 + if (s(1:9) /= '0XA.BCP+0') stop 7 + + ! Round up: first dropped digit 9 > 8, no carry. + ! 10.736572265625 = 0XA.BC9000000000000P+0 + ! d=2: first dropped 9 > 8 -> round up, C+1=D -> 0XA.BDP+0 + r10 = 10.736572265625_10 + write(s, '(EX0.2)') r10 + if (s(1:9) /= '0XA.BDP+0') stop 8 + + ! Round up: first dropped digit 9 > 8 in -pi*25 at d=13. + ! -pi*25 = -0X9.D14707B63DFB497P+3 (15 frac digits) + ! d=13: first dropped 9 > 8, last kept 4+1=5, no carry + ! result: -0X9.D14707B63DFB5P+3 + r10 = -3.14159682678_10 * 25._10 + write(s, '(EX0.13)') r10 + if (s(1:21) /= '-0X9.D14707B63DFB5P+3') stop 9 + + ! Normalization: carry through all 14 frac digits into integer. + ! huge(1.0_10) = 0XF.FFFFFFFFFFFFFFFP+16380 (15 frac digits) + ! d=14: first dropped F > 8, all carry, F+1 -> 8, exp 16381 + r10 = huge(1.0_10) + write(s, '(EX0.14)') r10 + if (s(1:25) /= '0X8.00000000000000P+16381') stop 10 + +end subroutine test10 +#else +subroutine test10 +end subroutine test10 +#endif + +#ifdef __GFC_REAL_16__ +subroutine test16 + real(kind=16) :: r16 + character(kind=1,len=45) :: s + + ! Tie, last kept digit even (C=12) -> truncate. + ! 10.736328125 = 0XA.BC8000000000000000000000000P+0 (28 frac digits) + ! d=2: first dropped 8, tail zeros, C even -> truncate -> 0XA.BCP+0 + r16 = 10.736328125_16 + write(s, '(EX0.2)') r16 + if (s(1:9) /= '0XA.BCP+0') stop 11 + + ! Tie, last kept digit odd (B=11) -> round up. + ! 10.732421875 = 0XA.BB8000000000000000000000000P+0 + ! d=2: first dropped 8, tail zeros, B odd -> round up -> 0XA.BCP+0 + r16 = 10.732421875_16 + write(s, '(EX0.2)') r16 + if (s(1:9) /= '0XA.BCP+0') stop 12 + + ! Round up: first dropped digit 9 > 8, no carry. + ! 10.736572265625 = 0XA.BC9000000000000000000000000P+0 + ! d=2: first dropped 9 > 8 -> round up, C+1=D -> 0XA.BDP+0 + r16 = 10.736572265625_16 + write(s, '(EX0.2)') r16 + if (s(1:9) /= '0XA.BDP+0') stop 13 + + ! Round up at d=26 on 1/3 = 0XA.AAAAAAAAAAAAAAAAAAAAAAAAAAA8P-5 + ! d=26: first dropped A (=10) > 8, last kept A+1=B, no carry + ! result: 0XA.AAAAAAAAAAAAAAAAAAAAAAAAABP-5 + r16 = 1.0_16 / 3.0_16 + write(s, '(EX0.26)') r16 + if (s(1:33) /= '0XA.AAAAAAAAAAAAAAAAAAAAAAAAABP-5') stop 14 + + ! Tie and normalization: huge(1.0_16) = 0XF.FFFFFFFFFFFFFFFFFFFFFFFFFFF8P+16380 + ! d=27: first dropped 8, tail empty -> tie, last kept F (odd) -> round up + ! all 27 F's carry, F+1 -> 8, exp 16381 + ! result: 0X8.000000000000000000000000000P+16381 + r16 = huge(1.0_16) + write(s, '(EX0.27)') r16 + if (s(1:38) /= '0X8.000000000000000000000000000P+16381') stop 15 + +end subroutine test16 +#else +subroutine test16 +end subroutine test16 +#endif + +end program main diff --git a/gcc/testsuite/gfortran.dg/EXrounding.F90 b/gcc/testsuite/gfortran.dg/EXrounding.F90 new file mode 100644 index 000000000000..a385343caba0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/EXrounding.F90 @@ -0,0 +1,200 @@ +! { dg-do run } +! PR93727 Test EX format explicit rounding modes (ROUND_NEAREST, ROUND_UP, +! ROUND_DOWN, ROUND_ZERO) for truncated hex mantissa, all supported kinds. +! +! Key values used throughout (all exactly representable): +! 10.736328125 = 0XA.BC8000...P+0 tie at d=2, last kept C (12, even) +! 10.732421875 = 0XA.BB8000...P+0 tie at d=2, last kept B (11, odd) +! 10.736572265625 = 0XA.BC9000...P+0 dropped digit 9 > 8, no tie +program main + implicit none + call test04_rounding + call test08_rounding + call test10_rounding + call test16_rounding + +contains + +! --------------------------------------------------------------------------- +subroutine test04_rounding + real(kind=4) :: r4 + character(kind=1,len=40) :: s + + ! Positive tie, last kept even (C=12): RN truncates, RU rounds up. + r4 = 10.736328125_4 + write(s, '(EX0.2)', round='nearest') r4 + if (s(1:9) /= '0XA.BCP+0') stop 1 + write(s, '(EX0.2)', round='up') r4 + if (s(1:9) /= '0XA.BDP+0') stop 2 + write(s, '(EX0.2)', round='down') r4 + if (s(1:9) /= '0XA.BCP+0') stop 3 + write(s, '(EX0.2)', round='zero') r4 + if (s(1:9) /= '0XA.BCP+0') stop 4 + + ! Positive tie, last kept odd (B=11): RN rounds up. + r4 = 10.732421875_4 + write(s, '(EX0.2)', round='nearest') r4 + if (s(1:9) /= '0XA.BCP+0') stop 5 + + ! Positive: dropped digit 9 > 8, no tie; all modes with dropped nonzero round up. + r4 = 10.736572265625_4 + write(s, '(EX0.2)', round='nearest') r4 + if (s(1:9) /= '0XA.BDP+0') stop 6 + write(s, '(EX0.2)', round='up') r4 + if (s(1:9) /= '0XA.BDP+0') stop 7 + write(s, '(EX0.2)', round='zero') r4 + if (s(1:9) /= '0XA.BCP+0') stop 8 + + ! Negative tie, last kept even (C=12): RD rounds up in magnitude. + r4 = -10.736328125_4 + write(s, '(EX0.2)', round='nearest') r4 + if (s(1:10) /= '-0XA.BCP+0') stop 9 + write(s, '(EX0.2)', round='down') r4 + if (s(1:10) /= '-0XA.BDP+0') stop 10 + write(s, '(EX0.2)', round='up') r4 + if (s(1:10) /= '-0XA.BCP+0') stop 11 + write(s, '(EX0.2)', round='zero') r4 + if (s(1:10) /= '-0XA.BCP+0') stop 12 + +end subroutine test04_rounding + +! --------------------------------------------------------------------------- +subroutine test08_rounding + real(kind=8) :: r8 + character(kind=1,len=40) :: s + + ! Positive tie, last kept even (C=12). + r8 = 10.736328125_8 + write(s, '(EX0.2)', round='nearest') r8 + if (s(1:9) /= '0XA.BCP+0') stop 13 + write(s, '(EX0.2)', round='up') r8 + if (s(1:9) /= '0XA.BDP+0') stop 14 + write(s, '(EX0.2)', round='down') r8 + if (s(1:9) /= '0XA.BCP+0') stop 15 + write(s, '(EX0.2)', round='zero') r8 + if (s(1:9) /= '0XA.BCP+0') stop 16 + + ! Positive tie, last kept odd (B=11): RN rounds up. + r8 = 10.732421875_8 + write(s, '(EX0.2)', round='nearest') r8 + if (s(1:9) /= '0XA.BCP+0') stop 17 + + ! Positive: dropped digit 9 > 8. + r8 = 10.736572265625_8 + write(s, '(EX0.2)', round='nearest') r8 + if (s(1:9) /= '0XA.BDP+0') stop 18 + write(s, '(EX0.2)', round='up') r8 + if (s(1:9) /= '0XA.BDP+0') stop 19 + write(s, '(EX0.2)', round='zero') r8 + if (s(1:9) /= '0XA.BCP+0') stop 20 + + ! Negative tie, last kept even (C=12). + r8 = -10.736328125_8 + write(s, '(EX0.2)', round='nearest') r8 + if (s(1:10) /= '-0XA.BCP+0') stop 21 + write(s, '(EX0.2)', round='down') r8 + if (s(1:10) /= '-0XA.BDP+0') stop 22 + write(s, '(EX0.2)', round='up') r8 + if (s(1:10) /= '-0XA.BCP+0') stop 23 + write(s, '(EX0.2)', round='zero') r8 + if (s(1:10) /= '-0XA.BCP+0') stop 24 + +end subroutine test08_rounding + +! --------------------------------------------------------------------------- +#ifdef __GFC_REAL_10__ +subroutine test10_rounding + real(kind=10) :: r10 + character(kind=1,len=40) :: s + + ! Positive tie, last kept even (C=12). + r10 = 10.736328125_10 + write(s, '(EX0.2)', round='nearest') r10 + if (s(1:9) /= '0XA.BCP+0') stop 25 + write(s, '(EX0.2)', round='up') r10 + if (s(1:9) /= '0XA.BDP+0') stop 26 + write(s, '(EX0.2)', round='down') r10 + if (s(1:9) /= '0XA.BCP+0') stop 27 + write(s, '(EX0.2)', round='zero') r10 + if (s(1:9) /= '0XA.BCP+0') stop 28 + + ! Positive tie, last kept odd (B=11): RN rounds up. + r10 = 10.732421875_10 + write(s, '(EX0.2)', round='nearest') r10 + if (s(1:9) /= '0XA.BCP+0') stop 29 + + ! Positive: dropped digit 9 > 8. + r10 = 10.736572265625_10 + write(s, '(EX0.2)', round='nearest') r10 + if (s(1:9) /= '0XA.BDP+0') stop 30 + write(s, '(EX0.2)', round='up') r10 + if (s(1:9) /= '0XA.BDP+0') stop 31 + write(s, '(EX0.2)', round='zero') r10 + if (s(1:9) /= '0XA.BCP+0') stop 32 + + ! Negative tie, last kept even (C=12). + r10 = -10.736328125_10 + write(s, '(EX0.2)', round='nearest') r10 + if (s(1:10) /= '-0XA.BCP+0') stop 33 + write(s, '(EX0.2)', round='down') r10 + if (s(1:10) /= '-0XA.BDP+0') stop 34 + write(s, '(EX0.2)', round='up') r10 + if (s(1:10) /= '-0XA.BCP+0') stop 35 + write(s, '(EX0.2)', round='zero') r10 + if (s(1:10) /= '-0XA.BCP+0') stop 36 + +end subroutine test10_rounding +#else +subroutine test10_rounding +end subroutine test10_rounding +#endif + +! --------------------------------------------------------------------------- +#ifdef __GFC_REAL_16__ +subroutine test16_rounding + real(kind=16) :: r16 + character(kind=1,len=40) :: s + + ! Positive tie, last kept even (C=12). + r16 = 10.736328125_16 + write(s, '(EX0.2)', round='nearest') r16 + if (s(1:9) /= '0XA.BCP+0') stop 37 + write(s, '(EX0.2)', round='up') r16 + if (s(1:9) /= '0XA.BDP+0') stop 38 + write(s, '(EX0.2)', round='down') r16 + if (s(1:9) /= '0XA.BCP+0') stop 39 + write(s, '(EX0.2)', round='zero') r16 + if (s(1:9) /= '0XA.BCP+0') stop 40 + + ! Positive tie, last kept odd (B=11): RN rounds up. + r16 = 10.732421875_16 + write(s, '(EX0.2)', round='nearest') r16 + if (s(1:9) /= '0XA.BCP+0') stop 41 + + ! Positive: dropped digit 9 > 8. + r16 = 10.736572265625_16 + write(s, '(EX0.2)', round='nearest') r16 + if (s(1:9) /= '0XA.BDP+0') stop 42 + write(s, '(EX0.2)', round='up') r16 + if (s(1:9) /= '0XA.BDP+0') stop 43 + write(s, '(EX0.2)', round='zero') r16 + if (s(1:9) /= '0XA.BCP+0') stop 44 + + ! Negative tie, last kept even (C=12). + r16 = -10.736328125_16 + write(s, '(EX0.2)', round='nearest') r16 + if (s(1:10) /= '-0XA.BCP+0') stop 45 + write(s, '(EX0.2)', round='down') r16 + if (s(1:10) /= '-0XA.BDP+0') stop 46 + write(s, '(EX0.2)', round='up') r16 + if (s(1:10) /= '-0XA.BCP+0') stop 47 + write(s, '(EX0.2)', round='zero') r16 + if (s(1:10) /= '-0XA.BCP+0') stop 48 + +end subroutine test16_rounding +#else +subroutine test16_rounding +end subroutine test16_rounding +#endif + +end program main diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index 44f4b614c4fe..3b187c618436 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -1955,9 +1955,112 @@ write_ex (st_parameter_dt *dtp, const fnode *f, const char *p, int kind) /* Adjust mantissa to have exactly 'd' digits after decimal */ if (d < mantissa_digits) { - /* Truncate mantissa */ + /* Determine rounding direction before truncating. */ + char *first_drop = decimal + d + 1; + char fc = *first_drop; + int fd_val = (fc >= '0' && fc <= '9') ? fc - '0' + : (fc >= 'A' && fc <= 'F') ? fc - 'A' + 10 : 0; + + /* Check whether any tail digits (beyond the + first dropped digit) are nonzero. */ + bool tail_nonzero = false; + for (char *tp = first_drop + 1; tp < p_pos; tp++) + if (*tp != '0') + { + tail_nonzero = true; + break; + } + + bool is_negative = (buf[0] == '-'); + bool do_round_up = false; + + switch (dtp->u.p.current_unit->round_status) + { + case ROUND_ZERO: + /* Truncate toward zero; no adjustment needed. */ + break; + case ROUND_UP: + /* Toward +inf: round up positive values only. */ + if (!is_negative && (fd_val > 0 || tail_nonzero)) + do_round_up = true; + break; + case ROUND_DOWN: + /* Toward -inf: round up negative values only. */ + if (is_negative && (fd_val > 0 || tail_nonzero)) + do_round_up = true; + break; + case ROUND_COMPATIBLE: + /* Nearest, ties away from zero. */ + do_round_up = (fd_val >= 8); + break; + case ROUND_PROCDEFINED: + case ROUND_UNSPECIFIED: + /* Processor-defined defaults to ROUND_NEAREST on IEEE 754 + systems. Fall through. */ + default: + case ROUND_NEAREST: + /* Round to nearest, ties to even. */ + if (fd_val > 8) + do_round_up = true; + else if (fd_val == 8) + { + if (tail_nonzero) + do_round_up = true; + else + { + /* Exact tie: round last kept digit to even. */ + char lk = *(decimal + d); + int lk_val = (lk >= '0' && lk <= '9') ? lk - '0' + : lk - 'A' + 10; + do_round_up = (lk_val & 1) != 0; + } + } + break; + } + + /* Truncate the fractional part to d digits. */ memmove (decimal + d + 1, p_pos, strlen (p_pos) + 1); p_pos = decimal + d + 1; + + if (do_round_up) + { + /* Propagate carry leftward through the fractional digits. */ + char *pos = p_pos - 1; + while (pos > decimal) + { + int dv = (*pos >= '0' && *pos <= '9') ? *pos - '0' + : *pos - 'A' + 10; + dv++; + if (dv < 16) + { + *pos = dv < 10 ? ('0' + dv) : ('A' + dv - 10); + goto rounding_done; + } + *pos = '0'; + pos--; + } + /* Carry reached the integer digit (at decimal - 1). */ + pos = decimal - 1; + { + int dv = (*pos >= '0' && *pos <= '9') ? *pos - '0' + : *pos - 'A' + 10; + dv++; + if (dv < 16) + *pos = dv < 10 ? ('0' + dv) : ('A' + dv - 10); + else + { + /* Integer digit overflowed (was F). Normalize: the + value F.0...0 * 2^exp to 8.0...0 * 2^(exp+1). */ + *pos = '8'; + int actual_exp = (sign_char == '-') ? -(int)exp_value + : (int)exp_value; + actual_exp++; + exp_value = actual_exp >= 0 ? actual_exp : -actual_exp; + sign_char = actual_exp >= 0 ? '+' : '-'; + } + } + rounding_done:; + } } else if (d > mantissa_digits) { diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def index da31c8af51c0..554013e93180 100644 --- a/libgfortran/io/write_float.def +++ b/libgfortran/io/write_float.def @@ -172,13 +172,13 @@ get_float_hex_string (const void *source, int kind, char *buffer, int_part = (int) mant; /* 56 is the nearest integer divisible by 4 that is >= 53 (mantissa bits for kind=8). (56-4)/4 = 13 hex digits for the fractional part. */ - frac_part = (GFC_UINTEGER_8) scalbn (mant - (double) int_part, 56 - 4); + frac_part = (long long unsigned) 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 @@ -188,7 +188,7 @@ get_float_hex_string (const void *source, int kind, char *buffer, GFC_REAL_10 mant; int expon; int int_part; - GFC_UINTEGER_8 frac_part; + long long unsigned frac_part; val = *(const GFC_REAL_10 *) source; is_negative = signbit (val); @@ -232,13 +232,13 @@ get_float_hex_string (const void *source, int kind, char *buffer, int_part = (int) mant; /* 64 is the nearest integer divisible by 4 that is >= 64 (mantissa bits for kind=10). (64-4)/4 = 15 hex digits for the fractional part. */ - frac_part = (GFC_UINTEGER_8) scalbnl (mant - (GFC_REAL_10) int_part, 64 - 4); + frac_part = (long long unsigned) 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 @@ -249,7 +249,7 @@ get_float_hex_string (const void *source, int kind, char *buffer, GFC_REAL_16 mant; int expon; int int_part; - GFC_UINTEGER_8 frac_hi, frac_lo; + long long unsigned frac_hi, frac_lo; GFC_REAL_16 frac_val, frac_lo_val; val = *(const GFC_REAL_16 *) source; @@ -295,19 +295,19 @@ get_float_hex_string (const void *source, int kind, char *buffer, /* 116 is the nearest integer divisible by 4 that is >= 113 (mantissa bits for kind=16). (116-4)/4 = 28 hex digits for the fractional part, split into two 56-bit halves (14 hex digits each) to fit in - GFC_UINTEGER_8. */ + long long unsigned. */ frac_val = mant - (GFC_REAL_16) int_part; - frac_hi = (GFC_UINTEGER_8) GFC_REAL_16_SCALBN (frac_val, 56); + frac_hi = (long long unsigned) GFC_REAL_16_SCALBN (frac_val, 56); frac_lo_val = frac_val - GFC_REAL_16_SCALBN ((GFC_REAL_16) frac_hi, -56); - frac_lo = (GFC_UINTEGER_8) GFC_REAL_16_SCALBN (frac_lo_val, 112); + frac_lo = (long long unsigned) 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 */
