diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 39 | ||||
| -rw-r--r-- | gcc/ada/decl.c | 60 | ||||
| -rw-r--r-- | gcc/ada/misc.c | 38 | ||||
| -rw-r--r-- | gcc/ada/trans.c | 257 | ||||
| -rw-r--r-- | gcc/ada/utils.c | 32 |
5 files changed, 300 insertions, 126 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 452ed38..5450f60 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,42 @@ +2004-07-13 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> + + * decl.c: (gnat_to_gnu_entity, object case): Convert initializer to + object type. + (gnat_to_gnu_entity, case E_Record_Subtype): Properly set + TYPE_STUB_DECL. + + * misc.c (gnat_types_compatible_p): New function. + (LANG_HOOKS_TYPES_COMPATIBLE_P): New hook, to use it. + (LANG_HOOKS_TYPE_MAX_SIZE, gnat_type_max_size): New. + + * trans.c (gigi): Move processing of main N_Compilation_Unit here. + (gnat_to_gnu, case N_Compilation_Unit): Just handle nested case here. + (add_stmt): Force walking of sizes and DECL_INITIAL for DECL_EXPR. + (mark_visited): Don't mark dummy type. + (tree_transform <N_Procedure_Call_Statement>): Unless this is an In + parameter, we must remove any LJM building from GNU_NAME. + (gnat_to_gnu, case N_String_Literal): Fill in indices in CONSTRUCTOR. + (pos_to_constructor): Use int_const_binop. + (gnat_to_gnu, case N_Identifier): Don't reference DECL_INITIAL of + PARM_DECL. + + * utils.c (gnat_init_decl_processing): Don't make two "void" decls. + (gnat_pushlevel): Set TREE_USE on BLOCK node. + (gnat_install_builtins): Add __builtin_memset. + +2004-07-13 Olivier Hainque <hainque@act-europe.fr> + + * decl.c (gnat_to_gnu_entity <E_Variable>): If we are making a pointer + for a renaming, stabilize the initialization expression if we are at a + local level. At the local level, uses of the renaming may be performed + by a direct dereference of the initializing expression, and we don't + want possible variables there to be evaluated for every use. + + * trans.c (gnat_stabilize_reference, gnat_stabilize_reference_1): + Propagate TREE_SIDE_EFFECTS and TREE_THIS_VOLATILE to avoid loosing + them on the way. Account for the fact that we may introduce side + effects in the process. + 2004-07-13 Richard Henderson <rth@redhat.com> * misc.c (default_pass_by_ref): Use pass_by_reference. diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index 5ef6ef5..e719072 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -728,15 +728,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type))))))) gnu_expr = convert (gnu_type, gnu_expr); - /* See if this is a renaming. If this is a constant renaming, - treat it as a normal variable whose initial value is what - is being renamed. We cannot do this if the type is - unconstrained or class-wide. + /* See if this is a renaming. If this is a constant renaming, treat + it as a normal variable whose initial value is what is being + renamed. We cannot do this if the type is unconstrained or + class-wide. Otherwise, if what we are renaming is a reference, we can simply - return a stabilized version of that reference, after forcing - any SAVE_EXPRs to be evaluated. But, if this is at global level, - we can only do this if we know no SAVE_EXPRs will be made. + return a stabilized version of that reference, after forcing any + SAVE_EXPRs to be evaluated. But, if this is at global level, we + can only do this if we know no SAVE_EXPRs will be made. + Otherwise, make this into a constant pointer to the object we are to rename. */ @@ -761,8 +762,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && !Is_Array_Type (Etype (gnat_entity))) ; - /* If this is a declaration or reference, we can just use that - declaration or reference as this entity. */ + /* If this is a declaration or reference that we can stabilize, + just use that declaration or reference as this entity unless + the latter has to be materialized. */ else if ((DECL_P (gnu_expr) || TREE_CODE_CLASS (TREE_CODE (gnu_expr)) == 'r') && ! Materialize_Entity (gnat_entity) @@ -775,12 +777,33 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) saved = 1; break; } + /* Otherwise, make this into a constant pointer to the object we + are to rename. + + Stabilize it if we are not at the global level since in this + case the renaming evaluation may directly dereference the + initial value we make here instead of the pointer we will + assign it to. We don't want variables in the expression to be + evaluated every time the renaming is used, since the value of + these variables may change in between. + + If we are at the global level and the value is not constant, + create_var_decl generates a mere elaboration assignment and + does not attach the initial expression to the declaration. + There is no possible direct initial-value dereference then. */ else { inner_const_flag = TREE_READONLY (gnu_expr); const_flag = 1; gnu_type = build_reference_type (gnu_type); gnu_expr = build_unary_op (ADDR_EXPR, gnu_type, gnu_expr); + + if (! global_bindings_p ()) + { + gnu_expr = gnat_stabilize_reference (gnu_expr, 1); + add_stmt (gnu_expr); + } + gnu_size = 0; used_by_ref = 1; } @@ -999,17 +1022,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) with the symbol we need to export in addition. Don't use the Interface_Name if there is an address clause (see CD30005). */ if (! Is_VMS_Exception (gnat_entity) - && - ((Present (Interface_Name (gnat_entity)) - && No (Address_Clause (gnat_entity))) - || - (Is_Public (gnat_entity) - && (! Is_Imported (gnat_entity) || Is_Exported (gnat_entity))))) + && ((Present (Interface_Name (gnat_entity)) + && No (Address_Clause (gnat_entity))) + || (Is_Public (gnat_entity) + && (! Is_Imported (gnat_entity) + || Is_Exported (gnat_entity))))) gnu_ext_name = create_concat_name (gnat_entity, 0); if (const_flag) - gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type) - | TYPE_QUAL_CONST)); + { + gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type) + | TYPE_QUAL_CONST)); + if (gnu_expr) + gnu_expr = convert (gnu_type, gnu_expr); + } /* If this is constant initialized to a static constant and the object has an aggregrate type, force it to be statically diff --git a/gcc/ada/misc.c b/gcc/ada/misc.c index 37e6f17..a22815c 100644 --- a/gcc/ada/misc.c +++ b/gcc/ada/misc.c @@ -94,6 +94,7 @@ static bool gnat_post_options (const char **); static HOST_WIDE_INT gnat_get_alias_set (tree); static void gnat_print_decl (FILE *, tree, int); static void gnat_print_type (FILE *, tree, int); +static int gnat_types_compatible_p (tree, tree); static const char *gnat_printable_name (tree, int); static tree gnat_eh_runtime_type (tree); static int gnat_eh_type_covers (tree, tree); @@ -102,6 +103,7 @@ static rtx gnat_expand_expr (tree, rtx, enum machine_mode, int, rtx *); static void internal_error_function (const char *, va_list *); static void gnat_adjust_rli (record_layout_info); +static tree gnat_type_max_size (tree); /* Definitions for our language-specific hooks. */ @@ -141,6 +143,10 @@ static void gnat_adjust_rli (record_layout_info); #define LANG_HOOKS_PRINT_DECL gnat_print_decl #undef LANG_HOOKS_PRINT_TYPE #define LANG_HOOKS_PRINT_TYPE gnat_print_type +#undef LANG_HOOKS_TYPES_COMPATIBLE_P +#define LANG_HOOKS_TYPES_COMPATIBLE_P gnat_types_compatible_p +#undef LANG_HOOKS_TYPE_MAX_SIZE +#define LANG_HOOKS_TYPE_MAX_SIZE gnat_type_max_size #undef LANG_HOOKS_DECL_PRINTABLE_NAME #define LANG_HOOKS_DECL_PRINTABLE_NAME gnat_printable_name #undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION @@ -555,6 +561,27 @@ gnat_print_type (FILE *file, tree node, int indent) } } +/* We consider two types compatible if they have the same main variant, + but we also consider two array types compatible if they have the same + component type and bounds. + + ??? We may also want to generalize to considering lots of integer types + compatible, but we need to understand the effects of alias sets first. */ + +static int +gnat_types_compatible_p (tree x, tree y) +{ + if (TREE_CODE (x) == ARRAY_TYPE && TREE_CODE (y) == ARRAY_TYPE + && gnat_types_compatible_p (TREE_TYPE (x), TREE_TYPE (y)) + && operand_equal_p (TYPE_MIN_VALUE (TYPE_DOMAIN (x)), + TYPE_MIN_VALUE (TYPE_DOMAIN (y)), 0) + && operand_equal_p (TYPE_MAX_VALUE (TYPE_DOMAIN (x)), + TYPE_MAX_VALUE (TYPE_DOMAIN (y)), 0)) + return 1; + else + return TYPE_MAIN_VARIANT (x) == TYPE_MAIN_VARIANT (y); +} + static const char * gnat_printable_name (tree decl, int verbosity) { @@ -691,6 +718,15 @@ gnat_get_alias_set (tree type) return -1; } +/* GNU_TYPE is a type. Return its maxium size in bytes, if known. */ + +static tree +gnat_type_max_size (gnu_type) + tree gnu_type; +{ + return max_size (TYPE_SIZE_UNIT (gnu_type), 1); +} + /* GNU_TYPE is a type. Determine if it should be passed by reference by default. */ @@ -709,7 +745,7 @@ default_pass_by_ref (tree gnu_type) if (targetm.calls.return_in_memory (gnu_type, NULL_TREE)) return true; - + if (AGGREGATE_TYPE_P (gnu_type) && (! host_integerp (TYPE_SIZE (gnu_type), 1) || 0 < compare_tree_int (TYPE_SIZE (gnu_type), diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index da75a35..6635c1df 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -170,6 +170,8 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name, Entity_Id standard_long_long_float, Entity_Id standard_exception_type, Int gigi_operating_mode) { + bool body_p; + Entity_Id gnat_unit_entity; tree gnu_standard_long_long_float; tree gnu_standard_exception_type; @@ -198,9 +200,6 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name, TYPE_SIZE_UNIT (void_type_node) = size_zero_node; } - if (Nkind (gnat_root) != N_Compilation_Unit) - gigi_abort (301); - /* Save the type we made for integer as the type for Standard.Integer. Then make the rest of the standard types. Note that some of these may be subtypes. */ @@ -228,7 +227,74 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name, if (Exception_Mechanism == GCC_ZCX) gnat_init_gcc_eh (); - gnat_to_gnu (gnat_root); + /* Make the decl for the elaboration procedure. */ + body_p = (Defining_Entity (Unit (gnat_root)), + Nkind (Unit (gnat_root)) == N_Package_Body + || Nkind (Unit (gnat_root)) == N_Subprogram_Body); + gnat_unit_entity = Defining_Entity (Unit (gnat_root)); + + gnu_elab_proc_decl + = create_subprog_decl + (create_concat_name (gnat_unit_entity, + body_p ? "elabb" : "elabs"), + NULL_TREE, void_ftype, NULL_TREE, 0, 1, 0, 0, gnat_unit_entity); + + 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; + + /* For a body, first process the spec if there is one. */ + if (Nkind (Unit (gnat_root)) == N_Package_Body + || (Nkind (Unit (gnat_root)) == N_Subprogram_Body + && ! Acts_As_Spec (gnat_root))) + add_stmt (gnat_to_gnu (Library_Unit (gnat_root))); + + process_inlined_subprograms (gnat_root); + + if (type_annotate_only) + { + elaborate_all_entities (gnat_root); + + if (Nkind (Unit (gnat_root)) == N_Subprogram_Declaration + || Nkind (Unit (gnat_root)) == N_Generic_Package_Declaration + || Nkind (Unit (gnat_root)) == N_Generic_Subprogram_Declaration) + return; + } + + process_decls (Declarations (Aux_Decls_Node (gnat_root)), Empty, Empty, + 1, 1); + add_stmt (gnat_to_gnu (Unit (gnat_root))); + + /* Process any pragmas and actions following the unit. */ + add_stmt_list (Pragmas_After (Aux_Decls_Node (gnat_root))); + add_stmt_list (Actions (Aux_Decls_Node (gnat_root))); + + /* Generate elaboration code for this unit, if necessary, and say whether + we did or not. */ + Set_Has_No_Elaboration_Code (gnat_root, build_unit_elab ()); +} + +/* Perform initializations for this module. */ + +void +gnat_init_stmt_group () +{ + /* Initialize ourselves. */ + init_code_table (); + start_stmt_group (); + + global_stmt_group = current_stmt_group; + + /* Enable GNAT stack checking method if needed */ + if (!Stack_Check_Probes_On_Target) + set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check")); + + if (Exception_Mechanism == Front_End_ZCX) + abort (); + + REAL_ARITHMETIC (dconstp5, RDIV_EXPR, dconst1, dconst2); + REAL_ARITHMETIC (dconstmp5, RDIV_EXPR, dconstm1, dconst2); } /* Perform initializations for this module. */ @@ -424,23 +490,38 @@ gnat_to_gnu (Node_Id gnat_node) if (TREE_CODE (gnu_result) == PARM_DECL && DECL_BY_COMPONENT_PTR_P (gnu_result)) - gnu_result = convert (build_pointer_type (gnu_result_type), - gnu_result); + gnu_result + = build_unary_op (INDIRECT_REF, NULL_TREE, + convert (build_pointer_type (gnu_result_type), + gnu_result)); /* If the object is constant, we try to do the dereference directly through the DECL_INITIAL. This is actually required in order to get correct aliasing information for renamed objects that are - components of non-aliased aggregates, because the type of - the renamed object and that of the aggregate don't alias. */ - if (TREE_READONLY (gnu_result) - && DECL_INITIAL (gnu_result) - /* Strip possible conversion to reference type. */ - && (initial = TREE_CODE (DECL_INITIAL (gnu_result)) == NOP_EXPR - ? TREE_OPERAND (DECL_INITIAL (gnu_result), 0) - : DECL_INITIAL (gnu_result), 1) - && TREE_CODE (initial) == ADDR_EXPR - && (TREE_CODE (TREE_OPERAND (initial, 0)) == ARRAY_REF - || TREE_CODE (TREE_OPERAND (initial, 0)) == COMPONENT_REF)) + components of non-aliased aggregates, because the type of the + renamed object and that of the aggregate don't alias. + + Note that we expect the initial value to have been stabilized. + If it contains e.g. a variable reference, we certainly don't want + to re-evaluate the variable each time the renaming is used. + + Stabilization is currently not performed at the global level but + create_var_decl avoids setting DECL_INITIAL if the value is not + constant then, and we get to the pointer dereference below. + + ??? Couldn't the aliasing issue show up again in this case ? + There is no obvious reason why not. */ + else if (TREE_READONLY (gnu_result) + && DECL_INITIAL (gnu_result) + /* Strip possible conversion to reference type. */ + && ((initial = TREE_CODE (DECL_INITIAL (gnu_result)) + == NOP_EXPR + ? TREE_OPERAND (DECL_INITIAL (gnu_result), 0) + : DECL_INITIAL (gnu_result), 1)) + && TREE_CODE (initial) == ADDR_EXPR + && (TREE_CODE (TREE_OPERAND (initial, 0)) == ARRAY_REF + || (TREE_CODE (TREE_OPERAND (initial, 0)) + == COMPONENT_REF))) gnu_result = TREE_OPERAND (initial, 0); else gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, @@ -629,16 +710,22 @@ gnat_to_gnu (Node_Id gnat_node) int length = String_Length (gnat_string); int i; tree gnu_list = NULL_TREE; + tree gnu_idx = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type)); for (i = 0; i < length; i++) - gnu_list - = tree_cons (NULL_TREE, - convert (TREE_TYPE (gnu_result_type), - build_int_2 (Get_String_Char (gnat_string, - i + 1), - 0)), + { + gnu_list + = tree_cons (gnu_idx, + convert (TREE_TYPE (gnu_result_type), + build_int_2 + (Get_String_Char (gnat_string, i + 1), + 0)), gnu_list); + gnu_idx = int_const_binop (PLUS_EXPR, gnu_idx, integer_one_node, + 0); + } + gnu_result = gnat_build_constructor (gnu_result_type, nreverse (gnu_list)); } @@ -2149,7 +2236,7 @@ gnat_to_gnu (Node_Id gnat_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))); @@ -2785,6 +2872,16 @@ gnat_to_gnu (Node_Id gnat_node) gnu_actual = convert (get_unpadded_type (Etype (gnat_actual)), gnu_actual); + /* Unless this is an In parameter, we must remove any LJM building + from GNU_NAME. */ + if (Ekind (gnat_formal) != E_In_Parameter + && TREE_CODE (gnu_name) == CONSTRUCTOR + && TREE_CODE (TREE_TYPE (gnu_name)) == RECORD_TYPE + && TYPE_LEFT_JUSTIFIED_MODULAR_P (TREE_TYPE (gnu_name))) + gnu_name + = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_name))), + gnu_name); + if (Ekind (gnat_formal) != E_Out_Parameter && ! unchecked_convert_p && Do_Range_Check (gnat_actual)) @@ -3149,29 +3246,9 @@ gnat_to_gnu (Node_Id gnat_node) case N_Compilation_Unit: - /* If this is the main unit, make the decl for the elaboration - procedure. Otherwise, push a statement group for this nested - compilation unit. */ - if (gnat_node == Cunit (Main_Unit)) - { - 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)); - - gnu_elab_proc_decl - = create_subprog_decl - (create_concat_name (gnat_unit_entity, - body_p ? "elabb" : "elabs"), - NULL_TREE, void_ftype, NULL_TREE, 0, 1, 0, 0, gnat_unit_entity); - - 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; - } - else - start_stmt_group (); + /* This is not called for the main unit, which is handled in function + gigi above. */ + start_stmt_group (); /* For a body, first process the spec if there is one. */ if (Nkind (Unit (gnat_node)) == N_Package_Body @@ -3180,20 +3257,6 @@ gnat_to_gnu (Node_Id gnat_node) add_stmt (gnat_to_gnu (Library_Unit (gnat_node))); process_inlined_subprograms (gnat_node); - - if (type_annotate_only && gnat_node == Cunit (Main_Unit)) - { - elaborate_all_entities (gnat_node); - - if (Nkind (Unit (gnat_node)) == N_Subprogram_Declaration - || Nkind (Unit (gnat_node)) == N_Generic_Package_Declaration - || Nkind (Unit (gnat_node)) == N_Generic_Subprogram_Declaration) - { - gnu_result = alloc_stmt_list (); - break; - } - } - process_decls (Declarations (Aux_Decls_Node (gnat_node)), Empty, Empty, 1, 1); add_stmt (gnat_to_gnu (Unit (gnat_node))); @@ -3201,20 +3264,9 @@ gnat_to_gnu (Node_Id gnat_node) /* Process any pragmas and actions following the unit. */ add_stmt_list (Pragmas_After (Aux_Decls_Node (gnat_node))); add_stmt_list (Actions (Aux_Decls_Node (gnat_node))); - - /* If this is the main unit, generate elaboration code for this - unit, if necessary, and say whether we did or not. Otherwise, - there is no elaboration code and we end our statement group. */ - if (gnat_node == Cunit (Main_Unit)) - { - Set_Has_No_Elaboration_Code (gnat_node, build_unit_elab ()); - gnu_result = alloc_stmt_list (); - } - else - { - Set_Has_No_Elaboration_Code (gnat_node, 1); - gnu_result = end_stmt_group (); - } + + Set_Has_No_Elaboration_Code (gnat_node, 1); + gnu_result = end_stmt_group (); break; case N_Subprogram_Body_Stub: @@ -3317,7 +3369,7 @@ gnat_to_gnu (Node_Id gnat_node) (set_jmpbuf_decl, build_unary_op (ADDR_EXPR, NULL_TREE, gnu_jmpbuf_decl))); - + if (Present (First_Real_Statement (gnat_node))) process_decls (Statements (gnat_node), Empty, First_Real_Statement (gnat_node), 1, 1); @@ -3358,7 +3410,7 @@ gnat_to_gnu (Node_Id gnat_node) gnat_temp = Next_Non_Pragma (gnat_temp)) { gnu_expr = gnat_to_gnu (gnat_temp); - + /* If this is the first one, set it as the outer one. Otherwise, point the "else" part of the previous handler to us. Then point to our "else" part. */ @@ -3791,7 +3843,7 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result = build_call_alloc_dealloc (gnu_ptr, gnu_obj_size, align, Procedure_To_Call (gnat_node), - Storage_Pool (gnat_node), + Storage_Pool (gnat_node), gnat_node); } break; @@ -4047,9 +4099,25 @@ add_stmt (tree gnu_stmt) append_to_statement_list (gnu_stmt, ¤t_stmt_group->stmt_list); /* If we're at top level, show everything in here is in use in case - any of it is shared by a subprogram. */ + any of it is shared by a subprogram. + + ??? If this is a DECL_EXPR for a VAR_DECL or CONST_DECL, we must + walk the sizes and DECL_INITIAL since we won't be walking the + BIND_EXPR here. This whole thing is a mess! */ if (!current_function_decl) - walk_tree (&gnu_stmt, mark_visited, NULL, NULL); + { + walk_tree (&gnu_stmt, mark_visited, NULL, NULL); + if (TREE_CODE (gnu_stmt) == DECL_EXPR + && (TREE_CODE (DECL_EXPR_DECL (gnu_stmt)) == VAR_DECL + || TREE_CODE (DECL_EXPR_DECL (gnu_stmt)) == CONST_DECL)) + { + tree gnu_decl = DECL_EXPR_DECL (gnu_stmt); + + walk_tree (&DECL_SIZE (gnu_decl), mark_visited, NULL, NULL); + walk_tree (&DECL_SIZE_UNIT (gnu_decl), mark_visited, NULL, NULL); + walk_tree (&DECL_INITIAL (gnu_decl), mark_visited, NULL, NULL); + } + } } /* Similar, but set the location of GNU_STMT to that of GNAT_NODE. */ @@ -4116,7 +4184,7 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity) tree gnu_assign_stmt = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, DECL_INITIAL (gnu_decl)); - + DECL_INITIAL (gnu_decl) = 0; annotate_with_locus (gnu_assign_stmt, DECL_SOURCE_LOCATION (gnu_decl)); @@ -4134,7 +4202,10 @@ mark_visited (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED) { if (TREE_VISITED (*tp)) *walk_subtrees = 0; - else + + /* Don't mark a dummy type as visited because we want to mark its sizes + and fields once it's filled in. */ + else if (!TYPE_IS_DUMMY_P (*tp)) TREE_VISITED (*tp) = 1; return NULL_TREE; @@ -4421,7 +4492,7 @@ gnat_expand_body_1 (tree gnu_decl, bool nested_p) { if (nested_p) push_function_context (); - + tree_rest_of_compilation (gnu_decl, nested_p); if (nested_p) @@ -5304,9 +5375,7 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type, = tree_cons (gnu_index, convert (TREE_TYPE (gnu_array_type), gnu_expr), gnu_expr_list); - gnu_index = fold (build2 (PLUS_EXPR, TREE_TYPE (gnu_index), gnu_index, - convert (TREE_TYPE (gnu_index), - integer_one_node))); + gnu_index = int_const_binop (PLUS_EXPR, gnu_index, integer_one_node, 0); } return gnat_build_constructor (gnu_array_type, nreverse (gnu_expr_list)); @@ -5500,6 +5569,19 @@ gnat_stabilize_reference (tree ref, int force) } TREE_READONLY (result) = TREE_READONLY (ref); + + /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS attached to the initial + expression may not be sustained across some paths, such as the way via + build1 for INDIRECT_REF. We re-populate those flags here for the general + case, which is consistent with the GCC version of this routine. + + Special care should be taken regarding TREE_SIDE_EFFECTS, because some + paths introduce side effects where there was none initially (e.g. calls + to save_expr), and we also want to keep track of that. */ + + TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref); + TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (ref); + return result; } @@ -5569,6 +5651,9 @@ gnat_stabilize_reference_1 (tree e, int force) } TREE_READONLY (result) = TREE_READONLY (e); + + TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e); + TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e); return result; } diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index 772fdd4..dc8a5b1 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -230,6 +230,7 @@ gnat_pushlevel () BLOCK_SUPERCONTEXT (newlevel->block) = current_binding_level->block; BLOCK_VARS (newlevel->block) = BLOCK_SUBBLOCKS (newlevel->block) = NULL_TREE; + TREE_USED (newlevel->block) = 1; /* Add this level to the front of the chain (stack) of levels that are active. */ @@ -362,7 +363,7 @@ gnat_pushdecl (tree decl, Node_Id gnat_node) && DECL_ARTIFICIAL (TYPE_NAME (TREE_TYPE (decl))) && ! DECL_ARTIFICIAL (decl)))) TYPE_NAME (TREE_TYPE (decl)) = decl; - + if (TREE_CODE (decl) != CONST_DECL) rest_of_decl_compilation (decl, NULL, global_bindings_p (), 0); } @@ -404,9 +405,6 @@ gnat_init_decl_processing (void) gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("long integer"), long_integer_type_node), Empty); - gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("void"), - void_type_node), - Empty); ptr_void_type_node = build_pointer_type (void_type_node); @@ -464,6 +462,13 @@ gnat_install_builtins () gnat_define_builtin ("__builtin_memcmp", ftype, BUILT_IN_MEMCMP, "memcmp", false); + tmp = tree_cons (NULL_TREE, size_type_node, void_list_node); + tmp = tree_cons (NULL_TREE, integer_type_node, tmp); + tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp); + ftype = build_function_type (integer_type_node, tmp); + gnat_define_builtin ("__builtin_memset", ftype, BUILT_IN_MEMSET, + "memset", false); + tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node); ftype = build_function_type (integer_type_node, tmp); gnat_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ, "clz", true); @@ -2827,10 +2832,8 @@ convert (tree type, tree expr) return expr; case STRING_CST: - case CONSTRUCTOR: /* If we are converting a STRING_CST to another constrained array type, - just make a new one in the proper type. Likewise for - CONSTRUCTOR if the alias sets are the same. */ + just make a new one in the proper type. */ if (code == ecode && AGGREGATE_TYPE_P (etype) && ! (TREE_CODE (TYPE_SIZE (etype)) == INTEGER_CST && TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST) @@ -2843,21 +2846,6 @@ convert (tree type, tree expr) } break; - case COMPONENT_REF: - /* If we are converting between two aggregate types of the same - kind, size, mode, and alignment, just make a new COMPONENT_REF. - This avoid unneeded conversions which makes reference computations - more complex. */ - if (code == ecode && TYPE_MODE (type) == TYPE_MODE (etype) - && AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype) - && TYPE_ALIGN (type) == TYPE_ALIGN (etype) - && 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), NULL_TREE); - - break; - case UNCONSTRAINED_ARRAY_REF: /* Convert this to the type of the inner array by getting the address of the array from the template. */ |