https://gcc.gnu.org/g:e36ce9a6a54e3709b95da494732a55e481336360
commit r17-1824-ge36ce9a6a54e3709b95da494732a55e481336360 Author: Robert Dubner <[email protected]> Date: Wed Jun 24 22:46:34 2026 -0400 cobol: Improve MOVE BINARY/COMP-5 to PACKED-DECIMAL and NUMERIC-DISPLAY These are more efficient algorithms for converting binary values to packed-decimal and zoned decimal byte strings. There is also an improved routine that generates GENERIC to do COBOL rounding during such moves. gcc/cobol/ChangeLog: * gengen.cc (gg_abs): Use fold_build1(). * genutil.cc (scale_and_round): Remove function. (round_this_value): New function for rounding. * genutil.h (scale_and_round): Remove function. (round_this_value): New declaration. * move.cc (cobol_wider_type_with_x_signedness): New function. (mh_binary_to_numdisp): Faster routine. (mh_binary_to_packed): Faster routine. (move_helper): Use the faster routines. libgcobol/ChangeLog: * charmaps.cc (__gg__miconverter): Use table instead of a map. (__gg__get_charmap): Likewise. * charmaps.h (ebcdic_zero): New constant. (ebcdic_plus): Likewise. (ebcdic_minus): Likewise. * encodings.h (enum cbl_encoding_t): Guardrail for table. (ASCII_e): Remove trailing spaces. * stringbin.cc (string_from_combined): Improved routine. (defined): Likewise. (FALLTHROUGH): Likewise. (uint_to_8_digits): Improve speed. (__gg__binary_to_string_ascii): Likewise. (binary_to_string): Likewise. (__gg__binary_to_string_ebcdic): Likewise. (__gg__binary_to_string_encoded): Likewise. (packed_from_combined): Likewise. (__gg__binary_to_packed): Likewise. (__gg__packed_to_binary): Likewise. gcc/testsuite/ChangeLog: * cobol.dg/group1/simple-classes.cob: * cobol.dg/group1/simple-if.cob: * cobol.dg/group2/Rounding_from_BINARY_signable_and_negative.cob: New test. * cobol.dg/group2/Rounding_from_BINARY_signable_and_negative.out: New test. * cobol.dg/group2/Rounding_from_BINARY_signable_and_positive.cob: New test. * cobol.dg/group2/Rounding_from_BINARY_signable_and_positive.out: New test. * cobol.dg/group2/Rounding_from_BINARY_unsignable.cob: New test. * cobol.dg/group2/Rounding_from_BINARY_unsignable.out: New test. Diff: --- gcc/cobol/gengen.cc | 2 +- gcc/cobol/genutil.cc | 403 +++++++++++++--- gcc/cobol/genutil.h | 9 +- gcc/cobol/move.cc | 537 +++++++++++++++++++++ gcc/testsuite/cobol.dg/group1/simple-classes.cob | 4 +- gcc/testsuite/cobol.dg/group1/simple-if.cob | 2 +- .../Rounding_from_BINARY_signable_and_negative.cob | 62 +++ .../Rounding_from_BINARY_signable_and_negative.out | 9 + .../Rounding_from_BINARY_signable_and_positive.cob | 62 +++ .../Rounding_from_BINARY_signable_and_positive.out | 9 + .../group2/Rounding_from_BINARY_unsignable.cob | 62 +++ .../group2/Rounding_from_BINARY_unsignable.out | 9 + libgcobol/charmaps.cc | 18 +- libgcobol/charmaps.h | 3 + libgcobol/encodings.h | 7 +- libgcobol/stringbin.cc | 395 +++++++-------- 16 files changed, 1276 insertions(+), 317 deletions(-) diff --git a/gcc/cobol/gengen.cc b/gcc/cobol/gengen.cc index 3700de015904..03f79c566921 100644 --- a/gcc/cobol/gengen.cc +++ b/gcc/cobol/gengen.cc @@ -1594,7 +1594,7 @@ gg_bitwise_not(tree var) tree gg_abs(tree var) { - return build1(ABS_EXPR, TREE_TYPE(var), var); + return fold_build1(ABS_EXPR, TREE_TYPE(var), var); } static tree diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc index 799a17e1bb74..142e0bb02e26 100644 --- a/gcc/cobol/genutil.cc +++ b/gcc/cobol/genutil.cc @@ -1760,71 +1760,6 @@ scale_by_power_of_ten(tree value, return retval; } -void -scale_and_round(tree value, - int value_rdigits, - bool target_is_signable, - int target_rdigits, - cbl_round_t rounded) - { - if( !target_is_signable ) - { - // The target has to be positive, so take the absolute value of the input - gg_assign(value, gg_abs(value)); - } - - if( target_rdigits >= value_rdigits ) - { - // The value doesn't have enough rdigits. All we need to do is multiply it - // by a power of ten to get it right: - scale_by_power_of_ten_N(value, - target_rdigits - value_rdigits); - } - else - { - // The value has too few rdigits. - switch(rounded) - { - case nearest_away_from_zero_e: - { - // This is rounding away from zero - - // We want to adjust value so that the extra digit is in the units - // place: - scale_by_power_of_ten_N(value, - target_rdigits - value_rdigits + 1); - // Add five to the result: - IF( value, lt_op, gg_cast(TREE_TYPE(value), integer_zero_node) ) - { - gg_assign(value, - gg_add( value, - build_int_cst_type(TREE_TYPE(value), -5))); - } - ELSE - { - gg_assign(value, - gg_add( value, - build_int_cst_type(TREE_TYPE(value), +5))); - } - // And now get rid of the lowest decimal digit - scale_by_power_of_ten_N(value, -1); - - break; - } - - case truncation_e: - { - // Without rounding, just scale the result - scale_by_power_of_ten_N(value, target_rdigits - value_rdigits); - break; - } - default: - abort(); - break; - } - } - } - void hex_dump(tree data, size_t bytes) { @@ -3493,3 +3428,341 @@ attribute_bit_set(struct cbl_field_t *var, cbl_field_attr_t bits) build_int_cst_type(SIZE_T, bits))); } +tree +round_this_value( tree &value, + tree pot, + cbl_round_t rounded, + tree size_error) + { + tree retval = gg_define_variable(INT); + // We are rounding value by dividing it by 'pot', which is a power of ten. + // We will decide how to round it by looking at the remainder. + + // Return zero when the returned value is zero. We use this to avoid + // negative zero flags in numeric-display and packed-decimal reprentatios + // when there have been truncations. + tree type = TREE_TYPE(value); + if( rounded == truncation_e ) + { + // This is the simplest and most common case. + gg_assign(value, gg_divide(value, pot)); + IF( value, eq_op, build_int_cst_type(type, 0) ) + { + gg_assign(retval, integer_zero_node); + } + ELSE + { + gg_assign(retval, integer_one_node); + } + ENDIF + return retval; + } + // With truncation out of the way, we actually have to do some work. + bool signable = !TYPE_UNSIGNED(type); + + // Let's calculate rem = abs(value) % pot. So, if the POT is, say, 1000, + // the remainder will be between 000 and 999 inclusive. + tree rem = gg_define_variable(type); + gg_assign(rem, gg_mod(gg_abs(value), pot)); + gg_assign(value, gg_divide(value, pot)); + + // We often need the halfway point, that is, 500 when POT is 1000 + tree half = gg_define_variable(type); + gg_assign(half, gg_divide(pot, build_int_cst_type(type, 2))); + + tree zero = build_int_cst_type(type, 0); + + switch(rounded) + { + case away_from_zero_e: + { + /* "If the AWAY-FROM-ZERO phrase is specified and the arithmetic value + cannot be exactly represented in the resultant identifier, the + arithmetic value is rounded to the nearest value farther from zero + that can be represented in the resultant identifier." */ + if( signable ) + { + IF( value, ge_op, zero ) + { + // The value is positive, so if there is a remainder, increment it + IF( rem, gt_op, zero ) + { + gg_increment(value); + } + ELSE {} ENDIF + } + ELSE + { + // The value is negative, so if there is a remainder, decrement it + IF( rem, gt_op, zero ) + { + gg_decrement(value); + } + ELSE {} ENDIF + } + ENDIF + } + else + { + // The value is positive, so if there is a remainder, increment it + IF( rem, gt_op, zero ) + { + gg_increment(value); + } + ELSE {} ENDIF + } + break; + } + + case nearest_away_from_zero_e: + { + /* "If the NEAREST-AWAY-FROM-ZERO phrase is specified or implied and the + arithmetic value cannot be exactly represented in the resultant + identifier, the arithmetic value is rounded to the nearest value that + can be represented in the resultant identifier. If two such values are + equally near, the value farther from zero is chosen." + + This is rounding like you learned in grade school, + */ + if( signable ) + { + IF( value, ge_op, zero ) + { + // The value is positive, so if remainder >= 5, increment it + IF( rem, ge_op, half ) + { + gg_increment(value); + } + ELSE {} ENDIF + } + ELSE + { + // The value is negative, so if remainder < 5, decrement it + IF( rem, ge_op, half ) + { + gg_decrement(value); + } + ELSE {} ENDIF + } + ENDIF + } + else + { + // The value is positive, so if remainder >= 5, increment it + IF( rem, ge_op, half ) + { + gg_increment(value); + } + ELSE {} ENDIF + } + break; + } + + case nearest_even_e: + { + /* "If the NEAREST-EVEN phrase is specified and the arithmetic value + cannot be exactly represented in the resultant identifier, the + arithmetic value is rounded to the nearest value that can be + represented in the resultant identifier. If two such values are + equally near, the value whose rightmost digit is even is chosen. + NOTE: This method is sometimes known as 'banker's rounding'." */ + if( signable ) + { + IF( rem, eq_op, half ) + { + // This is the money shot, exactly half-way. + IF( value, ge_op, zero ) + { + gg_increment(value); + gg_assign(value, + gg_bitwise_and(value, + gg_bitwise_not(build_int_cst_type(type, + 1)))); + } + ELSE + { + gg_assign(value, gg_negate(value)); + gg_increment(value); + gg_assign(value, + gg_bitwise_and(value, + gg_bitwise_not(build_int_cst_type(type, + 1)))); + gg_assign(value, gg_negate(value)); + } + ENDIF + } + ELSE + { + // The signable value has a remainder that is not exactly 5 + IF( value, ge_op, zero ) + { + // The value is positive, so if remainder >= 5, increment it + IF( rem, ge_op, half ) + { + gg_increment(value); + } + ELSE {} ENDIF + } + ELSE + { + // The value is negative, so if remainder < 5, decrement it + IF( rem, ge_op, half ) + { + gg_decrement(value); + } + ELSE {} ENDIF + } + ENDIF + } + ENDIF + } + else + { + // The value is not signable, hence it is positive: + IF( rem, eq_op, half ) + { + // This is the money shot, exactly half-way. + // Make value a multiple of 2 + gg_increment(value); + gg_assign(value, + gg_bitwise_and(value, + gg_bitwise_not(build_int_cst_type(type, + 1)))); + } + ELSE + { + // The value is positive, so if remainder > 5, increment it + IF( rem, gt_op, half ) + { + gg_increment(value); + } + ELSE {} ENDIF + } + ENDIF + } + break; + } + + case nearest_toward_zero_e: + { + /* "If the NEAREST-TOWARD-ZERO phrase is specified and the arithmetic + value cannot be exactly represented in the resultant identifier, the + arithmetic value is rounded to the nearest value that can be + represented in the resultant identifier. If two such values are + equally near, the value nearest to zero is chosen." */ + if( signable ) + { + IF( value, ge_op, zero ) + { + // The value is positive, so if remainder > 5, increment it + IF( rem, gt_op, half ) + { + gg_increment(value); + } + ELSE {} ENDIF + } + ELSE + { + // The value is negative, so if remainder < 5, decrement it + IF( rem, gt_op, half ) + { + gg_decrement(value); + } + ELSE {} ENDIF + } + ENDIF + } + else + { + // The value is positive, so if remainder > 5, increment it + IF( rem, gt_op, half ) + { + gg_increment(value); + } + ELSE {} ENDIF + } + break; + } + case prohibited_e: + { + /* "If the PROHIBITED phrase is specified, and the arithmetic value + cannot be represented exactly in the resultant identifier, the + EC-SIZE-TRUNCATION exception condition is set to exist, the size error + condition exists, and the content of the resultant identifier is + unchanged." */ + const cbl_enabled_exceptions_t& + enabled_exceptions( cdf_enabled_exceptions() ); + IF( rem, ne_op, zero ) + { + if( size_error ) + { + gg_assign(size_error, integer_one_node); + } + else if( enabled_exceptions.match(ec_size_truncation_e) ) + { + set_exception_code(ec_size_truncation_e); + } + } + ELSE + { + } + ENDIF + break; + } + + case toward_greater_e: + { + /* "If the TOWARD-GREATER phrase is specified, and the arithmetic value + cannot be represented exactly in the resultant identifier, the + arithmetic value is rounded to the nearest larger value that can be + represented in the resultant identifier." */ + IF( value, ge_op, zero ) + { + // The value is positive, so if remainder != 0, increment it + IF( rem, ne_op, zero ) + { + gg_increment(value); + } + ELSE {} ENDIF + } + ELSE {} ENDIF + break; + } + + case toward_lesser_e: + { + /* "If the TOWARD-LESS phrase is specified, and the arithmetic value + cannot be represented exactly in the resultant identifier, the + arithmetic value is rounded to the nearest smaller value that + can be represented in the resultant identifier." */ + IF( value, lt_op, zero ) + { + // The value is negative, so if remainder != 0 , decrement it + IF( rem, ne_op, zero ) + { + gg_decrement(value); + } + ELSE {} ENDIF + } + ELSE {} ENDIF + break; + } + + case truncation_e: + { + /* We do nothing.*/ + gg_assign(value, gg_divide(value, pot)); + break; + } + } + IF( value, eq_op, build_int_cst_type(type, 0) ) + { + gg_assign(retval, integer_zero_node); + } + ELSE + { + gg_assign(retval, integer_one_node); + } + ENDIF + return retval; + } diff --git a/gcc/cobol/genutil.h b/gcc/cobol/genutil.h index e9ec2630718c..985b3a52d51a 100644 --- a/gcc/cobol/genutil.h +++ b/gcc/cobol/genutil.h @@ -90,11 +90,10 @@ void scale_by_power_of_ten_N(tree value, tree scale_by_power_of_ten(tree value, tree N, bool check_for_fractional = false); -void scale_and_round(tree value, - int value_rdigits, - bool target_is_signable, - int target_rdigits, - cbl_round_t rounded); +tree round_this_value( tree &value, + tree power_of_ten, + cbl_round_t rounded, + tree size_error); void hex_dump(tree data, size_t bytes); void set_exception_code_func(ec_type_t ec, int line, diff --git a/gcc/cobol/move.cc b/gcc/cobol/move.cc index 4050c49e8d29..d57ae6b20ce2 100644 --- a/gcc/cobol/move.cc +++ b/gcc/cobol/move.cc @@ -1268,6 +1268,527 @@ mh_numeric_display( const cbl_refer_t &destref, return moved; } +static tree +cobol_wider_type_with_x_signedness (tree s_type, tree x_type) + { + gcc_assert (INTEGRAL_TYPE_P (s_type)); + gcc_assert (INTEGRAL_TYPE_P (x_type)); + + unsigned int s_prec = TYPE_PRECISION (s_type); + unsigned int x_prec = TYPE_PRECISION (x_type); + + unsigned int w_prec = MAX (s_prec, x_prec); + int unsignedp = TYPE_UNSIGNED (x_type); + + return build_nonstandard_integer_type (w_prec, unsignedp); + } + +static bool +mh_binary_to_numdisp(const cbl_refer_t &destref, + const cbl_refer_t &sourceref, + cbl_round_t rounded, + tree size_error) + { + bool moved = false; + + charmap_t *charmap_dest = + __gg__get_charmap(destref.field->codeset.encoding); + if( destref.field->type == FldNumericDisplay + && !(destref.field->attr & scaled_e) + && !(sourceref.field->attr & scaled_e) + && charmap_dest->stride() == 1 + && ( sourceref.field->type == FldNumericBinary + || sourceref.field->type == FldNumericBin5 + || sourceref.field->type == FldLiteralN + || sourceref.field->type == FldIndex + || sourceref.field->type == FldPointer ) ) + { + tree plus = build_int_cst_type(UCHAR, + charmap_dest->is_like_ebcdic() + ? ebcdic_plus : ascii_plus ); + tree minus = build_int_cst_type(UCHAR, + charmap_dest->is_like_ebcdic() + ? ebcdic_minus : ascii_minus ); + tree dest_location; + get_location(dest_location, destref); + + tree s_type = tree_type_from_refer(sourceref); + tree d_type = tree_type_from_refer(destref); + + // Our working type is the larger of the source and destination types. + tree work_type = cobol_wider_type_with_x_signedness(d_type, s_type); + + tree value ; + get_binary_value(value, sourceref, work_type); + + tree negative = gg_define_variable(INT); + gg_assign(negative, integer_zero_node); + + tree sign_location = NULL_TREE; + + if( destref.field->attr & signable_e ) + { + sign_location = gg_define_variable(UCHAR_P); + if( (destref.field->attr & separate_e) + && (destref.field->attr & leading_e ) ) + { + // separate and leading + gg_assign(sign_location, dest_location); + gg_increment(dest_location); + } + else if( (destref.field->attr & separate_e) + && !(destref.field->attr & leading_e ) ) + { + // separate and trailing + gg_assign(sign_location, gg_add(dest_location, + build_int_cst_type(SIZE_T, + destref.field->data.capacity()-1))); + } + else if( !(destref.field->attr & separate_e) + && (destref.field->attr & leading_e ) ) + { + // internal and leading + gg_assign(sign_location, dest_location); + } + else + { + // internal and trailing + gg_assign(sign_location, gg_add(dest_location, + build_int_cst_type(SIZE_T, + destref.field->data.capacity()-1))); + } + } + + if( (sourceref.field->attr & signable_e) + && (destref.field->attr & signable_e) ) + { + // Both source and dest are signable, which means we have to preserve + // the source sign and apply it, eventually, to the target. + IF( value, lt_op, gg_cast(work_type, integer_zero_node) ) + { + gg_assign(negative, integer_one_node); + } + ELSE {} ENDIF + } + + // At this point we have to align the source and destination value rdigits. + + if( !(sourceref.field->attr & intermediate_e) ) + { + // Because the source is not intermediate, we can work with the compile- + // time values. + int source_rdigits = sourceref.field->data.rdigits; + int dest_rdigits = destref.field->data.rdigits; + int nshift = source_rdigits - dest_rdigits; + if(nshift < 0) + { + // We need to multiply the source by 10^(-nshift) to line them up. + FIXED_WIDE_INT(128) power_of_ten = get_power_of_ten( -nshift ); + gg_assign(value, gg_multiply(value, + wide_int_to_tree(work_type, + power_of_ten))); + } + else if(nshift > 0) + { + // We need to divide the source by 10^(nshift) to line them up. + // This is a potential rounding situation. + FIXED_WIDE_INT(128) power_of_ten = get_power_of_ten( nshift ); + tree pot = wide_int_to_tree(work_type, power_of_ten); + gg_assign(negative, + gg_bitwise_and( negative, + round_this_value(value, + pot, + rounded, + size_error))); + } + } + else + { + // Source is intermediate; we need to use the dynamic source rdigits + // Because the source is not intermediate, we can work with the compile- + // time values. + tree source_rdigits = gg_define_variable(INT); + tree dest_rdigits; + tree nshift = gg_define_variable(INT); + + gg_assign(source_rdigits, + gg_cast(INT, + member(sourceref.field->var_decl_node, + "rdigits"))); + dest_rdigits = build_int_cst_type(INT, destref.field->data.rdigits); + gg_assign(nshift, gg_subtract(source_rdigits, dest_rdigits)); + tree power_of_ten = gg_define_variable(work_type); + IF( nshift, lt_op, integer_zero_node ) + { + // We need to multiply the source by 10^(-nshift) to line them up. + gg_assign(power_of_ten, + gg_cast(work_type, + gg_call_expr(INT128, + "__gg__power_of_ten", + gg_negate(nshift), + NULL_TREE))); + gg_assign(value, gg_multiply(value, power_of_ten)); + } + ELSE + { + IF( nshift, gt_op, integer_zero_node ) + { + // We need to divide the source by 10^(nshift) to line them up. + // This is a potential rounding situation. + gg_assign(power_of_ten, + gg_cast(work_type, + gg_call_expr(INT128, + "__gg__power_of_ten", + nshift, + NULL_TREE))); + gg_assign(negative, + gg_bitwise_and( negative, + round_this_value(value, + power_of_ten, + rounded, + size_error))); + } + ELSE + { + } + ENDIF + } + ENDIF + } + + // At this point, value is lined up with the destination. + + // Make it positive + + if( !TYPE_UNSIGNED(work_type) ) + { + gg_assign(value, gg_abs(value)); + } + + if( size_error ) + { + // We need to see if is too big to fit + FIXED_WIDE_INT(128) power_of_ten = + get_power_of_ten(destref.field->data.digits); + tree pot = wide_int_to_tree(work_type, power_of_ten); + IF( gg_divide(value, pot), + ne_op, + gg_cast(work_type, integer_zero_node) ) + { + // The value is too big; flag it: + gg_assign(size_error, integer_one_node); + } + ELSE + { + } + ENDIF + } + + if( charmap_dest->is_like_ebcdic() ) + { + gg_call(INT, + "__gg__binary_to_string_ebcdic", + dest_location, + build_int_cst_type(INT, destref.field->data.digits), + gg_cast(INT128, value), + NULL_TREE); + } + else + { + gg_call(INT, + "__gg__binary_to_string_ascii", + dest_location, + build_int_cst_type(INT, destref.field->data.digits), + gg_cast(INT128, value), + NULL_TREE); + } + + if( (sourceref.field->attr & signable_e ) + && (destref.field->attr & signable_e ) ) + { + IF( negative, ne_op, integer_zero_node ) + { + if( destref.field->attr & separate_e ) + { + // We flag the separate as negative + gg_assign(gg_indirect(sign_location), minus); + } + else + { + if( charmap_dest->is_like_ebcdic() ) + { + gg_assign(gg_indirect(sign_location), + gg_bitwise_and(gg_indirect(sign_location), + build_int_cst_type(UCHAR, 0xDF))); + } + else + { + gg_assign(gg_indirect(sign_location), + gg_bitwise_or(gg_indirect(sign_location), + build_int_cst_type(UCHAR, 0x70))); + } + } + } + ELSE + { + // The result is positive + if( destref.field->attr & separate_e ) + { + // We flag the separate as negative + gg_assign(gg_indirect(sign_location), plus); + } + } + ENDIF + } + else if( (destref.field->attr & signable_e ) + && (destref.field->attr & separate_e ) ) + { + // The source is not signed, but the destination is signable and + // separate: + gg_assign(gg_indirect(sign_location), plus); + } + + moved = true; + } + + return moved; + } + +static bool +mh_binary_to_packed(const cbl_refer_t &destref, + const cbl_refer_t &sourceref, + cbl_round_t rounded, + tree size_error) + { + bool moved = false; + + if( destref.field->type == FldPacked + && !(destref.field->attr & scaled_e) + && !(sourceref.field->attr & scaled_e) + && ( sourceref.field->type == FldNumericBinary + || sourceref.field->type == FldNumericBin5 + || sourceref.field->type == FldLiteralN + || sourceref.field->type == FldIndex + || sourceref.field->type == FldPointer ) ) + { + tree dest_location; + get_location(dest_location, destref); + + tree s_type = tree_type_from_refer(sourceref); + tree d_type = tree_type_from_refer(destref); + + // Our working type is the larger of the source and destination types. + tree work_type = cobol_wider_type_with_x_signedness(d_type, s_type); + + tree value ; + get_binary_value(value, sourceref, work_type); + + tree negative = gg_define_variable(INT); + gg_assign(negative, integer_zero_node); + + if( (sourceref.field->attr & signable_e) + && (destref.field->attr & signable_e) ) + { + // Both source and dest are signable, which means we have to preserve + // the source sign and apply it, eventually, to the target. + IF( value, lt_op, gg_cast(work_type, integer_zero_node) ) + { + gg_assign(negative, integer_one_node); + } + ELSE + { + gg_assign(negative, integer_zero_node); + } + ENDIF + } + + // At this point we have to align the source and destination value rdigits. + + if( !(sourceref.field->attr & intermediate_e) ) + { + // Because the source is not intermediate, we can work with the compile- + // time values. + int source_rdigits = sourceref.field->data.rdigits; + int dest_rdigits = destref.field->data.rdigits; + int nshift = source_rdigits - dest_rdigits; + if(nshift < 0) + { + // We need to multiply the source by 10^(-nshift) to line them up. + FIXED_WIDE_INT(128) power_of_ten = get_power_of_ten( -nshift ); + gg_assign(value, gg_multiply(value, + wide_int_to_tree(work_type, + power_of_ten))); + } + else if(nshift > 0) + { + // We need to divide the source by 10^(nshift) to line them up. + // This is a potential rounding situation. + FIXED_WIDE_INT(128) power_of_ten = get_power_of_ten(nshift); + tree pot = wide_int_to_tree(work_type, power_of_ten); + gg_assign(negative, + gg_bitwise_and( negative, + round_this_value(value, + pot, + rounded, + size_error))); + } + } + else + { + // Source is intermediate; we need to use the dynamic source rdigits + // Because the source is not intermediate, we can work with the compile- + // time values. + tree source_rdigits = gg_define_variable(INT); + tree dest_rdigits; + tree nshift = gg_define_variable(INT); + + gg_assign(source_rdigits, + gg_cast(INT, + member(sourceref.field->var_decl_node, + "rdigits"))); + dest_rdigits = build_int_cst_type(INT, destref.field->data.rdigits); + gg_assign(nshift, gg_subtract(source_rdigits, dest_rdigits)); + tree power_of_ten = gg_define_variable(work_type); + IF( nshift, lt_op, integer_zero_node ) + { + // We need to multiply the source by 10^(-nshift) to line them up. + gg_assign(power_of_ten, + gg_cast(work_type, + gg_call_expr(INT128, + "__gg__power_of_ten", + gg_negate(nshift), + NULL_TREE))); + gg_assign(value, gg_multiply(value, power_of_ten)); + } + ELSE + { + IF( nshift, gt_op, integer_zero_node ) + { + // We need to divide the source by 10^(nshift) to line them up. + // This is a potential rounding situation. + gg_assign(power_of_ten, + gg_cast(work_type, + gg_call_expr(INT128, + "__gg__power_of_ten", + nshift, + NULL_TREE))); + // At this point, value is ten times as big as the final value, so + // we are set up to round it: + gg_assign(negative, + gg_bitwise_and( negative, + round_this_value(value, + power_of_ten, + rounded, + size_error))); + } + ELSE + { + } + ENDIF + } + ENDIF + } + + // At this point, value is lined up with the destination. + + // Make it positive + + if( !TYPE_UNSIGNED(work_type) ) + { + gg_assign(value, gg_abs(value)); + } + + if( size_error ) + { + // We need to see if is too big to fit + FIXED_WIDE_INT(128) power_of_ten = + get_power_of_ten(destref.field->data.digits); + tree pot = wide_int_to_tree(work_type, power_of_ten); + IF( gg_divide(value, pot), + ne_op, + gg_cast(work_type, integer_zero_node) ) + { + // The value is too big; flag it: + gg_assign(size_error, integer_one_node); + } + ELSE + { + } + ENDIF + } + + // We are now ready to convert the binary to the packed byte string. + + int ndigits; + if( !(destref.field->attr & packed_no_sign_e) ) + { + // This is ordinary packed. We need to multiply the value by ten to + // make room for the sign nybble. + gg_assign(value, gg_multiply(value, build_int_cst_type(work_type, 10))); + ndigits = destref.field->data.digits+1; + } + else + { + ndigits = destref.field->data.digits; + } + + gg_call(INT, + "__gg__binary_to_packed", + dest_location, + build_int_cst_type(INT, ndigits), + gg_cast(INT128, value), + NULL_TREE); + + if( !(destref.field->attr & packed_no_sign_e) ) + { + tree sign_loc = gg_add(dest_location, + build_int_cst_type(SIZE_T, + destref.field->data.capacity()-1)); + if( !(destref.field->attr & signable_e) ) + { + // This is an unsigned packed decimal. + gg_assign(gg_indirect(sign_loc), + gg_bitwise_or(gg_indirect(sign_loc), + build_int_cst_type(UCHAR, 0x0F))); + } + else + { + // It is signable + if( !(sourceref.field->attr & signable_e) ) + { + // The source wasn't signable, so the destination has to be positive. + gg_assign(gg_indirect(sign_loc), + gg_bitwise_or(gg_indirect(sign_loc), + build_int_cst_type(UCHAR, 0x0C))); + } + else + { + // The source was signable, so we have to transfer the sign + IF( negative, ne_op, integer_one_node ) + { + // The result is non-negative + gg_assign(gg_indirect(sign_loc), + gg_bitwise_or(gg_indirect(sign_loc), + build_int_cst_type(UCHAR, 0x0C))); + } + ELSE + { + // The result is negative + gg_assign(gg_indirect(sign_loc), + gg_bitwise_or(gg_indirect(sign_loc), + build_int_cst_type(UCHAR, 0x0D))); + } + ENDIF + } + } + } + + moved = true; + } + + return moved; + } + static void copy_little_endian_into_place(cbl_field_t *dest, tree dest_offset, @@ -2952,6 +3473,22 @@ move_helper(tree size_error, // This is an INT size_error); } + if( !moved ) + { + moved = mh_binary_to_numdisp(destref, + sourceref, + rounded, + size_error); + } + + if( !moved ) + { + moved = mh_binary_to_packed(destref, + sourceref, + rounded, + size_error); + } + if( !moved ) { SHOW_PARSE1 diff --git a/gcc/testsuite/cobol.dg/group1/simple-classes.cob b/gcc/testsuite/cobol.dg/group1/simple-classes.cob index 6b3a90d14524..7d8cce6f46cc 100644 --- a/gcc/testsuite/cobol.dg/group1/simple-classes.cob +++ b/gcc/testsuite/cobol.dg/group1/simple-classes.cob @@ -12,7 +12,7 @@ *> { dg-output {Fred is alphabetic(\n|\r\n|\r)} } *> { dg-output { } } IDENTIFICATION DIVISION. -PROGRAM-ID. test. +PROGRAM-ID. prog. AUTHOR. Michael Coughlan. *> This routine is based on Listing-5-1 ENVIRONMENT DIVISION. @@ -65,4 +65,4 @@ TestAlphabetic. ELSE DISPLAY NameIn " is not alphabetic" END-IF. - END PROGRAM test. + END PROGRAM prog. diff --git a/gcc/testsuite/cobol.dg/group1/simple-if.cob b/gcc/testsuite/cobol.dg/group1/simple-if.cob index bdf11ec42903..5e5f33a106eb 100644 --- a/gcc/testsuite/cobol.dg/group1/simple-if.cob +++ b/gcc/testsuite/cobol.dg/group1/simple-if.cob @@ -21,7 +21,7 @@ *> { dg-output { } } >>SOURCE FREE IDENTIFICATION DIVISION. - PROGRAM-ID. test. + PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. 01 A_4 PIC 9999 VALUE 5. diff --git a/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_signable_and_negative.cob b/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_signable_and_negative.cob new file mode 100644 index 000000000000..afa6eb9b51c8 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_signable_and_negative.cob @@ -0,0 +1,62 @@ + *> { dg-do run } + *> { dg-output-file "group2/Rounding_from_BINARY_signable_and_negative.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 77 v0 pic s9999v9 binary value -1234.0 . + 77 v1 pic s9999v9 binary value -1234.1 . + 77 v5 pic s9999v9 binary value -1234.5 . + 77 v9 pic s9999v9 binary value -1234.9 . + 77 d0 pic s9999 display . + 77 d1 pic s9999 display . + 77 d5 pic s9999 display . + 77 d9 pic s9999 display . + + procedure division. + display "-1234.0 -1234.1 -1234.5 -1234.9" + compute d0 = v0 + compute d1 = v1 + compute d5 = v5 + compute d9 = v9 + display d0 " " d1 " " d5 " " d9 " " "truncated" + + compute d0 ROUNDED MODE AWAY-FROM-ZERO = v0 + compute d1 ROUNDED MODE AWAY-FROM-ZERO = v1 + compute d5 ROUNDED MODE AWAY-FROM-ZERO = v5 + compute d9 ROUNDED MODE AWAY-FROM-ZERO = v9 + display d0 " " d1 " " d5 " " d9 " " "away-from-zero" + + compute d0 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = v0 + compute d1 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = v1 + compute d5 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = v5 + compute d9 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = v9 + display d0 " " d1 " " d5 " " d9 " " "nearest-away-from-zero" + + compute d0 ROUNDED MODE NEAREST-EVEN = v0 + compute d1 ROUNDED MODE NEAREST-EVEN = v1 + compute d5 ROUNDED MODE NEAREST-EVEN = v5 + compute d9 ROUNDED MODE NEAREST-EVEN = v9 + display d0 " " d1 " " d5 " " d9 " " "nearest-even" + + compute d0 ROUNDED MODE NEAREST-TOWARD-ZERO = v0 + compute d1 ROUNDED MODE NEAREST-TOWARD-ZERO = v1 + compute d5 ROUNDED MODE NEAREST-TOWARD-ZERO = v5 + compute d9 ROUNDED MODE NEAREST-TOWARD-ZERO = v9 + display d0 " " d1 " " d5 " " d9 " " "nearest-toward-zero" + + compute d0 ROUNDED MODE TOWARD-GREATER = v0 + compute d1 ROUNDED MODE TOWARD-GREATER = v1 + compute d5 ROUNDED MODE TOWARD-GREATER = v5 + compute d9 ROUNDED MODE TOWARD-GREATER = v9 + display d0 " " d1 " " d5 " " d9 " " "toward-greater" + + compute d0 ROUNDED MODE TOWARD-LESSER = v0 + compute d1 ROUNDED MODE TOWARD-LESSER = v1 + compute d5 ROUNDED MODE TOWARD-LESSER = v5 + compute d9 ROUNDED MODE TOWARD-LESSER = v9 + display d0 " " d1 " " d5 " " d9 " " "toward-lesser" + + goback. + end program prog. + diff --git a/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_signable_and_negative.out b/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_signable_and_negative.out new file mode 100644 index 000000000000..682fc1b1bbe7 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_signable_and_negative.out @@ -0,0 +1,9 @@ +-1234.0 -1234.1 -1234.5 -1234.9 +-1234 -1234 -1234 -1234 truncated +-1234 -1235 -1235 -1235 away-from-zero +-1234 -1234 -1235 -1235 nearest-away-from-zero +-1234 -1234 -1234 -1235 nearest-even +-1234 -1234 -1234 -1235 nearest-toward-zero +-1234 -1234 -1234 -1234 toward-greater +-1234 -1235 -1235 -1235 toward-lesser + diff --git a/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_signable_and_positive.cob b/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_signable_and_positive.cob new file mode 100644 index 000000000000..3cdae70c8380 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_signable_and_positive.cob @@ -0,0 +1,62 @@ + *> { dg-do run } + *> { dg-output-file "group2/Rounding_from_BINARY_signable_and_positive.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 77 v0 pic s9999v9 binary value 1234.0 . + 77 v1 pic s9999v9 binary value 1234.1 . + 77 v5 pic s9999v9 binary value 1234.5 . + 77 v9 pic s9999v9 binary value 1234.9 . + 77 d0 pic s9999 display . + 77 d1 pic s9999 display . + 77 d5 pic s9999 display . + 77 d9 pic s9999 display . + + procedure division. + display "+1234.0 +1234.1 +1234.5 +1234.9" + compute d0 = v0 + compute d1 = v1 + compute d5 = v5 + compute d9 = v9 + display d0 " " d1 " " d5 " " d9 " " "truncated" + + compute d0 ROUNDED MODE AWAY-FROM-ZERO = v0 + compute d1 ROUNDED MODE AWAY-FROM-ZERO = v1 + compute d5 ROUNDED MODE AWAY-FROM-ZERO = v5 + compute d9 ROUNDED MODE AWAY-FROM-ZERO = v9 + display d0 " " d1 " " d5 " " d9 " " "away-from-zero" + + compute d0 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = v0 + compute d1 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = v1 + compute d5 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = v5 + compute d9 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = v9 + display d0 " " d1 " " d5 " " d9 " " "nearest-away-from-zero" + + compute d0 ROUNDED MODE NEAREST-EVEN = v0 + compute d1 ROUNDED MODE NEAREST-EVEN = v1 + compute d5 ROUNDED MODE NEAREST-EVEN = v5 + compute d9 ROUNDED MODE NEAREST-EVEN = v9 + display d0 " " d1 " " d5 " " d9 " " "nearest-even" + + compute d0 ROUNDED MODE NEAREST-TOWARD-ZERO = v0 + compute d1 ROUNDED MODE NEAREST-TOWARD-ZERO = v1 + compute d5 ROUNDED MODE NEAREST-TOWARD-ZERO = v5 + compute d9 ROUNDED MODE NEAREST-TOWARD-ZERO = v9 + display d0 " " d1 " " d5 " " d9 " " "nearest-toward-zero" + + compute d0 ROUNDED MODE TOWARD-GREATER = v0 + compute d1 ROUNDED MODE TOWARD-GREATER = v1 + compute d5 ROUNDED MODE TOWARD-GREATER = v5 + compute d9 ROUNDED MODE TOWARD-GREATER = v9 + display d0 " " d1 " " d5 " " d9 " " "toward-greater" + + compute d0 ROUNDED MODE TOWARD-LESSER = v0 + compute d1 ROUNDED MODE TOWARD-LESSER = v1 + compute d5 ROUNDED MODE TOWARD-LESSER = v5 + compute d9 ROUNDED MODE TOWARD-LESSER = v9 + display d0 " " d1 " " d5 " " d9 " " "toward-lesser" + + goback. + end program prog. + diff --git a/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_signable_and_positive.out b/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_signable_and_positive.out new file mode 100644 index 000000000000..c173c7aeee10 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_signable_and_positive.out @@ -0,0 +1,9 @@ ++1234.0 +1234.1 +1234.5 +1234.9 ++1234 +1234 +1234 +1234 truncated ++1234 +1235 +1235 +1235 away-from-zero ++1234 +1234 +1235 +1235 nearest-away-from-zero ++1234 +1234 +1234 +1235 nearest-even ++1234 +1234 +1234 +1235 nearest-toward-zero ++1234 +1235 +1235 +1235 toward-greater ++1234 +1234 +1234 +1234 toward-lesser + diff --git a/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_unsignable.cob b/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_unsignable.cob new file mode 100644 index 000000000000..ee02333bce45 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_unsignable.cob @@ -0,0 +1,62 @@ + *> { dg-do run } + *> { dg-output-file "group2/Rounding_from_BINARY_unsignable.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 77 v0 pic 9999v9 binary value 1234.0 . + 77 v1 pic 9999v9 binary value 1234.1 . + 77 v5 pic 9999v9 binary value 1234.5 . + 77 v9 pic 9999v9 binary value 1234.9 . + 77 d0 pic s9999 display . + 77 d1 pic s9999 display . + 77 d5 pic s9999 display . + 77 d9 pic s9999 display . + + procedure division. + display " 1234.0 1234.1 1234.5 1234.9" + compute d0 = v0 + compute d1 = v1 + compute d5 = v5 + compute d9 = v9 + display d0 " " d1 " " d5 " " d9 " " "truncated" + + compute d0 ROUNDED MODE AWAY-FROM-ZERO = v0 + compute d1 ROUNDED MODE AWAY-FROM-ZERO = v1 + compute d5 ROUNDED MODE AWAY-FROM-ZERO = v5 + compute d9 ROUNDED MODE AWAY-FROM-ZERO = v9 + display d0 " " d1 " " d5 " " d9 " " "away-from-zero" + + compute d0 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = v0 + compute d1 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = v1 + compute d5 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = v5 + compute d9 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = v9 + display d0 " " d1 " " d5 " " d9 " " "nearest-away-from-zero" + + compute d0 ROUNDED MODE NEAREST-EVEN = v0 + compute d1 ROUNDED MODE NEAREST-EVEN = v1 + compute d5 ROUNDED MODE NEAREST-EVEN = v5 + compute d9 ROUNDED MODE NEAREST-EVEN = v9 + display d0 " " d1 " " d5 " " d9 " " "nearest-even" + + compute d0 ROUNDED MODE NEAREST-TOWARD-ZERO = v0 + compute d1 ROUNDED MODE NEAREST-TOWARD-ZERO = v1 + compute d5 ROUNDED MODE NEAREST-TOWARD-ZERO = v5 + compute d9 ROUNDED MODE NEAREST-TOWARD-ZERO = v9 + display d0 " " d1 " " d5 " " d9 " " "nearest-toward-zero" + + compute d0 ROUNDED MODE TOWARD-GREATER = v0 + compute d1 ROUNDED MODE TOWARD-GREATER = v1 + compute d5 ROUNDED MODE TOWARD-GREATER = v5 + compute d9 ROUNDED MODE TOWARD-GREATER = v9 + display d0 " " d1 " " d5 " " d9 " " "toward-greater" + + compute d0 ROUNDED MODE TOWARD-LESSER = v0 + compute d1 ROUNDED MODE TOWARD-LESSER = v1 + compute d5 ROUNDED MODE TOWARD-LESSER = v5 + compute d9 ROUNDED MODE TOWARD-LESSER = v9 + display d0 " " d1 " " d5 " " d9 " " "toward-lesser" + + goback. + end program prog. + diff --git a/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_unsignable.out b/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_unsignable.out new file mode 100644 index 000000000000..0a1ff4754b0c --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Rounding_from_BINARY_unsignable.out @@ -0,0 +1,9 @@ + 1234.0 1234.1 1234.5 1234.9 ++1234 +1234 +1234 +1234 truncated ++1234 +1235 +1235 +1235 away-from-zero ++1234 +1234 +1235 +1235 nearest-away-from-zero ++1234 +1234 +1234 +1235 nearest-even ++1234 +1234 +1234 +1235 nearest-toward-zero ++1234 +1235 +1235 +1235 toward-greater ++1234 +1234 +1234 +1234 toward-lesser + diff --git a/libgcobol/charmaps.cc b/libgcobol/charmaps.cc index 6bce28c211c0..8f28f85c8e50 100644 --- a/libgcobol/charmaps.cc +++ b/libgcobol/charmaps.cc @@ -1715,11 +1715,13 @@ __gg__miconverter( cbl_encoding_t from, return retval; } -typedef std::unordered_map<cbl_encoding_t, charmap_t *, cbl_encoding_t_hash> -cbl_encoding_charmap_map; +// I switched to this wasteful table when I learned that unordered_map.find(), +// fast though it is, at something like 23 nanoseconds was annoyingly longer +// than some of my efficient MOVE conversion routines. -static -cbl_encoding_charmap_map map_of_encodings; +// Using 1500 is, I suppose, sloppy. Right now the biggest entry in the +// cbl_encodings_t enum is about 1,150. +static charmap_t *maps_weve_seen[iconv_LAST] = {}; charmap_t * __gg__get_charmap(cbl_encoding_t encoding) @@ -1741,15 +1743,15 @@ __gg__get_charmap(cbl_encoding_t encoding) } charmap_t *retval; - cbl_encoding_charmap_map::const_iterator it = map_of_encodings.find(encoding); - if( it != map_of_encodings.end() ) + + if( maps_weve_seen[encoding] ) { - retval = it->second; + retval = maps_weve_seen[encoding]; } else { retval = new charmap_t(encoding); - map_of_encodings[encoding] = retval; + maps_weve_seen[encoding] = retval; } return retval; } diff --git a/libgcobol/charmaps.h b/libgcobol/charmaps.h index 3fb1bd067d55..a16caa57ea87 100644 --- a/libgcobol/charmaps.h +++ b/libgcobol/charmaps.h @@ -263,6 +263,9 @@ enum #define ascii_ff ((uint8_t)('\f')) #define ascii_newline ((uint8_t)('\n')) #define ascii_return ((uint8_t)('\r')) +#define ebcdic_zero ((uint8_t)(0xF0)) +#define ebcdic_plus ((uint8_t)(0x4E)) +#define ebcdic_minus ((uint8_t)(0x60)) extern unsigned char __gg__data_space[1] ; extern unsigned char __gg__data_low_values[1] ; diff --git a/libgcobol/encodings.h b/libgcobol/encodings.h index cf46d83981a7..e7de8793f4a3 100644 --- a/libgcobol/encodings.h +++ b/libgcobol/encodings.h @@ -33,8 +33,10 @@ #include <type_traits> +// These values explicitly start at zero. The final entry is used for sizing +// a lookup array. enum cbl_encoding_t { - no_encoding_e, + no_encoding_e = 0, custom_encoding_e, iconv_1026_e, iconv_1046_e, @@ -1195,6 +1197,7 @@ enum cbl_encoding_t { iconv_WIN_SAMI_2_e, iconv_WS2_e, iconv_YU_e, + iconv_LAST, // This must be the last one. It's used for array sizing }; static inline bool @@ -1202,7 +1205,7 @@ valid_encoding( cbl_encoding_t enc ) { return enc <= iconv_YU_e; } -#define ASCII_e iconv_ASCII_e +#define ASCII_e iconv_ASCII_e #define CP1252_e iconv_CP1252_e #define EBCDIC_e iconv_CP1140_e #define UTF8_e iconv_UTF_8_e diff --git a/libgcobol/stringbin.cc b/libgcobol/stringbin.cc index 8597338c57d5..acf2fff02a09 100644 --- a/libgcobol/stringbin.cc +++ b/libgcobol/stringbin.cc @@ -128,148 +128,128 @@ static char zero_char; typedef struct { - int start; int run; union { unsigned __int128 val128; uint64_t val64; - uint32_t val32; - uint16_t val16; - uint8_t val8; }; } COMBINED; -static -void -string_from_combined(const COMBINED &combined) +#if defined(__cplusplus) && __cplusplus >= 201703L +# define FALLTHROUGH [[fallthrough]] +#elif defined(__GNUC__) && __GNUC__ >= 7 +# define FALLTHROUGH __attribute__((fallthrough)) +#else +# define FALLTHROUGH ((void)0) +#endif + +static const unsigned char digits2[100][2] = { - COMBINED left; - COMBINED right; + {0,0},{0,1},{0,2},{0,3},{0,4},{0,5},{0,6},{0,7},{0,8},{0,9}, + {1,0},{1,1},{1,2},{1,3},{1,4},{1,5},{1,6},{1,7},{1,8},{1,9}, + {2,0},{2,1},{2,2},{2,3},{2,4},{2,5},{2,6},{2,7},{2,8},{2,9}, + {3,0},{3,1},{3,2},{3,3},{3,4},{3,5},{3,6},{3,7},{3,8},{3,9}, + {4,0},{4,1},{4,2},{4,3},{4,4},{4,5},{4,6},{4,7},{4,8},{4,9}, + {5,0},{5,1},{5,2},{5,3},{5,4},{5,5},{5,6},{5,7},{5,8},{5,9}, + {6,0},{6,1},{6,2},{6,3},{6,4},{6,5},{6,6},{6,7},{6,8},{6,9}, + {7,0},{7,1},{7,2},{7,3},{7,4},{7,5},{7,6},{7,7},{7,8},{7,9}, + {8,0},{8,1},{8,2},{8,3},{8,4},{8,5},{8,6},{8,7},{8,8},{8,9}, + {9,0},{9,1},{9,2},{9,3},{9,4},{9,5},{9,6},{9,7},{9,8},{9,9} + }; - uint16_t v16; +static void +uint_to_8_digits(unsigned int a, unsigned char *ach, int n) + { + unsigned int x; - switch(combined.run) + switch(n) { - case 1: - // We know that val8 is a single digit - combined_string[combined.start] = combined.val8 + zero_char; - break; - - case 2: - // We know that val8 has two digits - combined_string[combined.start] = digit_high[combined.val8] + zero_char; - combined_string[combined.start+1] = digit_low [combined.val8] + zero_char; - break; - - case 3: - // We know that val16 has three digits. - v16 = combined.val16; - combined_string[combined.start] = v16 / 100 + zero_char; - v16 %= 100; - combined_string[combined.start+1] = v16 / 10 + zero_char; - combined_string[combined.start+2] = v16 % 10 + zero_char; - break; - - case 4: - // We know that val16 has four digits: - v16 = combined.val16; - combined_string[combined.start] = v16 / 1000 + zero_char; - v16 %= 1000; - combined_string[combined.start+1] = v16 / 100 + zero_char; - v16 %= 100; - combined_string[combined.start+2] = v16 / 10 + zero_char; - combined_string[combined.start+3] = v16 % 10 + zero_char; - break; - - case 5: - case 6: - case 7: case 8: - // We know that val32 can be treated as two 4-digit pieces - left.start = combined.start; - left.run = combined.run - 4; - left.val16 = combined.val32 / 10000; + x = a % 100; + ach[6] = digits2[x][0]; + ach[7] = digits2[x][1]; + a /= 100; + FALLTHROUGH; - right.start = combined.start+left.run; - right.run = 4; - right.val16 = combined.val32 % 10000; - - string_from_combined(left); - string_from_combined(right); - break; - - case 9: - // We break val32 into a 1-digit piece, and an 8-digit piece: - left.start = combined.start; - left.run = combined.run - 8; - left.val32 = combined.val32 / 100000000; - - right.start = combined.start+left.run; - right.run = 8; - right.val32 = combined.val32 % 100000000; + case 7: + case 6: + x = a % 100; + ach[4] = digits2[x][0]; + ach[5] = digits2[x][1]; + a /= 100; + FALLTHROUGH; - string_from_combined(left); - string_from_combined(right); - break; + case 5: + case 4: + x = a % 100; + ach[2] = digits2[x][0]; + ach[3] = digits2[x][1]; + a /= 100; + FALLTHROUGH; - case 10: - case 11: - case 12: - case 13: - case 14: - case 15: - case 16: - case 17: - case 18: - // We know we can treat val64 as two 9-digit pieces: - left.start = combined.start; - left.run = combined.run - 9; - left.val32 = combined.val64 / 1000000000; - - right.start = combined.start+left.run; - right.run = 9; - right.val32 = combined.val64 % 1000000000; - - string_from_combined(left); - string_from_combined(right); + case 3: + case 2: + x = a % 100; + ach[0] = digits2[x][0]; + ach[1] = digits2[x][1]; + FALLTHROUGH; + default: break; + } + } - case 19: - // We split off the bottom nine digits - left.start = combined.start; - left.run = combined.run - 9; - left.val64 = combined.val64 / 1000000000; - - right.start = combined.start+left.run; - right.run = 9; - right.val32 = combined.val64 % 1000000000; - - string_from_combined(left); - string_from_combined(right); - break; +static +void +string_from_combined(const COMBINED &combined) + { + int ndigits = combined.run; + unsigned __int128 value = combined.val128; - default: - // For twenty or more digits we peel eighteen digits at a time off the - // right side: - left.start = combined.start; - left.run = combined.run - 18; - left.val128 = combined.val128 / 1000000000000000000ULL; - - right.start = combined.start+left.run; - right.run = 18; - right.val64 = combined.val128 % 1000000000000000000ULL; - - string_from_combined(left); - string_from_combined(right); - break; + if( ndigits & 0x01 ) + { + combined_string[ndigits-1] = value%10; + value /= 10; + ndigits -= 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 ) + { + 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); + value /= 100000000; + } + char *p = combined_string; + const char *pend = p + combined.run; + while(p < pend) + { + *p++ += zero_char; } } -bool -__gg__binary_to_string_ascii(char *result, int digits, __int128 value) +static bool +binary_to_string(char *result, int digits, __int128 value) { - zero_char = ascii_zero; bool retval; // True means the value was too big to fit into digits if( digits < 39 ) { @@ -291,7 +271,6 @@ __gg__binary_to_string_ascii(char *result, int digits, __int128 value) // mask off the bottom digits to avoid garbage when value is too large value %= mask; - combined.start = 0; combined.run = digits; combined.val128 = value; string_from_combined(combined); @@ -307,7 +286,6 @@ __gg__binary_to_string_ascii(char *result, int digits, __int128 value) // number of digits: retval = false; - combined.start = 0; combined.run = digits; combined.val128 = value; string_from_combined(combined); @@ -316,6 +294,22 @@ __gg__binary_to_string_ascii(char *result, int digits, __int128 value) return retval; } +extern "C" +bool +__gg__binary_to_string_ascii(char *result, int digits, __int128 value) + { + zero_char = ascii_zero; + return binary_to_string(result, digits, value); + } + +extern "C" +bool +__gg__binary_to_string_ebcdic(char *result, int digits, __int128 value) + { + zero_char = ebcdic_zero; + return binary_to_string(result, digits, value); + } + bool __gg__binary_to_string_encoded( char *result, size_t digits, @@ -325,7 +319,10 @@ __gg__binary_to_string_encoded( char *result, // A non-zero retval means the number was too big to fit into the desired // number of digits. - zero_char = ascii_0; + const charmap_t *charmap = __gg__get_charmap(encoding); + int stride = charmap->stride(); + + zero_char = charmap->is_like_ebcdic() ? ebcdic_zero : ascii_0; // Note that this routine does not terminate the generated string with a // NUL. This routine is sometimes used to generate a NumericDisplay string @@ -343,22 +340,29 @@ __gg__binary_to_string_encoded( char *result, // mask off the bottom digits to avoid garbage when value is too large value %= mask; - combined.start = 0; combined.run = digits; combined.val128 = value; string_from_combined(combined); - size_t converted_bytes; - const char *converted = __gg__iconverter(DEFAULT_SOURCE_ENCODING, - encoding, - combined_string, - digits, - &converted_bytes); - memcpy(result, converted, converted_bytes); + if( stride == 1 ) + { + memcpy(result, combined_string, digits); + } + else + { + char *p = combined_string; + const char *pend = p + digits; + char *d = result; + while(p < pend) + { + *d++ = *p++; + memset(d, 0, stride-1); + d += stride-1; + } + } return retval; } -static -void +static void packed_from_combined(const COMBINED &combined) { /* The combined.value must be positive at this point. @@ -383,108 +387,33 @@ packed_from_combined(const COMBINED &combined) 0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99, } ; - COMBINED left; - COMBINED right; + char *d = combined_string + combined.run; - switch(combined.run) + if( combined.run > 9) { - case 1: - // We know that val8 has two digits. - combined_string[combined.start] = bin2pd[combined.val8]; - break; - - case 2: - // We know that val16 has four digits. - combined_string[combined.start ] = bin2pd[combined.val16/100]; - combined_string[combined.start+1] = bin2pd[combined.val16%100]; - break; - - case 3: - case 4: - // We know that val32 can hold up to eight digits. Break it in half. - left.start = combined.start; - left.run = combined.run - 2; - left.val16 = combined.val32 / 10000; - - right.start = combined.start+left.run; - right.run = 2; - right.val16 = combined.val32 % 10000; - - packed_from_combined(left); - packed_from_combined(right); - break; - - case 5: - case 6: - case 7: - case 8: - // We know that val64 is holding up to 18 digits. Break it into two - // eight-digit places that can each go into a val23 - left.start = combined.start; - left.run = combined.run - 4; - left.val32 = combined.val64 / 100000000; - - right.start = combined.start+left.run; - right.run = 4; - right.val32 = combined.val64 % 100000000; - - packed_from_combined(left); - packed_from_combined(right); - break; - - case 9: - // We know that val64 is holding 17 or 18 digits. Break off the - // bottom eight. - left.start = combined.start; - left.run = combined.run - 4; - left.val64 = combined.val64 / 100000000; - - right.start = combined.start+left.run; - right.run = 4; - right.val32 = combined.val64 % 100000000; - - packed_from_combined(left); - packed_from_combined(right); - break; - - case 10: - case 11: - case 12: - case 13: - case 14: - case 15: - case 16: - case 17: - case 18: - // We know that val64 is holding between 18 and 36 digits. Break it - // two val64: - - left.start = combined.start; - left.run = combined.run - 9; - left.val64 = combined.val128 / 1000000000000000000ULL; - - right.start = combined.start+left.run; - right.run = 9; - right.val64 = combined.val128 % 1000000000000000000ULL; - - packed_from_combined(left); - packed_from_combined(right); - break; - - default: - // For twenty or more digits we peel eighteen digits at a time off the - // right side: - left.start = combined.start; - left.run = combined.run - 9; - left.val128 = combined.val128 / 1000000000000000000ULL; - - right.start = combined.start+left.run; - right.run = 9; - right.val64 = combined.val128 % 1000000000000000000ULL; - - packed_from_combined(left); - packed_from_combined(right); - break; + // Stage 1: pull from int128 until the top half is zero. + __int128 value128 = combined.val128; + 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 + { + uint64_t value = combined.val64; + while(d > combined_string) + { + *(--d) = bin2pd[value%100]; + value /= 100; + } } } @@ -497,7 +426,6 @@ __gg__binary_to_packed( unsigned char *result, size_t length = (digits+1)/2; COMBINED combined; - combined.start = 0; combined.run = length; combined.val128 = value; packed_from_combined(combined); @@ -671,3 +599,4 @@ __gg__packed_to_binary(const unsigned char *psz, } return retval; } +
