diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f0551826626..d6788f3d3be 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,31 @@ +2004-06-20 Richard Kenner + + * decl.c (elaborate_expression, elaborate_expression_1): Arguments + now bool instead of int. + (gnat_to_gnu_entity, elaborate_expression_1): New arg to COMPONENT_REF. + * trans.c (gnu_switch_label_stack): New function. + (gnat_to_gnu, N_Object_Renaming_Declaration): Result is what the + elaboration of renamed entity returns. + (gnat_to_gnu, case N_Case_Statement): Add branches to end label. + (add_decl_stmt): Don't add TYPE_DECL for UNCONSTRAINED_ARRAY_TYPE. + (gnat_gimplify_stmt): Use alloc_stmt_list, not build_empty_stmt. + (gnat_gimplify_stmt, case DECL_STMT): gimplify DECL_SIZE and + DECL_SIZE_UNIT and simplify variable-sized case. + (gnat_gimplify_type_sizes, gnat_gimplify_one_sizepos): Deleted. + Callers changes to call gimplify_type_sizes and gimplify_one_sizepos. + (gnat_stabilize_reference): Add arg to COMPONENT_REF. + (build_unit_elab): Disable for now. + * utils.c (mark_visited): New function. + (pushdecl): Walk tree to call it for global decl. + (update_pointer_to): Update all variants of pointer and ref types. + Add arg to COMPONENT_REF. + (convert): Likewise. + Move check for converting between variants lower down. + * utils2.c (build_simple_component_ref): Add arg to COMPONENT_REF. + (build_allocator): Don't force type of MODIFY_EXPR. + (gnat_mark_addressable, case VAR_DECL): Unconditionally call + put_var_into_stack. + 2004-06-14 Richard Kenner * ada-tree.def (LOOP_STMT, EXIT_STMT): Update documentation. diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index 3f5d80939fb..25fe2c8dd58 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -84,9 +84,10 @@ static void copy_alias_set (tree, tree); static tree substitution_list (Entity_Id, Entity_Id, tree, int); static int allocatable_size_p (tree, int); static struct attrib *build_attr_list (Entity_Id); -static tree elaborate_expression (Node_Id, Entity_Id, tree, int, int, int); +static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool); static int is_variable_size (tree); -static tree elaborate_expression_1 (Node_Id, Entity_Id, tree, tree, int, int); +static tree elaborate_expression_1 (Node_Id, Entity_Id, tree, tree, + bool, bool); static tree make_packable_type (tree); static tree maybe_pad_type (tree, tree, unsigned int, Entity_Id, const char *, int, int, int); @@ -1487,7 +1488,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) fields once we build them. */ tem = build (COMPONENT_REF, gnu_ptr_template, build (PLACEHOLDER_EXPR, gnu_fat_type), - TREE_CHAIN (TYPE_FIELDS (gnu_fat_type))); + TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)), NULL_TREE); gnu_template_reference = build_unary_op (INDIRECT_REF, gnu_template_type, tem); TREE_READONLY (gnu_template_reference) = 1; @@ -1532,9 +1533,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* We can't use build_component_ref here since the template type isn't complete yet. */ gnu_min = build (COMPONENT_REF, gnu_ind_subtype, - gnu_template_reference, gnu_min_field); + gnu_template_reference, gnu_min_field, NULL_TREE); gnu_max = build (COMPONENT_REF, gnu_ind_subtype, - gnu_template_reference, gnu_max_field); + gnu_template_reference, gnu_max_field, NULL_TREE); TREE_READONLY (gnu_min) = TREE_READONLY (gnu_max) = 1; /* Make a range type with the new ranges, but using @@ -2331,7 +2332,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_get_parent = build (COMPONENT_REF, void_type_node, build (PLACEHOLDER_EXPR, gnu_type), build_decl (FIELD_DECL, NULL_TREE, - NULL_TREE)); + NULL_TREE), + NULL_TREE); if (Has_Discriminants (gnat_entity)) for (gnat_field = First_Stored_Discriminant (gnat_entity); @@ -2345,7 +2347,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_get_parent, gnat_to_gnu_entity (Corresponding_Discriminant (gnat_field), - NULL_TREE, 0)), + NULL_TREE, 0), + NULL_TREE), 1); gnu_parent = gnat_to_gnu_type (Parent_Subtype (gnat_entity)); @@ -2387,7 +2390,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) build (COMPONENT_REF, TREE_TYPE (gnu_field), build (PLACEHOLDER_EXPR, DECL_CONTEXT (gnu_field)), - gnu_field), + gnu_field, NULL_TREE), 1); TREE_CHAIN (gnu_field) = gnu_field_list; @@ -4453,12 +4456,9 @@ maybe_variable (tree gnu_operand) purposes even if it isn't needed for code generation. */ static tree -elaborate_expression (Node_Id gnat_expr, - Entity_Id gnat_entity, - tree gnu_name, - int definition, - int need_value, - int need_debug) +elaborate_expression (Node_Id gnat_expr, Entity_Id gnat_entity, + tree gnu_name, bool definition, bool need_value, + bool need_debug) { tree gnu_expr; @@ -4480,10 +4480,8 @@ elaborate_expression (Node_Id gnat_expr, = elaborate_expression_1 (gnat_expr, gnat_entity, gnat_to_gnu (gnat_expr), gnu_name, definition, need_debug); - /* Save the expression in case we try to elaborate this entity again. - Since this is not a DECL, don't check it. If this is a constant, - don't save it since GNAT_EXPR might be used more than once. Also, - don't save if it's a discriminant. */ + /* Save the expression in case we try to elaborate this entity again. Since + this is not a DECL, don't check it. Don't save if it's a discriminant. */ if (! CONTAINS_PLACEHOLDER_P (gnu_expr)) save_gnu_tree (gnat_expr, gnu_expr, 1); @@ -4493,12 +4491,9 @@ elaborate_expression (Node_Id gnat_expr, /* Similar, but take a GNU expression. */ static tree -elaborate_expression_1 (Node_Id gnat_expr, - Entity_Id gnat_entity, - tree gnu_expr, - tree gnu_name, - int definition, - int need_debug) +elaborate_expression_1 (Node_Id gnat_expr, Entity_Id gnat_entity, + tree gnu_expr, tree gnu_name, bool definition, + bool need_debug) { tree gnu_decl = 0; /* Strip any conversions to see if the expression is a readonly variable. @@ -4517,7 +4512,7 @@ elaborate_expression_1 (Node_Id gnat_expr, if (TREE_CODE (gnu_expr) == FIELD_DECL) gnu_expr = build (COMPONENT_REF, TREE_TYPE (gnu_expr), build (PLACEHOLDER_EXPR, DECL_CONTEXT (gnu_expr)), - gnu_expr); + gnu_expr, NULL_TREE); /* If GNU_EXPR is neither a placeholder nor a constant, nor a variable that is a constant, make a variable that is initialized to contain the diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index 0dec6721252..b6e9abcfcea 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -109,6 +109,10 @@ static GTY(()) tree gnu_return_label_stack; TREE_VALUE of each entry is the label of the corresponding LOOP_STMT. */ static GTY(()) tree gnu_loop_label_stack; +/* List of TREE_LIST nodes representing labels for switch statements. + TREE_VALUE of each entry is the label at the end of the switch. */ +static GTY(()) tree gnu_switch_label_stack; + /* List of TREE_LIST nodes containing pending elaborations lists. used to prevent the elaborations being reclaimed by GC. */ static GTY(()) tree gnu_pending_elaboration_lists; @@ -746,18 +750,21 @@ gnat_to_gnu (Node_Id gnat_node) case N_Object_Renaming_Declaration: gnat_temp = Defining_Entity (gnat_node); - gnu_result = alloc_stmt_list (); - /* Don't do anything if this renaming is handled by the front end. - or if we are just annotating types and this object has a - composite or task type, don't elaborate it. */ + /* Don't do anything if this renaming is handled by the front end. or if + we are just annotating types and this object has a composite or task + type, don't elaborate it. We return the result in case it has any + SAVE_EXPRs in it that need to be evaluated here. */ if (! Is_Renaming_Of_Object (gnat_temp) && ! (type_annotate_only && (Is_Array_Type (Etype (gnat_temp)) || Is_Record_Type (Etype (gnat_temp)) || Is_Concurrent_Type (Etype (gnat_temp))))) - gnat_to_gnu_entity (gnat_temp, - gnat_to_gnu (Renamed_Object (gnat_temp)), 1); + gnu_result + = gnat_to_gnu_entity (gnat_temp, + gnat_to_gnu (Renamed_Object (gnat_temp)), 1); + else + gnu_result = alloc_stmt_list (); break; case N_Implicit_Label_Declaration: @@ -2053,6 +2060,8 @@ gnat_to_gnu (Node_Id gnat_node) /* We build a SWITCH_EXPR that contains the code with interspersed CASE_LABEL_EXPRs for each label. */ + push_stack (&gnu_switch_label_stack, NULL_TREE, + create_artificial_label ()); start_stmt_group (); for (gnat_when = First_Non_Pragma (Alternatives (gnat_node)); Present (gnat_when); @@ -2121,10 +2130,17 @@ gnat_to_gnu (Node_Id gnat_node) we want them to be local to this set of statements instead of the block containing the Case statement. */ add_stmt (build_stmt_group (Statements (gnat_when), true)); + add_stmt (build1 (GOTO_EXPR, void_type_node, + TREE_VALUE (gnu_switch_label_stack))); + } + /* Now emit a definition of the label all the cases branched to. */ + add_stmt (build1 (LABEL_EXPR, void_type_node, + TREE_VALUE (gnu_switch_label_stack))); gnu_result = build (SWITCH_EXPR, TREE_TYPE (gnu_expr), gnu_expr, end_stmt_group (), NULL_TREE); + pop_stack (&gnu_switch_label_stack); break; } @@ -4051,8 +4067,11 @@ add_decl_stmt (tree gnu_decl, Entity_Id gnat_entity) { /* If this is a variable that Gigi is to ignore, we may have been given an ERROR_MARK. So test for it. We also might have been given a - reference for a renaming. So only do something for a decl. */ - if (!DECL_P (gnu_decl)) + reference for a renaming. So only do something for a decl. Also + ignore a TYPE_DECL for an UNCONSTRAINED_ARRAY_TYPE. */ + if (!DECL_P (gnu_decl) + || (TREE_CODE (gnu_decl) == TYPE_DECL + && TREE_CODE (TREE_TYPE (gnu_decl)) == UNCONSTRAINED_ARRAY_TYPE)) return; add_stmt_with_node (build (DECL_STMT, void_type_node, gnu_decl), @@ -4254,7 +4273,7 @@ gnat_gimplify_stmt (tree *stmt_p) return GS_OK; case USE_STMT: - *stmt_p = build_empty_stmt (); + *stmt_p = alloc_stmt_list (); return GS_ALL_DONE; case DECL_STMT: @@ -4262,31 +4281,33 @@ gnat_gimplify_stmt (tree *stmt_p) tree var = DECL_STMT_VAR (stmt); if (TREE_CODE (var) == TYPE_DECL) - *stmt_p = gnat_gimplify_type_sizes (TREE_TYPE (var)); - else if (TREE_CODE (var) == VAR_DECL && !DECL_EXTERNAL (var) - && !TREE_CONSTANT (DECL_SIZE_UNIT (var))) + *stmt_p = gimplify_type_sizes (TREE_TYPE (var)); + else if (TREE_CODE (var) == VAR_DECL) { - tree pt_type = build_pointer_type (TREE_TYPE (var)); - tree size, pre = NULL_TREE, post = NULL_TREE; - - /* This is a variable-sized decl. Simplify its size and mark it - for deferred expansion. Note that mudflap depends on the format - of the emitted code: see mx_register_decls. */ *stmt_p = NULL_TREE; - size = get_initialized_tmp_var (DECL_SIZE_UNIT (var), &pre, &post); - DECL_DEFER_OUTPUT (var) = 1; - append_to_statement_list (pre, stmt_p); - append_to_statement_list - (build_function_call_expr - (implicit_built_in_decls[BUILT_IN_STACK_ALLOC], - tree_cons (NULL_TREE, - build1 (ADDR_EXPR, pt_type, var), - tree_cons (NULL_TREE, size, NULL_TREE))), - stmt_p); - append_to_statement_list (post, stmt_p); + gimplify_one_sizepos (&DECL_SIZE (var), stmt_p); + gimplify_one_sizepos (&DECL_SIZE_UNIT (var), stmt_p); + + if (!DECL_EXTERNAL (var) && !TREE_CONSTANT (DECL_SIZE_UNIT (var))) + { + DECL_DEFER_OUTPUT (var) = 1; + append_to_statement_list + (build_function_call_expr + (implicit_built_in_decls[BUILT_IN_STACK_ALLOC], + tree_cons (NULL_TREE, + build1 (ADDR_EXPR, + build_pointer_type (TREE_TYPE (var)), + var), + tree_cons (NULL_TREE, DECL_SIZE_UNIT (var), + NULL_TREE))), + stmt_p); + } + + if (*stmt_p == NULL_TREE) + *stmt_p = alloc_stmt_list (); } else - *stmt_p = build_empty_stmt (); + *stmt_p = alloc_stmt_list (); return GS_ALL_DONE; } @@ -4352,76 +4373,6 @@ gnat_gimplify_stmt (tree *stmt_p) abort (); } } - -/* Look through GNU_TYPE for variable-sized objects and gimplify each such - size that we find. Return a STATEMENT_LIST containing the result. */ - -static tree -gnat_gimplify_type_sizes (tree gnu_type) -{ - tree gnu_stmts = NULL_TREE; - tree gnu_field; - - switch (TREE_CODE (gnu_type)) - { - case ERROR_MARK: - case UNCONSTRAINED_ARRAY_TYPE: - return alloc_stmt_list (); - - case INTEGER_TYPE: - case ENUMERAL_TYPE: - case BOOLEAN_TYPE: - case CHAR_TYPE: - case REAL_TYPE: - gnat_gimplify_one_sizepos (&TYPE_MIN_VALUE (gnu_type), &gnu_stmts); - gnat_gimplify_one_sizepos (&TYPE_MAX_VALUE (gnu_type), &gnu_stmts); - break; - - case RECORD_TYPE: - case UNION_TYPE: - case QUAL_UNION_TYPE: - for (gnu_field = TYPE_FIELDS (gnu_type); gnu_field; - gnu_field = TREE_CHAIN (gnu_field)) - if (TREE_CODE (gnu_field) == FIELD_DECL) - gnat_gimplify_one_sizepos (&DECL_FIELD_OFFSET (gnu_field), - &gnu_stmts); - break; - - default: - break; - } - - gnat_gimplify_one_sizepos (&TYPE_SIZE (gnu_type), &gnu_stmts); - gnat_gimplify_one_sizepos (&TYPE_SIZE_UNIT (gnu_type), &gnu_stmts); - - if (!gnu_stmts) - gnu_stmts = alloc_stmt_list (); - - return gnu_stmts; -} - -/* Subroutine of the above to gimplify one size or position, *GNU_EXPR_P. - We add any required statements to GNU_STMT_P. */ - -static void -gnat_gimplify_one_sizepos (tree *gnu_expr_p, tree *gnu_stmt_p) -{ - tree gnu_pre = NULL_TREE, gnu_post = NULL_TREE; - - /* We don't do anything if the value isn't there, is constant, or - contains a PLACEHOLDER_EXPR. */ - if (*gnu_expr_p == NULL_TREE - || TREE_CONSTANT (*gnu_expr_p) - || CONTAINS_PLACEHOLDER_P (*gnu_expr_p)) - return; - - gimplify_expr (gnu_expr_p, &gnu_pre, &gnu_post, is_gimple_val, fb_rvalue); - - if (gnu_pre) - append_to_statement_list (gnu_pre, gnu_stmt_p); - if (gnu_post) - append_to_statement_list (gnu_post, gnu_stmt_p); -} /* Generate the RTL for the body of GNU_DECL. If NESTED_P is nonzero, then we are already in the process of generating RTL for another @@ -5472,7 +5423,7 @@ gnat_stabilize_reference (tree ref, int force) result = build (COMPONENT_REF, type, gnat_stabilize_reference (TREE_OPERAND (ref, 0), force), - TREE_OPERAND (ref, 1)); + TREE_OPERAND (ref, 1), NULL_TREE); break; case BIT_FIELD_REF: @@ -5592,6 +5543,9 @@ build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list) rtx insn; int result = 1; + /* ??? For now, force nothing to do. */ + gnu_elab_list = 0; + /* If we have nothing to do, return. */ if (gnu_elab_list == 0) return 1; diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index 6906e98e293..7619b4a0e57 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -133,6 +133,7 @@ struct language_function GTY(()) int unused; }; +static tree mark_visited (tree *, int *, void *); static void gnat_define_builtin (const char *, tree, int, const char *, bool); static void gnat_install_builtins (void); static tree merge_sizes (tree, tree, tree, int, int); @@ -338,6 +339,21 @@ block_has_vars () return BLOCK_VARS (current_binding_level->block) != 0; } +/* Utility function to mark nodes with TREE_VISITED. Called from walk_tree. + We use this to indicate all variable sizes and positions in global types + may not be shared by any subprogram. */ + +static tree +mark_visited (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED) +{ + if (TREE_VISITED (*tp)) + *walk_subtrees = 0; + else + TREE_VISITED (*tp) = 1; + + return NULL_TREE; +} + /* Records a ..._DECL node DECL as belonging to the current lexical scope. Returns the ..._DECL node. */ @@ -345,9 +361,13 @@ tree pushdecl (tree decl) { /* If at top level, there is no context. But PARM_DECLs always go in the - level of its function. */ + level of its function. Also, at toplevel we must protect all trees + that are part of sizes and positions. */ if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL) - DECL_CONTEXT (decl) = 0; + { + DECL_CONTEXT (decl) = 0; + walk_tree (&decl, mark_visited, NULL, NULL); + } else DECL_CONTEXT (decl) = current_function_decl; @@ -1261,11 +1281,8 @@ create_index_type (tree min, tree max, tree index) information about this type. */ tree -create_type_decl (tree type_name, - tree type, - struct attrib *attr_list, - int artificial_p, - int debug_info_p) +create_type_decl (tree type_name, tree type, struct attrib *attr_list, + int artificial_p, int debug_info_p) { tree type_decl = build_decl (TYPE_DECL, type_name, type); enum tree_code code = TREE_CODE (type); @@ -1929,7 +1946,7 @@ gnat_gimplify_function (tree fndecl) so that items like VLA sizes are expanded properly in the context of the correct function. */ cgn = cgraph_node (fndecl); - for (cgn = cgn->nested; cgn ; cgn = cgn->next_nested) + for (cgn = cgn->nested; cgn; cgn = cgn->next_nested) gnat_gimplify_function (cgn->decl); } @@ -2615,6 +2632,7 @@ update_pointer_to (tree old_type, tree new_type) { tree ptr = TYPE_POINTER_TO (old_type); tree ref = TYPE_REFERENCE_TO (old_type); + tree ptr1, ref1; tree type; /* If this is the main variant, process all the other variants first. */ @@ -2662,26 +2680,30 @@ update_pointer_to (tree old_type, tree new_type) TYPE_REFERENCE_TO (new_type) = ref; for (; ptr; ptr = TYPE_NEXT_PTR_TO (ptr)) - { - TREE_TYPE (ptr) = new_type; + for (ptr1 = TYPE_MAIN_VARIANT (ptr); ptr1; + ptr1 = TYPE_NEXT_VARIANT (ptr1)) + { + TREE_TYPE (ptr1) = new_type; - if (TYPE_NAME (ptr) != 0 - && TREE_CODE (TYPE_NAME (ptr)) == TYPE_DECL - && TREE_CODE (new_type) != ENUMERAL_TYPE) - rest_of_decl_compilation (TYPE_NAME (ptr), NULL, - global_bindings_p (), 0); - } + if (TYPE_NAME (ptr1) != 0 + && TREE_CODE (TYPE_NAME (ptr1)) == TYPE_DECL + && TREE_CODE (new_type) != ENUMERAL_TYPE) + rest_of_decl_compilation (TYPE_NAME (ptr1), NULL, + global_bindings_p (), 0); + } for (; ref; ref = TYPE_NEXT_PTR_TO (ref)) - { - TREE_TYPE (ref) = new_type; + for (ref1 = TYPE_MAIN_VARIANT (ref); ref1; + ref1 = TYPE_NEXT_VARIANT (ref1)) + { + TREE_TYPE (ref1) = new_type; - if (TYPE_NAME (ref) != 0 - && TREE_CODE (TYPE_NAME (ref)) == TYPE_DECL - && TREE_CODE (new_type) != ENUMERAL_TYPE) - rest_of_decl_compilation (TYPE_NAME (ref), NULL, - global_bindings_p (), 0); - } + if (TYPE_NAME (ref1) != 0 + && TREE_CODE (TYPE_NAME (ref1)) == TYPE_DECL + && TREE_CODE (new_type) != ENUMERAL_TYPE) + rest_of_decl_compilation (TYPE_NAME (ref1), NULL, + global_bindings_p (), 0); + } } /* Now deal with the unconstrained array case. In this case the "pointer" @@ -2711,7 +2733,7 @@ update_pointer_to (tree old_type, tree new_type) ptr_temp_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (ptr))); new_ref = build (COMPONENT_REF, ptr_temp_type, build (PLACEHOLDER_EXPR, ptr), - TREE_CHAIN (TYPE_FIELDS (ptr))); + TREE_CHAIN (TYPE_FIELDS (ptr)), NULL_TREE); update_pointer_to (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (ptr))), @@ -2854,11 +2876,6 @@ convert (tree type, tree expr) /* If EXPR is already the right type, we are done. */ if (type == etype) return expr; - /* If we're converting between two aggregate types that have the same main - variant, just make a VIEW_CONVER_EXPR. */ - else if (AGGREGATE_TYPE_P (type) - && TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype)) - return build1 (VIEW_CONVERT_EXPR, type, expr); /* If the input type has padding, remove it by doing a component reference to the field. If the output type has padding, make a constructor @@ -2995,7 +3012,7 @@ convert (tree type, tree expr) && operand_equal_p (TYPE_SIZE (type), TYPE_SIZE (etype), 0) && get_alias_set (type) == get_alias_set (etype)) return build (COMPONENT_REF, type, TREE_OPERAND (expr, 0), - TREE_OPERAND (expr, 1)); + TREE_OPERAND (expr, 1), NULL_TREE); break; @@ -3043,9 +3060,16 @@ convert (tree type, tree expr) if (TYPE_FAT_POINTER_P (type) && ! TYPE_FAT_POINTER_P (etype)) return convert_to_fat_pointer (type, expr); - if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype) - || (code == INTEGER_CST && ecode == INTEGER_CST - && (type == TREE_TYPE (etype) || etype == TREE_TYPE (type)))) + /* If we're converting between two aggregate types that have the same main + variant, just make a VIEW_CONVER_EXPR. */ + else if (AGGREGATE_TYPE_P (type) + && TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype)) + return build1 (VIEW_CONVERT_EXPR, type, expr); + + /* In all other cases of related types, make a NOP_EXPR. */ + 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 (build1 (NOP_EXPR, type, expr)); switch (code) diff --git a/gcc/ada/utils2.c b/gcc/ada/utils2.c index 0d83f74e9b6..f1c167f46f3 100644 --- a/gcc/ada/utils2.c +++ b/gcc/ada/utils2.c @@ -1535,10 +1535,8 @@ gnat_build_constructor (tree type, tree list) actual record and know how to look for fields in variant parts. */ static tree -build_simple_component_ref (tree record_variable, - tree component, - tree field, - int no_fold_p) +build_simple_component_ref (tree record_variable, tree component, + tree field, int no_fold_p) { tree record_type = TYPE_MAIN_VARIANT (TREE_TYPE (record_variable)); tree ref; @@ -1610,7 +1608,8 @@ build_simple_component_ref (tree record_variable, /* It would be nice to call "fold" here, but that can lose a type we need to tag a PLACEHOLDER_EXPR with, so we can't do it. */ - ref = build (COMPONENT_REF, TREE_TYPE (field), record_variable, field); + ref = build (COMPONENT_REF, TREE_TYPE (field), record_variable, field, + NULL_TREE); if (TREE_READONLY (record_variable) || TREE_READONLY (field)) TREE_READONLY (ref) = 1; @@ -1625,10 +1624,8 @@ build_simple_component_ref (tree record_variable, reference could not be found. */ tree -build_component_ref (tree record_variable, - tree component, - tree field, - int no_fold_p) +build_component_ref (tree record_variable, tree component, + tree field, int no_fold_p) { tree ref = build_simple_component_ref (record_variable, component, field, no_fold_p); @@ -1930,7 +1927,7 @@ build_allocator (tree type, result = build (COMPOUND_EXPR, TREE_TYPE (result), build_binary_op - (MODIFY_EXPR, TREE_TYPE (TREE_TYPE (result)), + (MODIFY_EXPR, NULL_TREE, build_unary_op (INDIRECT_REF, TREE_TYPE (TREE_TYPE (result)), result), init), @@ -1993,19 +1990,8 @@ gnat_mark_addressable (tree expr_node) case VAR_DECL: case PARM_DECL: case RESULT_DECL: - /* If we have already made a REG for this decl, we must put it - directly into the stack. Likewise for a MEM whose address is a - pseudo. Otherwise, set a flag to mark us to do it later. */ - if (DECL_RTL_SET_P (expr_node) - && (GET_CODE (DECL_RTL (expr_node)) == REG - || (GET_CODE (DECL_RTL (expr_node)) == MEM - && GET_CODE (XEXP (DECL_RTL (expr_node), 0)) == REG - && (REGNO (XEXP (DECL_RTL (expr_node), 0)) - > LAST_VIRTUAL_REGISTER)))) - put_var_into_stack (expr_node, 1); - else - TREE_ADDRESSABLE (expr_node) = 1; - + put_var_into_stack (expr_node, 1); + TREE_ADDRESSABLE (expr_node) = 1; return true; case FUNCTION_DECL: