From 33e26a071f9daea57cb0d170d75d9fdf406040f1 Mon Sep 17 00:00:00 2001 From: Robert Dubner Date: Wed, 13 Aug 2025 11:17:05 -0400 Subject: cobol: Implement and use faster __gg__packed_to_binary() routine. The new routine uses table lookups more effectively, and avoids __int128 arithmetic until necessary. gcc/cobol/ChangeLog: * genutil.cc (get_binary_value): Use the new routine. libgcobol/ChangeLog: * libgcobol.cc (get_binary_value_local): Use the new routine. * stringbin.cc (int_from_string): Removed. (__gg__packed_to_binary): Implement new routine. * stringbin.h (__gg__packed_to_binary): Likewise. --- gcc/cobol/genutil.cc | 60 ++++++++++++++++------------------------------------ 1 file changed, 18 insertions(+), 42 deletions(-) (limited to 'gcc') diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc index e131d15..3682b10 100644 --- a/gcc/cobol/genutil.cc +++ b/gcc/cobol/genutil.cc @@ -755,10 +755,6 @@ get_binary_value( tree value, static tree pointer = gg_define_variable( UCHAR_P, "..gbv_pointer", vs_file_static); - static tree pend = gg_define_variable(UCHAR_P, - "..gbv_pend", - vs_file_static); - switch(field->type) { case FldLiteralN: @@ -945,7 +941,9 @@ get_binary_value( tree value, vs_file_static); if( field->attr & signable_e ) { - IF( gg_array_value(gg_cast(build_pointer_type(SCHAR), source)), lt_op, gg_cast(SCHAR, integer_zero_node) ) + IF( gg_array_value(gg_cast(build_pointer_type(SCHAR), source)), + lt_op, + gg_cast(SCHAR, integer_zero_node) ) { gg_assign(extension, build_int_cst_type(UCHAR, 0xFF)); } @@ -1028,45 +1026,23 @@ get_binary_value( tree value, case FldPacked: { - // Zero out the destination: - gg_assign(value, gg_cast(TREE_TYPE(value), integer_zero_node)); - gg_assign(pointer, get_data_address(field, field_offset)); - gg_assign(pend, - gg_add(pointer, - build_int_cst_type(SIZE_T, field->data.capacity-1))); - - // Convert all but the last byte of the packed decimal sequence - WHILE( pointer, lt_op, pend ) - { - // Convert the first nybble - gg_assign(value, gg_multiply(value, build_int_cst_type(TREE_TYPE(value), 10))); - gg_assign(value, gg_add(value, gg_cast(TREE_TYPE(value), gg_rshift(gg_get_indirect_reference(pointer, NULL_TREE), build_int_cst(UINT, 4))))); - - // Convert the second nybble - gg_assign(value, gg_multiply(value, build_int_cst_type(TREE_TYPE(value), 10))); - gg_assign(value, gg_add(value, gg_cast(TREE_TYPE(value), gg_bitwise_and(gg_get_indirect_reference(pointer, NULL_TREE), build_int_cst_type(UCHAR, 0xF))))); - gg_increment(pointer); - } - WEND - - // This is the final byte: - gg_assign(value, gg_multiply(value, build_int_cst_type(TREE_TYPE(value), 10))); - gg_assign(value, gg_add(value, gg_cast(TREE_TYPE(value), gg_rshift(gg_get_indirect_reference(pointer, NULL_TREE), build_int_cst(UINT, 4))))); - - IF( gg_bitwise_and(gg_get_indirect_reference(pointer, NULL_TREE), build_int_cst_type(UCHAR, 0xF)), eq_op, build_int_cst_type(UCHAR, 0x0D) ) - { - gg_assign(value, gg_negate(value)); - } - ELSE + if( rdigits ) { - IF( gg_bitwise_and(gg_get_indirect_reference(pointer, NULL_TREE), build_int_cst_type(UCHAR, 0xF)), eq_op, build_int_cst_type(UCHAR, 0x0B) ) - { - gg_assign(value, gg_negate(value)); - } - ELSE - ENDIF + gg_assign(rdigits, + build_int_cst_type( TREE_TYPE(rdigits), + get_scaled_rdigits(field))); } - ENDIF + tree dest_type = TREE_TYPE(value); + + gg_assign(value, + gg_cast(dest_type, + gg_call_expr(INT128, + "__gg__packed_to_binary", + get_data_address( field, + field_offset), + build_int_cst_type(INT, + field->data.capacity), + NULL_TREE))); break; } -- cgit v1.1