[gcc r17-2874] cobol: For fixed-point arithmetic, use struct int128 with ::rdigits member.
Robert Dubner via Gcc-cvs <[email protected]> Sat, 1 Aug 2026 16:06:00 +0000 (GMT)
| Newsgroups | gmane.comp.gcc.cvs |
|---|---|
| Message-ID | <[email protected]> |
https://gcc.gnu.org/g:56e8379dd25e53e9d716d3b5a45ad7de4da06809 commit r17-2874-g56e8379dd25e53e9d716d3b5a45ad7de4da06809 Author: Robert Dubner <[email protected]> Date: Sat Aug 1 11:50:49 2026 -0400 cobol: For fixed-point arithmetic, use struct int128 with ::rdigits member. The "struct int128" with the ::rdigits member makes for cleaner code when implementing fixed-point arithmetic. gcc/cobol/ChangeLog: * compare.cc (numeric_compare): Change comment. * genutil.cc (get_power_of_ten): Likewise. libgcobol/ChangeLog: * gmath.cc (get_int256_from_qualified_field): Use int128 structure. (multiply_int128_by_int128): Likewise. (__gg__multiplyf1_phase2): Likewise. (__gg__multiplyf2): Likewise. (__gg__dividef1_phase2): Likewise. (__gg__dividef23): Likewise. (__gg__dividef45): Likewise. * inspect.cc (inspect_backward_format_1): Likewise. (__gg__inspect_format_1): Likewise. (__gg__inspect_format_1_sbc): Likewise. * intrinsic.cc (get_value_as_double_from_qualified_field): Likewise. (populate_ctm_from_date): Likewise. (populate_ctm_from_time): Likewise. (__gg__char): Likewise. (__gg__char_national): Likewise. (__gg__combined_datetime): Likewise. (__gg__date_of_integer): Likewise. (__gg__date_to_yyyymmdd): Likewise. (__gg__day_of_integer): Likewise. (__gg__day_to_yyyyddd): Likewise. (__gg__factorial): Likewise. (__gg__integer_of_date): Likewise. (__gg__integer_of_day): Likewise. (__gg__random): Likewise. (__gg__test_date_yyyymmdd): Likewise. (__gg__test_day_yyyyddd): Likewise. (__gg__year_to_yyyy): Likewise. (__gg__locale_time_from_seconds): Likewise. * libgcobol.cc (__gg__power_of_ten): Change comment. (__gg__move): Use int128 structure. (__gg__string): Likewise. (__gg__binary_value_from_qualified_field): Likewise. (__gg__int128_from_qualified_field): Likewise. (__gg__float128_from_qualified_field): Likewise. (__gg__unstring): Likewise. * libgcobol.h (struct cbl_timespec): Add "struct int128" (__gg__binary_value_from_qualified_field): Use int128 structure. (__gg__int128_from_qualified_field): Use int128 structure. * stringbin.cc (packed_from_combined): Change comment. Diff: --- gcc/cobol/compare.cc | 2 +- gcc/cobol/genutil.cc | 2 +- libgcobol/gmath.cc | 209 +++++++++++++++++++++++-------------------------- libgcobol/inspect.cc | 57 +++++++------- libgcobol/intrinsic.cc | 180 ++++++++++++++++++------------------------ libgcobol/libgcobol.cc | 142 +++++++++++++++++---------------- libgcobol/libgcobol.h | 17 +++- libgcobol/stringbin.cc | 2 +- 8 files changed, 292 insertions(+), 319 deletions(-) diff --git a/gcc/cobol/compare.cc b/gcc/cobol/compare.cc index 8b612d545dad..0b7c301cc850 100644 --- a/gcc/cobol/compare.cc +++ b/gcc/cobol/compare.cc @@ -389,7 +389,7 @@ numeric_compare(tree &left, So consider comparing a 32.0 to a 1.9. To normalize them, I would have to multiply the 32.0 by 10^9, which would mean I would be comparing a 32.9 to a 1.9 . This is mathematically correct; the problem is that an - int128 can hold only only 38 digits, and thus can't handle the 41 digits + __int128 can hold only only 38 digits, and thus can't handle the 41 digits of a 32.9. So, in this routine I make sure the two values can be normalized into no diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc index bb6172f3db30..c8aa72ea99d9 100644 --- a/gcc/cobol/genutil.cc +++ b/gcc/cobol/genutil.cc @@ -1036,7 +1036,7 @@ get_power_of_ten(int n) }; if( n < 0 || n>MAX_POWER*2) // The most we can handle is 10**38 { - fprintf(stderr, "Trying to raise 10 to %d as an int128, which we can't do.\n", n); + fprintf(stderr, "Trying to raise 10 to %d as an __int128, which we can't do.\n", n); fprintf(stderr, "The problem is in %s.\n", __func__); abort(); } diff --git a/libgcobol/gmath.cc b/libgcobol/gmath.cc index e136494948bf..c4670ff10b08 100644 --- a/libgcobol/gmath.cc +++ b/libgcobol/gmath.cc @@ -598,12 +598,14 @@ get_int256_from_qualified_field(int256 &var, size_t field_o, size_t field_s) { - __int128 incoming = __gg__binary_value_from_qualified_field(&var.rdigits, - field, - field_o, - field_s); - int256_set_u128(var, 0, static_cast<uint128>(incoming)); - if( incoming < 0 ) + int128 incoming; + __gg__int128_from_qualified_field(incoming, + field, + field_o, + field_s); + var.rdigits = incoming.rdigits; + int256_set_u128(var, 0, static_cast<uint128>(incoming.i128)); + if( incoming.i128 < 0 ) { // This value is negative, so extend the sign bit: var.i64[2] = UINT64_MAX; @@ -1232,8 +1234,7 @@ __gg__subtractf3( cbl_arith_format_t , static bool multiply_intermediate_is_float; static GCOB_FP128 multiply_intermediate_float; -static __int128 multiply_intermediate_int128; -static int multiply_intermediate_rdigits; +static int128 multiply_intermediate_int128; extern "C" void @@ -1262,23 +1263,22 @@ __gg__multiplyf1_phase1(cbl_arith_format_t , else { multiply_intermediate_is_float = false; - multiply_intermediate_int128 = - __gg__binary_value_from_qualified_field(&multiply_intermediate_rdigits, - A[0].field, - A[0].offset, - A[0].size); + __gg__int128_from_qualified_field(multiply_intermediate_int128, + A[0].field, + A[0].offset, + A[0].size); } } static void multiply_int128_by_int128(int256 &ABCD, - __int128 ab_value, - __int128 cd_value) + const int128 &ab_value, + const int128 &cd_value) { - bool is_negative = (ab_value < 0) != (cd_value < 0); + bool is_negative = (ab_value.i128 < 0) != (cd_value.i128 < 0); - uint128 abs_ab = int128_abs_as_uint128(ab_value); - uint128 abs_cd = int128_abs_as_uint128(cd_value); + uint128 abs_ab = int128_abs_as_uint128(ab_value.i128); + uint128 abs_cd = int128_abs_as_uint128(cd_value.i128); uint128 AC00; uint128 AD0; @@ -1319,11 +1319,13 @@ void multiply_int128_by_int128(int256 &ABCD, temp.i64[3] = uint128_hi64(AC00); add_int256_to_int256(ABCD, temp); - // ABCD is now a 256-bit integer with rdigits decimal places + // ABCD is now a 256-bit integer if( is_negative ) { negate_int256(ABCD); } + ABCD.rdigits = ab_value.rdigits + cd_value.rdigits; + } extern "C" @@ -1370,10 +1372,11 @@ __gg__multiplyf1_phase2(cbl_arith_format_t , if( C[0].field->type == FldFloat ) { // fixed * float - a_value = (GCOB_FP128) multiply_intermediate_int128; - if( multiply_intermediate_rdigits ) + a_value = (GCOB_FP128) multiply_intermediate_int128.i128; + if( multiply_intermediate_int128.rdigits ) { - a_value /= (GCOB_FP128)__gg__power_of_ten(multiply_intermediate_rdigits); + a_value /= + (GCOB_FP128)__gg__power_of_ten(multiply_intermediate_int128.rdigits); } b_value = __gg__float128_from_qualified_field(C[0].field, C[0].offset, @@ -1387,19 +1390,17 @@ __gg__multiplyf1_phase2(cbl_arith_format_t , // We have two 128-bit numbers. Call them AB and CD, where A, B, C, D are // 64-bit "digits". We need to multiply them to create a 256-bit result - int cd_rdigits; - __int128 ab_value = multiply_intermediate_int128; - __int128 cd_value = __gg__binary_value_from_qualified_field(&cd_rdigits, - C[0].field, - C[0].offset, - C[0].size); + int128 ab_value = multiply_intermediate_int128; - int rdigits = multiply_intermediate_rdigits + cd_rdigits; + int128 cd_value; + __gg__int128_from_qualified_field(cd_value, + C[0].field, + C[0].offset, + C[0].size); int256 ABCD; multiply_int128_by_int128(ABCD, ab_value, cd_value); - ABCD.rdigits = rdigits; int overflow = squeeze_int256(ABCD); if( overflow ) { @@ -1409,7 +1410,7 @@ __gg__multiplyf1_phase2(cbl_arith_format_t , *compute_error |= conditional_stash(C[0].field, C[0].offset, C[0].size, on_size_error, int256_get_u128(ABCD, 0), - rdigits, + ABCD.rdigits, *rounded++); goto done; @@ -1467,18 +1468,17 @@ __gg__multiplyf2( cbl_arith_format_t , } else { - int a_rdigits; - int b_rdigits; - __int128 a_value = __gg__binary_value_from_qualified_field(&a_rdigits, - A[0].field, - A[0].offset, - A[0].size); - __int128 b_value = __gg__binary_value_from_qualified_field(&b_rdigits, - B[0].field, - B[0].offset, - B[0].size); + int128 a_value; + int128 b_value; + __gg__int128_from_qualified_field(a_value, + A[0].field, + A[0].offset, + A[0].size); + __gg__int128_from_qualified_field(b_value, + B[0].field, + B[0].offset, + B[0].size); multiply_int128_by_int128(product_fix, a_value, b_value); - product_fix.rdigits = a_rdigits + b_rdigits; int overflow = squeeze_int256(product_fix); if( overflow ) { @@ -1798,12 +1798,12 @@ __gg__dividef1_phase2(cbl_arith_format_t , { if( C[0].field->type == FldFloat ) { - // gixed * float - a_value = (GCOB_FP128) multiply_intermediate_int128; - if( multiply_intermediate_rdigits ) + // fixed by float + a_value = (GCOB_FP128) multiply_intermediate_int128.i128; + if( multiply_intermediate_int128.rdigits ) { a_value /= - (GCOB_FP128)__gg__power_of_ten(multiply_intermediate_rdigits); + (GCOB_FP128)__gg__power_of_ten(multiply_intermediate_int128.rdigits); } b_value = __gg__float128_from_qualified_field(C[0].field, C[0].offset, @@ -1812,26 +1812,20 @@ __gg__dividef1_phase2(cbl_arith_format_t , } else { - // fixed times fixed - - // We have two 128-bit numbers. Call them AB and CD, where A, B, C, D - // are 64-bit "digits". We need to multiply them to create a 256-bit - // result - - int dividend_rdigits; - __int128 dividend = __gg__binary_value_from_qualified_field( - ÷nd_rdigits, - C[0].field, - C[0].offset, - C[0].size); + // fixed by fixed + int128 dividend; + __gg__int128_from_qualified_field(dividend, + C[0].field, + C[0].offset, + C[0].size); int256 quotient; divide_int128_by_int128(quotient, - dividend, - dividend_rdigits, - multiply_intermediate_int128, - multiply_intermediate_rdigits, + dividend.i128, + dividend.rdigits, + multiply_intermediate_int128.i128, + multiply_intermediate_int128.rdigits, compute_error); int overflow = squeeze_int256(quotient); @@ -1914,26 +1908,24 @@ __gg__dividef23(cbl_arith_format_t , else { // fixed divided by fixed - int dividend_rdigits; - __int128 dividend = __gg__binary_value_from_qualified_field( - ÷nd_rdigits, - A[0].field, - A[0].offset, - A[0].size); - - int divisor_rdigits; - __int128 divisor = __gg__binary_value_from_qualified_field( - &divisor_rdigits, - B[0].field, - B[0].offset, - B[0].size); + int128 dividend; + __gg__int128_from_qualified_field(dividend, + A[0].field, + A[0].offset, + A[0].size); + + int128 divisor; + __gg__int128_from_qualified_field(divisor, + B[0].field, + B[0].offset, + B[0].size); int256 quotient; divide_int128_by_int128(quotient, - dividend, - dividend_rdigits, - divisor, - divisor_rdigits, + dividend.i128, + dividend.rdigits, + divisor.i128, + divisor.rdigits, compute_error); @@ -2006,27 +1998,24 @@ __gg__dividef45(cbl_arith_format_t , else { // fixed divided by fixed - int dividend_rdigits; - __int128 dividend = __gg__binary_value_from_qualified_field( - ÷nd_rdigits, - A[0].field, - A[0].offset, - A[0].size); - - int divisor_rdigits; - __int128 divisor = __gg__binary_value_from_qualified_field( - &divisor_rdigits, - B[0].field, - B[0].offset, - B[0].size); + int128 dividend; + __gg__int128_from_qualified_field(dividend, + A[0].field, + A[0].offset, + A[0].size); + int128 divisor; + __gg__int128_from_qualified_field(divisor, + B[0].field, + B[0].offset, + B[0].size); int256 quotient; divide_int128_by_int128(quotient, - dividend, - dividend_rdigits, - divisor, - divisor_rdigits, + dividend.i128, + dividend.rdigits, + divisor.i128, + divisor.rdigits, compute_error); *compute_error |= squeeze_int256(quotient); @@ -2034,8 +2023,7 @@ __gg__dividef45(cbl_arith_format_t , if( !*compute_error ) { // We are going to need the unrounded quotient to calculate the remainder - __int128 unrounded_quotient = 0; - int unrounded_quotient_digits; + int128 unrounded_quotient; rounded_p += 1;// Skip the rounded value for the remainder cbl_round_t rounded = *rounded_p; switch(rounded) @@ -2049,11 +2037,10 @@ __gg__dividef45(cbl_arith_format_t , int256_get_u128(quotient, 0), quotient.rdigits, *rounded_p++); - unrounded_quotient = __gg__binary_value_from_qualified_field( - &unrounded_quotient_digits, - C[1].field, - C[1].offset, - C[1].size); + __gg__int128_from_qualified_field(unrounded_quotient, + C[1].field, + C[1].offset, + C[1].size); break; } default: @@ -2063,11 +2050,10 @@ __gg__dividef45(cbl_arith_format_t , int256_get_u128(quotient, 0), quotient.rdigits, truncation_e); - unrounded_quotient = __gg__binary_value_from_qualified_field( - &unrounded_quotient_digits, - C[1].field, - C[1].offset, - C[1].size); + __gg__int128_from_qualified_field(unrounded_quotient, + C[1].field, + C[1].offset, + C[1].size); // At this point, we assign the rounded quotient to *C. *compute_error |= conditional_stash(C[1].field, C[1].offset, @@ -2100,12 +2086,11 @@ __gg__dividef45(cbl_arith_format_t , int256 temp; // Step 1: Multiply the unrounded quotient by the divisor multiply_int128_by_int128(temp, unrounded_quotient, divisor); - temp.rdigits = unrounded_quotient_digits + divisor_rdigits; int256 odividend = {}; - int256_set_u128(odividend, 0, static_cast<uint128>(dividend)); - odividend.rdigits = dividend_rdigits; - if( dividend < 0 ) + int256_set_u128(odividend, 0, static_cast<uint128>(dividend.i128)); + odividend.rdigits = dividend.rdigits; + if( dividend.i128 < 0 ) { odividend.i64[2] = UINT64_MAX; odividend.i64[3] = UINT64_MAX; diff --git a/libgcobol/inspect.cc b/libgcobol/inspect.cc index 373eb5068c5f..7c140cf692a8 100644 --- a/libgcobol/inspect.cc +++ b/libgcobol/inspect.cc @@ -1161,25 +1161,24 @@ inspect_backward_format_1(const size_t integers[], for(size_t i = 0; i<id_2_results.size(); i++) { - int rdigits; - __int128 id_2_value - = __gg__binary_value_from_qualified_field(&rdigits, - id_2_results[i].id2, - id_2_results[i].id2_o, - id_2_results[i].id2_s); - while(rdigits--) + int128 id_2_value; + __gg__int128_from_qualified_field(id_2_value, + id_2_results[i].id2, + id_2_results[i].id2_o, + id_2_results[i].id2_s); + while(id_2_value.rdigits--) { - id_2_value /= 10.0; + id_2_value.i128 /= 10.0; } // Accumulate what we've found into it - id_2_value += id_2_results[i].result; + id_2_value.i128 += id_2_results[i].result; // And put it back: __gg__int128_to_qualified_field(id_2_results[i].id2, id_2_results[i].id2_o, id_2_results[i].id2_s, - id_2_value, + id_2_value.i128, 0, truncation_e, NULL); @@ -1531,25 +1530,24 @@ __gg__inspect_format_1( int backward, for(size_t i = 0; i<id_2_results.size(); i++) { - int rdigits; - __int128 id_2_value - = __gg__binary_value_from_qualified_field(&rdigits, - id_2_results[i].id2, - id_2_results[i].id2_o, - id_2_results[i].id2_s); - while(rdigits--) + int128 id_2_value; + __gg__int128_from_qualified_field(id_2_value, + id_2_results[i].id2, + id_2_results[i].id2_o, + id_2_results[i].id2_s); + while(id_2_value.rdigits--) { - id_2_value /= 10.0; + id_2_value.i128 /= 10.0; } // Accumulate what we've found into it - id_2_value += id_2_results[i].result; + id_2_value.i128 += id_2_results[i].result; // And put it back: __gg__int128_to_qualified_field(id_2_results[i].id2, id_2_results[i].id2_o, id_2_results[i].id2_s, - id_2_value, + id_2_value.i128, 0, truncation_e, NULL); @@ -2994,25 +2992,24 @@ __gg__inspect_format_1_sbc( int backward, for(size_t i = 0; i<id_2_results.size(); i++) { - int rdigits; - __int128 id_2_value - = __gg__binary_value_from_qualified_field(&rdigits, - id_2_results[i].id2, - id_2_results[i].id2_o, - id_2_results[i].id2_s); - while(rdigits--) + int128 id_2_value; + __gg__int128_from_qualified_field(id_2_value, + id_2_results[i].id2, + id_2_results[i].id2_o, + id_2_results[i].id2_s); + while(id_2_value.rdigits--) { - id_2_value /= 10.0; + id_2_value.i128 /= 10.0; } // Accumulate what we've found into it - id_2_value += id_2_results[i].result; + id_2_value.i128 += id_2_results[i].result; // And put it back: __gg__int128_to_qualified_field(id_2_results[i].id2, id_2_results[i].id2_o, id_2_results[i].id2_s, - id_2_value, + id_2_value.i128, 0, truncation_e, NULL); diff --git a/libgcobol/intrinsic.cc b/libgcobol/intrinsic.cc index b56e828fb2b0..de139b2b59df 100644 --- a/libgcobol/intrinsic.cc +++ b/libgcobol/intrinsic.cc @@ -447,7 +447,7 @@ get_value_as_double_from_qualified_field( const cblc_field_t *input, size_t input_s) { double retval; - int rdigits; + int128 val128; switch( input->type ) { @@ -458,11 +458,11 @@ get_value_as_double_from_qualified_field( const cblc_field_t *input, break; default: - retval = __gg__binary_value_from_qualified_field(&rdigits, - input, - input_o, - input_s); - for(int i=0; i<rdigits; i++) + retval = __gg__int128_from_qualified_field(val128, + input, + input_o, + input_s); + for(int i=0; i<val128.rdigits; i++) { retval /= 10.0; } @@ -757,11 +757,9 @@ populate_ctm_from_date( struct cobol_tm &ctm, size_t pdate_size) { // Get the date as an integer - int rdigits; - double JD = (double)__gg__binary_value_from_qualified_field(&rdigits, - pdate, - pdate_offset, - pdate_size); + double JD = (double)__gg__int128_from_qualified_field(pdate, + pdate_offset, + pdate_size); populate_ctm_from_JD(ctm, JD); } @@ -800,15 +798,14 @@ populate_ctm_from_time( struct cobol_tm &ctm, if( poffset ) { - int rdigits; - int value = (int)__gg__binary_value_from_qualified_field(&rdigits, - poffset, - poffset_o, - poffset_s); - if( rdigits ) + int128 val128; + int value = (int)__gg__int128_from_qualified_field(val128, + poffset, + poffset_o, + poffset_s); + if( val128.rdigits ) { - value /= __gg__power_of_ten(rdigits); - rdigits = 0; + value /= __gg__power_of_ten(val128.rdigits); } ctm.tz_offset = value; if( abs(value) >= 1440 ) @@ -1210,8 +1207,6 @@ __gg__char( cblc_field_t *dest, size_t source_offset, size_t source_size) { - int rdigits; - // The CHAR function takes an integer, the ordinal position. It // returns a single-character string, which is the character at that // ordinal position in the DISPLAY collation. @@ -1219,11 +1214,12 @@ __gg__char( cblc_field_t *dest, // 'A', with the ascii value of 65, is at the ordinal position 66 // in the default collation. - int ordinal = (int)(__gg__binary_value_from_qualified_field(&rdigits, - source, - source_offset, - source_size)); - ordinal /= __gg__power_of_ten(rdigits); + int128 val128; + int ordinal = (int)(__gg__int128_from_qualified_field(val128, + source, + source_offset, + source_size)); + ordinal /= __gg__power_of_ten(val128.rdigits); ordinal -= 1; // We now look for that ordinal position in the collation table: @@ -1301,7 +1297,6 @@ __gg__char_national(cblc_field_t *dest, // Since we haven't tried to implement collation sequences for National, // this whole subroutine is a Hail Mary play. I frankly don't even know // why we tried. - int rdigits; // The CHAR function takes an integer, the ordinal position. It // returns a single-character string, which is the character at that @@ -1310,11 +1305,12 @@ __gg__char_national(cblc_field_t *dest, // 'A', with the ascii value of 65, is at the ordinal position 66 // in the default collation. - int ordinal = (int)(__gg__binary_value_from_qualified_field(&rdigits, - source, - source_offset, - source_size)); - ordinal /= __gg__power_of_ten(rdigits); + int128 val128; + int ordinal = (int)(__gg__int128_from_qualified_field(val128, + source, + source_offset, + source_size)); + ordinal /= __gg__power_of_ten(val128.rdigits); ordinal -= 1; // We need to convert the ch character to the destination encoding. @@ -1335,16 +1331,12 @@ __gg__combined_datetime(cblc_field_t *dest, size_t arg2_offset, size_t arg2_size) { - int rdigits; - - __int128 val1 = (int)(__gg__binary_value_from_qualified_field(&rdigits, - arg1, - arg1_offset, - arg1_size)); - __int128 val2 = (int)(__gg__binary_value_from_qualified_field(&rdigits, - arg2, - arg2_offset, - arg2_size)); + __int128 val1 = (int)(__gg__int128_from_qualified_field(arg1, + arg1_offset, + arg1_size)); + __int128 val2 = (int)(__gg__int128_from_qualified_field(arg2, + arg2_offset, + arg2_size)); __int128 value = val1 * 1000000 + val2; __gg__int128_to_field(dest, value, @@ -1450,11 +1442,9 @@ __gg__date_of_integer(cblc_field_t *dest, size_t source_size) { // FUNCTION DATE-OF-INTEGER - int rdigits; - double JD = (double)__gg__binary_value_from_qualified_field(&rdigits, - source, - source_offset, - source_size); + double JD = (double)__gg__int128_from_qualified_field(source, + source_offset, + source_size); JD += JD_OF_1601_01_02; int Y; int M; @@ -1483,10 +1473,9 @@ __gg__date_to_yyyymmdd( cblc_field_t *dest, { // FUNCTION DATE-TO-YYYYMMDD // See the discussion in ISO/IEC 2014-1989 Section 15.20 - int rdigits; - int arg1 = (int)__gg__binary_value_from_qualified_field(&rdigits, par1, par1_o, par1_s); - int arg2 = (int)__gg__binary_value_from_qualified_field(&rdigits, par2, par2_o, par2_s ); - int arg3 = (int)__gg__binary_value_from_qualified_field(&rdigits, par3, par3_o, par3_s); + int arg1 = (int)__gg__int128_from_qualified_field(par1, par1_o, par1_s); + int arg2 = (int)__gg__int128_from_qualified_field(par2, par2_o, par2_s ); + int arg3 = (int)__gg__int128_from_qualified_field(par3, par3_o, par3_s); int yy = arg1/10000; int mmdd = arg1%10000; @@ -1507,11 +1496,9 @@ __gg__day_of_integer( cblc_field_t *dest, size_t source_size) { // FUNCTION DAY-OF_INTEGER - int rdigits; - double JD = (double)__gg__binary_value_from_qualified_field(&rdigits, - source, - source_offset, - source_size); + double JD = (double)__gg__int128_from_qualified_field(source, + source_offset, + source_size); JD += JD_OF_1601_01_02; int Y; int M; @@ -1543,10 +1530,9 @@ __gg__day_to_yyyyddd( cblc_field_t *dest, { // FUNCTION DAY-TO-YYYYDDD // See the discussion in ISO/IEC 2014-1989 Section 15.20 - int rdigits; - int arg1 = (int)__gg__binary_value_from_qualified_field(&rdigits, par1, par1_o, par1_s); - int arg2 = (int)__gg__binary_value_from_qualified_field(&rdigits, par2, par2_o, par2_s ); - int arg3 = (int)__gg__binary_value_from_qualified_field(&rdigits, par3, par3_o, par3_s); + int arg1 = (int)__gg__int128_from_qualified_field(par1, par1_o, par1_s); + int arg2 = (int)__gg__int128_from_qualified_field(par2, par2_o, par2_s ); + int arg3 = (int)__gg__int128_from_qualified_field(par3, par3_o, par3_s); int yy = arg1/1000; int ddd = arg1%1000; @@ -1619,12 +1605,12 @@ __gg__factorial(cblc_field_t *dest, size_t source_size) { // FUNCTION FACTORIAL - int rdigits; - int N = (int)__gg__binary_value_from_qualified_field( &rdigits, - source, - source_offset, - source_size); - while(rdigits--) + int128 val128; + int N = (int)__gg__int128_from_qualified_field(val128, + source, + source_offset, + source_size); + while(val128.rdigits--) { N /= 10; } @@ -1918,11 +1904,9 @@ __gg__integer_of_date(cblc_field_t *dest, size_t source_size) { // FUNCTION INTEGER-OF-DATE - int rdigits; - long argument_1 = (long)(__gg__binary_value_from_qualified_field(&rdigits, - source, - source_offset, - source_size)); + long argument_1 = (long)(__gg__int128_from_qualified_field(source, + source_offset, + source_size)); int retval = 0; static const int max_days[13] = {0, 31, 28, 31, 30, 31, 30, @@ -1974,11 +1958,9 @@ __gg__integer_of_day( cblc_field_t *dest, { // FUNCTION INTEGER-OF-DAY // Convert YYYYDDD to "integer date" - int rdigits; - int yyyyddd = (int)__gg__binary_value_from_qualified_field( &rdigits, - source, - source_offset, - source_size); + int yyyyddd = (int)__gg__int128_from_qualified_field(source, + source_offset, + source_size); int yyyy = yyyyddd / 1000; int ddd = yyyyddd % 1000; @@ -3776,7 +3758,6 @@ __gg__random( cblc_field_t *dest, size_t input_size) { int32_t retval_31; - int rdigits; #if HAVE_INITSTATE_R && HAVE_SRANDOM_R && HAVE_RANDOM_R // This creates a thread-safe pseudo-random number generator // using input as the seed @@ -3794,18 +3775,16 @@ __gg__random( cblc_field_t *dest, __gg__clock_gettime(&ts); initstate_r( ts.tv_nsec, state, state_len, buf); } - int seed = (int)__gg__binary_value_from_qualified_field(&rdigits, - input, - input_offset, - input_size); + int seed = (int)__gg__int128_from_qualified_field(input, + input_offset, + input_size); srandom_r(seed, buf); random_r(buf, &retval_31); #else - seed = (unsigned)__gg__binary_value_from_qualified_field(&rdigits, - input, - input_offset, - input_size); + seed = (unsigned)__gg__int128_from_qualified_field(input, + input_offset, + input_size); srandom (seed); retval_31 = random (); #endif @@ -4022,11 +4001,9 @@ __gg__test_date_yyyymmdd( cblc_field_t *dest, size_t source_offset, size_t source_size) { - int rdigits; - int yyyymmdd = (int)__gg__binary_value_from_qualified_field(&rdigits, - source, - source_offset, - source_size); + int yyyymmdd = (int)__gg__int128_from_qualified_field(source, + source_offset, + source_size); int retval; int mmdd = yyyymmdd % 10000; int mm = mmdd / 100; @@ -4075,11 +4052,9 @@ __gg__test_day_yyyyddd( cblc_field_t *dest, size_t source_offset, size_t source_size) { - int rdigits; - int yyyyddd = (int)__gg__binary_value_from_qualified_field(&rdigits, - source, - source_offset, - source_size); + int yyyyddd = (int)__gg__int128_from_qualified_field(source, + source_offset, + source_size); int retval; int ddd = yyyyddd % 1000; int yyyy = yyyyddd / 1000; @@ -4164,10 +4139,9 @@ __gg__year_to_yyyy( cblc_field_t *dest, size_t par3_s) { // FUNCTION YEAR_TO_YYYY - int rdigits; - int yy = (int)__gg__binary_value_from_qualified_field(&rdigits, par1, par1_o, par1_s); - int arg2 = (int)__gg__binary_value_from_qualified_field(&rdigits, par2, par2_o, par2_s ); - int arg3 = (int)__gg__binary_value_from_qualified_field(&rdigits, par3, par3_o, par3_s); + int yy = (int)__gg__int128_from_qualified_field(par1, par1_o, par1_s); + int arg2 = (int)__gg__int128_from_qualified_field(par2, par2_o, par2_s ); + int arg3 = (int)__gg__int128_from_qualified_field(par3, par3_o, par3_s); int retval = year_to_yyyy(yy, arg2, arg3); @@ -6021,11 +5995,9 @@ __gg__locale_time_from_seconds( cblc_field_t *dest, // Default locale tm tm = {}; - int rdigits=0; - long seconds = (long)__gg__binary_value_from_qualified_field(&rdigits, - arg1, - arg1_o, - arg1_s); + long seconds = (long)__gg__int128_from_qualified_field(arg1, + arg1_o, + arg1_s); tm.tm_hour = seconds/3600; tm.tm_min = ((seconds%3600) / 60) % 100; tm.tm_sec = seconds % 100; diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc index ba421cee2cf8..70f4fdfa6199 100644 --- a/libgcobol/libgcobol.cc +++ b/libgcobol/libgcobol.cc @@ -1350,7 +1350,7 @@ __gg__power_of_ten(int n) if( n < 0 || n>MAX_POWER*2) // The most we can handle is 10**38 { fprintf(stderr, - "Trying to raise 10 to %d as an int128, which we can't do.\n", + "Trying to raise 10 to %d as an __int128, which we can't do.\n", n); fprintf(stderr, "The problem is in %s %s:%d.\n", @@ -6422,7 +6422,6 @@ __gg__move( cblc_field_t *fdest, int size_error = 0; // This is the return value __int128 value; - int rdigits; charmap_t *charmap = __gg__get_charmap(fdest->encoding); int stride = charmap->stride(); @@ -6598,10 +6597,9 @@ __gg__move( cblc_field_t *fdest, ? -fsource->rdigits : 0) ; // Pick up the absolute value of the source - value = __gg__binary_value_from_qualified_field(&rdigits, - fsource, - source_offset, - source_size); + value = __gg__int128_from_qualified_field(fsource, + source_offset, + source_size); char ach[128]; @@ -6676,10 +6674,9 @@ __gg__move( cblc_field_t *fdest, char ach[128]; // Turn the integer source into a value: - value = __gg__binary_value_from_qualified_field(&rdigits, - fsource, - source_offset, - source_size); + value = __gg__int128_from_qualified_field(fsource, + source_offset, + source_size); source_size = fsource->digits; @@ -6793,10 +6790,9 @@ __gg__move( cblc_field_t *fdest, char ach[128]; // Turn the integer source into a value: - value = __gg__binary_value_from_qualified_field(&rdigits, - fsource, - source_offset, - source_size); + value = __gg__int128_from_qualified_field(fsource, + source_offset, + source_size); // Turn the integer value into a string: __gg__binary_to_string_encoded(ach, source_size, @@ -6881,36 +6877,37 @@ __gg__move( cblc_field_t *fdest, case FldLiteralN: { // We are moving a number to a number: - value = __gg__binary_value_from_qualified_field(&rdigits, - fsource, - source_offset, - source_size); + int128 val128; + __gg__int128_from_qualified_field(val128, + fsource, + source_offset, + source_size); if( truncation_mode == trunc_std_e ) { // We need to adjust the value to have the rdigits of the // the destination: - int scaler = rdigits - fdest->rdigits; + int scaler = val128.rdigits - fdest->rdigits; if( scaler > 0 ) { - value /= __gg__power_of_ten(scaler); - rdigits -= scaler; + val128.i128 /= __gg__power_of_ten(scaler); + val128.rdigits -= scaler; } else if( scaler < 0 ) { - value *= __gg__power_of_ten(-scaler); - rdigits -= scaler; + val128.i128 *= __gg__power_of_ten(-scaler); + val128.rdigits -= scaler; } - if( value < 0 ) + if( val128.i128 < 0 ) { - value = -value; - value %= __gg__power_of_ten(fdest->digits); - value = -value; + val128.i128 = -val128.i128; + val128.i128 %= __gg__power_of_ten(fdest->digits); + val128.i128 = -val128.i128; } else { - value %= __gg__power_of_ten(fdest->digits); + val128.i128 %= __gg__power_of_ten(fdest->digits); } } @@ -6918,8 +6915,8 @@ __gg__move( cblc_field_t *fdest, fdest, dest_offset, dest_size, - value, - rdigits, + val128.i128, + val128.rdigits, rounded, &size_error ); break; @@ -6927,7 +6924,7 @@ __gg__move( cblc_field_t *fdest, case FldFloat: { - rdigits = get_scaled_rdigits(fdest); + int rdigits = get_scaled_rdigits(fdest); bool negative = false; __int128 value128 = 0; switch(fsource->capacity) @@ -7032,15 +7029,16 @@ __gg__move( cblc_field_t *fdest, case FldLiteralN: { // We are moving a number to a number: - value = __gg__binary_value_from_qualified_field(&rdigits, - fsource, - source_offset, - source_size); + int128 val128; + __gg__int128_from_qualified_field(val128, + fsource, + source_offset, + source_size); __gg__int128_to_qualified_field( fdest, dest_offset, dest_size, - value, - rdigits, + val128.i128, + val128.rdigits, rounded, &size_error ); break; @@ -7050,7 +7048,6 @@ __gg__move( cblc_field_t *fdest, { // We are converted a floating-point value fixed-point - rdigits = get_scaled_rdigits(fdest); GCOB_FP128 fp128=0; switch(fsource->capacity) { @@ -7112,10 +7109,9 @@ __gg__move( cblc_field_t *fdest, + (fsource->rdigits<0 ? -fsource->rdigits : 0) ; // Pick up the absolute value of the source - value = __gg__binary_value_from_qualified_field(&rdigits, - fsource, - source_offset, - source_size); + value = __gg__int128_from_qualified_field(fsource, + source_offset, + source_size); char ach[64]; // Convert it to the full complement of digits available @@ -8048,9 +8044,7 @@ __gg__string(const size_t integers[], const cblc_referlet_t *ref) int overflow = 0; if( ref[INDEX_OF_POINTER].field ) { - int rdigits; - int p = (size_t)__gg__binary_value_from_qualified_field( - &rdigits, + int p = (size_t)__gg__int128_from_qualified_field( ref[INDEX_OF_POINTER] .field, ref[INDEX_OF_POINTER] @@ -8603,19 +8597,39 @@ __gg__binary_value_from_field( int *rdigits, var->capacity); } -extern "C" __int128 -__gg__binary_value_from_qualified_field(int *rdigits, - const cblc_field_t *var, +__gg__int128_from_qualified_field(const cblc_field_t *var, size_t offset, size_t size) { - return get_binary_value_local( rdigits, + // Use this version when rdigits isn't relevant + int rdigits; + return get_binary_value_local( &rdigits, var, var->data + offset, size); } +__int128 +__gg__int128_from_qualified_field(int128 &i128, + const cblc_field_t *var, + size_t offset, + size_t size) + { + // This routine does double-duty. It converts VAR to a fixed-point + // int128 that carries an rdigits value. It also returns the __int128 + // portion of that value, because many routines that know there are no + // rdigits also call this routine. This is a holdover from the time + // before this routine was refactored to carry the rdigits, which were + // maintained in the external logic before int128::rdigits was implemented/ + + i128.i128 = get_binary_value_local(&i128.rdigits, + var, + var->data + offset, + size); + return i128.i128; + } + extern "C" GCOB_FP128 __gg__float128_from_field( cblc_field_t *field ) @@ -8650,14 +8664,14 @@ __gg__float128_from_qualified_field(const cblc_field_t *field, } else { - int rdigits; - retval = (GCOB_FP128)__gg__binary_value_from_qualified_field(&rdigits, - field, - offset, - size); - if( rdigits ) + int128 i128; + retval = (GCOB_FP128)__gg__int128_from_qualified_field(i128, + field, + offset, + size); + if( i128.rdigits ) { - retval /= (GCOB_FP128)__gg__power_of_ten(rdigits); + retval /= (GCOB_FP128)__gg__power_of_ten(i128.rdigits); } } return retval; @@ -10077,20 +10091,16 @@ __gg__unstring( const cblc_referlet_t *id2, if( id8 ) { - int rdigits; - tally = (int)__gg__binary_value_from_qualified_field(&rdigits, - id8, - id8_o, - id8_s); + tally = (int)__gg__int128_from_qualified_field(id8, + id8_o, + id8_s); } if( id7 ) { - int rdigits; - int p = (int)__gg__binary_value_from_qualified_field(&rdigits, - id7, - id7_o, - id7_s); + int p = (int)__gg__int128_from_qualified_field(id7, + id7_o, + id7_s); if( p < 1 ) { overflow = 1; diff --git a/libgcobol/libgcobol.h b/libgcobol/libgcobol.h index 3dadfef76616..92e8c497c630 100644 --- a/libgcobol/libgcobol.h +++ b/libgcobol/libgcobol.h @@ -105,6 +105,12 @@ struct cbl_timespec long tv_nsec; // Nanoseconds. } ; +typedef struct int128 + { + __int128 i128; + int rdigits; + }int128; + extern "C" void __gg__clock_gettime(struct cbl_timespec *tp); extern "C" GCOB_FP128 __gg__float128_from_location( @@ -116,10 +122,13 @@ extern "C" void __gg__realloc_if_necessary( char **dest, size_t *dest_size, size_t new_size); extern "C" void __gg__set_exception_file(const cblc_file_t *file); -extern "C" __int128 __gg__binary_value_from_qualified_field(int *rdigits, - const cblc_field_t *var, - size_t offset, - size_t size); +__int128 __gg__int128_from_qualified_field(const cblc_field_t *var, + size_t offset, + size_t size); +__int128 __gg__int128_from_qualified_field(struct int128 &i128, + const cblc_field_t *var, + size_t offset, + size_t size); extern "C" GCOB_FP128 __gg__float128_from_qualified_field(const cblc_field_t *field, size_t offset, size_t size); diff --git a/libgcobol/stringbin.cc b/libgcobol/stringbin.cc index 7d480d1bb97c..75e97ce965aa 100644 --- a/libgcobol/stringbin.cc +++ b/libgcobol/stringbin.cc @@ -407,7 +407,7 @@ packed_from_combined(const COMBINED &combined) if( combined.run > 9) { - // Stage 1: pull from int128 until the top half is zero. + // Stage 1: pull from __int128 until the top half is zero. __int128 value128 = combined.val128; #if COBOL_LITTLE_ENDIAN while(value128>>64)