On Fri, Mar 21, 2025 at 08:25:10PM +0100, Richard Biener wrote:
> Hmm, but I see that digits_from_float128 from
> 
> (gdb) p debug (value)
> 1.0e+0
> 
> produces via real_to_integer zero:
> 
> (gdb) s
> real_to_integer (r=0x7fffffff69a0, fail=0x7fffffff685f, precision=128)
>     at ../../src/gcc/gcc/real.cc:1483
> (gdb) p debug (*r)
> 1.0e+0
> (gdb) n
> 1485      switch (r->cl)
> (gdb) 
> 1502          if (r->decimal)
> (gdb) 
> 1505          exp = REAL_EXP (r);
> (gdb) 
> 1506          if (exp <= 0)
> (gdb) 
> 1507            goto underflow;
> (gdb) 
> 1489          return wi::zero (precision);
> 
> we've come from initial_from_float128 which does
> 
>       REAL_VALUE_TYPE pow10
>         = real_powi10 (field->data.digits + field->data.rdigits);
>       real_arithmetic (&value, MULT_EXPR, &value, &pow10);
> 
> which produces the 1.0e+0 - do I need to process this to be "normal"?

Here is a more complete incremental patch, though just make check-cobol
tested.  In particular, not sure if the parser_display_internal stuff
is tested in the testsuite at all, we need to test both the 0/-0 cases and
values with exponents < -9, [9, -5], -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, [6, 9], 
> 9
and in each case something that rounds up and down from the %.33E to %.32E.

--- gcc/cobol/parse.y.jj        2025-03-22 07:59:58.575988929 +0100
+++ gcc/cobol/parse.y   2025-03-22 08:05:50.579195142 +0100
@@ -4331,7 +4331,8 @@ value_clause:   VALUE all LITERAL[lit] {
                   cbl_field_t *field = current_field();
                   auto orig_str = original_number();
                  REAL_VALUE_TYPE orig_val;
-                 real_from_string (&orig_val, orig_str);
+                 real_from_string3 (&orig_val, orig_str,
+                                    TYPE_MODE (float128_type_node));
                   char *initial = NULL;
 
                   if( real_identical (&orig_val, &$value) ) {
@@ -6910,10 +6911,22 @@ num_value:      scalar // might actually
 /*              ; */
 
 cce_expr:       cce_factor
-        |       cce_expr '+' cce_expr { real_arithmetic (&$$, PLUS_EXPR, &$1, 
&$3); }
-        |       cce_expr '-' cce_expr { real_arithmetic (&$$, MINUS_EXPR, &$1, 
&$3); }
-        |       cce_expr '*' cce_expr { real_arithmetic (&$$, MULT_EXPR, &$1, 
&$3); }
-        |       cce_expr '/' cce_expr { real_arithmetic (&$$, RDIV_EXPR, &$1, 
&$3); }
+        |       cce_expr '+' cce_expr {
+                  real_arithmetic (&$$, PLUS_EXPR, &$1, &$3);
+                  real_convert (&$$, TYPE_MODE (float128_type_node), &$$);
+                }
+        |       cce_expr '-' cce_expr {
+                  real_arithmetic (&$$, MINUS_EXPR, &$1, &$3);
+                  real_convert (&$$, TYPE_MODE (float128_type_node), &$$);
+                }
+        |       cce_expr '*' cce_expr {
+                  real_arithmetic (&$$, MULT_EXPR, &$1, &$3);
+                  real_convert (&$$, TYPE_MODE (float128_type_node), &$$);
+                }
+        |       cce_expr '/' cce_expr {
+                  real_arithmetic (&$$, RDIV_EXPR, &$1, &$3);
+                  real_convert (&$$, TYPE_MODE (float128_type_node), &$$);
+                }
         |                '+' cce_expr %prec NEG { $$ =  $2; }
         |                '-' cce_expr %prec NEG { $$ = real_value_negate 
(&$2); }
         |                '(' cce_expr ')'  { $$ = $2; }
@@ -6922,7 +6935,8 @@ cce_expr:       cce_factor
 cce_factor:     NUMSTR {
                   /* ???  real_from_string does not allow arbitrary radix.  */
                   // $$ = numstr2i($1.string, $1.radix);
-                 real_from_string (&$$, $1.string);
+                 real_from_string3 (&$$, $1.string,
+                                    TYPE_MODE (float128_type_node));
                 }
                 ;
 
--- gcc/cobol/genapi.cc.jj      2025-03-22 08:00:50.325284174 +0100
+++ gcc/cobol/genapi.cc 2025-03-22 08:21:18.287554771 +0100
@@ -4889,37 +4889,62 @@ parser_display_internal(tree file_descri
     if( !p )
       {
       // Probably INF -INF NAN or -NAN, so ach has our result
+      // Except that real_to_decimal prints -0.0 and 0.0 like that with
+      // no e.
+      if( ach[0] == '0' || ( ach[0] == '-' && ach[1] == '0' ))
+       __gg__remove_trailing_zeroes(ach);
       }
     else
       {
       p += 1;
       int exp = atoi(p);
       if( exp >= 6 || exp <= -5 )
-        {
-        // We are going to stick with the E notation, so ach has our result
-        }
-      else if (exp == 0)
        {
-         p[-1] = '\0';
+       // We are going to stick with the E notation, so ach has our result
+       // Except that real_to_decimal prints with e notation rather than E
+       // and doesn't guarantee at least two exponent digits.
+       *p = 'E';
+       if( exp < 0 && exp >= -9 )
+         {
+           p[1] = '-';
+           p[2] = '0';
+           p[3] = '0' - exp;
+           p[4] = '\0';
+         }
+       else if( exp >= 0 && exp <= 9 )
+         {
+           p[1] = '+';
+           p[2] = '0';
+           p[3] = '0' + exp;
+           p[4] = '\0';
+         }
        }
-      else if (exp < 0)
-        {
-         p[-1] = '\0';
-         char *q = strchr (ach, '.');
-         char dig = q[-1];
-         q[-1] = '\0';
-         char tem[132];
-         snprintf (tem, 132, "%s0.%0*u%c%s", ach, -exp - 1, 0, dig, q + 1);
-         strcpy (ach, tem);
-        }
-      else if (exp > 0)
-        {
+      else
+       {
+         // We want one fewer mantissa digit.  If last digit is not '5',
+         // we don't need to repeat real_from_decimal, otherwise do it
+         // to avoid double rounding issues.
+         if( p[-1] == '5' )
+           real_to_decimal (ach,
+                            TREE_REAL_CST_PTR (refer.field->data.value_of()),
+                            sizeof(ach), 33, 0);
          p[-1] = '\0';
-         char *q = strchr (ach, '.');
-         for (int i = 0; i != exp; ++i)
-           q[i] = q[i + 1];
-         q[exp] = '.';
-        }
+         // Transform %.32E format into %.*f for 32 - exp precision.
+         int neg = ach[0] == '-';
+         if( exp < 0 )
+           {
+             memmove (ach + 2 - exp + neg, ach + 2 + neg, 33);
+             ach[1 - exp + neg] = ach[neg];
+             ach[neg] = '0';
+             ach[neg + 1] = '.';
+             memset (ach + 2 + neg, '0', -1 - exp);
+           }
+         else if( exp > 0 )
+           {
+             memmove (ach + 1 + neg, ach + 2 + neg, exp);
+             ach[exp + 1 + neg] = '.';
+           }
+       }
       __gg__remove_trailing_zeroes(ach);
       }
 
@@ -15320,6 +15345,7 @@ digits_from_float128(char *retval, cbl_f
     {
       REAL_VALUE_TYPE pow10 = real_powi10 (rdigits);
       real_arithmetic (&value, MULT_EXPR, &value, &pow10);
+      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
@@ -15437,6 +15463,7 @@ initial_from_float128(cbl_field_t *field
       REAL_VALUE_TYPE pow10
        = real_powi10 (field->data.digits + field->data.rdigits);
       real_arithmetic (&value, MULT_EXPR, &value, &pow10);
+      real_convert (&value, TYPE_MODE (float128_type_node), &value);
       }
     else
       {
@@ -15448,6 +15475,7 @@ initial_from_float128(cbl_field_t *field
 
       REAL_VALUE_TYPE pow10 = real_powi10 (-field->data.rdigits);
       real_arithmetic (&value, RDIV_EXPR, &value, &pow10);
+      real_convert (&value, TYPE_MODE (float128_type_node), &value);
       }
     // Either way, we now have everything aligned for the remainder of the
     // processing to work:


        Jakub

Reply via email to