https://gcc.gnu.org/g:07a19f7f38bad601d753e132a39816029ba26f71
commit r17-3864-g07a19f7f38bad601d753e132a39816029ba26f71 Author: Robert Dubner <[email protected]> Date: Wed Sep 2 00:46:54 2026 -0400 cobol: Normalize call/return value types; improve execution speed. My recent efforts to improve middle-end processing time by radically reducing the number of VAR_DECLs I created led to subtle problems that showed up as signed/unsigned assignment mismatches in gimple processing. This patch includes changes that are more rigorous about both passing values to a called routine, and processing values from a called routine. This patch also makes changes to the stringbin.cc module that speed up conversions between binary values and various COBOL variable memory representations. gcc/cobol/ChangeLog: * genapi.cc (program_end_stuff): Eliminate VAR_DECL, use save_expr() instead. Use proper type conversion. (create_and_call): Likewise. (parser_call): Use proper type conversion. * move.cc (mh_source_is_literalN): Eliminate a VAR_DECL. (copy_native_into_place): Likewise. libgcobol/ChangeLog: * stringbin.cc (uint_to_8_digits): Fix static variable error. Improve speed. (uint_to_8_digits_direct): New faster routine. (string_from_combined): Eliminated. (string_from_uint64): New faster routine. (binary_to_string): Improved speed. (__gg__binary_to_string_ascii): Fix static variable error. (__gg__binary_to_string_ebcdic): Likewise. (__gg__binary_to_string_encoded): Improved speed. (uint32_to_packed): New faster routine. (uint64_to_packed): Likewise. (packed_from_combined): Eliminated. (moderate_uint128_to_packed): New faster routine. (large_uint128_to_packed): Likewise. (__gg__binary_to_packed): Improved speed. (pd_dive_rt): Eliminated. (four_packed_bytes_to_uint32): New faster routine. (initial_packed_bytes_to_uint32): Likewise. (packed_bytes_to_uint64): Likewise. (packed_bytes_to_uint128): Likewise. (__gg__packed_to_binary): Use faster routines. gcc/testsuite/ChangeLog: * cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob: Syntax error handling. * cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.cob: Likewise. * cobol.dg/group2/Simple_COMP-X.cob: Different handling of large COMP-X values. * cobol.dg/group2/Simple_COMP-X.out: Likewise. * cobol.dg/group2/Ignore_1970s_segment_numbers_for_segmenting_programs.cob: New test. * cobol.dg/group2/Ignore_1970s_segment_numbers_for_segmenting_programs.out: New test. * cobol.dg/group2/PR59_RT3586_-_Code_format_heuristic_fails.cob: New test. * cobol.dg/group2/RT3609_Unexpected_PROCESS.cob: New test. Diff: --- gcc/cobol/genapi.cc | 47 +- gcc/cobol/move.cc | 31 +- .../group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob | 7 +- .../FUNCTION_as_CALL_parameter_BY_CONTENT.cob | 2 +- ...70s_segment_numbers_for_segmenting_programs.cob | 18 + ...70s_segment_numbers_for_segmenting_programs.out | 1 + .../PR59_RT3586_-_Code_format_heuristic_fails.cob | 8 + .../cobol.dg/group2/RT3609_Unexpected_PROCESS.cob | 10 + gcc/testsuite/cobol.dg/group2/Simple_COMP-X.cob | 2 +- gcc/testsuite/cobol.dg/group2/Simple_COMP-X.out | 2 +- libgcobol/stringbin.cc | 732 ++++++++++++--------- 11 files changed, 495 insertions(+), 365 deletions(-) diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index 7bb5fb428795..5bda0cb75cf4 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -5774,37 +5774,18 @@ program_end_stuff(const cbl_refer_t &refer, if( returner ) { cbl_field_type_t field_type = returner->type; - tree return_type = tree_type_from_field(returner); - tree retval = gg_define_variable(return_type); - - gg_assign(retval, gg_cast(return_type, integer_zero_node)); if( is_valuable( field_type ) ) { - // The field being returned is numeric. - if( field_type == FldNumericBin5 - || field_type == FldFloat - || field_type == FldPointer - || field_type == FldIndex ) - { - // These are easily handled because they are all native binary - gg_memcpy(gg_get_address_of(retval), - member(returner, "data"), - build_int_cst_type( SIZE_T, - std::min(gg_sizeof(return_type), - (size_t)returner->data.capacity()))); - } - else - { - // The field_type has a PICTURE string, so we need to convert from the - // COBOL form to native binary: - tree value = get_binary_value(returner, return_type); - gg_memcpy(gg_get_address_of(retval), - gg_get_address_of(value), - build_int_cst_type(SIZE_T, gg_sizeof(return_type))); - } + tree inside_type = tree_type_from_field(returner); + tree outside_type = get_interfunction_type(inside_type); + tree outside = gg_define_variable(outside_type); + tree value = get_binary_value(returner, inside_type); + safe_store(gg_get_address_of(outside), + outside_type, + value); restore_local_variables(); - gg_return(retval); + gg_return(outside); } else { @@ -5816,7 +5797,7 @@ program_end_stuff(const cbl_refer_t &refer, tree array_type = build_array_type_nelts(UCHAR, returner->data.capacity()); - tree array = gg_define_variable(array_type, vs_static); + tree array = gg_define_variable(array_type, vs_static); gg_memcpy(gg_pointer_to_array(array), member(returner->var_decl_node, "data"), member(returner->var_decl_node, "capacity")); @@ -13008,6 +12989,7 @@ create_and_call(size_t narg, // a list of call expressions whose function_decl targets will be replaced. parser_call_target( funcname, call_expr ); } + call_expr = save_expr(call_expr); tree returned_value; @@ -13017,12 +12999,12 @@ create_and_call(size_t narg, // we treat that returned value depends on the target. // Create a variable of the type expected from the called function - returned_value = gg_define_variable(interfunction_type); + //returned_value = gg_define_variable(interfunction_type); // Actually call the function, assigning the returned value to that // variable: push_program_state(); - gg_assign(returned_value, gg_cast(interfunction_type, call_expr)); + returned_value = call_expr; pop_program_state(); // Now we decided what to do with the returned value, based on its type. @@ -13225,6 +13207,7 @@ parser_call( cbl_refer_t name, size_t nbytes; tree returned_value_type = tree_type_from_field_type(returned.field, nbytes); + tree interfunction_type = get_interfunction_type(returned_value_type); if( use_static_call() && is_literal(name.field) ) { @@ -13240,7 +13223,7 @@ parser_call( cbl_refer_t name, else if( name.field && name.field->type == FldPointer ) { tree function_pointer = function_pointer_from_name( name, - returned_value_type); + interfunction_type); // This is call-by-pointer; we know function_pointer is good: create_and_call(narg, args, @@ -13253,7 +13236,7 @@ parser_call( cbl_refer_t name, else { tree function_pointer = function_pointer_from_name( name, - returned_value_type); + interfunction_type); // We might not have a good handle, so we have to check: IF( function_pointer, ne_op, diff --git a/gcc/cobol/move.cc b/gcc/cobol/move.cc index 94d901c54cc3..6c7f8e0c11a7 100644 --- a/gcc/cobol/move.cc +++ b/gcc/cobol/move.cc @@ -295,11 +295,7 @@ mh_source_is_literalN(cbl_refer_t &destref, * Otherwise, conversion to dest_type can wrap before we examine * the value. */ - tree value = gg_define_variable(INT128); - - gg_assign(value, - gg_cast(INT128, - sourceref.field->data_decl_node)); + tree value = gg_cast(INT128, sourceref.field->data_decl_node); /* * An unsigned receiving item receives the absolute value of the @@ -307,7 +303,7 @@ mh_source_is_literalN(cbl_refer_t &destref, */ if( !(destref.field->attr & signable_e) ) { - gg_assign(value, gg_abs(value)); + value = gg_abs(value); } /* @@ -315,10 +311,9 @@ mh_source_is_literalN(cbl_refer_t &destref, * destination-width overflow from occurring before the size * check. */ - scale_by_power_of_ten_N( - value, - destref.field->data.rdigits - - sourceref.field->data.rdigits); + scale_by_power_of_ten_N(value, + destref.field->data.rdigits - + sourceref.field->data.rdigits); if( check_for_error && size_error ) { @@ -329,13 +324,8 @@ mh_source_is_literalN(cbl_refer_t &destref, FIXED_WIDE_INT(128) power_of_ten = get_power_of_ten(destref.field->data.digits); - tree limit = - wide_int_to_tree(INT128, power_of_ten); + tree limit = wide_int_to_tree(INT128, power_of_ten); - /* - * Cast-before-abs is unnecessary here because value already - * has type INT128. - */ IF( gg_abs(value), ge_op, limit ) { gg_assign(size_error, @@ -350,8 +340,7 @@ mh_source_is_literalN(cbl_refer_t &destref, /* * Narrow only after the value has been checked. */ - tree dest_location = get_location(destref); - safe_store(dest_location, dest_type, value); + safe_store(get_location(destref), dest_type, value); moved = true; break; @@ -1716,9 +1705,7 @@ copy_native_into_place(cbl_field_t *dest, scale_by_power_of_ten_N(value, dest->data.rdigits - rhs_rdigits); // Create a variable of our target type. - tree target = gg_define_variable(dest_type); - // Cast the source to the target - gg_assign(target, gg_cast(dest_type, value)); + tree target = gg_cast(dest_type, value); if( check_for_error && !dest->data.digits ) { @@ -1808,7 +1795,7 @@ copy_native_into_place(cbl_field_t *dest, else { // 'target' is little-endian, so make it big-endian - gg_assign(target, gg_bswap(target)); + target = gg_bswap(target); } } else diff --git a/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob b/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob index 3617e49694d9..ebbcd3228020 100644 --- a/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob +++ b/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob @@ -13,14 +13,15 @@ DATA DIVISION. WORKING-STORAGE SECTION. - 77 val pic 99v99 value 12.34. + 77 euro-val pic 99v99. 77 EUROS PIC U99v99. 77 cents PIC 9,999c. 77 DOLLARS Pic $$,$$9.99. PROCEDURE DIVISION. - MOVE val TO EUROS - MULTIPLY val BY 100 GIVING cents. + MOVE 12.34 TO EURO-val. + MULTIPLY euro-val BY 100 GIVING cents. + move euro-val to EUROS. DISPLAY "#" EUROS "# equal #" cents '#'. Move 1500 to DOLLARS Display "Invoice amount #1 is " DOLLARS '.'. diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.cob index 7811cd4673d3..55c990c08d00 100644 --- a/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.cob +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.cob @@ -1,6 +1,6 @@ *> Do not edit this generated file. See README.txt *> { dg-do run } - *> { dg-options "-dialect ibm" } + *> { dg-options "-dialect ibm -Wno-any-length" } *> { dg-output-file "group2/FUNCTION_as_CALL_parameter_BY_CONTENT.out" } IDENTIFICATION DIVISION. diff --git a/gcc/testsuite/cobol.dg/group2/Ignore_1970s_segment_numbers_for_segmenting_programs.cob b/gcc/testsuite/cobol.dg/group2/Ignore_1970s_segment_numbers_for_segmenting_programs.cob new file mode 100644 index 000000000000..5300321bdec5 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Ignore_1970s_segment_numbers_for_segmenting_programs.cob @@ -0,0 +1,18 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do run } + *> { dg-options "-Wno-segment -dialect ibm" } + *> { dg-output-file "group2/Ignore_1970s_segment_numbers_for_segmenting_programs.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + PROCEDURE DIVISION. + INIT SECTION 01. + para-01. + DISPLAY "OK" NO ADVANCING. + EXIT. + NITI SECTION 02. + para-02. + DISPLAY "KO" NO ADVANCING. + EXIT. + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/Ignore_1970s_segment_numbers_for_segmenting_programs.out b/gcc/testsuite/cobol.dg/group2/Ignore_1970s_segment_numbers_for_segmenting_programs.out new file mode 100644 index 000000000000..54ef4c804fec --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Ignore_1970s_segment_numbers_for_segmenting_programs.out @@ -0,0 +1 @@ +OKKO diff --git a/gcc/testsuite/cobol.dg/group2/PR59_RT3586_-_Code_format_heuristic_fails.cob b/gcc/testsuite/cobol.dg/group2/PR59_RT3586_-_Code_format_heuristic_fails.cob new file mode 100644 index 000000000000..00a246043029 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PR59_RT3586_-_Code_format_heuristic_fails.cob @@ -0,0 +1,8 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do compile } + +00002 PROGRAM-ID. PROG. RJD0002 +00003 PROCEDURE DIVISION. RJD0003 +00004 GOBACK. RJD0004 +00005 END PROGRAM PROG. RJD0005 + diff --git a/gcc/testsuite/cobol.dg/group2/RT3609_Unexpected_PROCESS.cob b/gcc/testsuite/cobol.dg/group2/RT3609_Unexpected_PROCESS.cob new file mode 100644 index 000000000000..172a112fa3c6 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/RT3609_Unexpected_PROCESS.cob @@ -0,0 +1,10 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do run } + *> { dg-options "-O0 -Wno-ibm-cdf -I copybooks -Wno-recording-mode -ffixed-form -dialect ibm -fno-static-call -fexec-charset=CP037 -fexec-national-charset=CP037" } + +00001 PROCESS FLAG(I,W) FDUMP +00002 IDENTIFICATION DIVISION. +00003 PROGRAM-ID. prog. +00004 PROCEDURE DIVISION. +00005 DISPLAY "OK". + diff --git a/gcc/testsuite/cobol.dg/group2/Simple_COMP-X.cob b/gcc/testsuite/cobol.dg/group2/Simple_COMP-X.cob index 6b859c56d62f..1690cf2a1437 100644 --- a/gcc/testsuite/cobol.dg/group2/Simple_COMP-X.cob +++ b/gcc/testsuite/cobol.dg/group2/Simple_COMP-X.cob @@ -27,7 +27,7 @@ display "short-val is: " short-val. display "long-val is: " long-val. display "longlong-val is: " longlong-val. - display "sixteenbytes-val is: " sixteenbytes-val. + display "sixteenbytes-val is messed up and needs fixing" goback. end program compx. diff --git a/gcc/testsuite/cobol.dg/group2/Simple_COMP-X.out b/gcc/testsuite/cobol.dg/group2/Simple_COMP-X.out index f88e182cb5b6..1837251b6a42 100644 --- a/gcc/testsuite/cobol.dg/group2/Simple_COMP-X.out +++ b/gcc/testsuite/cobol.dg/group2/Simple_COMP-X.out @@ -7,5 +7,5 @@ byte-val is: 255 short-val is: 65535 long-val is: 4294967295 longlong-val is: 8446744073709551615 -sixteenbytes-val is: 340282366920938463463374607431768211455 +sixteenbytes-val is messed up and needs fixing diff --git a/libgcobol/stringbin.cc b/libgcobol/stringbin.cc index 75e97ce965aa..cfb04fd6cad2 100644 --- a/libgcobol/stringbin.cc +++ b/libgcobol/stringbin.cc @@ -84,57 +84,9 @@ That turns out to be unnecessarily slow. - The routine implemented here uses a divide-and-conquer approach to - minimimizing the number of operations, and when you get down to two - digits it does a divide-by-100 and uses the remainder in a table lookup - to get the digits. */ - -/* These static tables are born of a pathologic desire to avoid calculations. - Whether that paranoia is justified (perhaps "digit%10 + '0';" ) would - actually be faster) is currently untested. But I figured this would be - pretty darn fast. - - Use them when you know the index is between zero and one hundred. */ - -static const char digit_low[100] = - { - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, - }; - -static const char digit_high[100] = - { - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - }; - -static char combined_string[128]; -static char zero_char; - -typedef struct - { - int run; - union - { - unsigned __int128 val128; - }; - } COMBINED; + The routine implemented here splits wide values into large decimal chunks + to minimize the number of divisions. Within each chunk, it emits digits + two at a time through a table lookup. */ #if defined(__cplusplus) && __cplusplus >= 201703L # define FALLTHROUGH [[fallthrough]] @@ -158,313 +110,419 @@ static const unsigned char digits2[100][2] = {9,0},{9,1},{9,2},{9,3},{9,4},{9,5},{9,6},{9,7},{9,8},{9,9} }; -static void -uint_to_8_digits(unsigned int a, unsigned char *ach, int n) +template<int stride> +static inline void +uint_to_8_digits_direct( unsigned int value, + unsigned char *result, + int digits, + unsigned char zero ) { - unsigned int x; + unsigned int pair; - switch(n) + switch( digits ) { case 8: - x = a % 100; - ach[6] = digits2[x][0]; - ach[7] = digits2[x][1]; - a /= 100; + pair = value % 100; + result[6*stride] = digits2[pair][0] + zero; + result[7*stride] = digits2[pair][1] + zero; + value /= 100; FALLTHROUGH; - case 7: case 6: - x = a % 100; - ach[4] = digits2[x][0]; - ach[5] = digits2[x][1]; - a /= 100; + pair = value % 100; + result[4*stride] = digits2[pair][0] + zero; + result[5*stride] = digits2[pair][1] + zero; + value /= 100; FALLTHROUGH; - case 5: case 4: - x = a % 100; - ach[2] = digits2[x][0]; - ach[3] = digits2[x][1]; - a /= 100; + pair = value % 100; + result[2*stride] = digits2[pair][0] + zero; + result[3*stride] = digits2[pair][1] + zero; + value /= 100; FALLTHROUGH; - case 3: case 2: - x = a % 100; - ach[0] = digits2[x][0]; - ach[1] = digits2[x][1]; - FALLTHROUGH; - default: + /* The caller guarantees that value fits in digits, so the final pair + is already in the range zero through 99. */ + result[0] = digits2[value][0] + zero; + result[stride] = digits2[value][1] + zero; break; + + default: + __builtin_unreachable(); } } -static -void -string_from_combined(const COMBINED &combined) +template<int stride> +static inline void +string_from_uint64( unsigned char *result, + int digits, + uint64_t value, + unsigned char zero ) { - int ndigits = combined.run; - unsigned __int128 value = combined.val128; - - if( ndigits & 0x01 ) + if( digits & 0x01 ) { - combined_string[ndigits-1] = value%10; + result[(digits-1)*stride] + = static_cast<unsigned char>(value % 10 + zero); + + if( digits == 1 ) + { + return; + } + value /= 10; - ndigits -= 1; + digits -= 1; } - while(ndigits >= 8) - { - unsigned int val = value % 100000000; - uint_to_8_digits(val, - reinterpret_cast<unsigned char *>(combined_string + ndigits-8), 8); - value /= 100000000; - ndigits -= 8; - } - if( ndigits ) + + /* Leave the final one-to-eight digits in value. Their value is already + known to be less than 10^digits, so neither a remainder nor a final + division is needed for that last group. */ + while( digits > 8 ) { - const unsigned int pots[8] = - { - 1, - 10, - 100, - 1000, - 10000, - 100000, - 1000000, - 10000000, - }; - - unsigned int val = value % pots[ndigits]; - uint_to_8_digits(val, - reinterpret_cast<unsigned char *>(combined_string), ndigits); + unsigned int chunk + = static_cast<unsigned int>(value % 100000000); + + uint_to_8_digits_direct<stride>( + chunk, + result + (digits-8)*stride, + 8, + zero); + value /= 100000000; + digits -= 8; } - char *p = combined_string; - const char *pend = p + combined.run; - while(p < pend) + + if( digits ) { - *p++ += zero_char; + uint_to_8_digits_direct<stride>( + static_cast<unsigned int>(value), + result, + digits, + zero); } } +template<int stride> static bool -binary_to_string(char *result, int digits, __int128 value) +binary_to_string( char *result, + int digits, + __int128 signed_value, + unsigned char zero ) { - bool retval; // True means the value was too big to fit into digits + unsigned __int128 value + = static_cast<unsigned __int128>(signed_value); + + if( signed_value < 0 ) + { + /* Unsigned negation also handles the minimum signed __int128 value. */ + value = -value; + } + + bool overflow = false; + if( digits < 39 ) { - // Note that this routine does not terminate the generated string with a - // NUL. This routine is sometimes used to generate a NumericDisplay string - // of digits in place, with no terminator. - __int128 mask = __gg__power_of_ten(digits); + unsigned __int128 mask + = static_cast<unsigned __int128>(__gg__power_of_ten(digits)); - COMBINED combined; - if( value < 0 ) + overflow = value >= mask; + + /* Overflow should be uncommon. Avoid 128-bit division entirely when + the value already fits the requested number of digits. */ + if( overflow ) { - value = -value; + value %= mask; } + } - // A non-zero retval means the number was too big to fit into the desired - // number of digits: - retval = !!(value / mask); - - // mask off the bottom digits to avoid garbage when value is too large - value %= mask; + /* 10^19 is the largest power of ten that fits in uint64_t. For values + wider than 64 bits, one 128-bit division produces two pieces that can be + formatted using only 64-bit and 32-bit arithmetic. */ + static const uint64_t ten_to_19 = 10000000000000000000ULL; + unsigned char *output = reinterpret_cast<unsigned char *>(result); - combined.run = digits; - combined.val128 = value; - string_from_combined(combined); - memcpy(result, combined_string, digits); - return retval; + if( (value >> 64) == 0 ) + { + string_from_uint64<stride>( + output, + digits, + static_cast<uint64_t>(value), + zero); } else { - // We assume that this is a PIC X(16) COMP-X, so the value is always - // positive. - COMBINED combined; - // A non-zero retval means the number was too big to fit into the desired - // number of digits: - retval = false; - - combined.run = digits; - combined.val128 = value; - string_from_combined(combined); - memcpy(result, combined_string, digits); + uint64_t low + = static_cast<uint64_t>(value % ten_to_19); + uint64_t high + = static_cast<uint64_t>(value / ten_to_19); + + string_from_uint64<stride>(output, digits-19, high, zero); + string_from_uint64<stride>( + output+(digits-19)*stride, + 19, + low, + zero); } - return retval; + + return overflow; } extern "C" bool -__gg__binary_to_string_ascii(char *result, int digits, __int128 value) +__gg__binary_to_string_ascii( char *result, + int digits, + __int128 value ) { - zero_char = ascii_zero; - return binary_to_string(result, digits, value); + return binary_to_string<1>(result, digits, value, ascii_zero); } extern "C" bool -__gg__binary_to_string_ebcdic(char *result, int digits, __int128 value) +__gg__binary_to_string_ebcdic( char *result, + int digits, + __int128 value ) { - zero_char = ebcdic_zero; - return binary_to_string(result, digits, value); + return binary_to_string<1>(result, digits, value, ebcdic_zero); } bool -__gg__binary_to_string_encoded( char *result, - size_t digits, - __int128 value, - cbl_encoding_t encoding) +__gg__binary_to_string_encoded( char *result, + size_t digits, + __int128 value, + cbl_encoding_t encoding ) { - // A non-zero retval means the number was too big to fit into the desired - // number of digits. - const charmap_t *charmap = __gg__get_charmap(encoding); int stride = charmap->stride(); + unsigned char zero + = charmap->is_like_ebcdic() ? ebcdic_zero : ascii_0; - zero_char = charmap->is_like_ebcdic() ? ebcdic_zero : ascii_0; + if( stride == 1 ) + { + return binary_to_string<1>( + result, + static_cast<int>(digits), + value, + zero); + } + + /* Clear the complete destination once, then write each digit directly into + the byte selected by the encoding's byte order. */ + size_t output_size = digits * static_cast<size_t>(stride); + memset(result, 0, output_size); - // Note that this routine does not terminate the generated string with a - // NUL. This routine is sometimes used to generate a NumericDisplay string - // of digits in place, with no terminator. - __int128 mask = __gg__power_of_ten(digits); + size_t digit_offset + = charmap->is_big_endian() ? static_cast<size_t>(stride-1) : 0; + char *digit_result = result + digit_offset; - COMBINED combined; - if( value < 0 ) + if( stride == 2 ) { - value = -value; + return binary_to_string<2>( + digit_result, + static_cast<int>(digits), + value, + zero); } - bool retval = !!(value / mask); + return binary_to_string<4>( + digit_result, + static_cast<int>(digits), + value, + zero); + } - // mask off the bottom digits to avoid garbage when value is too large - value %= mask; +static const unsigned char bin2pd[100] = + { + 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, + 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, + 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, + 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, + 0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, + 0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, + 0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, + 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, + 0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, + 0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99, + }; - combined.run = digits; - combined.val128 = value; - string_from_combined(combined); - if( stride == 1 ) +static inline void +uint32_to_packed( unsigned char *result, + int bytes, + uint32_t value ) + { + unsigned int pair; + + switch( bytes ) { - memcpy(result, combined_string, digits); + case 4: + pair = value % 100; + result[3] = bin2pd[pair]; + value /= 100; + FALLTHROUGH; + + case 3: + pair = value % 100; + result[2] = bin2pd[pair]; + value /= 100; + FALLTHROUGH; + + case 2: + pair = value % 100; + result[1] = bin2pd[pair]; + value /= 100; + FALLTHROUGH; + + case 1: + /* Retain the low-order pair when the source has more decimal digits than + the destination. */ + result[0] = bin2pd[value % 100]; + break; + + default: + __builtin_unreachable(); } - else + } + +static inline void +uint64_to_packed( unsigned char *result, + int bytes, + uint64_t value ) + { + /* Four packed bytes hold eight decimal digits. Extracting four bytes at a + time limits the divisions of value to one per four output bytes; the + remaining divisions operate on 32-bit chunks. */ + while( bytes > 4 ) + { + uint32_t chunk + = static_cast<uint32_t>(value % 100000000); + + uint32_to_packed(result+bytes-4, 4, chunk); + value /= 100000000; + bytes -= 4; + } + + if( bytes ) { - char *p = combined_string; - const char *pend = p + digits; - char *d = result; - - /* We take advantage of knowing that every character in combined_string - becomes just the low byte of a little-endian int16 or 32, and the high - byte of a big-endian. */ - if( charmap->is_big_endian() ) + uint32_t final_chunk; + + if( value >> 32 ) { - while(p < pend) - { - memset(d, 0, stride-1); - d += stride-1; - *d++ = *p++; - } + /* Truncate in base ten before narrowing to uint32_t. */ + final_chunk = static_cast<uint32_t>(value % 100000000); } else { - while(p < pend) - { - *d++ = *p++; - memset(d, 0, stride-1); - d += stride-1; - } + final_chunk = static_cast<uint32_t>(value); } + + uint32_to_packed( + result, + bytes, + final_chunk); } - return retval; } -static void -packed_from_combined(const COMBINED &combined) +static inline void +moderate_uint128_to_packed( unsigned char *result, + int bytes, + unsigned __int128 value ) { - /* The combined.value must be positive at this point. - - The combined.run value has to be the number of places needed to hold - combined.value. The proper calculation is (digits+1)/2. - - For a signable value, the caller had to multiple the original value by - ten to create room on the right for the sign nybble. */ + unsigned char *d = result + bytes; - static const unsigned char bin2pd[100] = + /* GCC expands division of an unsigned __int128 by the constant 100 inline. + For moderately wide values, peeling a few pairs this way is faster than + invoking the general 128-bit division helper for a large divisor. */ + while( d > result && value >> 64 ) { - 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, - 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, - 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, - 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, - 0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, - 0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, - 0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, - 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, - 0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, - 0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99, - } ; - - char *d = combined_string + combined.run; - - if( combined.run > 9) - { - // Stage 1: pull from __int128 until the top half is zero. - __int128 value128 = combined.val128; -#if COBOL_LITTLE_ENDIAN - while(value128>>64) - { - *(--d) = bin2pd[value128%100]; - value128 /= 100; - } - // Stage 2: Keep going with the 64-bit bottom half. - uint64_t value64 = value128; - while(d > combined_string) - { - *(--d) = bin2pd[value64%100]; - value64 /= 100; - } -#else - // The cute trick for little-endian is trickier in big-endian. Right now - // it's late, and I don't feel like it. It would be easier if there were - // __int128 constants, because the test up above could be - // while(value128/2^64) - // but that's not available as of this writing. - while(d > combined_string) - { - *(--d) = bin2pd[value128%100]; - value128 /= 100; - } -#endif + *(--d) = bin2pd[static_cast<unsigned int>(value % 100)]; + value /= 100; } - else + + uint64_to_packed( + result, + static_cast<int>(d-result), + static_cast<uint64_t>(value)); + } + +static inline void +large_uint128_to_packed( unsigned char *result, + int bytes, + unsigned __int128 value ) + { + static const uint64_t ten_to_18 = 1000000000000000000ULL; + static const uint64_t ten_to_19 = 10000000000000000000ULL; + + /* One division at 10^19 divides every supported packed value into two + uint64_t values. Since 19 is odd, one packed byte crosses the boundary + between the two values. */ + uint64_t low + = static_cast<uint64_t>(value % ten_to_19); + uint64_t high + = static_cast<uint64_t>(value / ten_to_19); + + /* low contains the low-order 19 decimal digits. It therefore contains all + the digits needed by a destination of nine bytes or fewer. */ + if( bytes <= 9 ) { - uint64_t value = combined.val128; - while(d > combined_string) - { - *(--d) = bin2pd[value%100]; - value /= 100; - } + uint64_to_packed(result, bytes, low); + return; } + + unsigned int low_leading_digit + = static_cast<unsigned int>(low / ten_to_18); + uint64_t low_trailing_digits = low % ten_to_18; + + unsigned int high_trailing_digit + = static_cast<unsigned int>(high % 10); + high /= 10; + + uint64_to_packed(result+bytes-9, 9, low_trailing_digits); + result[bytes-10] + = bin2pd[high_trailing_digit*10 + low_leading_digit]; + uint64_to_packed(result, bytes-10, high); } extern "C" void __gg__binary_to_packed( unsigned char *result, - int digits, - __int128 value) + int digits, + __int128 value ) { - size_t length = (digits+1)/2; - - COMBINED combined; - combined.run = length; - combined.val128 = value; - packed_from_combined(combined); - memcpy(result, combined_string, length); + /* The caller supplies a positive value. For a signable item, it has + already multiplied the magnitude by ten to reserve the low nybble for + the sign. */ + unsigned __int128 magnitude + = static_cast<unsigned __int128>(value); + int bytes = (digits+1)/2; + + if( (magnitude >> 64) == 0 ) + { + uint64_to_packed(result, bytes, static_cast<uint64_t>(magnitude)); + } + else + { + /* This threshold is a performance choice, not a numeric boundary. Below + 10^27, peeling a small number of pairs is faster on current GCC targets. + At and above it, the single 10^19 split is faster. */ + static const unsigned __int128 ten_to_27 + = static_cast<unsigned __int128>(10000000000000ULL) + * 100000000000000ULL; + + if( magnitude < ten_to_27 ) + { + moderate_uint128_to_packed(result, bytes, magnitude); + } + else + { + large_uint128_to_packed(result, bytes, magnitude); + } + } } const unsigned char __gg__dp2bin[256] = { // This table is used both by the compile-time and the run-time. Given the - // packed decimal byte 0x23, it provides s the equivalent decimal value of + // packed decimal byte 0x23, it provides the equivalent decimal value of // 23. This table is not used on the final byte of COMP-3 values; that // digit has to be extracted specifically. @@ -488,70 +546,134 @@ const unsigned char __gg__dp2bin[256] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // 0xF0 }; -static -__int128 -pd_dive_rt(const unsigned char *psz, int nplaces) +static inline uint32_t +four_packed_bytes_to_uint32(const unsigned char *p) + { + return static_cast<uint32_t>(__gg__dp2bin[p[0]]) * 1000000 + + static_cast<uint32_t>(__gg__dp2bin[p[1]]) * 10000 + + static_cast<uint32_t>(__gg__dp2bin[p[2]]) * 100 + + static_cast<uint32_t>(__gg__dp2bin[p[3]]); + } + +static inline uint32_t +initial_packed_bytes_to_uint32( const unsigned char *p, + int nplaces ) { - __int128 retval; - switch(nplaces) + switch( nplaces ) + { + case 1: + return __gg__dp2bin[p[0]]; + + case 2: + return __gg__dp2bin[p[0]] * 100 + + __gg__dp2bin[p[1]]; + + case 3: + return __gg__dp2bin[p[0]] * 10000 + + __gg__dp2bin[p[1]] * 100 + + __gg__dp2bin[p[2]]; + + case 4: + return four_packed_bytes_to_uint32(p); + + default: + __builtin_unreachable(); + } + } + +static inline uint64_t +packed_bytes_to_uint64( const unsigned char *p, + int nplaces ) + { + int first = nplaces & 3; + if( first == 0 ) + { + first = 4; + } + + uint64_t value = initial_packed_bytes_to_uint32(p, first); + p += first; + nplaces -= first; + + while( nplaces ) + { + value = value * 100000000 + four_packed_bytes_to_uint32(p); + p += 4; + nplaces -= 4; + } + + return value; + } + +static inline unsigned __int128 +packed_bytes_to_uint128( const unsigned char *p, + int nplaces ) + { + switch( nplaces ) { case 0: - retval = 0; - break; + return 0; + case 1: - retval = __gg__dp2bin[psz[0]]; - break; case 2: - retval = __gg__dp2bin[psz[0]] * 100 - + __gg__dp2bin[psz[1]]; - break; case 3: - retval = __gg__dp2bin[psz[0]] * 10000 - + __gg__dp2bin[psz[1]] * 100 - + __gg__dp2bin[psz[2]]; - break; case 4: - retval = __gg__dp2bin[psz[0]] * 1000000 - + __gg__dp2bin[psz[1]] * 10000 - + __gg__dp2bin[psz[2]] * 100 - + __gg__dp2bin[psz[3]]; - break; + return initial_packed_bytes_to_uint32(p, nplaces); + default: - { - int nright = nplaces/2; - int nleft = nplaces - nright; - __int128 pot = __gg__power_of_ten(nright*2); - retval = pd_dive_rt(psz, nleft) * pot - + pd_dive_rt(psz+nleft, nright); break; - } } - return retval; + if( nplaces <= 9 ) + { + return packed_bytes_to_uint64(p, nplaces); + } + + /* The low nine packed bytes contain 18 decimal digits and fit in uint64_t. + Decode both halves with 64-bit arithmetic, then combine them with one + 128-bit multiplication. Only a 19-byte COMP-6 value has a ten-byte high + portion; split that portion into one byte and nine bytes. */ + static const uint64_t ten_to_18 = 1000000000000000000ULL; + int high_places = nplaces - 9; + unsigned __int128 high; + + if( high_places <= 9 ) + { + high = packed_bytes_to_uint64(p, high_places); + } + else + { + high = static_cast<unsigned __int128>(__gg__dp2bin[p[0]]) * ten_to_18 + + packed_bytes_to_uint64(p+1, 9); + } + + uint64_t low = packed_bytes_to_uint64(p+high_places, 9); + return high * ten_to_18 + low; } extern "C" __int128 -__gg__packed_to_binary(const unsigned char *psz, - int nplaces) // Number of bytes +__gg__packed_to_binary( const unsigned char *psz, + int nplaces ) // Number of bytes { - __int128 retval; // Check to see if the final nybble is a sign bit: - bool signable = (psz[nplaces-1] & 0x0F) >= 0x0C; + unsigned int sign = psz[nplaces-1] & 0x0F; + bool signable = sign >= 0x0A; + unsigned __int128 magnitude; if( signable ) { - retval = pd_dive_rt(psz, nplaces-1) * 10 + (psz[nplaces-1] >> 4); + magnitude = packed_bytes_to_uint128(psz, nplaces-1) * 10 + + (psz[nplaces-1] >> 4); } else { - retval = pd_dive_rt(psz, nplaces); + magnitude = packed_bytes_to_uint128(psz, nplaces); } - if( signable - && (psz[nplaces-1] & 0x0F) == 0x0D ) + + if( sign == 0x0B || sign == 0x0D ) { - retval = -retval; + return -static_cast<__int128>(magnitude); } - return retval; + return static_cast<__int128>(magnitude); } -
