aboutsummaryrefslogtreecommitdiff
path: root/gcc/cobol/genutil.cc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/cobol/genutil.cc')
-rw-r--r--gcc/cobol/genutil.cc335
1 files changed, 70 insertions, 265 deletions
diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc
index 7895ea8..4b296e4 100644
--- a/gcc/cobol/genutil.cc
+++ b/gcc/cobol/genutil.cc
@@ -27,6 +27,9 @@
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
+
+// cppcheck-suppress-file duplicateBreak
+
#include "cobol-system.h"
#include "coretypes.h"
#include "tree.h"
@@ -749,9 +752,9 @@ get_binary_value( tree value,
return;
}
- 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);
-
+ static tree pointer = gg_define_variable( UCHAR_P,
+ "..gbv_pointer",
+ vs_file_static);
switch(field->type)
{
case FldLiteralN:
@@ -788,8 +791,9 @@ get_binary_value( tree value,
// We need to check early on for HIGH-VALUE and LOW-VALUE
// Pick up the byte
tree digit = gg_get_indirect_reference(source_address, NULL_TREE);
- IF( digit, eq_op, build_int_cst(UCHAR, 0xFF) )
+ IF( digit, eq_op, build_int_cst(UCHAR, DEGENERATE_HIGH_VALUE) )
{
+ // We are dealing with HIGH-VALUE
if( hilo )
{
gg_assign(hilo, integer_one_node);
@@ -800,12 +804,14 @@ get_binary_value( tree value,
build_int_cst_type( TREE_TYPE(rdigits),
get_scaled_rdigits(field)));
}
- gg_assign(value, build_int_cst_type(TREE_TYPE(value), 0xFFFFFFFFFFFFFFFUL));
+ gg_assign(value, build_int_cst_type(TREE_TYPE(value),
+ 0x7FFFFFFFFFFFFFFFUL));
}
ELSE
{
- IF( digit, eq_op, build_int_cst(UCHAR, 0x00) )
+ IF( digit, eq_op, build_int_cst(UCHAR, DEGENERATE_LOW_VALUE) )
{
+ // We are dealing with LOW-VALUE
if( hilo )
{
gg_assign(hilo, integer_minus_one_node);
@@ -813,26 +819,25 @@ get_binary_value( tree value,
}
ELSE
{
- // Establish rdigits:
+ // We are dealing with an ordinary NumericDisplay value
+ gg_assign(pointer, source_address);
+
if( rdigits )
{
gg_assign(rdigits,
- build_int_cst_type( TREE_TYPE(rdigits),
- get_scaled_rdigits(field)));
+ build_int_cst_type(TREE_TYPE(rdigits),
+ get_scaled_rdigits(field)));
}
- // Zero out the destination
- gg_assign(value, gg_cast(TREE_TYPE(value), integer_zero_node));
- // Pick up a pointer to the source bytes:
-
- gg_assign(pointer, source_address);
-
- // This is the we-are-done pointer
- gg_assign(pend, gg_add( pointer,
- get_any_capacity(field)));
-
- static tree signbyte = gg_define_variable(UCHAR, "..gbv_signbyte", vs_file_static);
-
- // The big decision is whether or not the variable is signed:
+ // This will be the 128-bit value of the character sequence
+ static tree val128 = gg_define_variable(INT128,
+ "..gbv_val128",
+ vs_file_static);
+ // This is a pointer to the sign byte
+ static tree signp = gg_define_variable(UCHAR_P,
+ "..gbv_signp",
+ vs_file_static);
+ // We need to figure out where the sign information, if any is to be
+ // found:
if( field->attr & signable_e )
{
// The variable is signed
@@ -842,12 +847,17 @@ get_binary_value( tree value,
if( field->attr & leading_e)
{
// The first byte is '+' or '-'
+ gg_assign(signp, source_address);
+ // Increment pointer to point to the first actual digit
gg_increment(pointer);
}
else
{
// The final byte is '+' or '-'
- gg_decrement(pend);
+ gg_assign(signp,
+ gg_add(source_address,
+ build_int_cst_type( SIZE_T,
+ field->data.digits)));
}
}
else
@@ -855,219 +865,34 @@ get_binary_value( tree value,
// The sign byte is internal
if( field->attr & leading_e)
{
- // The first byte has the sign bit:
- gg_assign(signbyte,
- gg_get_indirect_reference(source_address, NULL_TREE));
- if( internal_codeset_is_ebcdic() )
- {
- // We need to make sure the EBCDIC sign bit is ON, for positive
- gg_assign(gg_get_indirect_reference(source_address, NULL_TREE),
- gg_bitwise_or(signbyte,
- build_int_cst_type( UCHAR,
- NUMERIC_DISPLAY_SIGN_BIT)));
- }
- else
- {
- // We need to make sure the ascii sign bit is Off, for positive
- gg_assign(gg_get_indirect_reference(source_address, NULL_TREE),
- gg_bitwise_and( signbyte,
- build_int_cst_type( UCHAR,
- ~NUMERIC_DISPLAY_SIGN_BIT)));
- }
+ // The first byte has the sign bit.
+ gg_assign(signp, source_address);
}
else
{
- // The final byte has the sign bit:
- gg_assign(signbyte,
- gg_get_indirect_reference(source_address,
- build_int_cst_type(SIZE_T,
- field->data.capacity-1)));
- if( internal_codeset_is_ebcdic() )
- {
- // We need to make sure the EBCDIC sign bit is ON, for positive
- gg_assign(gg_get_indirect_reference(source_address,
- build_int_cst_type( SIZE_T,
- field->data.capacity-1)),
- gg_bitwise_or(signbyte,
- build_int_cst_type( UCHAR,
- NUMERIC_DISPLAY_SIGN_BIT)));
- }
- else
- {
- // We need to make sure the ASCII sign bit is Off, for positive
- gg_assign(gg_get_indirect_reference(source_address,
- build_int_cst_type( SIZE_T,
- field->data.capacity-1)),
- gg_bitwise_and( signbyte,
- build_int_cst_type( UCHAR,
- ~NUMERIC_DISPLAY_SIGN_BIT)));
- }
- }
- }
- }
- // We can now set up the byte-by-byte processing loop:
- if( internal_codeset_is_ebcdic() )
- {
- // We are working in EBCDIC
- WHILE( pointer, lt_op, pend )
- {
- // Pick up the byte
- digit = gg_get_indirect_reference(pointer, NULL_TREE);
- IF( digit, lt_op, build_int_cst_type(UCHAR, EBCDIC_ZERO) )
- {
- // break on a non-digit
- gg_assign(pointer, pend);
+ // The final byte has the sign bit.
+ gg_assign(signp,
+ gg_add(source_address,
+ build_int_cst_type( SIZE_T,
+ field->data.digits-1)));
}
- ELSE
- {
- IF( digit, gt_op, build_int_cst_type(UCHAR, EBCDIC_NINE) )
- {
- // break on a non-digit
- gg_assign(pointer, pend);
- }
- ELSE
- {
- // Whether ASCII or EBCDIC, the bottom four bits tell the tale:
- // Multiply our accumulator by ten:
- gg_assign(value, gg_multiply(value, build_int_cst_type(TREE_TYPE(value), 10)));
- // And add in the current digit
- gg_assign(value,
- gg_add(value, gg_cast(TREE_TYPE(value), gg_bitwise_and( digit,
- build_int_cst_type(UCHAR, 0x0F) ))));
- gg_increment(pointer);
- }
- ENDIF
- }
- ENDIF
}
- WEND
}
else
{
- // We are working in ASCII:
- WHILE( pointer, lt_op, pend )
- {
- // Pick up the byte
- digit = gg_get_indirect_reference(pointer, NULL_TREE);
- // Whether ASCII or EBCDIC, the bottom four bits tell the tale:
- // Multiply our accumulator by ten:
- gg_assign(value, gg_multiply(value, build_int_cst_type(TREE_TYPE(value), 10)));
- // And add in the current digit
- gg_assign(value, gg_add(value, gg_cast(TREE_TYPE(value), gg_bitwise_and(digit, build_int_cst_type(UCHAR, 0x0F)))));
- gg_increment(pointer);
- }
- WEND
+ // This value is unsigned, so just use the first location:
+ gg_assign(signp, source_address);
}
- // Value contains the binary value. The last thing is to apply -- and
- // undo -- the signable logic:
-
- if( field->attr & signable_e )
- {
- // The variable is signed
- if( field->attr & separate_e )
- {
- // The sign byte is separate
- if( field->attr & leading_e)
- {
- // The first byte is '+' or '-'
- if( internal_codeset_is_ebcdic() )
- {
- // We are operating in EBCDIC, so we look for a 96 (is minus sign)
- IF( gg_get_indirect_reference(source_address, NULL_TREE),
- eq_op,
- build_int_cst_type(UCHAR, 96) )
- {
- gg_assign(value, gg_negate(value));
- }
- ELSE
- ENDIF
- }
- else
- {
- // We are operating in ASCII
- IF( gg_get_indirect_reference(source_address, NULL_TREE),
- eq_op,
- build_int_cst_type(UCHAR, '-') )
- {
- gg_assign(value, gg_negate(value));
- }
- ELSE
- ENDIF
- }
- }
- else
- {
- // The final byte is '+' or '-'
- if( internal_codeset_is_ebcdic() )
- {
- // We are operating in EBCDIC, so we look for a 96 (is minus sign)
- IF( gg_get_indirect_reference(source_address, build_int_cst_type(SIZE_T, field->data.capacity-1)),
- eq_op,
- build_int_cst_type(UCHAR, 96) )
- {
- gg_assign(value, gg_negate(value));
- }
- ELSE
- ENDIF
- }
- else
- {
- // We are operating in ASCII
- IF( gg_get_indirect_reference(source_address, build_int_cst_type(SIZE_T, field->data.capacity-1)),
- eq_op,
- build_int_cst_type(UCHAR, '-') )
- {
- gg_assign(value, gg_negate(value));
- }
- ELSE
- ENDIF
- }
- }
- }
- else
- {
- // The sign byte is internal. Check the sign bit
- if(internal_codeset_is_ebcdic())
- {
- IF( gg_bitwise_and( signbyte,
- build_int_cst_type( UCHAR,
- NUMERIC_DISPLAY_SIGN_BIT)), eq_op, build_int_cst_type(UCHAR, 0) )
- {
- // The EBCDIC sign bit was OFF, so negate the result
- gg_assign(value, gg_negate(value));
- }
- ELSE
- ENDIF
- }
- else
- {
- IF( gg_bitwise_and( signbyte,
- build_int_cst_type( UCHAR,
- NUMERIC_DISPLAY_SIGN_BIT)), ne_op, build_int_cst_type(UCHAR, 0) )
- {
- // The ASCII sign bit was on, so negate the result
- gg_assign(value, gg_negate(value));
- }
- ELSE
- ENDIF
- }
- // It's time to put back the original data:
- if( field->attr & leading_e)
- {
- // The first byte has the sign bit:
- gg_assign(gg_get_indirect_reference(source_address, NULL_TREE),
- signbyte);
- }
- else
- {
- // The final byte has the sign bit:
- gg_assign(gg_get_indirect_reference(source_address,
- build_int_cst_type(SIZE_T, field->data.capacity-1)),
- signbyte);
- }
- }
- }
+ gg_assign(val128,
+ gg_call_expr( INT128,
+ "__gg__numeric_display_to_binary",
+ signp,
+ pointer,
+ build_int_cst_type(INT, field->data.digits),
+ NULL_TREE));
+ // Assign the value we got from the string to our "return" value:
+ gg_assign(value, gg_cast(TREE_TYPE(value), val128));
}
ENDIF
}
@@ -1116,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));
}
@@ -1199,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;
}
@@ -1267,7 +1072,7 @@ get_binary_value( tree value,
cbl_field_type_str(field->type) );
cbl_internal_error("%s", err);
abort();
- // break; // break not needed after abort();
+ break;
}
}
generated by cgit v1.1 at 2025-09-27 10:34:36 +0000