* *
* C Implementation File *
* *
- * Copyright (C) 1992-2004, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2005, 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- *
Entity_Id full_type;
} *defer_incomplete_list = 0;
+/* These two variables are used to defer emission of debug information for
+ nested incomplete record types */
+
+static int defer_debug_level = 0;
+static tree defer_debug_incomplete_list;
+
static void copy_alias_set (tree, tree);
-static tree substitution_list (Entity_Id, Entity_Id, tree, int);
-static int allocatable_size_p (tree, int);
-static struct attrib *build_attr_list (Entity_Id);
+static tree substitution_list (Entity_Id, Entity_Id, tree, bool);
+static bool allocatable_size_p (tree, bool);
+static void prepend_attributes (Entity_Id, struct attrib **);
static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool);
-static int is_variable_size (tree);
+static bool is_variable_size (tree);
static tree elaborate_expression_1 (Node_Id, Entity_Id, tree, tree,
bool, bool);
static tree make_packable_type (tree);
-static tree maybe_pad_type (tree, tree, unsigned int, Entity_Id, const char *,
- int, int, int);
-static tree gnat_to_gnu_field (Entity_Id, tree, int, int);
-static void components_to_record (tree, Node_Id, tree, int, int, tree *,
- int, int);
+static tree gnat_to_gnu_field (Entity_Id, tree, int, bool);
+static void components_to_record (tree, Node_Id, tree, int, bool, tree *,
+ bool, bool, bool);
static int compare_field_bitpos (const PTR, const PTR);
static Uint annotate_value (tree);
static void annotate_rep (Entity_Id, tree);
static tree compute_field_positions (tree, tree, tree, tree, unsigned int);
-static tree validate_size (Uint, tree, Entity_Id, enum tree_code, int, int);
+static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool);
static void set_rm_size (Uint, tree, Entity_Id);
-static tree make_type_from_size (tree, tree, int);
+static tree make_type_from_size (tree, tree, bool);
static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
-static void check_ok_for_atomic (tree, Entity_Id, int);
-static void annotate_decl_with_node (tree, Node_Id);
-\f
+static void check_ok_for_atomic (tree, Entity_Id, bool);
+static int compatible_signatures_p (tree ftype1, tree ftype2);
+
/* Given GNAT_ENTITY, an entity in the incoming GNAT tree, return a
GCC type corresponding to that entity. GNAT_ENTITY is assumed to
refer to an Ada type. */
/* Convert the ada entity type into a GCC TYPE_DECL node. */
gnu_decl = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
- if (TREE_CODE (gnu_decl) != TYPE_DECL)
- gigi_abort (101);
-
+ gcc_assert (TREE_CODE (gnu_decl) == TYPE_DECL);
return TREE_TYPE (gnu_decl);
}
\f
gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
{
tree gnu_entity_id;
- tree gnu_type = 0;
+ tree gnu_type = NULL_TREE;
/* Contains the gnu XXXX_DECL tree node which is equivalent to the input
GNAT tree. This node will be associated with the GNAT node by calling
the save_gnu_tree routine at the end of the `switch' statement. */
- tree gnu_decl = 0;
- /* Nonzero if we have already saved gnu_decl as a gnat association. */
- int saved = 0;
+ tree gnu_decl = NULL_TREE;
+ /* true if we have already saved gnu_decl as a gnat association. */
+ bool saved = false;
/* Nonzero if we incremented defer_incomplete_level. */
- int this_deferred = 0;
+ bool this_deferred = false;
+ /* Nonzero if we incremented defer_debug_level. */
+ bool debug_deferred = false;
/* Nonzero if we incremented force_global. */
- int this_global = 0;
+ bool this_global = false;
/* Nonzero if we should check to see if elaborated during processing. */
- int maybe_present = 0;
+ bool maybe_present = false;
/* Nonzero if we made GNU_DECL and its type here. */
- int this_made_decl = 0;
- struct attrib *attr_list = 0;
- int debug_info_p = (Needs_Debug_Info (gnat_entity)
- || debug_info_level == DINFO_LEVEL_VERBOSE);
+ bool this_made_decl = false;
+ struct attrib *attr_list = NULL;
+ bool debug_info_p = (Needs_Debug_Info (gnat_entity)
+ || debug_info_level == DINFO_LEVEL_VERBOSE);
Entity_Kind kind = Ekind (gnat_entity);
Entity_Id gnat_temp;
unsigned int esize
: LONG_LONG_TYPE_SIZE)
: LONG_LONG_TYPE_SIZE);
tree gnu_size = 0;
- int imported_p
+ bool imported_p
= ((Is_Imported (gnat_entity) && No (Address_Clause (gnat_entity)))
|| From_With_Type (gnat_entity));
unsigned int align = 0;
/* Since a use of an Itype is a definition, process it as such if it
is not in a with'ed unit. */
- if (! definition && Is_Itype (gnat_entity)
- && ! present_gnu_tree (gnat_entity)
+ if (!definition && Is_Itype (gnat_entity)
+ && !present_gnu_tree (gnat_entity)
&& In_Extended_Main_Code_Unit (gnat_entity))
{
/* Ensure that we are in a subprogram mentioned in the Scope
chain of this entity, our current scope is global,
or that we encountered a task or entry (where we can't currently
accurately check scoping). */
- if (current_function_decl == 0
+ if (!current_function_decl
|| DECL_ELABORATION_PROC_P (current_function_decl))
{
process_type (gnat_entity);
}
}
- /* gigi abort 122 means that the entity "gnat_entity" has an incorrect
- scope, i.e. that its scope does not correspond to the subprogram
- in which it is declared */
- gigi_abort (122);
+ /* This abort means the entity "gnat_entity" has an incorrect scope,
+ i.e. that its scope does not correspond to the subprogram in which
+ it is declared */
+ gcc_unreachable ();
}
/* If this is entity 0, something went badly wrong. */
- if (gnat_entity == 0)
- gigi_abort (102);
+ gcc_assert (Present (gnat_entity));
/* 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.
gnu_decl = gnat_to_gnu_entity (Full_View (gnat_entity),
NULL_TREE, 0);
- save_gnu_tree (gnat_entity, NULL_TREE, 0);
- save_gnu_tree (gnat_entity, gnu_decl, 0);
+ save_gnu_tree (gnat_entity, NULL_TREE, false);
+ save_gnu_tree (gnat_entity, gnu_decl, false);
}
return gnu_decl;
/* If this is a numeric or enumeral type, or an access type, a nonzero
Esize must be specified unless it was specified by the programmer. */
- if ((IN (kind, Numeric_Kind) || IN (kind, Enumeration_Kind)
- || (IN (kind, Access_Kind)
- && kind != E_Access_Protected_Subprogram_Type
- && kind != E_Access_Subtype))
- && Unknown_Esize (gnat_entity)
- && ! Has_Size_Clause (gnat_entity))
- gigi_abort (109);
+ gcc_assert (!Unknown_Esize (gnat_entity)
+ || Has_Size_Clause (gnat_entity)
+ || (!IN (kind, Numeric_Kind) && !IN (kind, Enumeration_Kind)
+ && (!IN (kind, Access_Kind)
+ || kind == E_Access_Protected_Subprogram_Type
+ || kind == E_Access_Subtype)));
/* Likewise, RM_Size must be specified for all discrete and fixed-point
types. */
- if (IN (kind, Discrete_Or_Fixed_Point_Kind)
- && Unknown_RM_Size (gnat_entity))
- gigi_abort (123);
+ gcc_assert (!IN (kind, Discrete_Or_Fixed_Point_Kind)
+ || !Unknown_RM_Size (gnat_entity));
/* 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. */
/* 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. */
- if (! 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)))
-#if 1
- && !IN (kind, Type_Kind)
-#endif
- )
- gigi_abort (116);
+ 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
another compilation unit) Public entities, show we are at global level
discriminants since the relevant test is whether or not the record is
being defined. But do this for Imported functions or procedures in
all cases. */
- if ((! definition && Is_Public (gnat_entity)
- && ! Is_Statically_Allocated (gnat_entity)
+ if ((!definition && Is_Public (gnat_entity)
+ && !Is_Statically_Allocated (gnat_entity)
&& kind != E_Discriminant && kind != E_Component)
|| (Is_Imported (gnat_entity)
&& (kind == E_Function || kind == E_Procedure)))
- force_global++, this_global = 1;
+ force_global++, this_global = true;
- /* Handle any attributes. */
+ /* Handle any attributes directly attached to the entity. */
if (Has_Gigi_Rep_Item (gnat_entity))
- attr_list = build_attr_list (gnat_entity);
+ prepend_attributes (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 (Is_Type (gnat_entity) && 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);
switch (kind)
{
case E_Constant:
/* If this is a use of a deferred constant, get its full
declaration. */
- if (! definition && Present (Full_View (gnat_entity)))
+ if (!definition && Present (Full_View (gnat_entity)))
{
gnu_decl = gnat_to_gnu_entity (Full_View (gnat_entity),
gnu_expr, definition);
- saved = 1;
+ saved = true;
break;
}
Do not retrieve the expression if it is an aggregate, because
in complex instantiation contexts it may not be expanded */
- if (! definition
+ if (!definition
&& Present (Expression (Declaration_Node (gnat_entity)))
- && ! No_Initialization (Declaration_Node (gnat_entity))
- && Nkind (Expression (Declaration_Node (gnat_entity)))
- != N_Aggregate)
+ && !No_Initialization (Declaration_Node (gnat_entity))
+ && (Nkind (Expression (Declaration_Node (gnat_entity)))
+ != N_Aggregate))
gnu_expr = gnat_to_gnu (Expression (Declaration_Node (gnat_entity)));
/* Ignore deferred constant definitions; they are processed fully in the
not a deferred constant but a constant whose value is built
manually. */
- if (definition && gnu_expr == 0
- && ! No_Initialization (Declaration_Node (gnat_entity))
+ if (definition && !gnu_expr
+ && !No_Initialization (Declaration_Node (gnat_entity))
&& No (Renamed_Object (gnat_entity)))
{
gnu_decl = error_mark_node;
- saved = 1;
+ saved = true;
break;
}
- else if (! definition && IN (kind, Incomplete_Or_Private_Kind)
+ else if (!definition && IN (kind, Incomplete_Or_Private_Kind)
&& Present (Full_View (gnat_entity)))
{
gnu_decl = gnat_to_gnu_entity (Full_View (gnat_entity),
NULL_TREE, 0);
- saved = 1;
+ saved = true;
break;
}
stored discriminant. Also use Original_Record_Component
if the record has a private extension. */
- if ((Base_Type (gnat_record) == gnat_record
- || Ekind (Scope (gnat_entity)) == E_Private_Subtype
- || Ekind (Scope (gnat_entity)) == E_Record_Subtype_With_Private
- || Ekind (Scope (gnat_entity)) == E_Record_Type_With_Private)
- && Present (Original_Record_Component (gnat_entity))
+ if (Present (Original_Record_Component (gnat_entity))
&& Original_Record_Component (gnat_entity) != gnat_entity)
{
gnu_decl
= gnat_to_gnu_entity (Original_Record_Component (gnat_entity),
gnu_expr, definition);
- saved = 1;
+ saved = true;
break;
}
{
/* A tagged record has no explicit stored discriminants. */
- if (First_Discriminant (gnat_record)
- != First_Stored_Discriminant (gnat_record))
- gigi_abort (119);
-
+ gcc_assert (First_Discriminant (gnat_record)
+ == First_Stored_Discriminant (gnat_record));
gnu_decl
= gnat_to_gnu_entity (Corresponding_Discriminant (gnat_entity),
gnu_expr, definition);
- saved = 1;
+ saved = true;
break;
}
else if (Present (Corresponding_Discriminant (gnat_entity))
&& (First_Discriminant (gnat_record)
!= First_Stored_Discriminant (gnat_record)))
- gigi_abort (120);
+ gcc_unreachable ();
/* Otherwise, if we are not defining this and we have no GCC type
for the containing record, make one for it. Then we should
have made our own equivalent. */
- else if (! definition && ! present_gnu_tree (gnat_record))
+ else if (!definition && !present_gnu_tree (gnat_record))
{
/* ??? If this is in a record whose scope is a protected
type and we have an Original_Record_Component, use it.
= gnat_to_gnu_entity (Original_Record_Component
(gnat_entity),
gnu_expr, definition);
- saved = 1;
+ saved = true;
break;
}
gnat_to_gnu_entity (Scope (gnat_entity), NULL_TREE, 0);
gnu_decl = get_gnu_tree (gnat_entity);
- saved = 1;
+ saved = true;
break;
}
- /* Here we have no GCC type and this is a reference rather than a
- definition. This should never happen. Most likely the cause is a
- reference before declaration in the gnat tree for gnat_entity. */
else
- gigi_abort (103);
+ /* Here we have no GCC type and this is a reference rather than a
+ definition. This should never happen. Most likely the cause is a
+ reference before declaration in the gnat tree for gnat_entity. */
+ gcc_unreachable ();
}
case E_Loop_Parameter:
/* Simple variables, loop variables, OUT parameters, and exceptions. */
object:
{
- int used_by_ref = 0;
- int const_flag
+ bool used_by_ref = false;
+ bool const_flag
= ((kind == E_Constant || kind == E_Variable)
- && ! Is_Statically_Allocated (gnat_entity)
+ && !Is_Statically_Allocated (gnat_entity)
&& Is_True_Constant (gnat_entity)
&& (((Nkind (Declaration_Node (gnat_entity))
== N_Object_Declaration)
&& Present (Expression (Declaration_Node (gnat_entity))))
|| Present (Renamed_Object (gnat_entity))));
- int inner_const_flag = const_flag;
- int static_p = Is_Statically_Allocated (gnat_entity);
+ bool inner_const_flag = const_flag;
+ bool static_p = Is_Statically_Allocated (gnat_entity);
tree gnu_ext_name = NULL_TREE;
+ tree renamed_obj = NULL_TREE;
- if (Present (Renamed_Object (gnat_entity)) && ! definition)
+ if (Present (Renamed_Object (gnat_entity)) && !definition)
{
if (kind == E_Exception)
gnu_expr = gnat_to_gnu_entity (Renamed_Entity (gnat_entity),
|| TYPE_IS_DUMMY_P (gnu_type)
|| TREE_CODE (gnu_type) == VOID_TYPE)
{
- if (type_annotate_only)
- return error_mark_node;
- else
- gigi_abort (104);
+ gcc_assert (type_annotate_only);
+ return error_mark_node;
+ }
+
+ /* If an alignment is specified, use it if valid. Note that
+ exceptions are objects but don't have alignments. We must do this
+ before we validate the size, since the alignment can affect the
+ size. */
+ if (kind != E_Exception && Known_Alignment (gnat_entity))
+ {
+ gcc_assert (Present (Alignment (gnat_entity)));
+ align = validate_alignment (Alignment (gnat_entity), gnat_entity,
+ TYPE_ALIGN (gnu_type));
+ gnu_type = maybe_pad_type (gnu_type, NULL_TREE, align,
+ gnat_entity, "PAD", 0, definition, 1);
}
/* If we are defining the object, see if it has a Size value and
get the new type, if any. */
if (definition)
gnu_size = validate_size (Esize (gnat_entity), gnu_type,
- gnat_entity, VAR_DECL, 0,
+ gnat_entity, VAR_DECL, false,
Has_Size_Clause (gnat_entity));
else if (Has_Size_Clause (gnat_entity))
gnu_size = UI_To_gnu (Esize (gnat_entity), bitsizetype);
- if (gnu_size != 0)
+ if (gnu_size)
{
gnu_type
= make_type_from_size (gnu_type, gnu_size,
Has_Biased_Representation (gnat_entity));
if (operand_equal_p (TYPE_SIZE (gnu_type), gnu_size, 0))
- gnu_size = 0;
+ gnu_size = NULL_TREE;
}
/* If this object has self-referential size, it must be a record with
if (No (Renamed_Object (gnat_entity))
&& CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
{
- if (gnu_expr != 0 && kind == E_Constant)
+ if (gnu_expr && kind == E_Constant)
gnu_size
= SUBSTITUTE_PLACEHOLDER_IN_EXPR
(TYPE_SIZE (TREE_TYPE (gnu_expr)), gnu_expr);
(Etype
(Expression (Declaration_Node (gnat_entity)))));
else
- gnu_size = max_size (TYPE_SIZE (gnu_type), 1);
+ gnu_size = max_size (TYPE_SIZE (gnu_type), true);
}
/* If the size is zero bytes, make it one byte since some linkers have
clause, as we would lose useful information on the view size
(e.g. for null array slices) and we are not allocating the object
here anyway. */
- if (((gnu_size != 0 && integer_zerop (gnu_size))
- || (TYPE_SIZE (gnu_type) != 0
- && integer_zerop (TYPE_SIZE (gnu_type))))
- && (! Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
- || ! Is_Array_Type (Etype (gnat_entity)))
- && ! Present (Renamed_Object (gnat_entity))
- && ! Present (Address_Clause (gnat_entity)))
+ if (((gnu_size && integer_zerop (gnu_size))
+ || (TYPE_SIZE (gnu_type) && integer_zerop (TYPE_SIZE (gnu_type))))
+ && (!Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
+ || !Is_Array_Type (Etype (gnat_entity)))
+ && !Present (Renamed_Object (gnat_entity))
+ && !Present (Address_Clause (gnat_entity)))
gnu_size = bitsize_unit_node;
- /* If an alignment is specified, use it if valid. Note that
- exceptions are objects but don't have alignments. */
- if (kind != E_Exception && Known_Alignment (gnat_entity))
- {
- if (No (Alignment (gnat_entity)))
- gigi_abort (125);
-
- align
- = validate_alignment (Alignment (gnat_entity), gnat_entity,
- TYPE_ALIGN (gnu_type));
- }
-
/* If this is an atomic object with no specified size and alignment,
but where the size of the type is a constant, set the alignment to
the lowest power of two greater than the size, or to the
biggest meaningful alignment, whichever is smaller. */
- if (Is_Atomic (gnat_entity) && gnu_size == 0 && align == 0
+ if (Is_Atomic (gnat_entity) && !gnu_size && align == 0
&& TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST)
{
- if (! host_integerp (TYPE_SIZE (gnu_type), 1)
+ if (!host_integerp (TYPE_SIZE (gnu_type), 1)
|| 0 <= compare_tree_int (TYPE_SIZE (gnu_type),
BIGGEST_ALIGNMENT))
align = BIGGEST_ALIGNMENT;
if (Has_Atomic_Components (gnat_entity))
{
- tree gnu_inner
- = (TREE_CODE (gnu_type) == ARRAY_TYPE
- ? TREE_TYPE (gnu_type) : gnu_type);
+ tree gnu_inner = (TREE_CODE (gnu_type) == ARRAY_TYPE
+ ? TREE_TYPE (gnu_type) : gnu_type);
while (TREE_CODE (gnu_inner) == ARRAY_TYPE
&& TYPE_MULTI_ARRAY_P (gnu_inner))
gnu_inner = TREE_TYPE (gnu_inner);
- check_ok_for_atomic (gnu_inner, gnat_entity, 1);
+ check_ok_for_atomic (gnu_inner, gnat_entity, true);
}
/* Now check if the type of the object allows atomic access. Note
this by always copying via an intermediate value, but it's not
clear it's worth the effort. */
if (Is_Atomic (gnat_entity))
- check_ok_for_atomic (gnu_type, gnat_entity, 0);
+ check_ok_for_atomic (gnu_type, gnat_entity, false);
/* If this is an aliased object with an unconstrained nominal subtype,
make a type that includes the template. */
if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
&& Is_Array_Type (Etype (gnat_entity))
- && ! type_annotate_only)
+ && !type_annotate_only)
{
tree gnu_fat
= TREE_TYPE (gnat_to_gnu_type (Base_Type (Etype (gnat_entity))));
do not do it for Out parameters since that creates an
size inconsistency with In parameters. */
if (align == 0 && MINIMUM_ATOMIC_ALIGNMENT > TYPE_ALIGN (gnu_type)
- && ! FLOAT_TYPE_P (gnu_type)
- && ! const_flag && No (Renamed_Object (gnat_entity))
- && ! imported_p && No (Address_Clause (gnat_entity))
+ && !FLOAT_TYPE_P (gnu_type)
+ && !const_flag && No (Renamed_Object (gnat_entity))
+ && !imported_p && No (Address_Clause (gnat_entity))
&& kind != E_Out_Parameter
- && (gnu_size != 0 ? TREE_CODE (gnu_size) == INTEGER_CST
+ && (gnu_size ? TREE_CODE (gnu_size) == INTEGER_CST
: TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST))
align = MINIMUM_ATOMIC_ALIGNMENT;
#endif
/* Make a new type with the desired size and alignment, if needed. */
- gnu_type = maybe_pad_type (gnu_type, gnu_size, align,
- gnat_entity, "PAD", 0, definition, 1);
+ gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
+ "PAD", false, definition, true);
/* Make a volatile version of this object's type if we are to
make the object volatile. Note that 13.3(19) says that we
|| Is_Exported (gnat_entity)
|| Is_Imported (gnat_entity)
|| Present (Address_Clause (gnat_entity)))
- && ! TYPE_VOLATILE (gnu_type))
+ && !TYPE_VOLATILE (gnu_type))
gnu_type = build_qualified_type (gnu_type,
(TYPE_QUALS (gnu_type)
| TYPE_QUAL_VOLATILE));
the former case, converting will generate unnecessary evaluations
of the CONSTRUCTOR to compute the size and in the latter case, we
want to only copy the actual data. */
- if (gnu_expr != 0
+ if (gnu_expr
&& TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
- && ! CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
- && ! (TREE_CODE (gnu_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (gnu_type)
- && (CONTAINS_PLACEHOLDER_P
- (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))))
+ && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
+ && !(TREE_CODE (gnu_type) == RECORD_TYPE
+ && TYPE_IS_PADDING_P (gnu_type)
+ && (CONTAINS_PLACEHOLDER_P
+ (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))))
gnu_expr = convert (gnu_type, gnu_expr);
- /* See if this is a renaming. If this is a constant renaming,
- treat it as a normal variable whose initial value is what
- is being renamed. We cannot do this if the type is
- unconstrained or class-wide.
+ /* See if this is a renaming. If this is a constant renaming, treat
+ it as a normal variable whose initial value is what is being
+ renamed. We cannot do this if the type is unconstrained or
+ class-wide.
Otherwise, if what we are renaming is a reference, we can simply
- return a stabilized version of that reference, after forcing
- any SAVE_EXPRs to be evaluated. But, if this is at global level,
- we can only do this if we know no SAVE_EXPRs will be made.
+ return a stabilized version of that reference, after forcing any
+ SAVE_EXPRs to be evaluated. But, if this is at global level, we
+ can only do this if we know no SAVE_EXPRs will be made.
+
Otherwise, make this into a constant pointer to the object we are
to rename. */
}
if (const_flag
+ && !TREE_SIDE_EFFECTS (gnu_expr)
&& TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
&& TYPE_MODE (gnu_type) != BLKmode
&& Ekind (Etype (gnat_entity)) != E_Class_Wide_Type
&& !Is_Array_Type (Etype (gnat_entity)))
;
- /* If this is a declaration or reference, we can just use that
- declaration or reference as this entity. */
- else if ((DECL_P (gnu_expr)
- || TREE_CODE_CLASS (TREE_CODE (gnu_expr)) == 'r')
- && ! Materialize_Entity (gnat_entity)
- && (! global_bindings_p ()
+ /* If this is a declaration or reference that we can stabilize,
+ just use that declaration or reference as this entity unless
+ the latter has to be materialized. */
+ else if ((DECL_P (gnu_expr) || REFERENCE_CLASS_P (gnu_expr))
+ && !Materialize_Entity (gnat_entity)
+ && (!global_bindings_p ()
|| (staticp (gnu_expr)
- && ! TREE_SIDE_EFFECTS (gnu_expr))))
+ && !TREE_SIDE_EFFECTS (gnu_expr))))
{
- gnu_decl = gnat_stabilize_reference (gnu_expr, 1);
- save_gnu_tree (gnat_entity, gnu_decl, 1);
- saved = 1;
+ gnu_decl = gnat_stabilize_reference (gnu_expr, true);
+ save_gnu_tree (gnat_entity, gnu_decl, true);
+ saved = true;
break;
}
+
+ /* Otherwise, make this into a constant pointer to the object we
+ are to rename and attach the object to the pointer. We need
+ to stabilize too since the renaming evaluation may directly
+ reference the renamed object instead of the pointer we will
+ attach it to. We don't want variables in the expression to
+ be evaluated every time the renaming is used, since their
+ value may change in between. */
else
{
+ bool has_side_effects = TREE_SIDE_EFFECTS (gnu_expr);
inner_const_flag = TREE_READONLY (gnu_expr);
- const_flag = 1;
+ const_flag = true;
gnu_type = build_reference_type (gnu_type);
- gnu_expr = build_unary_op (ADDR_EXPR, gnu_type, gnu_expr);
- gnu_size = 0;
- used_by_ref = 1;
+ renamed_obj = gnat_stabilize_reference (gnu_expr, true);
+ gnu_expr = build_unary_op (ADDR_EXPR, gnu_type, renamed_obj);
+
+ if (!global_bindings_p ())
+ {
+ /* If the original expression had side effects, put a
+ SAVE_EXPR around this whole thing. */
+ if (has_side_effects)
+ gnu_expr = save_expr (gnu_expr);
+
+ add_stmt (gnu_expr);
+ }
+
+ gnu_size = NULL_TREE;
+ used_by_ref = true;
}
}
== RECORD_TYPE
&& TYPE_CONTAINS_TEMPLATE_P
(TREE_TYPE (TYPE_FIELDS (gnu_type)))))
- && gnu_expr == 0)
+ && !gnu_expr)
{
tree template_field
= TYPE_IS_PADDING_P (gnu_type)
imported. */
if (definition
&& (POINTER_TYPE_P (gnu_type) || TYPE_FAT_POINTER_P (gnu_type))
- && !Is_Imported (gnat_entity)
- && gnu_expr == 0)
+ && !Is_Imported (gnat_entity) && !gnu_expr)
gnu_expr = integer_zero_node;
/* If we are defining the object and it has an Address clause we must
= (present_gnu_tree (gnat_entity) ? get_gnu_tree (gnat_entity)
: gnat_to_gnu (Expression (Address_Clause (gnat_entity))));
- save_gnu_tree (gnat_entity, NULL_TREE, 0);
+ save_gnu_tree (gnat_entity, NULL_TREE, false);
/* Ignore the size. It's either meaningless or was handled
above. */
- gnu_size = 0;
+ gnu_size = NULL_TREE;
gnu_type = build_reference_type (gnu_type);
gnu_address = convert (gnu_type, gnu_address);
- used_by_ref = 1;
- const_flag = ! Is_Public (gnat_entity);
+ used_by_ref = true;
+ const_flag = !Is_Public (gnat_entity);
/* If we don't have an initializing expression for the underlying
variable, the initializing expression for the pointer is the
specified address. Otherwise, we have to make a COMPOUND_EXPR
to assign both the address and the initial value. */
- if (gnu_expr == 0)
+ if (!gnu_expr)
gnu_expr = gnu_address;
else
gnu_expr
- = build (COMPOUND_EXPR, gnu_type,
- build_binary_op
- (MODIFY_EXPR, NULL_TREE,
- build_unary_op (INDIRECT_REF, NULL_TREE,
- gnu_address),
- gnu_expr),
- gnu_address);
+ = build2 (COMPOUND_EXPR, gnu_type,
+ build_binary_op
+ (MODIFY_EXPR, NULL_TREE,
+ build_unary_op (INDIRECT_REF, NULL_TREE,
+ gnu_address),
+ gnu_expr),
+ gnu_address);
}
/* If it has an address clause and we are not defining it, mark it
as an indirect object. Likewise for Stdcall objects that are
imported. */
- if ((! definition && Present (Address_Clause (gnat_entity)))
+ if ((!definition && Present (Address_Clause (gnat_entity)))
|| (Is_Imported (gnat_entity)
&& Convention (gnat_entity) == Convention_Stdcall))
{
gnu_type = build_reference_type (gnu_type);
- gnu_size = 0;
- used_by_ref = 1;
+ gnu_size = NULL_TREE;
+ used_by_ref = true;
}
/* If we are at top level and this object is of variable size,
Storage_Error gets raised. Note that we will never free
such memory, so we presume it never will get allocated. */
- if (! allocatable_size_p (TYPE_SIZE_UNIT (gnu_type),
- global_bindings_p () || ! definition
- || static_p)
- || (gnu_size != 0
+ if (!allocatable_size_p (TYPE_SIZE_UNIT (gnu_type),
+ global_bindings_p () || !definition
+ || static_p)
+ || (gnu_size
&& ! allocatable_size_p (gnu_size,
- global_bindings_p () || ! definition
+ global_bindings_p () || !definition
|| static_p)))
{
gnu_type = build_reference_type (gnu_type);
- gnu_size = 0;
- used_by_ref = 1;
- const_flag = 1;
+ gnu_size = NULL_TREE;
+ used_by_ref = true;
+ const_flag = true;
+
+ /* In case this was a aliased object whose nominal subtype is
+ unconstrained, the pointer above will be a thin pointer and
+ build_allocator will automatically make the template.
- /* Get the data part of GNU_EXPR in case this was a
- aliased object whose nominal subtype is unconstrained.
- In that case the pointer above will be a thin pointer and
- build_allocator will automatically make the template and
- constructor already made above. */
+ If we have a template initializer only (that we made above),
+ pretend there is none and rely on what build_allocator creates
+ again anyway. Otherwise (if we have a full initializer), get
+ the data part and feed that to build_allocator. */
if (definition)
{
{
gnu_alloc_type
= TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_alloc_type)));
- gnu_expr
- = build_component_ref
- (gnu_expr, NULL_TREE,
- TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr))), 0);
+
+ if (TREE_CODE (gnu_expr) == CONSTRUCTOR
+ &&
+ TREE_CHAIN (CONSTRUCTOR_ELTS (gnu_expr)) == NULL_TREE)
+ gnu_expr = 0;
+ else
+ gnu_expr
+ = build_component_ref
+ (gnu_expr, NULL_TREE,
+ TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr))),
+ false);
}
if (TREE_CODE (TYPE_SIZE_UNIT (gnu_alloc_type)) == INTEGER_CST
&& TREE_CONSTANT_OVERFLOW (TYPE_SIZE_UNIT (gnu_alloc_type))
- && ! Is_Imported (gnat_entity))
+ && !Is_Imported (gnat_entity))
post_error ("Storage_Error will be raised at run-time?",
gnat_entity);
}
else
{
- gnu_expr = 0;
- const_flag = 0;
+ gnu_expr = NULL_TREE;
+ const_flag = false;
}
}
to hold the "aligning type" with a modified initial value,
if any, then point to it and make that the value of this
variable, which is now indirect. */
-
- if (! global_bindings_p () && ! static_p && definition
- && ! imported_p && TYPE_ALIGN (gnu_type) > BIGGEST_ALIGNMENT)
+ if (!global_bindings_p () && !static_p && definition
+ && !imported_p && TYPE_ALIGN (gnu_type) > BIGGEST_ALIGNMENT)
{
tree gnu_new_type
= make_aligning_type (gnu_type, TYPE_ALIGN (gnu_type),
gnu_new_var
= create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
- NULL_TREE, gnu_new_type, gnu_expr,
- 0, 0, 0, 0, 0);
- annotate_decl_with_node (gnu_new_var, gnat_entity);
- add_decl_expr (gnu_new_var, gnat_entity);
+ NULL_TREE, gnu_new_type, gnu_expr, false,
+ false, false, false, NULL, gnat_entity);
- if (gnu_expr != 0)
+ if (gnu_expr)
add_stmt_with_node
(build_binary_op (MODIFY_EXPR, NULL_TREE,
build_component_ref
(gnu_new_var, NULL_TREE,
- TYPE_FIELDS (gnu_new_type), 0),
+ TYPE_FIELDS (gnu_new_type), false),
gnu_expr),
gnat_entity);
= build_unary_op
(ADDR_EXPR, gnu_type,
build_component_ref (gnu_new_var, NULL_TREE,
- TYPE_FIELDS (gnu_new_type), 0));
+ TYPE_FIELDS (gnu_new_type), false));
- gnu_size = 0;
- used_by_ref = 1;
- const_flag = 1;
+ gnu_size = NULL_TREE;
+ used_by_ref = true;
+ const_flag = true;
}
+ if (const_flag)
+ gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type)
+ | TYPE_QUAL_CONST));
+
/* Convert the expression to the type of the object except in the
case where the object's type is unconstrained or the object's type
is a padded record whose field is of self-referential size. In
the former case, converting will generate unnecessary evaluations
of the CONSTRUCTOR to compute the size and in the latter case, we
want to only copy the actual data. */
- if (gnu_expr != 0
+ if (gnu_expr
&& TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
- && ! CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
- && ! (TREE_CODE (gnu_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (gnu_type)
- && (CONTAINS_PLACEHOLDER_P
- (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))))
+ && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
+ && !(TREE_CODE (gnu_type) == RECORD_TYPE
+ && TYPE_IS_PADDING_P (gnu_type)
+ && (CONTAINS_PLACEHOLDER_P
+ (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))))
gnu_expr = convert (gnu_type, gnu_expr);
/* If this name is external or there was a name specified, use it,
unless this is a VMS exception object since this would conflict
with the symbol we need to export in addition. Don't use the
Interface_Name if there is an address clause (see CD30005). */
- if (! Is_VMS_Exception (gnat_entity)
- &&
- ((Present (Interface_Name (gnat_entity))
- && No (Address_Clause (gnat_entity)))
- ||
- (Is_Public (gnat_entity)
- && (! Is_Imported (gnat_entity) || Is_Exported (gnat_entity)))))
+ if (!Is_VMS_Exception (gnat_entity)
+ && ((Present (Interface_Name (gnat_entity))
+ && No (Address_Clause (gnat_entity)))
+ || (Is_Public (gnat_entity)
+ && (!Is_Imported (gnat_entity)
+ || Is_Exported (gnat_entity)))))
gnu_ext_name = create_concat_name (gnat_entity, 0);
- if (const_flag)
- gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type)
- | TYPE_QUAL_CONST));
-
/* If this is constant initialized to a static constant and the
- object has an aggregrate type, force it to be statically
+ object has an aggregate type, force it to be statically
allocated. */
if (const_flag && gnu_expr && TREE_CONSTANT (gnu_expr)
&& host_integerp (TYPE_SIZE_UNIT (gnu_type), 1)
&& (AGGREGATE_TYPE_P (gnu_type)
- && ! (TREE_CODE (gnu_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (gnu_type))))
- static_p = 1;
+ && !(TREE_CODE (gnu_type) == RECORD_TYPE
+ && TYPE_IS_PADDING_P (gnu_type))))
+ static_p = true;
gnu_decl = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type,
gnu_expr, const_flag,
Is_Public (gnat_entity),
imported_p || !definition,
- static_p, attr_list);
- annotate_decl_with_node (gnu_decl, gnat_entity);
+ static_p, attr_list, gnat_entity);
DECL_BY_REF_P (gnu_decl) = used_by_ref;
DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
+ if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
+ {
+ SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
+ DECL_RENAMING_GLOBAL_P (gnu_decl) = global_bindings_p ();
+ }
/* If we have an address clause and we've made this indirect, it's
not enough to merely mark the type as volatile since volatile
if (Present (Address_Clause (gnat_entity)) && used_by_ref)
DECL_POINTER_ALIAS_SET (gnu_decl) = 0;
- add_decl_expr (gnu_decl, gnat_entity);
-
- if (definition && DECL_SIZE (gnu_decl) != 0
+ if (definition && DECL_SIZE (gnu_decl)
&& get_block_jmpbuf_decl ()
&& (TREE_CODE (DECL_SIZE (gnu_decl)) != INTEGER_CST
- || (flag_stack_check && ! STACK_CHECK_BUILTIN
+ || (flag_stack_check && !STACK_CHECK_BUILTIN
&& 0 < compare_tree_int (DECL_SIZE_UNIT (gnu_decl),
STACK_CHECK_MAX_VAR_SIZE))))
add_stmt_with_node (build_call_1_expr
{
tree gnu_corr_var
= create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type,
- gnu_expr, 0, Is_Public (gnat_entity), 0,
- static_p, 0);
+ gnu_expr, false, Is_Public (gnat_entity),
+ false, static_p, NULL, gnat_entity);
- add_decl_expr (gnu_corr_var, gnat_entity);
SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var);
}
/* Back-annotate the Alignment of the object if not already in the
tree. Likewise for Esize if the object is of a constant size.
But if the "object" is actually a pointer to an object, the
- alignment and size are the same as teh type, so don't back-annotate
+ alignment and size are the same as the type, so don't back-annotate
the values for the pointer. */
- if (! used_by_ref && Unknown_Alignment (gnat_entity))
+ if (!used_by_ref && Unknown_Alignment (gnat_entity))
Set_Alignment (gnat_entity,
UI_From_Int (DECL_ALIGN (gnu_decl) / BITS_PER_UNIT));
- if (! used_by_ref && Unknown_Esize (gnat_entity)
- && DECL_SIZE (gnu_decl) != 0)
+ if (!used_by_ref && Unknown_Esize (gnat_entity)
+ && DECL_SIZE (gnu_decl))
{
tree gnu_back_size = DECL_SIZE (gnu_decl);
tree gnu_value = UI_To_gnu (Enumeration_Rep (gnat_literal),
gnu_type);
tree gnu_literal
- = create_var_decl (get_entity_name (gnat_literal),
- 0, gnu_type, gnu_value, 1, 0, 0, 0, 0);
+ = create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
+ gnu_type, gnu_value, true, false, false,
+ false, NULL, gnat_literal);
- add_decl_expr (gnu_literal, gnat_literal);
- save_gnu_tree (gnat_literal, gnu_literal, 0);
+ save_gnu_tree (gnat_literal, gnu_literal, false);
gnu_literal_list = tree_cons (DECL_NAME (gnu_literal),
gnu_value, gnu_literal_list);
}
a modulus of zero, which is otherwise invalid. */
gnu_modulus = UI_To_gnu (Modulus (gnat_entity), gnu_type);
- if (! integer_zerop (gnu_modulus))
+ if (!integer_zerop (gnu_modulus))
{
TYPE_MODULAR_P (gnu_type) = 1;
SET_TYPE_MODULUS (gnu_type, gnu_modulus);
- gnu_high = fold (build (MINUS_EXPR, gnu_type, gnu_modulus,
- convert (gnu_type, integer_one_node)));
+ gnu_high = fold (build2 (MINUS_EXPR, gnu_type, gnu_modulus,
+ convert (gnu_type, integer_one_node)));
}
/* If we have to set TYPE_PRECISION different from its natural value,
it is not one greater than TYPE_MAX_VALUE. */
if (TYPE_PRECISION (gnu_type) != esize
|| (TYPE_MODULAR_P (gnu_type)
- && ! tree_int_cst_equal (TYPE_MAX_VALUE (gnu_type), gnu_high)))
+ && !tree_int_cst_equal (TYPE_MAX_VALUE (gnu_type), gnu_high)))
{
tree gnu_subtype = make_node (INTEGER_TYPE);
if (definition == 0
&& Present (Ancestor_Subtype (gnat_entity))
- && ! In_Extended_Main_Code_Unit (Ancestor_Subtype (gnat_entity))
- && (! Compile_Time_Known_Value (Type_Low_Bound (gnat_entity))
- || ! Compile_Time_Known_Value (Type_High_Bound (gnat_entity))))
+ && !In_Extended_Main_Code_Unit (Ancestor_Subtype (gnat_entity))
+ && (!Compile_Time_Known_Value (Type_Low_Bound (gnat_entity))
+ || !Compile_Time_Known_Value (Type_High_Bound (gnat_entity))))
gnat_to_gnu_entity (Ancestor_Subtype (gnat_entity),
gnu_expr, definition);
so don't blow up if so. */
if (present_gnu_tree (gnat_entity))
{
- maybe_present = 1;
+ maybe_present = true;
break;
}
/* If the type we are dealing with is to represent a packed array,
we need to have the bits left justified on big-endian targets
- (see exp_packd.ads). We build a record with a bitfield of the
- appropriate size to achieve this. */
- if (Is_Packed_Array_Type (gnat_entity) && BYTES_BIG_ENDIAN)
+ and right justified on little-endian targets. We also need to
+ ensure that when the value is read (e.g. for comparison of two
+ such values), we only get the good bits, since the unused bits
+ are uninitialized. Both goals are accomplished by wrapping the
+ modular value in an enclosing struct. */
+ if (Is_Packed_Array_Type (gnat_entity))
{
tree gnu_field_type = gnu_type;
tree gnu_field;
- TYPE_RM_SIZE_INT (gnu_field_type)
+ TYPE_RM_SIZE_NUM (gnu_field_type)
= UI_To_gnu (RM_Size (gnat_entity), bitsizetype);
gnu_type = make_node (RECORD_TYPE);
- TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "LJM");
+ TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "JM");
TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_field_type);
TYPE_PACKED (gnu_type) = 1;
+ /* Create a stripped-down declaration of the original type, mainly
+ for debugging. */
+ create_type_decl (get_entity_name (gnat_entity), gnu_field_type,
+ NULL, true, debug_info_p, gnat_entity);
+
/* Don't notify the field as "addressable", since we won't be taking
it's address and it would prevent create_field_decl from making a
bitfield. */
gnu_field = create_field_decl (get_identifier ("OBJECT"),
gnu_field_type, gnu_type, 1, 0, 0, 0);
- finish_record_type (gnu_type, gnu_field, 0, 0);
- TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_type) = 1;
+ finish_record_type (gnu_type, gnu_field, false, false);
+ TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1;
SET_TYPE_ADA_SIZE (gnu_type, bitsize_int (esize));
}
{
if (definition == 0
&& Present (Ancestor_Subtype (gnat_entity))
- && ! In_Extended_Main_Code_Unit (Ancestor_Subtype (gnat_entity))
- && (! Compile_Time_Known_Value (Type_Low_Bound (gnat_entity))
- || ! Compile_Time_Known_Value (Type_High_Bound (gnat_entity))))
+ && !In_Extended_Main_Code_Unit (Ancestor_Subtype (gnat_entity))
+ && (!Compile_Time_Known_Value (Type_Low_Bound (gnat_entity))
+ || !Compile_Time_Known_Value (Type_High_Bound (gnat_entity))))
gnat_to_gnu_entity (Ancestor_Subtype (gnat_entity),
gnu_expr, definition);
so don't blow up if so. */
if (present_gnu_tree (gnat_entity))
{
- maybe_present = 1;
+ maybe_present = true;
break;
}
suppress expanding incomplete types and save the node as the type
for GNAT_ENTITY. */
gnu_type = make_node (UNCONSTRAINED_ARRAY_TYPE);
- if (! definition)
+ if (!definition)
{
defer_incomplete_level++;
- this_deferred = this_made_decl = 1;
+ this_deferred = this_made_decl = true;
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
- ! Comes_From_Source (gnat_entity),
- debug_info_p);
- save_gnu_tree (gnat_entity, gnu_decl, 0);
- saved = 1;
+ !Comes_From_Source (gnat_entity),
+ debug_info_p, gnat_entity);
+ save_gnu_tree (gnat_entity, gnu_decl, false);
+ saved = true;
}
/* Build the fat pointer type. Use a "void *" object instead of
/* Make sure we can put this into a register. */
TYPE_ALIGN (gnu_fat_type) = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE);
- finish_record_type (gnu_fat_type, tem, 0, 1);
+ finish_record_type (gnu_fat_type, tem, false, true);
/* Build a reference to the template from a PLACEHOLDER_EXPR that
is the fat pointer. This will be used to access the individual
fields once we build them. */
- tem = build (COMPONENT_REF, gnu_ptr_template,
- build (PLACEHOLDER_EXPR, gnu_fat_type),
- TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)), NULL_TREE);
+ tem = build3 (COMPONENT_REF, gnu_ptr_template,
+ build0 (PLACEHOLDER_EXPR, gnu_fat_type),
+ TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)), NULL_TREE);
gnu_template_reference
= build_unary_op (INDIRECT_REF, gnu_template_type, tem);
TREE_READONLY (gnu_template_reference) = 1;
gnu_ind_subtype,
gnu_template_type, 0, 0, 0, 0);
- annotate_decl_with_node (gnu_min_field, gnat_entity);
- annotate_decl_with_node (gnu_max_field, gnat_entity);
+ Sloc_to_locus (Sloc (gnat_entity),
+ &DECL_SOURCE_LOCATION (gnu_min_field));
+ Sloc_to_locus (Sloc (gnat_entity),
+ &DECL_SOURCE_LOCATION (gnu_max_field));
gnu_temp_fields[index] = chainon (gnu_min_field, gnu_max_field);
/* We can't use build_component_ref here since the template
type isn't complete yet. */
- gnu_min = build (COMPONENT_REF, gnu_ind_subtype,
- gnu_template_reference, gnu_min_field, NULL_TREE);
- gnu_max = build (COMPONENT_REF, gnu_ind_subtype,
- gnu_template_reference, gnu_max_field, NULL_TREE);
+ gnu_min = build3 (COMPONENT_REF, gnu_ind_subtype,
+ gnu_template_reference, gnu_min_field,
+ NULL_TREE);
+ gnu_max = build3 (COMPONENT_REF, gnu_ind_subtype,
+ gnu_template_reference, gnu_max_field,
+ NULL_TREE);
TREE_READONLY (gnu_min) = TREE_READONLY (gnu_max) = 1;
/* Make a range type with the new ranges, but using
= chainon (gnu_template_fields, gnu_temp_fields[index]);
/* Install all the fields into the template. */
- finish_record_type (gnu_template_type, gnu_template_fields, 0, 0);
+ finish_record_type (gnu_template_type, gnu_template_fields,
+ false, false);
TYPE_READONLY (gnu_template_type) = 1;
/* Now make the array of arrays and update the pointer to the array
= validate_size (Component_Size (gnat_entity), tem,
gnat_entity,
(Is_Bit_Packed_Array (gnat_entity)
- ? TYPE_DECL : VAR_DECL), 1,
- Has_Component_Size_Clause (gnat_entity));
+ ? TYPE_DECL : VAR_DECL),
+ true, Has_Component_Size_Clause (gnat_entity));
if (Has_Atomic_Components (gnat_entity))
- check_ok_for_atomic (tem, gnat_entity, 1);
+ check_ok_for_atomic (tem, gnat_entity, true);
/* If the component type is a RECORD_TYPE that has a self-referential
size, use the maxium size. */
- if (gnu_comp_size == 0 && TREE_CODE (tem) == RECORD_TYPE
+ if (!gnu_comp_size && TREE_CODE (tem) == RECORD_TYPE
&& CONTAINS_PLACEHOLDER_P (TYPE_SIZE (tem)))
- gnu_comp_size = max_size (TYPE_SIZE (tem), 1);
+ gnu_comp_size = max_size (TYPE_SIZE (tem), true);
- if (! Is_Bit_Packed_Array (gnat_entity) && gnu_comp_size != 0)
+ if (!Is_Bit_Packed_Array (gnat_entity) && gnu_comp_size)
{
- tem = make_type_from_size (tem, gnu_comp_size, 0);
+ tem = make_type_from_size (tem, gnu_comp_size, false);
tem = maybe_pad_type (tem, gnu_comp_size, 0, gnat_entity,
- "C_PAD", 0, definition, 1);
+ "C_PAD", false, definition, true);
}
if (Has_Volatile_Components (gnat_entity))
TYPE_NONALIASED_COMPONENT (tem)
= ((TREE_CODE (TREE_TYPE (tem)) == ARRAY_TYPE
&& TYPE_MULTI_ARRAY_P (TREE_TYPE (tem))) ? 1
- : (! Has_Aliased_Components (gnat_entity)
- && ! AGGREGATE_TYPE_P (TREE_TYPE (tem))));
+ : (!Has_Aliased_Components (gnat_entity)
+ && !AGGREGATE_TYPE_P (TREE_TYPE (tem))));
}
/* If an alignment is specified, use it if valid. But ignore it for
if (No (Packed_Array_Type (gnat_entity))
&& Known_Alignment (gnat_entity))
{
- if (No (Alignment (gnat_entity)))
- gigi_abort (124);
-
+ gcc_assert (Present (Alignment (gnat_entity)));
TYPE_ALIGN (tem)
= validate_alignment (Alignment (gnat_entity), gnat_entity,
TYPE_ALIGN (tem));
/* If the maximum size doesn't overflow, use it. */
if (TREE_CODE (gnu_max_size) == INTEGER_CST
- && ! TREE_OVERFLOW (gnu_max_size))
+ && !TREE_OVERFLOW (gnu_max_size))
TYPE_SIZE (tem)
= size_binop (MIN_EXPR, gnu_max_size, TYPE_SIZE (tem));
if (TREE_CODE (gnu_max_size_unit) == INTEGER_CST
- && ! TREE_OVERFLOW (gnu_max_size_unit))
+ && !TREE_OVERFLOW (gnu_max_size_unit))
TYPE_SIZE_UNIT (tem)
= size_binop (MIN_EXPR, gnu_max_size_unit,
TYPE_SIZE_UNIT (tem));
create_type_decl (create_concat_name (gnat_entity, "XUA"),
- tem, 0, ! Comes_From_Source (gnat_entity),
- debug_info_p);
- rest_of_type_compilation (gnu_fat_type, global_bindings_p ());
+ tem, NULL, !Comes_From_Source (gnat_entity),
+ debug_info_p, gnat_entity);
/* Create a record type for the object and its template and
set the template at a negative offset. */
/* Give the thin pointer type a name. */
create_type_decl (create_concat_name (gnat_entity, "XUX"),
- build_pointer_type (tem), 0,
- ! Comes_From_Source (gnat_entity), debug_info_p);
+ build_pointer_type (tem), NULL,
+ !Comes_From_Source (gnat_entity), debug_info_p,
+ gnat_entity);
}
break;
type. If so, the result is the array type. */
gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
- if (! Is_Constrained (gnat_entity))
+ if (!Is_Constrained (gnat_entity))
break;
else
{
Entity_Id gnat_ind_base_subtype;
tree gnu_base_type = gnu_type;
tree *gnu_index_type = (tree *) alloca (array_dim * sizeof (tree *));
- tree gnu_comp_size = 0;
+ tree gnu_comp_size = NULL_TREE;
tree gnu_max_size = size_one_node;
tree gnu_max_size_unit;
- int need_index_type_struct = 0;
- int max_overflow = 0;
+ bool need_index_type_struct = false;
+ bool max_overflow = false;
/* First create the gnu types for each index. Create types for
debugging information to point to the index types if the
does not overflow in SIZETYPE, ignore the overflow
indications. */
if ((TYPE_PRECISION (gnu_index_subtype)
- > TYPE_PRECISION (sizetype))
+ > TYPE_PRECISION (sizetype)
+ || TYPE_UNSIGNED (gnu_index_subtype)
+ != TYPE_UNSIGNED (sizetype))
&& TREE_CODE (gnu_min) == INTEGER_CST
&& TREE_CODE (gnu_max) == INTEGER_CST
&& TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max)
- && (! TREE_OVERFLOW
- (fold (build (MINUS_EXPR, gnu_index_subtype,
- TYPE_MAX_VALUE (gnu_index_subtype),
- TYPE_MIN_VALUE (gnu_index_subtype))))))
+ && (!TREE_OVERFLOW
+ (fold (build2 (MINUS_EXPR, gnu_index_subtype,
+ TYPE_MAX_VALUE (gnu_index_subtype),
+ TYPE_MIN_VALUE (gnu_index_subtype))))))
TREE_OVERFLOW (gnu_min) = TREE_OVERFLOW (gnu_max)
= TREE_CONSTANT_OVERFLOW (gnu_min)
= TREE_CONSTANT_OVERFLOW (gnu_max) = 0;
/* Similarly, if the range is null, use bounds of 1..0 for
the sizetype bounds. */
else if ((TYPE_PRECISION (gnu_index_subtype)
- > TYPE_PRECISION (sizetype))
+ > TYPE_PRECISION (sizetype)
+ || TYPE_UNSIGNED (gnu_index_subtype)
+ != TYPE_UNSIGNED (sizetype))
&& TREE_CODE (gnu_min) == INTEGER_CST
&& TREE_CODE (gnu_max) == INTEGER_CST
&& (TREE_OVERFLOW (gnu_min) || TREE_OVERFLOW (gnu_max))
code below to malfunction if we don't handle it specially. */
if (TREE_CODE (gnu_base_min) == INTEGER_CST
&& TREE_CODE (gnu_base_max) == INTEGER_CST
- && ! TREE_CONSTANT_OVERFLOW (gnu_base_min)
- && ! TREE_CONSTANT_OVERFLOW (gnu_base_max)
+ && !TREE_CONSTANT_OVERFLOW (gnu_base_min)
+ && !TREE_CONSTANT_OVERFLOW (gnu_base_max)
&& tree_int_cst_lt (gnu_base_max, gnu_base_min))
gnu_high = size_zero_node, gnu_min = size_one_node;
handle each bound separately. */
if ((TREE_CODE (gnu_min) == INTEGER_CST
- && ! TREE_OVERFLOW (gnu_min)
- && ! operand_equal_p (gnu_min, gnu_base_base_min, 0))
- || ! CONTAINS_PLACEHOLDER_P (gnu_min))
+ && !TREE_OVERFLOW (gnu_min)
+ && !operand_equal_p (gnu_min, gnu_base_base_min, 0))
+ || !CONTAINS_PLACEHOLDER_P (gnu_min))
gnu_base_min = gnu_min;
if ((TREE_CODE (gnu_max) == INTEGER_CST
- && ! TREE_OVERFLOW (gnu_max)
- && ! operand_equal_p (gnu_max, gnu_base_base_max, 0))
- || ! CONTAINS_PLACEHOLDER_P (gnu_max))
+ && !TREE_OVERFLOW (gnu_max)
+ && !operand_equal_p (gnu_max, gnu_base_base_max, 0))
+ || !CONTAINS_PLACEHOLDER_P (gnu_max))
gnu_base_max = gnu_max;
if ((TREE_CODE (gnu_base_min) == INTEGER_CST
|| (TREE_CODE (gnu_base_max) == INTEGER_CST
&& TREE_CONSTANT_OVERFLOW (gnu_base_max))
|| operand_equal_p (gnu_base_max, gnu_base_base_max, 0))
- max_overflow = 1;
+ max_overflow = true;
gnu_base_min = size_binop (MAX_EXPR, gnu_base_min, gnu_min);
gnu_base_max = size_binop (MIN_EXPR, gnu_base_max, gnu_max);
if (TREE_CODE (gnu_this_max) == INTEGER_CST
&& TREE_CONSTANT_OVERFLOW (gnu_this_max))
- max_overflow = 1;
+ max_overflow = true;
gnu_max_size
= size_binop (MULT_EXPR, gnu_max_size, gnu_this_max);
- if (! integer_onep (TYPE_MIN_VALUE (gnu_index_subtype))
+ if (!integer_onep (TYPE_MIN_VALUE (gnu_index_subtype))
|| (TREE_CODE (TYPE_MAX_VALUE (gnu_index_subtype))
!= INTEGER_CST)
|| TREE_CODE (gnu_index_subtype) != INTEGER_TYPE
- || (TREE_TYPE (gnu_index_subtype) != 0
+ || (TREE_TYPE (gnu_index_subtype)
&& (TREE_CODE (TREE_TYPE (gnu_index_subtype))
!= INTEGER_TYPE))
|| TYPE_BIASED_REPRESENTATION_P (gnu_index_subtype)
|| (TYPE_PRECISION (gnu_index_subtype)
> TYPE_PRECISION (sizetype)))
- need_index_type_struct = 1;
+ need_index_type_struct = true;
}
/* Then flatten: create the array of arrays. */
so don't blow up if so. */
if (present_gnu_tree (gnat_entity))
{
- maybe_present = 1;
+ maybe_present = true;
break;
}
gnat_entity,
(Is_Bit_Packed_Array (gnat_entity)
? TYPE_DECL : VAR_DECL),
- 1, Has_Component_Size_Clause (gnat_entity));
+ true, Has_Component_Size_Clause (gnat_entity));
/* If the component type is a RECORD_TYPE that has a self-referential
size, use the maxium size. */
- if (gnu_comp_size == 0 && TREE_CODE (gnu_type) == RECORD_TYPE
+ if (!gnu_comp_size && TREE_CODE (gnu_type) == RECORD_TYPE
&& CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
- gnu_comp_size = max_size (TYPE_SIZE (gnu_type), 1);
+ gnu_comp_size = max_size (TYPE_SIZE (gnu_type), true);
- if (! Is_Bit_Packed_Array (gnat_entity) && gnu_comp_size != 0)
+ if (!Is_Bit_Packed_Array (gnat_entity) && gnu_comp_size)
{
- gnu_type = make_type_from_size (gnu_type, gnu_comp_size, 0);
+ gnu_type = make_type_from_size (gnu_type, gnu_comp_size, false);
gnu_type = maybe_pad_type (gnu_type, gnu_comp_size, 0,
- gnat_entity, "C_PAD", 0,
- definition, 1);
+ gnat_entity, "C_PAD", false,
+ definition, true);
}
if (Has_Volatile_Components (Base_Type (gnat_entity)))
TYPE_NONALIASED_COMPONENT (gnu_type)
= ((TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE
&& TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type))) ? 1
- : (! Has_Aliased_Components (gnat_entity)
- && ! AGGREGATE_TYPE_P (TREE_TYPE (gnu_type))));
+ : (!Has_Aliased_Components (gnat_entity)
+ && !AGGREGATE_TYPE_P (TREE_TYPE (gnu_type))));
}
/* If we are at file level and this is a multi-dimensional array, we
if (need_index_type_struct && debug_info_p)
{
tree gnu_bound_rec_type = make_node (RECORD_TYPE);
- tree gnu_field_list = 0;
+ tree gnu_field_list = NULL_TREE;
tree gnu_field;
TYPE_NAME (gnu_bound_rec_type)
gnu_field_list = gnu_field;
}
- finish_record_type (gnu_bound_rec_type, gnu_field_list, 0, 0);
+ finish_record_type (gnu_bound_rec_type, gnu_field_list,
+ false, false);
}
TYPE_CONVENTION_FORTRAN_P (gnu_type)
/* If our size depends on a placeholder and the maximum size doesn't
overflow, use it. */
if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
- && ! (TREE_CODE (gnu_max_size) == INTEGER_CST
- && TREE_OVERFLOW (gnu_max_size))
- && ! (TREE_CODE (gnu_max_size_unit) == INTEGER_CST
- && TREE_OVERFLOW (gnu_max_size_unit))
- && ! max_overflow)
+ && !(TREE_CODE (gnu_max_size) == INTEGER_CST
+ && TREE_OVERFLOW (gnu_max_size))
+ && !(TREE_CODE (gnu_max_size_unit) == INTEGER_CST
+ && TREE_OVERFLOW (gnu_max_size_unit))
+ && !max_overflow)
{
TYPE_SIZE (gnu_type) = size_binop (MIN_EXPR, gnu_max_size,
TYPE_SIZE (gnu_type));
| (TYPE_QUAL_VOLATILE
* Treat_As_Volatile (gnat_entity))));
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
- ! Comes_From_Source (gnat_entity),
- debug_info_p);
- annotate_decl_with_node (gnu_decl, gnat_entity);
- if (! Comes_From_Source (gnat_entity))
+ !Comes_From_Source (gnat_entity),
+ debug_info_p, gnat_entity);
+ if (!Comes_From_Source (gnat_entity))
DECL_ARTIFICIAL (gnu_decl) = 1;
/* Save it as our equivalent in case the call below elaborates
this type again. */
- save_gnu_tree (gnat_entity, gnu_decl, 0);
+ save_gnu_tree (gnat_entity, gnu_decl, false);
gnu_decl = gnat_to_gnu_entity (Packed_Array_Type (gnat_entity),
NULL_TREE, 0);
- this_made_decl = 1;
+ this_made_decl = true;
gnu_inner_type = gnu_type = TREE_TYPE (gnu_decl);
- save_gnu_tree (gnat_entity, NULL_TREE, 0);
+ save_gnu_tree (gnat_entity, NULL_TREE, false);
while (TREE_CODE (gnu_inner_type) == RECORD_TYPE
- && (TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_inner_type)
+ && (TYPE_JUSTIFIED_MODULAR_P (gnu_inner_type)
|| TYPE_IS_PADDING_P (gnu_inner_type)))
gnu_inner_type = TREE_TYPE (TYPE_FIELDS (gnu_inner_type));
the actual bounds can be put into a template. */
if ((TREE_CODE (gnu_inner_type) == ARRAY_TYPE
- && TYPE_ACTUAL_BOUNDS (gnu_inner_type) == 0)
+ && !TYPE_ACTUAL_BOUNDS (gnu_inner_type))
|| (TREE_CODE (gnu_inner_type) == INTEGER_TYPE
- && ! TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner_type)))
+ && !TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner_type)))
{
if (TREE_CODE (gnu_inner_type) == INTEGER_TYPE)
{
nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner_type)));
if (TREE_CODE (gnu_type) == RECORD_TYPE
- && TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_type))
+ && TYPE_JUSTIFIED_MODULAR_P (gnu_type))
TREE_TYPE (TYPE_FIELDS (gnu_type)) = gnu_inner_type;
}
}
/* Abort if packed array with no packed array type field set. */
- else if (Is_Packed (gnat_entity))
- gigi_abort (107);
+ else
+ gcc_assert (!Is_Packed (gnat_entity));
break;
gnu_type
= build_array_type (gnat_to_gnu_type (Component_Type (gnat_entity)),
gnu_index_type);
+ copy_alias_set (gnu_type, gnu_string_type);
}
break;
: (Component_Alignment (gnat_entity)
== Calign_Storage_Unit) ? -1
: 0);
- int has_rep = Has_Specified_Layout (gnat_entity);
- int all_rep = has_rep;
- int is_extension
+ 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);
if ((Ekind (gnat_field) == E_Component
|| Ekind (gnat_field) == E_Discriminant)
&& No (Component_Clause (gnat_field)))
- all_rep = 0;
+ all_rep = false;
/* If this is a record extension, go a level further to find the
record definition. Also, verify we have a Parent_Subtype. */
if (is_extension)
{
- if (! type_annotate_only
+ if (!type_annotate_only
|| Present (Record_Extension_Part (record_definition)))
record_definition = Record_Extension_Part (record_definition);
- if (! type_annotate_only && No (Parent_Subtype (gnat_entity)))
- gigi_abort (121);
+ gcc_assert (type_annotate_only
+ || Present (Parent_Subtype (gnat_entity)));
}
/* Make a node for the record. If we are not defining the record,
DECL_IGNORED_P (TYPE_NAME (gnu_type)) = 0;
TYPE_ALIGN (gnu_type) = 0;
- TYPE_PACKED (gnu_type) = packed != 0 || has_rep;
+ TYPE_PACKED (gnu_type) = packed || has_rep;
- if (! definition)
+ if (!definition)
{
defer_incomplete_level++;
- this_deferred = 1;
+ this_deferred = true;
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
- ! Comes_From_Source (gnat_entity),
- debug_info_p);
- annotate_decl_with_node (gnu_decl, gnat_entity);
- save_gnu_tree (gnat_entity, gnu_decl, 0);
- this_made_decl = saved = 1;
+ !Comes_From_Source (gnat_entity),
+ debug_info_p, gnat_entity);
+ save_gnu_tree (gnat_entity, gnu_decl, false);
+ this_made_decl = saved = true;
}
/* If both a size and rep clause was specified, put the size in
else if (Is_Atomic (gnat_entity))
TYPE_ALIGN (gnu_type)
= (esize >= BITS_PER_WORD ? BITS_PER_WORD
- : 1 << ((floor_log2 (esize) - 1) + 1));
+ : 1 << (floor_log2 (esize - 1) + 1));
/* If we have a Parent_Subtype, make a field for the parent. If
this record has rep clauses, force the position to zero. */
COMPONENT_REF which will be filled in below, once
the parent type can be safely built. */
- gnu_get_parent = build (COMPONENT_REF, void_type_node,
- build (PLACEHOLDER_EXPR, gnu_type),
- build_decl (FIELD_DECL, NULL_TREE,
- NULL_TREE),
- NULL_TREE);
+ gnu_get_parent = build3 (COMPONENT_REF, void_type_node,
+ build0 (PLACEHOLDER_EXPR, gnu_type),
+ build_decl (FIELD_DECL, NULL_TREE,
+ NULL_TREE),
+ NULL_TREE);
if (Has_Discriminants (gnat_entity))
for (gnat_field = First_Stored_Discriminant (gnat_entity);
if (Present (Corresponding_Discriminant (gnat_field)))
save_gnu_tree
(gnat_field,
- build (COMPONENT_REF,
- get_unpadded_type (Etype (gnat_field)),
- gnu_get_parent,
- gnat_to_gnu_entity (Corresponding_Discriminant
- (gnat_field),
- NULL_TREE, 0),
- NULL_TREE),
- 1);
+ build3 (COMPONENT_REF,
+ get_unpadded_type (Etype (gnat_field)),
+ gnu_get_parent,
+ gnat_to_gnu_field_decl (Corresponding_Discriminant
+ (gnat_field)),
+ NULL_TREE),
+ true);
gnu_parent = gnat_to_gnu_type (Parent_Subtype (gnat_entity));
}
/* Add the fields for the discriminants into the record. */
- if (! Is_Unchecked_Union (gnat_entity)
+ if (!Is_Unchecked_Union (gnat_entity)
&& Has_Discriminants (gnat_entity))
for (gnat_field = First_Stored_Discriminant (gnat_entity);
Present (gnat_field);
corresponding GNAT defining identifier. Then add to the
list of fields. */
save_gnu_tree (gnat_field,
- build (COMPONENT_REF, TREE_TYPE (gnu_field),
- build (PLACEHOLDER_EXPR,
- DECL_CONTEXT (gnu_field)),
- gnu_field, NULL_TREE),
- 1);
+ build3 (COMPONENT_REF, TREE_TYPE (gnu_field),
+ build0 (PLACEHOLDER_EXPR,
+ DECL_CONTEXT (gnu_field)),
+ gnu_field, NULL_TREE),
+ true);
TREE_CHAIN (gnu_field) = gnu_field_list;
gnu_field_list = gnu_field;
/* Add the listed fields into the record and finish up. */
components_to_record (gnu_type, Component_List (record_definition),
- gnu_field_list, packed, definition, 0,
- 0, all_rep);
+ gnu_field_list, packed, definition, NULL,
+ false, all_rep, this_deferred);
+
+ if (this_deferred)
+ {
+ debug_deferred = true;
+ defer_debug_level++;
+
+ defer_debug_incomplete_list
+ = tree_cons (NULL_TREE, gnu_type,
+ defer_debug_incomplete_list);
+ }
+
+ /* We used to remove the associations of the discriminants and
+ _Parent for validity checking, but we may need them if there's
+ Freeze_Node for a subtype used in this record. */
TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity);
TYPE_BY_REFERENCE_P (gnu_type) = Is_By_Reference_Type (gnat_entity);
- /* If this is an extension type, reset the tree for any
- inherited discriminants. Also remove the PLACEHOLDER_EXPR
- for non-inherited discriminants. */
- if (! Is_Unchecked_Union (gnat_entity)
- && Has_Discriminants (gnat_entity))
- for (gnat_field = First_Stored_Discriminant (gnat_entity);
- Present (gnat_field);
- gnat_field = Next_Stored_Discriminant (gnat_field))
- {
- if (Present (Parent_Subtype (gnat_entity))
- && Present (Corresponding_Discriminant (gnat_field)))
- save_gnu_tree (gnat_field, NULL_TREE, 0);
- else
- {
- gnu_field = get_gnu_tree (gnat_field);
- save_gnu_tree (gnat_field, NULL_TREE, 0);
- save_gnu_tree (gnat_field, TREE_OPERAND (gnu_field, 1), 0);
- }
- }
-
/* If it is a tagged record force the type to BLKmode to insure
that these objects will always be placed in memory. Do the
same thing for limited record types. */
the same as that of the type we are derived from. We assume here
that the other type is already frozen. */
if (Etype (gnat_entity) != gnat_entity
- && ! (Is_Private_Type (Etype (gnat_entity))
- && Full_View (Etype (gnat_entity)) == gnat_entity))
+ && !(Is_Private_Type (Etype (gnat_entity))
+ && Full_View (Etype (gnat_entity)) == gnat_entity))
copy_alias_set (gnu_type, gnat_to_gnu_type (Etype (gnat_entity)));
/* Fill in locations of fields. */
if ((Ekind (gnat_temp) == E_Component
|| Ekind (gnat_temp) == E_Discriminant)
&& Is_Itype (Etype (gnat_temp))
- && ! present_gnu_tree (gnat_temp))
+ && !present_gnu_tree (gnat_temp))
gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0);
}
break;
{
gnu_decl = gnat_to_gnu_entity (Equivalent_Type (gnat_entity),
NULL_TREE, 0);
- maybe_present = 1;
+ maybe_present = true;
break;
}
{
gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity),
NULL_TREE, 0);
- maybe_present = 1;
+ maybe_present = true;
}
/* Otherwise, first ensure the base type is elaborated. Then, if we are
tree gnu_base_type;
tree gnu_orig_type;
- if (! definition)
- defer_incomplete_level++, this_deferred = 1;
+ if (!definition)
+ defer_incomplete_level++, this_deferred = true;
/* Get the base type initially for its alignment and sizes. But
if it is a padded type, we do all the other work with the
if (present_gnu_tree (gnat_entity))
{
- maybe_present = 1;
+ maybe_present = true;
break;
}
expressions are Is_Constrained but aren't constrained! */
if (IN (Ekind (gnat_base_type), Record_Kind)
- && ! Is_For_Access_Subtype (gnat_entity)
- && ! Is_Unchecked_Union (gnat_base_type)
+ && !Is_For_Access_Subtype (gnat_entity)
+ && !Is_Unchecked_Union (gnat_base_type)
&& Is_Constrained (gnat_entity)
&& Stored_Constraint (gnat_entity) != No_Elist
&& Present (Discriminant_Constraint (gnat_entity)))
{
Entity_Id gnat_field;
- Entity_Id gnat_root_type;
tree gnu_field_list = 0;
tree gnu_pos_list
= compute_field_positions (gnu_orig_type, NULL_TREE,
definition);
tree gnu_temp;
- /* If this is a derived type, we may be seeing fields from any
- original records, so add those positions and discriminant
- substitutions to our lists. */
- for (gnat_root_type = gnat_base_type;
- Underlying_Type (Etype (gnat_root_type)) != gnat_root_type;
- gnat_root_type = Underlying_Type (Etype (gnat_root_type)))
- {
- gnu_pos_list
- = compute_field_positions
- (gnat_to_gnu_type (Etype (gnat_root_type)),
- gnu_pos_list, size_zero_node, bitsize_zero_node,
- BIGGEST_ALIGNMENT);
-
- if (Present (Parent_Subtype (gnat_root_type)))
- gnu_subst_list
- = substitution_list (Parent_Subtype (gnat_root_type),
- Empty, gnu_subst_list, definition);
- }
-
gnu_type = make_node (RECORD_TYPE);
TYPE_NAME (gnu_type) = gnu_entity_id;
TYPE_STUB_DECL (gnu_type)
- = pushdecl (build_decl (TYPE_DECL, NULL_TREE, gnu_type));
+ = create_type_decl (NULL_TREE, gnu_type, NULL, false, false,
+ gnat_entity);
TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type);
for (gnat_field = First_Entity (gnat_entity);
Present (gnat_field); gnat_field = Next_Entity (gnat_field))
- if (Ekind (gnat_field) == E_Component
- || Ekind (gnat_field) == E_Discriminant)
+ if ((Ekind (gnat_field) == E_Component
+ || Ekind (gnat_field) == E_Discriminant)
+ && (Underlying_Type (Scope (Original_Record_Component
+ (gnat_field)))
+ == gnat_base_type)
+ && (No (Corresponding_Discriminant (gnat_field))
+ || !Is_Tagged_Type (gnat_base_type)))
{
tree gnu_old_field
- = gnat_to_gnu_entity
- (Original_Record_Component (gnat_field), NULL_TREE, 0);
+ = gnat_to_gnu_field_decl (Original_Record_Component
+ (gnat_field));
tree gnu_offset
= TREE_VALUE (purpose_member (gnu_old_field,
gnu_pos_list));
/* If there was a component clause, the field types must be
the same for the type and subtype, so copy the data from
- the old field to avoid recomputation here. */
+ the old field to avoid recomputation here. Also if the
+ field is justified modular and the optimization in
+ gnat_to_gnu_field was applied. */
if (Present (Component_Clause
- (Original_Record_Component (gnat_field))))
+ (Original_Record_Component (gnat_field)))
+ || (TREE_CODE (gnu_field_type) == RECORD_TYPE
+ && TYPE_JUSTIFIED_MODULAR_P (gnu_field_type)
+ && TREE_TYPE (TYPE_FIELDS (gnu_field_type))
+ == TREE_TYPE (gnu_old_field)))
{
gnu_size = DECL_SIZE (gnu_old_field);
gnu_field_type = TREE_TYPE (gnu_old_field);
= create_field_decl
(DECL_NAME (gnu_old_field), gnu_field_type, gnu_type,
0, gnu_size, gnu_new_pos,
- ! DECL_NONADDRESSABLE_P (gnu_old_field));
+ !DECL_NONADDRESSABLE_P (gnu_old_field));
- if (! TREE_CONSTANT (gnu_pos))
+ if (!TREE_CONSTANT (gnu_pos))
{
normalize_offset (&gnu_pos, &gnu_bitpos, offset_align);
DECL_FIELD_OFFSET (gnu_field) = gnu_pos;
DECL_INTERNAL_P (gnu_field)
= DECL_INTERNAL_P (gnu_old_field);
SET_DECL_ORIGINAL_FIELD
- (gnu_field, (DECL_ORIGINAL_FIELD (gnu_old_field) != 0
+ (gnu_field, (DECL_ORIGINAL_FIELD (gnu_old_field)
? DECL_ORIGINAL_FIELD (gnu_old_field)
: gnu_old_field));
DECL_DISCRIMINANT_NUMBER (gnu_field)
= TREE_THIS_VOLATILE (gnu_old_field);
TREE_CHAIN (gnu_field) = gnu_field_list;
gnu_field_list = gnu_field;
- save_gnu_tree (gnat_field, gnu_field, 0);
+ save_gnu_tree (gnat_field, gnu_field, false);
}
- finish_record_type (gnu_type, nreverse (gnu_field_list), 1, 0);
+ /* Now go through the entities again looking for Itypes that
+ we have not elaborated but should (e.g., Etypes of fields
+ that have Original_Components). */
+ for (gnat_field = First_Entity (gnat_entity);
+ Present (gnat_field); gnat_field = Next_Entity (gnat_field))
+ if ((Ekind (gnat_field) == E_Discriminant
+ || Ekind (gnat_field) == E_Component)
+ && !present_gnu_tree (Etype (gnat_field)))
+ gnat_to_gnu_entity (Etype (gnat_field), NULL_TREE, 0);
+
+ finish_record_type (gnu_type, nreverse (gnu_field_list),
+ true, false);
/* Now set the size, alignment and alias set of the new type to
match that of the old one, doing any substitutions, as
TREE_PURPOSE (gnu_temp),
TREE_VALUE (gnu_temp));
- if (TYPE_ADA_SIZE (gnu_type) != 0
- && CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (gnu_type)))
+ if (CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (gnu_type)))
for (gnu_temp = gnu_subst_list;
gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
SET_TYPE_ADA_SIZE
gnu_subtype_marker,
0, NULL_TREE,
NULL_TREE, 0),
- 0, 0);
+ false, false);
}
TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity);
TYPE_NAME (gnu_type) = gnu_entity_id;
TYPE_STUB_DECL (gnu_type)
- = pushdecl (build_decl (TYPE_DECL, TYPE_NAME (gnu_type),
- gnu_type));
- DECL_ARTIFICIAL (TYPE_STUB_DECL (gnu_type)) = 1;
- DECL_IGNORED_P (TYPE_STUB_DECL (gnu_type)) = ! debug_info_p;
- rest_of_type_compilation (gnu_type, global_bindings_p ());
+ = create_type_decl (TYPE_NAME (gnu_type), gnu_type,
+ NULL, true, debug_info_p, gnat_entity);
}
/* Otherwise, go down all the components in the new type and
for (gnat_temp = First_Entity (gnat_entity); Present (gnat_temp);
gnat_temp = Next_Entity (gnat_temp))
if ((Ekind (gnat_temp) == E_Discriminant
- && ! Is_Unchecked_Union (gnat_base_type))
+ && !Is_Unchecked_Union (gnat_base_type))
|| Ekind (gnat_temp) == E_Component)
save_gnu_tree (gnat_temp,
- get_gnu_tree
- (Original_Record_Component (gnat_temp)), 0);
+ gnat_to_gnu_field_decl
+ (Original_Record_Component (gnat_temp)), false);
}
break;
/* If we are not defining this entity, and we have incomplete
entities being processed above us, make a dummy type and
fill it in later. */
- if (! definition && defer_incomplete_level != 0)
+ if (!definition && defer_incomplete_level != 0)
{
struct incomplete *p
= (struct incomplete *) xmalloc (sizeof (struct incomplete));
= build_pointer_type
(make_dummy_type (Directly_Designated_Type (gnat_entity)));
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
- ! Comes_From_Source (gnat_entity),
- debug_info_p);
- save_gnu_tree (gnat_entity, gnu_decl, 0);
- this_made_decl = saved = 1;
+ !Comes_From_Source (gnat_entity),
+ debug_info_p, gnat_entity);
+ save_gnu_tree (gnat_entity, gnu_decl, false);
+ this_made_decl = saved = true;
p->old_type = TREE_TYPE (gnu_type);
p->full_type = Directly_Designated_Type (gnat_entity);
? Full_View (gnat_desig_type) : 0);
/* We want to know if we'll be seeing the freeze node for any
incomplete type we may be pointing to. */
- int in_main_unit
+ bool in_main_unit
= (Present (gnat_desig_full)
? In_Extended_Main_Code_Unit (gnat_desig_full)
: In_Extended_Main_Code_Unit (gnat_desig_type));
- int got_fat_p = 0;
- int made_dummy = 0;
- tree gnu_desig_type = 0;
+ bool got_fat_p = false;
+ bool made_dummy = false;
+ tree gnu_desig_type = NULL_TREE;
enum machine_mode p_mode = mode_for_size (esize, MODE_INT, 0);
if (!targetm.valid_pointer_mode (p_mode))
subtype of. This avoids problems with multiple copies of
unconstrained array types. */
if (Ekind (gnat_desig_type) == E_Array_Subtype
- && ! Is_Constrained (gnat_desig_type))
+ && !Is_Constrained (gnat_desig_type))
gnat_desig_type = Etype (gnat_desig_type);
if (Present (gnat_desig_full)
&& Ekind (gnat_desig_full) == E_Array_Subtype
- && ! Is_Constrained (gnat_desig_full))
+ && !Is_Constrained (gnat_desig_full))
gnat_desig_full = Etype (gnat_desig_full);
/* If the designated type is a subtype of an incomplete record type,
/* If we are pointing to an incomplete type whose completion is an
unconstrained array, make a fat pointer type instead of a pointer
to VOID. The two types in our fields will be pointers to VOID and
- will be replaced in update_pointer_to. Similiarly, if the type
+ will be replaced in update_pointer_to. Similarly, if the type
itself is a dummy type or an unconstrained array. Also make
a dummy TYPE_OBJECT_RECORD_TYPE in case we have any thin
pointers to it. */
if ((Present (gnat_desig_full)
&& Is_Array_Type (gnat_desig_full)
- && ! Is_Constrained (gnat_desig_full))
+ && !Is_Constrained (gnat_desig_full))
|| (present_gnu_tree (gnat_desig_type)
&& TYPE_IS_DUMMY_P (TREE_TYPE
(get_gnu_tree (gnat_desig_type)))
&& Is_Array_Type (gnat_desig_type)
- && ! Is_Constrained (gnat_desig_type))
+ && !Is_Constrained (gnat_desig_type))
|| (present_gnu_tree (gnat_desig_type)
&& (TREE_CODE (TREE_TYPE (get_gnu_tree (gnat_desig_type)))
== UNCONSTRAINED_ARRAY_TYPE)
- && (TYPE_POINTER_TO (TREE_TYPE
- (get_gnu_tree (gnat_desig_type)))
- == 0))
- || (No (gnat_desig_full) && ! in_main_unit
- && defer_incomplete_level != 0
- && ! present_gnu_tree (gnat_desig_type)
+ && !(TYPE_POINTER_TO (TREE_TYPE
+ (get_gnu_tree (gnat_desig_type)))))
+ || (No (gnat_desig_full) && !in_main_unit
+ && defer_incomplete_level
+ && !present_gnu_tree (gnat_desig_type)
&& Is_Array_Type (gnat_desig_type)
- && ! Is_Constrained (gnat_desig_type)))
+ && !Is_Constrained (gnat_desig_type)))
{
tree gnu_old
= (present_gnu_tree (gnat_desig_type)
tree fields;
/* Show the dummy we get will be a fat pointer. */
- got_fat_p = made_dummy = 1;
+ got_fat_p = made_dummy = true;
/* If the call above got something that has a pointer, that
pointer is our type. This could have happened either
because the type was elaborated or because somebody
else executed the code below. */
gnu_type = TYPE_POINTER_TO (gnu_old);
- if (gnu_type == 0)
+ if (!gnu_type)
{
gnu_type = make_node (RECORD_TYPE);
SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_old);
TYPE_ALIGN (gnu_type)
= MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE);
TYPE_IS_FAT_POINTER_P (gnu_type) = 1;
- finish_record_type (gnu_type, fields, 0, 1);
+ finish_record_type (gnu_type, fields, false, true);
TYPE_OBJECT_RECORD_TYPE (gnu_old) = make_node (RECORD_TYPE);
TYPE_NAME (TYPE_OBJECT_RECORD_TYPE (gnu_old))
to it. If it is a reference to an incomplete or private type with a
full view that is a record, make a dummy type node and get the
actual type later when we have verified it is safe. */
- else if (! in_main_unit
- && ! present_gnu_tree (gnat_desig_type)
+ else if (!in_main_unit
+ && !present_gnu_tree (gnat_desig_type)
&& Present (gnat_desig_full)
- && ! present_gnu_tree (gnat_desig_full)
+ && !present_gnu_tree (gnat_desig_full)
&& Is_Record_Type (gnat_desig_full))
{
gnu_desig_type = make_dummy_type (gnat_desig_type);
- made_dummy = 1;
+ made_dummy = true;
}
/* Likewise if we are pointing to a record or array and we are to defer
elaborating incomplete types. We do this since this access type
may be the full view of some private type. Note that the
unconstrained array case is handled above. */
- else if ((! in_main_unit || imported_p) && defer_incomplete_level != 0
- && ! present_gnu_tree (gnat_desig_type)
+ else if ((!in_main_unit || imported_p) && defer_incomplete_level != 0
+ && !present_gnu_tree (gnat_desig_type)
&& ((Is_Record_Type (gnat_desig_type)
|| Is_Array_Type (gnat_desig_type))
|| (Present (gnat_desig_full)
|| Is_Array_Type (gnat_desig_full)))))
{
gnu_desig_type = make_dummy_type (gnat_desig_type);
- made_dummy = 1;
+ made_dummy = true;
}
else if (gnat_desig_type == gnat_entity)
{
type. If so, just return it. */
if (present_gnu_tree (gnat_entity))
{
- maybe_present = 1;
+ maybe_present = true;
break;
}
/* If we have a GCC type for the designated type, possibly modify it
if we are pointing only to constant objects and then make a pointer
to it. Don't do this for unconstrained arrays. */
- if (gnu_type == 0 && gnu_desig_type != 0)
+ if (!gnu_type && gnu_desig_type)
{
if (Is_Access_Constant (gnat_entity)
&& TREE_CODE (gnu_desig_type) != UNCONSTRAINED_ARRAY_TYPE)
of the call to gnat_to_gnu_type above if we are processing
an access type for a record component designating the
record type itself. */
- if (! COMPLETE_TYPE_P (gnu_desig_type))
+ if (TYPE_MODE (gnu_desig_type) == VOIDmode)
{
/* We must ensure that the pointer to variant we make will
be processed by update_pointer_to when the initial type
is completed. Pretend we made a dummy and let further
processing act as usual. */
- made_dummy = 1;
+ made_dummy = true;
/* We must ensure that update_pointer_to will not retrieve
the dummy variant when building a properly qualified
actually looking up the actual type, make an entry in the
deferred list. */
- if (! in_main_unit && made_dummy)
+ if (!in_main_unit && made_dummy)
{
tree gnu_old_type
= TYPE_FAT_POINTER_P (gnu_type)
(TYPE_UNCONSTRAINED_ARRAY (gnu_type)));
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
- ! Comes_From_Source (gnat_entity),
- debug_info_p);
- save_gnu_tree (gnat_entity, gnu_decl, 0);
- this_made_decl = saved = 1;
+ !Comes_From_Source (gnat_entity),
+ debug_info_p, gnat_entity);
+ save_gnu_tree (gnat_entity, gnu_decl, false);
+ this_made_decl = saved = true;
if (defer_incomplete_level == 0)
- {
- update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_type),
- gnat_to_gnu_type (gnat_desig_type));
- /* Note that the call to gnat_to_gnu_type here might have
- updated gnu_old_type directly, in which case it is not a
- dummy type any more when we get into update_pointer_to.
-
- This may happen for instance when the designated type is a
- record type, because their elaboration starts with an
- initial node from make_dummy_type, which may yield the same
- node as the one we got.
-
- Besides, variants of this non-dummy type might have been
- created along the way. update_pointer_to is expected to
- properly take care of those situations. */
- }
+ /* Note that the call to gnat_to_gnu_type here might have
+ updated gnu_old_type directly, in which case it is not a
+ dummy type any more when we get into update_pointer_to.
+
+ This may happen for instance when the designated type is a
+ record type, because their elaboration starts with an
+ initial node from make_dummy_type, which may yield the same
+ node as the one we got.
+
+ Besides, variants of this non-dummy type might have been
+ created along the way. update_pointer_to is expected to
+ properly take care of those situations. */
+ update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_type),
+ gnat_to_gnu_type (gnat_desig_type));
else
{
struct incomplete *p
gnu_type = gnat_to_gnu_type (Equivalent_Type (gnat_entity));
if (Is_Itype (Directly_Designated_Type (gnat_entity))
- && ! present_gnu_tree (Directly_Designated_Type (gnat_entity))
+ && !present_gnu_tree (Directly_Designated_Type (gnat_entity))
&& No (Freeze_Node (Directly_Designated_Type (gnat_entity)))
- && ! Is_Record_Type (Scope (Directly_Designated_Type (gnat_entity))))
+ && !Is_Record_Type (Scope (Directly_Designated_Type (gnat_entity))))
gnat_to_gnu_entity (Directly_Designated_Type (gnat_entity),
NULL_TREE, 0);
gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
if (Is_Itype (Directly_Designated_Type (gnat_entity))
- && ! present_gnu_tree (Directly_Designated_Type (gnat_entity))
+ && !present_gnu_tree (Directly_Designated_Type (gnat_entity))
&& Is_Frozen (Directly_Designated_Type (gnat_entity))
&& No (Freeze_Node (Directly_Designated_Type (gnat_entity))))
{
/* If we are not defining this entity, and we have incomplete
entities being processed above us, make a dummy type and
elaborate it later. */
- if (! definition && defer_incomplete_level != 0)
+ if (!definition && defer_incomplete_level != 0)
{
struct incomplete *p
= (struct incomplete *) xmalloc (sizeof (struct incomplete));
p->next = defer_incomplete_list;
defer_incomplete_list = p;
}
- else if
- (IN (Ekind (Base_Type (Directly_Designated_Type (gnat_entity))),
- Incomplete_Or_Private_Kind))
- { ;}
+ else if (IN (Ekind (Base_Type
+ (Directly_Designated_Type (gnat_entity))),
+ Incomplete_Or_Private_Kind))
+ ;
else
gnat_to_gnu_entity (Directly_Designated_Type (gnat_entity),
NULL_TREE, 0);
}
- maybe_present = 1;
+ maybe_present = true;
break;
/* Subprogram Entities
corresponding to that field. This list will be saved in the
TYPE_CI_CO_LIST field of the FUNCTION_TYPE node we create. */
tree gnu_return_list = NULL_TREE;
+ /* If an import pragma asks to map this subprogram to a GCC builtin,
+ this is the builtin DECL node. */
+ tree gnu_builtin_decl = NULL_TREE;
Entity_Id gnat_param;
- int inline_flag = Is_Inlined (gnat_entity);
- int public_flag = Is_Public (gnat_entity);
- int extern_flag
+ bool inline_flag = Is_Inlined (gnat_entity);
+ bool public_flag = Is_Public (gnat_entity);
+ bool extern_flag
= (Is_Public (gnat_entity) && !definition) || imported_p;
- int pure_flag = Is_Pure (gnat_entity);
- int volatile_flag = No_Return (gnat_entity);
- int returns_by_ref = 0;
- int returns_unconstrained = 0;
+ bool pure_flag = Is_Pure (gnat_entity);
+ bool volatile_flag = No_Return (gnat_entity);
+ bool returns_by_ref = false;
+ bool returns_unconstrained = false;
+ bool returns_by_target_ptr = false;
tree gnu_ext_name = create_concat_name (gnat_entity, 0);
- int has_copy_in_out = 0;
+ bool has_copy_in_out = false;
int parmnum;
- if (kind == E_Subprogram_Type && ! definition)
+ if (kind == E_Subprogram_Type && !definition)
/* A parameter may refer to this type, so defer completion
of any incomplete types. */
- defer_incomplete_level++, this_deferred = 1;
+ defer_incomplete_level++, this_deferred = true;
/* If the subprogram has an alias, it is probably inherited, so
we can use the original one. If the original "subprogram"
break;
}
+ /* If this subprogram is expectedly bound to a GCC builtin, fetch the
+ corresponding DECL node.
+
+ We still want the parameter associations to take place because the
+ proper generation of calls depends on it (a GNAT parameter without
+ a corresponding GCC tree has a very specific meaning), so we don't
+ just break here. */
+ if (Convention (gnat_entity) == Convention_Intrinsic)
+ gnu_builtin_decl = builtin_decl_for (gnu_ext_name);
+
+ /* ??? What if we don't find the builtin node above ? warn ? err ?
+ In the current state we neither warn nor err, and calls will just
+ be handled as for regular subprograms. */
+
if (kind == E_Function || kind == E_Subprogram_Type)
gnu_return_type = gnat_to_gnu_type (Etype (gnat_entity));
return type of this function the pointer and mark the decl. */
if (Returns_By_Ref (gnat_entity))
{
- returns_by_ref = 1;
+ returns_by_ref = true;
gnu_return_type = build_pointer_type (gnu_return_type);
}
else if (TREE_CODE (gnu_return_type) == UNCONSTRAINED_ARRAY_TYPE)
{
gnu_return_type = TREE_TYPE (gnu_return_type);
- returns_unconstrained = 1;
+ returns_unconstrained = true;
}
/* If the type requires a transient scope, the result is allocated
else if (Requires_Transient_Scope (Etype (gnat_entity)))
{
gnu_return_type = build_pointer_type (gnu_return_type);
- returns_unconstrained = 1;
+ returns_unconstrained = true;
}
/* If the type is a padded type and the underlying type would not
return the underlying type. */
else if (TREE_CODE (gnu_return_type) == RECORD_TYPE
&& TYPE_IS_PADDING_P (gnu_return_type)
- && (! default_pass_by_ref (TREE_TYPE
- (TYPE_FIELDS (gnu_return_type)))
+ && (!default_pass_by_ref (TREE_TYPE
+ (TYPE_FIELDS (gnu_return_type)))
|| Has_Foreign_Convention (gnat_entity)))
gnu_return_type = TREE_TYPE (TYPE_FIELDS (gnu_return_type));
- /* Look at all our parameters and get the type of
- each. While doing this, build a copy-out structure if
- we need one. */
+ /* If the return type is unconstrained, that means it must have a
+ maximum size. We convert the function into a procedure and its
+ caller will pass a pointer to an object of that maximum size as the
+ first parameter when we call the function. */
+ if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_return_type)))
+ {
+ returns_by_target_ptr = true;
+ gnu_param_list
+ = create_param_decl (get_identifier ("TARGET"),
+ build_reference_type (gnu_return_type),
+ true);
+ gnu_return_type = void_type_node;
+ }
/* If the return type has a size that overflows, we cannot have
a function that returns that type. This usage doesn't make
TYPE_SIZE (gnu_return_type) = bitsize_zero_node;
TYPE_SIZE_UNIT (gnu_return_type) = size_zero_node;
TYPE_MAIN_VARIANT (gnu_return_type) = gnu_return_type;
- TYPE_NEXT_VARIANT (gnu_return_type) = 0;
+ TYPE_NEXT_VARIANT (gnu_return_type) = NULL_TREE;
}
+ /* Look at all our parameters and get the type of
+ each. While doing this, build a copy-out structure if
+ we need one. */
+
for (gnat_param = First_Formal (gnat_entity), parmnum = 0;
Present (gnat_param);
gnat_param = Next_Formal_With_Extras (gnat_param), parmnum++)
tree gnu_param_name = get_entity_name (gnat_param);
tree gnu_param_type = gnat_to_gnu_type (Etype (gnat_param));
tree gnu_param, gnu_field;
- int by_ref_p = 0;
- int by_descr_p = 0;
- int by_component_ptr_p = 0;
- int copy_in_copy_out_flag = 0;
- int req_by_copy = 0, req_by_ref = 0;
+ bool by_ref_p = false;
+ bool by_descr_p = false;
+ bool by_component_ptr_p = false;
+ bool copy_in_copy_out_flag = false;
+ bool req_by_copy = false, req_by_ref = false;
+
+ /* Builtins are expanded inline and there is no real call sequence
+ involved. so the type expected by the underlying expander is
+ always the type of each argument "as is". */
+ if (gnu_builtin_decl)
+ req_by_copy = 1;
- /* See if a Mechanism was supplied that forced this
+ /* Otherwise, see if a Mechanism was supplied that forced this
parameter to be passed one way or another. */
- if (Is_Valued_Procedure (gnat_entity) && parmnum == 0)
- req_by_copy = 1;
+ else if (Is_Valued_Procedure (gnat_entity) && parmnum == 0)
+ req_by_copy = true;
else if (Mechanism (gnat_param) == Default)
;
else if (Mechanism (gnat_param) == By_Copy)
- req_by_copy = 1;
+ req_by_copy = true;
else if (Mechanism (gnat_param) == By_Reference)
- req_by_ref = 1;
+ req_by_ref = true;
else if (Mechanism (gnat_param) <= By_Descriptor)
- by_descr_p = 1;
+ by_descr_p = true;
else if (Mechanism (gnat_param) > 0)
{
if (TREE_CODE (gnu_param_type) == UNCONSTRAINED_ARRAY_TYPE
|| TREE_CODE (TYPE_SIZE (gnu_param_type)) != INTEGER_CST
|| 0 < compare_tree_int (TYPE_SIZE (gnu_param_type),
Mechanism (gnat_param)))
- req_by_ref = 1;
+ req_by_ref = true;
else
- req_by_copy = 1;
+ req_by_copy = true;
}
else
post_error ("unsupported mechanism for&", gnat_param);
/* If this is either a foreign function or if the
- underlying type won't be passed by refererence, strip off
+ underlying type won't be passed by reference, strip off
possible padding type. */
if (TREE_CODE (gnu_param_type) == RECORD_TYPE
&& TYPE_IS_PADDING_P (gnu_param_type)
&& (req_by_ref || Has_Foreign_Convention (gnat_entity)
- || ! must_pass_by_ref (TREE_TYPE (TYPE_FIELDS
- (gnu_param_type)))))
+ || !must_pass_by_ref (TREE_TYPE (TYPE_FIELDS
+ (gnu_param_type)))))
gnu_param_type = TREE_TYPE (TYPE_FIELDS (gnu_param_type));
/* If this is an IN parameter it is read-only, so make a variant
self-referential type. */
if (Ekind (gnat_param) == E_In_Parameter
&& TREE_CODE (gnu_param_type) != UNCONSTRAINED_ARRAY_TYPE
- && ! (TYPE_SIZE (gnu_param_type) != 0
- && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_param_type))))
+ && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_param_type)))
gnu_param_type
= build_qualified_type (gnu_param_type,
(TYPE_QUALS (gnu_param_type)
gnu_param_type
= build_pointer_type
(build_vms_descriptor (gnu_param_type,
- Mechanism (gnat_param),
- gnat_entity));
+ Mechanism (gnat_param), gnat_entity));
else if (Has_Foreign_Convention (gnat_entity)
- && ! req_by_copy
+ && !req_by_copy
&& TREE_CODE (gnu_param_type) == ARRAY_TYPE)
{
/* Strip off any multi-dimensional entries, then strip
&& TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_param_type)))
gnu_param_type = TREE_TYPE (gnu_param_type);
- by_component_ptr_p = 1;
+ by_component_ptr_p = true;
gnu_param_type = TREE_TYPE (gnu_param_type);
if (Ekind (gnat_param) == E_In_Parameter)
&& TYPE_FAT_POINTER_P (gnu_param_type))
gnu_param_type
= make_type_from_size (gnu_param_type,
- size_int (POINTER_SIZE), 0);
+ size_int (POINTER_SIZE), false);
/* If we must pass or were requested to pass by reference, do so.
If we were requested to pass by copy, do so.
all integer and FP types that way too. For Convention Ada,
use the standard Ada default. */
else if (must_pass_by_ref (gnu_param_type) || req_by_ref
- || (! req_by_copy
+ || (!req_by_copy
&& ((Has_Foreign_Convention (gnat_entity)
&& (Ekind (gnat_param) != E_In_Parameter
|| AGGREGATE_TYPE_P (gnu_param_type)))
|| FLOAT_TYPE_P (gnu_param_type)))
/* For convention Ada, see if we pass by reference
by default. */
- || (! Has_Foreign_Convention (gnat_entity)
+ || (!Has_Foreign_Convention (gnat_entity)
&& default_pass_by_ref (gnu_param_type)))))
{
gnu_param_type = build_reference_type (gnu_param_type);
- by_ref_p = 1;
+ by_ref_p = true;
}
else if (Ekind (gnat_param) != E_In_Parameter)
- copy_in_copy_out_flag = 1;
+ copy_in_copy_out_flag = true;
if (req_by_copy && (by_ref_p || by_component_ptr_p))
post_error ("?cannot pass & by copy", gnat_param);
check for packed arrays of records. This may lead to useless
copy-in operations, but in very rare cases only, as these would
be exceptions in a set of already exceptional situations. */
- if (Ekind (gnat_param) == E_Out_Parameter && ! by_ref_p
+ if (Ekind (gnat_param) == E_Out_Parameter && !by_ref_p
&& ((Is_Valued_Procedure (gnat_entity) && parmnum == 0)
- || (! by_descr_p
- && ! POINTER_TYPE_P (gnu_param_type)
- && ! AGGREGATE_TYPE_P (gnu_param_type)))
- && ! (Is_Array_Type (Etype (gnat_param))
- && Is_Packed (Etype (gnat_param))
- && Is_Composite_Type (Component_Type
- (Etype (gnat_param)))))
- gnu_param = 0;
+ || (!by_descr_p
+ && !POINTER_TYPE_P (gnu_param_type)
+ && !AGGREGATE_TYPE_P (gnu_param_type)))
+ && !(Is_Array_Type (Etype (gnat_param))
+ && Is_Packed (Etype (gnat_param))
+ && Is_Composite_Type (Component_Type
+ (Etype (gnat_param)))))
+ gnu_param = NULL_TREE;
else
{
gnu_param
DECL_POINTS_TO_READONLY_P (gnu_param)
= (Ekind (gnat_param) == E_In_Parameter
&& (by_ref_p || by_component_ptr_p));
- annotate_decl_with_node (gnu_param, gnat_param);
- save_gnu_tree (gnat_param, gnu_param, 0);
+ Sloc_to_locus (Sloc (gnat_param),
+ &DECL_SOURCE_LOCATION (gnu_param));
+ save_gnu_tree (gnat_param, gnu_param, false);
gnu_param_list = chainon (gnu_param, gnu_param_list);
/* If a parameter is a pointer, this function may modify
case also handles by-ref parameters. */
if (POINTER_TYPE_P (gnu_param_type)
|| TYPE_FAT_POINTER_P (gnu_param_type))
- pure_flag = 0;
+ pure_flag = false;
}
if (copy_in_copy_out_flag)
{
- if (! has_copy_in_out)
+ if (!has_copy_in_out)
{
- if (TREE_CODE (gnu_return_type) != VOID_TYPE)
- gigi_abort (111);
-
+ gcc_assert (TREE_CODE (gnu_return_type) == VOID_TYPE);
gnu_return_type = make_node (RECORD_TYPE);
TYPE_NAME (gnu_return_type) = get_identifier ("RETURN");
- has_copy_in_out = 1;
+ has_copy_in_out = true;
}
gnu_field = create_field_decl (gnu_param_name, gnu_param_type,
gnu_return_type, 0, 0, 0, 0);
- annotate_decl_with_node (gnu_field, gnat_param);
+ Sloc_to_locus (Sloc (gnat_param),
+ &DECL_SOURCE_LOCATION (gnu_field));
TREE_CHAIN (gnu_field) = gnu_field_list;
gnu_field_list = gnu_field;
gnu_return_list = tree_cons (gnu_field, gnu_param,
/* Do not compute record for out parameters if subprogram is
stubbed since structures are incomplete for the back-end. */
- if (gnu_field_list != 0
+ if (gnu_field_list
&& Convention (gnat_entity) != Convention_Stubbed)
- finish_record_type (gnu_return_type, nreverse (gnu_field_list),
- 0, 0);
+ {
+ /* If all types are not complete, defer emission of debug
+ information for this record types. Otherwise, we risk emitting
+ debug information for a dummy type contained in the fields
+ for that record. */
+ finish_record_type (gnu_return_type, nreverse (gnu_field_list),
+ false, defer_incomplete_level);
+
+ if (defer_incomplete_level)
+ {
+ debug_deferred = true;
+ defer_debug_level++;
+
+ defer_debug_incomplete_list
+ = tree_cons (NULL_TREE, gnu_return_type,
+ defer_debug_incomplete_list);
+ }
+ }
/* If we have a CICO list but it has only one entry, we convert
this function into a function that simply returns that one
attr->next = attr_list;
attr->type = ATTR_MACHINE_ATTRIBUTE;
attr->name = get_identifier ("stdcall");
- attr->arg = NULL_TREE;
+ attr->args = NULL_TREE;
attr->error_point = gnat_entity;
attr_list = attr;
}
= create_subprog_type (gnu_return_type, gnu_param_list,
gnu_return_list, returns_unconstrained,
returns_by_ref,
- Function_Returns_With_DSP (gnat_entity));
-
- /* ??? For now, don't consider nested functions pure. */
- if (! global_bindings_p ())
- pure_flag = 0;
+ Function_Returns_With_DSP (gnat_entity),
+ returns_by_target_ptr);
/* A subprogram (something that doesn't return anything) shouldn't
be considered Pure since there would be no reason for such a
subprogram. Note that procedures with Out (or In Out) parameters
have already been converted into a function with a return type. */
if (TREE_CODE (gnu_return_type) == VOID_TYPE)
- pure_flag = 0;
+ pure_flag = false;
gnu_type
= build_qualified_type (gnu_type,
Sloc_to_locus (Sloc (gnat_entity), &input_location);
+ /* If we have a builtin decl for that function, check the signatures
+ compatibilities. If the signatures are compatible, use the builtin
+ decl. If they are not, we expect the checker predicate to have
+ posted the appropriate errors, and just continue with what we have
+ so far. */
+ if (gnu_builtin_decl)
+ {
+ tree gnu_builtin_type = TREE_TYPE (gnu_builtin_decl);
+
+ if (compatible_signatures_p (gnu_type, gnu_builtin_type))
+ {
+ gnu_decl = gnu_builtin_decl;
+ gnu_type = gnu_builtin_type;
+ break;
+ }
+ }
+
/* If there was no specified Interface_Name and the external and
internal names of the subprogram are the same, only use the
internal name to allow disambiguation of nested subprograms. */
if (No (Interface_Name (gnat_entity)) && gnu_ext_name == gnu_entity_id)
- gnu_ext_name = 0;
+ gnu_ext_name = NULL_TREE;
/* If we are defining the subprogram and it has an Address clause
we must get the address expression from the saved GCC tree for the
make it a constant. */
if (Present (Address_Clause (gnat_entity)))
{
- tree gnu_address = 0;
+ tree gnu_address = NULL_TREE;
if (definition)
gnu_address
? get_gnu_tree (gnat_entity)
: gnat_to_gnu (Expression (Address_Clause (gnat_entity))));
- save_gnu_tree (gnat_entity, NULL_TREE, 0);
+ save_gnu_tree (gnat_entity, NULL_TREE, false);
gnu_type = build_reference_type (gnu_type);
- if (gnu_address != 0)
+ if (gnu_address)
gnu_address = convert (gnu_type, gnu_address);
gnu_decl
= create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type,
- gnu_address, 0, Is_Public (gnat_entity),
- extern_flag, 0, 0);
+ gnu_address, false, Is_Public (gnat_entity),
+ extern_flag, false, NULL, gnat_entity);
DECL_BY_REF_P (gnu_decl) = 1;
- add_decl_expr (gnu_decl, gnat_entity);
}
else if (kind == E_Subprogram_Type)
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
- ! Comes_From_Source (gnat_entity),
- debug_info_p);
+ !Comes_From_Source (gnat_entity),
+ debug_info_p && !defer_incomplete_level,
+ gnat_entity);
else
{
gnu_decl = create_subprog_decl (gnu_entity_id, gnu_ext_name,
gnu_type, gnu_param_list,
inline_flag, public_flag,
- extern_flag, attr_list);
+ extern_flag, attr_list,
+ gnat_entity);
DECL_STUBBED_P (gnu_decl)
= Convention (gnat_entity) == Convention_Stubbed;
}
{
gnu_decl = gnat_to_gnu_entity (Etype (gnat_entity),
NULL_TREE, 0);
- maybe_present = 1;
+ maybe_present = true;
}
break;
type from the full view. But always get the type from the full
view for define on use types, since otherwise we won't see them! */
- else if (! definition
+ else if (!definition
|| (Is_Itype (Full_View (gnat_entity))
&& No (Freeze_Node (gnat_entity)))
|| (Is_Itype (gnat_entity)
{
gnu_decl = gnat_to_gnu_entity (Full_View (gnat_entity),
NULL_TREE, 0);
- maybe_present = 1;
+ maybe_present = true;
break;
}
/* Save this type as the full declaration's type so we can do any needed
updates when we see it. */
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
- ! Comes_From_Source (gnat_entity),
- debug_info_p);
- annotate_decl_with_node (gnu_decl, gnat_entity);
- save_gnu_tree (Full_View (gnat_entity), gnu_decl, 0);
+ !Comes_From_Source (gnat_entity),
+ debug_info_p, gnat_entity);
+ save_gnu_tree (Full_View (gnat_entity), gnu_decl, false);
break;
/* Simple class_wide types are always viewed as their root_type
else
gnu_type = gnat_to_gnu_type (Root_Type (gnat_entity));
- maybe_present = 1;
+ maybe_present = true;
break;
case E_Task_Type:
else
gnu_type = gnat_to_gnu_type (Corresponding_Record_Type (gnat_entity));
- maybe_present = 1;
+ maybe_present = true;
break;
case E_Label:
/* Nothing at all to do here, so just return an ERROR_MARK and claim
we've already saved it, so we don't try to. */
gnu_decl = error_mark_node;
- saved = 1;
+ saved = true;
break;
default:
- gigi_abort (113);
+ gcc_unreachable ();
}
/* If we had a case where we evaluated another type and it might have
if (maybe_present && present_gnu_tree (gnat_entity))
{
gnu_decl = get_gnu_tree (gnat_entity);
- saved = 1;
+ saved = true;
}
/* 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
handling alignment and possible padding. */
- if ((gnu_decl == 0 || this_made_decl) && IN (kind, Type_Kind))
+ if ((!gnu_decl || this_made_decl) && IN (kind, Type_Kind))
{
if (Is_Tagged_Type (gnat_entity)
|| Is_Class_Wide_Equivalent_Type (gnat_entity))
/* ??? Don't set the size for a String_Literal since it is either
confirming or we don't handle it properly (if the low bound is
non-constant). */
- if (gnu_size == 0 && kind != E_String_Literal_Subtype)
+ if (!gnu_size && kind != E_String_Literal_Subtype)
gnu_size = validate_size (Esize (gnat_entity), gnu_type, gnat_entity,
- TYPE_DECL, 0, Has_Size_Clause (gnat_entity));
+ TYPE_DECL, false,
+ Has_Size_Clause (gnat_entity));
/* If a size was specified, see if we can make a new type of that size
by rearranging the type, for example from a fat to a thin pointer. */
- if (gnu_size != 0)
+ if (gnu_size)
{
gnu_type
= make_type_from_size (gnu_type, gnu_size,
else if (Known_Alignment (gnat_entity))
align = validate_alignment (Alignment (gnat_entity), gnat_entity,
TYPE_ALIGN (gnu_type));
- else if (Is_Atomic (gnat_entity) && gnu_size == 0
+ else if (Is_Atomic (gnat_entity) && !gnu_size
&& host_integerp (TYPE_SIZE (gnu_type), 1)
&& integer_pow2p (TYPE_SIZE (gnu_type)))
align = MIN (BIGGEST_ALIGNMENT,
tree_low_cst (TYPE_SIZE (gnu_type), 1));
- else if (Is_Atomic (gnat_entity) && gnu_size != 0
+ else if (Is_Atomic (gnat_entity) && gnu_size
&& host_integerp (gnu_size, 1)
&& integer_pow2p (gnu_size))
align = MIN (BIGGEST_ALIGNMENT, tree_low_cst (gnu_size, 1));
/* See if we need to pad the type. If we did, and made a record,
the name of the new type may be changed. So get it back for
us when we make the new TYPE_DECL below. */
- gnu_type = maybe_pad_type (gnu_type, gnu_size, align,
- gnat_entity, "PAD", 1, definition, 0);
+ gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity, "PAD",
+ true, definition, false);
if (TREE_CODE (gnu_type) == RECORD_TYPE
&& TYPE_IS_PADDING_P (gnu_type))
{
make a variable for the size rather than calculating it each time.
Handle both the RM size and the actual size. */
if (global_bindings_p ()
- && TYPE_SIZE (gnu_type) != 0
- && ! TREE_CONSTANT (TYPE_SIZE (gnu_type))
- && ! CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
+ && TYPE_SIZE (gnu_type)
+ && !TREE_CONSTANT (TYPE_SIZE (gnu_type))
+ && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
{
if (TREE_CODE (gnu_type) == RECORD_TYPE
&& operand_equal_p (TYPE_ADA_SIZE (gnu_type),
In GCC 3.4, we'll use DECL_OFFSET_ALIGN in some way, but
right now, we have to put in an explicit multiply and
divide by that value. */
- if (! CONTAINS_PLACEHOLDER_P (DECL_FIELD_OFFSET (gnu_field)))
+ if (!CONTAINS_PLACEHOLDER_P (DECL_FIELD_OFFSET (gnu_field)))
DECL_FIELD_OFFSET (gnu_field)
= build_binary_op
(MULT_EXPR, sizetype,
* Treat_As_Volatile (gnat_entity))));
if (Is_Atomic (gnat_entity))
- check_ok_for_atomic (gnu_type, gnat_entity, 0);
+ check_ok_for_atomic (gnu_type, gnat_entity, false);
if (Known_Alignment (gnat_entity))
TYPE_USER_ALIGN (gnu_type) = 1;
- if (gnu_decl == 0)
- {
- gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
- ! Comes_From_Source (gnat_entity),
- debug_info_p);
- annotate_decl_with_node (gnu_decl, gnat_entity);
- }
+ if (!gnu_decl)
+ gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
+ !Comes_From_Source (gnat_entity),
+ debug_info_p, gnat_entity);
else
TREE_TYPE (gnu_decl) = gnu_type;
-
- add_decl_expr (gnu_decl, gnat_entity);
}
- if (IN (kind, Type_Kind) && ! TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl)))
+ if (IN (kind, Type_Kind) && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl)))
{
gnu_type = TREE_TYPE (gnu_decl);
Set_Alignment (gnat_entity,
UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
- if (Unknown_Esize (gnat_entity) && TYPE_SIZE (gnu_type) != 0)
+ if (Unknown_Esize (gnat_entity) && TYPE_SIZE (gnu_type))
{
/* If the size is self-referential, we annotate the maximum
value of that size. */
tree gnu_size = TYPE_SIZE (gnu_type);
if (CONTAINS_PLACEHOLDER_P (gnu_size))
- gnu_size = max_size (gnu_size, 1);
+ gnu_size = max_size (gnu_size, true);
Set_Esize (gnat_entity, annotate_value (gnu_size));
}
}
- if (Unknown_RM_Size (gnat_entity) && rm_size (gnu_type) != 0)
+ if (Unknown_RM_Size (gnat_entity) && rm_size (gnu_type))
Set_RM_Size (gnat_entity, annotate_value (rm_size (gnu_type)));
}
- if (! Comes_From_Source (gnat_entity) && DECL_P (gnu_decl))
+ if (!Comes_From_Source (gnat_entity) && DECL_P (gnu_decl))
DECL_ARTIFICIAL (gnu_decl) = 1;
- if (! debug_info_p && DECL_P (gnu_decl)
+ if (!debug_info_p && DECL_P (gnu_decl)
&& TREE_CODE (gnu_decl) != FUNCTION_DECL)
DECL_IGNORED_P (gnu_decl) = 1;
/* If we haven't already, associate the ..._DECL node that we just made with
the input GNAT entity node. */
- if (! saved)
- save_gnu_tree (gnat_entity, gnu_decl, 0);
+ if (!saved)
+ save_gnu_tree (gnat_entity, gnu_decl, false);
/* 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.
enumeration literal table, if needed. */
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)))
{
tree gnu_scalar_type = gnu_type;
/* If this is a floating point type and we haven't set a floating
point type yet, use this in the evaluation of the bounds. */
- if (longest_float_type_node == 0 && kind == E_Floating_Point_Type)
+ if (!longest_float_type_node && kind == E_Floating_Point_Type)
longest_float_type_node = gnu_type;
TYPE_MIN_VALUE (gnu_scalar_type)
TYPE_MAX_VALUE (gnu_scalar_type)
= gnat_to_gnu (Type_High_Bound (gnat_entity));
- if (kind == E_Enumeration_Type)
+ if (TREE_CODE (gnu_scalar_type) == ENUMERAL_TYPE)
{
TYPE_STUB_DECL (gnu_scalar_type) = gnu_decl;
/* If we deferred processing of incomplete types, re-enable it. If there
were no other disables and we have some to process, do so. */
- if (this_deferred && --defer_incomplete_level == 0
- && defer_incomplete_list != 0)
+ if (this_deferred && --defer_incomplete_level == 0 && defer_incomplete_list)
{
struct incomplete *incp = defer_incomplete_list;
struct incomplete *next;
- defer_incomplete_list = 0;
+ defer_incomplete_list = NULL;
for (; incp; incp = next)
{
next = incp->next;
- if (incp->old_type != 0)
+ if (incp->old_type)
update_pointer_to (TYPE_MAIN_VARIANT (incp->old_type),
gnat_to_gnu_type (incp->full_type));
free (incp);
/* If we are not defining this type, see if it's in the incomplete list.
If so, handle that list entry now. */
- else if (! definition)
+ else if (!definition)
{
struct incomplete *incp;
for (incp = defer_incomplete_list; incp; incp = incp->next)
- if (incp->old_type != 0 && incp->full_type == gnat_entity)
+ if (incp->old_type && incp->full_type == gnat_entity)
{
update_pointer_to (TYPE_MAIN_VARIANT (incp->old_type),
TREE_TYPE (gnu_decl));
- incp->old_type = 0;
+ incp->old_type = NULL_TREE;
}
}
+ /* If there are no incomplete types and we have deferred emission
+ of debug information, check whether we have finished defining
+ all nested records.
+ If so, handle the list now. */
+
+ if (debug_deferred)
+ defer_debug_level--;
+
+ if (defer_debug_incomplete_list
+ && !defer_incomplete_level
+ && !defer_debug_level)
+ {
+ tree c, n;
+
+ defer_debug_incomplete_list = nreverse (defer_debug_incomplete_list);
+
+ for (c = defer_debug_incomplete_list; c; c = n)
+ {
+ n = TREE_CHAIN (c);
+ write_record_type_debug_info (TREE_VALUE (c));
+ }
+
+ defer_debug_incomplete_list = 0;
+ }
+
if (this_global)
force_global--;
if (Is_Packed_Array_Type (gnat_entity)
&& Is_Itype (Associated_Node_For_Itype (gnat_entity))
&& No (Freeze_Node (Associated_Node_For_Itype (gnat_entity)))
- && ! present_gnu_tree (Associated_Node_For_Itype (gnat_entity)))
+ && !present_gnu_tree (Associated_Node_For_Itype (gnat_entity)))
gnat_to_gnu_entity (Associated_Node_For_Itype (gnat_entity), NULL_TREE, 0);
return gnu_decl;
}
+
+/* Similar, but if the returned value is a COMPONENT_REF, return the
+ FIELD_DECL. */
+
+tree
+gnat_to_gnu_field_decl (Entity_Id gnat_entity)
+{
+ tree gnu_field = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
+
+ if (TREE_CODE (gnu_field) == COMPONENT_REF)
+ gnu_field = TREE_OPERAND (gnu_field, 1);
+
+ return gnu_field;
+}
\f
/* Given GNAT_ENTITY, elaborate all expressions that are required to
be elaborated at the point of its definition, but do nothing else. */
is needed until the front stops generating bogus conversions
on bounds of real types. */
- if (! Raises_Constraint_Error (gnat_lb))
+ if (!Raises_Constraint_Error (gnat_lb))
elaborate_expression (gnat_lb, gnat_entity, get_identifier ("L"),
1, 0, Needs_Debug_Info (gnat_entity));
- if (! Raises_Constraint_Error (gnat_hb))
+ if (!Raises_Constraint_Error (gnat_hb))
elaborate_expression (gnat_hb, gnat_entity, get_identifier ("U"),
1, 0, Needs_Debug_Info (gnat_entity));
break;
gnat_field = Next_Discriminant (gnat_field),
gnat_discriminant_expr = Next_Elmt (gnat_discriminant_expr))
/* ??? For now, ignore access discriminants. */
- if (! Is_Access_Type (Etype (Node (gnat_discriminant_expr))))
+ if (!Is_Access_Type (Etype (Node (gnat_discriminant_expr))))
elaborate_expression (Node (gnat_discriminant_expr),
gnat_entity,
get_entity_name (gnat_field), 1, 0, 0);
a subprogram or parameter. We could refine this, but it isn't
worth it. If this is statically allocated, it is supposed to
hang around out of cope. */
- if (present_gnu_tree (gnat_entity) && ! Is_Statically_Allocated (gnat_entity)
- && kind != E_Procedure && kind != E_Function && ! IN (kind, Formal_Kind))
+ if (present_gnu_tree (gnat_entity) && !Is_Statically_Allocated (gnat_entity)
+ && kind != E_Procedure && kind != E_Function && !IN (kind, Formal_Kind))
{
- save_gnu_tree (gnat_entity, NULL_TREE, 1);
- save_gnu_tree (gnat_entity, error_mark_node, 1);
+ save_gnu_tree (gnat_entity, NULL_TREE, true);
+ save_gnu_tree (gnat_entity, error_mark_node, true);
}
}
\f
static void
copy_alias_set (tree gnu_new_type, tree gnu_old_type)
{
+ /* Remove any padding from GNU_OLD_TYPE. It doesn't matter in the case
+ of a one-dimensional array, since the padding has the same alias set
+ as the field type, but if it's a multi-dimensional array, we need to
+ see the inner types. */
+ while (TREE_CODE (gnu_old_type) == RECORD_TYPE
+ && (TYPE_JUSTIFIED_MODULAR_P (gnu_old_type)
+ || TYPE_IS_PADDING_P (gnu_old_type)))
+ gnu_old_type = TREE_TYPE (TYPE_FIELDS (gnu_old_type));
+
+ /* We need to be careful here in case GNU_OLD_TYPE is an unconstrained
+ array. In that case, it doesn't have the same shape as GNU_NEW_TYPE,
+ so we need to go down to what does. */
+ if (TREE_CODE (gnu_old_type) == UNCONSTRAINED_ARRAY_TYPE)
+ gnu_old_type
+ = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_old_type))));
+
if (TREE_CODE (gnu_new_type) == ARRAY_TYPE
&& TREE_CODE (TREE_TYPE (gnu_new_type)) == ARRAY_TYPE
&& TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_new_type)))
- {
- /* We need to be careful here in case GNU_OLD_TYPE is an unconstrained
- array. In that case, it doesn't have the same shape as GNU_NEW_TYPE,
- so we need to go down to what does. */
- if (TREE_CODE (gnu_old_type) == UNCONSTRAINED_ARRAY_TYPE)
- gnu_old_type
- = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_old_type))));
-
- copy_alias_set (TREE_TYPE (gnu_new_type), TREE_TYPE (gnu_old_type));
- }
+ copy_alias_set (TREE_TYPE (gnu_new_type), TREE_TYPE (gnu_old_type));
TYPE_ALIAS_SET (gnu_new_type) = get_alias_set (gnu_old_type);
record_component_aliases (gnu_new_type);
/* Return a TREE_LIST describing the substitutions needed to reflect
discriminant substitutions from GNAT_SUBTYPE to GNAT_TYPE and add
them to GNU_LIST. If GNAT_TYPE is not specified, use the base type
- of GNAT_SUBTYPE. The substitions can be in any order. TREE_PURPOSE
+ of GNAT_SUBTYPE. The substitutions can be in any order. TREE_PURPOSE
gives the tree for the discriminant and TREE_VALUES is the replacement
value. They are in the form of operands to substitute_in_expr.
DEFINITION is as in gnat_to_gnu_entity. */
static tree
-substitution_list (Entity_Id gnat_subtype,
- Entity_Id gnat_type,
- tree gnu_list,
- int definition)
+substitution_list (Entity_Id gnat_subtype, Entity_Id gnat_type,
+ tree gnu_list, bool definition)
{
Entity_Id gnat_discrim;
Node_Id gnat_value;
gnat_discrim = Next_Stored_Discriminant (gnat_discrim),
gnat_value = Next_Elmt (gnat_value))
/* Ignore access discriminants. */
- if (! Is_Access_Type (Etype (Node (gnat_value))))
- gnu_list = tree_cons (gnat_to_gnu_entity (gnat_discrim, NULL_TREE, 0),
- elaborate_expression
+ if (!Is_Access_Type (Etype (Node (gnat_value))))
+ gnu_list = tree_cons (gnat_to_gnu_field_decl (gnat_discrim),
+ elaborate_expression
(Node (gnat_value), gnat_subtype,
get_entity_name (gnat_discrim), definition,
1, 0),
/* If this is a record, make this a RECORD_TYPE or UNION_TYPE; else make
it a VOID_TYPE. */
- if (Is_Record_Type (gnat_underlying))
- gnu_type = make_node (Is_Unchecked_Union (gnat_underlying)
- ? UNION_TYPE : RECORD_TYPE);
+ if (Is_Unchecked_Union (gnat_underlying))
+ {
+ gnu_type = make_node (UNION_TYPE);
+ TYPE_UNCHECKED_UNION_P (gnu_type) = 1;
+ }
+ else if (Is_Record_Type (gnat_underlying))
+ gnu_type = make_node (RECORD_TYPE);
else
gnu_type = make_node (ENUMERAL_TYPE);
TYPE_NAME (gnu_type) = get_entity_name (gnat_type);
+ TYPE_DUMMY_P (gnu_type) = 1;
if (AGGREGATE_TYPE_P (gnu_type))
- TYPE_STUB_DECL (gnu_type)
- = pushdecl (build_decl (TYPE_DECL, NULL_TREE, gnu_type));
+ TYPE_STUB_DECL (gnu_type) = build_decl (TYPE_DECL, NULL_TREE, gnu_type);
- TYPE_DUMMY_P (gnu_type) = 1;
dummy_node_table[gnat_underlying] = gnu_type;
return gnu_type;
}
\f
-/* Return 1 if the size represented by GNU_SIZE can be handled by an
- allocation. If STATIC_P is non-zero, consider only what can be
- done with a static allocation. */
+/* Return true if the size represented by GNU_SIZE can be handled by an
+ allocation. If STATIC_P is true, consider only what can be done with a
+ static allocation. */
-static int
-allocatable_size_p (tree gnu_size, int static_p)
+static bool
+allocatable_size_p (tree gnu_size, bool static_p)
{
HOST_WIDE_INT our_size;
/* If this is not a static allocation, the only case we want to forbid
is an overflowing size. That will be converted into a raise a
Storage_Error. */
- if (! static_p)
- return ! (TREE_CODE (gnu_size) == INTEGER_CST
- && TREE_CONSTANT_OVERFLOW (gnu_size));
+ if (!static_p)
+ return !(TREE_CODE (gnu_size) == INTEGER_CST
+ && TREE_CONSTANT_OVERFLOW (gnu_size));
/* Otherwise, we need to deal with both variable sizes and constant
sizes that won't fit in a host int. We use int instead of HOST_WIDE_INT
since assemblers may not like very large sizes. */
if (!host_integerp (gnu_size, 1))
- return 0;
+ return false;
our_size = tree_low_cst (gnu_size, 1);
return (int) our_size == our_size;
}
\f
-/* Return a list of attributes for GNAT_ENTITY, if any. */
+/* Prepend to ATTR_LIST the list of attributes for GNAT_ENTITY, if any. */
-static struct attrib *
-build_attr_list (Entity_Id gnat_entity)
+static void
+prepend_attributes (Entity_Id gnat_entity, struct attrib ** attr_list)
{
- struct attrib *attr_list = 0;
Node_Id gnat_temp;
for (gnat_temp = First_Rep_Item (gnat_entity); Present (gnat_temp);
if (Nkind (gnat_temp) == N_Pragma)
{
struct attrib *attr;
- tree gnu_arg0 = 0, gnu_arg1 = 0;
+ tree gnu_arg0 = NULL_TREE, gnu_arg1 = NULL_TREE;
Node_Id gnat_assoc = Pragma_Argument_Associations (gnat_temp);
enum attr_type etype;
}
attr = (struct attrib *) xmalloc (sizeof (struct attrib));
- attr->next = attr_list;
+ attr->next = *attr_list;
attr->type = etype;
attr->name = gnu_arg0;
- attr->arg = gnu_arg1;
+
+ /* If we have an argument specified together with an attribute name,
+ make it a single TREE_VALUE entry in a list of arguments, as GCC
+ expects it. */
+ if (gnu_arg1 != NULL_TREE)
+ attr->args = build_tree_list (NULL_TREE, gnu_arg1);
+ else
+ attr->args = NULL_TREE;
+
attr->error_point
= Present (Next (First (gnat_assoc)))
? Expression (Next (First (gnat_assoc))) : gnat_temp;
- attr_list = attr;
+ *attr_list = attr;
}
-
- return attr_list;
}
\f
/* Get the unpadded version of a GNAT type. */
/* If we don't need a value and this is static or a discriment, we
don't need to do anything. */
- else if (! need_value
+ else if (!need_value
&& (Is_OK_Static_Expression (gnat_expr)
|| (Nkind (gnat_expr) == N_Identifier
&& Ekind (Entity (gnat_expr)) == E_Discriminant)))
return 0;
- /* Otherwise, convert this tree to its GCC equivalant. */
+ /* Otherwise, convert this tree to its GCC equivalent. */
gnu_expr
= elaborate_expression_1 (gnat_expr, gnat_entity, gnat_to_gnu (gnat_expr),
gnu_name, definition, need_debug);
/* Save the expression in case we try to elaborate this entity again. Since
this is not a DECL, don't check it. Don't save if it's a discriminant. */
- if (! CONTAINS_PLACEHOLDER_P (gnu_expr))
- save_gnu_tree (gnat_expr, gnu_expr, 1);
+ if (!CONTAINS_PLACEHOLDER_P (gnu_expr))
+ save_gnu_tree (gnat_expr, gnu_expr, true);
return need_value ? gnu_expr : error_mark_node;
}
tree gnu_expr, tree gnu_name, bool definition,
bool need_debug)
{
- tree gnu_decl = 0;
+ tree gnu_decl = NULL_TREE;
/* Strip any conversions to see if the expression is a readonly variable.
??? This really should remain readonly, but we have to think about
the typing of the tree here. */
- tree gnu_inner_expr = remove_conversions (gnu_expr, 1);
- int expr_global = Is_Public (gnat_entity) || global_bindings_p ();
- int expr_variable;
+ tree gnu_inner_expr = remove_conversions (gnu_expr, true);
+ bool expr_global = Is_Public (gnat_entity) || global_bindings_p ();
+ bool expr_variable;
/* In most cases, we won't see a naked FIELD_DECL here because a
discriminant reference will have been replaced with a COMPONENT_REF
here. We have to hope it will be at the highest level of the
expression in these cases. */
if (TREE_CODE (gnu_expr) == FIELD_DECL)
- gnu_expr = build (COMPONENT_REF, TREE_TYPE (gnu_expr),
- build (PLACEHOLDER_EXPR, DECL_CONTEXT (gnu_expr)),
- gnu_expr, NULL_TREE);
+ gnu_expr = build3 (COMPONENT_REF, TREE_TYPE (gnu_expr),
+ build0 (PLACEHOLDER_EXPR, DECL_CONTEXT (gnu_expr)),
+ gnu_expr, NULL_TREE);
/* If GNU_EXPR is neither a placeholder nor a constant, nor a variable
that is a constant, make a variable that is initialized to contain the
rely here on the fact that an expression cannot contain both the
discriminant and some other variable. */
- expr_variable = (TREE_CODE_CLASS (TREE_CODE (gnu_expr)) != 'c'
- && ! (TREE_CODE (gnu_inner_expr) == VAR_DECL
- && TREE_READONLY (gnu_inner_expr))
- && ! CONTAINS_PLACEHOLDER_P (gnu_expr));
+ expr_variable = (!CONSTANT_CLASS_P (gnu_expr)
+ && !(TREE_CODE (gnu_inner_expr) == VAR_DECL
+ && TREE_READONLY (gnu_inner_expr))
+ && !CONTAINS_PLACEHOLDER_P (gnu_expr));
/* If this is a static expression or contains a discriminant, we don't
need the variable for debugging (and can't elaborate anyway if a
if (need_debug
&& (Is_OK_Static_Expression (gnat_expr)
|| CONTAINS_PLACEHOLDER_P (gnu_expr)))
- need_debug = 0;
+ need_debug = false;
/* Now create the variable if we need it. */
if (need_debug || (expr_variable && expr_global))
- {
- gnu_decl
- = create_var_decl (create_concat_name (gnat_entity,
- IDENTIFIER_POINTER (gnu_name)),
- NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, 1,
- Is_Public (gnat_entity), ! definition, 0, 0);
- annotate_decl_with_node (gnu_decl, gnat_entity);
- add_decl_expr (gnu_decl, gnat_entity);
- }
+ gnu_decl
+ = create_var_decl (create_concat_name (gnat_entity,
+ IDENTIFIER_POINTER (gnu_name)),
+ NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, true,
+ Is_Public (gnat_entity), !definition, false, NULL,
+ gnat_entity);
/* We only need to use this variable if we are in global context since GCC
can do the right thing in the local case. */
if (expr_global && expr_variable)
return gnu_decl;
- else if (! expr_variable)
+ else if (!expr_variable)
return gnu_expr;
else
return maybe_variable (gnu_expr);
make_aligning_type (tree type, int align, tree size)
{
tree record_type = make_node (RECORD_TYPE);
- tree place = build (PLACEHOLDER_EXPR, record_type);
+ tree place = build0 (PLACEHOLDER_EXPR, record_type);
tree size_addr_place = convert (sizetype,
build_unary_op (ADDR_EXPR, NULL_TREE,
place));
/* The bit position is obtained by "and"ing the alignment minus 1
with the two's complement of the address and multiplying
by the number of bits per unit. Do all this in sizetype. */
-
pos = size_binop (MULT_EXPR,
convert (bitsizetype,
size_binop (BIT_AND_EXPR,
- 1))),
bitsize_unit_node);
- field = create_field_decl (get_identifier ("F"), type, record_type,
- 1, size, pos, 1);
- DECL_BIT_FIELD (field) = 0;
+ /* Create the field, with -1 as the 'addressable' indication to avoid the
+ creation of a bitfield. We don't need one, it would have damaging
+ consequences on the alignment computation, and create_field_decl would
+ make one without this special argument, for instance because of the
+ complex position expression. */
+ field = create_field_decl (get_identifier ("F"), type, record_type, 1, size,
+ pos, -1);
- finish_record_type (record_type, field, 1, 0);
+ finish_record_type (record_type, field, true, false);
TYPE_ALIGN (record_type) = BIGGEST_ALIGNMENT;
TYPE_SIZE (record_type)
= size_binop (PLUS_EXPR,
the alignment to try for an integral type. For QUAL_UNION_TYPE,
also copy the size. */
TYPE_NAME (new_type) = TYPE_NAME (type);
- TYPE_LEFT_JUSTIFIED_MODULAR_P (new_type)
- = TYPE_LEFT_JUSTIFIED_MODULAR_P (type);
+ TYPE_JUSTIFIED_MODULAR_P (new_type)
+ = TYPE_JUSTIFIED_MODULAR_P (type);
TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type);
if (TREE_CODE (type) == RECORD_TYPE)
<< (floor_log2 (tree_low_cst (TYPE_SIZE (type), 1) - 1) + 1));
/* Now copy the fields, keeping the position and size. */
- for (old_field = TYPE_FIELDS (type); old_field != 0;
+ for (old_field = TYPE_FIELDS (type); old_field;
old_field = TREE_CHAIN (old_field))
{
tree new_field_type = TREE_TYPE (old_field);
new_type, TYPE_PACKED (type),
DECL_SIZE (old_field),
bit_position (old_field),
- ! DECL_NONADDRESSABLE_P (old_field));
+ !DECL_NONADDRESSABLE_P (old_field));
DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
SET_DECL_ORIGINAL_FIELD
- (new_field, (DECL_ORIGINAL_FIELD (old_field) != 0
+ (new_field, (DECL_ORIGINAL_FIELD (old_field)
? DECL_ORIGINAL_FIELD (old_field) : old_field));
if (TREE_CODE (new_type) == QUAL_UNION_TYPE)
field_list = new_field;
}
- finish_record_type (new_type, nreverse (field_list), 1, 1);
+ finish_record_type (new_type, nreverse (field_list), true, true);
copy_alias_set (new_type, type);
return TYPE_MODE (new_type) == BLKmode ? type : new_type;
}
GNAT_ENTITY and NAME_TRAILER are used to name the resulting record and
to issue a warning.
- IS_USER_TYPE is nonzero if we must be sure we complete the original type.
+ IS_USER_TYPE is true if we must be sure we complete the original type.
- DEFINITION is nonzero if this type is being defined.
+ DEFINITION is true if this type is being defined.
- SAME_RM_SIZE is nonzero if the RM_Size of the resulting type is to be
+ SAME_RM_SIZE is true if the RM_Size of the resulting type is to be
set to its TYPE_SIZE; otherwise, it's set to the RM_Size of the original
type. */
-static tree
+tree
maybe_pad_type (tree type, tree size, unsigned int align,
Entity_Id gnat_entity, const char *name_trailer,
- int is_user_type, int definition, int same_rm_size)
+ bool is_user_type, bool definition, bool same_rm_size)
{
tree orig_size = TYPE_SIZE (type);
tree record;
if (TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type))
{
- if ((size == 0
+ if ((!size
|| operand_equal_p (round_up (size,
MAX (align, TYPE_ALIGN (type))),
round_up (TYPE_SIZE (type),
&& (align == 0 || align == TYPE_ALIGN (type)))
return type;
- if (size == 0)
+ if (!size)
size = TYPE_SIZE (type);
if (align == 0)
align = TYPE_ALIGN (type);
isn't changing. Likewise, clear the alignment if it isn't being
changed. Then return if we aren't doing anything. */
- if (size != 0
+ if (size
&& (operand_equal_p (size, orig_size, 0)
|| (TREE_CODE (orig_size) == INTEGER_CST
&& tree_int_cst_lt (size, orig_size))))
- size = 0;
+ size = NULL_TREE;
if (align == TYPE_ALIGN (type))
align = 0;
- if (align == 0 && size == 0)
+ if (align == 0 && !size)
return type;
/* We used to modify the record in place in some cases, but that could
name. */
if (is_user_type)
create_type_decl (get_entity_name (gnat_entity), type,
- 0, ! Comes_From_Source (gnat_entity),
- ! (TYPE_NAME (type) != 0
- && TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
- && DECL_IGNORED_P (TYPE_NAME (type))));
+ NULL, !Comes_From_Source (gnat_entity),
+ !(TYPE_NAME (type)
+ && TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
+ && DECL_IGNORED_P (TYPE_NAME (type))),
+ gnat_entity);
/* If we are changing the alignment and the input type is a record with
BLKmode and a small constant size, try to make a form that has an
&& TYPE_MODE (type) == BLKmode
&& host_integerp (orig_size, 1)
&& compare_tree_int (orig_size, BIGGEST_ALIGNMENT) <= 0
- && (size == 0
+ && (!size
|| (TREE_CODE (size) == INTEGER_CST
&& compare_tree_int (size, BIGGEST_ALIGNMENT) <= 0))
&& tree_low_cst (orig_size, 1) % align == 0)
NULL_TREE, bitsize_zero_node, 1);
DECL_INTERNAL_P (field) = 1;
- TYPE_SIZE (record) = size != 0 ? size : orig_size;
+ TYPE_SIZE (record) = size ? size : orig_size;
TYPE_SIZE_UNIT (record)
- = convert (sizetype,
- size_binop (CEIL_DIV_EXPR, TYPE_SIZE (record),
- bitsize_unit_node));
+ = (size ? convert (sizetype,
+ size_binop (CEIL_DIV_EXPR, size, bitsize_unit_node))
+ : TYPE_SIZE_UNIT (type));
+
TYPE_ALIGN (record) = align;
TYPE_IS_PADDING_P (record) = 1;
TYPE_VOLATILE (record)
= Present (gnat_entity) && Treat_As_Volatile (gnat_entity);
- finish_record_type (record, field, 1, 0);
+ finish_record_type (record, field, true, false);
/* Keep the RM_Size of the padded record as that of the old record
if requested. */
/* Unless debugging information isn't being written for the input type,
write a record that shows what we are a subtype of and also make a
variable that indicates our size, if variable. */
- if (TYPE_NAME (record) != 0
- && AGGREGATE_TYPE_P (type)
+ if (TYPE_NAME (record) && AGGREGATE_TYPE_P (type)
&& (TREE_CODE (TYPE_NAME (type)) != TYPE_DECL
- || ! DECL_IGNORED_P (TYPE_NAME (type))))
+ || !DECL_IGNORED_P (TYPE_NAME (type))))
{
tree marker = make_node (RECORD_TYPE);
- tree name = DECL_NAME (TYPE_NAME (record));
+ tree name = (TREE_CODE (TYPE_NAME (record)) == TYPE_DECL
+ ? DECL_NAME (TYPE_NAME (record))
+ : TYPE_NAME (record));
tree orig_name = TYPE_NAME (type);
if (TREE_CODE (orig_name) == TYPE_DECL)
create_field_decl (orig_name, integer_type_node,
marker, 0, NULL_TREE, NULL_TREE,
0),
- 0, 0);
-
- if (size != 0 && TREE_CODE (size) != INTEGER_CST && definition)
- {
- tree gnu_xvz
- = create_var_decl (concat_id_with_name (name, "XVZ"), NULL_TREE,
- sizetype, TYPE_SIZE (record), 0, 0, 0, 0, 0);
+ false, false);
- add_decl_expr (gnu_xvz, gnat_entity);
- }
+ if (size && TREE_CODE (size) != INTEGER_CST && definition)
+ create_var_decl (concat_id_with_name (name, "XVZ"), NULL_TREE,
+ sizetype, TYPE_SIZE (record), false, false, false,
+ false, NULL, gnat_entity);
}
type = record;
if (CONTAINS_PLACEHOLDER_P (orig_size))
- orig_size = max_size (orig_size, 1);
+ orig_size = max_size (orig_size, true);
/* If the size was widened explicitly, maybe give a warning. */
- if (size != 0 && Present (gnat_entity)
- && ! operand_equal_p (size, orig_size, 0)
- && ! (TREE_CODE (size) == INTEGER_CST
- && TREE_CODE (orig_size) == INTEGER_CST
- && tree_int_cst_lt (size, orig_size)))
+ if (size && Present (gnat_entity)
+ && !operand_equal_p (size, orig_size, 0)
+ && !(TREE_CODE (size) == INTEGER_CST
+ && TREE_CODE (orig_size) == INTEGER_CST
+ && tree_int_cst_lt (size, orig_size)))
{
Node_Id gnat_error_node = Empty;
gnat_entity,
size_diffop (size, orig_size));
- else if (*name_trailer == 'C' && ! Is_Internal (gnat_entity))
+ else if (*name_trailer == 'C' && !Is_Internal (gnat_entity))
post_error_ne_tree ("component of& padded{ by ^ bits}?",
gnat_entity, gnat_entity,
size_diffop (size, orig_size));
break;
default:
- gigi_abort (114);
+ gcc_unreachable ();
}
result = build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
PACKED is 1 if the enclosing record is packed and -1 if the enclosing
record has a Component_Alignment of Storage_Unit.
- DEFINITION is nonzero if this field is for a record being defined. */
+ DEFINITION is true if this field is for a record being defined. */
static tree
-gnat_to_gnu_field (Entity_Id gnat_field,
- tree gnu_record_type,
- int packed,
- int definition)
+gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
+ bool definition)
{
tree gnu_field_id = get_entity_name (gnat_field);
tree gnu_field_type = gnat_to_gnu_type (Etype (gnat_field));
tree gnu_pos = 0;
tree gnu_size = 0;
tree gnu_field;
- int needs_strict_alignment
+ bool needs_strict_alignment
= (Is_Aliased (gnat_field) || Strict_Alignment (Etype (gnat_field))
|| Treat_As_Volatile (gnat_field));
if (packed == 1)
gnu_size = validate_size (RM_Size (Etype (gnat_field)), gnu_field_type,
- gnat_field, FIELD_DECL, 0, 1);
+ gnat_field, FIELD_DECL, false, true);
if (Known_Static_Esize (gnat_field))
gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
- gnat_field, FIELD_DECL, 0, 1);
-
- /* If the field's type is left-justified modular, the wrapper can prevent
- packing so we make the field the type of the inner object unless the
- situation forbids it. We may not do that when the field is addressable_p,
- typically because in that case this field may later be passed by-ref for
- a formal argument expecting the left justification. The condition below
- is then matching the addressable_p code for COMPONENT_REF. */
- if (! Is_Aliased (gnat_field) && flag_strict_aliasing
- && TREE_CODE (gnu_field_type) == RECORD_TYPE
- && TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_field_type))
- gnu_field_type = TREE_TYPE (TYPE_FIELDS (gnu_field_type));
+ gnat_field, FIELD_DECL, false, true);
/* If we are packing this record, have a specified size that's smaller than
that of the field type, or a position is specified, and the field type
&& TYPE_MODE (gnu_field_type) == BLKmode
&& host_integerp (TYPE_SIZE (gnu_field_type), 1)
&& compare_tree_int (TYPE_SIZE (gnu_field_type), BIGGEST_ALIGNMENT) <= 0
- && (packed
- || (gnu_size != 0 && tree_int_cst_lt (gnu_size,
- TYPE_SIZE (gnu_field_type)))
+ && (packed == 1
+ || (gnu_size && tree_int_cst_lt (gnu_size,
+ TYPE_SIZE (gnu_field_type)))
|| Present (Component_Clause (gnat_field))))
{
gnu_field_type = make_packable_type (gnu_field_type);
- if (gnu_field_type != gnu_orig_field_type && gnu_size == 0)
+ if (gnu_field_type != gnu_orig_field_type && !gnu_size)
gnu_size = rm_size (gnu_field_type);
}
/* If we are packing the record and the field is BLKmode, round the
size up to a byte boundary. */
- if (packed && TYPE_MODE (gnu_field_type) == BLKmode && gnu_size != 0)
+ if (packed && TYPE_MODE (gnu_field_type) == BLKmode && gnu_size)
gnu_size = round_up (gnu_size, BITS_PER_UNIT);
if (Present (Component_Clause (gnat_field)))
{
gnu_pos = UI_To_gnu (Component_Bit_Offset (gnat_field), bitsizetype);
gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
- gnat_field, FIELD_DECL, 0, 1);
+ gnat_field, FIELD_DECL, false, true);
/* Ensure the position does not overlap with the parent subtype,
if there is one. */
consistent with the alignment. */
if (needs_strict_alignment)
{
- tree gnu_min_size = round_up (rm_size (gnu_field_type),
- TYPE_ALIGN (gnu_field_type));
+ tree gnu_rounded_size = round_up (rm_size (gnu_field_type),
+ TYPE_ALIGN (gnu_field_type));
TYPE_ALIGN (gnu_record_type)
= MAX (TYPE_ALIGN (gnu_record_type), TYPE_ALIGN (gnu_field_type));
- /* If Atomic, the size must match exactly and if aliased, the size
- must not be less than the rounded size. */
+ /* If Atomic, the size must match exactly that of the field. */
if ((Is_Atomic (gnat_field) || Is_Atomic (Etype (gnat_field)))
- && ! operand_equal_p (gnu_size, TYPE_SIZE (gnu_field_type), 0))
+ && !operand_equal_p (gnu_size, TYPE_SIZE (gnu_field_type), 0))
{
post_error_ne_tree
("atomic field& must be natural size of type{ (^)}",
Last_Bit (Component_Clause (gnat_field)), gnat_field,
TYPE_SIZE (gnu_field_type));
- gnu_size = 0;
+ gnu_size = NULL_TREE;
}
+ /* If Aliased, the size must match exactly the rounded size. We
+ used to be more accommodating here and accept greater sizes, but
+ fully supporting this case on big-endian platforms would require
+ switching to a more involved layout for the field. */
else if (Is_Aliased (gnat_field)
- && gnu_size != 0
- && tree_int_cst_lt (gnu_size, gnu_min_size))
+ && gnu_size
+ && ! operand_equal_p (gnu_size, gnu_rounded_size, 0))
{
post_error_ne_tree
- ("size of aliased field& too small{, minimum required is ^}",
+ ("size of aliased field& must be ^ bits",
Last_Bit (Component_Clause (gnat_field)), gnat_field,
- gnu_min_size);
- gnu_size = 0;
+ gnu_rounded_size);
+ gnu_size = NULL_TREE;
}
- if (! integer_zerop (size_binop
- (TRUNC_MOD_EXPR, gnu_pos,
- bitsize_int (TYPE_ALIGN (gnu_field_type)))))
+ if (!integer_zerop (size_binop
+ (TRUNC_MOD_EXPR, gnu_pos,
+ bitsize_int (TYPE_ALIGN (gnu_field_type)))))
{
if (Is_Aliased (gnat_field))
post_error_ne_num
First_Bit (Component_Clause (gnat_field)), gnat_field,
TYPE_ALIGN (gnu_field_type));
else
- gigi_abort (124);
+ gcc_unreachable ();
- gnu_pos = 0;
+ gnu_pos = NULL_TREE;
}
-
- /* If an error set the size to zero, show we have no position
- either. */
- if (gnu_size == 0)
- gnu_pos = 0;
}
if (Is_Atomic (gnat_field))
- check_ok_for_atomic (gnu_field_type, gnat_field, 0);
+ check_ok_for_atomic (gnu_field_type, gnat_field, false);
}
/* If the record has rep clauses and this is the tag field, make a rep
self-referential and an unconstrained type. In that case, we can't
pack the field since we can't make a copy to align it. */
if (TREE_CODE (gnu_field_type) == RECORD_TYPE
- && gnu_size == 0
+ && !gnu_size
&& CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_field_type))
- && ! Is_Constrained (Underlying_Type (Etype (gnat_field))))
+ && !Is_Constrained (Underlying_Type (Etype (gnat_field))))
{
- gnu_size = max_size (TYPE_SIZE (gnu_field_type), 1);
+ gnu_size = max_size (TYPE_SIZE (gnu_field_type), true);
packed = 0;
}
/* If no size is specified (or if there was an error), don't specify a
position. */
- if (gnu_size == 0)
- gnu_pos = 0;
+ if (!gnu_size)
+ gnu_pos = NULL_TREE;
else
{
- /* Unless this field is aliased, we can remove any left-justified
- modular type since it's only needed in the unchecked conversion
- case, which doesn't apply here. */
- if (! needs_strict_alignment
+ /* If the field's type is justified modular, we would need to remove
+ the wrapper to (better) meet the layout requirements. However we
+ can do so only if the field is not aliased to preserve the unique
+ layout and if the prescribed size is not greater than that of the
+ packed array to preserve the justification. */
+ if (!needs_strict_alignment
&& TREE_CODE (gnu_field_type) == RECORD_TYPE
- && TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_field_type))
+ && TYPE_JUSTIFIED_MODULAR_P (gnu_field_type)
+ && tree_int_cst_compare (gnu_size, TYPE_ADA_SIZE (gnu_field_type))
+ <= 0)
gnu_field_type = TREE_TYPE (TYPE_FIELDS (gnu_field_type));
gnu_field_type
= make_type_from_size (gnu_field_type, gnu_size,
Has_Biased_Representation (gnat_field));
- gnu_field_type = maybe_pad_type (gnu_field_type, gnu_size, 0,
- gnat_field, "PAD", 0, definition, 1);
+ gnu_field_type = maybe_pad_type (gnu_field_type, gnu_size, 0, gnat_field,
+ "PAD", false, definition, true);
}
- if (TREE_CODE (gnu_field_type) == RECORD_TYPE
- && TYPE_CONTAINS_TEMPLATE_P (gnu_field_type))
- gigi_abort (118);
+ gcc_assert (TREE_CODE (gnu_field_type) != RECORD_TYPE
+ || !TYPE_CONTAINS_TEMPLATE_P (gnu_field_type));
/* Now create the decl for the field. */
gnu_field = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type,
packed, gnu_size, gnu_pos,
Is_Aliased (gnat_field));
- annotate_decl_with_node (gnu_field, gnat_field);
+ Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field));
TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field);
if (Ekind (gnat_field) == E_Discriminant)
return gnu_field;
}
\f
-/* Return 1 if TYPE is a type with variable size, a padding type with a field
- of variable size or is a record that has a field such a field. */
+/* Return true if TYPE is a type with variable size, a padding type with a
+ field of variable size or is a record that has a field such a field. */
-static int
+static bool
is_variable_size (tree type)
{
tree field;
/* We need not be concerned about this at all if we don't have
strict alignment. */
- if (! STRICT_ALIGNMENT)
- return 0;
- else if (! TREE_CONSTANT (TYPE_SIZE (type)))
- return 1;
+ if (!STRICT_ALIGNMENT)
+ return false;
+ else if (!TREE_CONSTANT (TYPE_SIZE (type)))
+ return true;
else if (TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type)
- && ! TREE_CONSTANT (DECL_SIZE (TYPE_FIELDS (type))))
- return 1;
+ && !TREE_CONSTANT (DECL_SIZE (TYPE_FIELDS (type))))
+ return true;
else if (TREE_CODE (type) != RECORD_TYPE
&& TREE_CODE (type) != UNION_TYPE
&& TREE_CODE (type) != QUAL_UNION_TYPE)
- return 0;
+ return false;
- for (field = TYPE_FIELDS (type); field != 0; field = TREE_CHAIN (field))
+ for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
if (is_variable_size (TREE_TYPE (field)))
- return 1;
+ return true;
- return 0;
+ return false;
}
\f
/* Return a GCC tree for a record type given a GNAT Component_List and a chain
PACKED is 1 if this is for a record with "pragma pack" and -1 is this is
for a record type with "pragma component_alignment (storage_unit)".
- FINISH_RECORD is nonzero if this call will supply all of the remaining
- fields of the record.
+ DEFINITION is true if we are defining this record.
P_GNU_REP_LIST, if nonzero, is a pointer to a list to which each field
with a rep clause is to be added. If it is nonzero, that is all that
should be done with such fields.
- CANCEL_ALIGNMENT, if nonzero, means the alignment should be zeroed
- before laying out the record. This means the alignment only serves
- to force fields to be bitfields, but not require the record to be
- that aligned. This is used for variants.
+ CANCEL_ALIGNMENT, if true, means the alignment should be zeroed before
+ laying out the record. This means the alignment only serves to force fields
+ to be bitfields, but not require the record to be that aligned. This is
+ used for variants.
- ALL_REP, if nonzero, means that a rep clause was found for all the
- fields. This simplifies the logic since we know we're not in the mixed
- case.
+ ALL_REP, if true, means a rep clause was found for all the fields. This
+ simplifies the logic since we know we're not in the mixed case.
+
+ DEFER_DEBUG, if true, means that the debugging routines should not be
+ called when finishing constructing the record type.
The processing of the component list fills in the chain with all of the
fields of the record and then the record type is finished. */
static void
-components_to_record (tree gnu_record_type,
- Node_Id component_list,
- tree gnu_field_list,
- int packed,
- int definition,
- tree *p_gnu_rep_list,
- int cancel_alignment,
- int all_rep)
+components_to_record (tree gnu_record_type, Node_Id component_list,
+ tree gnu_field_list, int packed, bool definition,
+ tree *p_gnu_rep_list, bool cancel_alignment,
+ bool all_rep, bool defer_debug)
{
Node_Id component_decl;
Entity_Id gnat_field;
Node_Id variant;
tree gnu_our_rep_list = NULL_TREE;
tree gnu_field, gnu_last;
- int layout_with_rep = 0;
- int all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type) != 0;
+ bool layout_with_rep = false;
+ bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type);
/* For each variable within each component declaration create a GCC field
and add it to the list, skipping any pragmas in the list. */
}
}
- save_gnu_tree (gnat_field, gnu_field, 0);
+ save_gnu_tree (gnat_field, gnu_field, false);
}
/* At the end of the component list there may be a variant part. */
/* If this is an unchecked union, each variant must have exactly one
component, each of which becomes one component of this union. */
- if (TREE_CODE (gnu_record_type) == UNION_TYPE && Present (variant_part))
+ if (TREE_CODE (gnu_record_type) == UNION_TYPE
+ && TYPE_UNCHECKED_UNION_P (gnu_record_type)
+ && Present (variant_part))
for (variant = First_Non_Pragma (Variants (variant_part));
Present (variant);
variant = Next_Non_Pragma (variant))
definition);
TREE_CHAIN (gnu_field) = gnu_field_list;
gnu_field_list = gnu_field;
- save_gnu_tree (gnat_field, gnu_field, 0);
+ save_gnu_tree (gnat_field, gnu_field, false);
}
/* We create a QUAL_UNION_TYPE for the variant part since the variants are
components_to_record (gnu_variant_type, Component_List (variant),
NULL_TREE, packed, definition,
- &gnu_our_rep_list, !all_rep_and_size, all_rep);
+ &gnu_our_rep_list, !all_rep_and_size, all_rep,
+ false);
gnu_qual = choices_to_gnu (gnu_discriminant,
Discrete_Choices (variant));
to these empty variants. */
/* Only make the QUAL_UNION_TYPE if there are any non-empty variants. */
- if (gnu_variant_list != 0)
+ if (gnu_variant_list)
{
if (all_rep_and_size)
{
}
finish_record_type (gnu_union_type, nreverse (gnu_variant_list),
- all_rep_and_size, 0);
+ all_rep_and_size, false);
gnu_union_field
= create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type,
??? Note: if we then reorder them, debugging information will be wrong,
but there's nothing that can be done about this at the moment. */
- for (gnu_field = gnu_field_list, gnu_last = 0; gnu_field; )
+ for (gnu_field = gnu_field_list, gnu_last = NULL_TREE; gnu_field; )
{
- if (DECL_FIELD_OFFSET (gnu_field) != 0)
+ if (DECL_FIELD_OFFSET (gnu_field))
{
tree gnu_next = TREE_CHAIN (gnu_field);
- if (gnu_last == 0)
+ if (!gnu_last)
gnu_field_list = gnu_next;
else
TREE_CHAIN (gnu_last) = gnu_next;
set it and ignore the items. Otherwise, sort the fields by bit position
and put them into their own record if we have any fields without
rep clauses. */
- if (gnu_our_rep_list != 0 && p_gnu_rep_list != 0 && ! all_rep)
+ if (gnu_our_rep_list && p_gnu_rep_list && !all_rep)
*p_gnu_rep_list = chainon (*p_gnu_rep_list, gnu_our_rep_list);
- else if (gnu_our_rep_list != 0)
+ else if (gnu_our_rep_list)
{
tree gnu_rep_type
- = gnu_field_list == 0 ? gnu_record_type : make_node (RECORD_TYPE);
+ = (gnu_field_list ? make_node (RECORD_TYPE) : gnu_record_type);
int len = list_length (gnu_our_rep_list);
tree *gnu_arr = (tree *) alloca (sizeof (tree) * len);
int i;
TREE_CHAIN (gnu_arr[i]) = gnu_our_rep_list;
gnu_our_rep_list = gnu_arr[i];
DECL_CONTEXT (gnu_arr[i]) = gnu_rep_type;
- DECL_SECTION_NAME (gnu_arr[i]) = 0;
+ DECL_SECTION_NAME (gnu_arr[i]) = NULL_TREE;
}
- if (gnu_field_list != 0)
+ if (gnu_field_list)
{
- finish_record_type (gnu_rep_type, gnu_our_rep_list, 1, 0);
+ finish_record_type (gnu_rep_type, gnu_our_rep_list, true, false);
gnu_field = create_field_decl (get_identifier ("REP"), gnu_rep_type,
gnu_record_type, 0, 0, 0, 1);
DECL_INTERNAL_P (gnu_field) = 1;
}
else
{
- layout_with_rep = 1;
+ layout_with_rep = true;
gnu_field_list = nreverse (gnu_our_rep_list);
}
}
TYPE_ALIGN (gnu_record_type) = 0;
finish_record_type (gnu_record_type, nreverse (gnu_field_list),
- layout_with_rep, 0);
+ layout_with_rep, defer_debug);
}
\f
/* Called via qsort from the above. Returns -1, 1, depending on the
return No_Uint;
/* See if we've already saved the value for this node. */
- if (IS_EXPR_CODE_CLASS (TREE_CODE_CLASS (TREE_CODE (gnu_size)))
- && TREE_COMPLEXITY (gnu_size) != 0)
+ if (EXPR_P (gnu_size) && TREE_COMPLEXITY (gnu_size))
return (Node_Ref_Or_Val) TREE_COMPLEXITY (gnu_size);
/* If we do not return inside this switch, TCODE will be set to the
/* For negative values, use NEGATE_EXPR of the supplied value. */
if (tree_int_cst_sgn (gnu_size) < 0)
{
- /* The rediculous code below is to handle the case of the largest
+ /* The ridiculous code below is to handle the case of the largest
negative integer. */
tree negative_size = size_diffop (bitsize_zero_node, gnu_size);
- int adjust = 0;
+ bool adjust = false;
tree temp;
if (TREE_CONSTANT_OVERFLOW (negative_size))
= size_binop (MINUS_EXPR, bitsize_zero_node,
size_binop (PLUS_EXPR, gnu_size,
bitsize_one_node));
- adjust = 1;
+ adjust = true;
}
temp = build1 (NEGATE_EXPR, bitsizetype, negative_size);
if (adjust)
- temp = build (MINUS_EXPR, bitsizetype, temp, bitsize_one_node);
+ temp = build2 (MINUS_EXPR, bitsizetype, temp, bitsize_one_node);
return annotate_value (temp);
}
- if (! host_integerp (gnu_size, 1))
+ if (!host_integerp (gnu_size, 1))
return No_Uint;
size = tree_low_cst (gnu_size, 1);
/* The only case we handle here is a simple discriminant reference. */
if (TREE_CODE (TREE_OPERAND (gnu_size, 0)) == PLACEHOLDER_EXPR
&& TREE_CODE (TREE_OPERAND (gnu_size, 1)) == FIELD_DECL
- && DECL_DISCRIMINANT_NUMBER (TREE_OPERAND (gnu_size, 1)) != 0)
+ && DECL_DISCRIMINANT_NUMBER (TREE_OPERAND (gnu_size, 1)))
return Create_Node (Discrim_Val,
annotate_value (DECL_DISCRIMINANT_NUMBER
(TREE_OPERAND (gnu_size, 1))),
tree gnu_entry;
Entity_Id gnat_field;
- /* We operate by first making a list of all field and their positions
+ /* We operate by first making a list of all fields and their positions
(we can get the sizes easily at any time) by a recursive call
and then update all the sizes into the tree. */
gnu_list = compute_field_positions (gnu_type, NULL_TREE,
gnat_field = Next_Entity (gnat_field))
if ((Ekind (gnat_field) == E_Component
|| (Ekind (gnat_field) == E_Discriminant
- && ! Is_Unchecked_Union (Scope (gnat_field)))))
+ && !Is_Unchecked_Union (Scope (gnat_field)))))
{
tree parent_offset = bitsize_zero_node;
- gnu_entry
- = purpose_member (gnat_to_gnu_entity (gnat_field, NULL_TREE, 0),
- gnu_list);
+ gnu_entry = purpose_member (gnat_to_gnu_field_decl (gnat_field),
+ gnu_list);
if (gnu_entry)
{
so far. */
static tree
-compute_field_positions (tree gnu_type,
- tree gnu_list,
- tree gnu_pos,
- tree gnu_bitpos,
- unsigned int offset_align)
+compute_field_positions (tree gnu_type, tree gnu_list, tree gnu_pos,
+ tree gnu_bitpos, unsigned int offset_align)
{
tree gnu_field;
tree gnu_result = gnu_list;
for the size of a field. COMPONENT_P is true if we are being called
to process the Component_Size of GNAT_OBJECT. This is used for error
message handling and to indicate to use the object size of GNU_TYPE.
- ZERO_OK is nonzero if a size of zero is permitted; if ZERO_OK is zero,
+ ZERO_OK is true if a size of zero is permitted; if ZERO_OK is false,
it means that a size of zero should be treated as an unspecified size. */
static tree
validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
- enum tree_code kind, int component_p, int zero_ok)
+ enum tree_code kind, bool component_p, bool zero_ok)
{
Node_Id gnat_error_node;
tree type_size
/* Return 0 if no size was specified, either because Esize was not Present or
the specified size was zero. */
if (No (uint_size) || uint_size == No_Uint)
- return 0;
+ return NULL_TREE;
/* Get the size as a tree. Give an error if a size was specified, but cannot
be represented as in sizetype. */
post_error_ne (component_p ? "component size of & is too large"
: "size of & is too large",
gnat_error_node, gnat_object);
- return 0;
+ return NULL_TREE;
}
+
/* Ignore a negative size since that corresponds to our back-annotation.
Also ignore a zero size unless a size clause exists. */
- else if (tree_int_cst_sgn (size) < 0 || (integer_zerop (size) && ! zero_ok))
- return 0;
+ else if (tree_int_cst_sgn (size) < 0 || (integer_zerop (size) && !zero_ok))
+ return NULL_TREE;
/* The size of objects is always a multiple of a byte. */
if (kind == VAR_DECL
- && ! integer_zerop (size_binop (TRUNC_MOD_EXPR, size,
- bitsize_unit_node)))
+ && !integer_zerop (size_binop (TRUNC_MOD_EXPR, size, bitsize_unit_node)))
{
if (component_p)
post_error_ne ("component size for& is not a multiple of Storage_Unit",
else
post_error_ne ("size for& is not a multiple of Storage_Unit",
gnat_error_node, gnat_object);
- return 0;
+ return NULL_TREE;
}
/* If this is an integral type or a packed array type, the front-end has
checking against the bounds). However, if this is an aliased 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))
- && ! (kind == VAR_DECL && Is_Aliased (gnat_object)))
+ && !(kind == VAR_DECL && Is_Aliased (gnat_object)))
return size;
/* If the object is a record that contains a template, add the size of
/* Modify the size of the type to be that of the maximum size if it has a
discriminant or the size of a thin pointer if this is a fat pointer. */
- if (type_size != 0 && CONTAINS_PLACEHOLDER_P (type_size))
- type_size = max_size (type_size, 1);
+ if (type_size && CONTAINS_PLACEHOLDER_P (type_size))
+ type_size = max_size (type_size, true);
else if (TYPE_FAT_POINTER_P (gnu_type))
type_size = bitsize_int (POINTER_SIZE);
post_error_ne_tree ("size for& too small{, minimum allowed is ^}",
gnat_error_node, gnat_object, type_size);
- if (kind == VAR_DECL && ! component_p
+ if (kind == VAR_DECL && !component_p
&& TREE_CODE (rm_size (gnu_type)) == INTEGER_CST
- && ! tree_int_cst_lt (size, rm_size (gnu_type)))
+ && !tree_int_cst_lt (size, rm_size (gnu_type)))
post_error_ne_tree_2
("\\size of ^ is not a multiple of alignment (^ bits)",
gnat_error_node, gnat_object, rm_size (gnu_type),
post_error_ne ("\\size would be legal if & were not aliased!",
gnat_error_node, gnat_object);
- return 0;
+ return NULL_TREE;
}
return size;
front end will have always set it. */
else if (tree_int_cst_sgn (size) < 0
|| (integer_zerop (size) && No (gnat_attr_node)
- && ! Has_Size_Clause (gnat_entity)
- && ! Is_Discrete_Or_Fixed_Point_Type (gnat_entity)))
+ && !Has_Size_Clause (gnat_entity)
+ && !Is_Discrete_Or_Fixed_Point_Type (gnat_entity)))
return;
/* If the old size is self-referential, get the maximum size. */
if (CONTAINS_PLACEHOLDER_P (old_size))
- old_size = max_size (old_size, 1);
+ old_size = max_size (old_size, true);
/* If the size of the object is a constant, the new size must not be
smaller (the front end checks this for scalar types). */
/* Otherwise, set the RM_Size. */
if (TREE_CODE (gnu_type) == INTEGER_TYPE
&& Is_Discrete_Or_Fixed_Point_Type (gnat_entity))
- TYPE_RM_SIZE_INT (gnu_type) = size;
+ TYPE_RM_SIZE_NUM (gnu_type) = size;
else if (TREE_CODE (gnu_type) == ENUMERAL_TYPE)
- SET_TYPE_RM_SIZE_ENUM (gnu_type, size);
+ TYPE_RM_SIZE_NUM (gnu_type) = size;
else if ((TREE_CODE (gnu_type) == RECORD_TYPE
|| TREE_CODE (gnu_type) == UNION_TYPE
|| TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
- && ! TYPE_IS_FAT_POINTER_P (gnu_type))
+ && !TYPE_IS_FAT_POINTER_P (gnu_type))
SET_TYPE_ADA_SIZE (gnu_type, size);
}
\f
we are making a biased type. */
static tree
-make_type_from_size (tree type, tree size_tree, int biased_p)
+make_type_from_size (tree type, tree size_tree, bool biased_p)
{
tree new_type;
unsigned HOST_WIDE_INT size;
+ bool unsigned_p;
/* If size indicates an error, just return TYPE to avoid propagating the
error. Likewise if it's too large to represent. */
- if (size_tree == 0 || ! host_integerp (size_tree, 1))
+ if (!size_tree || !host_integerp (size_tree, 1))
return type;
size = tree_low_cst (size_tree, 1);
&& TYPE_BIASED_REPRESENTATION_P (type))))
break;
+ biased_p |= (TREE_CODE (type) == INTEGER_TYPE
+ && TYPE_BIASED_REPRESENTATION_P (type));
+ unsigned_p = TYPE_UNSIGNED (type) || biased_p;
+
size = MIN (size, LONG_LONG_TYPE_SIZE);
- new_type = make_signed_type (size);
- TREE_TYPE (new_type)
- = TREE_TYPE (type) != 0 ? TREE_TYPE (type) : type;
+ new_type
+ = unsigned_p ? make_unsigned_type (size) : make_signed_type (size);
+ TREE_TYPE (new_type) = TREE_TYPE (type) ? TREE_TYPE (type) : type;
TYPE_MIN_VALUE (new_type)
= convert (TREE_TYPE (new_type), TYPE_MIN_VALUE (type));
TYPE_MAX_VALUE (new_type)
= convert (TREE_TYPE (new_type), TYPE_MAX_VALUE (type));
- TYPE_BIASED_REPRESENTATION_P (new_type)
- = ((TREE_CODE (type) == INTEGER_TYPE
- && TYPE_BIASED_REPRESENTATION_P (type))
- || biased_p);
- TYPE_UNSIGNED (new_type)
- = TYPE_UNSIGNED (type) | TYPE_BIASED_REPRESENTATION_P (new_type);
- TYPE_RM_SIZE_INT (new_type) = bitsize_int (size);
+ TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p;
+ TYPE_RM_SIZE_NUM (new_type) = bitsize_int (size);
return new_type;
case RECORD_TYPE:
post_error_ne_num ("largest supported alignment for& is ^",
gnat_error_node, gnat_entity,
MAX_OFILE_ALIGNMENT / BITS_PER_UNIT);
- else if (! (Present (Alignment_Clause (gnat_entity))
- && From_At_Mod (Alignment_Clause (gnat_entity)))
+ else if (!(Present (Alignment_Clause (gnat_entity))
+ && From_At_Mod (Alignment_Clause (gnat_entity)))
&& new_align * BITS_PER_UNIT < align)
post_error_ne_num ("alignment for& must be at least ^",
gnat_error_node, gnat_entity,
}
\f
/* Verify that OBJECT, a type or decl, is something we can implement
- atomically. If not, give an error for GNAT_ENTITY. COMP_P is nonzero
+ atomically. If not, give an error for GNAT_ENTITY. COMP_P is true
if we require atomic components. */
static void
-check_ok_for_atomic (tree object, Entity_Id gnat_entity, int comp_p)
+check_ok_for_atomic (tree object, Entity_Id gnat_entity, bool comp_p)
{
Node_Id gnat_error_point = gnat_entity;
Node_Id gnat_node;
/* For the moment, also allow anything that has an alignment equal
to its size and which is smaller than a word. */
- if (size != 0 && TREE_CODE (size) == INTEGER_CST
+ if (size && TREE_CODE (size) == INTEGER_CST
&& compare_tree_int (size, align) == 0
&& align <= BITS_PER_WORD)
return;
for (gnat_node = First_Rep_Item (gnat_entity); Present (gnat_node);
gnat_node = Next_Rep_Item (gnat_node))
{
- if (! comp_p && Nkind (gnat_node) == N_Pragma
+ if (!comp_p && Nkind (gnat_node) == N_Pragma
&& Get_Pragma_Id (Chars (gnat_node)) == Pragma_Atomic)
gnat_error_point = First (Pragma_Argument_Associations (gnat_node));
else if (comp_p && Nkind (gnat_node) == N_Pragma
gnat_error_point, gnat_entity);
}
\f
-/* Set the DECL_SOURCE_LOCATION of GNU_DECL to the location of
- GNAT_NODE. */
+/* Check if FTYPE1 and FTYPE2, two potentially different function type nodes,
+ have compatible signatures so that a call using one type may be safely
+ issued if the actual target function type is the other. Return 1 if it is
+ the case, 0 otherwise, and post errors on the incompatibilities.
-static void
-annotate_decl_with_node (tree gnu_decl, Node_Id gnat_node)
+ This is used when an Ada subprogram is mapped onto a GCC builtin, to ensure
+ that calls to the subprogram will have arguments suitable for the later
+ underlying builtin expansion. */
+
+static int
+compatible_signatures_p (tree ftype1, tree ftype2)
{
- Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (gnu_decl));
+ /* As of now, we only perform very trivial tests and consider it's the
+ programmer's responsability to ensure the type correctness in the Ada
+ declaration, as in the regular Import cases.
+
+ Mismatches typically result in either error messages from the builtin
+ expander, internal compiler errors, or in a real call sequence. This
+ should be refined to issue diagnostics helping error detection and
+ correction. */
+
+ /* Almost fake test, ensuring a use of each argument. */
+ if (ftype1 == ftype2)
+ return 1;
+
+ return 1;
}
\f
-/* Given a type T, a FIELD_DECL F, and a replacement value R,
- return a new type with all size expressions that contain F
- updated by replacing F with R. This is identical to GCC's
- substitute_in_type except that it knows about TYPE_INDEX_TYPE.
- If F is NULL_TREE, always make a new RECORD_TYPE, even if nothing has
- changed. */
+/* Given a type T, a FIELD_DECL F, and a replacement value R, return a new type
+ with all size expressions that contain F updated by replacing F with R.
+ This is identical to GCC's substitute_in_type except that it knows about
+ TYPE_INDEX_TYPE. If F is NULL_TREE, always make a new RECORD_TYPE, even if
+ nothing has changed. */
tree
gnat_substitute_in_type (tree t, tree f, tree r)
if (CONTAINS_PLACEHOLDER_P (TYPE_MIN_VALUE (t))
|| CONTAINS_PLACEHOLDER_P (TYPE_MAX_VALUE (t)))
{
- tree low = substitute_in_expr (TYPE_MIN_VALUE (t), f, r);
- tree high = substitute_in_expr (TYPE_MAX_VALUE (t), f, r);
+ tree low = SUBSTITUTE_IN_EXPR (TYPE_MIN_VALUE (t), f, r);
+ tree high = SUBSTITUTE_IN_EXPR (TYPE_MAX_VALUE (t), f, r);
if (low == TYPE_MIN_VALUE (t) && high == TYPE_MAX_VALUE (t))
return t;
return t;
case REAL_TYPE:
- if ((TYPE_MIN_VALUE (t) != 0
- && CONTAINS_PLACEHOLDER_P (TYPE_MIN_VALUE (t)))
- || (TYPE_MAX_VALUE (t) != 0
- && CONTAINS_PLACEHOLDER_P (TYPE_MAX_VALUE (t))))
+ if (CONTAINS_PLACEHOLDER_P (TYPE_MIN_VALUE (t))
+ || CONTAINS_PLACEHOLDER_P (TYPE_MAX_VALUE (t)))
{
- tree low = 0, high = 0;
+ tree low = NULL_TREE, high = NULL_TREE;
if (TYPE_MIN_VALUE (t))
- low = substitute_in_expr (TYPE_MIN_VALUE (t), f, r);
+ low = SUBSTITUTE_IN_EXPR (TYPE_MIN_VALUE (t), f, r);
if (TYPE_MAX_VALUE (t))
- high = substitute_in_expr (TYPE_MAX_VALUE (t), f, r);
+ high = SUBSTITUTE_IN_EXPR (TYPE_MAX_VALUE (t), f, r);
if (low == TYPE_MIN_VALUE (t) && high == TYPE_MAX_VALUE (t))
return t;
case OFFSET_TYPE:
case METHOD_TYPE:
- case FILE_TYPE:
- case SET_TYPE:
case FUNCTION_TYPE:
case LANG_TYPE:
/* Don't know how to do these yet. */
- abort ();
+ gcc_unreachable ();
case ARRAY_TYPE:
{
TYPE_CONVENTION_FORTRAN_P (new) = TYPE_CONVENTION_FORTRAN_P (t);
layout_type (new);
TYPE_ALIGN (new) = TYPE_ALIGN (t);
+
+ /* If we had bounded the sizes of T by a constant, bound the sizes of
+ NEW by the same constant. */
+ if (TREE_CODE (TYPE_SIZE (t)) == MIN_EXPR)
+ TYPE_SIZE (new)
+ = size_binop (MIN_EXPR, TREE_OPERAND (TYPE_SIZE (t), 1),
+ TYPE_SIZE (new));
+ if (TREE_CODE (TYPE_SIZE_UNIT (t)) == MIN_EXPR)
+ TYPE_SIZE_UNIT (new)
+ = size_binop (MIN_EXPR, TREE_OPERAND (TYPE_SIZE_UNIT (t), 1),
+ TYPE_SIZE_UNIT (new));
return new;
}
case QUAL_UNION_TYPE:
{
tree field;
- int changed_field
- = (f == NULL_TREE && ! TREE_CONSTANT (TYPE_SIZE (t)));
- int field_has_rep = 0;
- tree last_field = 0;
+ bool changed_field
+ = (f == NULL_TREE && !TREE_CONSTANT (TYPE_SIZE (t)));
+ bool field_has_rep = false;
+ tree last_field = NULL_TREE;
tree new = copy_type (t);
in. If we haven't actually changed the type of any field,
discard everything we've done and return the old type. */
- TYPE_FIELDS (new) = 0;
- TYPE_SIZE (new) = 0;
+ TYPE_FIELDS (new) = NULL_TREE;
+ TYPE_SIZE (new) = NULL_TREE;
- for (field = TYPE_FIELDS (t); field;
- field = TREE_CHAIN (field))
+ for (field = TYPE_FIELDS (t); field; field = TREE_CHAIN (field))
{
tree new_field = copy_node (field);
TREE_TYPE (new_field)
= gnat_substitute_in_type (TREE_TYPE (new_field), f, r);
- if (DECL_HAS_REP_P (field) && ! DECL_INTERNAL_P (field))
- field_has_rep = 1;
+ if (DECL_HAS_REP_P (field) && !DECL_INTERNAL_P (field))
+ field_has_rep = true;
else if (TREE_TYPE (new_field) != TREE_TYPE (field))
- changed_field = 1;
+ changed_field = true;
/* If this is an internal field and the type of this field is
a UNION_TYPE or RECORD_TYPE with no elements, ignore it. If
&& (TREE_CODE (TREE_TYPE (new_field)) == UNION_TYPE
|| TREE_CODE (TREE_TYPE (new_field)) == RECORD_TYPE))
{
- if (TYPE_FIELDS (TREE_TYPE (new_field)) == 0)
+ if (!TYPE_FIELDS (TREE_TYPE (new_field)))
continue;
- if (TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (new_field))) == 0)
+ if (!TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (new_field))))
{
tree next_new_field
= copy_node (TYPE_FIELDS (TREE_TYPE (new_field)));
DECL_CONTEXT (new_field) = new;
SET_DECL_ORIGINAL_FIELD (new_field,
- (DECL_ORIGINAL_FIELD (field) != 0
+ (DECL_ORIGINAL_FIELD (field)
? DECL_ORIGINAL_FIELD (field) : field));
/* If the size of the old field was set at a constant,
record.) */
DECL_SIZE (new_field)
= TREE_CODE (DECL_SIZE (field)) == INTEGER_CST
- ? DECL_SIZE (field) : 0;
+ ? DECL_SIZE (field) : NULL_TREE;
DECL_SIZE_UNIT (new_field)
= TREE_CODE (DECL_SIZE_UNIT (field)) == INTEGER_CST
- ? DECL_SIZE_UNIT (field) : 0;
+ ? DECL_SIZE_UNIT (field) : NULL_TREE;
if (TREE_CODE (t) == QUAL_UNION_TYPE)
{
- tree new_q = substitute_in_expr (DECL_QUALIFIER (field), f, r);
+ tree new_q = SUBSTITUTE_IN_EXPR (DECL_QUALIFIER (field), f, r);
if (new_q != DECL_QUALIFIER (new_field))
- changed_field = 1;
+ changed_field = true;
/* Do the substitution inside the qualifier and if we find
that this field will not be present, omit it. */
continue;
}
- if (last_field == 0)
+ if (!last_field)
TYPE_FIELDS (new) = new_field;
else
TREE_CHAIN (last_field) = new_field;
/* If this used to be a qualified union type, but we now know what
field will be present, make this a normal union. */
if (changed_field && TREE_CODE (new) == QUAL_UNION_TYPE
- && (TYPE_FIELDS (new) == 0
+ && (!TYPE_FIELDS (new)
|| integer_onep (DECL_QUALIFIER (TYPE_FIELDS (new)))))
TREE_SET_CODE (new, UNION_TYPE);
- else if (! changed_field)
+ else if (!changed_field)
return t;
- if (field_has_rep)
- gigi_abort (117);
-
+ gcc_assert (!field_has_rep);
layout_type (new);
/* If the size was originally a constant use it. */
- if (TYPE_SIZE (t) != 0 && TREE_CODE (TYPE_SIZE (t)) == INTEGER_CST
+ if (TYPE_SIZE (t) && TREE_CODE (TYPE_SIZE (t)) == INTEGER_CST
&& TREE_CODE (TYPE_SIZE (new)) != INTEGER_CST)
{
TYPE_SIZE (new) = TYPE_SIZE (t);
/* For integer types, this is the precision. For record types, we store
the size explicitly. For other types, this is just the size. */
- if (INTEGRAL_TYPE_P (gnu_type) && TYPE_RM_SIZE (gnu_type) != 0)
+ if (INTEGRAL_TYPE_P (gnu_type) && TYPE_RM_SIZE (gnu_type))
return TYPE_RM_SIZE (gnu_type);
else if (TREE_CODE (gnu_type) == RECORD_TYPE
&& TYPE_CONTAINS_TEMPLATE_P (gnu_type))
else if ((TREE_CODE (gnu_type) == RECORD_TYPE
|| TREE_CODE (gnu_type) == UNION_TYPE
|| TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
- && ! TYPE_IS_FAT_POINTER_P (gnu_type)
- && TYPE_ADA_SIZE (gnu_type) != 0)
+ && !TYPE_IS_FAT_POINTER_P (gnu_type)
+ && TYPE_ADA_SIZE (gnu_type))
return TYPE_ADA_SIZE (gnu_type);
else
return TYPE_SIZE (gnu_type);
tree
create_concat_name (Entity_Id gnat_entity, const char *suffix)
{
- const char *str = (suffix == 0 ? "" : suffix);
+ const char *str = (!suffix ? "" : suffix);
String_Template temp = {1, strlen (str)};
Fat_Pointer fp = {str, &temp};
on a Windows box) live in a DLL. Here we adjust its name to use
the jump-table, the _imp__NAME contains the address for the NAME
variable. */
-
{
Entity_Kind kind = Ekind (gnat_entity);
const char *prefix = "_imp__";
OSDN Git Service
