|| (TREE_CODE (gnu_result) == PARM_DECL
&& DECL_BY_COMPONENT_PTR_P (gnu_result))))
{
- bool ro = DECL_POINTS_TO_READONLY_P (gnu_result);
+ const bool read_only = DECL_POINTS_TO_READONLY_P (gnu_result);
tree renamed_obj;
if (TREE_CODE (gnu_result) == PARM_DECL
we can reference the renamed object directly, since the renamed
expression has been protected against multiple evaluations. */
else if (TREE_CODE (gnu_result) == VAR_DECL
- && (renamed_obj = DECL_RENAMED_OBJECT (gnu_result)) != 0
- && (! DECL_RENAMING_GLOBAL_P (gnu_result)
+ && (renamed_obj = DECL_RENAMED_OBJECT (gnu_result))
+ && (!DECL_RENAMING_GLOBAL_P (gnu_result)
|| global_bindings_p ()))
gnu_result = renamed_obj;
else
gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
- TREE_READONLY (gnu_result) = TREE_STATIC (gnu_result) = ro;
+ if (read_only)
+ TREE_READONLY (gnu_result) = 1;
}
/* The GNAT tree has the type of a function as the type of its result. Also
static tree
call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
{
- tree gnu_result;
/* The GCC node corresponding to the GNAT subprogram name. This can either
be a FUNCTION_DECL node if we are dealing with a standard subprogram call,
or an indirect reference expression (an INDIRECT_REF node) pointing to a
subprogram. */
- tree gnu_subprog_node = gnat_to_gnu (Name (gnat_node));
+ tree gnu_subprog = gnat_to_gnu (Name (gnat_node));
/* The FUNCTION_TYPE node giving the GCC type of the subprogram. */
- tree gnu_subprog_type = TREE_TYPE (gnu_subprog_node);
- tree gnu_subprog_addr
- = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_subprog_node);
+ tree gnu_subprog_type = TREE_TYPE (gnu_subprog);
+ tree gnu_subprog_addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_subprog);
Entity_Id gnat_formal;
Node_Id gnat_actual;
tree gnu_actual_list = NULL_TREE;
tree gnu_name_list = NULL_TREE;
tree gnu_before_list = NULL_TREE;
tree gnu_after_list = NULL_TREE;
- tree gnu_subprog_call;
+ tree gnu_call;
gcc_assert (TREE_CODE (gnu_subprog_type) == FUNCTION_TYPE);
- /* If we are calling a stubbed function, make this into a raise of
- Program_Error. Elaborate all our args first. */
- if (TREE_CODE (gnu_subprog_node) == FUNCTION_DECL
- && DECL_STUBBED_P (gnu_subprog_node))
+ /* If we are calling a stubbed function, raise Program_Error, but Elaborate
+ all our args first. */
+ if (TREE_CODE (gnu_subprog) == FUNCTION_DECL && DECL_STUBBED_P (gnu_subprog))
{
+ tree call_expr = build_call_raise (PE_Stubbed_Subprogram_Called,
+ gnat_node, N_Raise_Program_Error);
+
for (gnat_actual = First_Actual (gnat_node);
Present (gnat_actual);
gnat_actual = Next_Actual (gnat_actual))
add_stmt (gnat_to_gnu (gnat_actual));
- {
- tree call_expr
- = build_call_raise (PE_Stubbed_Subprogram_Called, gnat_node,
- N_Raise_Program_Error);
+ if (Nkind (gnat_node) == N_Function_Call && !gnu_target)
+ {
+ *gnu_result_type_p = TREE_TYPE (gnu_subprog_type);
+ return build1 (NULL_EXPR, TREE_TYPE (gnu_subprog_type), call_expr);
+ }
- if (Nkind (gnat_node) == N_Function_Call && !gnu_target)
- {
- *gnu_result_type_p = TREE_TYPE (gnu_subprog_type);
- return build1 (NULL_EXPR, *gnu_result_type_p, call_expr);
- }
- else
- return call_expr;
- }
+ return call_expr;
}
/* The only way we can be making a call via an access type is if Name is an
explicit dereference. In that case, get the list of formal args from the
- type the access type is pointing to. Otherwise, get the formals from
+ type the access type is pointing to. Otherwise, get the formals from the
entity being called. */
if (Nkind (Name (gnat_node)) == N_Explicit_Dereference)
gnat_formal = First_Formal_With_Extras (Etype (Name (gnat_node)));
else if (Nkind (Name (gnat_node)) == N_Attribute_Reference)
/* Assume here that this must be 'Elab_Body or 'Elab_Spec. */
- gnat_formal = 0;
+ gnat_formal = Empty;
else
gnat_formal = First_Formal_With_Extras (Entity (Name (gnat_node)));
- /* Create the list of the actual parameters as GCC expects it, namely a chain
- of TREE_LIST nodes in which the TREE_VALUE field of each node is a
- parameter-expression and the TREE_PURPOSE field is null. Skip Out
- parameters not passed by reference and don't need to be copied in. */
+ /* Create the list of the actual parameters as GCC expects it, namely a
+ chain of TREE_LIST nodes in which the TREE_VALUE field of each node
+ is an expression and the TREE_PURPOSE field is null. But skip Out
+ parameters not passed by reference and that need not be copied in. */
for (gnat_actual = First_Actual (gnat_node);
Present (gnat_actual);
gnat_formal = Next_Formal_With_Extras (gnat_formal),
gnat_actual = Next_Actual (gnat_actual))
{
- tree gnu_formal
- = (present_gnu_tree (gnat_formal)
- ? get_gnu_tree (gnat_formal) : NULL_TREE);
+ tree gnu_formal = present_gnu_tree (gnat_formal)
+ ? get_gnu_tree (gnat_formal) : NULL_TREE;
tree gnu_formal_type = gnat_to_gnu_type (Etype (gnat_formal));
/* We must suppress conversions that can cause the creation of a
temporary in the Out or In Out case because we need the real
&& Ekind (gnat_formal) != E_In_Parameter)
|| (Nkind (gnat_actual) == N_Type_Conversion
&& Is_Composite_Type (Underlying_Type (Etype (gnat_formal)))));
- Node_Id gnat_name = (suppress_type_conversion
- ? Expression (gnat_actual) : gnat_actual);
+ Node_Id gnat_name = suppress_type_conversion
+ ? Expression (gnat_actual) : gnat_actual;
tree gnu_name = gnat_to_gnu (gnat_name), gnu_name_type;
tree gnu_actual;
/* If it's possible we may need to use this expression twice, make sure
- that any side-effects are handled via SAVE_EXPRs. Likewise if we need
+ that any side-effects are handled via SAVE_EXPRs; likewise if we need
to force side-effects before the call.
??? This is more conservative than we need since we don't need to do
this for pass-by-ref with no conversion. */
post_error
("misaligned actual cannot be passed by reference", gnat_actual);
- /* For users of Starlet we issue a warning because the
- interface apparently assumes that by-ref parameters
- outlive the procedure invocation. The code still
- will not work as intended, but we cannot do much
- better since other low-level parts of the back-end
- would allocate temporaries at will because of the
- misalignment if we did not do so here. */
+ /* For users of Starlet we issue a warning because the interface
+ apparently assumes that by-ref parameters outlive the procedure
+ invocation. The code still will not work as intended, but we
+ cannot do much better since low-level parts of the back-end
+ would allocate temporaries at will because of the misalignment
+ if we did not do so here. */
else if (Is_Valued_Procedure (Entity (Name (gnat_node))))
{
post_error
gnu_name = convert (gnu_name_type, gnu_name);
/* Make a SAVE_EXPR to both properly account for potential side
- effects and handle the creation of a temporary copy. Special
- code in gnat_gimplify_expr ensures that the same temporary is
- used as the object and copied back after the call if needed. */
+ effects and handle the creation of a temporary. Special code
+ in gnat_gimplify_expr ensures that the same temporary is used
+ as the object and copied back after the call if needed. */
gnu_name = build1 (SAVE_EXPR, TREE_TYPE (gnu_name), gnu_name);
TREE_SIDE_EFFECTS (gnu_name) = 1;
- /* Set up to move the copy back to the original. */
+ /* Set up to move the copy back to the original if needed. */
if (Ekind (gnat_formal) != E_In_Parameter)
{
tree stmt = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_copy,
/* We may have suppressed a conversion to the Etype of the actual
since the parent is a procedure call. So put it back here.
??? We use the reverse order compared to the case above because
- of an awkward interaction with the check and actually don't put
- back the conversion at all if a check is emitted. This is also
- done for the conversion to the formal's type just below. */
+ of an awkward interaction with the check. */
if (TREE_CODE (gnu_actual) != SAVE_EXPR)
gnu_actual = convert (gnat_to_gnu_type (Etype (gnat_actual)),
gnu_actual);
gnu_name);
/* If we have not saved a GCC object for the formal, it means it is an
- Out parameter not passed by reference and that does not need to be
- copied in. Otherwise, look at the PARM_DECL to see if it is passed by
- reference. */
+ Out parameter not passed by reference and that need not be copied in.
+ Otherwise, first see if the PARM_DECL is passed by reference. */
if (gnu_formal
&& TREE_CODE (gnu_formal) == PARM_DECL
&& DECL_BY_REF_P (gnu_formal))
&& TREE_CODE (gnu_formal) == PARM_DECL
&& DECL_BY_DESCRIPTOR_P (gnu_formal))
{
- /* If arg is 'Null_Parameter, pass zero descriptor. */
+ /* If this is 'Null_Parameter, pass a zero descriptor. */
if ((TREE_CODE (gnu_actual) == INDIRECT_REF
|| TREE_CODE (gnu_actual) == UNCONSTRAINED_ARRAY_REF)
&& TREE_PRIVATE (gnu_actual))
- gnu_actual = convert (DECL_ARG_TYPE (get_gnu_tree (gnat_formal)),
- integer_zero_node);
+ gnu_actual
+ = convert (DECL_ARG_TYPE (gnu_formal), integer_zero_node);
else
gnu_actual = build_unary_op (ADDR_EXPR, NULL_TREE,
fill_vms_descriptor (gnu_actual,
}
else
{
- tree gnu_actual_size = TYPE_SIZE (TREE_TYPE (gnu_actual));
+ tree gnu_size;
if (Ekind (gnat_formal) != E_In_Parameter)
gnu_name_list = tree_cons (NULL_TREE, gnu_name, gnu_name_list);
- if (!gnu_formal || TREE_CODE (gnu_formal) != PARM_DECL)
+ if (!(gnu_formal && TREE_CODE (gnu_formal) == PARM_DECL))
continue;
/* If this is 'Null_Parameter, pass a zero even though we are
dereferencing it. */
- else if (TREE_CODE (gnu_actual) == INDIRECT_REF
- && TREE_PRIVATE (gnu_actual)
- && host_integerp (gnu_actual_size, 1)
- && 0 >= compare_tree_int (gnu_actual_size,
- BITS_PER_WORD))
+ if (TREE_CODE (gnu_actual) == INDIRECT_REF
+ && TREE_PRIVATE (gnu_actual)
+ && (gnu_size = TYPE_SIZE (TREE_TYPE (gnu_actual)))
+ && TREE_CODE (gnu_size) == INTEGER_CST
+ && compare_tree_int (gnu_size, BITS_PER_WORD) <= 0)
gnu_actual
= unchecked_convert (DECL_ARG_TYPE (gnu_formal),
convert (gnat_type_for_size
- (tree_low_cst (gnu_actual_size, 1),
- 1),
+ (TREE_INT_CST_LOW (gnu_size), 1),
integer_zero_node),
false);
else
gnu_actual_list = tree_cons (NULL_TREE, gnu_actual, gnu_actual_list);
}
- gnu_subprog_call = build_call_list (TREE_TYPE (gnu_subprog_type),
- gnu_subprog_addr,
- nreverse (gnu_actual_list));
- set_expr_location_from_node (gnu_subprog_call, gnat_node);
+ gnu_call = build_call_list (TREE_TYPE (gnu_subprog_type), gnu_subprog_addr,
+ nreverse (gnu_actual_list));
+ set_expr_location_from_node (gnu_call, gnat_node);
/* If it's a function call, the result is the call expression unless a target
is specified, in which case we copy the result into the target and return
the assignment statement. */
if (Nkind (gnat_node) == N_Function_Call)
{
- gnu_result = gnu_subprog_call;
+ tree gnu_result = gnu_call;
enum tree_code op_code;
/* If the function returns an unconstrained array or by direct reference,
{
tree gnu_name;
- gnu_subprog_call = save_expr (gnu_subprog_call);
+ /* The call sequence must contain one and only one call, even though
+ the function is const or pure. So force a SAVE_EXPR. */
+ gnu_call = build1 (SAVE_EXPR, TREE_TYPE (gnu_call), gnu_call);
+ TREE_SIDE_EFFECTS (gnu_call) = 1;
gnu_name_list = nreverse (gnu_name_list);
/* If any of the names had side-effects, ensure they are all
evaluated before the call. */
- for (gnu_name = gnu_name_list; gnu_name;
+ for (gnu_name = gnu_name_list;
+ gnu_name;
gnu_name = TREE_CHAIN (gnu_name))
if (TREE_SIDE_EFFECTS (TREE_VALUE (gnu_name)))
append_to_statement_list (TREE_VALUE (gnu_name),
either the result of the function if there is only a single such
parameter or the appropriate field from the record returned. */
tree gnu_result
- = length == 1 ? gnu_subprog_call
- : build_component_ref (gnu_subprog_call, NULL_TREE,
+ = length == 1
+ ? gnu_call
+ : build_component_ref (gnu_call, NULL_TREE,
TREE_PURPOSE (scalar_return_list),
false);
/* If the result is a padded type, remove the padding. */
if (TYPE_IS_PADDING_P (TREE_TYPE (gnu_result)))
- gnu_result = convert (TREE_TYPE (TYPE_FIELDS
- (TREE_TYPE (gnu_result))),
- gnu_result);
+ gnu_result
+ = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_result))),
+ gnu_result);
/* If the actual is a type conversion, the real target object is
denoted by the inner Expression and we need to convert the
scalar_return_list = TREE_CHAIN (scalar_return_list);
gnu_name_list = TREE_CHAIN (gnu_name_list);
}
- }
+ }
else
- append_to_statement_list (gnu_subprog_call, &gnu_before_list);
+ append_to_statement_list (gnu_call, &gnu_before_list);
append_to_statement_list (gnu_after_list, &gnu_before_list);
+
return gnu_before_list;
}
\f
&& !truncatep)
{
REAL_VALUE_TYPE half_minus_pred_half, pred_half;
- tree gnu_conv, gnu_zero, gnu_comp, gnu_saved_result, calc_type;
+ tree gnu_conv, gnu_zero, gnu_comp, calc_type;
tree gnu_pred_half, gnu_add_pred_half, gnu_subtract_pred_half;
const struct real_format *fmt;
gnu_pred_half = build_real (calc_type, pred_half);
/* If the input is strictly negative, subtract this value
- and otherwise add it from the input. For 0.5, the result
+ and otherwise add it from the input. For 0.5, the result
is exactly between 1.0 and the machine number preceding 1.0
- (for calc_type). Since the last bit of 1.0 is even, this 0.5
+ (for calc_type). Since the last bit of 1.0 is even, this 0.5
will round to 1.0, while all other number with an absolute
- value less than 0.5 round to 0.0. For larger numbers exactly
+ value less than 0.5 round to 0.0. For larger numbers exactly
halfway between integers, rounding will always be correct as
the true mathematical result will be closer to the higher
- integer compared to the lower one. So, this constant works
+ integer compared to the lower one. So, this constant works
for all floating-point numbers.
The reason to use the same constant with subtract/add instead
conversion of the input to the calc_type (if necessary). */
gnu_zero = convert (gnu_in_basetype, integer_zero_node);
- gnu_saved_result = save_expr (gnu_result);
- gnu_conv = convert (calc_type, gnu_saved_result);
- gnu_comp = build2 (GE_EXPR, integer_type_node,
- gnu_saved_result, gnu_zero);
+ gnu_result = protect_multiple_eval (gnu_result);
+ gnu_conv = convert (calc_type, gnu_result);
+ gnu_comp
+ = fold_build2 (GE_EXPR, integer_type_node, gnu_result, gnu_zero);
gnu_add_pred_half
- = build2 (PLUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
+ = fold_build2 (PLUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
gnu_subtract_pred_half
- = build2 (MINUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
- gnu_result = build3 (COND_EXPR, calc_type, gnu_comp,
- gnu_add_pred_half, gnu_subtract_pred_half);
+ = fold_build2 (MINUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
+ gnu_result = fold_build3 (COND_EXPR, calc_type, gnu_comp,
+ gnu_add_pred_half, gnu_subtract_pred_half);
}
if (TREE_CODE (gnu_base_type) == INTEGER_TYPE
else
gnu_result = convert (gnu_base_type, gnu_result);
- /* Finally, do the range check if requested. Note that if the
- result type is a modular type, the range check is actually
- an overflow check. */
-
+ /* Finally, do the range check if requested. Note that if the result type
+ is a modular type, the range check is actually an overflow check. */
if (rangep
|| (TREE_CODE (gnu_base_type) == INTEGER_TYPE
&& TYPE_MODULAR_P (gnu_base_type) && overflowp))
protect_multiple_eval (tree exp)
{
tree type = TREE_TYPE (exp);
+ enum tree_code code = TREE_CODE (exp);
/* If EXP has no side effects, we theoritically don't need to do anything.
However, we may be recursively passed more and more complex expressions
Similarly, if we're indirectly referencing something, we only
need to protect the address since the data itself can't change
in these situations. */
- if (TREE_CODE (exp) == NON_LVALUE_EXPR
- || CONVERT_EXPR_P (exp)
- || TREE_CODE (exp) == VIEW_CONVERT_EXPR
- || TREE_CODE (exp) == INDIRECT_REF
- || TREE_CODE (exp) == UNCONSTRAINED_ARRAY_REF)
- return build1 (TREE_CODE (exp), type,
- protect_multiple_eval (TREE_OPERAND (exp, 0)));
+ if (code == NON_LVALUE_EXPR
+ || CONVERT_EXPR_CODE_P (code)
+ || code == VIEW_CONVERT_EXPR
+ || code == INDIRECT_REF
+ || code == UNCONSTRAINED_ARRAY_REF)
+ return build1 (code, type, protect_multiple_eval (TREE_OPERAND (exp, 0)));
+
+ /* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer.
+ This may be more efficient, but will also allow us to more easily find
+ the match for the PLACEHOLDER_EXPR. */
+ if (code == COMPONENT_REF
+ && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
+ return build3 (code, type, protect_multiple_eval (TREE_OPERAND (exp, 0)),
+ TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2));
/* If this is a fat pointer or something that can be placed in a register,
just make a SAVE_EXPR. Likewise for a CALL_EXPR as large objects are
directly be filled by the callee. */
if (TYPE_IS_FAT_POINTER_P (type)
|| TYPE_MODE (type) != BLKmode
- || TREE_CODE (exp) == CALL_EXPR)
+ || code == CALL_EXPR)
return save_expr (exp);
/* Otherwise reference, protect the address and dereference. */
return ref;
}
- TREE_READONLY (result) = TREE_READONLY (ref);
-
- /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS attached to the initial
- expression may not be sustained across some paths, such as the way via
- build1 for INDIRECT_REF. We re-populate those flags here for the general
- case, which is consistent with the GCC version of this routine.
+ /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS set on the initial expression
+ may not be sustained across some paths, such as the way via build1 for
+ INDIRECT_REF. We reset those flags here in the general case, which is
+ consistent with the GCC version of this routine.
Special care should be taken regarding TREE_SIDE_EFFECTS, because some
- paths introduce side effects where there was none initially (e.g. calls
- to save_expr), and we also want to keep track of that. */
-
- TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
+ paths introduce side-effects where there was none initially (e.g. if a
+ SAVE_EXPR is built) and we also want to keep track of that. */
+ TREE_READONLY (result) = TREE_READONLY (ref);
TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (ref);
+ TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
return result;
}
-/* Wrapper around maybe_stabilize_reference, for common uses without
- lvalue restrictions and without need to examine the success
- indication. */
+/* Wrapper around maybe_stabilize_reference, for common uses without lvalue
+ restrictions and without the need to examine the success indication. */
static tree
gnat_stabilize_reference (tree ref, bool force)
to a const array but whose index contains side-effects. But we can
ignore things that are actual constant or that already have been
handled by this function. */
-
if (TREE_CONSTANT (e) || code == SAVE_EXPR)
return e;
switch (TREE_CODE_CLASS (code))
{
case tcc_exceptional:
- case tcc_type:
case tcc_declaration:
case tcc_comparison:
- case tcc_statement:
case tcc_expression:
case tcc_reference:
case tcc_vl_exp:
us to more easily find the match for the PLACEHOLDER_EXPR. */
if (code == COMPONENT_REF
&& TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
- result = build3 (COMPONENT_REF, type,
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 0),
- force),
- TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
+ result
+ = build3 (code, type,
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
+ TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
+ /* If the expression has side-effects, then encase it in a SAVE_EXPR
+ so that it will only be evaluated once. */
+ /* The tcc_reference and tcc_comparison classes could be handled as
+ below, but it is generally faster to only evaluate them once. */
else if (TREE_SIDE_EFFECTS (e) || force)
return save_expr (e);
else
return e;
break;
- case tcc_constant:
- /* Constants need no processing. In fact, we should never reach
- here. */
- return e;
-
case tcc_binary:
/* Recursively stabilize each operand. */
- result = build2 (code, type,
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 1),
- force));
+ result
+ = build2 (code, type,
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), force));
break;
case tcc_unary:
/* Recursively stabilize each operand. */
- result = build1 (code, type,
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 0),
- force));
+ result
+ = build1 (code, type,
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force));
break;
default:
gcc_unreachable ();
}
+ /* See similar handling in maybe_stabilize_reference. */
TREE_READONLY (result) = TREE_READONLY (e);
-
- TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
+ TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
+
return result;
}
\f
#include "gigi.h"
static tree find_common_type (tree, tree);
-static bool contains_save_expr_p (tree);
-static tree contains_null_expr (tree);
static tree compare_arrays (tree, tree, tree);
static tree nonbinary_modular_operation (enum tree_code, tree, tree, tree);
static tree build_simple_component_ref (tree, tree, tree, bool);
return NULL_TREE;
}
\f
-/* See if EXP contains a SAVE_EXPR in a position where we would
- normally put it.
+/* Return an expression tree representing an equality comparison of A1 and A2,
+ two objects of type ARRAY_TYPE. The result should be of type RESULT_TYPE.
- ??? This is a real kludge, but is probably the best approach short
- of some very general solution. */
-
-static bool
-contains_save_expr_p (tree exp)
-{
- switch (TREE_CODE (exp))
- {
- case SAVE_EXPR:
- return true;
-
- case ADDR_EXPR: case INDIRECT_REF:
- case COMPONENT_REF:
- CASE_CONVERT: case VIEW_CONVERT_EXPR:
- return contains_save_expr_p (TREE_OPERAND (exp, 0));
-
- case CONSTRUCTOR:
- {
- tree value;
- unsigned HOST_WIDE_INT ix;
-
- FOR_EACH_CONSTRUCTOR_VALUE (CONSTRUCTOR_ELTS (exp), ix, value)
- if (contains_save_expr_p (value))
- return true;
- return false;
- }
-
- default:
- return false;
- }
-}
-\f
-/* See if EXP contains a NULL_EXPR in an expression we use for sizes. Return
- it if so. This is used to detect types whose sizes involve computations
- that are known to raise Constraint_Error. */
-
-static tree
-contains_null_expr (tree exp)
-{
- tree tem;
-
- if (TREE_CODE (exp) == NULL_EXPR)
- return exp;
-
- switch (TREE_CODE_CLASS (TREE_CODE (exp)))
- {
- case tcc_unary:
- return contains_null_expr (TREE_OPERAND (exp, 0));
-
- case tcc_comparison:
- case tcc_binary:
- tem = contains_null_expr (TREE_OPERAND (exp, 0));
- if (tem)
- return tem;
-
- return contains_null_expr (TREE_OPERAND (exp, 1));
-
- case tcc_expression:
- switch (TREE_CODE (exp))
- {
- case SAVE_EXPR:
- return contains_null_expr (TREE_OPERAND (exp, 0));
-
- case COND_EXPR:
- tem = contains_null_expr (TREE_OPERAND (exp, 0));
- if (tem)
- return tem;
-
- tem = contains_null_expr (TREE_OPERAND (exp, 1));
- if (tem)
- return tem;
-
- return contains_null_expr (TREE_OPERAND (exp, 2));
-
- default:
- return 0;
- }
-
- default:
- return 0;
- }
-}
-\f
-/* Return an expression tree representing an equality comparison of
- A1 and A2, two objects of ARRAY_TYPE. The returned expression should
- be of type RESULT_TYPE
-
- Two arrays are equal in one of two ways: (1) if both have zero length
- in some dimension (not necessarily the same dimension) or (2) if the
- lengths in each dimension are equal and the data is equal. We perform the
- length tests in as efficient a manner as possible. */
+ Two arrays are equal in one of two ways: (1) if both have zero length in
+ some dimension (not necessarily the same dimension) or (2) if the lengths
+ in each dimension are equal and the data is equal. We perform the length
+ tests in as efficient a manner as possible. */
static tree
compare_arrays (tree result_type, tree a1, tree a2)
tree result = convert (result_type, integer_one_node);
tree a1_is_null = convert (result_type, integer_zero_node);
tree a2_is_null = convert (result_type, integer_zero_node);
+ bool a1_side_effects_p = TREE_SIDE_EFFECTS (a1);
+ bool a2_side_effects_p = TREE_SIDE_EFFECTS (a2);
bool length_zero_p = false;
+ /* If either operand has side-effects, they have to be evaluated only once
+ in spite of the multiple references to the operand in the comparison. */
+ if (a1_side_effects_p)
+ a1 = protect_multiple_eval (a1);
+
+ if (a2_side_effects_p)
+ a2 = protect_multiple_eval (a2);
+
/* Process each dimension separately and compare the lengths. If any
dimension has a size known to be zero, set SIZE_ZERO_P to 1 to
suppress the comparison of the data. */
tree bt = get_base_type (TREE_TYPE (lb1));
tree length1 = fold_build2 (MINUS_EXPR, bt, ub1, lb1);
tree length2 = fold_build2 (MINUS_EXPR, bt, ub2, lb2);
- tree nbt;
- tree tem;
tree comparison, this_a1_is_null, this_a2_is_null;
+ tree nbt, tem;
+ bool btem;
/* If the length of the first array is a constant, swap our operands
unless the length of the second array is the constant zero.
tem = ub1, ub1 = ub2, ub2 = tem;
tem = length1, length1 = length2, length2 = tem;
tem = a1_is_null, a1_is_null = a2_is_null, a2_is_null = tem;
+ btem = a1_side_effects_p, a1_side_effects_p = a2_side_effects_p,
+ a2_side_effects_p = btem;
}
/* If the length of this dimension in the second array is the constant
tree type = find_common_type (TREE_TYPE (a1), TREE_TYPE (a2));
if (type)
- a1 = convert (type, a1), a2 = convert (type, a2);
+ {
+ a1 = convert (type, a1),
+ a2 = convert (type, a2);
+ }
result = build_binary_op (TRUTH_ANDIF_EXPR, result_type, result,
fold_build2 (EQ_EXPR, result_type, a1, a2));
-
}
/* The result is also true if both sizes are zero. */
a1_is_null, a2_is_null),
result);
- /* If either operand contains SAVE_EXPRs, they have to be evaluated before
- starting the comparison above since the place it would be otherwise
- evaluated would be wrong. */
-
- if (contains_save_expr_p (a1))
+ /* If either operand has side-effects, they have to be evaluated before
+ starting the comparison above since the place they would be otherwise
+ evaluated could be wrong. */
+ if (a1_side_effects_p)
result = build2 (COMPOUND_EXPR, result_type, a1, result);
- if (contains_save_expr_p (a2))
+ if (a2_side_effects_p)
result = build2 (COMPOUND_EXPR, result_type, a2, result);
return result;
/* For subtraction, add the modulus back if we are negative. */
else if (op_code == MINUS_EXPR)
{
- result = save_expr (result);
+ result = protect_multiple_eval (result);
result = fold_build3 (COND_EXPR, op_type,
fold_build2 (LT_EXPR, integer_type_node, result,
convert (op_type, integer_zero_node)),
/* For the other operations, subtract the modulus if we are >= it. */
else
{
- result = save_expr (result);
+ result = protect_multiple_eval (result);
result = fold_build3 (COND_EXPR, op_type,
fold_build2 (GE_EXPR, integer_type_node,
result, modulus),
{
result = build1 (UNCONSTRAINED_ARRAY_REF,
TYPE_UNCONSTRAINED_ARRAY (type), operand);
- TREE_READONLY (result) = TREE_STATIC (result)
+ TREE_READONLY (result)
= TYPE_READONLY (TYPE_UNCONSTRAINED_ARRAY (type));
}
else if (TREE_CODE (operand) == ADDR_EXPR)
if (TREE_SIDE_EFFECTS (val))
side_effects = true;
-
- /* Propagate an NULL_EXPR from the size of the type. We won't ever
- be executing the code we generate here in that case, but handle it
- specially to avoid the compiler blowing up. */
- if (TREE_CODE (type) == RECORD_TYPE
- && (result = contains_null_expr (DECL_SIZE (obj))) != NULL_TREE)
- return build1 (NULL_EXPR, type, TREE_OPERAND (result, 0));
}
/* For record types with constant components only, sort field list
{
/* Latch malloc's return value and get a pointer to the aligning field
first. */
- tree storage_ptr = save_expr (malloc_ptr);
+ tree storage_ptr = protect_multiple_eval (malloc_ptr);
tree aligning_record_addr
= convert (build_pointer_type (aligning_type), storage_ptr);
gnat_proc, gnat_pool,
gnat_node));
- /* If we have an initial value, put the new address into a SAVE_EXPR, assign
- the value, and return the address. Do this with a COMPOUND_EXPR. */
-
+ /* If we have an initial value, protect the new address, assign the value
+ and return the address with a COMPOUND_EXPR. */
if (init)
{
- result = save_expr (result);
+ result = protect_multiple_eval (result);
result
= build2 (COMPOUND_EXPR, TREE_TYPE (result),
build_binary_op
return gnat_build_constructor (record_type, nreverse (const_list));
}
-/* Indicate that we need to make the address of EXPR_NODE and it therefore
+/* Indicate that we need to take the address of T and that it therefore
should not be allocated in a register. Returns true if successful. */
bool
-gnat_mark_addressable (tree expr_node)
+gnat_mark_addressable (tree t)
{
- while (1)
- switch (TREE_CODE (expr_node))
+ while (true)
+ switch (TREE_CODE (t))
{
case ADDR_EXPR:
case COMPONENT_REF:
case VIEW_CONVERT_EXPR:
case NON_LVALUE_EXPR:
CASE_CONVERT:
- expr_node = TREE_OPERAND (expr_node, 0);
+ t = TREE_OPERAND (t, 0);
break;
case CONSTRUCTOR:
- TREE_ADDRESSABLE (expr_node) = 1;
+ TREE_ADDRESSABLE (t) = 1;
return true;
case VAR_DECL:
case PARM_DECL:
case RESULT_DECL:
- TREE_ADDRESSABLE (expr_node) = 1;
+ TREE_ADDRESSABLE (t) = 1;
return true;
case FUNCTION_DECL:
- TREE_ADDRESSABLE (expr_node) = 1;
+ TREE_ADDRESSABLE (t) = 1;
return true;
case CONST_DECL:
- return (DECL_CONST_CORRESPONDING_VAR (expr_node)
- && (gnat_mark_addressable
- (DECL_CONST_CORRESPONDING_VAR (expr_node))));
+ return DECL_CONST_CORRESPONDING_VAR (t)
+ && gnat_mark_addressable (DECL_CONST_CORRESPONDING_VAR (t));
+
default:
return true;
}
git://gcc.gnu.org / gcc.git / commitdiff