[PATCH] PR93727 Add EX format rounding for truncated hex mantissa

Jerry D <[email protected]> Tue, 26 May 2026 18:12:47 -0700

Newsgroups	gmane.comp.gcc.patches,gmane.comp.gcc.fortran
Message-ID	<[email protected]>

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?

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.
---

0001-Fortran-PR93727-Add-EX-format-rounding-for-truncated.patch (text/x-patch, 17.4 KB)

From aecbdc74231df195c5e38a11c3f7eaaf3591a704 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Sat, 23 May 2026 20:28:43 -0700
Subject: [PATCH] Fortran: [PR93727] Add EX format rounding for truncated hex
 mantissa
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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.
---
 gcc/testsuite/gfortran.dg/EXformat_3.F90 | 157 ++++++++++++++++++
 gcc/testsuite/gfortran.dg/EXrounding.F90 | 200 +++++++++++++++++++++++
 libgfortran/io/write.c                   | 105 +++++++++++-
 3 files changed, 461 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/EXformat_3.F90
 create mode 100644 gcc/testsuite/gfortran.dg/EXrounding.F90

diff --git a/gcc/testsuite/gfortran.dg/EXformat_3.F90 b/gcc/testsuite/gfortran.dg/EXformat_3.F90
new file mode 100644
index 00000000000..8f3b8bd2a7f
--- /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 00000000000..a385343caba
--- /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 44f4b614c4f..3b187c61843 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)
 	    {
-- 
2.54.0