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