From 58c8f7700a237538681b287d03625ca85a71e651 Mon Sep 17 00:00:00 2001
From: Eric Botcazou <ebotcazou@adacore.com>
Date: Thu, 15 Apr 2010 21:15:47 +0000
Subject: [PATCH] cuintp.c (UI_To_gnu): Fix long line.
* gcc-interface/cuintp.c (UI_To_gnu): Fix long line.
* gcc-interface/gigi.h (MARK_VISITED): Skip objects of constant class.
(process_attributes): Delete.
(post_error_ne_num): Change parameter name.
* gcc-interface/decl.c (gnat_to_gnu_entity): Do not force debug info
with -g3. Remove a couple of obsolete lines. Minor tweaks.
If type annotating mode, operate on trees to compute the adjustment to
the sizes of tagged types. Fix long line.
(cannot_be_superflat_p): Tweak head comment.
(annotate_value): Fold local constant.
(set_rm_size): Fix long line.
* gcc-interface/trans.c (Identifier_to_gnu): Rework comments.
(Attribute_to_gnu): Fix long line.
<Attr_Size>: Remove useless assertion.
Reorder statements. Use size_binop routine.
(Loop_Statement_to_gnu): Use build5 in lieu of build_nt.
Create local variables for the label and the test. Tweak comments.
(Subprogram_Body_to_gnu): Reset cfun to NULL.
(Compilation_Unit_to_gnu): Use the Sloc of the Unit node.
(process_inlined_subprograms): Integrate into...
(Compilation_Unit_to_gnu): ...this.
(gnat_to_gnu): Fix long line.
(post_error_ne_num): Change parameter name.
* gcc-interface/utils.c (process_attributes): Static-ify.
<ATTR_MACHINE_ATTRIBUTE>: Set input_location before proceeding.
(create_type_decl): Add comment.
(create_var_decl_1): Process the attributes after adding the VAR_DECL
to the current binding level.
(create_subprog_decl): Likewise for the FUNCTION_DECL.
(end_subprog_body): Do not reset cfun to NULL.
(build_vms_descriptor32): Fix long line.
(build_vms_descriptor): Likewise.
(handle_nonnull_attribute): Likewise.
(convert_vms_descriptor64): Likewise.
* gcc-interface/utils2.c (fill_vms_descriptor): Fix long line.
(gnat_protect_expr): Fix thinko.
From-SVN: r158390
---
gcc/ada/ChangeLog | 39 ++++++
gcc/ada/gcc-interface/cuintp.c | 3 +-
gcc/ada/gcc-interface/decl.c | 78 ++++++------
gcc/ada/gcc-interface/gigi.h | 13 +-
gcc/ada/gcc-interface/trans.c | 218 ++++++++++++++++-----------------
gcc/ada/gcc-interface/utils.c | 164 ++++++++++++-------------
gcc/ada/gcc-interface/utils2.c | 12 +-
7 files changed, 279 insertions(+), 248 deletions(-)
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index aaec1a4651dd..38a5ae5dee97 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,42 @@
+2010-04-15 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/cuintp.c (UI_To_gnu): Fix long line.
+ * gcc-interface/gigi.h (MARK_VISITED): Skip objects of constant class.
+ (process_attributes): Delete.
+ (post_error_ne_num): Change parameter name.
+ * gcc-interface/decl.c (gnat_to_gnu_entity): Do not force debug info
+ with -g3. Remove a couple of obsolete lines. Minor tweaks.
+ If type annotating mode, operate on trees to compute the adjustment to
+ the sizes of tagged types. Fix long line.
+ (cannot_be_superflat_p): Tweak head comment.
+ (annotate_value): Fold local constant.
+ (set_rm_size): Fix long line.
+ * gcc-interface/trans.c (Identifier_to_gnu): Rework comments.
+ (Attribute_to_gnu): Fix long line.
+ <Attr_Size>: Remove useless assertion.
+ Reorder statements. Use size_binop routine.
+ (Loop_Statement_to_gnu): Use build5 in lieu of build_nt.
+ Create local variables for the label and the test. Tweak comments.
+ (Subprogram_Body_to_gnu): Reset cfun to NULL.
+ (Compilation_Unit_to_gnu): Use the Sloc of the Unit node.
+ (process_inlined_subprograms): Integrate into...
+ (Compilation_Unit_to_gnu): ...this.
+ (gnat_to_gnu): Fix long line.
+ (post_error_ne_num): Change parameter name.
+ * gcc-interface/utils.c (process_attributes): Static-ify.
+ <ATTR_MACHINE_ATTRIBUTE>: Set input_location before proceeding.
+ (create_type_decl): Add comment.
+ (create_var_decl_1): Process the attributes after adding the VAR_DECL
+ to the current binding level.
+ (create_subprog_decl): Likewise for the FUNCTION_DECL.
+ (end_subprog_body): Do not reset cfun to NULL.
+ (build_vms_descriptor32): Fix long line.
+ (build_vms_descriptor): Likewise.
+ (handle_nonnull_attribute): Likewise.
+ (convert_vms_descriptor64): Likewise.
+ * gcc-interface/utils2.c (fill_vms_descriptor): Fix long line.
+ (gnat_protect_expr): Fix thinko.
+
2010-04-15 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (gigi): Set DECL_IGNORED_P on EH functions.
diff --git a/gcc/ada/gcc-interface/cuintp.c b/gcc/ada/gcc-interface/cuintp.c
index 9b4204012b50..642a71b21c55 100644
--- a/gcc/ada/gcc-interface/cuintp.c
+++ b/gcc/ada/gcc-interface/cuintp.c
@@ -106,7 +106,8 @@ UI_To_gnu (Uint Input, tree type)
The base integer precision must be superior than 16. */
if (TREE_CODE (comp_type) != REAL_TYPE
- && TYPE_PRECISION (comp_type) < TYPE_PRECISION (long_integer_type_node))
+ && TYPE_PRECISION (comp_type)
+ < TYPE_PRECISION (long_integer_type_node))
{
comp_type = long_integer_type_node;
gcc_assert (TYPE_PRECISION (comp_type) > 16);
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index b5ee0cfed0e6..9ca27fd03ab1 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -207,8 +207,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* True if we made GNU_DECL and its type here. */
bool this_made_decl = false;
/* True if debug info is requested for this entity. */
- bool debug_info_p = (Needs_Debug_Info (gnat_entity)
- || debug_info_level == DINFO_LEVEL_VERBOSE);
+ 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)));
@@ -983,8 +982,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
as we have a VAR_DECL for the pointer we make. */
}
- gnu_expr
- = build_unary_op (ADDR_EXPR, gnu_type, maybe_stable_expr);
+ gnu_expr = build_unary_op (ADDR_EXPR, gnu_type,
+ maybe_stable_expr);
gnu_size = NULL_TREE;
used_by_ref = true;
@@ -1291,10 +1290,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|| Is_Exported (gnat_entity)))))
gnu_ext_name = create_concat_name (gnat_entity, NULL);
- /* If this is constant initialized to a static constant and the
- object has an aggregate type, force it to be statically
- allocated. This will avoid an initialization copy. */
- if (!static_p && const_flag
+ /* If this is an aggregate constant initialized to a constant, force it
+ to be statically allocated. This saves an initialization copy. */
+ if (!static_p
+ && const_flag
&& gnu_expr && TREE_CONSTANT (gnu_expr)
&& AGGREGATE_TYPE_P (gnu_type)
&& host_integerp (TYPE_SIZE_UNIT (gnu_type), 1)
@@ -1303,11 +1302,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
(TREE_TYPE (TYPE_FIELDS (gnu_type))), 1)))
static_p = true;
- gnu_decl = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
- gnu_expr, const_flag,
- Is_Public (gnat_entity),
- imported_p || !definition,
- static_p, attr_list, gnat_entity);
+ gnu_decl
+ = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
+ gnu_expr, const_flag, Is_Public (gnat_entity),
+ imported_p || !definition, static_p, attr_list,
+ gnat_entity);
DECL_BY_REF_P (gnu_decl) = used_by_ref;
DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
@@ -3473,7 +3472,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_old);
TYPE_POINTER_TO (gnu_old) = gnu_type;
- Sloc_to_locus (Sloc (gnat_entity), &input_location);
fields
= chainon (chainon (NULL_TREE,
create_field_decl
@@ -4170,8 +4168,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
| (TYPE_QUAL_CONST * const_flag)
| (TYPE_QUAL_VOLATILE * volatile_flag));
- Sloc_to_locus (Sloc (gnat_entity), &input_location);
-
if (has_stub)
gnu_stub_type
= build_qualified_type (gnu_stub_type,
@@ -4705,38 +4701,40 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (Unknown_Esize (gnat_entity) && TYPE_SIZE (gnu_type))
{
- /* If the size is self-referential, we annotate the maximum
- value of that size. */
tree gnu_size = TYPE_SIZE (gnu_type);
+ /* If the size is self-referential, annotate the maximum value. */
if (CONTAINS_PLACEHOLDER_P (gnu_size))
gnu_size = max_size (gnu_size, true);
- Set_Esize (gnat_entity, annotate_value (gnu_size));
-
if (type_annotate_only && Is_Tagged_Type (gnat_entity))
{
- /* In this mode the tag and the parent components are not
- generated by the front-end, so the sizes must be adjusted
- explicitly now. */
- int size_offset, new_size;
+ /* In this mode, the tag and the parent components are not
+ generated by the front-end so the sizes must be adjusted. */
+ tree pointer_size = bitsize_int (POINTER_SIZE), offset;
+ Uint uint_size;
if (Is_Derived_Type (gnat_entity))
{
- size_offset
- = UI_To_Int (Esize (Etype (Base_Type (gnat_entity))));
+ offset = UI_To_gnu (Esize (Etype (Base_Type (gnat_entity))),
+ bitsizetype);
Set_Alignment (gnat_entity,
Alignment (Etype (Base_Type (gnat_entity))));
}
else
- size_offset = POINTER_SIZE;
-
- new_size = UI_To_Int (Esize (gnat_entity)) + size_offset;
- Set_Esize (gnat_entity,
- UI_From_Int (((new_size + (POINTER_SIZE - 1))
- / POINTER_SIZE) * POINTER_SIZE));
- Set_RM_Size (gnat_entity, Esize (gnat_entity));
+ offset = pointer_size;
+
+ gnu_size = size_binop (PLUS_EXPR, gnu_size, offset);
+ gnu_size = size_binop (MULT_EXPR, pointer_size,
+ size_binop (CEIL_DIV_EXPR,
+ gnu_size,
+ pointer_size));
+ uint_size = annotate_value (gnu_size);
+ Set_Esize (gnat_entity, uint_size);
+ Set_RM_Size (gnat_entity, uint_size);
}
+ else
+ Set_Esize (gnat_entity, annotate_value (gnu_size));
}
if (Unknown_RM_Size (gnat_entity) && rm_size (gnu_type))
@@ -5366,15 +5364,14 @@ compile_time_known_address_p (Node_Id gnat_address)
return Compile_Time_Known_Value (gnat_address);
}
-/* Return true if GNAT_RANGE, a N_Range node, cannot be superflat, i.e.
- cannot verify HB < LB-1 when LB and HB are the low and high bounds. */
+/* Return true if GNAT_RANGE, a N_Range node, cannot be superflat, i.e. if the
+ inequality HB >= LB-1 is true. LB and HB are the low and high bounds. */
static bool
cannot_be_superflat_p (Node_Id gnat_range)
{
Node_Id gnat_lb = Low_Bound (gnat_range), gnat_hb = High_Bound (gnat_range);
Node_Id scalar_range;
-
tree gnu_lb, gnu_hb;
/* If the low bound is not constant, try to find an upper bound. */
@@ -7087,12 +7084,10 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
static Uint
annotate_value (tree gnu_size)
{
- int len = TREE_CODE_LENGTH (TREE_CODE (gnu_size));
TCode tcode;
Node_Ref_Or_Val ops[3], ret;
- int i;
- int size;
struct tree_int_map **h = NULL;
+ int size, i;
/* See if we've already saved the value for this node. */
if (EXPR_P (gnu_size))
@@ -7223,7 +7218,7 @@ annotate_value (tree gnu_size)
for (i = 0; i < 3; i++)
ops[i] = No_Uint;
- for (i = 0; i < len; i++)
+ for (i = 0; i < TREE_CODE_LENGTH (TREE_CODE (gnu_size)); i++)
{
ops[i] = annotate_value (TREE_OPERAND (gnu_size, i));
if (ops[i] == No_Uint)
@@ -7675,7 +7670,8 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
&& TYPE_PACKED_ARRAY_TYPE_P (gnu_type))
&& !(TYPE_IS_PADDING_P (gnu_type)
&& TREE_CODE (TREE_TYPE (TYPE_FIELDS (gnu_type))) == ARRAY_TYPE
- && TYPE_PACKED_ARRAY_TYPE_P (TREE_TYPE (TYPE_FIELDS (gnu_type))))
+ && TYPE_PACKED_ARRAY_TYPE_P
+ (TREE_TYPE (TYPE_FIELDS (gnu_type))))
&& tree_int_cst_lt (size, old_size)))
{
if (Present (gnat_attr_node))
diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 6b7790b98e71..f0c577799e2d 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -85,7 +85,7 @@ extern void mark_visited (tree t);
#define MARK_VISITED(EXP) \
do { \
- if((EXP) && !TREE_CONSTANT (EXP)) \
+ if((EXP) && !CONSTANT_CLASS_P (EXP)) \
mark_visited (EXP); \
} while (0)
@@ -240,9 +240,9 @@ extern void post_error (const char *msg, Node_Id node);
extern void post_error_ne (const char *msg, Node_Id node, Entity_Id ent);
/* Similar, but NODE is the node at which to post the error, ENT is the node
- to use for the "&" substitution, and N is the number to use for the ^. */
+ to use for the "&" substitution, and NUM is the number to use for ^. */
extern void post_error_ne_num (const char *msg, Node_Id node, Entity_Id ent,
- int n);
+ int num);
/* Similar to post_error_ne_num, but T is a GCC tree representing the number
to write. If the tree represents a constant that fits within a
@@ -252,8 +252,8 @@ extern void post_error_ne_num (const char *msg, Node_Id node, Entity_Id ent,
extern void post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent,
tree t);
-/* Similar to post_error_ne_tree, except that NUM is a second
- integer to write in the message. */
+/* Similar to post_error_ne_tree, except that NUM is a second integer to write
+ in the message. */
extern void post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent,
tree t, int num);
@@ -622,9 +622,6 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
const_flag, public_flag, extern_flag, \
static_flag, false, attr_list, gnat_node)
-/* Given a DECL and ATTR_LIST, apply the listed attributes. */
-extern void process_attributes (tree decl, struct attrib *attr_list);
-
/* Record DECL as a global renaming pointer. */
extern void record_global_renaming_pointer (tree decl);
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 3d802c434077..e701bc08612b 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -200,7 +200,6 @@ static void pop_stack (tree *);
static enum gimplify_status gnat_gimplify_stmt (tree *);
static void elaborate_all_entities (Node_Id);
static void process_freeze_entity (Node_Id);
-static void process_inlined_subprograms (Node_Id);
static void process_decls (List_Id, List_Id, Node_Id, bool, bool);
static tree emit_range_check (tree, Node_Id, Node_Id);
static tree emit_index_check (tree, tree, tree, tree, Node_Id);
@@ -1034,10 +1033,9 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
gnu_result_type = TREE_TYPE (TYPE_FIELDS (gnu_result_type));
}
- /* 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 we have a constant declaration and its initializer, try to return the
+ latter to avoid the need to call fold in lots of places and the need for
+ elaboration code if this identifier is used as an initializer itself. */
if (TREE_CONSTANT (gnu_result)
&& DECL_P (gnu_result)
&& DECL_INITIAL (gnu_result))
@@ -1055,11 +1053,15 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
= lvalue_required_p (gnat_node, gnu_result_type, true,
address_of_constant, Is_Aliased (gnat_temp));
+ /* ??? We need to unshare the initializer if the object is external
+ as such objects are not marked for unsharing if we are not at the
+ global level. This should be fixed in add_decl_expr. */
if ((constant_only && !address_of_constant) || !require_lvalue)
gnu_result = unshare_expr (DECL_INITIAL (gnu_result));
}
*gnu_result_type_p = gnu_result_type;
+
return gnu_result;
}
@@ -1357,7 +1359,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
tree gnu_byte_offset
= convert (sizetype,
size_diffop (size_zero_node, gnu_pos));
- gnu_byte_offset = fold_build1 (NEGATE_EXPR, sizetype, gnu_byte_offset);
+ 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 (POINTER_PLUS_EXPR, gnu_char_ptr_type,
@@ -1456,17 +1459,14 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
else
gnu_result = rm_size (gnu_type);
- gcc_assert (gnu_result);
-
/* Deal with a self-referential size by returning the maximum size for
- a type and by qualifying the size with the object for 'Size of an
- object. */
+ a type and by qualifying the size with the object otherwise. */
if (CONTAINS_PLACEHOLDER_P (gnu_result))
{
- if (TREE_CODE (gnu_prefix) != TYPE_DECL)
- gnu_result = substitute_placeholder_in_expr (gnu_result, gnu_expr);
- else
+ if (TREE_CODE (gnu_prefix) == TYPE_DECL)
gnu_result = max_size (gnu_result, true);
+ else
+ gnu_result = substitute_placeholder_in_expr (gnu_result, gnu_expr);
}
/* If the type contains a template, subtract its size. */
@@ -1475,11 +1475,11 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
gnu_result = size_binop (MINUS_EXPR, gnu_result,
DECL_SIZE (TYPE_FIELDS (gnu_type)));
- gnu_result_type = get_unpadded_type (Etype (gnat_node));
-
+ /* For 'Max_Size_In_Storage_Elements, adjust the unit. */
if (attribute == Attr_Max_Size_In_Storage_Elements)
- gnu_result = fold_build2 (CEIL_DIV_EXPR, bitsizetype,
- gnu_result, bitsize_unit_node);
+ gnu_result = size_binop (CEIL_DIV_EXPR, gnu_result, bitsize_unit_node);
+
+ gnu_result_type = get_unpadded_type (Etype (gnat_node));
break;
case Attr_Alignment:
@@ -2052,25 +2052,22 @@ Case_Statement_to_gnu (Node_Id gnat_node)
static tree
Loop_Statement_to_gnu (Node_Id gnat_node)
{
- /* ??? It would be nice to use "build" here, but there's no build5. */
- tree gnu_loop_stmt = build_nt (LOOP_STMT, NULL_TREE, NULL_TREE,
- NULL_TREE, NULL_TREE, NULL_TREE);
- tree gnu_loop_var = NULL_TREE;
- Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node);
- tree gnu_cond_expr = NULL_TREE;
+ const Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node);
+ tree gnu_loop_stmt = build5 (LOOP_STMT, void_type_node, NULL_TREE,
+ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE);
+ tree gnu_loop_label = create_artificial_label (input_location);
+ tree gnu_loop_var = NULL_TREE, gnu_cond_expr = NULL_TREE;
tree gnu_result;
- TREE_TYPE (gnu_loop_stmt) = void_type_node;
- TREE_SIDE_EFFECTS (gnu_loop_stmt) = 1;
- LOOP_STMT_LABEL (gnu_loop_stmt) = create_artificial_label (input_location);
+ /* Set location information for statement and end label. */
set_expr_location_from_node (gnu_loop_stmt, gnat_node);
Sloc_to_locus (Sloc (End_Label (gnat_node)),
- &DECL_SOURCE_LOCATION (LOOP_STMT_LABEL (gnu_loop_stmt)));
+ &DECL_SOURCE_LOCATION (gnu_loop_label));
+ LOOP_STMT_LABEL (gnu_loop_stmt) = gnu_loop_label;
- /* Save the end label of this LOOP_STMT in a stack so that the corresponding
+ /* Save the end label of this LOOP_STMT in a stack so that a corresponding
N_Exit_Statement can find it. */
- push_stack (&gnu_loop_label_stack, NULL_TREE,
- LOOP_STMT_LABEL (gnu_loop_stmt));
+ push_stack (&gnu_loop_label_stack, NULL_TREE, gnu_loop_label);
/* Set the condition under which the loop must keep going.
For the case "LOOP .... END LOOP;" the condition is always true. */
@@ -2082,8 +2079,8 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
LOOP_STMT_TOP_COND (gnu_loop_stmt)
= gnat_to_gnu (Condition (gnat_iter_scheme));
- /* Otherwise we have an iteration scheme and the condition is given by
- the bounds of the subtype of the iteration variable. */
+ /* Otherwise we have an iteration scheme and the condition is given by the
+ bounds of the subtype of the iteration variable. */
else
{
Node_Id gnat_loop_spec = Loop_Parameter_Specification (gnat_iter_scheme);
@@ -2092,18 +2089,18 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
tree gnu_type = get_unpadded_type (gnat_type);
tree gnu_low = TYPE_MIN_VALUE (gnu_type);
tree gnu_high = TYPE_MAX_VALUE (gnu_type);
- tree gnu_first, gnu_last, gnu_limit;
- enum tree_code update_code, end_code;
tree gnu_base_type = get_base_type (gnu_type);
+ tree gnu_first, gnu_last, gnu_limit, gnu_test;
+ enum tree_code update_code, test_code;
- /* We must disable modulo reduction for the loop variable, if any,
+ /* We must disable modulo reduction for the iteration variable, if any,
in order for the loop comparison to be effective. */
if (Reverse_Present (gnat_loop_spec))
{
gnu_first = gnu_high;
gnu_last = gnu_low;
update_code = MINUS_NOMOD_EXPR;
- end_code = GE_EXPR;
+ test_code = GE_EXPR;
gnu_limit = TYPE_MIN_VALUE (gnu_base_type);
}
else
@@ -2111,14 +2108,15 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
gnu_first = gnu_low;
gnu_last = gnu_high;
update_code = PLUS_NOMOD_EXPR;
- end_code = LE_EXPR;
+ test_code = LE_EXPR;
gnu_limit = TYPE_MAX_VALUE (gnu_base_type);
}
- /* We know the loop variable will not overflow if GNU_LAST is a constant
- and is not equal to GNU_LIMIT. If it might overflow, we have to move
- the limit test to the end of the loop. In that case, we have to test
- for an empty loop outside the loop. */
+ /* We know that the iteration variable will not overflow if GNU_LAST is
+ a constant and is not equal to GNU_LIMIT. If it might overflow, we
+ have to turn the limit test into an inequality test and move it to
+ the end of the loop; as a consequence, we also have to test for an
+ empty loop before entering it. */
if (TREE_CODE (gnu_last) != INTEGER_CST
|| TREE_CODE (gnu_limit) != INTEGER_CST
|| tree_int_cst_equal (gnu_last, gnu_limit))
@@ -2129,32 +2127,30 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
gnu_low, gnu_high),
NULL_TREE, alloc_stmt_list ());
set_expr_location_from_node (gnu_cond_expr, gnat_loop_spec);
+ test_code = NE_EXPR;
}
/* Open a new nesting level that will surround the loop to declare the
- loop index variable. */
+ iteration variable. */
start_stmt_group ();
gnat_pushlevel ();
- /* Declare the loop index and set it to its initial value. */
+ /* Declare the iteration variable and set it to its initial value. */
gnu_loop_var = gnat_to_gnu_entity (gnat_loop_var, gnu_first, 1);
if (DECL_BY_REF_P (gnu_loop_var))
gnu_loop_var = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_loop_var);
- /* The loop variable might be a padded type, so use `convert' to get a
- reference to the inner variable if so. */
- gnu_loop_var = convert (get_base_type (gnu_type), gnu_loop_var);
+ /* Do all the arithmetics in the base type. */
+ gnu_loop_var = convert (gnu_base_type, gnu_loop_var);
/* Set either the top or bottom exit condition as appropriate depending
on whether or not we know an overflow cannot occur. */
+ gnu_test = build_binary_op (test_code, integer_type_node, gnu_loop_var,
+ gnu_last);
if (gnu_cond_expr)
- LOOP_STMT_BOT_COND (gnu_loop_stmt)
- = build_binary_op (NE_EXPR, integer_type_node,
- gnu_loop_var, gnu_last);
+ LOOP_STMT_BOT_COND (gnu_loop_stmt) = gnu_test;
else
- LOOP_STMT_TOP_COND (gnu_loop_stmt)
- = build_binary_op (end_code, integer_type_node,
- gnu_loop_var, gnu_last);
+ LOOP_STMT_TOP_COND (gnu_loop_stmt) = gnu_test;
LOOP_STMT_UPDATE (gnu_loop_stmt)
= build_binary_op (MODIFY_EXPR, NULL_TREE,
@@ -2169,16 +2165,15 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
}
/* If the loop was named, have the name point to this loop. In this case,
- the association is not a ..._DECL node, but the end label from this
- LOOP_STMT. */
+ the association is not a DECL node, but the end label of the loop. */
if (Present (Identifier (gnat_node)))
- save_gnu_tree (Entity (Identifier (gnat_node)),
- LOOP_STMT_LABEL (gnu_loop_stmt), true);
+ save_gnu_tree (Entity (Identifier (gnat_node)), gnu_loop_label, true);
/* Make the loop body into its own block, so any allocated storage will be
released every iteration. This is needed for stack allocation. */
LOOP_STMT_BODY (gnu_loop_stmt)
= build_stmt_group (Statements (gnat_node), true);
+ TREE_SIDE_EFFECTS (gnu_loop_stmt) = 1;
/* If we declared a variable, then we are in a statement group for that
declaration. Add the LOOP_STMT to it and make that the "loop". */
@@ -2325,13 +2320,14 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
allocate_struct_function (gnu_subprog_decl, false);
DECL_STRUCT_FUNCTION (gnu_subprog_decl)->language
= GGC_CNEW (struct language_function);
+ set_cfun (NULL);
begin_subprog_body (gnu_subprog_decl);
- gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
/* If there are Out parameters, we need to ensure that the return statement
properly copies them out. We do this by making a new block and converting
any inner return into a goto to a label at the end of the block. */
+ gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
push_stack (&gnu_return_label_stack, NULL_TREE,
gnu_cico_list ? create_artificial_label (input_location)
: NULL_TREE);
@@ -3422,26 +3418,26 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
static void
Compilation_Unit_to_gnu (Node_Id gnat_node)
{
+ const Node_Id gnat_unit = Unit (gnat_node);
+ const bool body_p = (Nkind (gnat_unit) == N_Package_Body
+ || Nkind (gnat_unit) == N_Subprogram_Body);
+ const Entity_Id gnat_unit_entity = Defining_Entity (gnat_unit);
/* Make the decl for the elaboration procedure. */
- bool body_p = (Defining_Entity (Unit (gnat_node)),
- Nkind (Unit (gnat_node)) == N_Package_Body
- || Nkind (Unit (gnat_node)) == N_Subprogram_Body);
- Entity_Id gnat_unit_entity = Defining_Entity (Unit (gnat_node));
tree gnu_elab_proc_decl
= create_subprog_decl
- (create_concat_name (gnat_unit_entity,
- body_p ? "elabb" : "elabs"),
- NULL_TREE, void_ftype, NULL_TREE, false, true, false, NULL,
- gnat_unit_entity);
+ (create_concat_name (gnat_unit_entity, body_p ? "elabb" : "elabs"),
+ NULL_TREE, void_ftype, NULL_TREE, false, true, false, NULL, gnat_unit);
struct elab_info *info;
push_stack (&gnu_elab_proc_stack, NULL_TREE, gnu_elab_proc_decl);
-
DECL_ELABORATION_PROC_P (gnu_elab_proc_decl) = 1;
+
+ /* Initialize the information structure for the function. */
allocate_struct_function (gnu_elab_proc_decl, false);
- Sloc_to_locus (Sloc (gnat_unit_entity), &cfun->function_end_locus);
- current_function_decl = NULL_TREE;
set_cfun (NULL);
+
+ current_function_decl = NULL_TREE;
+
start_stmt_group ();
gnat_pushlevel ();
@@ -3454,7 +3450,34 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
finalize_from_with_types ();
}
- process_inlined_subprograms (gnat_node);
+ /* If we can inline, generate code for all the inlined subprograms. */
+ if (optimize)
+ {
+ Entity_Id gnat_entity;
+
+ for (gnat_entity = First_Inlined_Subprogram (gnat_node);
+ Present (gnat_entity);
+ gnat_entity = Next_Inlined_Subprogram (gnat_entity))
+ {
+ Node_Id gnat_body = Parent (Declaration_Node (gnat_entity));
+
+ if (Nkind (gnat_body) != N_Subprogram_Body)
+ {
+ /* ??? This really should always be present. */
+ if (No (Corresponding_Body (gnat_body)))
+ continue;
+ gnat_body
+ = Parent (Declaration_Node (Corresponding_Body (gnat_body)));
+ }
+
+ if (Present (gnat_body))
+ {
+ /* Define the entity first so we set DECL_EXTERNAL. */
+ gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
+ add_stmt (gnat_to_gnu (gnat_body));
+ }
+ }
+ }
if (type_annotate_only && gnat_node == Cunit (Main_Unit))
{
@@ -3481,6 +3504,11 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
set_current_block_context (gnu_elab_proc_decl);
gnat_poplevel ();
DECL_SAVED_TREE (gnu_elab_proc_decl) = end_stmt_group ();
+
+ Sloc_to_locus
+ (Sloc (gnat_unit),
+ &DECL_STRUCT_FUNCTION (gnu_elab_proc_decl)->function_end_locus);
+
info->next = elab_info_list;
info->elab_proc = gnu_elab_proc_decl;
info->gnat_node = gnat_node;
@@ -5220,7 +5248,8 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_actual_obj_type
= build_unc_object_type_from_ptr (gnu_ptr_type,
gnu_actual_obj_type,
- get_identifier ("DEALLOC"));
+ get_identifier
+ ("DEALLOC"));
}
else
gnu_actual_obj_type = gnu_obj_type;
@@ -5235,7 +5264,8 @@ gnat_to_gnu (Node_Id gnat_node)
tree gnu_byte_offset
= convert (sizetype,
size_diffop (size_zero_node, gnu_pos));
- gnu_byte_offset = fold_build1 (NEGATE_EXPR, sizetype, gnu_byte_offset);
+ 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 (POINTER_PLUS_EXPR, gnu_char_ptr_type,
@@ -6219,42 +6249,6 @@ process_freeze_entity (Node_Id gnat_node)
TREE_TYPE (gnu_new));
}
-/* Process the list of inlined subprograms of GNAT_NODE, which is an
- N_Compilation_Unit. */
-
-static void
-process_inlined_subprograms (Node_Id gnat_node)
-{
- Entity_Id gnat_entity;
- Node_Id gnat_body;
-
- /* If we can inline, generate Gimple for all the inlined subprograms.
- Define the entity first so we set DECL_EXTERNAL. */
- if (optimize > 0)
- for (gnat_entity = First_Inlined_Subprogram (gnat_node);
- Present (gnat_entity);
- gnat_entity = Next_Inlined_Subprogram (gnat_entity))
- {
- gnat_body = Parent (Declaration_Node (gnat_entity));
-
- if (Nkind (gnat_body) != N_Subprogram_Body)
- {
- /* ??? This really should always be Present. */
- if (No (Corresponding_Body (gnat_body)))
- continue;
-
- gnat_body
- = Parent (Declaration_Node (Corresponding_Body (gnat_body)));
- }
-
- if (Present (gnat_body))
- {
- gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
- add_stmt (gnat_to_gnu (gnat_body));
- }
- }
-}
-
/* Elaborate decls in the lists GNAT_DECLS and GNAT_DECLS2, if present.
We make two passes, one to elaborate anything other than bodies (but
we declare a function if there was no spec). The second pass
@@ -7428,17 +7422,17 @@ post_error_ne (const char *msg, Node_Id node, Entity_Id ent)
}
/* Similar, but NODE is the node at which to post the error, ENT is the node
- to use for the "&" substitution, and N is the number to use for the ^. */
+ to use for the "&" substitution, and NUM is the number to use for ^. */
void
-post_error_ne_num (const char *msg, Node_Id node, Entity_Id ent, int n)
+post_error_ne_num (const char *msg, Node_Id node, Entity_Id ent, int num)
{
String_Template temp;
Fat_Pointer fp;
temp.Low_Bound = 1, temp.High_Bound = strlen (msg);
fp.Array = msg, fp.Bounds = &temp;
- Error_Msg_Uint_1 = UI_From_Int (n);
+ Error_Msg_Uint_1 = UI_From_Int (num);
if (Present (node))
Error_Msg_NE (fp, node, ent);
@@ -7495,8 +7489,8 @@ post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent, tree t)
Error_Msg_NE (fp, node, ent);
}
-/* Similar to post_error_ne_tree, except that NUM is a second
- integer to write in the message. */
+/* Similar to post_error_ne_tree, except that NUM is a second integer to write
+ in the message. */
void
post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent, tree t,
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index cd868a8c4790..27959ea505ca 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -203,6 +203,7 @@ static tree convert_to_fat_pointer (tree, tree);
static tree convert_to_thin_pointer (tree, tree);
static tree make_descriptor_field (const char *,tree, tree, tree);
static bool potential_alignment_gap (tree, tree, tree);
+static void process_attributes (tree, struct attrib *);
/* Initialize the association of GNAT nodes to GCC trees. */
@@ -1283,7 +1284,10 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list,
TYPE_DECL, type_name, type);
DECL_ARTIFICIAL (type_decl) = artificial_p;
+
+ /* Add this decl to the current binding level. */
gnat_pushdecl (type_decl, gnat_node);
+
process_attributes (type_decl, attr_list);
/* If we're naming the type, equate the TYPE_STUB_DECL to the name.
@@ -1413,21 +1417,17 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
!= null_pointer_node)
DECL_IGNORED_P (var_decl) = 1;
- if (TREE_CODE (var_decl) == VAR_DECL)
- {
- if (asm_name)
- SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
- process_attributes (var_decl, attr_list);
- }
-
/* Add this decl to the current binding level. */
gnat_pushdecl (var_decl, gnat_node);
if (TREE_SIDE_EFFECTS (var_decl))
TREE_ADDRESSABLE (var_decl) = 1;
- if (TREE_CODE (var_decl) != CONST_DECL)
+ if (TREE_CODE (var_decl) == VAR_DECL)
{
+ if (asm_name)
+ SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
+ process_attributes (var_decl, attr_list);
if (global_bindings_p ())
rest_of_decl_compilation (var_decl, true, 0);
}
@@ -1647,13 +1647,14 @@ create_param_decl (tree param_name, tree param_type, bool readonly)
/* Given a DECL and ATTR_LIST, process the listed attributes. */
-void
+static void
process_attributes (tree decl, struct attrib *attr_list)
{
for (; attr_list; attr_list = attr_list->next)
switch (attr_list->type)
{
case ATTR_MACHINE_ATTRIBUTE:
+ input_location = DECL_SOURCE_LOCATION (decl);
decl_attributes (&decl, tree_cons (attr_list->name, attr_list->args,
NULL_TREE),
ATTR_FLAG_TYPE_IN_PLACE);
@@ -1863,11 +1864,11 @@ create_subprog_decl (tree subprog_name, tree asm_name,
DECL_NAME (subprog_decl) = main_identifier_node;
}
- process_attributes (subprog_decl, attr_list);
-
/* Add this decl to the current binding level. */
gnat_pushdecl (subprog_decl, gnat_node);
+ process_attributes (subprog_decl, attr_list);
+
/* Output the assembler code and/or RTL for the declaration. */
rest_of_decl_compilation (subprog_decl, global_bindings_p (), 0);
@@ -1883,9 +1884,10 @@ begin_subprog_body (tree subprog_decl)
{
tree param_decl;
- current_function_decl = subprog_decl;
announce_function (subprog_decl);
+ current_function_decl = subprog_decl;
+
/* Enter a new binding level and show that all the parameters belong to
this function. */
gnat_pushlevel ();
@@ -1926,7 +1928,6 @@ end_subprog_body (tree body)
DECL_SAVED_TREE (fndecl) = body;
current_function_decl = DECL_CONTEXT (fndecl);
- set_cfun (NULL);
/* We cannot track the location of errors past this point. */
error_gnat_node = Empty;
@@ -2329,12 +2330,12 @@ build_template (tree template_type, tree array_type, tree expr)
return gnat_build_constructor (template_type, nreverse (template_elts));
}
-/* Build a 32bit VMS descriptor from a Mechanism_Type, which must specify
- a descriptor type, and the GCC type of an object. Each FIELD_DECL
- in the type contains in its DECL_INITIAL the expression to use when
- a constructor is made for the type. GNAT_ENTITY is an entity used
- to print out an error message if the mechanism cannot be applied to
- an object of that type and also for the name. */
+/* Build a 32-bit VMS descriptor from a Mechanism_Type, which must specify a
+ descriptor type, and the GCC type of an object. Each FIELD_DECL in the
+ type contains in its DECL_INITIAL the expression to use when a constructor
+ is made for the type. GNAT_ENTITY is an entity used to print out an error
+ message if the mechanism cannot be applied to an object of that type and
+ also for the name. */
tree
build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
@@ -2473,25 +2474,24 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
break;
}
- /* Make the type for a descriptor for VMS. The first four fields
- are the same for all types. */
-
+ /* Make the type for a descriptor for VMS. The first four fields are the
+ same for all types. */
+ field_list
+ = chainon (field_list,
+ make_descriptor_field ("LENGTH", gnat_type_for_size (16, 1),
+ record_type,
+ size_in_bytes
+ ((mech == By_Descriptor_A
+ || mech == By_Short_Descriptor_A)
+ ? inner_type : type)));
field_list
= chainon (field_list,
- make_descriptor_field
- ("LENGTH", gnat_type_for_size (16, 1), record_type,
- size_in_bytes ((mech == By_Descriptor_A ||
- mech == By_Short_Descriptor_A)
- ? inner_type : type)));
-
- field_list = chainon (field_list,
- make_descriptor_field ("DTYPE",
- gnat_type_for_size (8, 1),
- record_type, size_int (dtype)));
- field_list = chainon (field_list,
- make_descriptor_field ("CLASS",
- gnat_type_for_size (8, 1),
- record_type, size_int (klass)));
+ make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1),
+ record_type, size_int (dtype)));
+ field_list
+ = chainon (field_list,
+ make_descriptor_field ("CLASS", gnat_type_for_size (8, 1),
+ record_type, size_int (klass)));
/* Of course this will crash at run-time if the address space is not
within the low 32 bits, but there is nothing else we can do. */
@@ -2499,11 +2499,11 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
field_list
= chainon (field_list,
- make_descriptor_field
- ("POINTER", pointer32_type, record_type,
- build_unary_op (ADDR_EXPR,
- pointer32_type,
- build0 (PLACEHOLDER_EXPR, type))));
+ make_descriptor_field ("POINTER", pointer32_type, record_type,
+ build_unary_op (ADDR_EXPR,
+ pointer32_type,
+ build0 (PLACEHOLDER_EXPR,
+ type))));
switch (mech)
{
@@ -2644,12 +2644,12 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
return record_type;
}
-/* Build a 64bit VMS descriptor from a Mechanism_Type, which must specify
- a descriptor type, and the GCC type of an object. Each FIELD_DECL
- in the type contains in its DECL_INITIAL the expression to use when
- a constructor is made for the type. GNAT_ENTITY is an entity used
- to print out an error message if the mechanism cannot be applied to
- an object of that type and also for the name. */
+/* Build a 64-bit VMS descriptor from a Mechanism_Type, which must specify a
+ descriptor type, and the GCC type of an object. Each FIELD_DECL in the
+ type contains in its DECL_INITIAL the expression to use when a constructor
+ is made for the type. GNAT_ENTITY is an entity used to print out an error
+ message if the mechanism cannot be applied to an object of that type and
+ also for the name. */
tree
build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
@@ -2783,43 +2783,41 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
break;
}
- /* Make the type for a 64bit descriptor for VMS. The first six fields
+ /* Make the type for a 64-bit descriptor for VMS. The first six fields
are the same for all types. */
-
- field_list64 = chainon (field_list64,
- make_descriptor_field ("MBO",
- gnat_type_for_size (16, 1),
- record64_type, size_int (1)));
-
- field_list64 = chainon (field_list64,
- make_descriptor_field ("DTYPE",
- gnat_type_for_size (8, 1),
- record64_type, size_int (dtype)));
- field_list64 = chainon (field_list64,
- make_descriptor_field ("CLASS",
- gnat_type_for_size (8, 1),
- record64_type, size_int (klass)));
-
- field_list64 = chainon (field_list64,
- make_descriptor_field ("MBMO",
- gnat_type_for_size (32, 1),
- record64_type, ssize_int (-1)));
-
field_list64
= chainon (field_list64,
- make_descriptor_field
- ("LENGTH", gnat_type_for_size (64, 1), record64_type,
- size_in_bytes (mech == By_Descriptor_A ? inner_type : type)));
+ make_descriptor_field ("MBO", gnat_type_for_size (16, 1),
+ record64_type, size_int (1)));
+ field_list64
+ = chainon (field_list64,
+ make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1),
+ record64_type, size_int (dtype)));
+ field_list64
+ = chainon (field_list64,
+ make_descriptor_field ("CLASS", gnat_type_for_size (8, 1),
+ record64_type, size_int (klass)));
+ field_list64
+ = chainon (field_list64,
+ make_descriptor_field ("MBMO", gnat_type_for_size (32, 1),
+ record64_type, ssize_int (-1)));
+ field_list64
+ = chainon (field_list64,
+ make_descriptor_field ("LENGTH", gnat_type_for_size (64, 1),
+ record64_type,
+ size_in_bytes (mech == By_Descriptor_A
+ ? inner_type : type)));
pointer64_type = build_pointer_type_for_mode (type, DImode, false);
field_list64
= chainon (field_list64,
- make_descriptor_field
- ("POINTER", pointer64_type, record64_type,
- build_unary_op (ADDR_EXPR,
- pointer64_type,
- build0 (PLACEHOLDER_EXPR, type))));
+ make_descriptor_field ("POINTER", pointer64_type,
+ record64_type,
+ build_unary_op (ADDR_EXPR,
+ pointer64_type,
+ build0 (PLACEHOLDER_EXPR,
+ type))));
switch (mech)
{
@@ -2983,11 +2981,11 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
/* The CLASS field is the 3rd field in the descriptor. */
tree klass = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
/* The POINTER field is the 6th field in the descriptor. */
- tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (klass)));
+ tree pointer = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (klass)));
/* Retrieve the value of the POINTER field. */
tree gnu_expr64
- = build3 (COMPONENT_REF, TREE_TYPE (pointer64), desc, pointer64, NULL_TREE);
+ = build3 (COMPONENT_REF, TREE_TYPE (pointer), desc, pointer, NULL_TREE);
if (POINTER_TYPE_P (gnu_type))
return convert (gnu_type, gnu_expr64);
@@ -3033,7 +3031,7 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
/* If so, there is already a template in the descriptor and
it is located right after the POINTER field. The fields are
64bits so they must be repacked. */
- t = TREE_CHAIN (pointer64);
+ t = TREE_CHAIN (pointer);
lfield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
lfield = convert (TREE_TYPE (TYPE_FIELDS (template_type)), lfield);
@@ -3058,7 +3056,7 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
case 4: /* Class A */
/* The AFLAGS field is the 3rd field after the pointer in the
descriptor. */
- t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (pointer64)));
+ t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (pointer)));
aflags = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
/* The DIMCT field is the next field in the descriptor after
aflags. */
@@ -5084,7 +5082,8 @@ handle_nonnull_attribute (tree *node, tree ARG_UNUSED (name),
if (!argument
|| TREE_CODE (TREE_VALUE (argument)) == VOID_TYPE)
{
- error ("nonnull argument with out-of-range operand number (argument %lu, operand %lu)",
+ error ("nonnull argument with out-of-range operand number "
+ "(argument %lu, operand %lu)",
(unsigned long) attr_arg_num, (unsigned long) arg_num);
*no_add_attrs = true;
return NULL_TREE;
@@ -5092,7 +5091,8 @@ handle_nonnull_attribute (tree *node, tree ARG_UNUSED (name),
if (TREE_CODE (TREE_VALUE (argument)) != POINTER_TYPE)
{
- error ("nonnull argument references non-pointer operand (argument %lu, operand %lu)",
+ error ("nonnull argument references non-pointer operand "
+ "(argument %lu, operand %lu)",
(unsigned long) attr_arg_num, (unsigned long) arg_num);
*no_add_attrs = true;
return NULL_TREE;
diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index 3a5b96205865..b6bd268feeed 100644
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -2121,7 +2121,8 @@ fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual)
convert (long_integer_type_node,
addr64expr),
malloc64low),
- build_call_raise (CE_Range_Check_Failed, gnat_actual,
+ build_call_raise (CE_Range_Check_Failed,
+ gnat_actual,
N_Raise_Constraint_Error),
NULL_TREE));
}
@@ -2228,9 +2229,12 @@ gnat_protect_expr (tree exp)
unshared for gimplification; in order to avoid a complexity explosion
at that point, we protect any expressions more complex than a simple
arithmetic expression. */
- if (!TREE_SIDE_EFFECTS (exp)
- && !EXPRESSION_CLASS_P (skip_simple_arithmetic (exp)))
- return exp;
+ if (!TREE_SIDE_EFFECTS (exp))
+ {
+ tree inner = skip_simple_arithmetic (exp);
+ if (!EXPR_P (inner) || REFERENCE_CLASS_P (inner))
+ return exp;
+ }
/* If this is a conversion, protect what's inside the conversion. */
if (code == NON_LVALUE_EXPR
--
GitLab