> -----Original Message-----
> From: Jakub Jelinek <ja...@redhat.com>
> Sent: Tuesday, March 25, 2025 19:49
> To: Robert Dubner <rdub...@symas.com>; James K. Lowden
> <jklow...@cobolworx.com>; Richard Biener <rguent...@suse.de>
> Cc: gcc-patches@gcc.gnu.org
> Subject: [PATCH] cobol: Get rid of __int128 uses in the COBOL FE
> [PR119242]
>
> Hi!
>
> The following patch changes some remaining __int128 uses in the FE
> into FIXED_WIDE_INT(128), i.e. emulated 128-bit integral type.
> The use of wide_int_to_tree directly from that rather than going through
> build_int_cst_type means we don't throw away the upper 64 bits of the
> values, so the emitting of constants needing full 128 bits can be
greatly
> simplied.
> Plus all the #pragma GCC diagnostic ignored "-Wpedantic" spots aren't
> needed, we don't use the _Float128/__int128 types directly in the FE
> anymore.
>
> Tested on x86_64-linux with make check-cobol, could you please test this
> on UAT/NIST?
I took a minute to apply the patch and run the tests. Ten of the UAT
tests fail; they are the ones that test the ROUNDED clause.
It's 00:30 local time here, so I am not going to look into it now. But
here is a simple case so that you have something to chew on while I am
getting my beauty sleep:
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 N PIC S9.
PROCEDURE DIVISION.
COMPUTE N ROUNDED MODE AWAY-FROM-ZERO = -2.51
DISPLAY "N should be -3"
DISPLAY "N is " N
GOBACK.
END PROGRAM prog.
N should be -3
N is +1
>
> Note, PR119241/PR119242 bugs are still not fully fixed, I think the
> remaining problem is that several FE sources include
> ../../libgcobol/libgcobol.h and that header declares various APIs with
> __int128 and _Float128 types, so trying to build a cross-compiler on a
> host
> without __int128 and _Float128 will still fail miserably.
> I believe none of those APIs are actually used by the FE, so the
question
> is
> what the FE needs from libgcobol.h and whether the rest could be wrapped
> with #ifndef IN_GCC or #ifndef IN_GCC_FRONTEND or something similar
> (those 2 macros are predefined when compiling the FE files).
>
> 2025-03-26 Jakub Jelinek <ja...@redhat.com>
>
> PR cobol/119242
> * cobol/genutil.h (get_power_of_ten): Remove #pragma GCC
diagnostic
> around declaration.
> * cobol/genapi.cc (psa_FldLiteralN): Change type of value from
> __int128 to FIXED_WIDE_INT(128). Remove #pragma GCC diagnostic
> around the declaration. Use wi::min_precision to determine
> minimum unsigned precision of the value. Use wi::neg_p instead
> of value < 0 tests and wi::set_bit_in_zero<FIXED_WIDE_INT(128)>
> to build sign bit. Handle field->data.capacity == 16 like
> 1, 2, 4 and 8, use wide_int_to_tree instead of build_int_cst.
> (mh_source_is_literalN): Remove #pragma GCC diagnostic around
> the definition.
> (binary_initial_from_float128): Likewise.
> * cobol/genutil.cc (get_power_of_ten): Remove #pragma GCC
diagnostic
> before the definition.
>
> --- gcc/cobol/genutil.h.jj 2025-03-25 21:14:48.448384925 +0100
> +++ gcc/cobol/genutil.h 2025-03-25 21:19:24.358620134 +0100
> @@ -104,10 +104,7 @@ void get_binary_value( tree value,
> tree get_data_address( cbl_field_t *field,
> tree offset);
>
> -#pragma GCC diagnostic push
> -#pragma GCC diagnostic ignored "-Wpedantic"
> FIXED_WIDE_INT(128) get_power_of_ten(int n);
> -#pragma GCC diagnostic pop
> void scale_by_power_of_ten_N(tree value,
> int N,
> bool check_for_fractional = false);
> --- gcc/cobol/genapi.cc.jj 2025-03-25 21:11:06.767409766 +0100
> +++ gcc/cobol/genapi.cc 2025-03-25 21:22:28.038113833 +0100
> @@ -3798,16 +3798,13 @@ psa_FldLiteralN(struct cbl_field_t *fiel
> // We are constructing a completely static constant structure, based
on
> the
> // text string in .initial
>
> -#pragma GCC diagnostic push
> -#pragma GCC diagnostic ignored "-Wpedantic"
> - __int128 value = 0;
> -#pragma GCC diagnostic pop
> + FIXED_WIDE_INT(128) value = 0;
>
> do
> {
> // This is a false do{}while, to isolate the variables:
>
> - // We need to convert data.initial to an __int128 value
> + // We need to convert data.initial to an FIXED_WIDE_INT(128) value
> char *p = const_cast<char *>(field->data.initial);
> int sign = 1;
> if( *p == '-' )
> @@ -3903,24 +3900,24 @@ psa_FldLiteralN(struct cbl_field_t *fiel
>
> // We now need to calculate the capacity.
>
> - unsigned char *pvalue = (unsigned char *)&value;
> + unsigned int min_prec = wi::min_precision(value, UNSIGNED);
> int capacity;
> - if( *(uint64_t*)(pvalue + 8) )
> + if( min_prec > 64 )
> {
> // Bytes 15 through 8 are non-zero
> capacity = 16;
> }
> - else if( *(uint32_t*)(pvalue + 4) )
> + else if( min_prec > 32 )
> {
> // Bytes 7 through 4 are non-zero
> capacity = 8;
> }
> - else if( *(uint16_t*)(pvalue + 2) )
> + else if( min_prec > 16 )
> {
> // Bytes 3 and 2
> capacity = 4;
> }
> - else if( pvalue[1] )
> + else if( min_prec > 8 )
> {
> // Byte 1 is non-zero
> capacity = 2;
> @@ -3940,11 +3937,15 @@ psa_FldLiteralN(struct cbl_field_t *fiel
>
> if( capacity < 16 && (field->attr & signable_e) )
> {
> - if( value < 0 && (((pvalue[capacity-1] & 0x80) == 0 )))
> + if( wi::neg_p (value)
> + && (value & wi::set_bit_in_zero<FIXED_WIDE_INT(128)>(capacity
*
> 8
> + - 1)) !=
0
> )
> {
> capacity *= 2;
> }
> - else if( value >= 0 && (((pvalue[capacity-1] & 0x80) == 0x80 )))
> + else if( !wi::neg_p (value)
> + && (value &
> wi::set_bit_in_zero<FIXED_WIDE_INT(128)>(capacity * 8
> + -
1))
> == 0 )
> {
> capacity *= 2;
> }
> @@ -3964,86 +3965,15 @@ psa_FldLiteralN(struct cbl_field_t *fiel
>
> tree var_type;
>
> - if( field->data.capacity == 16 )
> - {
> - /* GCC-13 has no provision for an int128 constructor. So, we use
a
> - union for our necessary __int128.
> -
> - typedef union cblc_int128_t
> - {
> - unsigned char array16[16];
> - __uint128 uval128;
> - __int128 sval128;
> - } cblc_int128_t;
> -
> - We build a constructor for the array16[], and then we use that
> - constructor in the constructor for the union.
> - */
> -
> - // Build the constructor for array16
> - tree array16_type = build_array_type_nelts(UCHAR,
> 16);
> - tree array_16_constructor = make_node(CONSTRUCTOR);
> - TREE_TYPE(array_16_constructor) = array16_type;
> - TREE_STATIC(array_16_constructor) = 1;
> - TREE_CONSTANT(array_16_constructor) = 1;
> -
> - for(int i=0; i<16; i++)
> - {
> - CONSTRUCTOR_APPEND_ELT( CONSTRUCTOR_ELTS(array_16_constructor),
> - build_int_cst_type(INT, i),
> - build_int_cst_type(UCHAR,
> - ((unsigned char
> *)&value)[i]));
> - }
> -
> - // The array16 constructor is ready to be used
> -
> - // So, we need a constructor for the union:
> - // Now we create the union:
> - var_type = cblc_int128_type_node;
> -
> - tree union_constructor = make_node(CONSTRUCTOR);
> - TREE_TYPE(union_constructor) = var_type;
> - TREE_STATIC(union_constructor) = 1;
> - TREE_CONSTANT(union_constructor) = 1;
> -
> - // point next_field to the first field of the union, and
> - // set the value to be the table constructor
> - tree next_field = TYPE_FIELDS(var_type);
> - CONSTRUCTOR_APPEND_ELT( CONSTRUCTOR_ELTS(union_constructor),
> - next_field,
> - array_16_constructor );
> -
> - tree new_var_decl = gg_define_variable( var_type,
> - base_name,
> - vs_static);
> - DECL_INITIAL(new_var_decl) = union_constructor;
> -
> - field->data_decl_node = member(new_var_decl, "sval128");
> - TREE_READONLY(field->data_decl_node) = 1;
> - TREE_CONSTANT(field->data_decl_node) = 1;
> -
> - // Convert the compile-time data.value to a run-time variable decl
> node:
> - sprintf(id_string, ".%ld", ++our_index);
> - strcpy(base_name, field->name);
> - strcat(base_name, id_string);
> - field->literal_decl_node = gg_define_variable(DOUBLE, id_string,
> vs_static);
> - TREE_READONLY(field->literal_decl_node) = 1;
> - TREE_CONSTANT(field->literal_decl_node) = 1;
> - tree initer = fold_convert (DOUBLE, field->data.value_of());
> - DECL_INITIAL(field->literal_decl_node) = initer;
> -
> - }
> - else
> - {
> - // The value is 1, 2, 4, or 8 bytes, so an ordinary constructor can
> be used.
> - var_type = tree_type_from_size( field->data.capacity,
> - field->attr & signable_e);
> - tree new_var_decl = gg_define_variable( var_type,
> - base_name,
> - vs_static);
> - DECL_INITIAL(new_var_decl) = build_int_cst_type(var_type, value);
> - field->data_decl_node = new_var_decl;
> - }
> + // The value is 1, 2, 4, 8 or 16 bytes, so an ordinary constructor
can
> be
> + // used.
> + var_type = tree_type_from_size( field->data.capacity,
> + field->attr & signable_e);
> + tree new_var_decl = gg_define_variable( var_type,
> + base_name,
> + vs_static);
> + DECL_INITIAL(new_var_decl) = wide_int_to_tree(var_type, value);
> + field->data_decl_node = new_var_decl;
> }
>
> static void
> @@ -13739,8 +13669,6 @@ mh_identical(cbl_refer_t &destref,
> return moved;
> }
>
> -#pragma GCC diagnostic push
> -#pragma GCC diagnostic ignored "-Wpedantic"
> static bool
> mh_source_is_literalN(cbl_refer_t &destref,
> cbl_refer_t &sourceref,
> @@ -14013,7 +13941,6 @@ mh_source_is_literalN(cbl_refer_t &destr
> }
> return moved;
> }
> -#pragma GCC diagnostic pop
>
> static
> tree float_type_of(int n)
> @@ -15245,8 +15172,6 @@ real_powi10 (uint32_t x)
> return pow10;
> }
>
> -#pragma GCC diagnostic push
> -#pragma GCC diagnostic ignored "-Wpedantic"
> char *
> binary_initial_from_float128(cbl_field_t *field, int rdigits,
> REAL_VALUE_TYPE value)
> @@ -15322,7 +15247,6 @@ binary_initial_from_float128(cbl_field_t
>
> return retval;
> }
> -#pragma GCC diagnostic pop
>
>
> static void
> --- gcc/cobol/genutil.cc.jj 2025-03-25 21:14:52.450330315 +0100
> +++ gcc/cobol/genutil.cc 2025-03-25 21:19:08.743833202 +0100
> @@ -1419,9 +1419,6 @@ get_data_address( cbl_field_t *field,
> }
> }
>
> -// Ignore pedantic because we know 128-bit computation is not ISO
C++14.
> -#pragma GCC diagnostic ignored "-Wpedantic"
> -
> FIXED_WIDE_INT(128)
> get_power_of_ten(int n)
> {
>
> Jakub
