}
}
+static
+tree
+tree_type_from_field_type(cbl_field_t *field, size_t &nbytes)
+ {
+ /* This routine is used to determine what action is taken with type of a
+ CALL ... USING <var> and the matching PROCEDURE DIVISION USING <var> of
+ a PROGRAM-ID or FUNCTION-ID
+ */
+ tree retval = COBOL_FUNCTION_RETURN_TYPE;
+ nbytes = 8;
+ if( field )
+ {
+ // This maps a Fldxxx to a C-style variable type:
+ switch(field->type)
+ {
+ case FldGroup:
+ case FldAlphanumeric:
+ case FldAlphaEdited:
+ case FldNumericEdited:
+ retval = CHAR_P;
+ nbytes = field->data.capacity();
+ break;
+
+ case FldNumericDisplay:
+ case FldNumericBinary:
+ case FldPacked:
+ if( field->data.digits > 18 )
+ {
+ retval = UINT128;
+ nbytes = 16;
+ }
+ else
+ {
+ retval = SIZE_T;
+ nbytes = 8;
+ }
+ break;
+
+ case FldNumericBin5:
+ case FldIndex:
+ case FldPointer:
+ if( field->data.capacity() > 8 )
+ {
+ retval = UINT128;
+ nbytes = 16;
+ }
+ else
+ {
+ retval = SIZE_T;
+ nbytes = 8;
+ }
+ break;
+
+ case FldFloat:
+ if( field->data.capacity() == 8 )
+ {
+ retval = DOUBLE;
+ nbytes = 8;
+ }
+ else if( field->data.capacity() == 4 )
+ {
+ retval = FLOAT;
+ nbytes = 4;
+ }
+ else
+ {
+ retval = FLOAT128;
+ nbytes = 16;
+ }
+ break;
+
+ case FldLiteralN:
+ // Assume a 64-bit signed integer. This happens for GOBACK STATUS 101,
+ // the like
+ retval = LONG;
+ nbytes = 8;
+ break;
+
+ default:
+ cbl_internal_error( "%s: Invalid field type %s:",
+ __func__,
+ cbl_field_type_str(field->type));
+ break;
+ }
+ if( retval == SIZE_T && field->attr & signable_e )
+ {
+ retval = SSIZE_T;
+ }
+ if( retval == UINT128 && field->attr & signable_e )
+ {
+ retval = INT128;
+ }
+ }
+ return retval;
+ }
+
static void
compare_binary_binary(tree return_int,
cbl_refer_t *left_side_ref,
tree left_side;
tree right_side;
+ // Let's check for the simplified case where both left and right sides are
+ // little-endian binary values:
+
+ if( is_pure_integer(left_side_ref->field)
+ && is_pure_integer(right_side_ref->field) )
+ {
+ size_t left_bytes;
+ tree left_type = tree_type_from_field_type(left_side_ref->field,
+ left_bytes);
+ size_t right_bytes;
+ tree right_type = tree_type_from_field_type(right_side_ref->field,
+ right_bytes);
+ tree larger;
+ if( TREE_INT_CST_LOW(TYPE_SIZE(left_type))
+ > TREE_INT_CST_LOW(TYPE_SIZE(right_type)) )
+ {
+ larger = left_type;
+ }
+ else
+ {
+ larger = right_type;
+ }
+ left_side = get_binary_value_tree(larger,
+ NULL,
+ *left_side_ref);
+ right_side = get_binary_value_tree(larger,
+ NULL,
+ *right_side_ref);
+ IF( left_side, eq_op, right_side )
+ {
+ gg_assign(return_int, integer_zero_node);
+ }
+ ELSE
+ {
+ IF( left_side, lt_op, right_side )
+ {
+ gg_assign(return_int, integer_minusone_node);
+ }
+ ELSE
+ {
+ gg_assign(return_int, integer_one_node);
+ }
+ ENDIF
+ }
+ ENDIF
+ return;
+ }
+
// Use SIZE128 when we need two 64-bit registers to hold the value. All
// others fit into 64-bit LONG with pretty much the same efficiency.
uint32_t digits;
int32_t rdigits;
uint64_t attr;
- //// DUBNERHACK. Necessary to prevent UAT lockup:
- const char *source_text = field->data.original()
- ? field->data.original()
- : field->data.initial;
- FIXED_WIDE_INT(128) value = dirty_to_binary(source_text,
+ FIXED_WIDE_INT(128) value = dirty_to_binary(field->data.original(),
capacity,
digits,
rdigits,
tree new_var_decl = gg_define_variable( var_type,
base_name,
vs_static);
- DECL_INITIAL(new_var_decl) = wide_int_to_tree(var_type, value);
+ DECL_INITIAL(new_var_decl) = wide_int_to_tree(var_type, value);
+ TREE_CONSTANT(new_var_decl) = 1;
+
field->data_decl_node = new_var_decl;
// Note that during compilation, the integer value, assuming it can be
gg_free(ttbls);
}
-static
-tree
-tree_type_from_field_type(cbl_field_t *field, size_t &nbytes)
- {
- /* This routine is used to determine what action is taken with type of a
- CALL ... USING <var> and the matching PROCEDURE DIVISION USING <var> of
- a PROGRAM-ID or FUNCTION-ID
- */
- tree retval = COBOL_FUNCTION_RETURN_TYPE;
- nbytes = 8;
- if( field )
- {
- // This maps a Fldxxx to a C-style variable type:
- switch(field->type)
- {
- case FldGroup:
- case FldAlphanumeric:
- case FldAlphaEdited:
- case FldNumericEdited:
- retval = CHAR_P;
- nbytes = field->data.capacity();
- break;
-
- case FldNumericDisplay:
- case FldNumericBinary:
- case FldPacked:
- if( field->data.digits > 18 )
- {
- retval = UINT128;
- nbytes = 16;
- }
- else
- {
- retval = SIZE_T;
- nbytes = 8;
- }
- break;
-
- case FldNumericBin5:
- case FldIndex:
- case FldPointer:
- if( field->data.capacity() > 8 )
- {
- retval = UINT128;
- nbytes = 16;
- }
- else
- {
- retval = SIZE_T;
- nbytes = 8;
- }
- break;
-
- case FldFloat:
- if( field->data.capacity() == 8 )
- {
- retval = DOUBLE;
- nbytes = 8;
- }
- else if( field->data.capacity() == 4 )
- {
- retval = FLOAT;
- nbytes = 4;
- }
- else
- {
- retval = FLOAT128;
- nbytes = 16;
- }
- break;
-
- case FldLiteralN:
- // Assume a 64-bit signed integer. This happens for GOBACK STATUS 101,
- // the like
- retval = LONG;
- nbytes = 8;
- break;
-
- default:
- cbl_internal_error( "%s: Invalid field type %s:",
- __func__,
- cbl_field_type_str(field->type));
- break;
- }
- if( retval == SIZE_T && field->attr & signable_e )
- {
- retval = SSIZE_T;
- }
- if( retval == UINT128 && field->attr & signable_e )
- {
- retval = INT128;
- }
- }
- return retval;
- }
-
static void
restore_local_variables()
{
free(level_88_string);
free(class_string);
- if( !(new_var->attr & ( linkage_e | based_e)) )
+ if( !(new_var->attr & ( linkage_e | based_e))
+ && !(new_var->type == FldLiteralN) )
{
static const bool explicitly = false;
static const bool just_once = true;
}
static bool
-all_results_binary(size_t nC, const cbl_num_result_t *C)
+all_results_integer(size_t nC, const cbl_num_result_t *C)
{
bool retval = true;
for(size_t i=0; i<nC; i++)
{
- if(C[i].refer.field->data.digits != 0 || C[i].refer.field->type == FldFloat )
+ if( !is_pure_integer(C[i].refer.field) )
+ {
+ retval = false;
+ break;
+ }
+ }
+ return retval;
+ }
+
+static bool
+all_refers_integer(size_t nC, const cbl_refer_t *C)
+ {
+ bool retval = true;
+
+ for(size_t i=0; i<nC; i++)
+ {
+ if( !is_pure_integer(C[i].field) )
{
retval = false;
break;
for(size_t i=0; i<nA; i++)
{
- if( A[i].field->data.rdigits || A[i].field->type == FldFloat )
+ if( !is_pure_integer(A[i].field) || A[i].field->type == FldFloat )
{
- // We are prepared to work only with integers
+ // We are prepared to work only with binary integers
retval = NULL_TREE;
break;
}
if( A[i].field->type == FldLiteralN
-// || A[i].field->type == FldNumericDisplay
|| A[i].field->type == FldNumericBinary
|| A[i].field->type == FldNumericBin5
|| A[i].field->type == FldIndex
- || A[i].field->type == FldPointer )
+ || A[i].field->type == FldPointer
+ || ( A[i].field->type == FldAlphanumeric
+ && strcmp(A[i].field->name, "ZEROS") == 0 )
+ )
{
// This is an integer type that can be worked with quickly
is_negative |= ( A[i].field->attr & signable_e );
size_t nA, cbl_refer_t *A,
cbl_arith_format_t format )
{
+ /* ADD A TO D: nC==1, nA==1, D += A.
+ ADD A B C TO D: nC==1, nA==3, D = (A + B + C)
+ ADD A B C TO D E nC==2, nA==3
+ ADD A TO B GIVING D nC==1, nA==2, format==giving_e
+ ADD A B C TO D GIVING X Y nC==2, nA==3, format==giving_e */
bool retval = false;
- if( all_results_binary(nC, C) )
+ if( all_results_integer(nC, C)
+ && all_refers_integer(nA, A) )
{
Analyze();
// All targets are non-PICTURE binaries:
tree term_type = largest_binary_term(nA, A);
if( term_type )
{
- // All the terms are things we can work with.
-
- // We need to calculate the sum of all the A[] terms using term_type as
- // the intermediate type:
-
- tree sum = gg_define_variable(term_type);
- tree addend = gg_define_variable(term_type);
- get_binary_value( sum,
- NULL,
- A[0].field,
- refer_offset(A[0]));
-
- // Add in the rest of them:
- for(size_t i=1; i<nA; i++)
+ tree dest_type = tree_type_from_size(
+ C[0].refer.field->data.capacity(),
+ 0);
+ // All the numbers are integers without rdigits
+ if( nC == 1
+ && nA == 1
+ && format != giving_e
+ )
{
- get_binary_value( addend,
- NULL,
- A[i].field,
- refer_offset(A[i]));
- gg_assign(sum, gg_add(sum, addend));
- }
- //gg_printf("The intermediate sum is %ld\n", gg_cast(LONG, sum), NULL_TREE);
+ // This is the simplest case of all. Just add A to C. We can't
+ // naively add A to multiple C, because of the possibility of
+ // ADD A TO A B C. That would change A before A gets added to B and
+ // C, which is not how COBOL works.
- // We now either accumulate into C[n] or assign to C[n]:
- for(size_t i=0; i<nC; i++ )
- {
- tree dest_type = tree_type_from_size(C[i].refer.field->data.capacity(), 0);
- tree dest_addr = gg_add(member(C[i].refer.field->var_decl_node, "data"),
- refer_offset(C[i].refer));
- tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
- if( format == giving_e )
+ tree A_value;
+ if( refer_is_clean(A[0]) )
+ {
+ A_value = get_binary_value_tree(dest_type,
+ NULL, // No rdigits
+ A[0].field,
+ integer_zero_node);
+ }
+ else
{
- // We are assigning
+ A_value = get_binary_value_tree(dest_type,
+ NULL, // No rdigits
+ A[0].field,
+ refer_offset(A[0]));
+ }
+ if( refer_is_clean(C[0].refer) )
+ {
+ tree dest_addr = member(C[0].refer.field->var_decl_node,
+ "data");
+ tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
+ // We are accumulating into memory
gg_assign( gg_indirect(ptr),
- gg_cast(dest_type, sum));
+ gg_add( gg_indirect(ptr),
+ A_value));
}
else
{
- // We are accumulating
+ tree dest_addr = gg_add(member(C[0].refer.field->var_decl_node,
+ "data"),
+ refer_offset(C[0].refer));
+ tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
+ // We are accumulating into memory
gg_assign( gg_indirect(ptr),
gg_add( gg_indirect(ptr),
- gg_cast(dest_type, sum)));
+ A_value));
+ }
+ }
+ else if( nC == 1
+ && nA == 2
+ && format == giving_e )
+ {
+ // This is the very common ADD A TO B GIVING C
+ {
+ // Make C = A[0] + A[1]
+ tree dest_addr;
+ if( refer_is_clean(C[0].refer) )
+ {
+ dest_addr = member(C[0].refer.field->var_decl_node, "data");
+ }
+ else
+ {
+ dest_addr = gg_add(member(C[0].refer.field->var_decl_node, "data"),
+ refer_offset(C[0].refer));
+ }
+ dest_addr = gg_cast(build_pointer_type(dest_type), dest_addr);
+
+ tree A_value;
+ if( refer_is_clean(A[0]) )
+ {
+ A_value = get_binary_value_tree(dest_type,
+ NULL, // No rdigits
+ A[0].field,
+ integer_zero_node);
+ }
+ else
+ {
+ A_value = get_binary_value_tree(dest_type,
+ NULL, // No rdigits
+ A[0].field,
+ refer_offset(A[0]));
+ }
+
+ tree B_value;
+ if( refer_is_clean(A[1]) )
+ {
+ B_value = get_binary_value_tree(dest_type,
+ NULL, // No rdigits
+ A[1].field,
+ integer_zero_node);
+ }
+ else
+ {
+ B_value = get_binary_value_tree(dest_type,
+ NULL, // No rdigits
+ A[1].field,
+ refer_offset(A[1]));
+ }
+
+ gg_assign( gg_indirect(dest_addr),
+ gg_add( A_value,
+ B_value));
+ }
+ }
+ else
+ {
+ // We need to calculate the sum of all the A[] terms using term_type as
+ // the intermediate type:
+
+ tree sum = gg_define_variable(term_type);
+ tree addend = gg_define_variable(term_type);
+ get_binary_value( sum,
+ NULL,
+ A[0].field,
+ refer_offset(A[0]));
+
+ // Add in the rest of them:
+ for(size_t i=1; i<nA; i++)
+ {
+ get_binary_value( addend,
+ NULL,
+ A[i].field,
+ refer_offset(A[i]));
+ gg_assign(sum, gg_add(sum, addend));
+ }
+
+ // We now either accumulate into C[n] or assign to C[n]:
+ for(size_t i=0; i<nC; i++ )
+ {
+ tree dest_addr = gg_add(member(C[i].refer.field->var_decl_node,
+ "data"),
+ refer_offset(C[i].refer));
+ tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
+ if( format == giving_e )
+ {
+ // We are assigning
+ gg_assign( gg_indirect(ptr),
+ gg_cast(dest_type, sum));
+ }
+ else
+ {
+ // We are accumulating
+ gg_assign( gg_indirect(ptr),
+ gg_add( gg_indirect(ptr),
+ gg_cast(dest_type, sum)));
+ }
}
}
retval = true;
}
-
- //gg_insert_into_assembler("# DUBNER addition END ");
}
return retval;
}
size_t nB, cbl_refer_t *B,
cbl_arith_format_t format)
{
+ /* SUBTRACT A FROM D: nC==1, nA==1, nB==0: D -= A.
+ SUBTRACT A B C FROM D: nC==1, nA==3, nB==0: D -= (A + B + C)
+ SUBTRACT A B C FROM D E nC==2, nA==3
+ SUBTRACT A B C FROM D GIVING X Y
+ nC==2, nA==3, nB==1 */
bool retval = false;
- if( all_results_binary(nC, C) )
+ if( all_refers_integer(nA, A)
+ && all_refers_integer(nB, B)
+ && all_results_integer(nC, C) )
{
Analyze();
// All targets are non-PICTURE binaries:
if( term_type )
{
// All the terms are things we can work with.
+ // All the numbers are integers without rdigits
+ if( nC == 1
+ && nA == 1
+ && nB <= 1
+ )
+ {
+ // This is the simplest case of all. Just subtract A from C.
+ tree dest_type = tree_type_from_size(
+ C[0].refer.field->data.capacity(),
+ 0);
+ tree A_value;
+ if( refer_is_clean(A[0]) )
+ {
+ A_value = get_binary_value_tree(dest_type,
+ NULL, // No rdigits
+ A[0].field,
+ integer_zero_node);
+ }
+ else
+ {
+ A_value = get_binary_value_tree(dest_type,
+ NULL, // No rdigits
+ A[0].field,
+ refer_offset(A[0]));
+ }
+ if( format == giving_e )
+ {
+ // Make C = B - A
+ tree dest_addr;
+ if( refer_is_clean(C[0].refer) )
+ {
+ dest_addr = member(C[0].refer.field->var_decl_node, "data");
+ }
+ else
+ {
+ dest_addr = gg_add(member(C[0].refer.field->var_decl_node, "data"),
+ refer_offset(C[0].refer));
+ }
+ dest_addr = gg_cast(build_pointer_type(dest_type), dest_addr);
- // We need to calculate the sum of all the A[] terms using term_type as
- // the intermediate type:
-
- tree sum = gg_define_variable(term_type);
- tree addend = gg_define_variable(term_type);
- get_binary_value(sum, NULL, A[0].field, refer_offset(A[0]));
+ tree B_value;
+ if( refer_is_clean(B[0]) )
+ {
+ B_value = get_binary_value_tree(dest_type,
+ NULL, // No rdigits
+ B[0].field,
+ integer_zero_node);
+ }
+ else
+ {
+ B_value = get_binary_value_tree(dest_type,
+ NULL, // No rdigits
+ B[0].field,
+ refer_offset(B[0]));
+ }
- // Add in the rest of them:
- for(size_t i=1; i<nA; i++)
- {
- get_binary_value(sum, NULL, A[i].field, refer_offset(A[i]));
- gg_assign(sum, gg_add(sum, addend));
+ gg_assign( gg_indirect(dest_addr),
+ gg_cast(dest_type, gg_subtract( B_value,
+ A_value)));
+ }
+ else
+ {
+ // Make C = C - A
+ if( refer_is_clean(C[0].refer) )
+ {
+ tree dest_addr = member(C[0].refer.field->var_decl_node,
+ "data");
+ tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
+ // We are subtracting from memory
+ gg_assign( gg_indirect(ptr),
+ gg_subtract( gg_indirect(ptr),
+ A_value));
+ }
+ else
+ {
+ tree dest_addr = gg_add(member(C[0].refer.field->var_decl_node,
+ "data"),
+ refer_offset(C[0].refer));
+ tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
+ // We are subtracting from memory
+ gg_assign( gg_indirect(ptr),
+ gg_subtract( gg_indirect(ptr),
+ A_value));
+ }
+ }
}
- //gg_printf("The intermediate sum is %ld\n", gg_cast(LONG, sum), NULL_TREE);
-
- if( format == giving_e )
+ else
{
- // We now subtract the sum from B[0]
- get_binary_value(addend, NULL, B[0].field, refer_offset(B[0]));
- gg_assign(sum, gg_subtract(addend, sum));
- }
+ // We need to calculate the sum of all the A[] terms using term_type as
+ // the intermediate type:
+
+ tree sum = gg_define_variable(term_type);
+ tree addend = gg_define_variable(term_type);
+ get_binary_value(sum, NULL, A[0].field, refer_offset(A[0]));
+
+ // Add in the rest of them:
+ for(size_t i=1; i<nA; i++)
+ {
+ get_binary_value(addend, NULL, A[i].field, refer_offset(A[i]));
+ gg_assign(sum, gg_add(sum, addend));
+ }
+ //gg_printf("The intermediate sum is %ld\n", gg_cast(LONG, sum), NULL_TREE);
- // We now either accumulate into C[n] or assign to C[n]:
- for(size_t i=0; i<nC; i++ )
- {
- tree dest_type = tree_type_from_size(C[i].refer.field->data.capacity(), 0);
- tree dest_addr = gg_add(member(C[i].refer.field->var_decl_node, "data"),
- refer_offset(C[i].refer));
- tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
if( format == giving_e )
{
- // We are assigning
- gg_assign( gg_indirect(ptr),
- gg_cast(dest_type, sum));
+ // We now subtract the sum from B[0]
+ get_binary_value(addend, NULL, B[0].field, refer_offset(B[0]));
+ gg_assign(sum, gg_subtract(addend, sum));
}
- else
+
+ // We now either accumulate into C[n] or assign to C[n]:
+ for(size_t i=0; i<nC; i++ )
{
- // We are subtracting the sum from C[i]
- gg_assign( gg_indirect(ptr),
- gg_subtract(gg_indirect(ptr),
- gg_cast(dest_type, sum)));
+ tree dest_type = tree_type_from_size(C[i].refer.field->data.capacity(), 0);
+ tree dest_addr = gg_add(member(C[i].refer.field->var_decl_node, "data"),
+ refer_offset(C[i].refer));
+ tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
+ if( format == giving_e )
+ {
+ // We are assigning
+ gg_assign( gg_indirect(ptr),
+ gg_cast(dest_type, sum));
+ }
+ else
+ {
+ // We are subtracting the sum from C[i]
+ gg_assign( gg_indirect(ptr),
+ gg_subtract(gg_indirect(ptr),
+ gg_cast(dest_type, sum)));
+ }
}
}
retval = true;
size_t nB, cbl_refer_t *B)
{
bool retval = false;
- if( all_results_binary(nC, C) )
+ if( all_results_integer(nC, C) )
{
Analyze();
// All targets are non-PICTURE binaries:
const cbl_refer_t &remainder)
{
bool retval = false;
- if( all_results_binary(nC, C) )
+ if( all_results_integer(nC, C) )
{
Analyze();
// All targets are non-PICTURE binaries:
bool handled = false;
- if( fast_add( nC, C,
- nA, A,
- format) )
+ if( !error && !not_error && fast_add(nC, C,
+ nA, A,
+ format) )
{
handled = true;
}
SHOW_PARSE_END
}
- if( fast_multiply(nC, C,
- nA, A,
- nB, B) )
+ if( !error && !not_error && fast_multiply(nC, C,
+ nA, A,
+ nB, B) )
{
}
SHOW_PARSE_END
}
- if( fast_divide(nC, C,
- nA, A,
- nB, B,
- remainder) )
+ if( !error && !not_error && fast_divide(nC, C,
+ nA, A,
+ nB, B,
+ remainder) )
{
}
bool handled = false;
- if( fast_subtract(nC, C,
- nA, A,
- nB, B,
- format) )
+ if( !error && !not_error && fast_subtract(nC, C,
+ nA, A,
+ nB, B,
+ format) )
{
handled = true;
}
return retval;
}
-static tree tree_type_from_field(const cbl_field_t *field);
+//static tree tree_type_from_field(const cbl_field_t *field);
-void
-get_binary_value( tree value,
- tree rdigits,
- cbl_field_t *field,
- tree field_offset,
- tree hilo
- )
+tree
+get_binary_value_tree(tree return_type,
+ tree rdigits,
+ cbl_field_t *field,
+ tree field_offset,
+ tree hilo
+ )
{
- Analyze();
+ tree retval;
+
if( hilo )
{
gg_assign(hilo, integer_zero_node);
// Very special case:
if( strcmp(field->name, "ZEROS") == 0 )
{
- gg_assign(value, gg_cast(TREE_TYPE(value), integer_zero_node));
+ retval = gg_cast(return_type, integer_zero_node);
if( rdigits )
{
gg_assign(rdigits, gg_cast(TREE_TYPE(rdigits), integer_zero_node));
}
- return;
+ return retval;
}
static tree pointer = gg_define_variable( UCHAR_P,
{
case FldLiteralN:
{
- if( SCALAR_FLOAT_TYPE_P(value) )
+ if( return_type == FLOAT )
{
cbl_internal_error("cannot get %<float%> value from %s", field->name);
}
gg_assign(rdigits, build_int_cst_type(TREE_TYPE(rdigits),
field->data.rdigits));
}
- tree dest_type = TREE_TYPE(value);
- tree source_type = tree_type_from_field(field);
-
- gg_assign(value,
- gg_cast(dest_type,
- gg_indirect( gg_cast(build_pointer_type(source_type),
- gg_get_address_of(field->data_decl_node)))));
+ // tree source_type = tree_type_from_field(field);
+ // retval = gg_cast(return_type,
+ // gg_indirect( gg_cast(build_pointer_type(source_type),
+ // gg_get_address_of(field->data_decl_node))));
+ retval = gg_cast(return_type, field->data_decl_node);
}
-
break;
}
case FldNumericDisplay:
{
- Analyzer.Message("FldNumericDisplay");
const charmap_t *charmap = __gg__get_charmap(field->codeset.encoding);
int stride = charmap->stride();
build_int_cst_type( TREE_TYPE(rdigits),
get_scaled_rdigits(field)));
}
- gg_assign(value, build_int_cst_type(TREE_TYPE(value),
- 0x7FFFFFFFFFFFFFFFUL));
+ retval = build_int_cst_type(return_type, 0x7FFFFFFFFFFFFFFFUL);
}
ELSE
{
IF( digit, eq_op, build_int_cst(UCHAR, DEGENERATE_LOW_VALUE) )
{
- // We are dealing with LOW-VALUE
+ // We are dealing with LOW-VALUE
if( hilo )
{
gg_assign(hilo, integer_minus_one_node);
build_int_cst_type(INT, field->codeset.encoding),
NULL_TREE));
// Assign the value we got from the string to our "return" value:
- gg_assign(value, gg_cast(TREE_TYPE(value), val128));
+
+ // Note that cppcheck can't understand the run-time IF()
+ // cppcheck-suppress redundantAssignment
+ retval = gg_cast(return_type, val128);
}
ENDIF
}
{
// As of this writing, the source value is big-endian
// We have to convert it to a little-endian destination.
+ tree value = gg_define_variable(return_type);
tree dest = gg_cast(build_pointer_type(UCHAR), gg_get_address_of(value));
tree source = get_data_address(field, field_offset);
- size_t dest_nbytes = gg_sizeof(value);
+ size_t dest_nbytes = TREE_INT_CST_LOW(TYPE_SIZE_UNIT(return_type));
size_t source_nbytes = field->data.capacity();
if( debugging )
if( field->attr & signable_e )
{
IF( gg_array_value(gg_cast(build_pointer_type(SCHAR), source)),
- lt_op,
+ lt_op,
gg_cast(SCHAR, integer_zero_node) )
{
gg_assign(extension, build_int_cst_type(UCHAR, 0xFF));
hex_dump(dest, dest_nbytes);
gg_printf("\n", NULL_TREE);
}
+ retval = value;
break;
}
}
}
tree source_address = get_data_address(field, field_offset);
- tree dest_type = TREE_TYPE(value);
tree source_type = tree_type_from_size( field->data.capacity(),
field->attr & signable_e);
if( debugging && rdigits)
gg_printf("get_binary_value bin5 rdigits: %d\n", rdigits, NULL_TREE);
}
- gg_assign(value,
- gg_cast(dest_type,
- gg_indirect(gg_cast( build_pointer_type(source_type),
- source_address ))));
+ retval = gg_cast(return_type,
+ gg_indirect(gg_cast( build_pointer_type(source_type),
+ source_address )));
break;
}
build_int_cst_type( TREE_TYPE(rdigits),
get_scaled_rdigits(field)));
}
- tree dest_type = TREE_TYPE(value);
-
- gg_assign(value,
- gg_cast(dest_type,
- gg_call_expr(INT128,
+ tree value = gg_define_variable(return_type);
+ gg_assign(value, gg_cast(return_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)));
+ retval = value;
break;
}
gg_assign(rdigits,
gg_cast( TREE_TYPE(rdigits), integer_zero_node));
}
- gg_assign(value,
- gg_cast(TREE_TYPE(value),
- gg_call_expr( INT128,
- "__gg__integer_from_float128",
- gg_get_address_of(field->var_decl_node),
- NULL_TREE)));
+ tree value = gg_define_variable(return_type);
+ gg_assign(value, gg_cast(return_type,
+ gg_call_expr( INT128,
+ "__gg__integer_from_float128",
+ gg_get_address_of(field->var_decl_node),
+ NULL_TREE)));
needs_scaling = false;
+ retval = value;
break;
}
{
if( field->data.rdigits < 0 )
{
+ // Hey, Dubner!
+ // Should that test be != 0 rather than < 0? Maybe not; this routine
+ // is supposed to be for integers.
+ tree value = gg_define_variable(return_type);
+ gg_assign(value, retval);
scale_by_power_of_ten_N(value, -field->data.rdigits);
+ retval = value;
}
}
}
+ return retval;
+ }
+
+tree
+get_binary_value_tree(tree return_type,
+ tree rdigits,
+ const cbl_refer_t &refer,
+ tree hilo
+ )
+ {
+ tree retval;
+ if( refer_is_clean(refer) )
+ {
+ retval = get_binary_value_tree(return_type,
+ rdigits,
+ refer.field,
+ integer_zero_node,
+ hilo);
+ }
+ else
+ {
+ retval = get_binary_value_tree(return_type,
+ rdigits,
+ refer.field,
+ refer_offset(refer),
+ hilo);
+ }
+ return retval;
+ }
+
+void
+get_binary_value( tree value,
+ tree rdigits,
+ cbl_field_t *field,
+ tree field_offset,
+ tree hilo
+ )
+ {
+ tree return_type = TREE_TYPE(value);
+ gg_assign(value, get_binary_value_tree( return_type,
+ rdigits,
+ field,
+ field_offset,
+ hilo ));
}
+#if 0
static tree
tree_type_from_field(const cbl_field_t *field)
{
gcc_assert(field);
return tree_type_from_size(field->data.capacity(), field->attr & signable_e);
}
+#endif
tree
get_data_address( cbl_field_t *field,
// like.
return true;
}
-
+
return !refer.all
&& !refer.addr_of
&& !refer.nsubscript()
#endif
return retval;
}
+
+bool
+is_pure_integer(const cbl_field_t *field)
+ {
+ // Check to see if field is suitable for fast arithmetic. That is, it is
+ // a native binary integer with no fixed-point decimal places:
+ bool retval = false;
+ switch( field->type )
+ {
+ case FldIndex:
+ case FldPointer:
+ case FldLiteralN:
+ retval = true;
+ break;
+
+ case FldNumericBin5:
+ if( !(field->attr & intermediate_e) && field->data.rdigits == 0 )
+ {
+ // This is a pure integer, with no rdigits
+ switch(field->data.capacity())
+ {
+ case 1:
+ case 2:
+ case 4:
+ case 8:
+ case 16:
+ // These are the sizes we know how to handle
+ retval = true;
+ break;
+ }
+ }
+ break;
+
+ case FldAlphanumeric:
+ if( strcmp(field->name, "ZEROS") == 0 )
+ {
+ retval = true;
+ }
+ break;
+
+ case FldInvalid:
+ case FldGroup:
+ case FldNumericBinary:
+ case FldFloat:
+ case FldPacked:
+ case FldNumericDisplay:
+ case FldNumericEdited:
+ case FldAlphaEdited:
+ case FldLiteralA:
+ case FldClass:
+ case FldConditional:
+ case FldForward:
+ case FldSwitch:
+ case FldDisplay:
+ break;
+ }
+ return retval;
+ }
projects / thirdparty / gcc.git / commitdiff
