Commit 86060344 by Eric Botcazou Committed by Eric Botcazou

gigi.h (gnat_init_decl_processing): Delete.

	* gcc-interface/gigi.h (gnat_init_decl_processing): Delete.
	* gcc-interface/decl.c (gnat_to_gnu_entity): Constify a few variables.
	<object>: Do not create the fake PARM_DECL if no debug info is needed.
	Do not create the corresponding VAR_DECL of a CONST_DECL for debugging
	purposes if no debug info is needed.
	Fix formatting.  Reorder and add comments.
	* gcc-interface/trans.c (gnat_to_gnu) <N_Attribute_Reference>: Constify
	variable and remove obsolete comment.
	* gcc-interface/utils.c (convert_vms_descriptor64): Tweak comment.
	(convert_vms_descriptor32): Likewise.
	(convert): Remove dead code.
	<UNCONSTRAINED_ARRAY_REF>: Pass the field instead of its name to build
	the reference to the P_ARRAY pointer.
	<POINTER_TYPE>: Likewise.
	(maybe_unconstrained_array) <UNCONSTRAINED_ARRAY_TYPE>: Likewise.
	(gnat_init_decl_processing): Delete, move contents to...
	* gcc-interface/misc.c (gnat_init): ...here.

From-SVN: r158428
parent 9b04d6de
2010-04-16 Eric Botcazou <ebotcazou@adacore.com> 2010-04-16 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (gnat_init_decl_processing): Delete.
* gcc-interface/decl.c (gnat_to_gnu_entity): Constify a few variables.
<object>: Do not create the fake PARM_DECL if no debug info is needed.
Do not create the corresponding VAR_DECL of a CONST_DECL for debugging
purposes if no debug info is needed.
Fix formatting. Reorder and add comments.
* gcc-interface/trans.c (gnat_to_gnu) <N_Attribute_Reference>: Constify
variable and remove obsolete comment.
* gcc-interface/utils.c (convert_vms_descriptor64): Tweak comment.
(convert_vms_descriptor32): Likewise.
(convert): Remove dead code.
<UNCONSTRAINED_ARRAY_REF>: Pass the field instead of its name to build
the reference to the P_ARRAY pointer.
<POINTER_TYPE>: Likewise.
(maybe_unconstrained_array) <UNCONSTRAINED_ARRAY_TYPE>: Likewise.
(gnat_init_decl_processing): Delete, move contents to...
* gcc-interface/misc.c (gnat_init): ...here.
2010-04-16 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (unchecked_conversion_nop): Handle function * gcc-interface/trans.c (unchecked_conversion_nop): Handle function
calls. Return true for conversion from a record subtype to its type. calls. Return true for conversion from a record subtype to its type.
......
...@@ -182,6 +182,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -182,6 +182,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
const Entity_Kind kind = Ekind (gnat_entity); const Entity_Kind kind = Ekind (gnat_entity);
/* True if this is a type. */ /* True if this is a type. */
const bool is_type = IN (kind, Type_Kind); const bool is_type = IN (kind, Type_Kind);
/* True if debug info is requested for this entity. */
const bool debug_info_p = Needs_Debug_Info (gnat_entity);
/* True if this entity is to be considered as imported. */
const bool imported_p
= (Is_Imported (gnat_entity) && No (Address_Clause (gnat_entity)));
/* For a type, contains the equivalent GNAT node to be used in gigi. */ /* For a type, contains the equivalent GNAT node to be used in gigi. */
Entity_Id gnat_equiv_type = Empty; Entity_Id gnat_equiv_type = Empty;
/* Temporary used to walk the GNAT tree. */ /* Temporary used to walk the GNAT tree. */
...@@ -206,11 +211,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -206,11 +211,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
bool maybe_present = false; bool maybe_present = false;
/* True if we made GNU_DECL and its type here. */ /* True if we made GNU_DECL and its type here. */
bool this_made_decl = false; bool this_made_decl = false;
/* True if debug info is requested for this entity. */
bool debug_info_p = Needs_Debug_Info (gnat_entity);
/* True if this entity is to be considered as imported. */
bool imported_p = (Is_Imported (gnat_entity)
&& No (Address_Clause (gnat_entity)));
/* Size and alignment of the GCC node, if meaningful. */ /* Size and alignment of the GCC node, if meaningful. */
unsigned int esize = 0, align = 0; unsigned int esize = 0, align = 0;
/* Contains the list of attributes directly attached to the entity. */ /* Contains the list of attributes directly attached to the entity. */
...@@ -548,10 +548,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -548,10 +548,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
case E_Out_Parameter: case E_Out_Parameter:
case E_Variable: case E_Variable:
/* Simple variables, loop variables, Out parameters, and exceptions. */ /* Simple variables, loop variables, Out parameters and exceptions. */
object: object:
{ {
bool used_by_ref = false;
bool const_flag bool const_flag
= ((kind == E_Constant || kind == E_Variable) = ((kind == E_Constant || kind == E_Variable)
&& Is_True_Constant (gnat_entity) && Is_True_Constant (gnat_entity)
...@@ -563,6 +562,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -563,6 +562,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
bool inner_const_flag = const_flag; bool inner_const_flag = const_flag;
bool static_p = Is_Statically_Allocated (gnat_entity); bool static_p = Is_Statically_Allocated (gnat_entity);
bool mutable_p = false; bool mutable_p = false;
bool used_by_ref = false;
tree gnu_ext_name = NULL_TREE; tree gnu_ext_name = NULL_TREE;
tree renamed_obj = NULL_TREE; tree renamed_obj = NULL_TREE;
tree gnu_object_size; tree gnu_object_size;
...@@ -604,9 +604,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -604,9 +604,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (kind == E_Loop_Parameter) if (kind == E_Loop_Parameter)
gnu_type = get_base_type (gnu_type); gnu_type = get_base_type (gnu_type);
/* Reject non-renamed objects whose types are unconstrained arrays or /* Reject non-renamed objects whose type is an unconstrained array or
any object whose type is a dummy type or VOID_TYPE. */ any object whose type is a dummy type or void. */
if ((TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE if ((TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
&& No (Renamed_Object (gnat_entity))) && No (Renamed_Object (gnat_entity)))
|| TYPE_IS_DUMMY_P (gnu_type) || TYPE_IS_DUMMY_P (gnu_type)
...@@ -626,6 +625,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -626,6 +625,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gcc_assert (Present (Alignment (gnat_entity))); gcc_assert (Present (Alignment (gnat_entity)));
align = validate_alignment (Alignment (gnat_entity), gnat_entity, align = validate_alignment (Alignment (gnat_entity), gnat_entity,
TYPE_ALIGN (gnu_type)); TYPE_ALIGN (gnu_type));
/* No point in changing the type if there is an address clause /* No point in changing the type if there is an address clause
as the final type of the object will be a reference type. */ as the final type of the object will be a reference type. */
if (Present (Address_Clause (gnat_entity))) if (Present (Address_Clause (gnat_entity)))
...@@ -636,11 +636,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -636,11 +636,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
false, false, definition, true); false, false, definition, true);
} }
/* If we are defining the object, see if it has a Size value and /* If we are defining the object, see if it has a Size and validate it
validate it if so. If we are not defining the object and a Size if so. If we are not defining the object and a Size clause applies,
clause applies, simply retrieve the value. We don't want to ignore simply retrieve the value. We don't want to ignore the clause and
the clause and it is expected to have been validated already. Then it is expected to have been validated already. Then get the new
get the new type, if any. */ type, if any. */
if (definition) if (definition)
gnu_size = validate_size (Esize (gnat_entity), gnu_type, gnu_size = validate_size (Esize (gnat_entity), gnu_type,
gnat_entity, VAR_DECL, false, gnat_entity, VAR_DECL, false,
...@@ -659,8 +659,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -659,8 +659,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
} }
/* If this object has self-referential size, it must be a record with /* If this object has self-referential size, it must be a record with
a default value. We are supposed to allocate an object of the a default discriminant. We are supposed to allocate an object of
maximum size in this case unless it is a constant with an the maximum size in this case, unless it is a constant with an
initializing expression, in which case we can get the size from initializing expression, in which case we can get the size from
that. Note that the resulting size may still be a variable, so that. Note that the resulting size may still be a variable, so
this may end up with an indirect allocation. */ this may end up with an indirect allocation. */
...@@ -707,8 +707,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -707,8 +707,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
} }
} }
/* If the size is zero bytes, make it one byte since some linkers have /* If the size is zero byte, make it one byte since some linkers have
trouble with zero-sized objects. If the object will have a troubles with zero-sized objects. If the object will have a
template, that will make it nonzero so don't bother. Also avoid template, that will make it nonzero so don't bother. Also avoid
doing that for an object renaming or an object with an address doing that for an object renaming or an object with an address
clause, as we would lose useful information on the view size clause, as we would lose useful information on the view size
...@@ -774,7 +774,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -774,7 +774,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
??? Note that we ignore Has_Volatile_Components on objects; it's ??? Note that we ignore Has_Volatile_Components on objects; it's
not at all clear what to do in that case. */ not at all clear what to do in that case. */
if (Has_Atomic_Components (gnat_entity)) if (Has_Atomic_Components (gnat_entity))
{ {
tree gnu_inner = (TREE_CODE (gnu_type) == ARRAY_TYPE tree gnu_inner = (TREE_CODE (gnu_type) == ARRAY_TYPE
...@@ -789,10 +788,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -789,10 +788,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Now check if the type of the object allows atomic access. Note /* Now check if the type of the object allows atomic access. Note
that we must test the type, even if this object has size and that we must test the type, even if this object has size and
alignment to allow such access, because we will be going alignment to allow such access, because we will be going inside
inside the padded record to assign to the object. We could fix the padded record to assign to the object. We could fix this by
this by always copying via an intermediate value, but it's not always copying via an intermediate value, but it's not clear it's
clear it's worth the effort. */ worth the effort. */
if (Is_Atomic (gnat_entity)) if (Is_Atomic (gnat_entity))
check_ok_for_atomic (gnu_type, gnat_entity, false); check_ok_for_atomic (gnu_type, gnat_entity, false);
...@@ -1024,16 +1023,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1024,16 +1023,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
= TYPE_PADDING_P (gnu_type) = TYPE_PADDING_P (gnu_type)
? TYPE_FIELDS (TREE_TYPE (TYPE_FIELDS (gnu_type))) ? TYPE_FIELDS (TREE_TYPE (TYPE_FIELDS (gnu_type)))
: TYPE_FIELDS (gnu_type); : TYPE_FIELDS (gnu_type);
gnu_expr gnu_expr
= gnat_build_constructor = gnat_build_constructor
(gnu_type, (gnu_type,
tree_cons tree_cons
(template_field, (template_field,
build_template (TREE_TYPE (template_field), build_template (TREE_TYPE (template_field),
TREE_TYPE (TREE_CHAIN (template_field)), TREE_TYPE (TREE_CHAIN (template_field)),
NULL_TREE), NULL_TREE),
NULL_TREE)); NULL_TREE));
} }
/* Convert the expression to the type of the object except in the /* Convert the expression to the type of the object except in the
...@@ -1050,12 +1048,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1050,12 +1048,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
(TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))) (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type))))))
gnu_expr = convert (gnu_type, gnu_expr); gnu_expr = convert (gnu_type, gnu_expr);
/* If this is a pointer and it does not have an initializing /* If this is a pointer that doesn't have an initializing expression,
expression, initialize it to NULL, unless the object is initialize it to NULL, unless the object is imported. */
imported. */
if (definition if (definition
&& (POINTER_TYPE_P (gnu_type) || TYPE_IS_FAT_POINTER_P (gnu_type)) && (POINTER_TYPE_P (gnu_type) || TYPE_IS_FAT_POINTER_P (gnu_type))
&& !Is_Imported (gnat_entity) && !gnu_expr) && !gnu_expr
&& !Is_Imported (gnat_entity))
gnu_expr = integer_zero_node; gnu_expr = integer_zero_node;
/* If we are defining the object and it has an Address clause, we must /* If we are defining the object and it has an Address clause, we must
...@@ -1065,10 +1063,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1065,10 +1063,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
effects in this case. */ effects in this case. */
if (definition && Present (Address_Clause (gnat_entity))) if (definition && Present (Address_Clause (gnat_entity)))
{ {
Node_Id gnat_expr = Expression (Address_Clause (gnat_entity));
tree gnu_address tree gnu_address
= present_gnu_tree (gnat_entity) = present_gnu_tree (gnat_entity)
? get_gnu_tree (gnat_entity) ? get_gnu_tree (gnat_entity) : gnat_to_gnu (gnat_expr);
: gnat_to_gnu (Expression (Address_Clause (gnat_entity)));
save_gnu_tree (gnat_entity, NULL_TREE, false); save_gnu_tree (gnat_entity, NULL_TREE, false);
...@@ -1081,9 +1079,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1081,9 +1079,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
= build_reference_type_for_mode (gnu_type, ptr_mode, true); = build_reference_type_for_mode (gnu_type, ptr_mode, true);
gnu_address = convert (gnu_type, gnu_address); gnu_address = convert (gnu_type, gnu_address);
used_by_ref = true; used_by_ref = true;
const_flag = !Is_Public (gnat_entity) const_flag
|| compile_time_known_address_p (Expression (Address_Clause = !Is_Public (gnat_entity)
(gnat_entity))); || compile_time_known_address_p (gnat_expr);
/* If this is a deferred constant, the initializer is attached to /* If this is a deferred constant, the initializer is attached to
the full view. */ the full view. */
...@@ -1154,14 +1152,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1154,14 +1152,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
If the object's size overflows, make an allocator too, so that If the object's size overflows, make an allocator too, so that
Storage_Error gets raised. Note that we will never free Storage_Error gets raised. Note that we will never free
such memory, so we presume it never will get allocated. */ such memory, so we presume it never will get allocated. */
if (!allocatable_size_p (TYPE_SIZE_UNIT (gnu_type), if (!allocatable_size_p (TYPE_SIZE_UNIT (gnu_type),
global_bindings_p () || !definition global_bindings_p ()
|| !definition
|| static_p) || static_p)
|| (gnu_size || (gnu_size && !allocatable_size_p (gnu_size,
&& ! allocatable_size_p (gnu_size, global_bindings_p ()
global_bindings_p () || !definition || !definition
|| static_p))) || static_p)))
{ {
gnu_type = build_reference_type (gnu_type); gnu_type = build_reference_type (gnu_type);
gnu_size = NULL_TREE; gnu_size = NULL_TREE;
...@@ -1180,7 +1178,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1180,7 +1178,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
If we are elaborating a mutable object, tell build_allocator to If we are elaborating a mutable object, tell build_allocator to
ignore a possibly simpler size from the initializer, if any, as ignore a possibly simpler size from the initializer, if any, as
we must allocate the maximum possible size in this case. */ we must allocate the maximum possible size in this case. */
if (definition) if (definition)
{ {
tree gnu_alloc_type = TREE_TYPE (gnu_type); tree gnu_alloc_type = TREE_TYPE (gnu_type);
...@@ -1302,6 +1299,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1302,6 +1299,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
(TREE_TYPE (TYPE_FIELDS (gnu_type))), 1))) (TREE_TYPE (TYPE_FIELDS (gnu_type))), 1)))
static_p = true; static_p = true;
/* Now create the variable or the constant and set various flags. */
gnu_decl gnu_decl
= create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type, = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
gnu_expr, const_flag, Is_Public (gnat_entity), gnu_expr, const_flag, Is_Public (gnat_entity),
...@@ -1309,6 +1307,24 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1309,6 +1307,24 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnat_entity); gnat_entity);
DECL_BY_REF_P (gnu_decl) = used_by_ref; DECL_BY_REF_P (gnu_decl) = used_by_ref;
DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag; DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
/* If we are defining an Out parameter and optimization isn't enabled,
create a fake PARM_DECL for debugging purposes and make it point to
the VAR_DECL. Suppress debug info for the latter but make sure it
will live on the stack so that it can be accessed from within the
debugger through the PARM_DECL. */
if (kind == E_Out_Parameter && definition && !optimize && debug_info_p)
{
tree param = create_param_decl (gnu_entity_name, gnu_type, false);
gnat_pushdecl (param, gnat_entity);
SET_DECL_VALUE_EXPR (param, gnu_decl);
DECL_HAS_VALUE_EXPR_P (param) = 1;
DECL_IGNORED_P (gnu_decl) = 1;
TREE_ADDRESSABLE (gnu_decl) = 1;
}
/* If this is a renaming pointer, attach the renamed object to it and
register it if we are at top level. */
if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj) if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
{ {
SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj); SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
...@@ -1319,46 +1335,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1319,46 +1335,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
} }
} }
if (definition && DECL_SIZE_UNIT (gnu_decl) /* If this is a constant and we are defining it or it generates a real
&& get_block_jmpbuf_decl () symbol at the object level and we are referencing it, we may want
&& (TREE_CODE (DECL_SIZE_UNIT (gnu_decl)) != INTEGER_CST or need to have a true variable to represent it:
|| (flag_stack_check == GENERIC_STACK_CHECK - if optimization isn't enabled, for debugging purposes,
&& compare_tree_int (DECL_SIZE_UNIT (gnu_decl), - if the constant is public and not overlaid on something else,
STACK_CHECK_MAX_VAR_SIZE) > 0))) - if its address is taken,
add_stmt_with_node (build_call_1_expr - if either itself or its type is aliased. */
(update_setjmp_buf_decl,
build_unary_op (ADDR_EXPR, NULL_TREE,
get_block_jmpbuf_decl ())),
gnat_entity);
/* If we are defining an Out parameter and we're not optimizing,
create a fake PARM_DECL for debugging purposes and make it
point to the VAR_DECL. Suppress debug info for the latter
but make sure it will still live on the stack so it can be
accessed from within the debugger through the PARM_DECL. */
if (kind == E_Out_Parameter && definition && !optimize)
{
tree param = create_param_decl (gnu_entity_name, gnu_type, false);
gnat_pushdecl (param, gnat_entity);
SET_DECL_VALUE_EXPR (param, gnu_decl);
DECL_HAS_VALUE_EXPR_P (param) = 1;
if (debug_info_p)
debug_info_p = false;
else
DECL_IGNORED_P (param) = 1;
TREE_ADDRESSABLE (gnu_decl) = 1;
}
/* If this is a public constant or we're not optimizing and we're not
making a VAR_DECL for it, make one just for export or debugger use.
Likewise if the address is taken or if either the object or type is
aliased. Make an external declaration for a reference, unless this
is a Standard entity since there no real symbol at the object level
for these. */
if (TREE_CODE (gnu_decl) == CONST_DECL if (TREE_CODE (gnu_decl) == CONST_DECL
&& (definition || Sloc (gnat_entity) > Standard_Location) && (definition || Sloc (gnat_entity) > Standard_Location)
&& ((Is_Public (gnat_entity) && No (Address_Clause (gnat_entity))) && ((!optimize && debug_info_p)
|| !optimize || (Is_Public (gnat_entity)
&& No (Address_Clause (gnat_entity)))
|| Address_Taken (gnat_entity) || Address_Taken (gnat_entity)
|| Is_Aliased (gnat_entity) || Is_Aliased (gnat_entity)
|| Is_Aliased (Etype (gnat_entity)))) || Is_Aliased (Etype (gnat_entity))))
...@@ -1372,8 +1360,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1372,8 +1360,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var); SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var);
/* As debugging information will be generated for the variable, /* As debugging information will be generated for the variable,
do not generate information for the constant. */ do not generate debugging information for the constant. */
DECL_IGNORED_P (gnu_decl) = 1; if (debug_info_p)
DECL_IGNORED_P (gnu_decl) = 1;
else
DECL_IGNORED_P (gnu_corr_var) = 1;
} }
/* If this is a constant, even if we don't need a true variable, we /* If this is a constant, even if we don't need a true variable, we
...@@ -1385,13 +1376,31 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1385,13 +1376,31 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (TREE_CODE (gnu_decl) == CONST_DECL) if (TREE_CODE (gnu_decl) == CONST_DECL)
DECL_CONST_ADDRESS_P (gnu_decl) = constructor_address_p (gnu_expr); DECL_CONST_ADDRESS_P (gnu_decl) = constructor_address_p (gnu_expr);
/* If this is declared in a block that contains a block with an /* If this object is declared in a block that contains a block with an
exception handler, we must force this variable in memory to exception handler, and we aren't using the GCC exception mechanism,
suppress an invalid optimization. */ we must force this variable in memory in order to avoid an invalid
if (Has_Nested_Block_With_Handler (Scope (gnat_entity)) optimization. */
&& Exception_Mechanism != Back_End_Exceptions) if (Exception_Mechanism != Back_End_Exceptions
&& Has_Nested_Block_With_Handler (Scope (gnat_entity)))
TREE_ADDRESSABLE (gnu_decl) = 1; TREE_ADDRESSABLE (gnu_decl) = 1;
/* If we are defining an object with variable size or an object with
fixed size that will be dynamically allocated, and we are using the
setjmp/longjmp exception mechanism, update the setjmp buffer. */
if (definition
&& Exception_Mechanism == Setjmp_Longjmp
&& get_block_jmpbuf_decl ()
&& DECL_SIZE_UNIT (gnu_decl)
&& (TREE_CODE (DECL_SIZE_UNIT (gnu_decl)) != INTEGER_CST
|| (flag_stack_check == GENERIC_STACK_CHECK
&& compare_tree_int (DECL_SIZE_UNIT (gnu_decl),
STACK_CHECK_MAX_VAR_SIZE) > 0)))
add_stmt_with_node (build_call_1_expr
(update_setjmp_buf_decl,
build_unary_op (ADDR_EXPR, NULL_TREE,
get_block_jmpbuf_decl ())),
gnat_entity);
/* Back-annotate Esize and Alignment of the object if not already /* Back-annotate Esize and Alignment of the object if not already
known. Note that we pick the values of the type, not those of known. Note that we pick the values of the type, not those of
the object, to shield ourselves from low-level platform-dependent the object, to shield ourselves from low-level platform-dependent
...@@ -1969,7 +1978,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1969,7 +1978,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Now make the array of arrays and update the pointer to the array /* Now make the array of arrays and update the pointer to the array
in the fat pointer. Note that it is the first field. */ in the fat pointer. Note that it is the first field. */
tem = gnat_to_gnu_component_type (gnat_entity, definition, tem = gnat_to_gnu_component_type (gnat_entity, definition,
debug_info_p); debug_info_p);
/* If Component_Size is not already specified, annotate it with the /* If Component_Size is not already specified, annotate it with the
...@@ -2023,7 +2032,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2023,7 +2032,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
SET_TYPE_UNCONSTRAINED_ARRAY (gnu_fat_type, gnu_type); SET_TYPE_UNCONSTRAINED_ARRAY (gnu_fat_type, gnu_type);
/* If the maximum size doesn't overflow, use it. */ /* If the maximum size doesn't overflow, use it. */
if (gnu_max_size if (gnu_max_size
&& TREE_CODE (gnu_max_size) == INTEGER_CST && TREE_CODE (gnu_max_size) == INTEGER_CST
&& !TREE_OVERFLOW (gnu_max_size) && !TREE_OVERFLOW (gnu_max_size)
&& TREE_CODE (gnu_max_size_unit) == INTEGER_CST && TREE_CODE (gnu_max_size_unit) == INTEGER_CST
...@@ -2049,9 +2058,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2049,9 +2058,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_fat_type, NULL, true, gnu_fat_type, NULL, true,
debug_info_p, gnat_entity); debug_info_p, gnat_entity);
/* Create the type to be used as what a thin pointer designates: an /* Create the type to be used as what a thin pointer designates:
record type for the object and its template with the field offsets a record type for the object and its template with the fields
shifted to have the template at a negative offset. */ shifted to have the template at a negative offset. */
tem = build_unc_object_type (gnu_template_type, tem, tem = build_unc_object_type (gnu_template_type, tem,
create_concat_name (gnat_name, "XUT")); create_concat_name (gnat_name, "XUT"));
shift_unc_components_for_thin_pointers (tem); shift_unc_components_for_thin_pointers (tem);
...@@ -2901,7 +2910,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2901,7 +2910,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
debug_info_p, false); debug_info_p, false);
/* If it is passed by reference, force BLKmode to ensure that objects /* If it is passed by reference, force BLKmode to ensure that objects
+ of this type will always be put in memory. */ of this type will always be put in memory. */
if (Is_By_Reference_Type (gnat_entity)) if (Is_By_Reference_Type (gnat_entity))
SET_TYPE_MODE (gnu_type, BLKmode); SET_TYPE_MODE (gnu_type, BLKmode);
......
...@@ -444,7 +444,6 @@ extern tree get_block_jmpbuf_decl (void); ...@@ -444,7 +444,6 @@ extern tree get_block_jmpbuf_decl (void);
and uses GNAT_NODE for location information. */ and uses GNAT_NODE for location information. */
extern void gnat_pushdecl (tree decl, Node_Id gnat_node); extern void gnat_pushdecl (tree decl, Node_Id gnat_node);
extern void gnat_init_decl_processing (void);
extern void gnat_init_gcc_eh (void); extern void gnat_init_gcc_eh (void);
extern void gnat_install_builtins (void); extern void gnat_install_builtins (void);
......
...@@ -388,9 +388,31 @@ internal_error_function (const char *msgid, va_list *ap) ...@@ -388,9 +388,31 @@ internal_error_function (const char *msgid, va_list *ap)
static bool static bool
gnat_init (void) gnat_init (void)
{ {
/* Performs whatever initialization steps needed by the language-dependent /* Do little here, most of the standard declarations are set up after the
lexical analyzer. */ front-end has been run. */
gnat_init_decl_processing (); build_common_tree_nodes (true, true);
/* In Ada, we use a signed type for SIZETYPE. Use the signed type
corresponding to the width of Pmode. In most cases when ptr_mode
and Pmode differ, C will use the width of ptr_mode for SIZETYPE.
But we get far better code using the width of Pmode. */
size_type_node = gnat_type_for_mode (Pmode, 0);
set_sizetype (size_type_node);
/* In Ada, we use an unsigned 8-bit type for the default boolean type. */
boolean_type_node = make_unsigned_type (8);
TREE_SET_CODE (boolean_type_node, BOOLEAN_TYPE);
SET_TYPE_RM_MAX_VALUE (boolean_type_node,
build_int_cst (boolean_type_node, 1));
SET_TYPE_RM_SIZE (boolean_type_node, bitsize_int (1));
build_common_tree_nodes_2 (0);
boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
ptr_void_type_node = build_pointer_type (void_type_node);
/* Show that REFERENCE_TYPEs are internal and should be Pmode. */
internal_reference_types ();
/* Add the input filename as the last argument. */ /* Add the input filename as the last argument. */
if (main_input_filename) if (main_input_filename)
...@@ -400,11 +422,9 @@ gnat_init (void) ...@@ -400,11 +422,9 @@ gnat_init (void)
gnat_argv[gnat_argc] = NULL; gnat_argv[gnat_argc] = NULL;
} }
/* Register our internal error function. */
global_dc->internal_error = &internal_error_function; global_dc->internal_error = &internal_error_function;
/* Show that REFERENCE_TYPEs are internal and should be Pmode. */
internal_reference_types ();
return true; return true;
} }
......
...@@ -4285,21 +4285,20 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -4285,21 +4285,20 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Attribute_Reference: case N_Attribute_Reference:
{ {
/* The attribute designator (like an enumeration value). */ /* The attribute designator. */
int attribute = Get_Attribute_Id (Attribute_Name (gnat_node)); const int attr = Get_Attribute_Id (Attribute_Name (gnat_node));
/* The Elab_Spec and Elab_Body attributes are special in that /* The Elab_Spec and Elab_Body attributes are special in that Prefix
Prefix is a unit, not an object with a GCC equivalent. Similarly is a unit, not an object with a GCC equivalent. */
for Elaborated, since that variable isn't otherwise known. */ if (attr == Attr_Elab_Spec || attr == Attr_Elab_Body)
if (attribute == Attr_Elab_Body || attribute == Attr_Elab_Spec) return
return (create_subprog_decl create_subprog_decl (create_concat_name
(create_concat_name (Entity (Prefix (gnat_node)), (Entity (Prefix (gnat_node)),
attribute == Attr_Elab_Body attr == Attr_Elab_Body ? "elabb" : "elabs"),
? "elabb" : "elabs"), NULL_TREE, void_ftype, NULL_TREE, false,
NULL_TREE, void_ftype, NULL_TREE, false, true, true, NULL, true, true, NULL, gnat_node);
gnat_node));
gnu_result = Attribute_to_gnu (gnat_node, &gnu_result_type, attr);
gnu_result = Attribute_to_gnu (gnat_node, &gnu_result_type, attribute);
} }
break; break;
......
...@@ -514,34 +514,6 @@ gnat_pushdecl (tree decl, Node_Id gnat_node) ...@@ -514,34 +514,6 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
} }
} }
/* Do little here. Set up the standard declarations later after the
front end has been run. */
void
gnat_init_decl_processing (void)
{
build_common_tree_nodes (true, true);
/* In Ada, we use a signed type for SIZETYPE. Use the signed type
corresponding to the width of Pmode. In most cases when ptr_mode
and Pmode differ, C will use the width of ptr_mode for SIZETYPE.
But we get far better code using the width of Pmode. */
size_type_node = gnat_type_for_mode (Pmode, 0);
set_sizetype (size_type_node);
/* In Ada, we use an unsigned 8-bit type for the default boolean type. */
boolean_type_node = make_unsigned_type (8);
TREE_SET_CODE (boolean_type_node, BOOLEAN_TYPE);
SET_TYPE_RM_MAX_VALUE (boolean_type_node,
build_int_cst (boolean_type_node, 1));
SET_TYPE_RM_SIZE (boolean_type_node, bitsize_int (1));
build_common_tree_nodes_2 (0);
boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
ptr_void_type_node = build_pointer_type (void_type_node);
}
/* Record TYPE as a builtin type for Ada. NAME is the name of the type. */ /* Record TYPE as a builtin type for Ada. NAME is the name of the type. */
void void
...@@ -3000,7 +2972,7 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3000,7 +2972,7 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass)); int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass));
tree lfield, ufield; tree lfield, ufield;
/* Convert POINTER to the type of the P_ARRAY field. */ /* Convert POINTER to the pointer-to-array type. */
gnu_expr64 = convert (p_array_type, gnu_expr64); gnu_expr64 = convert (p_array_type, gnu_expr64);
switch (iklass) switch (iklass)
...@@ -3148,7 +3120,7 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3148,7 +3120,7 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
/* See the head comment of build_vms_descriptor. */ /* See the head comment of build_vms_descriptor. */
int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass)); int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass));
/* Convert POINTER to the type of the P_ARRAY field. */ /* Convert POINTER to the pointer-to-array type. */
gnu_expr32 = convert (p_array_type, gnu_expr32); gnu_expr32 = convert (p_array_type, gnu_expr32);
switch (iklass) switch (iklass)
...@@ -3955,10 +3927,12 @@ convert (tree type, tree expr) ...@@ -3955,10 +3927,12 @@ convert (tree type, tree expr)
case UNCONSTRAINED_ARRAY_REF: case UNCONSTRAINED_ARRAY_REF:
/* Convert this to the type of the inner array by getting the address of /* Convert this to the type of the inner array by getting the address of
the array from the template. */ the array from the template. */
expr = TREE_OPERAND (expr, 0);
expr = build_unary_op (INDIRECT_REF, NULL_TREE, expr = build_unary_op (INDIRECT_REF, NULL_TREE,
build_component_ref (TREE_OPERAND (expr, 0), build_component_ref (expr, NULL_TREE,
get_identifier ("P_ARRAY"), TYPE_FIELDS
NULL_TREE, false)); (TREE_TYPE (expr)),
false));
etype = TREE_TYPE (expr); etype = TREE_TYPE (expr);
ecode = TREE_CODE (etype); ecode = TREE_CODE (etype);
break; break;
...@@ -4033,9 +4007,7 @@ convert (tree type, tree expr) ...@@ -4033,9 +4007,7 @@ convert (tree type, tree expr)
} }
/* In all other cases of related types, make a NOP_EXPR. */ /* In all other cases of related types, make a NOP_EXPR. */
else if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype) else if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
|| (code == INTEGER_CST && ecode == INTEGER_CST
&& (type == TREE_TYPE (etype) || etype == TREE_TYPE (type))))
return fold_convert (type, expr); return fold_convert (type, expr);
switch (code) switch (code)
...@@ -4114,8 +4086,8 @@ convert (tree type, tree expr) ...@@ -4114,8 +4086,8 @@ convert (tree type, tree expr)
/* If converting fat pointer to normal pointer, get the pointer to the /* If converting fat pointer to normal pointer, get the pointer to the
array and then convert it. */ array and then convert it. */
else if (TYPE_IS_FAT_POINTER_P (etype)) else if (TYPE_IS_FAT_POINTER_P (etype))
expr = build_component_ref (expr, get_identifier ("P_ARRAY"), expr
NULL_TREE, false); = build_component_ref (expr, NULL_TREE, TYPE_FIELDS (etype), false);
return fold (convert_to_pointer (type, expr)); return fold (convert_to_pointer (type, expr));
...@@ -4226,7 +4198,7 @@ remove_conversions (tree exp, bool true_address) ...@@ -4226,7 +4198,7 @@ remove_conversions (tree exp, bool true_address)
} }
/* If EXP's type is an UNCONSTRAINED_ARRAY_TYPE, return an expression that /* If EXP's type is an UNCONSTRAINED_ARRAY_TYPE, return an expression that
refers to the underlying array. If its type has TYPE_CONTAINS_TEMPLATE_P, refers to the underlying array. If it has TYPE_CONTAINS_TEMPLATE_P,
likewise return an expression pointing to the underlying array. */ likewise return an expression pointing to the underlying array. */
tree tree
...@@ -4240,11 +4212,13 @@ maybe_unconstrained_array (tree exp) ...@@ -4240,11 +4212,13 @@ maybe_unconstrained_array (tree exp)
case UNCONSTRAINED_ARRAY_TYPE: case UNCONSTRAINED_ARRAY_TYPE:
if (code == UNCONSTRAINED_ARRAY_REF) if (code == UNCONSTRAINED_ARRAY_REF)
{ {
new_exp = TREE_OPERAND (exp, 0);
new_exp new_exp
= build_unary_op (INDIRECT_REF, NULL_TREE, = build_unary_op (INDIRECT_REF, NULL_TREE,
build_component_ref (TREE_OPERAND (exp, 0), build_component_ref (new_exp, NULL_TREE,
get_identifier ("P_ARRAY"), TYPE_FIELDS
NULL_TREE, false)); (TREE_TYPE (new_exp)),
false));
TREE_READONLY (new_exp) = TREE_READONLY (exp); TREE_READONLY (new_exp) = TREE_READONLY (exp);
return new_exp; return new_exp;
} }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment