}
}
- /* The GNAT tree has the type of a function as the type of its result. Also
- use the type of the result if the Etype is a subtype which is nominally
- unconstrained. But remove any padding from the resulting type. */
- if (TREE_CODE (TREE_TYPE (gnu_result)) == FUNCTION_TYPE
- || Is_Constr_Subt_For_UN_Aliased (gnat_temp_type))
- {
- gnu_result_type = TREE_TYPE (gnu_result);
- if (TYPE_IS_PADDING_P (gnu_result_type))
- gnu_result_type = TREE_TYPE (TYPE_FIELDS (gnu_result_type));
- }
-
/* If we have a constant declaration and its initializer, try to return the
latter to avoid the need to call fold in lots of places and the need for
elaboration code if this identifier is used as an initializer itself.
gnu_result = unshare_expr (DECL_INITIAL (gnu_result));
}
+ /* The GNAT tree has the type of a function set to its result type, so we
+ adjust here. Also use the type of the result if the Etype is a subtype
+ that is nominally unconstrained. Likewise if this is a deferred constant
+ of a discriminated type whose full view can be elaborated statically, to
+ avoid problematic conversions to the nominal subtype. But remove any
+ padding from the resulting type. */
+ if (TREE_CODE (TREE_TYPE (gnu_result)) == FUNCTION_TYPE
+ || Is_Constr_Subt_For_UN_Aliased (gnat_temp_type)
+ || (Ekind (gnat_temp) == E_Constant
+ && Present (Full_View (gnat_temp))
+ && Has_Discriminants (gnat_temp_type)
+ && TREE_CODE (gnu_result) == CONSTRUCTOR))
+ {
+ gnu_result_type = TREE_TYPE (gnu_result);
+ if (TYPE_IS_PADDING_P (gnu_result_type))
+ gnu_result_type = TREE_TYPE (TYPE_FIELDS (gnu_result_type));
+ }
+
*gnu_result_type_p = gnu_result_type;
return gnu_result;
static tree
Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
{
- tree gnu_prefix = gnat_to_gnu (Prefix (gnat_node));
- tree gnu_type = TREE_TYPE (gnu_prefix);
- tree gnu_expr, gnu_result_type, gnu_result = error_mark_node;
+ tree gnu_prefix, gnu_type, gnu_expr;
+ tree gnu_result_type, gnu_result = error_mark_node;
bool prefix_unused = false;
+ /* ??? If this is an access attribute for a public subprogram to be used in
+ a dispatch table, do not translate its type as it's useless there and the
+ parameter types might be incomplete types coming from a limited with. */
+ if (Ekind (Etype (gnat_node)) == E_Access_Subprogram_Type
+ && Is_Dispatch_Table_Entity (Etype (gnat_node))
+ && Nkind (Prefix (gnat_node)) == N_Identifier
+ && Is_Subprogram (Entity (Prefix (gnat_node)))
+ && Is_Public (Entity (Prefix (gnat_node)))
+ && !present_gnu_tree (Entity (Prefix (gnat_node))))
+ gnu_prefix = get_minimal_subprog_decl (Entity (Prefix (gnat_node)));
+ else
+ gnu_prefix = gnat_to_gnu (Prefix (gnat_node));
+ gnu_type = TREE_TYPE (gnu_prefix);
+
/* If the input is a NULL_EXPR, make a new one. */
if (TREE_CODE (gnu_prefix) == NULL_EXPR)
{
TREE_NO_TRAMPOLINE (gnu_expr) = TREE_CONSTANT (gnu_expr) = 1;
}
+ /* For 'Access, issue an error message if the prefix is a C++ method
+ since it can use a special calling convention on some platforms,
+ which cannot be propagated to the access type. */
+ else if (attribute == Attr_Access
+ && Nkind (Prefix (gnat_node)) == N_Identifier
+ && is_cplusplus_method (Entity (Prefix (gnat_node))))
+ post_error ("access to C++ constructor or member function not allowed",
+ gnat_node);
+
/* For other address attributes applied to a nested function,
find an inner ADDR_EXPR and annotate it so that we can issue
a useful warning with -Wtrampolines. */
/* Otherwise, use the do-while form with the help of a special
induction variable in the unsigned version of the base type
- or the unsigned version of the size type, whichever is the
+ or the unsigned version of sizetype, whichever is the
largest, in order to have wrap-around arithmetics for it. */
else
{
- if (TYPE_PRECISION (gnu_base_type)
- > TYPE_PRECISION (size_type_node))
+ if (TYPE_PRECISION (gnu_base_type) > TYPE_PRECISION (sizetype))
gnu_base_type = gnat_unsigned_type (gnu_base_type);
else
- gnu_base_type = size_type_node;
+ gnu_base_type = sizetype;
gnu_first = convert (gnu_base_type, gnu_first);
gnu_last = convert (gnu_base_type, gnu_last);
on the C++ optimization of the same name. The main difference is that
we disregard any semantical considerations when applying it here, the
counterpart being that we don't try to apply it to semantically loaded
- return types, i.e. types with the TREE_ADDRESSABLE flag set.
+ return types, i.e. types with the TYPE_BY_REFERENCE_P flag set.
We consider a function body of the following GENERIC form:
/* We shouldn't be applying the optimization to return types that we aren't
allowed to manipulate freely. */
- gcc_assert (!TREE_ADDRESSABLE (TREE_TYPE (TREE_TYPE (fndecl))));
+ gcc_assert (!TYPE_IS_BY_REFERENCE_P (TREE_TYPE (TREE_TYPE (fndecl))));
/* Prune the candidates that are referenced by other return values. */
data.nrv = nrv;
went_into_elab_proc = true;
}
- /* First, create the temporary for the return value if we need it: for a
- variable-sized return type if there is no target or if this is slice,
- because the gimplifier doesn't support these cases; or for a function
- with copy-in/copy-out parameters if there is no target, because we'll
- need to preserve the return value before copying back the parameters.
- This must be done before we push a new binding level around the call
- as we will pop it before copying the return value. */
+ /* First, create the temporary for the return value when:
+
+ 1. There is no target and the function has copy-in/copy-out parameters,
+ because we need to preserve the return value before copying back the
+ parameters.
+
+ 2. There is no target and this is not an object declaration, and the
+ return type has variable size, because in these cases the gimplifier
+ cannot create the temporary.
+
+ 3. There is a target and it is a slice or an array with fixed size,
+ and the return type has variable size, because the gimplifier
+ doesn't handle these cases.
+
+ This must be done before we push a binding level around the call, since
+ we will pop it before copying the return value. */
if (function_call
- && ((TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST
- && (!gnu_target || TREE_CODE (gnu_target) == ARRAY_RANGE_REF))
- || (!gnu_target && TYPE_CI_CO_LIST (gnu_subprog_type))))
+ && ((!gnu_target && TYPE_CI_CO_LIST (gnu_subprog_type))
+ || (!gnu_target
+ && Nkind (Parent (gnat_node)) != N_Object_Declaration
+ && TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST)
+ || (gnu_target
+ && (TREE_CODE (gnu_target) == ARRAY_RANGE_REF
+ || (TREE_CODE (TREE_TYPE (gnu_target)) == ARRAY_TYPE
+ && TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_target)))
+ == INTEGER_CST))
+ && TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST)))
gnu_retval = create_temporary ("R", gnu_result_type);
/* Create the list of the actual parameters as GCC expects it, namely a
;
/* If the type is passed by reference, a copy is not allowed. */
- else if (TREE_ADDRESSABLE (gnu_formal_type))
+ else if (TYPE_IS_BY_REFERENCE_P (gnu_formal_type))
post_error ("misaligned actual cannot be passed by reference",
gnat_actual);
/* The first entry is for the actual return value if this is a
function, so skip it. */
- if (TREE_VALUE (gnu_cico_list) == void_type_node)
+ if (function_call)
gnu_cico_list = TREE_CHAIN (gnu_cico_list);
if (Nkind (Name (gnat_node)) == N_Explicit_Dereference)
return value from it and update the return type. */
if (TYPE_CI_CO_LIST (gnu_subprog_type))
{
- tree gnu_elmt = value_member (void_type_node,
- TYPE_CI_CO_LIST (gnu_subprog_type));
+ tree gnu_elmt = TYPE_CI_CO_LIST (gnu_subprog_type);
gnu_call = build_component_ref (gnu_call, NULL_TREE,
TREE_PURPOSE (gnu_elmt), false);
gnu_result_type = TREE_TYPE (gnu_call);
/* Convert vector inputs to their representative array type, to fit
what the code below expects. */
- gnu_array_object = maybe_vector_array (gnu_array_object);
+ if (VECTOR_TYPE_P (TREE_TYPE (gnu_array_object)))
+ {
+ if (present_in_lhs_or_actual_p (gnat_node))
+ gnat_mark_addressable (gnu_array_object);
+ gnu_array_object = maybe_vector_array (gnu_array_object);
+ }
gnu_array_object = maybe_unconstrained_array (gnu_array_object);
gnu_result = gnat_to_gnu (Expression (gnat_node));
gnu_result_type = get_unpadded_type (Etype (gnat_node));
+ /* If this is a qualified expression for a tagged type, we mark the type
+ as used. Because of polymorphism, this might be the only reference to
+ the tagged type in the program while objects have it as dynamic type.
+ The debugger needs to see it to display these objects properly. */
+ if (kind == N_Qualified_Expression && Is_Tagged_Type (Etype (gnat_node)))
+ used_types_insert (gnu_result_type);
+
gnu_result
= convert_with_check (Etype (gnat_node), gnu_result,
Do_Overflow_Check (gnat_node),
if (Is_Elementary_Type (gnat_desig_type)
|| Is_Constrained (gnat_desig_type))
- {
- gnu_type = gnat_to_gnu_type (gnat_desig_type);
- gnu_init = convert (gnu_type, gnu_init);
- }
+ gnu_type = gnat_to_gnu_type (gnat_desig_type);
else
{
gnu_type = gnat_to_gnu_type (Etype (Expression (gnat_temp)));
if (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE)
gnu_type = TREE_TYPE (gnu_init);
-
- gnu_init = convert (gnu_type, gnu_init);
}
+
+ /* See the N_Qualified_Expression case for the rationale. */
+ if (Is_Tagged_Type (gnat_desig_type))
+ used_types_insert (gnu_type);
+
+ gnu_init = convert (gnu_type, gnu_init);
}
else
gcc_unreachable ();
the next statement that the middle-end knows how to preserve. */
if (!optimize && Comes_From_Source (gnat_node))
{
- tree stmt, label = create_label_decl (NULL_TREE);
+ tree stmt, label = create_label_decl (NULL_TREE, gnat_node);
+ DECL_IGNORED_P (label) = 1;
start_stmt_group ();
stmt = build1 (GOTO_EXPR, void_type_node, label);
set_expr_location_from_node (stmt, gnat_node);
: NULL_TREE;
tree gnu_target_desig_type = TREE_TYPE (gnu_target_type);
- if ((TYPE_DUMMY_P (gnu_target_desig_type)
+ if ((TYPE_IS_DUMMY_P (gnu_target_desig_type)
|| get_alias_set (gnu_target_desig_type) != 0)
&& (!POINTER_TYPE_P (gnu_source_type)
- || (TYPE_DUMMY_P (gnu_source_desig_type)
- != TYPE_DUMMY_P (gnu_target_desig_type))
- || (TYPE_DUMMY_P (gnu_source_desig_type)
+ || (TYPE_IS_DUMMY_P (gnu_source_desig_type)
+ != TYPE_IS_DUMMY_P (gnu_target_desig_type))
+ || (TYPE_IS_DUMMY_P (gnu_source_desig_type)
&& gnu_source_desig_type != gnu_target_desig_type)
|| !alias_sets_conflict_p
(get_alias_set (gnu_source_desig_type),
tree gnu_target_array_type
= TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_target_type)));
- if ((TYPE_DUMMY_P (gnu_target_array_type)
+ if ((TYPE_IS_DUMMY_P (gnu_target_array_type)
|| get_alias_set (gnu_target_array_type) != 0)
&& (!TYPE_IS_FAT_POINTER_P (gnu_source_type)
- || (TYPE_DUMMY_P (gnu_source_array_type)
- != TYPE_DUMMY_P (gnu_target_array_type))
- || (TYPE_DUMMY_P (gnu_source_array_type)
+ || (TYPE_IS_DUMMY_P (gnu_source_array_type)
+ != TYPE_IS_DUMMY_P (gnu_target_array_type))
+ || (TYPE_IS_DUMMY_P (gnu_source_array_type)
&& gnu_source_array_type != gnu_target_array_type)
|| !alias_sets_conflict_p
(get_alias_set (gnu_source_array_type),
N_Raise_Constraint_Error));
}
- /* If our result has side-effects and is of an unconstrained type,
- make a SAVE_EXPR so that we can be sure it will only be referenced
- once. Note we must do this before any conversions. */
+ /* If the result has side-effects and is of an unconstrained type, make a
+ SAVE_EXPR so that we can be sure it will only be referenced once. But
+ this is useless for a call to a function that returns an unconstrained
+ type with default discriminant, as we cannot compute the size of the
+ actual returned object. We must do this before any conversions. */
if (TREE_SIDE_EFFECTS (gnu_result)
+ && !(TREE_CODE (gnu_result) == CALL_EXPR
+ && TYPE_IS_PADDING_P (TREE_TYPE (gnu_result)))
&& (TREE_CODE (gnu_result_type) == UNCONSTRAINED_ARRAY_TYPE
|| CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type))))
gnu_result = gnat_stabilize_reference (gnu_result, false, NULL);
3. If the type is void or if we have no result, return error_mark_node
to show we have no result.
- 4. Finally, if the type of the result is already correct. */
+ 4. If this a call to a function that returns an unconstrained type with
+ default discriminant, return the call expression unmodified since we
+ cannot compute the size of the actual returned object.
+
+ 5. Finally, if the type of the result is already correct. */
if (Present (Parent (gnat_node))
&& (lhs_or_actual_p (gnat_node)
else if (gnu_result == error_mark_node || gnu_result_type == void_type_node)
gnu_result = error_mark_node;
- else if (gnu_result_type != TREE_TYPE (gnu_result))
+ else if (TREE_CODE (gnu_result) == CALL_EXPR
+ && TYPE_IS_PADDING_P (TREE_TYPE (gnu_result))
+ && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type)))
+ {
+ /* ??? We need to convert if the padded type has fixed size because
+ gnat_types_compatible_p will say that padded types are compatible
+ but the gimplifier will not and, therefore, will ultimately choke
+ if there isn't a conversion added early. */
+ if (TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_result))) == INTEGER_CST)
+ gnu_result = convert (gnu_result_type, gnu_result);
+ }
+
+ else if (TREE_TYPE (gnu_result) != gnu_result_type)
gnu_result = convert (gnu_result_type, gnu_result);
/* We don't need any NOP_EXPR or NON_LVALUE_EXPR on the result. */
return GS_ALL_DONE;
}
- /* Otherwise, if we are taking the address of a non-constant CONSTRUCTOR
- or of a call, explicitly create the local temporary. That's required
- if the type is passed by reference. */
- if (TREE_CODE (op) == CONSTRUCTOR || TREE_CODE (op) == CALL_EXPR)
- {
- tree mod, new_var = create_tmp_var_raw (TREE_TYPE (op), "C");
- TREE_ADDRESSABLE (new_var) = 1;
- gimple_add_tmp_var (new_var);
-
- mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, op);
- gimplify_and_add (mod, pre_p);
-
- TREE_OPERAND (expr, 0) = new_var;
- recompute_tree_invariant_for_addr_expr (expr);
- return GS_ALL_DONE;
- }
-
return GS_UNHANDLED;
case VIEW_CONVERT_EXPR:
OSDN Git Service
