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
