git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

decl.c (gnat_to_gnu_entity): Reorder local variables. 

* gcc-interface/decl.c (gnat_to_gnu_entity): Reorder local variables.
	* gcc-interface/trans.c: Fix formatting throughout.  Fix comments.
	* gcc-interface/utils.c: Fix comments.

From-SVN: r145658
This commit is contained in:
Eric Botcazou 2009-04-07 08:26:08 +00:00 committed by Eric Botcazou
parent 229077b0b4
commit 1e17ef870e
4 changed files with 265 additions and 275 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/ada/ChangeLog
View File

@ -1,9 +1,17 @@
2009-04-07 Eric Botcazou <ebotcazou@adacore.com>
* decl.c (compile_time_known_address_p): Rewrite and move around.
* gcc-interface/decl.c (gnat_to_gnu_entity): Reorder local variables.
* gcc-interface/trans.c: Fix formatting throughout. Fix comments.
* gcc-interface/utils.c: Fix comments.
2009-04-07 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (compile_time_known_address_p): Rewrite and
move around.
(gnat_to_gnu_type): Move around.
(get_unpadded_type): Likewise.
* utils.c (update_pointer_to): Use synthetic macro. Tidy comments.
* gcc-interface/utils.c (update_pointer_to): Use synthetic macro.
Tidy comments.
2009-04-07 Eric Botcazou <ebotcazou@adacore.com>

115
gcc/ada/gcc-interface/decl.c
View File

@ -155,17 +155,16 @@ static int compatible_signatures_p (tree ftype1, tree ftype2);
static void rest_of_type_decl_compilation_no_defer (tree);
/* Given GNAT_ENTITY, a GNAT defining identifier node, which denotes some Ada
entity, this routine returns the equivalent GCC tree for that entity
(an ..._DECL node) and associates the ..._DECL node with the input GNAT
defining identifier.
entity, return the equivalent GCC tree for that entity (a ..._DECL node)
and associate the ..._DECL node with the input GNAT defining identifier.
If GNAT_ENTITY is a variable or a constant declaration, GNU_EXPR gives its
initial value (in GCC tree form). This is optional for variables.
For renamed entities, GNU_EXPR gives the object being renamed.
initial value (in GCC tree form). This is optional for a variable. For
a renamed entity, GNU_EXPR gives the object being renamed.
DEFINITION is nonzero if this call is intended for a definition. This is
used for separate compilation where it necessary to know whether an
external declaration or a definition should be created if the GCC equivalent
used for separate compilation where it is necessary to know whether an
external declaration or a definition must be created if the GCC equivalent
was not created previously. The value of 1 is normally used for a nonzero
DEFINITION, but a value of 2 is used in special circumstances, defined in
the code. */
@ -174,27 +173,34 @@ tree
gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
{
Entity_Id gnat_equiv_type = Gigi_Equivalent_Type (gnat_entity);
tree gnu_entity_id;
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. */
Entity_Id gnat_temp;
Entity_Kind kind = Ekind (gnat_entity);
/* Contains the GCC DECL node which is equivalent to the input GNAT node.
This node will be associated with the GNAT node by calling at the end
of the `switch' statement. */
tree gnu_decl = NULL_TREE;
/* true if we have already saved gnu_decl as a gnat association. */
/* Contains the GCC type to be used for the GCC node. */
tree gnu_type = NULL_TREE;
/* Contains the GCC size tree to be used for the GCC node. */
tree gnu_size = NULL_TREE;
/* Contains the GCC name to be used for the GCC node. */
tree gnu_entity_id;
/* True if we have already saved gnu_decl as a GNAT association. */
bool saved = false;
/* Nonzero if we incremented defer_incomplete_level. */
/* True if we incremented defer_incomplete_level. */
bool this_deferred = false;
/* Nonzero if we incremented force_global. */
/* True if we incremented force_global. */
bool this_global = false;
/* Nonzero if we should check to see if elaborated during processing. */
/* True if we should check to see if elaborated during processing. */
bool maybe_present = false;
/* Nonzero if we made GNU_DECL and its type here. */
/* True if we made GNU_DECL and its type here. */
bool this_made_decl = false;
struct attrib *attr_list = NULL;
/* True if debug info is requested for this entity. */
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;
/* True if this entity is to be considered as imported. */
bool imported_p = (Is_Imported (gnat_entity)
&& No (Address_Clause (gnat_entity)));
unsigned int esize
= ((Known_Esize (gnat_entity)
&& UI_Is_In_Int_Range (Esize (gnat_entity)))
@ -204,22 +210,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
: IN (kind, Access_Kind) ? POINTER_SIZE * 2
: LONG_LONG_TYPE_SIZE)
: LONG_LONG_TYPE_SIZE);
tree gnu_size = 0;
bool imported_p
= (Is_Imported (gnat_entity) && No (Address_Clause (gnat_entity)));
unsigned int align = 0;
struct attrib *attr_list = NULL;
/* 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)
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). */
/* Ensure that we are in a subprogram mentioned in the Scope chain of
this entity, our current scope is global, or we encountered a task
or entry (where we can't currently accurately check scoping). */
if (!current_function_decl
|| DECL_ELABORATION_PROC_P (current_function_decl))
{
@ -228,7 +231,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
}
for (gnat_temp = Scope (gnat_entity);
Present (gnat_temp); gnat_temp = Scope (gnat_temp))
Present (gnat_temp);
gnat_temp = Scope (gnat_temp))
{
if (Is_Type (gnat_temp))
gnat_temp = Underlying_Type (gnat_temp);
@ -254,21 +258,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
}
}
/* 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 */
/* This abort means the entity has an incorrect scope, i.e. that its
scope does not correspond to the subprogram it is declared in. */
gcc_unreachable ();
}
/* If this is entity 0, something went badly wrong. */
/* If the entiy is not present, something went badly wrong. */
gcc_assert (Present (gnat_entity));
/* If we've already processed this entity, return what we got last time.
If we are defining the node, we should not have already processed it.
In that case, we will abort below when we try to save a new GCC tree for
this object. We also need to handle the case of getting a dummy type
when a Full_View exists. */
In that case, we will abort below when we try to save a new GCC tree
for this object. We also need to handle the case of getting a dummy
type when a Full_View exists. */
if (present_gnu_tree (gnat_entity)
&& (!definition || (Is_Type (gnat_entity) && imported_p)))
{
@ -279,9 +281,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int 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);
gnu_decl
= gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 0);
save_gnu_tree (gnat_entity, NULL_TREE, false);
save_gnu_tree (gnat_entity, gnu_decl, false);
}
@ -293,14 +294,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
Esize must be specified unless it was specified by the programmer. */
gcc_assert (!Unknown_Esize (gnat_entity)
|| Has_Size_Clause (gnat_entity)
|| (!IN (kind, Numeric_Kind) && !IN (kind, Enumeration_Kind)
|| (!IN (kind, Numeric_Kind)
&& !IN (kind, Enumeration_Kind)
&& (!IN (kind, Access_Kind)
|| kind == E_Access_Protected_Subprogram_Type
|| kind == E_Anonymous_Access_Protected_Subprogram_Type
|| kind == E_Access_Subtype)));
/* Likewise, RM_Size must be specified for all discrete and fixed-point
types. */
/* RM_Size must be specified for all discrete and fixed-point types. */
gcc_assert (!IN (kind, Discrete_Or_Fixed_Point_Kind)
|| !Unknown_RM_Size (gnat_entity));
@ -319,7 +320,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|| 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
another compilation unit) public entities, show we are at global level
for the purpose of computing scopes. Don't do this for components or
discriminants since the relevant test is whether or not the record is
being defined. But do this for Imported functions or procedures in
@ -426,7 +427,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
stored discriminants, return the entity for the corresponding
stored discriminant. Also use Original_Record_Component
if the record has a private extension. */
if (Present (Original_Record_Component (gnat_entity))
&& Original_Record_Component (gnat_entity) != gnat_entity)
{
@ -441,14 +441,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
then it is an untagged record. If the Corresponding_Discriminant
is not empty then this must be a renamed discriminant and its
Original_Record_Component must point to the corresponding explicit
stored discriminant (i.e., we should have taken the previous
stored discriminant (i.e. we should have taken the previous
branch). */
else if (Present (Corresponding_Discriminant (gnat_entity))
&& Is_Tagged_Type (gnat_record))
{
/* A tagged record has no explicit stored discriminants. */
gcc_assert (First_Discriminant (gnat_record)
== First_Stored_Discriminant (gnat_record));
gnu_decl
@ -471,9 +469,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
it is an untagged record. If the Corresponding_Discriminant
is not empty then this must be a renamed discriminant and its
Original_Record_Component must point to the corresponding explicit
stored discriminant (i.e., we should have taken the first
stored discriminant (i.e. we should have taken the first
branch). */
else if (Present (Corresponding_Discriminant (gnat_entity))
&& (First_Discriminant (gnat_record)
!= First_Stored_Discriminant (gnat_record)))
@ -3281,7 +3278,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
either gnat_desig_full or gnat_desig_equiv. */
Entity_Id gnat_desig_rep;
/* Nonzero if this is a pointer to an unconstrained array. */
/* True if this is a pointer to an unconstrained array. */
bool is_unconstrained_array;
/* We want to know if we'll be seeing the freeze node for any
@ -3291,9 +3288,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
? In_Extended_Main_Code_Unit (gnat_desig_full)
: In_Extended_Main_Code_Unit (gnat_desig_type));
/* Nonzero if we make a dummy type here. */
/* True if we make a dummy type here. */
bool got_fat_p = false;
/* Nonzero if the dummy is a fat pointer. */
/* True if the dummy is a fat pointer. */
bool made_dummy = false;
tree gnu_desig_type = NULL_TREE;
enum machine_mode p_mode = mode_for_size (esize, MODE_INT, 0);
@ -5483,10 +5480,10 @@ maybe_variable (tree gnu_operand)
type definition (either a bound or a discriminant value) for GNAT_ENTITY,
return the GCC tree to use for that expression. GNU_NAME is the
qualification to use if an external name is appropriate and DEFINITION is
nonzero if this is a definition of GNAT_ENTITY. If NEED_VALUE is nonzero,
we need a result. Otherwise, we are just elaborating this for
side-effects. If NEED_DEBUG is nonzero we need the symbol for debugging
purposes even if it isn't needed for code generation. */
true if this is a definition of GNAT_ENTITY. If NEED_VALUE is true, we
need a result. Otherwise, we are just elaborating this for side-effects.
If NEED_DEBUG is true we need the symbol for debugging purposes even if it
isn't needed for code generation. */
static tree
elaborate_expression (Node_Id gnat_expr, Entity_Id gnat_entity,
@ -7285,7 +7282,7 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
/* Given a type TYPE, return a new type whose size is appropriate for SIZE.
If TYPE is the best type, return it. Otherwise, make a new type. We
only support new integral and pointer types. FOR_BIASED is nonzero if
only support new integral and pointer types. FOR_BIASED is true if
we are making a biased type. */
static tree

197
gcc/ada/gcc-interface/trans.c
View File

@ -58,7 +58,6 @@
#include "ada-tree.h"
#include "gigi.h"
#include "adadecode.h"
#include "dwarf2.h"
#include "dwarf2out.h"
@ -74,10 +73,9 @@
#endif
/* For efficient float-to-int rounding, it is necessary to know whether
floating-point arithmetic may use wider intermediate results.
When FP_ARITH_MAY_WIDEN is not defined, be conservative and only assume
floating-point arithmetic does not widen if double precision is emulated. */
floating-point arithmetic may use wider intermediate results. When
FP_ARITH_MAY_WIDEN is not defined, be conservative and only assume
that arithmetic does not widen if double precision is emulated. */
#ifndef FP_ARITH_MAY_WIDEN
#if defined(HAVE_extendsfdf2)
#define FP_ARITH_MAY_WIDEN HAVE_extendsfdf2
@ -103,7 +101,7 @@ struct List_Header *List_Headers_Ptr;
/* Current filename without path. */
const char *ref_filename;
/* If true, then gigi is being called on an analyzed but unexpanded
/* True when gigi is being called on an analyzed but unexpanded
tree, and the only purpose of the call is to properly annotate
types with representation information. */
bool type_annotate_only;
@ -601,8 +599,8 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
required if this is a static expression because it might be used
in a context where a dereference is inappropriate, such as a case
statement alternative or a record discriminant. There is no possible
volatile-ness short-circuit here since Volatile constants must be imported
per C.6. */
volatile-ness short-circuit here since Volatile constants must bei
imported per C.6. */
if (Ekind (gnat_temp) == E_Constant && Is_Scalar_Type (gnat_temp_type)
&& !Is_Imported (gnat_temp)
&& Present (Address_Clause (gnat_temp)))
@ -1112,14 +1110,20 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
else if (Nkind (Prefix (gnat_node)) == N_Explicit_Dereference)
{
Node_Id gnat_deref = Prefix (gnat_node);
Node_Id gnat_actual_subtype = Actual_Designated_Subtype (gnat_deref);
tree gnu_ptr_type = TREE_TYPE (gnat_to_gnu (Prefix (gnat_deref)));
Node_Id gnat_actual_subtype
= Actual_Designated_Subtype (gnat_deref);
tree gnu_ptr_type
= TREE_TYPE (gnat_to_gnu (Prefix (gnat_deref)));
if (TYPE_FAT_OR_THIN_POINTER_P (gnu_ptr_type)
&& Present (gnat_actual_subtype))
{
tree gnu_actual_obj_type = gnat_to_gnu_type (gnat_actual_subtype);
gnu_type = build_unc_object_type_from_ptr (gnu_ptr_type,
gnu_actual_obj_type, get_identifier ("SIZE"));
tree gnu_actual_obj_type
= gnat_to_gnu_type (gnat_actual_subtype);
gnu_type
= build_unc_object_type_from_ptr (gnu_ptr_type,
gnu_actual_obj_type,
get_identifier ("SIZE"));
}
gnu_result = TYPE_SIZE (gnu_type);
@ -3214,7 +3218,7 @@ gnat_to_gnu (Node_Id gnat_node)
switch (Nkind (gnat_node))
{
/********************************/
/* Chapter 2: Lexical Elements: */
/* Chapter 2: Lexical Elements */
/********************************/
case N_Identifier:
@ -3274,7 +3278,7 @@ gnat_to_gnu (Node_Id gnat_node)
}
/* We should never see a Vax_Float type literal, since the front end
is supposed to transform these using appropriate conversions */
is supposed to transform these using appropriate conversions. */
else if (Vax_Float (Underlying_Type (Etype (gnat_node))))
gcc_unreachable ();
@ -3340,7 +3344,7 @@ gnat_to_gnu (Node_Id gnat_node)
int i;
char *string;
if (length >= ALLOCA_THRESHOLD)
string = XNEWVEC (char, length + 1); /* in case of large strings */
string = XNEWVEC (char, length + 1);
else
string = (char *) alloca (length + 1);
@ -3359,7 +3363,7 @@ gnat_to_gnu (Node_Id gnat_node)
this to not be converted to the array type. */
TREE_TYPE (gnu_result) = gnu_result_type;
if (length >= ALLOCA_THRESHOLD) /* free if heap-allocated */
if (length >= ALLOCA_THRESHOLD)
free (string);
}
else
@ -3395,7 +3399,7 @@ gnat_to_gnu (Node_Id gnat_node)
break;
/**************************************/
/* Chapter 3: Declarations and Types: */
/* Chapter 3: Declarations and Types */
/**************************************/
case N_Subtype_Declaration:
@ -3502,7 +3506,7 @@ gnat_to_gnu (Node_Id gnat_node)
break;
/*************************************/
/* Chapter 4: Names and Expressions: */
/* Chapter 4: Names and Expressions */
/*************************************/
case N_Explicit_Dereference:
@ -3676,20 +3680,17 @@ gnat_to_gnu (Node_Id gnat_node)
/* For discriminant references in tagged types always substitute the
corresponding discriminant as the actual selected component. */
if (Is_Tagged_Type (gnat_pref_type))
while (Present (Corresponding_Discriminant (gnat_field)))
gnat_field = Corresponding_Discriminant (gnat_field);
/* For discriminant references of untagged types always substitute the
corresponding stored discriminant. */
else if (Present (Corresponding_Discriminant (gnat_field)))
gnat_field = Original_Record_Component (gnat_field);
/* Handle extracting the real or imaginary part of a complex.
The real part is the first field and the imaginary the last. */
if (TREE_CODE (TREE_TYPE (gnu_prefix)) == COMPLEX_TYPE)
gnu_result = build_unary_op (Present (Next_Entity (gnat_field))
? REALPART_EXPR : IMAGPART_EXPR,
@ -3698,9 +3699,8 @@ gnat_to_gnu (Node_Id gnat_node)
{
gnu_field = gnat_to_gnu_field_decl (gnat_field);
/* If there are discriminants, the prefix might be
evaluated more than once, which is a problem if it has
side-effects. */
/* If there are discriminants, the prefix might be evaluated more
than once, which is a problem if it has side-effects. */
if (Has_Discriminants (Is_Access_Type (Etype (Prefix (gnat_node)))
? Designated_Type (Etype
(Prefix (gnat_node)))
@ -4159,9 +4159,9 @@ gnat_to_gnu (Node_Id gnat_node)
}
break;
/***************************/
/* Chapter 5: Statements: */
/***************************/
/**************************/
/* Chapter 5: Statements */
/**************************/
case N_Label:
gnu_result = build1 (LABEL_EXPR, void_type_node,
@ -4411,9 +4411,9 @@ gnat_to_gnu (Node_Id gnat_node)
gnat_to_gnu (Name (gnat_node)));
break;
/****************************/
/* Chapter 6: Subprograms: */
/****************************/
/***************************/
/* Chapter 6: Subprograms */
/***************************/
case N_Subprogram_Declaration:
/* Unless there is a freeze node, declare the subprogram. We consider
@ -4458,9 +4458,9 @@ gnat_to_gnu (Node_Id gnat_node)
break;
case N_Defining_Program_Unit_Name:
/* For a child unit identifier go up a level to get the
specification. We get this when we try to find the spec of
a child unit package that is the compilation unit being compiled. */
/* For a child unit identifier go up a level to get the specification.
We get this when we try to find the spec of a child unit package
that is the compilation unit being compiled. */
gnu_result = gnat_to_gnu (Parent (gnat_node));
break;
@ -4474,9 +4474,9 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result = call_to_gnu (gnat_node, &gnu_result_type, NULL_TREE);
break;
/*************************/
/* Chapter 7: Packages: */
/*************************/
/************************/
/* Chapter 7: Packages */
/************************/
case N_Package_Declaration:
gnu_result = gnat_to_gnu (Specification (gnat_node));
@ -4492,7 +4492,7 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Package_Body:
/* If this is the body of a generic package - do nothing */
/* If this is the body of a generic package - do nothing. */
if (Ekind (Corresponding_Spec (gnat_node)) == E_Generic_Package)
{
gnu_result = alloc_stmt_list ();
@ -4508,19 +4508,19 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result = end_stmt_group ();
break;
/*********************************/
/* Chapter 8: Visibility Rules: */
/*********************************/
/********************************/
/* Chapter 8: Visibility Rules */
/********************************/
case N_Use_Package_Clause:
case N_Use_Type_Clause:
/* Nothing to do here - but these may appear in list of declarations */
/* Nothing to do here - but these may appear in list of declarations. */
gnu_result = alloc_stmt_list ();
break;
/***********************/
/* Chapter 9: Tasks: */
/***********************/
/*********************/
/* Chapter 9: Tasks */
/*********************/
case N_Protected_Type_Declaration:
gnu_result = alloc_stmt_list ();
@ -4531,9 +4531,9 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result = alloc_stmt_list ();
break;
/***********************************************************/
/* Chapter 10: Program Structure and Compilation Issues: */
/***********************************************************/
/*********************************************************/
/* Chapter 10: Program Structure and Compilation Issues */
/*********************************************************/
case N_Compilation_Unit:
@ -4559,7 +4559,7 @@ gnat_to_gnu (Node_Id gnat_node)
break;
/***************************/
/* Chapter 11: Exceptions: */
/* Chapter 11: Exceptions */
/***************************/
case N_Handled_Sequence_Of_Statements:
@ -4615,9 +4615,9 @@ gnat_to_gnu (Node_Id gnat_node)
= TREE_CHAIN (gnu_program_error_label_stack);
break;
/*******************************/
/* Chapter 12: Generic Units: */
/*******************************/
/******************************/
/* Chapter 12: Generic Units */
/******************************/
case N_Generic_Function_Renaming_Declaration:
case N_Generic_Package_Renaming_Declaration:
@ -4632,10 +4632,10 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result = alloc_stmt_list ();
break;
/***************************************************/
/**************************************************/
/* Chapter 13: Representation Clauses and */
/* Implementation-Dependent Features: */
/***************************************************/
/* Implementation-Dependent Features */
/**************************************************/
case N_Attribute_Definition_Clause:
gnu_result = alloc_stmt_list ();
@ -4770,9 +4770,9 @@ gnat_to_gnu (Node_Id gnat_node)
break;
/***************************************************/
/****************/
/* Added Nodes */
/***************************************************/
/****************/
case N_Freeze_Entity:
start_stmt_group ();
@ -5947,13 +5947,14 @@ process_decls (List_Id gnat_decls, List_Id gnat_decls2,
gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE, 1);
}
}
/* For bodies and stubs that act as their own specs, the entity
itself must be elaborated in the first pass, because it may
be used in other declarations. */
else if (Nkind (gnat_decl) == N_Subprogram_Body_Stub)
{
Node_Id gnat_subprog_id =
Defining_Entity (Specification (gnat_decl));
Node_Id gnat_subprog_id
= Defining_Entity (Specification (gnat_decl));
if (Ekind (gnat_subprog_id) != E_Subprogram_Body
&& Ekind (gnat_subprog_id) != E_Generic_Procedure
@ -5966,6 +5967,7 @@ process_decls (List_Id gnat_decls, List_Id gnat_decls2,
else if (Nkind (gnat_decl) == N_Task_Body_Stub
|| Nkind (gnat_decl) == N_Protected_Body_Stub)
;
else
add_stmt (gnat_to_gnu (gnat_decl));
}
@ -6239,22 +6241,19 @@ emit_range_check (tree gnu_expr, Entity_Id gnat_range_type)
gnu_expr, CE_Range_Check_Failed);
}
/* Emit code for an index check. GNU_ARRAY_OBJECT is the array object
which we are about to index, GNU_EXPR is the index expression to be
checked, GNU_LOW and GNU_HIGH are the lower and upper bounds
against which GNU_EXPR has to be checked. Note that for index
checking we cannot use the emit_range_check function (although very
similar code needs to be generated in both cases) since for index
checking the array type against which we are checking the indices
may be unconstrained and consequently we need to retrieve the
actual index bounds from the array object itself
(GNU_ARRAY_OBJECT). The place where we need to do that is in
subprograms having unconstrained array formal parameters */
/* Emit code for an index check. GNU_ARRAY_OBJECT is the array object which
we are about to index, GNU_EXPR is the index expression to be checked,
GNU_LOW and GNU_HIGH are the lower and upper bounds against which GNU_EXPR
has to be checked. Note that for index checking we cannot simply use the
emit_range_check function (although very similar code needs to be generated
in both cases) since for index checking the array type against which we are
checking the indices may be unconstrained and consequently we need to get
the actual index bounds from the array object itself (GNU_ARRAY_OBJECT).
The place where we need to do that is in subprograms having unconstrained
array formal parameters. */
static tree
emit_index_check (tree gnu_array_object,
tree gnu_expr,
tree gnu_low,
emit_index_check (tree gnu_array_object, tree gnu_expr, tree gnu_low,
tree gnu_high)
{
tree gnu_expr_check;
@ -6311,11 +6310,10 @@ emit_check (tree gnu_cond, tree gnu_expr, int reason)
return save_expr (gnu_result);
}
/* Return an expression that converts GNU_EXPR to GNAT_TYPE, doing
overflow checks if OVERFLOW_P is nonzero and range checks if
RANGE_P is nonzero. GNAT_TYPE is known to be an integral type.
If TRUNCATE_P is nonzero, do a float to integer conversion with
truncation; otherwise round. */
/* Return an expression that converts GNU_EXPR to GNAT_TYPE, doing overflow
checks if OVERFLOW_P is true and range checks if RANGE_P is true.
GNAT_TYPE is known to be an integral type. If TRUNCATE_P true, do a
float to integer conversion with truncation; otherwise round. */
static tree
convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
@ -6410,8 +6408,8 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
gnu_out_ub))));
if (!integer_zerop (gnu_cond))
gnu_result = emit_check (gnu_cond, gnu_input,
CE_Overflow_Check_Failed);
gnu_result
= emit_check (gnu_cond, gnu_input, CE_Overflow_Check_Failed);
}
/* Now convert to the result base type. If this is a non-truncating
@ -6428,11 +6426,10 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
of each arithmetic operation. In order to prevent excess
precision from spoiling this property, use the widest hardware
floating-point type if FP_ARITH_MAY_WIDEN is true. */
calc_type
= FP_ARITH_MAY_WIDEN ? longest_float_type_node : gnu_in_basetype;
calc_type = (FP_ARITH_MAY_WIDEN ? longest_float_type_node
: gnu_in_basetype);
/* FIXME: Should not have padding in the first place */
/* FIXME: Should not have padding in the first place. */
if (TREE_CODE (calc_type) == RECORD_TYPE
&& TYPE_IS_PADDING_P (calc_type))
calc_type = TREE_TYPE (TYPE_FIELDS (calc_type));
@ -6458,8 +6455,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
The reason to use the same constant with subtract/add instead
of a positive and negative constant is to allow the comparison
to be scheduled in parallel with retrieval of the constant and
conversion of the input to the calc_type (if necessary).
*/
conversion of the input to the calc_type (if necessary). */
gnu_zero = convert (gnu_in_basetype, integer_zero_node);
gnu_saved_result = save_expr (gnu_result);
@ -6726,9 +6722,7 @@ process_type (Entity_Id gnat_entity)
/* If this is a record type corresponding to a task or protected type
that is a completion of an incomplete type, perform a similar update
on the type. */
/* ??? Including protected types here is a guess. */
on the type. ??? Including protected types here is a guess. */
if (IN (Ekind (gnat_entity), Record_Kind)
&& Is_Concurrent_Record_Type (gnat_entity)
&& present_gnu_tree (Corresponding_Concurrent_Type (gnat_entity)))
@ -6770,7 +6764,7 @@ assoc_to_constructor (Entity_Id gnat_entity, Node_Id gnat_assoc, tree gnu_type)
tree gnu_expr = gnat_to_gnu (Expression (gnat_assoc));
/* The expander is supposed to put a single component selector name
in every record component association */
in every record component association. */
gcc_assert (No (Next (gnat_field)));
/* Ignore fields that have Corresponding_Discriminants since we'll
@ -6810,11 +6804,11 @@ assoc_to_constructor (Entity_Id gnat_entity, Node_Id gnat_assoc, tree gnu_type)
return gnu_result;
}
/* Builds a possibly nested constructor for array aggregates. GNAT_EXPR
is the first element of an array aggregate. It may itself be an
aggregate (an array or record aggregate). GNU_ARRAY_TYPE is the gnu type
corresponding to the array aggregate. GNAT_COMPONENT_TYPE is the type
of the array component. It is needed for range checking. */
/* Build a possibly nested constructor for array aggregates. GNAT_EXPR is
the first element of an array aggregate. It may itself be an aggregate.
GNU_ARRAY_TYPE is the GCC type corresponding to the array aggregate.
GNAT_COMPONENT_TYPE is the type of the array component; it is needed
for range checking. */
static tree
pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
@ -6841,7 +6835,7 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
gnu_expr = gnat_to_gnu (gnat_expr);
/* before assigning the element to the array make sure it is
in range */
in range. */
if (Do_Range_Check (gnat_expr))
gnu_expr = emit_range_check (gnu_expr, gnat_component_type);
}
@ -7066,7 +7060,7 @@ maybe_stabilize_reference (tree ref, bool force, bool *success)
case ERROR_MARK:
ref = error_mark_node;
/* ... Fallthru to failure ... */
/* ... fall through to failure ... */
/* If arg isn't a kind of lvalue we recognize, make no change.
Caller should recognize the error for an invalid lvalue. */
@ -7235,9 +7229,7 @@ static const char *
extract_encoding (const char *name)
{
char *encoding = GGC_NEWVEC (char, strlen (name));
get_encoding (name, encoding);
return encoding;
}
@ -7247,9 +7239,7 @@ static const char *
decode_name (const char *name)
{
char *decoded = GGC_NEWVEC (char, strlen (name) * 2 + 60);
__gnat_decode (name, decoded, 0);
return decoded;
}
@ -7356,10 +7346,7 @@ post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent, tree t)
integer to write in the message. */
void
post_error_ne_tree_2 (const char *msg,
Node_Id node,
Entity_Id ent,
tree t,
post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent, tree t,
int num)
{
Error_Msg_Uint_2 = UI_From_Int (num);

16
gcc/ada/gcc-interface/utils.c
View File

@ -210,7 +210,7 @@ init_gnat_to_gnu (void)
/* GNAT_ENTITY is a GNAT tree node for an entity. GNU_DECL is the GCC tree
which is to be associated with GNAT_ENTITY. Such GCC tree node is always
a ..._DECL node. If NO_CHECK is nonzero, the latter check is suppressed.
a ..._DECL node. If NO_CHECK is true, the latter check is suppressed.
If GNU_DECL is zero, a previous association is to be reset. */
@ -1252,13 +1252,11 @@ get_parallel_type (tree type)
}
/* Utility function of above to merge LAST_SIZE, the previous size of a record
with FIRST_BIT and SIZE that describe a field. SPECIAL is nonzero
if this represents a QUAL_UNION_TYPE in which case we must look for
COND_EXPRs and replace a value of zero with the old size. If HAS_REP
is nonzero, we must take the MAX of the end position of this field
with LAST_SIZE. In all other cases, we use FIRST_BIT plus SIZE.
We return an expression for the size. */
with FIRST_BIT and SIZE that describe a field. SPECIAL is true if this
represents a QUAL_UNION_TYPE in which case we must look for COND_EXPRs and
replace a value of zero with the old size. If HAS_REP is true, we take the
MAX of the end position of this field with LAST_SIZE. In all other cases,
we use FIRST_BIT plus SIZE. Return an expression for the size. */
static tree
merge_sizes (tree last_size, tree first_bit, tree size, bool special,
@ -1499,7 +1497,7 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list,
definition to be made visible outside of the current compilation unit, for
instance variable definitions in a package specification.
EXTERN_FLAG is nonzero when processing an external variable declaration (as
EXTERN_FLAG is true when processing an external variable declaration (as
opposed to a definition: no storage is to be allocated for the variable).
STATIC_FLAG is only relevant when not at top level. In that case