struct language_function GTY(())
{
+/* We should avoid allocating more than ALLOCA_THRESHOLD bytes via alloca, for
+ fear of running out of stack space. If we need more, we use xmalloc/free
+ instead. */
+#define ALLOCA_THRESHOLD 1000
+
VEC(parm_attr,gc) *parm_attr_cache;
};
static tree gnat_stabilize_reference (tree, bool);
static tree gnat_stabilize_reference_1 (tree, bool);
static void annotate_with_node (tree, Node_Id);
-static int takes_address (Node_Id, tree);
+static int lvalue_required_p (Node_Id, tree, int);
\f
/* This is the main program of the back-end. It sets up all the table
structures and then generates code. */
end_subprog_body (gnu_body);
}
}
+
+ /* We cannot track the location of errors past this point. */
+ error_gnat_node = Empty;
}
\f
/* Perform initializations for this module. */
set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check"));
}
\f
-/* Returns a positive value if GNAT_NODE denotes an address construction
- for an operand of OPERAND_TYPE, zero otherwise. This is int instead
- of bool to facilitate usage in non purely binary logic contexts. */
+/* Returns a positive value if GNAT_NODE requires an lvalue for an
+ operand of OPERAND_TYPE, whose aliasing is specified by ALIASED,
+ zero otherwise. This is int instead of bool to facilitate usage
+ in non purely binary logic contexts. */
static int
-takes_address (Node_Id gnat_node, tree operand_type)
+lvalue_required_p (Node_Id gnat_node, tree operand_type, int aliased)
{
switch (Nkind (gnat_node))
{
|| id == Attr_Unrestricted_Access;
}
+ case N_Parameter_Association:
case N_Function_Call:
case N_Procedure_Call_Statement:
return must_pass_by_ref (operand_type)
gnat_temp = Next (gnat_temp))
if (Nkind (gnat_temp) != N_Integer_Literal)
return 1;
- return takes_address (Parent (gnat_node), operand_type);
+ aliased |= Has_Aliased_Components (Etype (Prefix (gnat_node)));
+ return lvalue_required_p (Parent (gnat_node), operand_type, aliased);
}
+ case N_Selected_Component:
+ aliased |= Is_Aliased (Entity (Selector_Name (gnat_node)));
+ return lvalue_required_p (Parent (gnat_node), operand_type, aliased);
+
+ case N_Object_Renaming_Declaration:
+ /* We need to make a real renaming only if the constant object is
+ aliased; otherwise we can optimize and return the rvalue. We
+ make an exception if the object is an identifier since in this
+ case the rvalue can be propagated attached to the CONST_DECL. */
+ return aliased || Nkind (Name (gnat_node)) == N_Identifier;
+
default:
return 0;
}
tree gnu_result;
Node_Id gnat_temp, gnat_temp_type;
- /* Whether the parent of gnat_node is taking its address. Needed in
- specific circumstances only, so evaluated lazily. < 0 means unknown,
+ /* Whether the parent of gnat_node requires an lvalue. Needed in
+ specific circumstances only, so evaluated lazily. < 0 means unknown,
> 0 means known true, 0 means known false. */
- int parent_takes_address = -1;
+ int parent_requires_lvalue = -1;
/* If GNAT_NODE is a constant, whether we should use the initialization
value instead of the constant entity, typically for scalars with an
- address clause when the parent is not taking the address. */
+ address clause when the parent doesn't require an lvalue. */
bool use_constant_initializer = false;
/* If the Etype of this node does not equal the Etype of the Entity,
gnu_result_type = get_unpadded_type (gnat_temp_type);
/* If this is a non-imported scalar constant with an address clause,
- retrieve the value instead of a pointer to be dereferenced, unless the
- parent is taking the address. This is generally more efficient and
+ retrieve the value instead of a pointer to be dereferenced unless the
+ parent requires an lvalue. This is generally more efficient and
actually 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
&& !Is_Imported (gnat_temp)
&& Present (Address_Clause (gnat_temp)))
{
- parent_takes_address
- = takes_address (Parent (gnat_node), gnu_result_type);
- use_constant_initializer = !parent_takes_address;
+ parent_requires_lvalue
+ = lvalue_required_p (Parent (gnat_node), gnu_result_type,
+ Is_Aliased (gnat_temp));
+ use_constant_initializer = !parent_requires_lvalue;
}
if (use_constant_initializer)
gnu_result_type = TREE_TYPE (TYPE_FIELDS (gnu_result_type));
}
- /* If we have a constant declaration and it's initializer at hand, return
- the latter to avoid the need to call fold in lots of places and the need
- of elaboration code if this Id is used as an initializer itself. Don't
- do this if the parent will be taking the address of this object and
- there is a corresponding variable to take the address of. */
+ /* If we have a constant declaration and its initializer at hand,
+ try to return the latter to avoid the need to call fold in lots
+ of places and the need of elaboration code if this Id is used as
+ an initializer itself. */
if (TREE_CONSTANT (gnu_result)
&& DECL_P (gnu_result) && DECL_INITIAL (gnu_result))
{
? DECL_CONST_CORRESPONDING_VAR (gnu_result) : gnu_result);
/* If there is a corresponding variable, we only want to return the CST
- value if the parent is not taking the address. Evaluate this now if
+ value if the parent doesn't require an lvalue. Evaluate this now if
we have not already done so. */
- if (object && parent_takes_address < 0)
- parent_takes_address
- = takes_address (Parent (gnat_node), gnu_result_type);
+ if (object && parent_requires_lvalue < 0)
+ parent_requires_lvalue
+ = lvalue_required_p (Parent (gnat_node), gnu_result_type,
+ Is_Aliased (gnat_temp));
- if (!object || !parent_takes_address)
+ if (!object || !parent_requires_lvalue)
gnu_result = DECL_INITIAL (gnu_result);
}
tree gnu_char_ptr_type = build_pointer_type (char_type_node);
tree gnu_pos = byte_position (TYPE_FIELDS (gnu_obj_type));
tree gnu_byte_offset
- = convert (gnu_char_ptr_type,
+ = convert (sizetype,
size_diffop (size_zero_node, gnu_pos));
+ gnu_byte_offset = fold_build1 (NEGATE_EXPR, sizetype, gnu_byte_offset);
gnu_ptr = convert (gnu_char_ptr_type, gnu_ptr);
- gnu_ptr = build_binary_op (MINUS_EXPR, gnu_char_ptr_type,
+ gnu_ptr = build_binary_op (POINTER_PLUS_EXPR, gnu_char_ptr_type,
gnu_ptr, gnu_byte_offset);
}
}
gnu_compute_type
- = get_signed_or_unsigned_type (0,
+ = signed_or_unsigned_type_for (0,
get_base_type (gnu_result_type));
gnu_result
build_call_0_expr (get_jmpbuf_decl),
false, false, false, false, NULL,
gnat_node);
+ DECL_ARTIFICIAL (gnu_jmpsave_decl) = 1;
+
/* The __builtin_setjmp receivers will immediately reinstall it. Now
because of the unstructured form of EH used by setjmp_longjmp, there
might be forward edges going to __builtin_setjmp receivers on which
NULL_TREE, jmpbuf_type,
NULL_TREE, false, false, false, false,
NULL, gnat_node);
+ DECL_ARTIFICIAL (gnu_jmpbuf_decl) = 1;
set_block_jmpbuf_decl (gnu_jmpbuf_decl);
DECL_ELABORATION_PROC_P (gnu_elab_proc_decl) = 1;
allocate_struct_function (gnu_elab_proc_decl);
Sloc_to_locus (Sloc (gnat_unit_entity), &cfun->function_end_locus);
- cfun = 0;
+ set_cfun (NULL);
/* For a body, first process the spec if there is one. */
if (Nkind (Unit (gnat_node)) == N_Package_Body
{
String_Id gnat_string = Strval (gnat_node);
int length = String_Length (gnat_string);
- char *string = (char *) alloca (length + 1);
int i;
+ char *string;
+ if (length >= ALLOCA_THRESHOLD)
+ string = xmalloc (length + 1); /* in case of large strings */
+ else
+ string = (char *) alloca (length + 1);
/* Build the string with the characters in the literal. Note
that Ada strings are 1-origin. */
/* Strings in GCC don't normally have types, but we want
this to not be converted to the array type. */
TREE_TYPE (gnu_result) = gnu_result_type;
+
+ if (length >= ALLOCA_THRESHOLD) /* free if heap-allocated */
+ free (string);
}
else
{
NULL_TREE, void_ftype, NULL_TREE, false, true, true, NULL,
gnat_node));
- /* Check for 'Address of a subprogram or function that has
- a Freeze_Node and whose saved tree is an ADDR_EXPR. If we have
- such, return that ADDR_EXPR. */
- if (attribute == Attr_Address
- && Nkind (Prefix (gnat_node)) == N_Identifier
- && (Ekind (Entity (Prefix (gnat_node))) == E_Function
- || Ekind (Entity (Prefix (gnat_node))) == E_Procedure)
- && Present (Freeze_Node (Entity (Prefix (gnat_node))))
- && present_gnu_tree (Entity (Prefix (gnat_node)))
- && (TREE_CODE (get_gnu_tree (Entity (Prefix (gnat_node))))
- == TREE_LIST))
- return TREE_PURPOSE (get_gnu_tree (Entity (Prefix (gnat_node))));
-
gnu_result = Attribute_to_gnu (gnat_node, &gnu_result_type, attribute);
}
break;
/* Unless there is a freeze node, declare the subprogram. We consider
this a "definition" even though we're not generating code for
the subprogram because we will be making the corresponding GCC
- node here. If there is a freeze node, make a dummy ADDR_EXPR
- so we can take the address of this subprogram before its freeze
- point; we'll fill in the ADDR_EXPR later. Put that ADDR_EXPR
- into a TREE_LIST that contains space for the value specified
- in an Address clause. */
- if (Freeze_Node (Defining_Entity (Specification (gnat_node))))
- save_gnu_tree (Defining_Entity (Specification (gnat_node)),
- tree_cons (build1 (ADDR_EXPR,
- build_pointer_type
- (make_node (FUNCTION_TYPE)),
- NULL_TREE),
- NULL_TREE, NULL_TREE),
- true);
- else
+ node here. */
+
+ if (No (Freeze_Node (Defining_Entity (Specification (gnat_node)))))
gnat_to_gnu_entity (Defining_Entity (Specification (gnat_node)),
NULL_TREE, 1);
-
gnu_result = alloc_stmt_list ();
break;
/* Get the value to use as the address and save it as the
equivalent for GNAT_TEMP. When the object is frozen,
- gnat_to_gnu_entity will do the right thing. We have to handle
- subprograms differently here. */
- if (Ekind (Entity (Name (gnat_node))) == E_Procedure
- || Ekind (Entity (Name (gnat_node))) == E_Function)
- TREE_VALUE (get_gnu_tree (Entity (Name (gnat_node))))
- = gnat_to_gnu (Expression (gnat_node));
- else
- save_gnu_tree (Entity (Name (gnat_node)),
- gnat_to_gnu (Expression (gnat_node)), true);
+ gnat_to_gnu_entity will do the right thing. */
+ save_gnu_tree (Entity (Name (gnat_node)),
+ gnat_to_gnu (Expression (gnat_node)), true);
break;
case N_Enumeration_Representation_Clause:
tree gnu_char_ptr_type = build_pointer_type (char_type_node);
tree gnu_pos = byte_position (TYPE_FIELDS (gnu_obj_type));
tree gnu_byte_offset
- = convert (gnu_char_ptr_type,
+ = convert (sizetype,
size_diffop (size_zero_node, gnu_pos));
+ gnu_byte_offset = fold_build1 (NEGATE_EXPR, sizetype, gnu_byte_offset);
gnu_ptr = convert (gnu_char_ptr_type, gnu_ptr);
- gnu_ptr = build_binary_op (MINUS_EXPR, gnu_char_ptr_type,
+ gnu_ptr = build_binary_op (POINTER_PLUS_EXPR, gnu_char_ptr_type,
gnu_ptr, gnu_byte_offset);
}
= present_gnu_tree (gnat_entity) ? get_gnu_tree (gnat_entity) : 0;
/* If this entity has an Address representation clause, GNU_OLD is the
- address, so discard it here. The exception is if this is a subprogram.
- In that case, GNU_OLD is a TREE_LIST that contains both an address and
- the ADDR_EXPR needed to take the address of the subprogram. */
- if (Present (Address_Clause (gnat_entity))
- && TREE_CODE (gnu_old) != TREE_LIST)
+ address, so discard it here. */
+ if (Present (Address_Clause (gnat_entity)))
gnu_old = 0;
/* Don't do anything for class-wide types they are always
/* Don't do anything for subprograms that may have been elaborated before
their freeze nodes. This can happen, for example because of an inner call
in an instance body, or a previous compilation of a spec for inlining
- purposes. ??? Does this still occur? */
+ purposes. */
if (gnu_old
&& ((TREE_CODE (gnu_old) == FUNCTION_DECL
&& (Ekind (gnat_entity) == E_Function
|| Ekind (gnat_entity) == E_Procedure))
- || (TREE_CODE (gnu_old) != TREE_LIST
+ || (gnu_old
&& TREE_CODE (TREE_TYPE (gnu_old)) == FUNCTION_TYPE
&& Ekind (gnat_entity) == E_Subprogram_Type)))
return;
freeze node, e.g. while processing the other. */
if (gnu_old
&& !(TREE_CODE (gnu_old) == TYPE_DECL
- && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_old)))
- && TREE_CODE (gnu_old) != TREE_LIST)
+ && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_old))))
{
gcc_assert ((IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
&& Present (Full_View (gnat_entity))
/* Reset the saved tree, if any, and elaborate the object or type for real.
If there is a full declaration, elaborate it and copy the type to
GNAT_ENTITY. Likewise if this is the record subtype corresponding to
- a class wide type or subtype. First handle the subprogram case: there,
- we have to set the GNU tree to be the address clause, if any. */
- else if (gnu_old)
+ a class wide type or subtype. */
+ if (gnu_old)
{
save_gnu_tree (gnat_entity, NULL_TREE, false);
- if (TREE_CODE (gnu_old) == TREE_LIST && TREE_VALUE (gnu_old))
- save_gnu_tree (gnat_entity, TREE_VALUE (gnu_old), true);
-
if (IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
&& Present (Full_View (gnat_entity))
&& present_gnu_tree (Full_View (gnat_entity)))
else
gnu_new = gnat_to_gnu_entity (gnat_entity, gnu_init, 1);
- /* If this was a subprogram being frozen, we have to update the ADDR_EXPR
- we previously made. Update the operand, then set up to update the
- pointers. */
- if (gnu_old && TREE_CODE (gnu_old) == TREE_LIST)
- {
- TREE_OPERAND (TREE_PURPOSE (gnu_old), 0) = gnu_new;
- gnu_old = TREE_TYPE (TREE_PURPOSE (gnu_old));
- }
-
/* If we've made any pointers to the old version of this type, we
have to update them. */
if (gnu_old)
/* Compute the exact value calc_type'Pred (0.5) at compile time. */
fmt = REAL_MODE_FORMAT (TYPE_MODE (calc_type));
- real_2expN (&half_minus_pred_half, -(fmt->p) - 1);
+ real_2expN (&half_minus_pred_half, -(fmt->p) - 1, TYPE_MODE (calc_type));
REAL_ARITHMETIC (pred_half, MINUS_EXPR, dconsthalf,
half_minus_pred_half);
gnu_pred_half = build_real (calc_type, pred_half);
switch (code)
{
+ case CONST_DECL:
case VAR_DECL:
case PARM_DECL:
case RESULT_DECL:
OSDN Git Service
