> -----Original Message-----
> From: Jakub Jelinek <ja...@redhat.com>
> Sent: Wednesday, March 26, 2025 08:24
> To: Robert Dubner <rdub...@symas.com>
> Cc: James K. Lowden <jklow...@cobolworx.com>; Richard Biener
> <rguent...@suse.de>; gcc-patches@gcc.gnu.org
> Subject: [PATCH] cobol, v2: Get rid of __int128 uses in the COBOL FE
> [PR119242]
>
> On Tue, Mar 25, 2025 at 11:36:10PM -0500, Robert Dubner wrote:
> > 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
>
> Sorry, got the conversion wrong in 2 spots.
>
> For signable the old code did
> if( value < 0 && (((pvalue[capacity-1] & 0x80) == 0 )))
> {
> capacity *= 2;
> }
> else if( value >= 0 && (((pvalue[capacity-1] & 0x80) == 0x80 )))
> {
> capacity *= 2;
> }
> value < 0 has been correctly replaced with wi::neg_p (value)
> and (pvalue[capacity-1] & 0x80) with
> (value & wi::set_bit_in_zero<FIXED_WIDE_INT(128)>(capacity * 8 - 1))
> (both are testing the same bit), but I got the two comparisons exactly
> the other way, for negative values it was testing if that bit is set
> (while previously it was testing if it was clear) and vice versa.
>
> Here is a fixed patch, passes make check-cobol, but that is
unfortunately
> still not enough.
With this second fixed patch, all of our tests pass.
Implicit criticism about tests accepted. I have 679 UAT tests, and now
I've got the bit in my teeth, and I am creating a process that will
convert as many as I can to DejaGnu. However: the autom4te and DejaGnu
principles, practices, and philosophies are almost, but not quite,
completely unlike each other.
With Jim back to help pay attention to the e-mails, I'll be able to focus
on the conversion. I hope to have a first tranche later today.
>
> 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-26 13:16:23.932827326 +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,13 @@ psa_FldLiteralN(struct cbl_field_t *fiel
>
> if( capacity < 16 && (field->attr & signable_e) )
> {
> - if( value < 0 && (((pvalue[capacity-1] & 0x80) == 0 )))
> + FIXED_WIDE_INT(128) mask
> + = wi::set_bit_in_zero<FIXED_WIDE_INT(128)>(capacity * 8 - 1);
> + if( wi::neg_p (value) && (value & mask) == 0 )
> {
> capacity *= 2;
> }
> - else if( value >= 0 && (((pvalue[capacity-1] & 0x80) == 0x80 )))
> + else if( !wi::neg_p (value) && (value & mask) != 0 )
> {
> capacity *= 2;
> }
> @@ -3964,86 +3963,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 +13667,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 +13939,6 @@ mh_source_is_literalN(cbl_refer_t &destr
> }
> return moved;
> }
> -#pragma GCC diagnostic pop
>
> static
> tree float_type_of(int n)
> @@ -15245,8 +15170,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 +15245,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
