On Sat, Mar 22, 2025 at 11:25:13PM -0500, Robert Dubner wrote:
> Real progress here.  Preliminary report:
> 
> I am still seeing trouble with a PIC PP9 variable coming back .000 instead
> of 0.001.
> 
> In my 679 UAT tests, the failure count is down from 23 to 4
> 
> In the NIST tests, the failure count is down from 273 to 35

Nice.

> It's after midnight, and my daily chores are not done, so I can't really
> look into all of the failures.
> 
> Here's one, though:
> 
>         IDENTIFICATION DIVISION.
>         PROGRAM-ID.  numeds.
>         DATA DIVISION.
>         WORKING-STORAGE SECTION.
>         01 VARPP9 PIC PP9 VALUE 0.001.
>         01 VARP9  PIC P9  VALUE 0.01.
>         01 VARV9  PIC V9  VALUE 0.1.
>         01 VAR9   PIC 9   VALUE 1.
>         01 VAR9P  PIC 9P  VALUE 10.
>         01 VAR9PP PIC 9PP VALUE 100.
>         PROCEDURE DIVISION.
>             DISPLAY "VARPP9 should be .001 is "  VARPP9
>             DISPLAY "VARP9  should be .01  is "  VARP9
>             DISPLAY "VARV9  should be .1   is "  VARV9
>             DISPLAY "VAR9   should be 1    is "  VAR9
>             DISPLAY "VAR9P  should be 10   is "  VAR9P
>             DISPLAY "VAR9PP should be 100  is "  VAR9PP.
>         END PROGRAM numeds.
> 
> What I am seeing with your patch is 
> 
> VARPP9 should be .001 is .000
> VARP9  should be .01  is .01
> VARV9  should be .1   is .1
> VAR9   should be 1    is 1
> VAR9P  should be 10   is 10
> VAR9PP should be 100  is 100

Ok, here is another incremental patch (so you need Richi's patch
+ my incremental you were testing + this one) for this:

--- gcc/cobol/genapi.cc.jj      2025-03-22 08:21:18.287554771 +0100
+++ gcc/cobol/genapi.cc 2025-03-23 11:38:04.757439095 +0100
@@ -53,6 +53,7 @@
 #include "../../libgcobol/valconv.h"
 #include "show_parse.h"
 #include "fold-const.h"
+#include "realmpfr.h"
 
 extern int yylineno;
 
@@ -15284,22 +15285,36 @@ binary_initial_from_float128(cbl_field_t
     {
       REAL_VALUE_TYPE pow10 = real_powi10 (rdigits);
       real_arithmetic (&value, MULT_EXPR, &value, &pow10);
-      // But make sure to round properly
-      real_roundeven (&value, VOIDmode, &value);
+      real_convert (&value, TYPE_MODE (float128_type_node), &value);
     }
   // We need to make sure that the resulting string will fit into
   // a number with 'digits' digits
-  bool fail = false;
-  FIXED_WIDE_INT(128) i
-    = FIXED_WIDE_INT(128)::from (real_to_integer (&value, &fail, 128), SIGNED);
 
   // Keep in mind that pure binary types, like BINARY-CHAR, have no digits
   if( field->data.digits )
     {
-      FIXED_WIDE_INT(128) pow10 = get_power_of_ten (field->data.digits);
-      i = wi::smod_trunc (i, pow10);
+      REAL_VALUE_TYPE pow10 = real_powi10 (field->data.digits);
+      mpfr_t m0, m1;
+
+      mpfr_inits2 (REAL_MODE_FORMAT (TYPE_MODE (float128_type_node))->p,
+                  m0, m1, NULL);
+      mpfr_from_real (m0, &value, MPFR_RNDN);
+      mpfr_from_real (m1, &pow10, MPFR_RNDN);
+      mpfr_clear_flags ();
+      mpfr_fmod (m0, m0, m1, MPFR_RNDN);
+      real_from_mpfr (&value, m0,
+                     REAL_MODE_FORMAT (TYPE_MODE (float128_type_node)),
+                     MPFR_RNDN);
+      real_convert (&value, TYPE_MODE (float128_type_node), &value);
+      mpfr_clears (m0, m1, NULL);
     }
 
+  real_roundeven (&value, TYPE_MODE (float128_type_node), &value);
+
+  bool fail = false;
+  FIXED_WIDE_INT(128) i
+    = FIXED_WIDE_INT(128)::from (real_to_integer (&value, &fail, 128), SIGNED);
+
   /* ???  Use native_encode_* below.  */
   retval = (char *)xmalloc(field->data.capacity);
   switch(field->data.capacity)
@@ -15349,13 +15364,26 @@ digits_from_float128(char *retval, cbl_f
     }
   // We need to make sure that the resulting string will fit into
   // a number with 'digits' digits
+  REAL_VALUE_TYPE pow10 = real_powi10 (field->data.digits);
+  mpfr_t m0, m1;
+
+  mpfr_inits2 (FLOAT_MODE_FORMAT (TYPE_MODE (float128_type_node))->p, m0, m1,
+              NULL);
+  mpfr_from_real (m0, &value, MPFR_RNDN);
+  mpfr_from_real (m1, &pow10, MPFR_RNDN);
+  mpfr_clear_flags ();
+  mpfr_fmod (m0, m0, m1, MPFR_RNDN);
+  real_from_mpfr (&value, m0,
+                 REAL_MODE_FORMAT (TYPE_MODE (float128_type_node)),
+                 MPFR_RNDN);
+  real_convert (&value, TYPE_MODE (float128_type_node), &value);
+  mpfr_clears (m0, m1, NULL);
+  real_roundeven (&value, TYPE_MODE (float128_type_node), &value);
+
   bool fail = false;
   FIXED_WIDE_INT(128) i
     = FIXED_WIDE_INT(128)::from (real_to_integer (&value, &fail, 128), SIGNED);
 
-  FIXED_WIDE_INT(128) pow10 = get_power_of_ten (field->data.digits);
-  i = wi::smod_trunc (i, pow10);
-
   // We convert it to a integer string of digits:
   print_dec (i, ach, SIGNED);
 


        Jakub

Reply via email to