Skip to content

R
riscv-gcc-1
Commit a8e05f92 by Eric Botcazou Committed by Eric Botcazou
Options

decl.c (gnat_to_gnu_entity): Compute is_type predicate on entry. 

	* gcc-interface/decl.c (gnat_to_gnu_entity): Compute is_type predicate
	on entry.  Defer common processing for types.  Reorder and clean up.
	Compute the equivalent GNAT node and the default size for types only.
	<E_Modular_Integer_Type>: Directly use Esize for the type's precision.
	<E_Access_Type>: For an unconstrained designated type, do not pretend
	that a dummy type is always made.
	<all> Fix nits in comments.
	(validate_size): Fix formatting nits and comments.
	(set_rm_size): Likewise.
	* gcc-interface/utils.c (create_param_decl): Replace bogus argument
	passed to TARGET_PROMOTE_PROTOTYPES hook.

From-SVN: r146549
parent 3ad606bc
Showing with 156 additions and 155 deletions
gcc/ada/ChangeLog
2009-04-22 Eric Botcazou <ebotcazou@adacore.com> 2009-04-22 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity): Compute is_type predicate
on entry. Defer common processing for types. Reorder and clean up.
Compute the equivalent GNAT node and the default size for types only.
<E_Modular_Integer_Type>: Directly use Esize for the type's precision.
<E_Access_Type>: For an unconstrained designated type, do not pretend
that a dummy type is always made.
<all> Fix nits in comments.
(validate_size): Fix formatting nits and comments.
(set_rm_size): Likewise.
* gcc-interface/utils.c (create_param_decl): Replace bogus argument
passed to TARGET_PROMOTE_PROTOTYPES hook.
2009-04-22 Eric Botcazou <ebotcazou@adacore.com>
* fe.h (Get_External_Name): Declare. * fe.h (Get_External_Name): Declare.
* gcc-interface/gigi.h (concat_id_with_name): Rename to... * gcc-interface/gigi.h (concat_id_with_name): Rename to...
(concat_name): ...this. (concat_name): ...this.
...@@ -9,13 +23,13 @@ ...@@ -9,13 +23,13 @@
types associated with unconstrained array types. types associated with unconstrained array types.
(make_aligning_type): Adjust for above renaming. (make_aligning_type): Adjust for above renaming.
(maybe_pad_type): Likewise. (maybe_pad_type): Likewise.
(components_to_record): Likewise.  Use get_identifier_with_length for (components_to_record): Likewise. Use get_identifier_with_length for
the encoding of the variant. the encoding of the variant.
(get_entity_name): Use get_identifier_with_length. (get_entity_name): Use get_identifier_with_length.
(create_concat_name): Likewise.  Use Get_External_Name if no suffix. (create_concat_name): Likewise. Use Get_External_Name if no suffix.
Do not fiddle with Name_Buffer. Do not fiddle with Name_Buffer.
(concat_id_with_name): Rename to... (concat_id_with_name): Rename to...
(concat_name): ...this.  Use get_identifier_with_length.  Do not fiddle (concat_name): ...this. Use get_identifier_with_length. Do not fiddle
with Name_Buffer. with Name_Buffer.
* gcc-interface/utils.c (rest_of_record_type_compilation): Adjust for * gcc-interface/utils.c (rest_of_record_type_compilation): Adjust for
above renaming. above renaming.
......
gcc/ada/gcc-interface/decl.c
...@@ -172,9 +172,14 @@ static void rest_of_type_decl_compilation_no_defer (tree); ...@@ -172,9 +172,14 @@ static void rest_of_type_decl_compilation_no_defer (tree);
tree tree
gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
{ {
Entity_Id gnat_equiv_type = Gigi_Equivalent_Type (gnat_entity); /* Contains the kind of the input GNAT node. */
const Entity_Kind kind = Ekind (gnat_entity);
/* True if this is a type. */
const bool is_type = IN (kind, Type_Kind);
/* For a type, contains the equivalent GNAT node to be used in gigi. */
Entity_Id gnat_equiv_type = Empty;
/* Temporary used to walk the GNAT tree. */
Entity_Id gnat_temp; Entity_Id gnat_temp;
Entity_Kind kind = Ekind (gnat_entity);
/* Contains the GCC DECL node which is equivalent to the input GNAT node. /* Contains the GCC DECL node which is equivalent to the input GNAT node.
This node will be associated with the GNAT node by calling at the end This node will be associated with the GNAT node by calling at the end
of the `switch' statement. */ of the `switch' statement. */
...@@ -201,30 +206,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -201,30 +206,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* True if this entity is to be considered as imported. */ /* True if this entity is to be considered as imported. */
bool imported_p = (Is_Imported (gnat_entity) bool imported_p = (Is_Imported (gnat_entity)
&& No (Address_Clause (gnat_entity))); && No (Address_Clause (gnat_entity)));
unsigned int esize, align = 0; /* Size and alignment of the GCC node, if meaningful. */
unsigned int esize = 0, align = 0;
/* Contains the list of attributes directly attached to the entity. */
struct attrib *attr_list = NULL; struct attrib *attr_list = NULL;
/* First compute a default value for the size of the entity. */
if (Known_Esize (gnat_entity) && UI_Is_In_Int_Range (Esize (gnat_entity)))
{
unsigned int max_esize;
esize = UI_To_Int (Esize (gnat_entity));
if (IN (kind, Float_Kind))
max_esize = fp_prec_to_size (LONG_DOUBLE_TYPE_SIZE);
else if (IN (kind, Access_Kind))
max_esize = POINTER_SIZE * 2;
else
max_esize = LONG_LONG_TYPE_SIZE;
esize = MIN (esize, max_esize);
}
else
esize = LONG_LONG_TYPE_SIZE;
/* Since a use of an Itype is a definition, process it as such if it /* Since a use of an Itype is a definition, process it as such if it
is not in a with'ed unit. */ is not in a with'ed unit. */
if (!definition if (!definition
&& is_type
&& Is_Itype (gnat_entity) && Is_Itype (gnat_entity)
&& !present_gnu_tree (gnat_entity) && !present_gnu_tree (gnat_entity)
&& In_Extended_Main_Code_Unit (gnat_entity)) && In_Extended_Main_Code_Unit (gnat_entity))
...@@ -267,21 +257,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -267,21 +257,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
} }
} }
/* This abort means the entity has an incorrect scope, i.e. that its /* This abort means the Itype has an incorrect scope, i.e. that its
scope does not correspond to the subprogram it is declared in. */ scope does not correspond to the subprogram it is declared in. */
gcc_unreachable (); gcc_unreachable ();
} }
/* If the entiy is not present, something went badly wrong. */
gcc_assert (Present (gnat_entity));
/* If we've already processed this entity, return what we got last time. /* If we've already processed this entity, return what we got last time.
If we are defining the node, we should not have already processed it. If we are defining the node, we should not have already processed it.
In that case, we will abort below when we try to save a new GCC tree In that case, we will abort below when we try to save a new GCC tree
for this object. We also need to handle the case of getting a dummy for this object. We also need to handle the case of getting a dummy
type when a Full_View exists. */ type when a Full_View exists. */
if (present_gnu_tree (gnat_entity) if ((!definition || (is_type && imported_p))
&& (!definition || (Is_Type (gnat_entity) && imported_p))) && present_gnu_tree (gnat_entity))
{ {
gnu_decl = get_gnu_tree (gnat_entity); gnu_decl = get_gnu_tree (gnat_entity);
...@@ -311,46 +298,76 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -311,46 +298,76 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|| kind == E_Access_Subtype))); || kind == E_Access_Subtype)));
/* The RM size must be specified for all discrete and fixed-point types. */ /* The RM size must be specified for all discrete and fixed-point types. */
gcc_assert (!IN (kind, Discrete_Or_Fixed_Point_Kind) gcc_assert (!(IN (kind, Discrete_Or_Fixed_Point_Kind)
|| !Unknown_RM_Size (gnat_entity)); && Unknown_RM_Size (gnat_entity)));
/* If we get here, it means we have not yet done anything with this entity.
If we are not defining it, it must be a type or an entity that is defined
elsewhere or externally, otherwise we should have defined it already. */
gcc_assert (definition
|| type_annotate_only
|| is_type
|| kind == E_Discriminant
|| kind == E_Component
|| kind == E_Label
|| (kind == E_Constant && Present (Full_View (gnat_entity)))
|| Is_Public (gnat_entity));
/* Get the name of the entity and set up the line number and filename of /* Get the name of the entity and set up the line number and filename of
the original definition for use in any decl we make. */ the original definition for use in any decl we make. */
gnu_entity_name = get_entity_name (gnat_entity); gnu_entity_name = get_entity_name (gnat_entity);
Sloc_to_locus (Sloc (gnat_entity), &input_location); Sloc_to_locus (Sloc (gnat_entity), &input_location);
/* If we get here, it means we have not yet done anything with this
entity. If we are not defining it here, it must be external,
otherwise we should have defined it already. */
gcc_assert (definition || Is_Public (gnat_entity) || type_annotate_only
|| kind == E_Discriminant || kind == E_Component
|| kind == E_Label
|| (kind == E_Constant && Present (Full_View (gnat_entity)))
|| IN (kind, Type_Kind));
/* For cases when we are not defining (i.e., we are referencing from /* For cases when we are not defining (i.e., we are referencing from
another compilation unit) public entities, show we are at global level another compilation unit) public entities, show we are at global level
for the purpose of computing scopes. Don't do this for components or for the purpose of computing scopes. Don't do this for components or
discriminants since the relevant test is whether or not the record is discriminants since the relevant test is whether or not the record is
being defined. */ being defined. */
if (!definition if (!definition
&& Is_Public (gnat_entity)
&& !Is_Statically_Allocated (gnat_entity)
&& kind != E_Component && kind != E_Component
&& kind != E_Discriminant) && kind != E_Discriminant
&& Is_Public (gnat_entity)
&& !Is_Statically_Allocated (gnat_entity))
force_global++, this_global = true; force_global++, this_global = true;
/* Handle any attributes directly attached to the entity. */ /* Handle any attributes directly attached to the entity. */
if (Has_Gigi_Rep_Item (gnat_entity)) if (Has_Gigi_Rep_Item (gnat_entity))
prepend_attributes (gnat_entity, &attr_list); prepend_attributes (gnat_entity, &attr_list);
/* Machine_Attributes on types are expected to be propagated to subtypes. /* Do some common processing for types. */
The corresponding Gigi_Rep_Items are only attached to the first subtype if (is_type)
though, so we handle the propagation here. */ {
if (Is_Type (gnat_entity) && Base_Type (gnat_entity) != gnat_entity /* Compute the equivalent type to be used in gigi. */
&& !Is_First_Subtype (gnat_entity) gnat_equiv_type = Gigi_Equivalent_Type (gnat_entity);
&& Has_Gigi_Rep_Item (First_Subtype (Base_Type (gnat_entity))))
prepend_attributes (First_Subtype (Base_Type (gnat_entity)), &attr_list); /* Machine_Attributes on types are expected to be propagated to
subtypes. The corresponding Gigi_Rep_Items are only attached
to the first subtype though, so we handle the propagation here. */
if (Base_Type (gnat_entity) != gnat_entity
&& !Is_First_Subtype (gnat_entity)
&& Has_Gigi_Rep_Item (First_Subtype (Base_Type (gnat_entity))))
prepend_attributes (First_Subtype (Base_Type (gnat_entity)),
&attr_list);
/* Compute a default value for the size of the type. */
if (Known_Esize (gnat_entity)
&& UI_Is_In_Int_Range (Esize (gnat_entity)))
{
unsigned int max_esize;
esize = UI_To_Int (Esize (gnat_entity));
if (IN (kind, Float_Kind))
max_esize = fp_prec_to_size (LONG_DOUBLE_TYPE_SIZE);
else if (IN (kind, Access_Kind))
max_esize = POINTER_SIZE * 2;
else
max_esize = LONG_LONG_TYPE_SIZE;
esize = MIN (esize, max_esize);
}
else
esize = LONG_LONG_TYPE_SIZE;
}
switch (kind) switch (kind)
{ {
...@@ -695,8 +712,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -695,8 +712,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& !TREE_OVERFLOW (TYPE_SIZE (gnu_type)))) && !TREE_OVERFLOW (TYPE_SIZE (gnu_type))))
&& (!Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity)) && (!Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
|| !Is_Array_Type (Etype (gnat_entity))) || !Is_Array_Type (Etype (gnat_entity)))
&& !Present (Renamed_Object (gnat_entity)) && No (Renamed_Object (gnat_entity))
&& !Present (Address_Clause (gnat_entity))) && No (Address_Clause (gnat_entity)))
gnu_size = bitsize_unit_node; gnu_size = bitsize_unit_node;
/* If this is an object with no specified size and alignment, and /* If this is an object with no specified size and alignment, and
...@@ -1333,8 +1350,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1333,8 +1350,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
for these. */ for these. */
if (TREE_CODE (gnu_decl) == CONST_DECL if (TREE_CODE (gnu_decl) == CONST_DECL
&& (definition || Sloc (gnat_entity) > Standard_Location) && (definition || Sloc (gnat_entity) > Standard_Location)
&& ((Is_Public (gnat_entity) && ((Is_Public (gnat_entity) && No (Address_Clause (gnat_entity)))
&& !Present (Address_Clause (gnat_entity)))
|| !optimize || !optimize
|| Address_Taken (gnat_entity) || Address_Taken (gnat_entity)
|| Is_Aliased (gnat_entity) || Is_Aliased (gnat_entity)
...@@ -1395,7 +1411,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1395,7 +1411,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
break; break;
case E_Enumeration_Type: case E_Enumeration_Type:
/* A special case, for the types Character and Wide_Character in /* A special case: for the types Character and Wide_Character in
Standard, we do not list all the literals. So if the literals Standard, we do not list all the literals. So if the literals
are not specified, make this an unsigned type. */ are not specified, make this an unsigned type. */
if (No (First_Literal (gnat_entity))) if (No (First_Literal (gnat_entity)))
...@@ -1403,24 +1419,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1403,24 +1419,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_type = make_unsigned_type (esize); gnu_type = make_unsigned_type (esize);
TYPE_NAME (gnu_type) = gnu_entity_name; TYPE_NAME (gnu_type) = gnu_entity_name;
/* Set TYPE_STRING_FLAG for Ada Character and Wide_Character types. /* Set TYPE_STRING_FLAG for Character and Wide_Character types.
This is needed by the DWARF-2 back-end to distinguish between This is needed by the DWARF-2 back-end to distinguish between
unsigned integer types and character types. */ unsigned integer types and character types. */
TYPE_STRING_FLAG (gnu_type) = 1; TYPE_STRING_FLAG (gnu_type) = 1;
break; break;
} }
/* Normal case of non-character type, or non-Standard character type */ /* Normal case of non-character type or non-Standard character type. */
{ {
/* Here we have a list of enumeral constants in First_Literal. /* Here we have a list of enumeral constants in First_Literal.
We make a CONST_DECL for each and build into GNU_LITERAL_LIST We make a CONST_DECL for each and build into GNU_LITERAL_LIST
the list to be places into TYPE_FIELDS. Each node in the list the list to be placed into TYPE_FIELDS. Each node in the list
is a TREE_LIST node whose TREE_VALUE is the literal name is a TREE_LIST whose TREE_VALUE is the literal name and whose
and whose TREE_PURPOSE is the value of the literal. TREE_PURPOSE is the value of the literal. */
Esize contains the number of bits needed to represent the enumeral
type, Type_Low_Bound also points to the first literal and
Type_High_Bound points to the last literal. */
Entity_Id gnat_literal; Entity_Id gnat_literal;
tree gnu_literal_list = NULL_TREE; tree gnu_literal_list = NULL_TREE;
...@@ -1451,8 +1463,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1451,8 +1463,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TYPE_VALUES (gnu_type) = nreverse (gnu_literal_list); TYPE_VALUES (gnu_type) = nreverse (gnu_literal_list);
/* Note that the bounds are updated at the end of this function /* Note that the bounds are updated at the end of this function
because to avoid an infinite recursion when we get the bounds of to avoid an infinite recursion since they refer to the type. */
this type, since those bounds are objects of this type. */
} }
break; break;
...@@ -1469,19 +1480,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1469,19 +1480,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* For modular types, make the unsigned type of the proper number /* For modular types, make the unsigned type of the proper number
of bits and then set up the modulus, if required. */ of bits and then set up the modulus, if required. */
tree gnu_modulus, gnu_high = NULL_TREE; tree gnu_modulus, gnu_high = NULL_TREE;
enum machine_mode mode;
/* Packed array types are supposed to be subtypes only. */ /* Packed array types are supposed to be subtypes only. */
gcc_assert (!Is_Packed_Array_Type (gnat_entity)); gcc_assert (!Is_Packed_Array_Type (gnat_entity));
/* Find the smallest mode at least ESIZE bits wide and make a class gnu_type = make_unsigned_type (esize);
using that mode. */
for (mode = GET_CLASS_NARROWEST_MODE (MODE_INT);
GET_MODE_BITSIZE (mode) < esize;
mode = GET_MODE_WIDER_MODE (mode))
;
gnu_type = make_unsigned_type (GET_MODE_BITSIZE (mode));
/* Get the modulus in this type. If it overflows, assume it is because /* Get the modulus in this type. If it overflows, assume it is because
it is equal to 2**Esize. Note that there is no overflow checking it is equal to 2**Esize. Note that there is no overflow checking
...@@ -1497,24 +1500,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1497,24 +1500,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
convert (gnu_type, integer_one_node)); convert (gnu_type, integer_one_node));
} }
/* If we have to set TYPE_PRECISION different from its natural value, /* If the upper bound is not maximal, make an extra subtype. */
make a subtype to do do. Likewise if there is a modulus and if (gnu_high
it is not one greater than TYPE_MAX_VALUE. */ && !tree_int_cst_equal (gnu_high, TYPE_MAX_VALUE (gnu_type)))
if (TYPE_PRECISION (gnu_type) != esize
|| (TYPE_MODULAR_P (gnu_type)
&& !tree_int_cst_equal (TYPE_MAX_VALUE (gnu_type), gnu_high)))
{ {
tree gnu_subtype = make_node (INTEGER_TYPE); tree gnu_subtype = make_unsigned_type (esize);
TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "UMT"); TYPE_MAX_VALUE (gnu_subtype) = gnu_high;
TREE_TYPE (gnu_subtype) = gnu_type; TREE_TYPE (gnu_subtype) = gnu_type;
TYPE_MIN_VALUE (gnu_subtype) = TYPE_MIN_VALUE (gnu_type);
TYPE_MAX_VALUE (gnu_subtype)
= TYPE_MODULAR_P (gnu_type)
? gnu_high : TYPE_MAX_VALUE (gnu_type);
TYPE_PRECISION (gnu_subtype) = esize;
TYPE_UNSIGNED (gnu_subtype) = 1;
TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1; TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
layout_type (gnu_subtype); TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "UMT");
gnu_type = gnu_subtype; gnu_type = gnu_subtype;
} }
} }
...@@ -1526,20 +1520,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1526,20 +1520,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
case E_Ordinary_Fixed_Point_Subtype: case E_Ordinary_Fixed_Point_Subtype:
case E_Decimal_Fixed_Point_Subtype: case E_Decimal_Fixed_Point_Subtype:
/* For integral subtypes, we make a new INTEGER_TYPE. Note /* For integral subtypes, we make a new INTEGER_TYPE. Note hat we do
that we do not want to call build_range_type since we would not want to call build_range_type since we would like each subtype
like each subtype node to be distinct. This will be important node to be distinct. This will be important when memory aliasing
when memory aliasing is implemented. is implemented.
The TREE_TYPE field of the INTEGER_TYPE we make points to the The TREE_TYPE field of the INTEGER_TYPE points to the base type;
parent type; this fact is used by the arithmetic conversion this fact is used by the arithmetic conversion functions.
functions.
We elaborate the Ancestor_Subtype if it is not in the current We elaborate the Ancestor_Subtype if it is not in the current unit
unit and one of our bounds is non-static. We do this to ensure and one of our bounds is non-static. We do this to ensure consistent
consistent naming in the case where several subtypes share the same naming in the case where several subtypes share the same bounds, by
bounds by always elaborating the first such subtype first, thus elaborating the first such subtype first, thus using its name. */
using its name. */
if (!definition if (!definition
&& Present (Ancestor_Subtype (gnat_entity)) && Present (Ancestor_Subtype (gnat_entity))
...@@ -3376,15 +3368,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3376,15 +3368,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& ! present_gnu_tree (gnat_desig_equiv)) && ! present_gnu_tree (gnat_desig_equiv))
|| (in_main_unit && is_from_limited_with || (in_main_unit && is_from_limited_with
&& Present (Freeze_Node (gnat_desig_rep))))) && Present (Freeze_Node (gnat_desig_rep)))))
{ {
tree gnu_old tree gnu_old;
= (present_gnu_tree (gnat_desig_rep)
? TREE_TYPE (get_gnu_tree (gnat_desig_rep))
: make_dummy_type (gnat_desig_rep));
tree fields;
/* Show the dummy we get will be a fat pointer. */ if (present_gnu_tree (gnat_desig_rep))
got_fat_p = made_dummy = true; gnu_old = TREE_TYPE (get_gnu_tree (gnat_desig_rep));
else
{
gnu_old = make_dummy_type (gnat_desig_rep);
/* Show the dummy we get will be a fat pointer. */
got_fat_p = made_dummy = true;
}
/* If the call above got something that has a pointer, that /* If the call above got something that has a pointer, that
pointer is our type. This could have happened either pointer is our type. This could have happened either
...@@ -3397,6 +3392,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3397,6 +3392,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
tree gnu_ptr_template = build_pointer_type (gnu_template_type); tree gnu_ptr_template = build_pointer_type (gnu_template_type);
tree gnu_array_type = make_node (ENUMERAL_TYPE); tree gnu_array_type = make_node (ENUMERAL_TYPE);
tree gnu_ptr_array = build_pointer_type (gnu_array_type); tree gnu_ptr_array = build_pointer_type (gnu_array_type);
tree fields;
TYPE_NAME (gnu_template_type) TYPE_NAME (gnu_template_type)
= create_concat_name (gnat_desig_equiv, "XUB"); = create_concat_name (gnat_desig_equiv, "XUB");
...@@ -4319,8 +4315,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -4319,8 +4315,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* If we are processing a type and there is either no decl for it or /* If we are processing a type and there is either no decl for it or
we just made one, do some common processing for the type, such as we just made one, do some common processing for the type, such as
handling alignment and possible padding. */ handling alignment and possible padding. */
if (is_type && (!gnu_decl || this_made_decl))
if ((!gnu_decl || this_made_decl) && IN (kind, Type_Kind))
{ {
if (Is_Tagged_Type (gnat_entity) if (Is_Tagged_Type (gnat_entity)
|| Is_Class_Wide_Equivalent_Type (gnat_entity)) || Is_Class_Wide_Equivalent_Type (gnat_entity))
...@@ -4531,7 +4526,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -4531,7 +4526,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TREE_TYPE (gnu_decl) = gnu_type; TREE_TYPE (gnu_decl) = gnu_type;
} }
if (IN (kind, Type_Kind) && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))) if (is_type && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl)))
{ {
gnu_type = TREE_TYPE (gnu_decl); gnu_type = TREE_TYPE (gnu_decl);
...@@ -4639,10 +4634,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -4639,10 +4634,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* If this is an enumeral or floating-point type, we were not able to set /* If this is an enumeral or floating-point type, we were not able to set
the bounds since they refer to the type. These bounds are always static. the bounds since they refer to the type. These bounds are always static.
For enumeration types, also write debugging information and declare the For enumeration types, also write debugging information and declare the
enumeration literal table, if needed. */ enumeration literal table, if needed. */
if ((kind == E_Enumeration_Type && Present (First_Literal (gnat_entity))) if ((kind == E_Enumeration_Type && Present (First_Literal (gnat_entity)))
|| (kind == E_Floating_Point_Type && !Vax_Float (gnat_entity))) || (kind == E_Floating_Point_Type && !Vax_Float (gnat_entity)))
{ {
...@@ -7141,13 +7134,13 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, ...@@ -7141,13 +7134,13 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
else else
gnat_error_node = gnat_object; gnat_error_node = gnat_object;
/* Return 0 if no size was specified, either because Esize was not Present or /* Return 0 if no size was specified, either because Esize was not Present
the specified size was zero. */ or the specified size was zero. */
if (No (uint_size) || uint_size == No_Uint) if (No (uint_size) || uint_size == No_Uint)
return NULL_TREE; return NULL_TREE;
/* Get the size as a tree. Give an error if a size was specified, but cannot /* Get the size as a tree. Issue an error if a size was specified but
be represented as in sizetype. */ cannot be represented in sizetype. */
size = UI_To_gnu (uint_size, bitsizetype); size = UI_To_gnu (uint_size, bitsizetype);
if (TREE_OVERFLOW (size)) if (TREE_OVERFLOW (size))
{ {
...@@ -7158,8 +7151,8 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, ...@@ -7158,8 +7151,8 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
} }
/* Ignore a negative size since that corresponds to our back-annotation. /* Ignore a negative size since that corresponds to our back-annotation.
Also ignore a zero size unless a size clause exists. */ Also ignore a zero size if it is not permitted. */
else if (tree_int_cst_sgn (size) < 0 || (integer_zerop (size) && !zero_ok)) if (tree_int_cst_sgn (size) < 0 || (integer_zerop (size) && !zero_ok))
return NULL_TREE; return NULL_TREE;
/* The size of objects is always a multiple of a byte. */ /* The size of objects is always a multiple of a byte. */
...@@ -7177,8 +7170,8 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, ...@@ -7177,8 +7170,8 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
/* If this is an integral type or a packed array type, the front-end has /* If this is an integral type or a packed array type, the front-end has
verified the size, so we need not do it here (which would entail verified the size, so we need not do it here (which would entail
checking against the bounds). However, if this is an aliased object, it checking against the bounds). However, if this is an aliased object,
may not be smaller than the type of the object. */ it may not be smaller than the type of the object. */
if ((INTEGRAL_TYPE_P (gnu_type) || TYPE_IS_PACKED_ARRAY_TYPE_P (gnu_type)) if ((INTEGRAL_TYPE_P (gnu_type) || TYPE_IS_PACKED_ARRAY_TYPE_P (gnu_type))
&& !(kind == VAR_DECL && Is_Aliased (gnat_object))) && !(kind == VAR_DECL && Is_Aliased (gnat_object)))
return size; return size;
...@@ -7246,38 +7239,37 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, ...@@ -7246,38 +7239,37 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
static void static void
set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity) set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
{ {
/* Only give an error if a Value_Size clause was explicitly given. /* Only issue an error if a Value_Size clause was explicitly given.
Otherwise, we'd be duplicating an error on the Size clause. */ Otherwise, we'd be duplicating an error on the Size clause. */
Node_Id gnat_attr_node Node_Id gnat_attr_node
= Get_Attribute_Definition_Clause (gnat_entity, Attr_Value_Size); = Get_Attribute_Definition_Clause (gnat_entity, Attr_Value_Size);
tree old_size = rm_size (gnu_type); tree old_size = rm_size (gnu_type), size;
tree size;
/* Get the size as a tree. Do nothing if none was specified, either /* Do nothing if no size was specified, either because RM size was not
because RM size was not Present or if the specified size was zero. Present or if the specified size was zero. */
Give an error if a size was specified, but cannot be represented as
in sizetype. */
if (No (uint_size) || uint_size == No_Uint) if (No (uint_size) || uint_size == No_Uint)
return; return;
/* Get the size as a tree. Issue an error if a size was specified but
cannot be represented in sizetype. */
size = UI_To_gnu (uint_size, bitsizetype); size = UI_To_gnu (uint_size, bitsizetype);
if (TREE_OVERFLOW (size)) if (TREE_OVERFLOW (size))
{ {
if (Present (gnat_attr_node)) if (Present (gnat_attr_node))
post_error_ne ("Value_Size of & is too large", gnat_attr_node, post_error_ne ("Value_Size of & is too large", gnat_attr_node,
gnat_entity); gnat_entity);
return; return;
} }
/* Ignore a negative size since that corresponds to our back-annotation. /* Ignore a negative size since that corresponds to our back-annotation.
Also ignore a zero size unless a size clause exists, a Value_Size Also ignore a zero size unless a Value_Size clause exists, or a size
clause exists, or this is an integer type, in which case the clause exists, or this is an integer type, in which case the front-end
front end will have always set it. */ will have always set it. */
else if (tree_int_cst_sgn (size) < 0 if (tree_int_cst_sgn (size) < 0
|| (integer_zerop (size) && No (gnat_attr_node) || (integer_zerop (size)
&& !Has_Size_Clause (gnat_entity) && No (gnat_attr_node)
&& !Is_Discrete_Or_Fixed_Point_Type (gnat_entity))) && !Has_Size_Clause (gnat_entity)
&& !Is_Discrete_Or_Fixed_Point_Type (gnat_entity)))
return; return;
/* If the old size is self-referential, get the maximum size. */ /* If the old size is self-referential, get the maximum size. */
...@@ -7285,17 +7277,15 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity) ...@@ -7285,17 +7277,15 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
old_size = max_size (old_size, true); old_size = max_size (old_size, true);
/* If the size of the object is a constant, the new size must not be /* If the size of the object is a constant, the new size must not be
smaller (the front end checks this for scalar types). */ smaller (the front-end checks this for scalar types). */
if (TREE_CODE (old_size) != INTEGER_CST if (TREE_CODE (old_size) != INTEGER_CST
|| TREE_OVERFLOW (old_size) || TREE_OVERFLOW (old_size)
|| (AGGREGATE_TYPE_P (gnu_type) || (AGGREGATE_TYPE_P (gnu_type) && tree_int_cst_lt (size, old_size)))
&& tree_int_cst_lt (size, old_size)))
{ {
if (Present (gnat_attr_node)) if (Present (gnat_attr_node))
post_error_ne_tree post_error_ne_tree
("Value_Size for& too small{, minimum allowed is ^}", ("Value_Size for& too small{, minimum allowed is ^}",
gnat_attr_node, gnat_entity, old_size); gnat_attr_node, gnat_entity, old_size);
return; return;
} }
......
gcc/ada/gcc-interface/utils.c
...@@ -1397,7 +1397,7 @@ aggregate_type_contains_array_p (tree type) ...@@ -1397,7 +1397,7 @@ aggregate_type_contains_array_p (tree type)
} }
} }
/* Returns a FIELD_DECL node. FIELD_NAME the field name, FIELD_TYPE is its /* Return a FIELD_DECL node. FIELD_NAME the field name, FIELD_TYPE is its
type, and RECORD_TYPE is the type of the parent. PACKED is nonzero if type, and RECORD_TYPE is the type of the parent. PACKED is nonzero if
this field is in a record type with a "pragma pack". If SIZE is nonzero this field is in a record type with a "pragma pack". If SIZE is nonzero
it is the specified size for this field. If POS is nonzero, it is the bit it is the specified size for this field. If POS is nonzero, it is the bit
...@@ -1540,22 +1540,19 @@ create_field_decl (tree field_name, tree field_type, tree record_type, ...@@ -1540,22 +1540,19 @@ create_field_decl (tree field_name, tree field_type, tree record_type,
return field_decl; return field_decl;
} }
/* Returns a PARM_DECL node. PARAM_NAME is the name of the parameter, /* Return a PARM_DECL node. PARAM_NAME is the name of the parameter and
PARAM_TYPE is its type. READONLY is true if the parameter is PARAM_TYPE is its type. READONLY is true if the parameter is readonly
readonly (either an In parameter or an address of a pass-by-ref (either an In parameter or an address of a pass-by-ref parameter). */
parameter). */
tree tree
create_param_decl (tree param_name, tree param_type, bool readonly) create_param_decl (tree param_name, tree param_type, bool readonly)
{ {
tree param_decl = build_decl (PARM_DECL, param_name, param_type); tree param_decl = build_decl (PARM_DECL, param_name, param_type);
/* Honor targetm.calls.promote_prototypes(), as not doing so can /* Honor TARGET_PROMOTE_PROTOTYPES like the C compiler, as not doing so
lead to various ABI violations. */ can lead to various ABI violations. */
if (targetm.calls.promote_prototypes (param_type) if (targetm.calls.promote_prototypes (NULL_TREE)
&& (TREE_CODE (param_type) == INTEGER_TYPE && INTEGRAL_TYPE_P (param_type)
|| TREE_CODE (param_type) == ENUMERAL_TYPE
|| TREE_CODE (param_type) == BOOLEAN_TYPE)
&& TYPE_PRECISION (param_type) < TYPE_PRECISION (integer_type_node)) && TYPE_PRECISION (param_type) < TYPE_PRECISION (integer_type_node))
{ {
/* We have to be careful about biased types here. Make a subtype /* We have to be careful about biased types here. Make a subtype
......
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