Commit 47625858 by Arnaud Charlet

Revert previous change, unintended.

From-SVN: r195805
parent a44bbd48
......@@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2012, Free Software Foundation, Inc. *
* Copyright (C) 1992-2013, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
......@@ -507,5 +507,11 @@ do { \
#define LOOP_STMT_BOTTOM_COND_P(NODE) TREE_LANG_FLAG_0 (LOOP_STMT_CHECK (NODE))
#define LOOP_STMT_TOP_UPDATE_P(NODE) TREE_LANG_FLAG_1 (LOOP_STMT_CHECK (NODE))
/* Optimization hints on loops. */
#define LOOP_STMT_NO_UNROLL(NODE) TREE_LANG_FLAG_2 (LOOP_STMT_CHECK (NODE))
#define LOOP_STMT_UNROLL(NODE) TREE_LANG_FLAG_3 (LOOP_STMT_CHECK (NODE))
#define LOOP_STMT_NO_VECTOR(NODE) TREE_LANG_FLAG_4 (LOOP_STMT_CHECK (NODE))
#define LOOP_STMT_VECTOR(NODE) TREE_LANG_FLAG_5 (LOOP_STMT_CHECK (NODE))
#define EXIT_STMT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 0)
#define EXIT_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 1)
......@@ -2908,12 +2908,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
{
Node_Id full_definition = Declaration_Node (gnat_entity);
Node_Id record_definition = Type_Definition (full_definition);
Node_Id gnat_constr;
Entity_Id gnat_field;
tree gnu_field, gnu_field_list = NULL_TREE;
tree gnu_get_parent;
tree gnu_field, gnu_field_list = NULL_TREE, gnu_get_parent;
/* Set PACKED in keeping with gnat_to_gnu_field. */
const int packed
int packed
= Is_Packed (gnat_entity)
? 1
: Component_Alignment (gnat_entity) == Calign_Storage_Unit
......@@ -2923,13 +2921,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& Known_RM_Size (gnat_entity)))
? -2
: 0;
const bool has_discr = Has_Discriminants (gnat_entity);
const bool has_rep = Has_Specified_Layout (gnat_entity);
const bool is_extension
bool has_discr = Has_Discriminants (gnat_entity);
bool has_rep = Has_Specified_Layout (gnat_entity);
bool all_rep = has_rep;
bool is_extension
= (Is_Tagged_Type (gnat_entity)
&& Nkind (record_definition) == N_Derived_Type_Definition);
const bool is_unchecked_union = Is_Unchecked_Union (gnat_entity);
bool all_rep = has_rep;
bool is_unchecked_union = Is_Unchecked_Union (gnat_entity);
/* See if all fields have a rep clause. Stop when we find one
that doesn't. */
......@@ -3168,51 +3166,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
}
}
/* If we have a derived untagged type that renames discriminants in
the root type, the (stored) discriminants are a just copy of the
discriminants of the root type. This means that any constraints
added by the renaming in the derivation are disregarded as far
as the layout of the derived type is concerned. To rescue them,
we change the type of the (stored) discriminants to a subtype
with the bounds of the type of the visible discriminants. */
if (has_discr
&& !is_extension
&& Stored_Constraint (gnat_entity) != No_Elist)
for (gnat_constr = First_Elmt (Stored_Constraint (gnat_entity));
gnat_constr != No_Elmt;
gnat_constr = Next_Elmt (gnat_constr))
if (Nkind (Node (gnat_constr)) == N_Identifier
/* Ignore access discriminants. */
&& !Is_Access_Type (Etype (Node (gnat_constr)))
&& Ekind (Entity (Node (gnat_constr))) == E_Discriminant)
{
Entity_Id gnat_discr = Entity (Node (gnat_constr));
tree gnu_discr_type = gnat_to_gnu_type (Etype (gnat_discr));
tree gnu_ref
= gnat_to_gnu_entity (Original_Record_Component (gnat_discr),
NULL_TREE, 0);
/* GNU_REF must be an expression using a PLACEHOLDER_EXPR built
just above for one of the stored discriminants. */
gcc_assert (TREE_TYPE (TREE_OPERAND (gnu_ref, 0)) == gnu_type);
if (gnu_discr_type != TREE_TYPE (gnu_ref))
{
const unsigned prec = TYPE_PRECISION (TREE_TYPE (gnu_ref));
tree gnu_subtype
= TYPE_UNSIGNED (TREE_TYPE (gnu_ref))
? make_unsigned_type (prec) : make_signed_type (prec);
TREE_TYPE (gnu_subtype) = TREE_TYPE (gnu_ref);
TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
SET_TYPE_RM_MIN_VALUE (gnu_subtype,
TYPE_MIN_VALUE (gnu_discr_type));
SET_TYPE_RM_MAX_VALUE (gnu_subtype,
TYPE_MAX_VALUE (gnu_discr_type));
TREE_TYPE (gnu_ref)
= TREE_TYPE (TREE_OPERAND (gnu_ref, 1)) = gnu_subtype;
}
}
/* Add the fields into the record type and finish it up. */
components_to_record (gnu_type, Component_List (record_definition),
gnu_field_list, packed, definition, false,
......@@ -4125,10 +4078,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
tree gnu_stub_type = NULL_TREE, gnu_stub_name = NULL_TREE;
tree gnu_ext_name = create_concat_name (gnat_entity, NULL);
Entity_Id gnat_param;
enum inline_status_t inline_status
= Has_Pragma_No_Inline (gnat_entity)
? is_suppressed
: (Is_Inlined (gnat_entity) ? is_enabled : is_disabled);
bool inline_flag = Is_Inlined (gnat_entity);
bool public_flag = Is_Public (gnat_entity) || imported_p;
bool extern_flag
= (Is_Public (gnat_entity) && !definition) || imported_p;
......@@ -4684,15 +4634,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_decl
= create_subprog_decl (gnu_entity_name, gnu_ext_name, gnu_type,
gnu_param_list, inline_status,
public_flag, extern_flag, artificial_flag,
attr_list, gnat_entity);
gnu_param_list, inline_flag, public_flag,
extern_flag, artificial_flag, attr_list,
gnat_entity);
if (has_stub)
{
tree gnu_stub_decl
= create_subprog_decl (gnu_entity_name, gnu_stub_name,
gnu_stub_type, gnu_stub_param_list,
inline_status, true, extern_flag,
inline_flag, true, extern_flag,
false, attr_list, gnat_entity);
SET_DECL_FUNCTION_STUB (gnu_decl, gnu_stub_decl);
}
......@@ -5425,7 +5375,7 @@ get_minimal_subprog_decl (Entity_Id gnat_entity)
return
create_subprog_decl (gnu_entity_name, gnu_ext_name, void_ftype, NULL_TREE,
is_disabled, true, true, true, attr_list, gnat_entity);
false, true, true, true, attr_list, gnat_entity);
}
/* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is
......@@ -6014,7 +5964,7 @@ elaborate_entity (Entity_Id gnat_entity)
Present (gnat_field);
gnat_field = Next_Discriminant (gnat_field),
gnat_discriminant_expr = Next_Elmt (gnat_discriminant_expr))
/* Ignore access discriminants. */
/* ??? For now, ignore access discriminants. */
if (!Is_Access_Type (Etype (Node (gnat_discriminant_expr))))
elaborate_expression (Node (gnat_discriminant_expr),
gnat_entity, get_entity_name (gnat_field),
......@@ -7660,20 +7610,20 @@ build_subst_list (Entity_Id gnat_subtype, Entity_Id gnat_type, bool definition)
{
vec<subst_pair> gnu_list = vNULL;
Entity_Id gnat_discrim;
Node_Id gnat_constr;
Node_Id gnat_value;
for (gnat_discrim = First_Stored_Discriminant (gnat_type),
gnat_constr = First_Elmt (Stored_Constraint (gnat_subtype));
gnat_value = First_Elmt (Stored_Constraint (gnat_subtype));
Present (gnat_discrim);
gnat_discrim = Next_Stored_Discriminant (gnat_discrim),
gnat_constr = Next_Elmt (gnat_constr))
gnat_value = Next_Elmt (gnat_value))
/* Ignore access discriminants. */
if (!Is_Access_Type (Etype (Node (gnat_constr))))
if (!Is_Access_Type (Etype (Node (gnat_value))))
{
tree gnu_field = gnat_to_gnu_field_decl (gnat_discrim);
tree replacement = convert (TREE_TYPE (gnu_field),
elaborate_expression
(Node (gnat_constr), gnat_subtype,
(Node (gnat_value), gnat_subtype,
get_entity_name (gnat_discrim),
definition, true, false));
subst_pair s = {gnu_field, replacement};
......
......@@ -430,17 +430,6 @@ enum exception_info_kind
exception_column
};
/* Define the inline status of a subprogram. */
enum inline_status_t
{
/* Inlining is suppressed for the subprogram. */
is_suppressed,
/* No inlining is requested for the subprogram. */
is_disabled,
/* Inlining is requested for the subprogram. */
is_enabled
};
extern GTY(()) tree gnat_std_decls[(int) ADT_LAST];
extern GTY(()) tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
extern GTY(()) tree gnat_raise_decls_ext[(int) LAST_REASON_CODE + 1];
......@@ -729,14 +718,13 @@ extern tree create_label_decl (tree, Node_Id);
node), PARAM_DECL_LIST is the list of the subprogram arguments (a list of
PARM_DECL nodes chained through the DECL_CHAIN field).
INLINE_STATUS, PUBLIC_FLAG, EXTERN_FLAG, ARTIFICIAL_FLAG and ATTR_LIST are
INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, ARTIFICIAL_FLAG and ATTR_LIST are
used to set the appropriate fields in the FUNCTION_DECL. GNAT_NODE is
used for the position of the decl. */
extern tree create_subprog_decl (tree subprog_name, tree asm_name,
tree subprog_type, tree param_decl_list,
enum inline_status_t inline_status,
bool public_flag, bool extern_flag,
bool artificial_flag,
bool inline_flag, bool public_flag,
bool extern_flag, bool artificial_flag,
struct attrib *attr_list, Node_Id gnat_node);
/* Set up the framework for generating code for SUBPROG_DECL, a subprogram
......
......@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2013, Free Software Foundation, Inc. *
* Copyright (C) 1992-2012, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
......@@ -2621,14 +2621,14 @@ create_label_decl (tree label_name, Node_Id gnat_node)
node), PARAM_DECL_LIST is the list of the subprogram arguments (a list of
PARM_DECL nodes chained through the DECL_CHAIN field).
INLINE_STATUS, PUBLIC_FLAG, EXTERN_FLAG, ARTIFICIAL_FLAG and ATTR_LIST are
INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, ARTIFICIAL_FLAG and ATTR_LIST are
used to set the appropriate fields in the FUNCTION_DECL. GNAT_NODE is
used for the position of the decl. */
tree
create_subprog_decl (tree subprog_name, tree asm_name, tree subprog_type,
tree param_decl_list, enum inline_status_t inline_status,
bool public_flag, bool extern_flag, bool artificial_flag,
tree param_decl_list, bool inline_flag, bool public_flag,
bool extern_flag, bool artificial_flag,
struct attrib *attr_list, Node_Id gnat_node)
{
tree subprog_decl = build_decl (input_location, FUNCTION_DECL, subprog_name,
......@@ -2642,7 +2642,7 @@ create_subprog_decl (tree subprog_name, tree asm_name, tree subprog_type,
function in the current unit since it is private to the other unit.
We could inline the nested function as well but it's probably better
to err on the side of too little inlining. */
if (inline_status != is_enabled
if (!inline_flag
&& !public_flag
&& current_function_decl
&& DECL_DECLARED_INLINE_P (current_function_decl)
......@@ -2651,24 +2651,8 @@ create_subprog_decl (tree subprog_name, tree asm_name, tree subprog_type,
DECL_ARTIFICIAL (subprog_decl) = artificial_flag;
DECL_EXTERNAL (subprog_decl) = extern_flag;
switch (inline_status)
{
case is_suppressed:
DECL_UNINLINABLE (subprog_decl) = 1;
break;
case is_disabled:
break;
case is_enabled:
DECL_DECLARED_INLINE_P (subprog_decl) = 1;
DECL_NO_INLINE_WARNING_P (subprog_decl) = artificial_flag;
break;
default:
gcc_unreachable ();
}
DECL_DECLARED_INLINE_P (subprog_decl) = inline_flag;
DECL_NO_INLINE_WARNING_P (subprog_decl) = inline_flag && artificial_flag;
TREE_PUBLIC (subprog_decl) = public_flag;
TREE_READONLY (subprog_decl) = TYPE_READONLY (subprog_type);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment