subprogram. */
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;
VEC(tree,gc) *gnu_actual_vec = NULL;
tree gnu_before_list = NULL_TREE;
tree gnu_after_list = NULL_TREE;
tree gnu_call;
- bool went_into_elab_proc = false;
gcc_assert (TREE_CODE (gnu_subprog_type) == FUNCTION_TYPE);
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
else
gnat_formal = First_Formal_With_Extras (Entity (Name (gnat_node)));
- /* If we are translating a statement, open a new nesting level that will
- surround it to declare the temporaries created for the call. */
- if (Nkind (gnat_node) == N_Procedure_Call_Statement || gnu_target)
- {
- start_stmt_group ();
- gnat_pushlevel ();
- }
-
- /* The lifetime of the temporaries created for the call ends with the call
- so we can give them the scope of the elaboration routine at top level. */
- else if (!current_function_decl)
- {
- current_function_decl = TREE_VALUE (gnu_elab_proc_stack);
- went_into_elab_proc = true;
- }
-
/* 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
&& (gnu_name_type = gnat_to_gnu_type (Etype (gnat_name)))
&& !addressable_p (gnu_name, gnu_name_type))
{
- tree gnu_orig = gnu_name, gnu_temp, gnu_stmt;
+ tree gnu_copy = gnu_name;
- /* Do not issue warnings for CONSTRUCTORs since this is not a copy
- but sort of an instantiation for them. */
- if (TREE_CODE (gnu_name) == CONSTRUCTOR)
- ;
-
- /* If the type is passed by reference, a copy is not allowed. */
- else if (TREE_ADDRESSABLE (gnu_formal_type))
- post_error ("misaligned actual cannot be passed by reference",
- gnat_actual);
+ /* If the type is by_reference, a copy is not allowed. */
+ if (Is_By_Reference_Type (Etype (gnat_formal)))
+ 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
TREE_TYPE (gnu_name))))
gnu_name = convert (gnu_name_type, gnu_name);
- /* Create an explicit temporary holding the copy. This ensures that
- its lifetime is as narrow as possible around a statement. */
- gnu_temp = create_var_decl (create_tmp_var_name ("A"), NULL_TREE,
- TREE_TYPE (gnu_name), NULL_TREE, false,
- false, false, false, NULL, Empty);
- DECL_ARTIFICIAL (gnu_temp) = 1;
- DECL_IGNORED_P (gnu_temp) = 1;
-
- /* But initialize it on the fly like for an implicit temporary as
- we aren't necessarily dealing with a statement. */
- gnu_stmt
- = build_binary_op (INIT_EXPR, NULL_TREE, gnu_temp, gnu_name);
- set_expr_location_from_node (gnu_stmt, gnat_actual);
-
- /* From now on, the real object is the temporary. */
- gnu_name = build2 (COMPOUND_EXPR, TREE_TYPE (gnu_name), gnu_stmt,
- gnu_temp);
+ /* Make a SAVE_EXPR to both properly account for potential side
+ 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 if needed. */
if (Ekind (gnat_formal) != E_In_Parameter)
= unchecked_convert (gnat_to_gnu_type (Etype (gnat_actual)),
gnu_actual, No_Truncation (gnat_actual));
else
- gnu_actual
- = convert (gnat_to_gnu_type (Etype (gnat_actual)), gnu_actual);
+ {
+ if (Ekind (gnat_formal) != E_Out_Parameter
+ && Do_Range_Check (gnat_actual))
+ gnu_actual = emit_range_check (gnu_actual, Etype (gnat_formal),
+ gnat_actual);
+
+ /* 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. */
+ if (TREE_CODE (gnu_actual) != SAVE_EXPR)
+ gnu_actual = convert (gnat_to_gnu_type (Etype (gnat_actual)),
+ gnu_actual);
+ }
/* Make sure that the actual is in range of the formal's type. */
if (Ekind (gnat_formal) != E_Out_Parameter
/* If we have not saved a GCC object for the formal, it means it is an
Out parameter not passed by reference and that need not be copied in.
- Otherwise, first see if the parameter is passed by reference. */
+ 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))
{
- gnu_actual = convert (gnu_formal_type, gnu_actual);
-
/* If this is 'Null_Parameter, pass a zero descriptor. */
if ((TREE_CODE (gnu_actual) == INDIRECT_REF
|| TREE_CODE (gnu_actual) == UNCONSTRAINED_ARRAY_REF)
gnu_name_list = tree_cons (NULL_TREE, gnu_name, gnu_name_list);
if (!(gnu_formal && TREE_CODE (gnu_formal) == PARM_DECL))
- {
- /* Make sure side-effects are evaluated before the call. */
- if (TREE_SIDE_EFFECTS (gnu_name))
- append_to_statement_list (gnu_name, &gnu_before_list);
- continue;
- }
-
- gnu_actual = convert (gnu_formal_type, gnu_actual);
+ continue;
/* If this is 'Null_Parameter, pass a zero even though we are
dereferencing it. */
VEC_safe_push (tree, gc, gnu_actual_vec, gnu_actual);
}
- 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_temp, gnu_stmt;
/* The call sequence must contain one and only one call, even though
- the function is pure. Save the result into a temporary. */
- gnu_temp = create_var_decl (create_tmp_var_name ("R"), NULL_TREE,
- TREE_TYPE (gnu_call), NULL_TREE, false,
- false, false, false, NULL, Empty);
- DECL_ARTIFICIAL (gnu_temp) = 1;
- DECL_IGNORED_P (gnu_temp) = 1;
-
- gnu_stmt
- = build_binary_op (INIT_EXPR, NULL_TREE, gnu_temp, gnu_call);
- set_expr_location_from_node (gnu_stmt, gnat_node);
-
- /* Add the call statement to the list and start from its result. */
- append_to_statement_list (gnu_stmt, &gnu_before_list);
- gnu_call = gnu_temp;
-
+ 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;
+ gnu_name = TREE_CHAIN (gnu_name))
+ if (TREE_SIDE_EFFECTS (TREE_VALUE (gnu_name)))
+ append_to_statement_list (TREE_VALUE (gnu_name),
+ &gnu_before_list);
}
if (Nkind (Name (gnat_node)) == N_Explicit_Dereference)
= length == 1
? gnu_call
: build_component_ref (gnu_call, NULL_TREE,
- TREE_PURPOSE (gnu_cico_list), false);
+ TREE_PURPOSE (scalar_return_list),
+ false);
/* If the actual is a conversion, get the inner expression, which
will be the real destination, and convert the result to the
append_to_statement_list (gnu_after_list, &gnu_before_list);
- add_stmt (gnu_before_list);
- gnat_poplevel ();
- return end_stmt_group ();
+ return gnu_before_list;
}
\f
/* Subroutine of gnat_to_gnu to translate gnat_node, an
conversion of the input to the calc_type (if necessary). */
gnu_zero = convert (gnu_in_basetype, integer_zero_node);
- gnu_result = gnat_protect_expr (gnu_result);
+ gnu_result = protect_multiple_eval (gnu_result);
gnu_conv = convert (calc_type, gnu_result);
gnu_comp
- = fold_build2 (GE_EXPR, boolean_type_node, gnu_result, gnu_zero);
+ = fold_build2 (GE_EXPR, integer_type_node, gnu_result, gnu_zero);
gnu_add_pred_half
= fold_build2 (PLUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
gnu_subtract_pred_half
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
tree a2_is_null = convert (result_type, boolean_false_node);
tree t1 = TREE_TYPE (a1);
tree t2 = TREE_TYPE (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 = gnat_protect_expr (a1);
+ a1 = protect_multiple_eval (a1);
if (a2_side_effects_p)
- a2 = gnat_protect_expr (a2);
+ a2 = protect_multiple_eval (a2);
/* Process each dimension separately and compare the lengths. If any
dimension has a length known to be zero, set LENGTH_ZERO_P to true
tree ub1 = TYPE_MAX_VALUE (TYPE_DOMAIN (t1));
tree lb2 = TYPE_MIN_VALUE (TYPE_DOMAIN (t2));
tree ub2 = TYPE_MAX_VALUE (TYPE_DOMAIN (t2));
- tree length1 = size_binop (PLUS_EXPR, size_binop (MINUS_EXPR, ub1, lb1),
- size_one_node);
- tree length2 = size_binop (PLUS_EXPR, size_binop (MINUS_EXPR, ub2, lb2),
- size_one_node);
+ 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 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. */
a2 = convert (type, a2);
}
- comparison = fold_build2 (EQ_EXPR, result_type, a1, a2);
- if (EXPR_P (comparison))
- SET_EXPR_LOCATION (comparison, input_location);
-
- result
- = build_binary_op (TRUTH_ANDIF_EXPR, result_type, result, comparison);
+ 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. */
/* For subtraction, add the modulus back if we are negative. */
else if (op_code == MINUS_EXPR)
{
- result = gnat_protect_expr (result);
+ result = protect_multiple_eval (result);
result = fold_build3 (COND_EXPR, op_type,
fold_build2 (LT_EXPR, boolean_type_node, result,
convert (op_type, integer_zero_node)),
/* For the other operations, subtract the modulus if we are >= it. */
else
{
- result = gnat_protect_expr (result);
+ result = protect_multiple_eval (result);
result = fold_build3 (COND_EXPR, op_type,
fold_build2 (GE_EXPR, boolean_type_node,
result, modulus),
{
/* Latch malloc's return value and get a pointer to the aligning field
first. */
- tree storage_ptr = gnat_protect_expr (malloc_ptr);
+ tree storage_ptr = protect_multiple_eval (malloc_ptr);
tree aligning_record_addr
= convert (build_pointer_type (aligning_type), storage_ptr);
and return the address with a COMPOUND_EXPR. */
if (init)
{
- result = gnat_protect_expr (result);
+ result = protect_multiple_eval (result);
result
= build2 (COMPOUND_EXPR, TREE_TYPE (result),
build_binary_op
t = TREE_OPERAND (t, 0);
break;
- case COMPOUND_EXPR:
- t = TREE_OPERAND (t, 1);
- break;
-
case CONSTRUCTOR:
TREE_ADDRESSABLE (t) = 1;
return true;
OSDN Git Service
