Okay!
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
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
I am working on expanding the cobol.dg test suite. I really am. I am
about ready to take dg-output-file out for a spin.
> -----Original Message-----
> From: Jakub Jelinek <[email protected]>
> Sent: Saturday, March 22, 2025 03:29
> To: Richard Biener <[email protected]>
> Cc: Robert Dubner <[email protected]>; [email protected]
> Subject: Re: [PATCH] change cbl_field_data_t::etc_t::value from
_Float128
> to tree
>
> 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
