Commit 5e61ef09 by Thomas Quinot Committed by Arnaud Charlet

decl.c: Factor common code to build a storage type for an unconstrained object from a...

2005-11-14  Thomas Quinot  <quinot@adacore.com>
	    Olivier Hainque  <hainque@adacore.com>
	    Eric Botcazou  <ebotcazou@adacore.com>

	* decl.c:
	Factor common code to build a storage type for an unconstrained object
	from a fat or thin pointer type and a constrained object type.
	(annotate_value): Handle BIT_AND_EXPR.
	(annotate_rep): Don't restrict the back annotation of inherited
	components to the type_annotate_only case.
	(gnat_to_gnu_entity) <E_Array_Type>: Do not invoke create_type_decl if
	we are not defining the type.
	<E_Record_Type>: Likewise.
	(gnat_to_gnu_entity) <object, renaming>: Adjust comments and structure
	to get advantage of the new maybe_stabilize_reference interface, to
	ensure that what we reference is indeed stabilized instead of relying
	on assumptions on what the stabilizer does.
	(gnat_to_gnu_entity) <E_Incomplete_Type>: If the entity is an incomplete
	type imported through a limited_with clause, use its non-limited view.
	(Has_Stdcall_Convention): New macro, to centralize the Windows vs others
	differentiation.
	(gnat_to_gnu_entity): Use Has_Stdcall_Convention instead of a spread mix
	of #if sections + explicit comparisons of convention identifiers.
	(gnat_to_gnu_entity) <E_Variable>: Decrement force_global if necessary
	before early-returning for certain types when code generation is
	disabled.
	(gnat_to_gnu_entity) <object>: Adjust comment attached to the
	nullification of gnu_expr we do for objects with address clause and
	that we are not defining.
	(elaborate_expression_1): Do not create constants when creating
	variables needed by the debug info: the dwarf2 writer considers that
	CONST_DECLs is used only to represent enumeration constants, and emits
	nothing for them.
	(gnat_to_gnu_entity) <object>: When turning a non-definition of an
	object with an address clause into an indirect reference, drop the
	initializing expression.
	Include "expr.h".
	(STACK_CHECK_BUILTIN): Delete.
	(STACK_CHECK_PROBE_INTERVAL): Likewise.
	(STACK_CHECK_MAX_FRAME_SIZE): Likewise.
	(STACK_CHECK_MAX_VAR_SIZE): Likewise.
	(gnat_to_gnu_entity): If gnat_entity is a renaming, do not mark the tree
	corresponding to the renamed object as ignored for debugging purposes.

	* trans.c (tree_transform, case N_Attribute_Reference, case Attr_Size &
	related): For a prefix that is a dereference of a fat or thin pointer,
	if there is an actual subtype provided by the front-end, use that
	subtype to build an actual type with bounds template.
	(tree_transform, case N_Free_Statement): If an Actual_Designated_Subtype
	is provided by the front-end, use that subtype to compute the size of
	the deallocated object.
	(gnat_to_gnu): When adding a statement into an elaboration procedure,
	check for a potential violation of a No_Elaboration_Code restriction.
	(maybe_stabilize_reference): New function, like gnat_stabilize_reference
	with extra arguments to control whether to recurse through non-values
	and to let the caller know if the stabilization has succeeded.
	(gnat_stabilize_reference): Now a simple wrapper around
	maybe_stabilize, for common uses without restriction on lvalues and
	without need to check for the success indication.
	(gnat_to_gnu, call_to_gnu): Adjust calls to gnat_stabilize_reference, to
	pass false instead of 0 as the FORCE argument which is a bool.
	(Identifier_to_gnu): Remove checks ensuring that an renamed object
	attached to a renaming pointer has been properly stabilized, as no such
	object is attached otherwise.
	(call_to_gnu): Invoke create_var_decl to create the temporary when the
	function uses the "target pointer" return mechanism.
	Reinstate conversion of the actual to the type of the formal
	parameter before any other specific treatment based on the passing
	mechanism. This turns out to be necessary in order for PLACEHOLDER
	substitution to work properly when the latter type is unconstrained.

	* gigi.h (build_unc_object_type_from_ptr): New subprogram, factoring a
	common pattern.
	(maybe_stabilize_reference): New function, like gnat_stabilize_reference
	with extra arguments to control whether to recurse through non-values
	and to let the caller know if the stabilization has succeeded.

	* utils2.c (gnat_build_constructor): Only sort the fields for possible
	static output of record constructor if all the components are constant.
	(gnat_build_constructor): For a record type, sort the list of field
	initializers in increasing bit position order.
	Factor common code to build a storage type for an unconstrained object
	from a fat or thin pointer type and a constrained object type.
	(build_unary_op) <ADDR_EXPR>: Always recurse down conversions between
	types variants, and process special cases of VIEW_CONVERT expressions
	as their NOP_EXPR counterpart to ensure we get to the
	CORRESPONDING_VARs associated with CONST_DECls.
	(build_binary_op) <MODIFY_EXPR>: Do not strip VIEW_CONVERT_EXPRs
	on the right-hand side.

	* utils.c (build_unc_object_type_from_ptr): New subprogram, factoring
	a common pattern.
	(convert) <VIEW_CONVERT_EXPR>: Return the inner operand directly if we
	are converting back to its original type.
	(convert) <JM input>: Fallthrough regular conversion code instead of
	extracting the object if converting to a type variant.
	(create_var_decl): When a variable has an initializer requiring code
	generation and we are at the top level, check for a potential violation
	of a No_Elaboration_Code restriction.
	(create_var_decl): call expand_decl for CONST_DECLs, to set MODE, ALIGN
	SIZE and SIZE_UNIT which we need for later back-annotations.
	* utils.c: (convert) <STRING_CST>: Remove obsolete code.
	<VIEW_CONVERT_EXPR>: Do not lift the conversion if the target type
	is an unchecked union.
	(pushdecl): Set DECL_NO_STATIC_CHAIN on imported nested functions.
	(convert) <VIEW_CONVERT_EXPR>: When the types have the same
	main variant, just replace the VIEW_CONVERT_EXPR.
	<UNION_TYPE>: Revert 2005-03-02 change.

	* repinfo.h, repinfo.ads: Add tcode for BIT_AND_EXPR.

	* repinfo.adb (Print_Expr, Rep_Value): Handle Bit_And_Expressions.

From-SVN: r106961
parent fda5d6d4
...@@ -248,9 +248,21 @@ extern void init_code_table (void); ...@@ -248,9 +248,21 @@ extern void init_code_table (void);
called. */ called. */
extern Node_Id error_gnat_node; extern Node_Id error_gnat_node;
/* This is equivalent to stabilize_reference in GCC's tree.c, but we know /* This is equivalent to stabilize_reference in GCC's tree.c, but we know how
how to handle our new nodes and we take an extra argument that says to handle our new nodes and we take extra arguments.
whether to force evaluation of everything. */
FORCE says whether to force evaluation of everything,
SUCCESS we set to true unless we walk through something we don't
know how to stabilize, or through something which is not an lvalue
and LVALUES_ONLY is true, in which cases we set to false. */
extern tree maybe_stabilize_reference (tree ref, bool force, bool lvalues_only,
bool *success);
/* Wrapper around maybe_stabilize_reference, for common uses without
lvalue restrictions and without need to examine the success
indication. */
extern tree gnat_stabilize_reference (tree ref, bool force); extern tree gnat_stabilize_reference (tree ref, bool force);
/* Highest number in the front-end node table. */ /* Highest number in the front-end node table. */
...@@ -612,6 +624,11 @@ extern tree build_vms_descriptor (tree type, Mechanism_Type mech, ...@@ -612,6 +624,11 @@ extern tree build_vms_descriptor (tree type, Mechanism_Type mech,
extern tree build_unc_object_type (tree template_type, tree object_type, extern tree build_unc_object_type (tree template_type, tree object_type,
tree name); tree name);
/* Same as build_unc_object_type, but taking a thin or fat pointer type
instead of the template type. */
extern tree build_unc_object_type_from_ptr (tree thin_fat_ptr_type,
tree object_type, tree name);
/* Update anything previously pointing to OLD_TYPE to point to NEW_TYPE. In /* Update anything previously pointing to OLD_TYPE to point to NEW_TYPE. In
the normal case this is just two adjustments, but we have more to do the normal case this is just two adjustments, but we have more to do
if NEW is an UNCONSTRAINED_ARRAY_TYPE. */ if NEW is an UNCONSTRAINED_ARRAY_TYPE. */
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1999-2005 Free Software Foundation, Inc. -- -- Copyright (C) 1999-2005, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -35,7 +35,7 @@ ...@@ -35,7 +35,7 @@
-- tree to fill in representation information, and also the routine used -- tree to fill in representation information, and also the routine used
-- by -gnatR to print this information. This unit is used both in the -- by -gnatR to print this information. This unit is used both in the
-- compiler and in ASIS (it is used in ASIS as part of the implementation -- compiler and in ASIS (it is used in ASIS as part of the implementation
-- of the data decomposition annex. -- of the data decomposition annex).
with Types; use Types; with Types; use Types;
with Uintp; use Uintp; with Uintp; use Uintp;
...@@ -128,7 +128,7 @@ package Repinfo is ...@@ -128,7 +128,7 @@ package Repinfo is
-- Subtype used for values that can either be a Node_Ref (negative) -- Subtype used for values that can either be a Node_Ref (negative)
-- or a value (non-negative) -- or a value (non-negative)
type TCode is range 0 .. 27; type TCode is range 0 .. 28;
-- Type used on Ada side to represent DEFTREECODE values defined in -- Type used on Ada side to represent DEFTREECODE values defined in
-- tree.def. Only a subset of these tree codes can actually appear. -- tree.def. Only a subset of these tree codes can actually appear.
-- The names are the names from tree.def in Ada casing. -- The names are the names from tree.def in Ada casing.
...@@ -162,6 +162,7 @@ package Repinfo is ...@@ -162,6 +162,7 @@ package Repinfo is
Ge_Expr : constant TCode := 25; -- comparision >= 2 Ge_Expr : constant TCode := 25; -- comparision >= 2
Eq_Expr : constant TCode := 26; -- comparision = 2 Eq_Expr : constant TCode := 26; -- comparision = 2
Ne_Expr : constant TCode := 27; -- comparision /= 2 Ne_Expr : constant TCode := 27; -- comparision /= 2
Bit_And_Expr : constant TCode := 28; -- Binary and 2
-- The following entry is used to represent a discriminant value in -- The following entry is used to represent a discriminant value in
-- the tree. It has a special tree code that does not correspond -- the tree. It has a special tree code that does not correspond
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Header File * * C Header File *
* * * *
* Copyright (C) 1999-2002 Free Software Foundation, Inc. * * Copyright (C) 1999-2005 Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -67,6 +67,7 @@ typedef char TCode; ...@@ -67,6 +67,7 @@ typedef char TCode;
#define Ge_Expr 25 #define Ge_Expr 25
#define Eq_Expr 26 #define Eq_Expr 26
#define Ne_Expr 27 #define Ne_Expr 27
#define Bit_And_Expr 28
/* Creates a node using the tree code defined by Expr and from 1-3 /* Creates a node using the tree code defined by Expr and from 1-3
operands as required (unused operands set as shown to No_Uint) Note operands as required (unused operands set as shown to No_Uint) Note
......
...@@ -324,7 +324,13 @@ gnat_pushdecl (tree decl, Node_Id gnat_node) ...@@ -324,7 +324,13 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL) if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL)
DECL_CONTEXT (decl) = 0; DECL_CONTEXT (decl) = 0;
else else
DECL_CONTEXT (decl) = current_function_decl; {
DECL_CONTEXT (decl) = current_function_decl;
/* Functions imported in another function are not really nested. */
if (TREE_CODE (decl) == FUNCTION_DECL && TREE_PUBLIC (decl))
DECL_NO_STATIC_CHAIN (decl) = 1;
}
TREE_NO_WARNING (decl) = (gnat_node == Empty || Warnings_Off (gnat_node)); TREE_NO_WARNING (decl) = (gnat_node == Empty || Warnings_Off (gnat_node));
...@@ -1277,6 +1283,12 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init, ...@@ -1277,6 +1283,12 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
|| (type_annotate_only && var_init && !TREE_CONSTANT (var_init))) || (type_annotate_only && var_init && !TREE_CONSTANT (var_init)))
var_init = NULL_TREE; var_init = NULL_TREE;
/* At the global level, an initializer requiring code to be generated
produces elaboration statements. Check that such statements are allowed,
that is, not violating a No_Elaboration_Code restriction. */
if (global_bindings_p () && var_init != 0 && ! init_const)
Check_Elaboration_Code_Allowed (gnat_node);
/* Ada doesn't feature Fortran-like COMMON variables so we shouldn't /* Ada doesn't feature Fortran-like COMMON variables so we shouldn't
try to fiddle with DECL_COMMON. However, on platforms that don't try to fiddle with DECL_COMMON. However, on platforms that don't
support global BSS sections, uninitialized global variables would support global BSS sections, uninitialized global variables would
...@@ -1313,6 +1325,10 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init, ...@@ -1313,6 +1325,10 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
if (TREE_CODE (var_decl) != CONST_DECL) if (TREE_CODE (var_decl) != CONST_DECL)
rest_of_decl_compilation (var_decl, global_bindings_p (), 0); rest_of_decl_compilation (var_decl, global_bindings_p (), 0);
else
/* expand CONST_DECLs to set their MODE, ALIGN, SIZE and SIZE_UNIT,
which we need for later back-annotations. */
expand_decl (var_decl);
return var_decl; return var_decl;
} }
...@@ -1607,7 +1623,7 @@ potential_alignment_gap (tree prev_field, tree curr_field, tree offset) ...@@ -1607,7 +1623,7 @@ potential_alignment_gap (tree prev_field, tree curr_field, tree offset)
% DECL_ALIGN (curr_field) != 0); % DECL_ALIGN (curr_field) != 0);
/* If both the position and size of the previous field are multiples /* If both the position and size of the previous field are multiples
of the current field alignment, there can not be any gap. */ of the current field alignment, there cannot be any gap. */
if (value_factor_p (bit_position (prev_field), DECL_ALIGN (curr_field)) if (value_factor_p (bit_position (prev_field), DECL_ALIGN (curr_field))
&& value_factor_p (DECL_SIZE (prev_field), DECL_ALIGN (curr_field))) && value_factor_p (DECL_SIZE (prev_field), DECL_ALIGN (curr_field)))
return false; return false;
...@@ -2444,6 +2460,22 @@ build_unc_object_type (tree template_type, tree object_type, tree name) ...@@ -2444,6 +2460,22 @@ build_unc_object_type (tree template_type, tree object_type, tree name)
return type; return type;
} }
/* Same, taking a thin or fat pointer type instead of a template type. */
tree
build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type, tree name)
{
tree template_type;
gcc_assert (TYPE_FAT_OR_THIN_POINTER_P (thin_fat_ptr_type));
template_type
= (TYPE_FAT_POINTER_P (thin_fat_ptr_type)
? TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (thin_fat_ptr_type))))
: TREE_TYPE (TYPE_FIELDS (TREE_TYPE (thin_fat_ptr_type))));
return build_unc_object_type (template_type, object_type, name);
}
/* Update anything previously pointing to OLD_TYPE to point to NEW_TYPE. In /* Update anything previously pointing to OLD_TYPE to point to NEW_TYPE. In
the normal case this is just two adjustments, but we have more to do the normal case this is just two adjustments, but we have more to do
...@@ -2755,11 +2787,15 @@ convert (tree type, tree expr) ...@@ -2755,11 +2787,15 @@ convert (tree type, tree expr)
expr)), expr)),
TYPE_MIN_VALUE (etype)))); TYPE_MIN_VALUE (etype))));
/* If the input is a justified modular type, we need to extract /* If the input is a justified modular type, we need to extract the actual
the actual object before converting it to any other type with the object before converting it to any other type with the exceptions of an
exception of an unconstrained array. */ unconstrained array or of a mere type variant. It is useful to avoid the
extraction and conversion in the type variant case because it could end
up replacing a VAR_DECL expr by a constructor and we might be about the
take the address of the result. */
if (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype) if (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype)
&& code != UNCONSTRAINED_ARRAY_TYPE) && code != UNCONSTRAINED_ARRAY_TYPE
&& TYPE_MAIN_VARIANT (type) != TYPE_MAIN_VARIANT (etype))
return convert (type, build_component_ref (expr, NULL_TREE, return convert (type, build_component_ref (expr, NULL_TREE,
TYPE_FIELDS (etype), false)); TYPE_FIELDS (etype), false));
...@@ -2804,9 +2840,7 @@ convert (tree type, tree expr) ...@@ -2804,9 +2840,7 @@ convert (tree type, tree expr)
just make a new one in the proper type. */ just make a new one in the proper type. */
if (code == ecode && AGGREGATE_TYPE_P (etype) if (code == ecode && AGGREGATE_TYPE_P (etype)
&& !(TREE_CODE (TYPE_SIZE (etype)) == INTEGER_CST && !(TREE_CODE (TYPE_SIZE (etype)) == INTEGER_CST
&& TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST) && TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST))
&& (TREE_CODE (expr) == STRING_CST
|| get_alias_set (etype) == get_alias_set (type)))
{ {
expr = copy_node (expr); expr = copy_node (expr);
TREE_TYPE (expr) = type; TREE_TYPE (expr) = type;
...@@ -2826,9 +2860,40 @@ convert (tree type, tree expr) ...@@ -2826,9 +2860,40 @@ convert (tree type, tree expr)
break; break;
case VIEW_CONVERT_EXPR: case VIEW_CONVERT_EXPR:
if (AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype) {
&& !TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype)) /* GCC 4.x is very sensitive to type consistency overall, and view
return convert (type, TREE_OPERAND (expr, 0)); conversions thus are very frequent. Eventhough just "convert"ing
the inner operand to the output type is fine in most cases, it
might expose unexpected input/output type mismatches in special
circumstances so we avoid such recursive calls when we can. */
tree op0 = TREE_OPERAND (expr, 0);
/* If we are converting back to the original type, we can just
lift the input conversion. This is a common occurence with
switches back-and-forth amongst type variants. */
if (type == TREE_TYPE (op0))
return op0;
/* Otherwise, if we're converting between two aggregate types, we
might be allowed to substitute the VIEW_CONVERT target type in
place or to just convert the inner expression. */
if (AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype))
{
/* If we are converting between type variants, we can just
substitute the VIEW_CONVERT in place. */
if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
return build1 (VIEW_CONVERT_EXPR, type, op0);
/* Otherwise, we may just bypass the input view conversion unless
one of the types is a fat pointer, or we're converting to an
unchecked union type. Both are handled by specialized code
below and the latter relies on exact type matching. */
else if (!TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype)
&& !(code == UNION_TYPE && TYPE_UNCHECKED_UNION_P (type)))
return convert (type, op0);
}
}
break; break;
case INDIRECT_REF: case INDIRECT_REF:
...@@ -2957,13 +3022,10 @@ convert (tree type, tree expr) ...@@ -2957,13 +3022,10 @@ convert (tree type, tree expr)
{ {
if (TREE_TYPE (tem) == etype) if (TREE_TYPE (tem) == etype)
return build1 (CONVERT_EXPR, type, expr); return build1 (CONVERT_EXPR, type, expr);
else if (TREE_CODE (TREE_TYPE (tem)) == RECORD_TYPE
/* Accept slight type variations. */ && (TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (tem))
if (TREE_TYPE (tem) == TYPE_MAIN_VARIANT (etype) || TYPE_IS_PADDING_P (TREE_TYPE (tem)))
|| (TREE_CODE (TREE_TYPE (tem)) == RECORD_TYPE && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (tem))) == etype)
&& (TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (tem))
|| TYPE_IS_PADDING_P (TREE_TYPE (tem)))
&& TREE_TYPE (TYPE_FIELDS (TREE_TYPE (tem))) == etype))
return build1 (CONVERT_EXPR, type, return build1 (CONVERT_EXPR, type,
convert (TREE_TYPE (tem), expr)); convert (TREE_TYPE (tem), expr));
} }
......
...@@ -170,7 +170,7 @@ known_alignment (tree exp) ...@@ -170,7 +170,7 @@ known_alignment (tree exp)
case NON_LVALUE_EXPR: case NON_LVALUE_EXPR:
/* Conversions between pointers and integers don't change the alignment /* Conversions between pointers and integers don't change the alignment
of the underlying object. */ of the underlying object. */
this_alignment = known_alignment (TREE_OPERAND (exp, 0)); this_alignment = known_alignment (TREE_OPERAND (exp, 0));
break; break;
case PLUS_EXPR: case PLUS_EXPR:
...@@ -656,40 +656,6 @@ build_binary_op (enum tree_code op_code, tree result_type, ...@@ -656,40 +656,6 @@ build_binary_op (enum tree_code op_code, tree result_type,
if (!operation_type) if (!operation_type)
operation_type = left_type; operation_type = left_type;
/* If the RHS has a conversion between record and array types and
an inner type is no worse, use it. Note we cannot do this for
modular types or types with TYPE_ALIGN_OK, since the latter
might indicate a conversion between a root type and a class-wide
type, which we must not remove. */
while (TREE_CODE (right_operand) == VIEW_CONVERT_EXPR
&& (((TREE_CODE (right_type) == RECORD_TYPE
|| TREE_CODE (right_type) == UNION_TYPE)
&& !TYPE_JUSTIFIED_MODULAR_P (right_type)
&& !TYPE_ALIGN_OK (right_type)
&& !TYPE_IS_FAT_POINTER_P (right_type))
|| TREE_CODE (right_type) == ARRAY_TYPE)
&& ((((TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
== RECORD_TYPE)
|| (TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
== UNION_TYPE))
&& !(TYPE_JUSTIFIED_MODULAR_P
(TREE_TYPE (TREE_OPERAND (right_operand, 0))))
&& !(TYPE_ALIGN_OK
(TREE_TYPE (TREE_OPERAND (right_operand, 0))))
&& !(TYPE_IS_FAT_POINTER_P
(TREE_TYPE (TREE_OPERAND (right_operand, 0)))))
|| (TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
== ARRAY_TYPE))
&& (0 == (best_type
= find_common_type (right_type,
TREE_TYPE (TREE_OPERAND
(right_operand, 0))))
|| right_type != best_type))
{
right_operand = TREE_OPERAND (right_operand, 0);
right_type = TREE_TYPE (right_operand);
}
/* If we are copying one array or record to another, find the best type /* If we are copying one array or record to another, find the best type
to use. */ to use. */
if (((TREE_CODE (left_type) == ARRAY_TYPE if (((TREE_CODE (left_type) == ARRAY_TYPE
...@@ -1159,12 +1125,18 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand) ...@@ -1159,12 +1125,18 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
return build_unary_op (ADDR_EXPR, result_type, return build_unary_op (ADDR_EXPR, result_type,
TREE_OPERAND (operand, 0)); TREE_OPERAND (operand, 0));
/* If this NOP_EXPR doesn't change the mode, get the result type /* ... fallthru ... */
from this type and go down. We need to do this in case
this is a conversion of a CONST_DECL. */ case VIEW_CONVERT_EXPR:
if (TYPE_MODE (type) != BLKmode /* If this just a variant conversion or if the conversion doesn't
&& (TYPE_MODE (type) change the mode, get the result type from this type and go down.
== TYPE_MODE (TREE_TYPE (TREE_OPERAND (operand, 0))))) This is needed for conversions of CONST_DECLs, to eventually get
to the address of their CORRESPONDING_VARs. */
if ((TYPE_MAIN_VARIANT (type)
== TYPE_MAIN_VARIANT (TREE_TYPE (TREE_OPERAND (operand, 0))))
|| (TYPE_MODE (type) != BLKmode
&& (TYPE_MODE (type)
== TYPE_MODE (TREE_TYPE (TREE_OPERAND (operand, 0))))))
return build_unary_op (ADDR_EXPR, return build_unary_op (ADDR_EXPR,
(result_type ? result_type (result_type ? result_type
: build_pointer_type (type)), : build_pointer_type (type)),
...@@ -1409,7 +1381,7 @@ build_return_expr (tree result_decl, tree ret_val) ...@@ -1409,7 +1381,7 @@ build_return_expr (tree result_decl, tree ret_val)
build_binary_op with the additional guarantee that the type build_binary_op with the additional guarantee that the type
cannot involve a placeholder, since otherwise the function cannot involve a placeholder, since otherwise the function
would use the "target pointer" return mechanism. */ would use the "target pointer" return mechanism. */
if (operation_type != TREE_TYPE (ret_val)) if (operation_type != TREE_TYPE (ret_val))
ret_val = convert (operation_type, ret_val); ret_val = convert (operation_type, ret_val);
...@@ -1493,17 +1465,41 @@ build_call_raise (int msg) ...@@ -1493,17 +1465,41 @@ build_call_raise (int msg)
build_int_cst (NULL_TREE, input_line)); build_int_cst (NULL_TREE, input_line));
} }
/* qsort comparer for the bit positions of two constructor elements
for record components. */
static int
compare_elmt_bitpos (const PTR rt1, const PTR rt2)
{
tree elmt1 = * (tree *) rt1;
tree elmt2 = * (tree *) rt2;
tree pos_field1 = bit_position (TREE_PURPOSE (elmt1));
tree pos_field2 = bit_position (TREE_PURPOSE (elmt2));
if (tree_int_cst_equal (pos_field1, pos_field2))
return 0;
else if (tree_int_cst_lt (pos_field1, pos_field2))
return -1;
else
return 1;
}
/* Return a CONSTRUCTOR of TYPE whose list is LIST. */ /* Return a CONSTRUCTOR of TYPE whose list is LIST. */
tree tree
gnat_build_constructor (tree type, tree list) gnat_build_constructor (tree type, tree list)
{ {
tree elmt; tree elmt;
int n_elmts;
bool allconstant = (TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST); bool allconstant = (TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST);
bool side_effects = false; bool side_effects = false;
tree result; tree result;
for (elmt = list; elmt; elmt = TREE_CHAIN (elmt)) /* Scan the elements to see if they are all constant or if any has side
effects, to let us set global flags on the resulting constructor. Count
the elements along the way for possible sorting purposes below. */
for (n_elmts = 0, elmt = list; elmt; elmt = TREE_CHAIN (elmt), n_elmts ++)
{ {
if (!TREE_CONSTANT (TREE_VALUE (elmt)) if (!TREE_CONSTANT (TREE_VALUE (elmt))
|| (TREE_CODE (type) == RECORD_TYPE || (TREE_CODE (type) == RECORD_TYPE
...@@ -1525,26 +1521,30 @@ gnat_build_constructor (tree type, tree list) ...@@ -1525,26 +1521,30 @@ gnat_build_constructor (tree type, tree list)
return build1 (NULL_EXPR, type, TREE_OPERAND (result, 0)); return build1 (NULL_EXPR, type, TREE_OPERAND (result, 0));
} }
/* If TYPE is a RECORD_TYPE and the fields are not in the /* For record types with constant components only, sort field list
same order as their bit position, don't treat this as constant by increasing bit position. This is necessary to ensure the
since varasm.c can't handle it. */ constructor can be output as static data, which the gimplifier
if (allconstant && TREE_CODE (type) == RECORD_TYPE) might force in various circumstances. */
if (allconstant && TREE_CODE (type) == RECORD_TYPE && n_elmts > 1)
{ {
tree last_pos = bitsize_zero_node; /* Fill an array with an element tree per index, and ask qsort to order
tree field; them according to what a bitpos comparison function says. */
for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field)) tree *gnu_arr = (tree *) alloca (sizeof (tree) * n_elmts);
{ int i;
tree this_pos = bit_position (field);
if (TREE_CODE (this_pos) != INTEGER_CST for (i = 0, elmt = list; elmt; elmt = TREE_CHAIN (elmt), i++)
|| tree_int_cst_lt (this_pos, last_pos)) gnu_arr[i] = elmt;
{
allconstant = false; qsort (gnu_arr, n_elmts, sizeof (tree), compare_elmt_bitpos);
break;
}
last_pos = this_pos; /* Then reconstruct the list from the sorted array contents. */
list = NULL_TREE;
for (i = n_elmts - 1; i >= 0; i--)
{
TREE_CHAIN (gnu_arr[i]) = list;
list = gnu_arr[i];
} }
} }
...@@ -1821,13 +1821,10 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, ...@@ -1821,13 +1821,10 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
fill in the parts that are known. */ fill in the parts that are known. */
else if (TYPE_FAT_OR_THIN_POINTER_P (result_type)) else if (TYPE_FAT_OR_THIN_POINTER_P (result_type))
{ {
tree template_type
= (TYPE_FAT_POINTER_P (result_type)
? TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (result_type))))
: TREE_TYPE (TYPE_FIELDS (TREE_TYPE (result_type))));
tree storage_type tree storage_type
= build_unc_object_type (template_type, type, = build_unc_object_type_from_ptr (result_type, type,
get_identifier ("ALLOC")); get_identifier ("ALLOC"));
tree template_type = TREE_TYPE (TYPE_FIELDS (storage_type));
tree storage_ptr_type = build_pointer_type (storage_type); tree storage_ptr_type = build_pointer_type (storage_type);
tree storage; tree storage;
tree template_cons = NULL_TREE; tree template_cons = NULL_TREE;
......
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