From 4189e6771feda58eeb5859eb78adaeb1ce9729e1 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Tue, 30 Jun 2009 17:26:32 +0000 Subject: * cgraphunit.c (cgraph_finalize_compilation_unit): Call finalize_size_functions before further processing. * stor-layout.c: Include cgraph.h, tree-inline.h and tree-dump.h. (variable_size): Call self_referential_size on size expressions that contain a PLACEHOLDER_EXPR. (size_functions): New static variable. (copy_self_referential_tree_r): New static function. (self_referential_size): Likewise. (finalize_size_functions): New global function. * tree.c: Include tree-inline.h. (push_without_duplicates): New static function. (find_placeholder_in_expr): New global function. (substitute_in_expr) : Return the replacement object on equality. : Likewise. : If the replacement object is a constant, try to inline the call in the expression. * tree.h (finalize_size_functions): Declare. (find_placeholder_in_expr): Likewise. (FIND_PLACEHOLDER_IN_EXPR): New macro. (substitute_placeholder_in_expr): Update comment. * tree-inline.c (remap_decl): Do not unshare trees if do_not_unshare is true. (copy_tree_body_r): Likewise. (copy_tree_body): New static function. (maybe_inline_call_in_expr): New global function. * tree-inline.h (struct copy_body_data): Add do_not_unshare field. (maybe_inline_call_in_expr): Declare. * Makefile.in (tree.o): Depend on TREE_INLINE_H. (stor-layout.o): Depend on CGRAPH_H, TREE_INLINE_H, TREE_DUMP_H and GIMPLE_H. ada/ * gcc-interface/decl.c: Include tree-inline.h. (annotate_value) : Try to inline the call in the expression. * gcc-interface/utils.c (max_size) : Likewise. * gcc-interface/utils2.c: Include tree-inline. (known_alignment) : Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149112 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 48acbfbe3c1..f380213c874 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -33,6 +33,7 @@ #include "ggc.h" #include "target.h" #include "expr.h" +#include "tree-inline.h" #include "ada.h" #include "types.h" @@ -7190,6 +7191,15 @@ annotate_value (tree gnu_size) case EQ_EXPR: tcode = Eq_Expr; break; case NE_EXPR: tcode = Ne_Expr; break; + case CALL_EXPR: + { + tree t = maybe_inline_call_in_expr (gnu_size); + if (t) + return annotate_value (t); + } + + /* Fall through... */ + default: return No_Uint; } -- cgit v1.2.1 From 9af94d3d553280107be0b8d08747c48ed35625f5 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sat, 4 Jul 2009 10:51:31 +0000 Subject: * ada-tree.h (SET_TYPE_LANG_SPECIFIC): Rewrite. (SET_DECL_LANG_SPECIFIC): Likewise. (TYPE_RM_VALUE): New macro. (SET_TYPE_RM_VALUE): Likewise. (TYPE_RM_SIZE): Rewrite in terms of TYPE_RM_VALUE. (TYPE_RM_MIN_VALUE): Likewise. (TYPE_RM_MAX_VALUE): Likewise. (SET_TYPE_RM_SIZE): Rewrite in terms of SET_TYPE_RM_VALUE. (SET_TYPE_RM_MIN_VALUE): Likewise. (SET_TYPE_RM_MAX_VALUE): Likewise. * decl.c (gnat_to_gnu_entity) : Remove kludge. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149225 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 6 ------ 1 file changed, 6 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index f380213c874..42086128cd7 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -2629,12 +2629,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) #endif } - /* ??? This is necessary to make sure that the container is - allocated with a null tree upfront; otherwise, it could - be allocated with an uninitialized tree that is accessed - before being set below. See ada-tree.h for details. */ - SET_TYPE_ACTUAL_BOUNDS (gnu_inner_type, NULL_TREE); - for (gnat_index = First_Index (gnat_entity); Present (gnat_index); gnat_index = Next_Index (gnat_index)) SET_TYPE_ACTUAL_BOUNDS -- cgit v1.2.1 From d6da74485431adc364c4bdeae355f7bc24e6e480 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sat, 11 Jul 2009 20:52:28 +0000 Subject: * checks.adb (Apply_Address_Clause_Check): Remove Size_Warning_Output local variable and do not test it in Compile_Time_Bad_Alignment. Do not issue size or alignment warnings for the X'Address form. * sem_util.ads (Find_Overlaid_Object): Delete. (Find_Overlaid_Entity): New procedure. * sem_util.adb (Find_Overlaid_Object): Rename to... (Find_Overlaid_Entity): ...this and turn into a procedure. Report whether the address is offseted within the overlaid entity. (Has_Compatible_Alignment): Track the offset globally instead of passing it to Check_Offset. For an indexed component, compute the full offset when possible. If the resulting offset is zero, only check the prefix. (Check_Offset): Delete. * sem_ch13.adb (Address_Clause_Check_Record): Add Off field. (Address_Aliased_Entity): Delete. (Analyze_Attribute_Definition_Clause) : Call Find_Overlaid_Entity to find the overlaid entity and the offset. Adjust throughout for above change. (Validate_Address_Clauses): Always use attributes of entities, not of their type. Tweak message for warning. Call Has_Compatible_Alignment if the address is offseted to warn about incompatible alignments. * gcc-interface/gigi.h (annotate_object): Declare. * gcc-interface/decl.c (gnat_to_gnu_entity) : Annotate renaming entity. Call annotate_object instead of annotating manually objects. (annotate_object): New function. * gcc-interface/trans.c (Subprogram_Body_to_gnu): Annotate parameters at the end. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149520 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 70 ++++++++++++++++++++++++++++---------------- 1 file changed, 44 insertions(+), 26 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 42086128cd7..67d8cd1b0c4 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -905,6 +905,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) mark_visited (&gnu_decl); save_gnu_tree (gnat_entity, gnu_decl, true); saved = true; + annotate_object (gnat_entity, gnu_type, NULL_TREE, + false); break; } @@ -1382,32 +1384,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && Exception_Mechanism != Back_End_Exceptions) TREE_ADDRESSABLE (gnu_decl) = 1; - gnu_type = TREE_TYPE (gnu_decl); - - /* Back-annotate Alignment and Esize of the object if not already - known, except for when the object is actually a pointer to the - real object, since alignment and size of a pointer don't have - anything to do with those of the designated object. Note that - we pick the values of the type, not those of the object, to - shield ourselves from low-level platform-dependent adjustments - like alignment promotion. This is both consistent with all the - treatment above, where alignment and size are set on the type of - the object and not on the object directly, and makes it possible - to support confirming representation clauses in all cases. */ - - if (!used_by_ref && Unknown_Alignment (gnat_entity)) - Set_Alignment (gnat_entity, - UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT)); - - if (!used_by_ref && Unknown_Esize (gnat_entity)) - { - if (TREE_CODE (gnu_type) == RECORD_TYPE - && TYPE_CONTAINS_TEMPLATE_P (gnu_type)) - gnu_object_size - = TYPE_SIZE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)))); - - Set_Esize (gnat_entity, annotate_value (gnu_object_size)); - } + /* Back-annotate Esize and Alignment of the object if not already + known. Note that we pick the values of the type, not those of + the object, to shield ourselves from low-level platform-dependent + adjustments like alignment promotion. This is both consistent with + all the treatment above, where alignment and size are set on the + type of the object and not on the object directly, and makes it + possible to support all confirming representation clauses. */ + annotate_object (gnat_entity, TREE_TYPE (gnu_decl), gnu_object_size, + used_by_ref); } break; @@ -7223,6 +7208,39 @@ annotate_value (tree gnu_size) return ret; } +/* Given GNAT_ENTITY, an object (constant, variable, parameter, exception) + and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the + size and alignment used by Gigi. Prefer SIZE over TYPE_SIZE if non-null. + BY_REF is true if the object is used by reference. */ + +void +annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref) +{ + if (by_ref) + { + if (TYPE_FAT_POINTER_P (gnu_type)) + gnu_type = TYPE_UNCONSTRAINED_ARRAY (gnu_type); + else + gnu_type = TREE_TYPE (gnu_type); + } + + if (Unknown_Esize (gnat_entity)) + { + if (TREE_CODE (gnu_type) == RECORD_TYPE + && TYPE_CONTAINS_TEMPLATE_P (gnu_type)) + size = TYPE_SIZE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)))); + else if (!size) + size = TYPE_SIZE (gnu_type); + + if (size) + Set_Esize (gnat_entity, annotate_value (size)); + } + + if (Unknown_Alignment (gnat_entity)) + Set_Alignment (gnat_entity, + UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT)); +} + /* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding GCC type, set Component_Bit_Offset and Esize to the position and size used by Gigi. */ -- cgit v1.2.1 From 39413c59069dd2300ce76b101877dcdca9c98fac Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 23 Jul 2009 10:21:03 +0000 Subject: * gcc-interface/decl.c (validate_alignment): For the case of an implicit array base type, look for alignment clause on first subtype. Code clean up. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149994 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 67d8cd1b0c4..7d96c9a3c6d 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -6512,17 +6512,21 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, if (Present (Component_Clause (gnat_field))) { + Entity_Id gnat_parent + = Parent_Subtype (Underlying_Type (Scope (gnat_field))); + gnu_pos = UI_To_gnu (Component_Bit_Offset (gnat_field), bitsizetype); gnu_size = validate_size (Esize (gnat_field), gnu_field_type, gnat_field, FIELD_DECL, false, true); - /* Ensure the position does not overlap with the parent subtype, - if there is one. */ - if (Present (Parent_Subtype (Underlying_Type (Scope (gnat_field))))) + /* Ensure the position does not overlap with the parent subtype, if there + is one. This test is omitted if the parent of the tagged type has a + full rep clause since, in this case, component clauses are allowed to + overlay the space allocated for the parent type and the front-end has + checked that there are no overlapping components. */ + if (Present (gnat_parent) && !Is_Fully_Repped_Tagged_Type (gnat_parent)) { - tree gnu_parent - = gnat_to_gnu_type (Parent_Subtype - (Underlying_Type (Scope (gnat_field)))); + tree gnu_parent = gnat_to_gnu_type (gnat_parent); if (TREE_CODE (TYPE_SIZE (gnu_parent)) == INTEGER_CST && tree_int_cst_lt (gnu_pos, TYPE_SIZE (gnu_parent))) @@ -7674,9 +7678,19 @@ validate_alignment (Uint alignment, Entity_Id gnat_entity, unsigned int align) if (Error_Posted (gnat_entity) && !Has_Alignment_Clause (gnat_entity)) return align; - /* Post the error on the alignment clause if any. */ + /* Post the error on the alignment clause if any. Note, for the implicit + base type of an array type, the alignment clause is on the first + subtype. */ if (Present (Alignment_Clause (gnat_entity))) gnat_error_node = Expression (Alignment_Clause (gnat_entity)); + + else if (Is_Itype (gnat_entity) + && Is_Array_Type (gnat_entity) + && Etype (gnat_entity) == gnat_entity + && Present (Alignment_Clause (First_Subtype (gnat_entity)))) + gnat_error_node = + Expression (Alignment_Clause (First_Subtype (gnat_entity))); + else gnat_error_node = gnat_entity; -- cgit v1.2.1 From 7acc347ee5888d93283457ced4a914766b7ab0ab Mon Sep 17 00:00:00 2001 From: hainque Date: Wed, 2 Sep 2009 12:13:37 +0000 Subject: ada/ * gcc-interface/decl.c (cannot_be_superflat_p): Handle Signed_Integer_Type_Definition Scalar_Ranges. testsuite/ * gnat.dg/array7.ad[bs]: Add check for Signed_Integer_Type_Definition. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151322 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 7d96c9a3c6d..9d385302c6b 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -5298,21 +5298,27 @@ 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. */ while (Nkind (gnat_lb) != N_Integer_Literal && (Ekind (Etype (gnat_lb)) == E_Signed_Integer_Subtype || Ekind (Etype (gnat_lb)) == E_Modular_Integer_Subtype) - && Nkind (Scalar_Range (Etype (gnat_lb))) == N_Range) - gnat_lb = High_Bound (Scalar_Range (Etype (gnat_lb))); + && (scalar_range = Scalar_Range (Etype (gnat_lb))) + && (Nkind (scalar_range) == N_Signed_Integer_Type_Definition + || Nkind (scalar_range) == N_Range)) + gnat_lb = High_Bound (scalar_range); /* If the high bound is not constant, try to find a lower bound. */ while (Nkind (gnat_hb) != N_Integer_Literal && (Ekind (Etype (gnat_hb)) == E_Signed_Integer_Subtype || Ekind (Etype (gnat_hb)) == E_Modular_Integer_Subtype) - && Nkind (Scalar_Range (Etype (gnat_hb))) == N_Range) - gnat_hb = Low_Bound (Scalar_Range (Etype (gnat_hb))); + && (scalar_range = Scalar_Range (Etype (gnat_hb))) + && (Nkind (scalar_range) == N_Signed_Integer_Type_Definition + || Nkind (scalar_range) == N_Range)) + gnat_hb = Low_Bound (scalar_range); if (!(Nkind (gnat_lb) == N_Integer_Literal && Nkind (gnat_hb) == N_Integer_Literal)) -- cgit v1.2.1 From 59cd8bed5ffef9abfba3242128c1752f62b35fb4 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Tue, 8 Sep 2009 19:40:00 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity) : Tidy flow of control. Avoid useless work when processing the Treat_As_Volatile flag. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151535 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 189 +++++++++++++++++++++---------------------- 1 file changed, 94 insertions(+), 95 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 9d385302c6b..255821e49c8 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -2093,7 +2093,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* This is the actual data type for array variables. Multidimensional arrays are implemented as arrays of arrays. Note that arrays which - have sparse enumeration subtypes as index components create sparse + have sparse enumeration subtypes as index components create sparse arrays, which is obviously space inefficient but so much easier to code for now. @@ -2105,7 +2105,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = gnat_to_gnu_type (Etype (gnat_entity)); if (!Is_Constrained (gnat_entity)) - break; + ; else { Entity_Id gnat_index, gnat_base_index; @@ -2538,105 +2538,104 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Set our alias set to that of our base type. This gives all array subtypes the same alias set. */ relate_alias_sets (gnu_type, gnu_base_type, ALIAS_SET_COPY); - } - - /* If this is a packed type, make this type the same as the packed - array type, but do some adjusting in the type first. */ - if (Present (Packed_Array_Type (gnat_entity))) - { - Entity_Id gnat_index; - tree gnu_inner_type; - /* First finish the type we had been making so that we output - debugging information for it. */ - gnu_type - = build_qualified_type (gnu_type, - (TYPE_QUALS (gnu_type) - | (TYPE_QUAL_VOLATILE - * Treat_As_Volatile (gnat_entity)))); - - /* Make it artificial only if the base type was artificial as well. - That's sort of "morally" true and will make it possible for the - debugger to look it up by name in DWARF, which is necessary in - order to decode the packed array type. */ - gnu_decl - = create_type_decl (gnu_entity_name, gnu_type, attr_list, - !Comes_From_Source (gnat_entity) - && !Comes_From_Source (Etype (gnat_entity)), - debug_info_p, gnat_entity); - - /* Save it as our equivalent in case the call below elaborates - this type again. */ - save_gnu_tree (gnat_entity, gnu_decl, false); - - gnu_decl = gnat_to_gnu_entity (Packed_Array_Type (gnat_entity), - NULL_TREE, 0); - this_made_decl = true; - gnu_type = TREE_TYPE (gnu_decl); - save_gnu_tree (gnat_entity, NULL_TREE, false); - - gnu_inner_type = gnu_type; - while (TREE_CODE (gnu_inner_type) == RECORD_TYPE - && (TYPE_JUSTIFIED_MODULAR_P (gnu_inner_type) - || TYPE_IS_PADDING_P (gnu_inner_type))) - gnu_inner_type = TREE_TYPE (TYPE_FIELDS (gnu_inner_type)); - - /* We need to attach the index type to the type we just made so - that the actual bounds can later be put into a template. */ - if ((TREE_CODE (gnu_inner_type) == ARRAY_TYPE - && !TYPE_ACTUAL_BOUNDS (gnu_inner_type)) - || (TREE_CODE (gnu_inner_type) == INTEGER_TYPE - && !TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner_type))) + /* If this is a packed type, make this type the same as the packed + array type, but do some adjusting in the type first. */ + if (Present (Packed_Array_Type (gnat_entity))) { - if (TREE_CODE (gnu_inner_type) == INTEGER_TYPE) + Entity_Id gnat_index; + tree gnu_inner; + + /* First finish the type we had been making so that we output + debugging information for it. */ + if (Treat_As_Volatile (gnat_entity)) + gnu_type + = build_qualified_type (gnu_type, + TYPE_QUALS (gnu_type) + | TYPE_QUAL_VOLATILE); + + /* Make it artificial only if the base type was artificial too. + That's sort of "morally" true and will make it possible for + the debugger to look it up by name in DWARF, which is needed + in order to decode the packed array type. */ + gnu_decl + = create_type_decl (gnu_entity_name, gnu_type, attr_list, + !Comes_From_Source (Etype (gnat_entity)) + && !Comes_From_Source (gnat_entity), + debug_info_p, gnat_entity); + + /* Save it as our equivalent in case the call below elaborates + this type again. */ + save_gnu_tree (gnat_entity, gnu_decl, false); + + gnu_decl = gnat_to_gnu_entity (Packed_Array_Type (gnat_entity), + NULL_TREE, 0); + this_made_decl = true; + gnu_type = TREE_TYPE (gnu_decl); + save_gnu_tree (gnat_entity, NULL_TREE, false); + + gnu_inner = gnu_type; + while (TREE_CODE (gnu_inner) == RECORD_TYPE + && (TYPE_JUSTIFIED_MODULAR_P (gnu_inner) + || TYPE_IS_PADDING_P (gnu_inner))) + gnu_inner = TREE_TYPE (TYPE_FIELDS (gnu_inner)); + + /* We need to attach the index type to the type we just made so + that the actual bounds can later be put into a template. */ + if ((TREE_CODE (gnu_inner) == ARRAY_TYPE + && !TYPE_ACTUAL_BOUNDS (gnu_inner)) + || (TREE_CODE (gnu_inner) == INTEGER_TYPE + && !TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner))) { - /* The TYPE_ACTUAL_BOUNDS field is overloaded with the - TYPE_MODULUS for modular types so we make an extra - subtype if necessary. */ - if (TYPE_MODULAR_P (gnu_inner_type)) + if (TREE_CODE (gnu_inner) == INTEGER_TYPE) { - tree gnu_subtype - = make_unsigned_type (TYPE_PRECISION (gnu_inner_type)); - TREE_TYPE (gnu_subtype) = gnu_inner_type; - TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1; - SET_TYPE_RM_MIN_VALUE (gnu_subtype, - TYPE_MIN_VALUE (gnu_inner_type)); - SET_TYPE_RM_MAX_VALUE (gnu_subtype, - TYPE_MAX_VALUE (gnu_inner_type)); - gnu_inner_type = gnu_subtype; - } - - TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner_type) = 1; + /* The TYPE_ACTUAL_BOUNDS field is overloaded with the + TYPE_MODULUS for modular types so we make an extra + subtype if necessary. */ + if (TYPE_MODULAR_P (gnu_inner)) + { + tree gnu_subtype + = make_unsigned_type (TYPE_PRECISION (gnu_inner)); + TREE_TYPE (gnu_subtype) = gnu_inner; + TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1; + SET_TYPE_RM_MIN_VALUE (gnu_subtype, + TYPE_MIN_VALUE (gnu_inner)); + SET_TYPE_RM_MAX_VALUE (gnu_subtype, + TYPE_MAX_VALUE (gnu_inner)); + gnu_inner = gnu_subtype; + } + + TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner) = 1; #ifdef ENABLE_CHECKING - /* Check for other cases of overloading. */ - gcc_assert (!TYPE_ACTUAL_BOUNDS (gnu_inner_type)); + /* Check for other cases of overloading. */ + gcc_assert (!TYPE_ACTUAL_BOUNDS (gnu_inner)); #endif - } + } - for (gnat_index = First_Index (gnat_entity); - Present (gnat_index); gnat_index = Next_Index (gnat_index)) - SET_TYPE_ACTUAL_BOUNDS - (gnu_inner_type, - tree_cons (NULL_TREE, - get_unpadded_type (Etype (gnat_index)), - TYPE_ACTUAL_BOUNDS (gnu_inner_type))); - - if (Convention (gnat_entity) != Convention_Fortran) - SET_TYPE_ACTUAL_BOUNDS - (gnu_inner_type, - nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner_type))); - - if (TREE_CODE (gnu_type) == RECORD_TYPE - && TYPE_JUSTIFIED_MODULAR_P (gnu_type)) - TREE_TYPE (TYPE_FIELDS (gnu_type)) = gnu_inner_type; + for (gnat_index = First_Index (gnat_entity); + Present (gnat_index); + gnat_index = Next_Index (gnat_index)) + SET_TYPE_ACTUAL_BOUNDS + (gnu_inner, + tree_cons (NULL_TREE, + get_unpadded_type (Etype (gnat_index)), + TYPE_ACTUAL_BOUNDS (gnu_inner))); + + if (Convention (gnat_entity) != Convention_Fortran) + SET_TYPE_ACTUAL_BOUNDS + (gnu_inner, nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner))); + + if (TREE_CODE (gnu_type) == RECORD_TYPE + && TYPE_JUSTIFIED_MODULAR_P (gnu_type)) + TREE_TYPE (TYPE_FIELDS (gnu_type)) = gnu_inner; + } } - } - - /* Abort if packed array with no packed array type field set. */ - else - gcc_assert (!Is_Packed (gnat_entity)); + else + /* Abort if packed array with no Packed_Array_Type field set. */ + gcc_assert (!Is_Packed (gnat_entity)); + } break; case E_String_Literal_Subtype: @@ -4634,10 +4633,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } } - gnu_type = build_qualified_type (gnu_type, - (TYPE_QUALS (gnu_type) - | (TYPE_QUAL_VOLATILE - * Treat_As_Volatile (gnat_entity)))); + if (Treat_As_Volatile (gnat_entity)) + gnu_type + = build_qualified_type (gnu_type, + TYPE_QUALS (gnu_type) | TYPE_QUAL_VOLATILE); if (Is_Atomic (gnat_entity)) check_ok_for_atomic (gnu_type, gnat_entity, false); -- cgit v1.2.1 From cf07a5908aeeb95b9662cb7b523d30a61cc15cce Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Mon, 14 Sep 2009 19:27:21 +0000 Subject: * exp_dbug.ads (Packed Array Encoding): Document the new encoding for the unconstrained case. * gcc-interfaces/decl.c (gnat_to_gnu_entity) : Implement the encoding. Do not give a name to the pointer type to the XUT type. * gcc-interfaces/utils.c (gnat_pushdecl): Propagate DECL_ORIGINAL_TYPE for fat pointer types, if any. Make sure DECL_ARTIFICIAL is cleared on nodes with DECL_ORIGINAL_TYPE set. (update_pointer_to): Set DECL_ORIGINAL_TYPE to the original pointer for fat pointer types. Make sure DECL_ARTIFICIAL is cleared. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151697 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 255821e49c8..ed393388c5c 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1782,7 +1782,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) case E_String_Type: case E_Array_Type: { - Entity_Id gnat_index; + Entity_Id gnat_index, gnat_name; const bool convention_fortran_p = (Convention (gnat_entity) == Convention_Fortran); const int ndim = Number_Dimensions (gnat_entity); @@ -2066,8 +2066,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tem, NULL, !Comes_From_Source (gnat_entity), debug_info_p, gnat_entity); - /* Give the fat pointer type a name. */ - create_type_decl (create_concat_name (gnat_entity, "XUP"), + /* Give the fat pointer type a name. If this is a packed type, tell + the debugger how to interpret the underlying bits. */ + if (Present (Packed_Array_Type (gnat_entity))) + gnat_name = Packed_Array_Type (gnat_entity); + else + gnat_name = gnat_entity; + create_type_decl (create_concat_name (gnat_name, "XUP"), gnu_fat_type, NULL, true, debug_info_p, gnat_entity); @@ -2075,16 +2080,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) record type for the object and its template with the field offsets shifted to have the template at a negative offset. */ tem = build_unc_object_type (gnu_template_type, tem, - create_concat_name (gnat_entity, "XUT")); + create_concat_name (gnat_name, "XUT")); shift_unc_components_for_thin_pointers (tem); SET_TYPE_UNCONSTRAINED_ARRAY (tem, gnu_type); TYPE_OBJECT_RECORD_TYPE (gnu_type) = tem; - - /* Give the thin pointer type a name. */ - create_type_decl (create_concat_name (gnat_entity, "XUX"), - build_pointer_type (tem), NULL, true, - debug_info_p, gnat_entity); } break; -- cgit v1.2.1 From f23a70cc7dea39d4237d020148866ef554bf69a6 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Wed, 16 Sep 2009 14:05:47 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_field): Add DEBUG_INFO_P parameter. If a padding type was made for the field, declare it. (components_to_record): Add DEBUG_INFO_P parameter. Adjust call to gnat_to_gnu_field and call to self. (gnat_to_gnu_entity) : Do not redeclare padding types. : Likewise. Adjust calls to gnat_to_gnu_field and components_to_record. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151755 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 53 +++++++++++++++++++++++++++++++------------- 1 file changed, 37 insertions(+), 16 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index ed393388c5c..58c07a777d7 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -131,7 +131,7 @@ static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool); static bool is_variable_size (tree); static tree elaborate_expression_1 (tree, Entity_Id, tree, bool, bool); static tree make_packable_type (tree, bool); -static tree gnat_to_gnu_field (Entity_Id, tree, int, bool); +static tree gnat_to_gnu_field (Entity_Id, tree, int, bool, bool); static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool, bool *); static bool same_discriminant_p (Entity_Id, Entity_Id); @@ -139,7 +139,7 @@ static bool array_type_has_nonaliased_component (Entity_Id, tree); static bool compile_time_known_address_p (Node_Id); static bool cannot_be_superflat_p (Node_Id); static void components_to_record (tree, Node_Id, tree, int, bool, tree *, - bool, bool, bool, bool); + bool, bool, bool, bool, bool); static Uint annotate_value (tree); static void annotate_rep (Entity_Id, tree); static tree compute_field_positions (tree, tree, tree, tree, unsigned int); @@ -1990,7 +1990,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* If a padding record was made, declare it now since it will never be declared otherwise. This is necessary to ensure that its subtrees are properly marked. */ - if (tem != orig_tem) + if (tem != orig_tem && !DECL_P (TYPE_NAME (tem))) create_type_decl (TYPE_NAME (tem), tem, NULL, true, debug_info_p, gnat_entity); } @@ -2364,7 +2364,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (gnu_comp_size && !Is_Bit_Packed_Array (gnat_entity)) { - tree orig_gnu_type = gnu_type; + tree orig_type = gnu_type; unsigned int max_align; /* If an alignment is specified, use it as a cap on the @@ -2381,9 +2381,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = make_type_from_size (gnu_type, gnu_comp_size, false); if (max_align > 0 && TYPE_ALIGN (gnu_type) > max_align) - gnu_type = orig_gnu_type; + gnu_type = orig_type; else - orig_gnu_type = gnu_type; + orig_type = gnu_type; gnu_type = maybe_pad_type (gnu_type, gnu_comp_size, 0, gnat_entity, "C_PAD", false, @@ -2392,7 +2392,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* If a padding record was made, declare it now since it will never be declared otherwise. This is necessary to ensure that its subtrees are properly marked. */ - if (gnu_type != orig_gnu_type) + if (gnu_type != orig_type && !DECL_P (TYPE_NAME (gnu_type))) create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL, true, debug_info_p, gnat_entity); } @@ -2952,7 +2952,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) continue; gnu_field - = gnat_to_gnu_field (gnat_field, gnu_type, packed, definition); + = gnat_to_gnu_field (gnat_field, gnu_type, packed, definition, + debug_info_p); /* Make an expression using a PLACEHOLDER_EXPR from the FIELD_DECL node just created and link that with the @@ -2973,7 +2974,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Add the fields into the record type and finish it up. */ components_to_record (gnu_type, Component_List (record_definition), gnu_field_list, packed, definition, NULL, - false, all_rep, false, is_unchecked_union); + false, all_rep, false, is_unchecked_union, + debug_info_p); /* If it is a tagged record force the type to BLKmode to insure that these objects will always be put in memory. Likewise for limited @@ -6412,11 +6414,14 @@ adjust_packed (tree field_type, tree record_type, int packed) record has Component_Alignment of Storage_Unit, -2 if the enclosing record has a specified alignment. - DEFINITION is true if this field is for a record being defined. */ + DEFINITION is true if this field is for a record being defined. + + DEBUG_INFO_P is true if we need to write debug information for types + that we may create in the process. */ static tree gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, - bool definition) + bool definition, bool debug_info_p) { tree gnu_field_id = get_entity_name (gnat_field); tree gnu_field_type = gnat_to_gnu_type (Etype (gnat_field)); @@ -6635,6 +6640,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, /* If a size is specified, adjust the field's type to it. */ if (gnu_size) { + tree orig_field_type; + /* If the field's type is justified modular, we would need to remove the wrapper to (better) meet the layout requirements. However we can do so only if the field is not aliased to preserve the unique @@ -6650,8 +6657,18 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, gnu_field_type = make_type_from_size (gnu_field_type, gnu_size, Has_Biased_Representation (gnat_field)); + + orig_field_type = gnu_field_type; gnu_field_type = maybe_pad_type (gnu_field_type, gnu_size, 0, gnat_field, "PAD", false, definition, true); + + /* If a padding record was made, declare it now since it will never be + declared otherwise. This is necessary to ensure that its subtrees + are properly marked. */ + if (gnu_field_type != orig_field_type + && !DECL_P (TYPE_NAME (gnu_field_type))) + create_type_decl (TYPE_NAME (gnu_field_type), gnu_field_type, NULL, + true, debug_info_p, gnat_field); } /* Otherwise (or if there was an error), don't specify a position. */ @@ -6746,13 +6763,17 @@ compare_field_bitpos (const PTR rt1, const PTR rt2) modified afterwards so it will not be finalized here. UNCHECKED_UNION, if true, means that we are building a type for a record - with a Pragma Unchecked_Union. */ + with a Pragma Unchecked_Union. + + DEBUG_INFO_P, if true, means that we need to write debug information for + types that we may create in the process. */ static void components_to_record (tree gnu_record_type, Node_Id gnat_component_list, tree gnu_field_list, int packed, bool definition, tree *p_gnu_rep_list, bool cancel_alignment, - bool all_rep, bool do_not_finalize, bool unchecked_union) + bool all_rep, bool do_not_finalize, + bool unchecked_union, bool debug_info_p) { bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type); bool layout_with_rep = false; @@ -6780,8 +6801,8 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, } else { - gnu_field = gnat_to_gnu_field (gnat_field, gnu_record_type, - packed, definition); + gnu_field = gnat_to_gnu_field (gnat_field, gnu_record_type, packed, + definition, debug_info_p); /* If this is the _Tag field, put it before any other fields. */ if (gnat_name == Name_uTag) @@ -6887,7 +6908,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, components_to_record (gnu_variant_type, Component_List (variant), NULL_TREE, packed, definition, &gnu_our_rep_list, !all_rep_and_size, all_rep, - true, unchecked_union); + true, unchecked_union, debug_info_p); gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant)); -- cgit v1.2.1 From 354af4246fbe650a00173133354185900bfaaf86 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Thu, 24 Sep 2009 13:36:24 +0000 Subject: * gcc-interface/ada.h: Fix outdated comment. * gcc-interface/ada-tree.h (SET_TYPE_RM_VALUE): Use MARK_VISITED in lieu of mark_visited. * gcc-interface/gigi.h (mark_visited): Change type of parameter. (MARK_VISITED): New macro. (gnat_truthvalue_conversion): Delete. * gcc-interface/decl.c (gnat_to_gnu_entity): Use MARK_VISITED in lieu of mark_visited. (annotate_rep): Fix formatting and tidy. (compute_field_positions): Get rid of useless variable. * gcc-interface/trans.c (gnat_to_gnu): Retrieve the Nkind of the GNAT node only once. Use IN operator for the Nkind in more cases. Remove calls to gnat_truthvalue_conversion. (mark_visited): Change type of parameter and adjust. (mark_visited_r): Dereference TP only once. (add_decl_expr): Use MARK_VISITED in lieu of mark_visited. * gcc-interface/utils2.c (gnat_truthvalue_conversion): Delete. (build_binary_op): Remove calls to gnat_truthvalue_conversion. (build_unary_op): Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152121 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 102 +++++++++++++++++++++---------------------- 1 file changed, 50 insertions(+), 52 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 58c07a777d7..1e54f38b0a5 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -898,11 +898,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (stable) { - gnu_decl = maybe_stable_expr; /* ??? No DECL_EXPR is created so we need to mark the expression manually lest it is shared. */ if (global_bindings_p ()) - mark_visited (&gnu_decl); + MARK_VISITED (maybe_stable_expr); + gnu_decl = maybe_stable_expr; save_gnu_tree (gnat_entity, gnu_decl, true); saved = true; annotate_object (gnat_entity, gnu_type, NULL_TREE, @@ -2465,7 +2465,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* ??? create_type_decl is not invoked on the inner types so the MULT_EXPR node built above will never be marked. */ - mark_visited (&TYPE_SIZE_UNIT (gnu_arr_type)); + MARK_VISITED (TYPE_SIZE_UNIT (gnu_arr_type)); } } @@ -4631,7 +4631,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) the MULT_EXPR node built above may not be marked by the call to create_type_decl below. */ if (global_bindings_p ()) - mark_visited (&DECL_FIELD_OFFSET (gnu_field)); + MARK_VISITED (DECL_FIELD_OFFSET (gnu_field)); } } @@ -7271,78 +7271,76 @@ annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref) UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT)); } -/* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding - GCC type, set Component_Bit_Offset and Esize to the position and size - used by Gigi. */ +/* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding GCC type, + set Component_Bit_Offset and Esize of the components to the position and + size used by Gigi. */ static void annotate_rep (Entity_Id gnat_entity, tree gnu_type) { - tree gnu_list; - tree gnu_entry; Entity_Id gnat_field; + tree gnu_list; - /* We operate by first making a list of all fields and their positions - (we can get the sizes easily at any time) by a recursive call - and then update all the sizes into the tree. */ - gnu_list = compute_field_positions (gnu_type, NULL_TREE, - size_zero_node, bitsize_zero_node, - BIGGEST_ALIGNMENT); + /* We operate by first making a list of all fields and their position (we + can get the size easily) and then update all the sizes in the tree. */ + gnu_list = compute_field_positions (gnu_type, NULL_TREE, size_zero_node, + bitsize_zero_node, BIGGEST_ALIGNMENT); - for (gnat_field = First_Entity (gnat_entity); Present (gnat_field); + for (gnat_field = First_Entity (gnat_entity); + Present (gnat_field); gnat_field = Next_Entity (gnat_field)) - if ((Ekind (gnat_field) == E_Component - || (Ekind (gnat_field) == E_Discriminant - && !Is_Unchecked_Union (Scope (gnat_field))))) + if (Ekind (gnat_field) == E_Component + || (Ekind (gnat_field) == E_Discriminant + && !Is_Unchecked_Union (Scope (gnat_field)))) { - tree parent_offset = bitsize_zero_node; + tree parent_offset, t; - gnu_entry = purpose_member (gnat_to_gnu_field_decl (gnat_field), - gnu_list); - - if (gnu_entry) + t = purpose_member (gnat_to_gnu_field_decl (gnat_field), gnu_list); + if (t) { if (type_annotate_only && Is_Tagged_Type (gnat_entity)) { - /* In this mode the tag and parent components have not been + /* In this mode the tag and parent components are not generated, so we add the appropriate offset to each component. For a component appearing in the current extension, the offset is the size of the parent. */ - if (Is_Derived_Type (gnat_entity) - && Original_Record_Component (gnat_field) == gnat_field) - parent_offset - = UI_To_gnu (Esize (Etype (Base_Type (gnat_entity))), - bitsizetype); - else - parent_offset = bitsize_int (POINTER_SIZE); + if (Is_Derived_Type (gnat_entity) + && Original_Record_Component (gnat_field) == gnat_field) + parent_offset + = UI_To_gnu (Esize (Etype (Base_Type (gnat_entity))), + bitsizetype); + else + parent_offset = bitsize_int (POINTER_SIZE); } + else + parent_offset = bitsize_zero_node; - Set_Component_Bit_Offset - (gnat_field, - annotate_value - (size_binop (PLUS_EXPR, - bit_from_pos (TREE_PURPOSE (TREE_VALUE (gnu_entry)), - TREE_VALUE (TREE_VALUE - (TREE_VALUE (gnu_entry)))), - parent_offset))); + Set_Component_Bit_Offset + (gnat_field, + annotate_value + (size_binop (PLUS_EXPR, + bit_from_pos (TREE_PURPOSE (TREE_VALUE (t)), + TREE_VALUE (TREE_VALUE + (TREE_VALUE (t)))), + parent_offset))); Set_Esize (gnat_field, - annotate_value (DECL_SIZE (TREE_PURPOSE (gnu_entry)))); + annotate_value (DECL_SIZE (TREE_PURPOSE (t)))); } - else if (Is_Tagged_Type (gnat_entity) - && Is_Derived_Type (gnat_entity)) + else if (Is_Tagged_Type (gnat_entity) && Is_Derived_Type (gnat_entity)) { - /* If there is no gnu_entry, this is an inherited component whose + /* If there is no entry, this is an inherited component whose position is the same as in the parent type. */ Set_Component_Bit_Offset (gnat_field, Component_Bit_Offset (Original_Record_Component (gnat_field))); + Set_Esize (gnat_field, Esize (Original_Record_Component (gnat_field))); } } } - + /* Scan all fields in GNU_TYPE and build entries where TREE_PURPOSE is the FIELD_DECL and TREE_VALUE a TREE_LIST with TREE_PURPOSE being the byte position and TREE_VALUE being a TREE_LIST with TREE_PURPOSE the value to be @@ -7356,9 +7354,9 @@ compute_field_positions (tree gnu_type, tree gnu_list, tree gnu_pos, tree gnu_bitpos, unsigned int offset_align) { tree gnu_field; - tree gnu_result = gnu_list; - for (gnu_field = TYPE_FIELDS (gnu_type); gnu_field; + for (gnu_field = TYPE_FIELDS (gnu_type); + gnu_field; gnu_field = TREE_CHAIN (gnu_field)) { tree gnu_our_bitpos = size_binop (PLUS_EXPR, gnu_bitpos, @@ -7368,22 +7366,22 @@ compute_field_positions (tree gnu_type, tree gnu_list, tree gnu_pos, unsigned int our_offset_align = MIN (offset_align, DECL_OFFSET_ALIGN (gnu_field)); - gnu_result + gnu_list = tree_cons (gnu_field, tree_cons (gnu_our_offset, tree_cons (size_int (our_offset_align), gnu_our_bitpos, NULL_TREE), NULL_TREE), - gnu_result); + gnu_list); if (DECL_INTERNAL_P (gnu_field)) - gnu_result - = compute_field_positions (TREE_TYPE (gnu_field), gnu_result, + gnu_list + = compute_field_positions (TREE_TYPE (gnu_field), gnu_list, gnu_our_offset, gnu_our_bitpos, our_offset_align); } - return gnu_result; + return gnu_list; } /* UINT_SIZE is a Uint giving the specified size for an object of GNU_TYPE -- cgit v1.2.1 From 67649397abe730ccf2f03176864e06c2bf836019 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sat, 26 Sep 2009 11:25:23 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity) : Filter out negative size for the array dimensions like in the constrained case. : Do not create an artificially non-constant high bound if the low bound is non-constant. Minor tweaks. * gcc-interface/trans.c (lvalue_required_p): Add CONSTANT parameter and turn ALIASED into a boolean parameter. Adjust calls to self. : Return 1 for more attributes. : Return 1 for non-constant objects. : Return 1 for the LHS. (Identifier_to_gnu): Adjust calls to lvalue_required_p. (call_to_gnu): Be prepared for wrapped boolean rvalues. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152201 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 75 ++++++++++++++++++++++++++++++-------------- 1 file changed, 51 insertions(+), 24 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 1e54f38b0a5..12d57bcd88f 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1852,7 +1852,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) char field_name[16]; tree gnu_index_base_type = get_unpadded_type (Base_Type (Etype (gnat_index))); - tree gnu_low_field, gnu_high_field, gnu_low, gnu_high; + tree gnu_low_field, gnu_high_field, gnu_low, gnu_high, gnu_max; /* Make the FIELD_DECLs for the low and high bounds of this type and then make extractions of these fields from the @@ -1885,11 +1885,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) NULL_TREE); TREE_READONLY (gnu_low) = TREE_READONLY (gnu_high) = 1; + /* Compute the size of this dimension. */ + gnu_max + = build3 (COND_EXPR, gnu_index_base_type, + build2 (GE_EXPR, integer_type_node, gnu_high, gnu_low), + gnu_high, + build2 (MINUS_EXPR, gnu_index_base_type, + gnu_low, fold_convert (gnu_index_base_type, + integer_one_node))); + /* Make a range type with the new range in the Ada base type. - Then make an index type with the new range in sizetype. */ + Then make an index type with the size range in sizetype. */ gnu_index_types[index] = create_index_type (convert (sizetype, gnu_low), - convert (sizetype, gnu_high), + convert (sizetype, gnu_max), create_range_type (gnu_index_base_type, gnu_low, gnu_high), gnat_entity); @@ -2130,12 +2139,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnat_base_index = Next_Index (gnat_base_index)) { tree gnu_index_type = get_unpadded_type (Etype (gnat_index)); - tree prec = TYPE_RM_SIZE (gnu_index_type); - const bool wider_p - = (compare_tree_int (prec, TYPE_PRECISION (sizetype)) > 0 - || (compare_tree_int (prec, TYPE_PRECISION (sizetype)) == 0 - && TYPE_UNSIGNED (gnu_index_type) - != TYPE_UNSIGNED (sizetype))); + const int prec_comp + = compare_tree_int (TYPE_RM_SIZE (gnu_index_type), + TYPE_PRECISION (sizetype)); + const bool subrange_p = (prec_comp < 0) + || (prec_comp == 0 + && TYPE_UNSIGNED (gnu_index_type) + == TYPE_UNSIGNED (sizetype)); + const bool wider_p = (prec_comp > 0); tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type); tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type); tree gnu_min = convert (sizetype, gnu_orig_min); @@ -2144,7 +2155,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = get_unpadded_type (Etype (gnat_base_index)); tree gnu_base_orig_min = TYPE_MIN_VALUE (gnu_base_index_type); tree gnu_base_orig_max = TYPE_MAX_VALUE (gnu_base_index_type); - tree gnu_high; + tree gnu_high, gnu_low; /* See if the base array type is already flat. If it is, we are probably compiling an ACATS test but it will cause the @@ -2160,7 +2171,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Similarly, if one of the values overflows in sizetype and the range is null, use 1..0 for the sizetype bounds. */ - else if (wider_p + else if (!subrange_p && TREE_CODE (gnu_min) == INTEGER_CST && TREE_CODE (gnu_max) == INTEGER_CST && (TREE_OVERFLOW (gnu_min) || TREE_OVERFLOW (gnu_max)) @@ -2174,7 +2185,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* If the minimum and maximum values both overflow in sizetype, but the difference in the original type does not overflow in sizetype, ignore the overflow indication. */ - else if (wider_p + else if (!subrange_p && TREE_CODE (gnu_min) == INTEGER_CST && TREE_CODE (gnu_max) == INTEGER_CST && TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max) @@ -2200,25 +2211,41 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Otherwise, if we can prove that the low bound minus one and the high bound cannot overflow, we can just use the expression - MAX (hb, lb - 1). Otherwise, we have to use the most general - expression (hb >= lb) ? hb : lb - 1. Note that the comparison - must be done in the original index type, to avoid any overflow - during the conversion. */ + MAX (hb, lb - 1). Similarly, if we can prove that the high + bound plus one and the low bound cannot overflow, we can use + the high bound as-is and MIN (hb + 1, lb) for the low bound. + Otherwise, we have to fall back to the most general expression + (hb >= lb) ? hb : lb - 1. Note that the comparison must be + done in the original index type, to avoid any overflow during + the conversion. */ else { gnu_high = size_binop (MINUS_EXPR, gnu_min, size_one_node); - - /* If gnu_high is a constant that has overflowed, the bound - is the smallest integer so cannot be the maximum. */ - if (TREE_CODE (gnu_high) == INTEGER_CST - && TREE_OVERFLOW (gnu_high)) + gnu_low = size_binop (PLUS_EXPR, gnu_max, size_one_node); + + /* If gnu_high is a constant that has overflowed, the low + bound is the smallest integer so cannot be the maximum. + If gnu_low is a constant that has overflowed, the high + bound is the highest integer so cannot be the minimum. */ + if ((TREE_CODE (gnu_high) == INTEGER_CST + && TREE_OVERFLOW (gnu_high)) + || (TREE_CODE (gnu_low) == INTEGER_CST + && TREE_OVERFLOW (gnu_low))) gnu_high = gnu_max; - /* If the index type is not wider and gnu_high is a constant + /* If the index type is a subrange and gnu_high a constant that hasn't overflowed, we can use the maximum. */ - else if (!wider_p && TREE_CODE (gnu_high) == INTEGER_CST) + else if (subrange_p && TREE_CODE (gnu_high) == INTEGER_CST) gnu_high = size_binop (MAX_EXPR, gnu_max, gnu_high); + /* If the index type is a subrange and gnu_low a constant + that hasn't overflowed, we can use the minimum. */ + else if (subrange_p && TREE_CODE (gnu_low) == INTEGER_CST) + { + gnu_high = gnu_max; + gnu_min = size_binop (MIN_EXPR, gnu_min, gnu_low); + } + else gnu_high = build_cond_expr (sizetype, @@ -2298,7 +2325,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && TREE_CODE (TREE_TYPE (gnu_index_type)) != INTEGER_TYPE) || TYPE_BIASED_REPRESENTATION_P (gnu_index_type) - || compare_tree_int (prec, TYPE_PRECISION (sizetype)) > 0) + || wider_p) need_index_type_struct = true; } -- cgit v1.2.1 From 0f5afd3e83da3462179c68f58e931d6650c0f07e Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Tue, 29 Sep 2009 10:54:12 +0000 Subject: * decl.c (gnat_to_gnu_entity) : Rewrite the handling of constrained discriminated record subtypes. (components_to_record): Declare the type of the variants and of the qualified union. (build_subst_list): Move around. (compute_field_positions): Rename into... (build_position_list): ...this. Return a TREE_VEC. (annotate_rep): Adjust for above renaming. (build_variant_list): New static function. (create_field_decl_from): Likewise. (get_rep_part): Likewise. (get_variant_part): Likewise. (create_variant_part_from): Likewise. (copy_and_substitute_in_size): Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152272 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 638 ++++++++++++++++++++++++++++++++----------- 1 file changed, 479 insertions(+), 159 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 12d57bcd88f..179418e8a95 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -122,7 +122,6 @@ enum alias_set_op static void relate_alias_sets (tree, tree, enum alias_set_op); -static tree build_subst_list (Entity_Id, Entity_Id, bool); static bool allocatable_size_p (tree, bool); static void prepend_one_attribute_to (struct attrib **, enum attr_type, tree, tree, Node_Id); @@ -142,14 +141,21 @@ static void components_to_record (tree, Node_Id, tree, int, bool, tree *, bool, bool, bool, bool, bool); static Uint annotate_value (tree); static void annotate_rep (Entity_Id, tree); -static tree compute_field_positions (tree, tree, tree, tree, unsigned int); +static tree build_position_list (tree, bool, tree, tree, unsigned int, tree); +static tree build_subst_list (Entity_Id, Entity_Id, bool); +static tree build_variant_list (tree, tree, tree); static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool); static void set_rm_size (Uint, tree, Entity_Id); static tree make_type_from_size (tree, tree, bool); static unsigned int validate_alignment (Uint, Entity_Id, unsigned int); static unsigned int ceil_alignment (unsigned HOST_WIDE_INT); static void check_ok_for_atomic (tree, Entity_Id, bool); -static int compatible_signatures_p (tree ftype1, tree ftype2); +static int compatible_signatures_p (tree, tree); +static tree create_field_decl_from (tree, tree, tree, tree, tree, tree); +static tree get_rep_part (tree); +static tree get_variant_part (tree); +static tree create_variant_part_from (tree, tree, tree, tree, tree); +static void copy_and_substitute_in_size (tree, tree, tree); static void rest_of_type_decl_compilation_no_defer (tree); /* Given GNAT_ENTITY, a GNAT defining identifier node, which denotes some Ada @@ -3085,9 +3091,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } /* When the subtype has discriminants and these discriminants affect - the initial shape it has inherited, factor them in. But for the - of an Unchecked_Union (it must be an Itype), just return the type. - + the initial shape it has inherited, factor them in. But for an + Unchecked_Union (it must be an Itype), just return the type. We can't just test Is_Constrained because private subtypes without discriminants of types with discriminants with default expressions are Is_Constrained but aren't constrained! */ @@ -3101,43 +3106,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { tree gnu_subst_list = build_subst_list (gnat_entity, gnat_base_type, definition); - tree gnu_pos_list, gnu_field_list = NULL_TREE; - tree gnu_unpad_base_type, t; + tree gnu_unpad_base_type, gnu_rep_part, gnu_variant_part, t; + tree gnu_variant_list, gnu_pos_list, gnu_field_list = NULL_TREE; + bool selected_variant = false; Entity_Id gnat_field; gnu_type = make_node (RECORD_TYPE); TYPE_NAME (gnu_type) = gnu_entity_name; /* Set the size, alignment and alias set of the new type to - match that of the old one, doing required substitutions. - We do it this early because we need the size of the new - type below to discard old fields if necessary. */ - TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_base_type); - TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_base_type); - SET_TYPE_ADA_SIZE (gnu_type, TYPE_ADA_SIZE (gnu_base_type)); - TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type); - relate_alias_sets (gnu_type, gnu_base_type, ALIAS_SET_COPY); - - if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))) - for (t = gnu_subst_list; t; t = TREE_CHAIN (t)) - TYPE_SIZE (gnu_type) - = substitute_in_expr (TYPE_SIZE (gnu_type), - TREE_PURPOSE (t), - TREE_VALUE (t)); - - if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE_UNIT (gnu_type))) - for (t = gnu_subst_list; t; t = TREE_CHAIN (t)) - TYPE_SIZE_UNIT (gnu_type) - = substitute_in_expr (TYPE_SIZE_UNIT (gnu_type), - TREE_PURPOSE (t), - TREE_VALUE (t)); - - if (CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (gnu_type))) - for (t = gnu_subst_list; t; t = TREE_CHAIN (t)) - SET_TYPE_ADA_SIZE - (gnu_type, substitute_in_expr (TYPE_ADA_SIZE (gnu_type), - TREE_PURPOSE (t), - TREE_VALUE (t))); + match that of the old one, doing required substitutions. */ + copy_and_substitute_in_size (gnu_type, gnu_base_type, + gnu_subst_list); if (TREE_CODE (gnu_base_type) == RECORD_TYPE && TYPE_IS_PADDING_P (gnu_base_type)) @@ -3145,10 +3125,57 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) else gnu_unpad_base_type = gnu_base_type; + /* Look for a REP part in the base type. */ + gnu_rep_part = get_rep_part (gnu_unpad_base_type); + + /* Look for a variant part in the base type. */ + gnu_variant_part = get_variant_part (gnu_unpad_base_type); + + /* If there is a variant part, we must compute whether the + constraints statically select a particular variant. If + so, we simply drop the qualified union and flatten the + list of fields. Otherwise we'll build a new qualified + union for the variants that are still relevant. */ + if (gnu_variant_part) + { + gnu_variant_list + = build_variant_list (TREE_TYPE (gnu_variant_part), + gnu_subst_list, NULL_TREE); + + /* If all the qualifiers are unconditionally true, the + innermost variant is statically selected. */ + selected_variant = true; + for (t = gnu_variant_list; t; t = TREE_CHAIN (t)) + if (!integer_onep (TREE_VEC_ELT (TREE_VALUE (t), 1))) + { + selected_variant = false; + break; + } + + /* Otherwise, create the new variants. */ + if (!selected_variant) + for (t = gnu_variant_list; t; t = TREE_CHAIN (t)) + { + tree old_variant = TREE_PURPOSE (t); + tree new_variant = make_node (RECORD_TYPE); + TYPE_NAME (new_variant) + = DECL_NAME (TYPE_NAME (old_variant)); + copy_and_substitute_in_size (new_variant, old_variant, + gnu_subst_list); + TREE_VEC_ELT (TREE_VALUE (t), 2) = new_variant; + } + } + else + { + gnu_variant_list = NULL_TREE; + selected_variant = false; + } + gnu_pos_list - = compute_field_positions (gnu_unpad_base_type, NULL_TREE, - size_zero_node, bitsize_zero_node, - BIGGEST_ALIGNMENT); + = build_position_list (gnu_unpad_base_type, + gnu_variant_list && !selected_variant, + size_zero_node, bitsize_zero_node, + BIGGEST_ALIGNMENT, NULL_TREE); for (gnat_field = First_Entity (gnat_entity); Present (gnat_field); @@ -3166,16 +3193,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = Original_Record_Component (gnat_field); tree gnu_old_field = gnat_to_gnu_field_decl (gnat_old_field); - tree gnu_offset - = TREE_VALUE - (purpose_member (gnu_old_field, gnu_pos_list)); - tree gnu_pos = TREE_PURPOSE (gnu_offset); - tree gnu_bitpos = TREE_VALUE (TREE_VALUE (gnu_offset)); - tree gnu_field, gnu_field_type, gnu_size, gnu_new_pos; - tree gnu_last = NULL_TREE; - unsigned int offset_align - = tree_low_cst - (TREE_PURPOSE (TREE_VALUE (gnu_offset)), 1); + tree gnu_context = DECL_CONTEXT (gnu_old_field); + tree gnu_field, gnu_field_type, gnu_size; + tree gnu_cont_type, gnu_last = NULL_TREE; /* If the type is the same, retrieve the GCC type from the old field to take into account possible adjustments. */ @@ -3219,67 +3239,50 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) else gnu_size = TYPE_SIZE (gnu_field_type); - if (CONTAINS_PLACEHOLDER_P (gnu_pos)) - for (t = gnu_subst_list; t; t = TREE_CHAIN (t)) - gnu_pos = substitute_in_expr (gnu_pos, - TREE_PURPOSE (t), - TREE_VALUE (t)); - - /* If the position is now a constant, we can set it as the - position of the field when we make it. Otherwise, we - need to deal with it specially below. */ - if (TREE_CONSTANT (gnu_pos)) + /* If the context of the old field is the base type or its + REP part (if any), put the field directly in the new + type; otherwise look up the context in the variant list + and put the field either in the new type if there is a + selected variant or in one of the new variants. */ + if (gnu_context == gnu_unpad_base_type + || (gnu_rep_part + && gnu_context == TREE_TYPE (gnu_rep_part))) + gnu_cont_type = gnu_type; + else { - gnu_new_pos = bit_from_pos (gnu_pos, gnu_bitpos); - - /* Discard old fields that are outside the new type. - This avoids confusing code scanning it to decide - how to pass it to functions on some platforms. */ - if (TREE_CODE (gnu_new_pos) == INTEGER_CST - && TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST - && !integer_zerop (gnu_size) - && !tree_int_cst_lt (gnu_new_pos, - TYPE_SIZE (gnu_type))) + t = purpose_member (gnu_context, gnu_variant_list); + if (t) + { + if (selected_variant) + gnu_cont_type = gnu_type; + else + gnu_cont_type = TREE_VEC_ELT (TREE_VALUE (t), 2); + } + else + /* The front-end may pass us "ghost" components if + it fails to recognize that a constrained subtype + is statically constrained. Discard them. */ continue; } - else - gnu_new_pos = NULL_TREE; + /* Now create the new field modeled on the old one. */ gnu_field - = create_field_decl - (DECL_NAME (gnu_old_field), gnu_field_type, gnu_type, - DECL_PACKED (gnu_old_field), gnu_size, gnu_new_pos, - !DECL_NONADDRESSABLE_P (gnu_old_field)); + = create_field_decl_from (gnu_old_field, gnu_field_type, + gnu_cont_type, gnu_size, + gnu_pos_list, gnu_subst_list); - if (!TREE_CONSTANT (gnu_pos)) + /* Put it in one of the new variants directly. */ + if (gnu_cont_type != gnu_type) { - normalize_offset (&gnu_pos, &gnu_bitpos, offset_align); - DECL_FIELD_OFFSET (gnu_field) = gnu_pos; - DECL_FIELD_BIT_OFFSET (gnu_field) = gnu_bitpos; - SET_DECL_OFFSET_ALIGN (gnu_field, offset_align); - DECL_SIZE (gnu_field) = gnu_size; - DECL_SIZE_UNIT (gnu_field) - = convert (sizetype, - size_binop (CEIL_DIV_EXPR, gnu_size, - bitsize_unit_node)); - layout_decl (gnu_field, DECL_OFFSET_ALIGN (gnu_field)); + TREE_CHAIN (gnu_field) = TYPE_FIELDS (gnu_cont_type); + TYPE_FIELDS (gnu_cont_type) = gnu_field; } - DECL_INTERNAL_P (gnu_field) - = DECL_INTERNAL_P (gnu_old_field); - SET_DECL_ORIGINAL_FIELD - (gnu_field, (DECL_ORIGINAL_FIELD (gnu_old_field) - ? DECL_ORIGINAL_FIELD (gnu_old_field) - : gnu_old_field)); - DECL_DISCRIMINANT_NUMBER (gnu_field) - = DECL_DISCRIMINANT_NUMBER (gnu_old_field); - TREE_THIS_VOLATILE (gnu_field) - = TREE_THIS_VOLATILE (gnu_old_field); - /* To match the layout crafted in components_to_record, if this is the _Tag or _Parent field, put it before any other fields. */ - if (gnat_name == Name_uTag || gnat_name == Name_uParent) + else if (gnat_name == Name_uTag + || gnat_name == Name_uParent) gnu_field_list = chainon (gnu_field_list, gnu_field); /* Similarly, if this is the _Controller field, put @@ -3304,6 +3307,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) save_gnu_tree (gnat_field, gnu_field, false); } + /* If there is a variant list and no selected variant, we need + to create the nest of variant parts from the old nest. */ + if (gnu_variant_list && !selected_variant) + { + tree new_variant_part + = create_variant_part_from (gnu_variant_part, + gnu_variant_list, gnu_type, + gnu_pos_list, gnu_subst_list); + TREE_CHAIN (new_variant_part) = gnu_field_list; + gnu_field_list = new_variant_part; + } + /* Now go through the entities again looking for Itypes that we have not elaborated but should (e.g., Etypes of fields that have Original_Components). */ @@ -3318,11 +3333,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_field_list = nreverse (gnu_field_list); finish_record_type (gnu_type, gnu_field_list, 2, true); - /* Finalize size and mode. */ - TYPE_SIZE (gnu_type) = variable_size (TYPE_SIZE (gnu_type)); - TYPE_SIZE_UNIT (gnu_type) - = variable_size (TYPE_SIZE_UNIT (gnu_type)); - /* See the E_Record_Type case for the rationale. */ if (Is_Tagged_Type (gnat_entity) || Is_Limited_Record (gnat_entity)) @@ -5549,37 +5559,6 @@ relate_alias_sets (tree gnu_new_type, tree gnu_old_type, enum alias_set_op op) record_component_aliases (gnu_new_type); } -/* Return a TREE_LIST describing the substitutions needed to reflect the - discriminant substitutions from GNAT_TYPE to GNAT_SUBTYPE. They can - be in any order. TREE_PURPOSE gives the tree for the discriminant and - TREE_VALUE is the replacement value. They are in the form of operands - to substitute_in_expr. DEFINITION is true if this is for a definition - of GNAT_SUBTYPE. */ - -static tree -build_subst_list (Entity_Id gnat_subtype, Entity_Id gnat_type, bool definition) -{ - tree gnu_list = NULL_TREE; - Entity_Id gnat_discrim; - Node_Id gnat_value; - - for (gnat_discrim = First_Stored_Discriminant (gnat_type), - gnat_value = First_Elmt (Stored_Constraint (gnat_subtype)); - Present (gnat_discrim); - gnat_discrim = Next_Stored_Discriminant (gnat_discrim), - gnat_value = Next_Elmt (gnat_value)) - /* Ignore access discriminants. */ - if (!Is_Access_Type (Etype (Node (gnat_value)))) - gnu_list = tree_cons (gnat_to_gnu_field_decl (gnat_discrim), - elaborate_expression - (Node (gnat_value), gnat_subtype, - get_entity_name (gnat_discrim), definition, - true, false), - gnu_list); - - return gnu_list; -} - /* Return true if the size represented by GNU_SIZE can be handled by an allocation. If STATIC_P is true, consider only what can be done with a static allocation. */ @@ -6959,6 +6938,8 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, otherwise, the union type definition will be lacking the fields associated with these empty variants. */ rest_of_record_type_compilation (gnu_variant_type); + create_type_decl (TYPE_NAME (gnu_variant_type), gnu_variant_type, + NULL, true, debug_info_p, gnat_component_list); gnu_field = create_field_decl (gnu_inner_name, gnu_variant_type, gnu_union_type, field_packed, @@ -7005,6 +6986,9 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, return; } + create_type_decl (TYPE_NAME (gnu_union_type), gnu_union_type, + NULL, true, debug_info_p, gnat_component_list); + /* Deal with packedness like in gnat_to_gnu_field. */ union_field_packed = adjust_packed (gnu_union_type, gnu_record_type, packed); @@ -7310,8 +7294,9 @@ annotate_rep (Entity_Id gnat_entity, tree gnu_type) /* We operate by first making a list of all fields and their position (we can get the size easily) and then update all the sizes in the tree. */ - gnu_list = compute_field_positions (gnu_type, NULL_TREE, size_zero_node, - bitsize_zero_node, BIGGEST_ALIGNMENT); + gnu_list + = build_position_list (gnu_type, false, size_zero_node, bitsize_zero_node, + BIGGEST_ALIGNMENT, NULL_TREE); for (gnat_field = First_Entity (gnat_entity); Present (gnat_field); @@ -7346,9 +7331,8 @@ annotate_rep (Entity_Id gnat_entity, tree gnu_type) (gnat_field, annotate_value (size_binop (PLUS_EXPR, - bit_from_pos (TREE_PURPOSE (TREE_VALUE (t)), - TREE_VALUE (TREE_VALUE - (TREE_VALUE (t)))), + bit_from_pos (TREE_VEC_ELT (TREE_VALUE (t), 0), + TREE_VEC_ELT (TREE_VALUE (t), 2)), parent_offset))); Set_Esize (gnat_field, @@ -7368,17 +7352,17 @@ annotate_rep (Entity_Id gnat_entity, tree gnu_type) } } -/* Scan all fields in GNU_TYPE and build entries where TREE_PURPOSE is the - FIELD_DECL and TREE_VALUE a TREE_LIST with TREE_PURPOSE being the byte - position and TREE_VALUE being a TREE_LIST with TREE_PURPOSE the value to be - placed into DECL_OFFSET_ALIGN and TREE_VALUE the bit position. GNU_POS is - to be added to the position, GNU_BITPOS to the bit position, OFFSET_ALIGN is - the present value of DECL_OFFSET_ALIGN and GNU_LIST is a list of the entries - so far. */ +/* Scan all fields in GNU_TYPE and return a TREE_LIST where TREE_PURPOSE is + the FIELD_DECL and TREE_VALUE a TREE_VEC containing the byte position, the + value to be placed into DECL_OFFSET_ALIGN and the bit position. The list + of fields is flattened, except for variant parts if DO_NOT_FLATTEN_VARIANT + is set to true. GNU_POS is to be added to the position, GNU_BITPOS to the + bit position, OFFSET_ALIGN is the present offset alignment. GNU_LIST is a + pre-existing list to be chained to the newly created entries. */ static tree -compute_field_positions (tree gnu_type, tree gnu_list, tree gnu_pos, - tree gnu_bitpos, unsigned int offset_align) +build_position_list (tree gnu_type, bool do_not_flatten_variant, tree gnu_pos, + tree gnu_bitpos, unsigned int offset_align, tree gnu_list) { tree gnu_field; @@ -7392,20 +7376,109 @@ compute_field_positions (tree gnu_type, tree gnu_list, tree gnu_pos, DECL_FIELD_OFFSET (gnu_field)); unsigned int our_offset_align = MIN (offset_align, DECL_OFFSET_ALIGN (gnu_field)); + tree v = make_tree_vec (3); - gnu_list - = tree_cons (gnu_field, - tree_cons (gnu_our_offset, - tree_cons (size_int (our_offset_align), - gnu_our_bitpos, NULL_TREE), - NULL_TREE), - gnu_list); + TREE_VEC_ELT (v, 0) = gnu_our_offset; + TREE_VEC_ELT (v, 1) = size_int (our_offset_align); + TREE_VEC_ELT (v, 2) = gnu_our_bitpos; + gnu_list = tree_cons (gnu_field, v, gnu_list); + /* Recurse on internal fields, flattening the nested fields except for + those in the variant part, if requested. */ if (DECL_INTERNAL_P (gnu_field)) - gnu_list - = compute_field_positions (TREE_TYPE (gnu_field), gnu_list, + { + tree gnu_field_type = TREE_TYPE (gnu_field); + if (do_not_flatten_variant + && TREE_CODE (gnu_field_type) == QUAL_UNION_TYPE) + gnu_list + = build_position_list (gnu_field_type, do_not_flatten_variant, + size_zero_node, bitsize_zero_node, + BIGGEST_ALIGNMENT, gnu_list); + else + gnu_list + = build_position_list (gnu_field_type, do_not_flatten_variant, gnu_our_offset, gnu_our_bitpos, - our_offset_align); + our_offset_align, gnu_list); + } + } + + return gnu_list; +} + +/* Return a TREE_LIST describing the substitutions needed to reflect the + discriminant substitutions from GNAT_TYPE to GNAT_SUBTYPE. They can + be in any order. TREE_PURPOSE gives the tree for the discriminant and + TREE_VALUE is the replacement value. They are in the form of operands + to SUBSTITUTE_IN_EXPR. DEFINITION is true if this is for a definition + of GNAT_SUBTYPE. */ + +static tree +build_subst_list (Entity_Id gnat_subtype, Entity_Id gnat_type, bool definition) +{ + tree gnu_list = NULL_TREE; + Entity_Id gnat_discrim; + Node_Id gnat_value; + + for (gnat_discrim = First_Stored_Discriminant (gnat_type), + gnat_value = First_Elmt (Stored_Constraint (gnat_subtype)); + Present (gnat_discrim); + gnat_discrim = Next_Stored_Discriminant (gnat_discrim), + gnat_value = Next_Elmt (gnat_value)) + /* Ignore access discriminants. */ + if (!Is_Access_Type (Etype (Node (gnat_value)))) + gnu_list = tree_cons (gnat_to_gnu_field_decl (gnat_discrim), + elaborate_expression + (Node (gnat_value), gnat_subtype, + get_entity_name (gnat_discrim), definition, + true, false), + gnu_list); + + return gnu_list; +} + +/* Scan all fields in QUAL_UNION_TYPE and return a TREE_LIST describing the + variants of QUAL_UNION_TYPE that are still relevant after applying the + substitutions described in SUBST_LIST. TREE_PURPOSE is the type of the + variant and TREE_VALUE is a TREE_VEC containing the field, the new value + of the qualifier and NULL_TREE respectively. GNU_LIST is a pre-existing + list to be chained to the newly created entries. */ + +static tree +build_variant_list (tree qual_union_type, tree subst_list, tree gnu_list) +{ + tree gnu_field; + + for (gnu_field = TYPE_FIELDS (qual_union_type); + gnu_field; + gnu_field = TREE_CHAIN (gnu_field)) + { + tree t, qual = DECL_QUALIFIER (gnu_field); + + for (t = subst_list; t; t = TREE_CHAIN (t)) + qual = SUBSTITUTE_IN_EXPR (qual, TREE_PURPOSE (t), TREE_VALUE (t)); + + /* If the new qualifier is not unconditionally false, its variant may + still be accessed. */ + if (!integer_zerop (qual)) + { + tree variant_type = TREE_TYPE (gnu_field), variant_subpart; + tree v = make_tree_vec (3); + TREE_VEC_ELT (v, 0) = gnu_field; + TREE_VEC_ELT (v, 1) = qual; + TREE_VEC_ELT (v, 2) = NULL_TREE; + gnu_list = tree_cons (variant_type, v, gnu_list); + + /* Recurse on the variant subpart of the variant, if any. */ + variant_subpart = get_variant_part (variant_type); + if (variant_subpart) + gnu_list = build_variant_list (TREE_TYPE (variant_subpart), + subst_list, gnu_list); + + /* If the new qualifier is unconditionally true, the subsequent + variants cannot be accessed. */ + if (integer_onep (qual)) + break; + } } return gnu_list; @@ -7916,6 +7989,253 @@ compatible_signatures_p (tree ftype1, tree ftype2) return 1; } +/* Return a FIELD_DECL node modeled on OLD_FIELD. FIELD_TYPE is its type + and RECORD_TYPE is the type of the parent. If SIZE is nonzero, it is the + specified size for this field. POS_LIST is a position list describing + the layout of OLD_FIELD and SUBST_LIST a substitution list to be applied + to this layout. */ + +static tree +create_field_decl_from (tree old_field, tree field_type, tree record_type, + tree size, tree pos_list, tree subst_list) +{ + tree t = TREE_VALUE (purpose_member (old_field, pos_list)); + tree pos = TREE_VEC_ELT (t, 0), bitpos = TREE_VEC_ELT (t, 2); + unsigned int offset_align = tree_low_cst (TREE_VEC_ELT (t, 1), 1); + tree new_pos, new_field; + + if (CONTAINS_PLACEHOLDER_P (pos)) + for (t = subst_list; t; t = TREE_CHAIN (t)) + pos = SUBSTITUTE_IN_EXPR (pos, TREE_PURPOSE (t), TREE_VALUE (t)); + + /* If the position is now a constant, we can set it as the position of the + field when we make it. Otherwise, we need to deal with it specially. */ + if (TREE_CONSTANT (pos)) + new_pos = bit_from_pos (pos, bitpos); + else + new_pos = NULL_TREE; + + new_field + = create_field_decl (DECL_NAME (old_field), field_type, record_type, + DECL_PACKED (old_field), size, new_pos, + !DECL_NONADDRESSABLE_P (old_field)); + + if (!new_pos) + { + normalize_offset (&pos, &bitpos, offset_align); + DECL_FIELD_OFFSET (new_field) = pos; + DECL_FIELD_BIT_OFFSET (new_field) = bitpos; + SET_DECL_OFFSET_ALIGN (new_field, offset_align); + DECL_SIZE (new_field) = size; + DECL_SIZE_UNIT (new_field) + = convert (sizetype, + size_binop (CEIL_DIV_EXPR, size, bitsize_unit_node)); + layout_decl (new_field, DECL_OFFSET_ALIGN (new_field)); + } + + DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field); + t = DECL_ORIGINAL_FIELD (old_field); + SET_DECL_ORIGINAL_FIELD (new_field, t ? t : old_field); + DECL_DISCRIMINANT_NUMBER (new_field) = DECL_DISCRIMINANT_NUMBER (old_field); + TREE_THIS_VOLATILE (new_field) = TREE_THIS_VOLATILE (old_field); + + return new_field; +} + +/* Return the REP part of RECORD_TYPE, if any. Otherwise return NULL. */ + +static tree +get_rep_part (tree record_type) +{ + tree field = TYPE_FIELDS (record_type); + + /* The REP part is the first field, internal, another record, and its name + doesn't start with an underscore (i.e. is not generated by the FE). */ + if (DECL_INTERNAL_P (field) + && TREE_CODE (TREE_TYPE (field)) == RECORD_TYPE + && IDENTIFIER_POINTER (DECL_NAME (field)) [0] != '_') + return field; + + return NULL_TREE; +} + +/* Return the variant part of RECORD_TYPE, if any. Otherwise return NULL. */ + +static tree +get_variant_part (tree record_type) +{ + tree field; + + /* The variant part is the only internal field that is a qualified union. */ + for (field = TYPE_FIELDS (record_type); field; field = TREE_CHAIN (field)) + if (DECL_INTERNAL_P (field) + && TREE_CODE (TREE_TYPE (field)) == QUAL_UNION_TYPE) + return field; + + return NULL_TREE; +} + +/* Return a new variant part modeled on OLD_VARIANT_PART. VARIANT_LIST is + the list of variants to be used and RECORD_TYPE is the type of the parent. + POS_LIST is a position list describing the layout of fields present in + OLD_VARIANT_PART and SUBST_LIST a substitution list to be applied to this + layout. */ + +static tree +create_variant_part_from (tree old_variant_part, tree variant_list, + tree record_type, tree pos_list, tree subst_list) +{ + tree offset = DECL_FIELD_OFFSET (old_variant_part); + tree bitpos = DECL_FIELD_BIT_OFFSET (old_variant_part); + tree old_union_type = TREE_TYPE (old_variant_part); + tree new_union_type, new_variant_part, t; + tree union_field_list = NULL_TREE; + + /* First create the type of the variant part from that of the old one. */ + new_union_type = make_node (QUAL_UNION_TYPE); + TYPE_NAME (new_union_type) = DECL_NAME (TYPE_NAME (old_union_type)); + + /* If the position of the variant part is constant, subtract it from the + size of the type of the parent to get the new size. This manual CSE + reduces the code size when not optimizing. */ + if (TREE_CODE (offset) == INTEGER_CST && TREE_CODE (bitpos) == INTEGER_CST) + { + tree first_bit = bit_from_pos (offset, bitpos); + TYPE_SIZE (new_union_type) + = size_binop (MINUS_EXPR, TYPE_SIZE (record_type), first_bit); + TYPE_SIZE_UNIT (new_union_type) + = size_binop (MINUS_EXPR, TYPE_SIZE_UNIT (record_type), + byte_from_pos (offset, bitpos)); + SET_TYPE_ADA_SIZE (new_union_type, + size_binop (MINUS_EXPR, TYPE_ADA_SIZE (record_type), + first_bit)); + TYPE_ALIGN (new_union_type) = TYPE_ALIGN (old_union_type); + relate_alias_sets (new_union_type, old_union_type, ALIAS_SET_COPY); + } + else + copy_and_substitute_in_size (new_union_type, old_union_type, subst_list); + + /* Now finish up the new variants and populate the union type. */ + for (t = variant_list; t; t = TREE_CHAIN (t)) + { + tree old_field = TREE_VEC_ELT (TREE_VALUE (t), 0), new_field; + tree old_variant, old_variant_subpart, new_variant, field_list; + + /* Skip variants that don't belong to this nesting level. */ + if (DECL_CONTEXT (old_field) != old_union_type) + continue; + + /* Retrieve the list of fields already added to the new variant. */ + new_variant = TREE_VEC_ELT (TREE_VALUE (t), 2); + field_list = TYPE_FIELDS (new_variant); + + /* If the old variant had a variant subpart, we need to create a new + variant subpart and add it to the field list. */ + old_variant = TREE_PURPOSE (t); + old_variant_subpart = get_variant_part (old_variant); + if (old_variant_subpart) + { + tree new_variant_subpart + = create_variant_part_from (old_variant_subpart, variant_list, + new_variant, pos_list, subst_list); + TREE_CHAIN (new_variant_subpart) = field_list; + field_list = new_variant_subpart; + } + + /* Finish up the new variant and create the field. */ + finish_record_type (new_variant, nreverse (field_list), 2, true); + compute_record_mode (new_variant); + rest_of_record_type_compilation (new_variant); + + /* No need for debug info thanks to the XVS type. */ + create_type_decl (TYPE_NAME (new_variant), new_variant, NULL, + true, false, Empty); + + new_field + = create_field_decl_from (old_field, new_variant, new_union_type, + TYPE_SIZE (new_variant), + pos_list, subst_list); + DECL_QUALIFIER (new_field) = TREE_VEC_ELT (TREE_VALUE (t), 1); + DECL_INTERNAL_P (new_field) = 1; + TREE_CHAIN (new_field) = union_field_list; + union_field_list = new_field; + } + + /* Finish up the union type and create the variant part. */ + finish_record_type (new_union_type, union_field_list, 2, true); + compute_record_mode (new_union_type); + rest_of_record_type_compilation (new_union_type); + + /* No need for debug info thanks to the XVS type. */ + create_type_decl (TYPE_NAME (new_union_type), new_union_type, NULL, + true, false, Empty); + + new_variant_part + = create_field_decl_from (old_variant_part, new_union_type, record_type, + TYPE_SIZE (new_union_type), + pos_list, subst_list); + DECL_INTERNAL_P (new_variant_part) = 1; + + /* With multiple discriminants it is possible for an inner variant to be + statically selected while outer ones are not; in this case, the list + of fields of the inner variant is not flattened and we end up with a + qualified union with a single member. Drop the useless container. */ + if (!TREE_CHAIN (union_field_list)) + { + DECL_CONTEXT (union_field_list) = record_type; + DECL_FIELD_OFFSET (union_field_list) + = DECL_FIELD_OFFSET (new_variant_part); + DECL_FIELD_BIT_OFFSET (union_field_list) + = DECL_FIELD_BIT_OFFSET (new_variant_part); + SET_DECL_OFFSET_ALIGN (union_field_list, + DECL_OFFSET_ALIGN (new_variant_part)); + new_variant_part = union_field_list; + } + + return new_variant_part; +} + +/* Copy the size (and alignment and alias set) from OLD_TYPE to NEW_TYPE, + which are both RECORD_TYPE, after applying the substitutions described + in SUBST_LIST. */ + +static void +copy_and_substitute_in_size (tree new_type, tree old_type, tree subst_list) +{ + tree t; + + TYPE_SIZE (new_type) = TYPE_SIZE (old_type); + TYPE_SIZE_UNIT (new_type) = TYPE_SIZE_UNIT (old_type); + SET_TYPE_ADA_SIZE (new_type, TYPE_ADA_SIZE (old_type)); + TYPE_ALIGN (new_type) = TYPE_ALIGN (old_type); + relate_alias_sets (new_type, old_type, ALIAS_SET_COPY); + + if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (new_type))) + for (t = subst_list; t; t = TREE_CHAIN (t)) + TYPE_SIZE (new_type) + = SUBSTITUTE_IN_EXPR (TYPE_SIZE (new_type), + TREE_PURPOSE (t), + TREE_VALUE (t)); + + if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE_UNIT (new_type))) + for (t = subst_list; t; t = TREE_CHAIN (t)) + TYPE_SIZE_UNIT (new_type) + = SUBSTITUTE_IN_EXPR (TYPE_SIZE_UNIT (new_type), + TREE_PURPOSE (t), + TREE_VALUE (t)); + + if (CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (new_type))) + for (t = subst_list; t; t = TREE_CHAIN (t)) + SET_TYPE_ADA_SIZE + (new_type, SUBSTITUTE_IN_EXPR (TYPE_ADA_SIZE (new_type), + TREE_PURPOSE (t), + TREE_VALUE (t))); + + /* Finalize the size. */ + TYPE_SIZE (new_type) = variable_size (TYPE_SIZE (new_type)); + TYPE_SIZE_UNIT (new_type) = variable_size (TYPE_SIZE_UNIT (new_type)); +} + /* Given a type T, a FIELD_DECL F, and a replacement value R, return a type with all size expressions that contain F in a PLACEHOLDER_EXPR updated by replacing F with R. -- cgit v1.2.1 From 7e8f90147042c91d693404a344728bb6fab2badb Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Tue, 29 Sep 2009 11:13:29 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity) : Factor out common code processing the component type into... : Likewise. (gnat_to_gnu_component_type): ...this new static function. (maybe_pad_type): Minor cleanup. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152273 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 248 +++++++++++++++++-------------------------- 1 file changed, 98 insertions(+), 150 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 179418e8a95..3fb7c807614 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -130,9 +130,10 @@ static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool); static bool is_variable_size (tree); static tree elaborate_expression_1 (tree, Entity_Id, tree, bool, bool); static tree make_packable_type (tree, bool); -static tree gnat_to_gnu_field (Entity_Id, tree, int, bool, bool); +static tree gnat_to_gnu_component_type (Entity_Id, bool, bool); static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool, bool *); +static tree gnat_to_gnu_field (Entity_Id, tree, int, bool, bool); static bool same_discriminant_p (Entity_Id, Entity_Id); static bool array_type_has_nonaliased_component (Entity_Id, tree); static bool compile_time_known_address_p (Node_Id); @@ -1799,8 +1800,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tree gnu_fat_type = make_node (RECORD_TYPE); tree *gnu_index_types = (tree *) alloca (ndim * sizeof (tree)); tree *gnu_temp_fields = (tree *) alloca (ndim * sizeof (tree)); - tree gnu_max_size = size_one_node, gnu_max_size_unit; - tree gnu_comp_size, tem; + tree gnu_max_size = size_one_node, gnu_max_size_unit, tem; int index; TYPE_NAME (gnu_template_type) @@ -1946,73 +1946,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Now make the array of arrays and update the pointer to the array in the fat pointer. Note that it is the first field. */ - tem = gnat_to_gnu_type (Component_Type (gnat_entity)); - - /* Try to get a smaller form of the component if needed. */ - if ((Is_Packed (gnat_entity) - || Has_Component_Size_Clause (gnat_entity)) - && !Is_Bit_Packed_Array (gnat_entity) - && !Has_Aliased_Components (gnat_entity) - && !Strict_Alignment (Component_Type (gnat_entity)) - && TREE_CODE (tem) == RECORD_TYPE - && !TYPE_IS_FAT_POINTER_P (tem) - && host_integerp (TYPE_SIZE (tem), 1)) - tem = make_packable_type (tem, false); - - if (Has_Atomic_Components (gnat_entity)) - check_ok_for_atomic (tem, gnat_entity, true); - - /* Get and validate any specified Component_Size, but if Packed, - ignore it since the front end will have taken care of it. */ - gnu_comp_size - = validate_size (Component_Size (gnat_entity), tem, - gnat_entity, - (Is_Bit_Packed_Array (gnat_entity) - ? TYPE_DECL : VAR_DECL), - true, Has_Component_Size_Clause (gnat_entity)); - - /* If the component type is a RECORD_TYPE that has a self-referential - size, use the maximum size. */ - if (!gnu_comp_size - && TREE_CODE (tem) == RECORD_TYPE - && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (tem))) - gnu_comp_size = max_size (TYPE_SIZE (tem), true); - - if (gnu_comp_size && !Is_Bit_Packed_Array (gnat_entity)) - { - tree orig_tem = tem; - unsigned int max_align; - - /* If an alignment is specified, use it as a cap on the component - type so that it can be honored for the whole type. But ignore - it for the original type of packed array types. */ - if (No (Packed_Array_Type (gnat_entity)) - && Known_Alignment (gnat_entity)) - max_align = validate_alignment (Alignment (gnat_entity), - gnat_entity, 0); - else - max_align = 0; - - tem = make_type_from_size (tem, gnu_comp_size, false); - if (max_align > 0 && TYPE_ALIGN (tem) > max_align) - tem = orig_tem; - else - orig_tem = tem; - - tem = maybe_pad_type (tem, gnu_comp_size, 0, gnat_entity, - "C_PAD", false, definition, true); - - /* If a padding record was made, declare it now since it will - never be declared otherwise. This is necessary to ensure - that its subtrees are properly marked. */ - if (tem != orig_tem && !DECL_P (TYPE_NAME (tem))) - create_type_decl (TYPE_NAME (tem), tem, NULL, true, - debug_info_p, gnat_entity); - } - - if (Has_Volatile_Components (gnat_entity)) - tem = build_qualified_type (tem, - TYPE_QUALS (tem) | TYPE_QUAL_VOLATILE); + tem = gnat_to_gnu_component_type (gnat_entity, definition, + debug_info_p); /* If Component_Size is not already specified, annotate it with the size of the component. */ @@ -2356,9 +2291,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } else { - tree gnu_comp_size; - - gnu_type = gnat_to_gnu_type (Component_Type (gnat_entity)); + gnu_type = gnat_to_gnu_component_type (gnat_entity, definition, + debug_info_p); /* One of the above calls might have caused us to be elaborated, so don't blow up if so. */ @@ -2367,73 +2301,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) maybe_present = true; break; } - - /* Try to get a smaller form of the component if needed. */ - if ((Is_Packed (gnat_entity) - || Has_Component_Size_Clause (gnat_entity)) - && !Is_Bit_Packed_Array (gnat_entity) - && !Has_Aliased_Components (gnat_entity) - && !Strict_Alignment (Component_Type (gnat_entity)) - && TREE_CODE (gnu_type) == RECORD_TYPE - && !TYPE_IS_FAT_POINTER_P (gnu_type) - && host_integerp (TYPE_SIZE (gnu_type), 1)) - gnu_type = make_packable_type (gnu_type, false); - - /* Get and validate any specified Component_Size, but if Packed, - ignore it since the front end will have taken care of it. */ - gnu_comp_size - = validate_size (Component_Size (gnat_entity), gnu_type, - gnat_entity, - (Is_Bit_Packed_Array (gnat_entity) - ? TYPE_DECL : VAR_DECL), true, - Has_Component_Size_Clause (gnat_entity)); - - /* If the component type is a RECORD_TYPE that has a - self-referential size, use the maximum size. */ - if (!gnu_comp_size - && TREE_CODE (gnu_type) == RECORD_TYPE - && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))) - gnu_comp_size = max_size (TYPE_SIZE (gnu_type), true); - - if (gnu_comp_size && !Is_Bit_Packed_Array (gnat_entity)) - { - tree orig_type = gnu_type; - unsigned int max_align; - - /* If an alignment is specified, use it as a cap on the - component type so that it can be honored for the whole - type. But ignore it for the original type of packed - array types. */ - if (No (Packed_Array_Type (gnat_entity)) - && Known_Alignment (gnat_entity)) - max_align = validate_alignment (Alignment (gnat_entity), - gnat_entity, 0); - else - max_align = 0; - - gnu_type - = make_type_from_size (gnu_type, gnu_comp_size, false); - if (max_align > 0 && TYPE_ALIGN (gnu_type) > max_align) - gnu_type = orig_type; - else - orig_type = gnu_type; - - gnu_type = maybe_pad_type (gnu_type, gnu_comp_size, 0, - gnat_entity, "C_PAD", false, - definition, true); - - /* If a padding record was made, declare it now since it - will never be declared otherwise. This is necessary - to ensure that its subtrees are properly marked. */ - if (gnu_type != orig_type && !DECL_P (TYPE_NAME (gnu_type))) - create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL, - true, debug_info_p, gnat_entity); - } - - if (Has_Volatile_Components (Base_Type (gnat_entity))) - gnu_type = build_qualified_type (gnu_type, - (TYPE_QUALS (gnu_type) - | TYPE_QUAL_VOLATILE)); } /* Compute the maximum size of the array in units and bits. */ @@ -5091,6 +4958,84 @@ Gigi_Equivalent_Type (Entity_Id gnat_entity) return gnat_equiv; } +/* Return a GCC tree for a type corresponding to the component type of the + array type or subtype GNAT_ARRAY. DEFINITION is true if this component + is for an array being defined. DEBUG_INFO_P is true if we need to write + debug information for other types that we may create in the process. */ + +static tree +gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition, + bool debug_info_p) +{ + tree gnu_type = gnat_to_gnu_type (Component_Type (gnat_array)); + tree gnu_comp_size; + + /* Try to get a smaller form of the component if needed. */ + if ((Is_Packed (gnat_array) + || Has_Component_Size_Clause (gnat_array)) + && !Is_Bit_Packed_Array (gnat_array) + && !Has_Aliased_Components (gnat_array) + && !Strict_Alignment (Component_Type (gnat_array)) + && TREE_CODE (gnu_type) == RECORD_TYPE + && !TYPE_IS_FAT_POINTER_P (gnu_type) + && host_integerp (TYPE_SIZE (gnu_type), 1)) + gnu_type = make_packable_type (gnu_type, false); + + if (Has_Atomic_Components (gnat_array)) + check_ok_for_atomic (gnu_type, gnat_array, true); + + /* Get and validate any specified Component_Size. */ + gnu_comp_size + = validate_size (Component_Size (gnat_array), gnu_type, gnat_array, + Is_Bit_Packed_Array (gnat_array) ? TYPE_DECL : VAR_DECL, + true, Has_Component_Size_Clause (gnat_array)); + + /* If the component type is a RECORD_TYPE that has a self-referential size, + then use the maximum size for the component size. */ + if (!gnu_comp_size + && TREE_CODE (gnu_type) == RECORD_TYPE + && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))) + gnu_comp_size = max_size (TYPE_SIZE (gnu_type), true); + + /* Honor the component size. This is not needed for bit-packed arrays. */ + if (gnu_comp_size && !Is_Bit_Packed_Array (gnat_array)) + { + tree orig_type = gnu_type; + unsigned int max_align; + + /* If an alignment is specified, use it as a cap on the component type + so that it can be honored for the whole type. But ignore it for the + original type of packed array types. */ + if (No (Packed_Array_Type (gnat_array)) && Known_Alignment (gnat_array)) + max_align = validate_alignment (Alignment (gnat_array), gnat_array, 0); + else + max_align = 0; + + gnu_type = make_type_from_size (gnu_type, gnu_comp_size, false); + if (max_align > 0 && TYPE_ALIGN (gnu_type) > max_align) + gnu_type = orig_type; + else + orig_type = gnu_type; + + gnu_type = maybe_pad_type (gnu_type, gnu_comp_size, 0, gnat_array, + "C_PAD", false, definition, true); + + /* If a padding record was made, declare it now since it will never be + declared otherwise. This is necessary to ensure that its subtrees + are properly marked. */ + if (gnu_type != orig_type && !DECL_P (TYPE_NAME (gnu_type))) + create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL, true, + debug_info_p, gnat_array); + } + + if (Has_Volatile_Components (Base_Type (gnat_array))) + gnu_type + = build_qualified_type (gnu_type, + TYPE_QUALS (gnu_type) | TYPE_QUAL_VOLATILE); + + return gnu_type; +} + /* Return a GCC tree for a parameter corresponding to GNAT_PARAM and using MECH as its passing mechanism, to be placed in the parameter list built for GNAT_SUBPROG. Assume a foreign convention for the @@ -6263,7 +6208,8 @@ maybe_pad_type (tree type, tree size, unsigned int align, if (align) orig_size = round_up (orig_size, align); - if (size && Present (gnat_entity) + if (Present (gnat_entity) + && size && !operand_equal_p (size, orig_size, 0) && !(TREE_CODE (size) == INTEGER_CST && TREE_CODE (orig_size) == INTEGER_CST @@ -6284,15 +6230,17 @@ maybe_pad_type (tree type, tree size, unsigned int align, /* Generate message only for entities that come from source, since if we have an entity created by expansion, the message will be generated for some other corresponding source entity. */ - if (Comes_From_Source (gnat_entity) && Present (gnat_error_node)) - post_error_ne_tree ("{^ }bits of & unused?", gnat_error_node, - gnat_entity, - size_diffop (size, orig_size)); - - else if (*name_trailer == 'C' && !Is_Internal (gnat_entity)) - post_error_ne_tree ("component of& padded{ by ^ bits}?", - gnat_entity, gnat_entity, - size_diffop (size, orig_size)); + if (Comes_From_Source (gnat_entity)) + { + if (Present (gnat_error_node)) + post_error_ne_tree ("{^ }bits of & unused?", + gnat_error_node, gnat_entity, + size_diffop (size, orig_size)); + else if (name_trailer[0] == 'C') + post_error_ne_tree ("component of& padded{ by ^ bits}?", + gnat_entity, gnat_entity, + size_diffop (size, orig_size)); + } } return record; -- cgit v1.2.1 From a1d123c54fbba362e38258ca3445d86456fa3f67 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Fri, 2 Oct 2009 20:03:16 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_component_type): Force at least unit size for the component size of an array with aliased components. (maybe_pad_type): Do not warn for MAX_EXPR. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152417 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 3fb7c807614..22ee89e6675 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -4990,6 +4990,17 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition, Is_Bit_Packed_Array (gnat_array) ? TYPE_DECL : VAR_DECL, true, Has_Component_Size_Clause (gnat_array)); + /* If the array has aliased components and the component size can be zero, + force at least unit size to ensure that the components have distinct + addresses. */ + if (!gnu_comp_size + && Has_Aliased_Components (gnat_array) + && (integer_zerop (TYPE_SIZE (gnu_type)) + || (TREE_CODE (gnu_type) == ARRAY_TYPE + && !TREE_CONSTANT (TYPE_SIZE (gnu_type))))) + gnu_comp_size + = size_binop (MAX_EXPR, TYPE_SIZE (gnu_type), bitsize_unit_node); + /* If the component type is a RECORD_TYPE that has a self-referential size, then use the maximum size for the component size. */ if (!gnu_comp_size @@ -6210,6 +6221,7 @@ maybe_pad_type (tree type, tree size, unsigned int align, if (Present (gnat_entity) && size + && TREE_CODE (size) != MAX_EXPR && !operand_equal_p (size, orig_size, 0) && !(TREE_CODE (size) == INTEGER_CST && TREE_CODE (orig_size) == INTEGER_CST -- cgit v1.2.1 From f613feb7160e43eccf32d70587ec41d56a8f8946 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Fri, 2 Oct 2009 20:16:18 +0000 Subject: * gcc-interface/decl.c (check_ok_for_atomic): Do nothing if the type doesn't come from source. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152418 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 22ee89e6675..a6c1672e2ad 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -7868,6 +7868,11 @@ check_ok_for_atomic (tree object, Entity_Id gnat_entity, bool comp_p) OBJECT is either a type or a decl. */ if (TYPE_P (object)) { + /* If this is an anonymous base type, nothing to check. Error will be + reported on the source type. */ + if (!Comes_From_Source (gnat_entity)) + return; + mode = TYPE_MODE (object); align = TYPE_ALIGN (object); size = TYPE_SIZE (object); -- cgit v1.2.1 From 81e46691fb15869f252525781736e8234d2ba368 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Fri, 2 Oct 2009 20:30:59 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity) : Generate an XVZ variable alongside the XVS type if the size is not constant. (maybe_pad_type): Minor tweak. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152420 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index a6c1672e2ad..f2f0f159abd 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -3212,13 +3212,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Fill in locations of fields. */ annotate_rep (gnat_entity, gnu_type); - /* We've built a new type, make an XVS type to show what this - is a subtype of. Some debuggers require the XVS type to be - output first, so do it in that order. */ + /* If debugging information is being written for the type, write + a record that shows what we are a subtype of and also make a + variable that indicates our size, if still variable. */ if (debug_info_p) { tree gnu_subtype_marker = make_node (RECORD_TYPE); tree gnu_unpad_base_name = TYPE_NAME (gnu_unpad_base_type); + tree gnu_size_unit = TYPE_SIZE_UNIT (gnu_type); if (TREE_CODE (gnu_unpad_base_name) == TYPE_DECL) gnu_unpad_base_name = DECL_NAME (gnu_unpad_base_name); @@ -3236,6 +3237,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) add_parallel_type (TYPE_STUB_DECL (gnu_type), gnu_subtype_marker); + + if (definition + && TREE_CODE (gnu_size_unit) != INTEGER_CST + && !CONTAINS_PLACEHOLDER_P (gnu_size_unit)) + create_var_decl (create_concat_name (gnat_entity, "XVZ"), + NULL_TREE, sizetype, gnu_size_unit, false, + false, false, false, NULL, gnat_entity); } /* Now we can finalize it. */ @@ -6201,7 +6209,7 @@ maybe_pad_type (tree type, tree size, unsigned int align, add_parallel_type (TYPE_STUB_DECL (record), marker); - if (size && TREE_CODE (size) != INTEGER_CST && definition) + if (definition && size && TREE_CODE (size) != INTEGER_CST) create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype, TYPE_SIZE_UNIT (record), false, false, false, false, NULL, gnat_entity); -- cgit v1.2.1 From 0041ef00d8632d3c7b9738ef2d006558d30df62e Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Fri, 16 Oct 2009 19:28:52 +0000 Subject: * exp_dbug.ads: Adjust type names in comments. * gcc-interface/decl.c (maybe_pad_type): Remove NAME_TRAILER parameter, add new IS_COMPONENT_TYPE parameter. Adjust. Remove dead code. (gnat_to_gnu_entity): Adjust for above change. (gnat_to_gnu_component_type): Likewise. (gnat_to_gnu_field): Likewise. * gcc-interface/trans.c (call_to_gnu): Likewise. Do not unnecessarily call max_size. * gcc-interface/utils.c (finish_record_type): Remove obsolete code. * gcc-interface/gigi.h (maybe_pad_type): Adjust prototype. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152916 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 39 +++++++++++++++------------------------ 1 file changed, 15 insertions(+), 24 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index f2f0f159abd..afef46ec809 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -633,7 +633,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) else gnu_type = maybe_pad_type (gnu_type, NULL_TREE, align, gnat_entity, - "PAD", false, definition, true); + false, false, definition, true); } /* If we are defining the object, see if it has a Size value and @@ -838,7 +838,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_object_size = gnu_size ? gnu_size : TYPE_SIZE (gnu_type); if (gnu_size || align > 0) gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity, - "PAD", false, definition, + false, false, definition, gnu_size ? true : false); /* If this is a renaming, avoid as much as possible to create a new @@ -1017,8 +1017,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && !gnu_expr && TREE_CODE (gnu_type) == RECORD_TYPE && (TYPE_CONTAINS_TEMPLATE_P (gnu_type) - /* Beware that padding might have been introduced - via maybe_pad_type above. */ + /* Beware that padding might have been introduced above. */ || (TYPE_IS_PADDING_P (gnu_type) && TREE_CODE (TREE_TYPE (TYPE_FIELDS (gnu_type))) == RECORD_TYPE @@ -4446,7 +4445,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) us when we make the new TYPE_DECL below. */ if (gnu_size || align > 0) gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity, - "PAD", true, definition, false); + false, true, definition, false); if (TREE_CODE (gnu_type) == RECORD_TYPE && TYPE_IS_PADDING_P (gnu_type)) @@ -5037,7 +5036,7 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition, orig_type = gnu_type; gnu_type = maybe_pad_type (gnu_type, gnu_comp_size, 0, gnat_array, - "C_PAD", false, definition, true); + true, false, definition, true); /* If a padding record was made, declare it now since it will never be declared otherwise. This is necessary to ensure that its subtrees @@ -6046,25 +6045,20 @@ make_packable_type (tree type, bool in_record) /* Ensure that TYPE has SIZE and ALIGN. Make and return a new padded type if needed. We have already verified that SIZE and TYPE are large enough. - - GNAT_ENTITY and NAME_TRAILER are used to name the resulting record and - to issue a warning. - - IS_USER_TYPE is true if we must complete the original type. - - DEFINITION is true if this type is being defined. - - SAME_RM_SIZE is true if the RM size of the resulting type is to be set - to SIZE too; otherwise, it's set to the RM size of the original type. */ + GNAT_ENTITY is used to name the resulting record and to issue a warning. + IS_COMPONENT_TYPE is true if this is being done for the component type + of an array. IS_USER_TYPE is true if we must complete the original type. + DEFINITION is true if this type is being defined. SAME_RM_SIZE is true + if the RM size of the resulting type is to be set to SIZE too; otherwise, + it's set to the RM size of the original type. */ tree maybe_pad_type (tree type, tree size, unsigned int align, - Entity_Id gnat_entity, const char *name_trailer, + Entity_Id gnat_entity, bool is_component_type, bool is_user_type, bool definition, bool same_rm_size) { tree orig_rm_size = same_rm_size ? NULL_TREE : rm_size (type); tree orig_size = TYPE_SIZE (type); - unsigned int orig_align = align; tree record, field; /* If TYPE is a padded type, see if it agrees with any size and alignment @@ -6124,15 +6118,12 @@ maybe_pad_type (tree type, tree size, unsigned int align, TYPE_IS_PADDING_P (record) = 1; if (Present (gnat_entity)) - TYPE_NAME (record) = create_concat_name (gnat_entity, name_trailer); + TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD"); TYPE_VOLATILE (record) = Present (gnat_entity) && Treat_As_Volatile (gnat_entity); TYPE_ALIGN (record) = align; - if (orig_align) - TYPE_USER_ALIGN (record) = align; - TYPE_SIZE (record) = size ? size : orig_size; TYPE_SIZE_UNIT (record) = convert (sizetype, @@ -6256,7 +6247,7 @@ maybe_pad_type (tree type, tree size, unsigned int align, post_error_ne_tree ("{^ }bits of & unused?", gnat_error_node, gnat_entity, size_diffop (size, orig_size)); - else if (name_trailer[0] == 'C') + else if (is_component_type) post_error_ne_tree ("component of& padded{ by ^ bits}?", gnat_entity, gnat_entity, size_diffop (size, orig_size)); @@ -6634,7 +6625,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, orig_field_type = gnu_field_type; gnu_field_type = maybe_pad_type (gnu_field_type, gnu_size, 0, gnat_field, - "PAD", false, definition, true); + false, false, definition, true); /* If a padding record was made, declare it now since it will never be declared otherwise. This is necessary to ensure that its subtrees -- cgit v1.2.1 From a98f6becc1a2d108e170f816c1a9aebb3cb618df Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Fri, 16 Oct 2009 20:07:52 +0000 Subject: * gcc-interface/ada-tree.h (TYPE_FAT_POINTER_P): Swap with... (TYPE_IS_FAT_POINTER_P): ...this. (TYPE_THIN_POINTER_P): Rename into... (TYPE_IS_THIN_POINTER_P): ...this. (TYPE_FAT_OR_THIN_POINTER_P): Rename into... (TYPE_IS_FAT_OR_THIN_POINTER_P): ...this. (TYPE_IS_PADDING_P): Change definition, move old one to... (TYPE_PADDING_P): ...this. * gcc-interface/decl.c (gnat_to_gnu_entity): Adjust for above changes. (get_unpadded_type): Likewise. (gnat_to_gnu_component_type): Likewise. (gnat_to_gnu_param): Likewise. (relate_alias_sets): Likewise. (make_packable_type): Likewise. (maybe_pad_type): Likewise. (gnat_to_gnu_field): Likewise. (is_variable_size): Likewise. (annotate_object): Likewise. (validate_size): Likewise. (set_rm_size): Likewise. (make_type_from_size): Likewise. (rm_size): Likewise. * gcc-interface/misc.c (gnat_print_type): Likewise. (gnat_get_alias_set): Likewise. * gcc-interface/trans.c (Identifier_to_gnu): Likewise. (Attribute_to_gnu): Likewise. (call_to_gnu): Likewise. (gnat_to_gnu): Likewise. (add_decl_expr): Likewise. (convert_with_check): Likewise. (addressable_p): Likewise. (maybe_implicit_deref): Likewise. (protect_multiple_eval): Likewise. (gnat_stabilize_reference_1): Likewise. * gcc-interface/utils.c (gnat_pushdecl): Likewise. (finish_record_type): Likewise. (rest_of_record_type_compilation): Likewise. (create_type_decl): Likewise. (gnat_types_compatible_p): Likewise. (build_template): Likewise. (convert_vms_descriptor64): Likewise. (convert_vms_descriptor32): Likewise. (build_unc_object_type_from_ptr): Likewise. (update_pointer_to): Likewise. (convert_to_fat_pointer): Likewise. (convert_to_fat_pointer): Likewise. (convert): Likewise. (remove_conversions): Likewise. (maybe_unconstrained_array): Likewise. (unchecked_convert): Likewise. (handle_vector_type_attribute): Likewise. * gcc-interface/utils2.c (build_binary_op): Likewise. (build_unary_op): Likewise. (build_allocator): Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152917 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 101 ++++++++++++++++++------------------------- 1 file changed, 43 insertions(+), 58 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index afef46ec809..a2af1798170 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -676,8 +676,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) despite having a nominal type with self-referential size, we can get the size directly from it. */ if (TREE_CODE (gnu_expr) == COMPONENT_REF - && TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_expr, 0))) - == RECORD_TYPE && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_expr, 0))) && TREE_CODE (TREE_OPERAND (gnu_expr, 0)) == VAR_DECL @@ -852,8 +850,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* If the renamed object had padding, strip off the reference to the inner object and reset our type. */ if ((TREE_CODE (gnu_expr) == COMPONENT_REF - && TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_expr, 0))) - == RECORD_TYPE && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_expr, 0)))) /* Strip useless conversions around the object. */ || (TREE_CODE (gnu_expr) == NOP_EXPR @@ -1018,14 +1014,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && TREE_CODE (gnu_type) == RECORD_TYPE && (TYPE_CONTAINS_TEMPLATE_P (gnu_type) /* Beware that padding might have been introduced above. */ - || (TYPE_IS_PADDING_P (gnu_type) + || (TYPE_PADDING_P (gnu_type) && TREE_CODE (TREE_TYPE (TYPE_FIELDS (gnu_type))) == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (TYPE_FIELDS (gnu_type)))))) { tree template_field - = TYPE_IS_PADDING_P (gnu_type) + = TYPE_PADDING_P (gnu_type) ? TYPE_FIELDS (TREE_TYPE (TYPE_FIELDS (gnu_type))) : TYPE_FIELDS (gnu_type); @@ -1049,17 +1045,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (gnu_expr && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)) - && !(TREE_CODE (gnu_type) == RECORD_TYPE - && TYPE_IS_PADDING_P (gnu_type) - && (CONTAINS_PLACEHOLDER_P - (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type))))))) + && !(TYPE_IS_PADDING_P (gnu_type) + && CONTAINS_PLACEHOLDER_P + (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))) gnu_expr = convert (gnu_type, gnu_expr); /* If this is a pointer and it does not have an initializing expression, initialize it to NULL, unless the object is imported. */ if (definition - && (POINTER_TYPE_P (gnu_type) || TYPE_FAT_POINTER_P (gnu_type)) + && (POINTER_TYPE_P (gnu_type) || TYPE_IS_FAT_POINTER_P (gnu_type)) && !Is_Imported (gnat_entity) && !gnu_expr) gnu_expr = integer_zero_node; @@ -1278,10 +1273,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (gnu_expr && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)) - && !(TREE_CODE (gnu_type) == RECORD_TYPE - && TYPE_IS_PADDING_P (gnu_type) - && (CONTAINS_PLACEHOLDER_P - (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type))))))) + && !(TYPE_IS_PADDING_P (gnu_type) + && CONTAINS_PLACEHOLDER_P + (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))) gnu_expr = convert (gnu_type, gnu_expr); /* If this name is external or there was a name specified, use it, @@ -1303,8 +1297,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && gnu_expr && TREE_CONSTANT (gnu_expr) && AGGREGATE_TYPE_P (gnu_type) && host_integerp (TYPE_SIZE_UNIT (gnu_type), 1) - && !(TREE_CODE (gnu_type) == RECORD_TYPE - && TYPE_IS_PADDING_P (gnu_type) + && !(TYPE_IS_PADDING_P (gnu_type) && !host_integerp (TYPE_SIZE_UNIT (TREE_TYPE (TYPE_FIELDS (gnu_type))), 1))) static_p = true; @@ -1686,7 +1679,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_field_type, gnu_type, 1, 0, 0, 0); finish_record_type (gnu_type, gnu_field, 0, false); - TYPE_IS_PADDING_P (gnu_type) = 1; + TYPE_PADDING_P (gnu_type) = 1; relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY); } @@ -1834,7 +1827,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Do not finalize this record type since the types of its fields are still incomplete at this point. */ finish_record_type (gnu_fat_type, tem, 0, true); - TYPE_IS_FAT_POINTER_P (gnu_fat_type) = 1; + TYPE_FAT_POINTER_P (gnu_fat_type) = 1; /* Build a reference to the template from a PLACEHOLDER_EXPR that is the fat pointer. This will be used to access the individual @@ -2476,7 +2469,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_inner = gnu_type; while (TREE_CODE (gnu_inner) == RECORD_TYPE && (TYPE_JUSTIFIED_MODULAR_P (gnu_inner) - || TYPE_IS_PADDING_P (gnu_inner))) + || TYPE_PADDING_P (gnu_inner))) gnu_inner = TREE_TYPE (TYPE_FIELDS (gnu_inner)); /* We need to attach the index type to the type we just made so @@ -2985,8 +2978,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) copy_and_substitute_in_size (gnu_type, gnu_base_type, gnu_subst_list); - if (TREE_CODE (gnu_base_type) == RECORD_TYPE - && TYPE_IS_PADDING_P (gnu_base_type)) + if (TYPE_IS_PADDING_P (gnu_base_type)) gnu_unpad_base_type = TREE_TYPE (TYPE_FIELDS (gnu_base_type)); else gnu_unpad_base_type = gnu_base_type; @@ -3096,7 +3088,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { gnu_size = DECL_SIZE (gnu_old_field); if (TREE_CODE (gnu_field_type) == RECORD_TYPE - && !TYPE_IS_FAT_POINTER_P (gnu_field_type) + && !TYPE_FAT_POINTER_P (gnu_field_type) && host_integerp (TYPE_SIZE (gnu_field_type), 1)) gnu_field_type = make_packable_type (gnu_field_type, true); @@ -3464,7 +3456,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Make sure we can place this into a register. */ TYPE_ALIGN (gnu_type) = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE); - TYPE_IS_FAT_POINTER_P (gnu_type) = 1; + TYPE_FAT_POINTER_P (gnu_type) = 1; /* Do not finalize this record type since the types of its fields are incomplete. */ @@ -3598,11 +3590,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if ((! in_main_unit || is_from_limited_with) && made_dummy) { tree gnu_old_type - = TYPE_FAT_POINTER_P (gnu_type) + = TYPE_IS_FAT_POINTER_P (gnu_type) ? TYPE_UNCONSTRAINED_ARRAY (gnu_type) : TREE_TYPE (gnu_type); if (esize == POINTER_SIZE - && (got_fat_p || TYPE_FAT_POINTER_P (gnu_type))) + && (got_fat_p || TYPE_IS_FAT_POINTER_P (gnu_type))) gnu_type = build_pointer_type (TYPE_OBJECT_RECORD_TYPE @@ -3914,8 +3906,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* If the type is a padded type and the underlying type would not be passed by reference or this function has a foreign convention, return the underlying type. */ - else if (TREE_CODE (gnu_return_type) == RECORD_TYPE - && TYPE_IS_PADDING_P (gnu_return_type) + else if (TYPE_IS_PADDING_P (gnu_return_type) && (!default_pass_by_ref (TREE_TYPE (TYPE_FIELDS (gnu_return_type))) || Has_Foreign_Convention (gnat_entity))) @@ -4053,7 +4044,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) between two calls, so they can't be CSE'ed. The latter case also handles by-ref parameters. */ if (POINTER_TYPE_P (gnu_param_type) - || TYPE_FAT_POINTER_P (gnu_param_type)) + || TYPE_IS_FAT_POINTER_P (gnu_param_type)) const_flag = false; } @@ -4416,7 +4407,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) else if ((TREE_CODE (gnu_type) == RECORD_TYPE || TREE_CODE (gnu_type) == UNION_TYPE || TREE_CODE (gnu_type) == QUAL_UNION_TYPE) - && !TYPE_IS_FAT_POINTER_P (gnu_type)) + && !TYPE_FAT_POINTER_P (gnu_type)) size = rm_size (gnu_type); else size = TYPE_SIZE (gnu_type); @@ -4447,8 +4438,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity, false, true, definition, false); - if (TREE_CODE (gnu_type) == RECORD_TYPE - && TYPE_IS_PADDING_P (gnu_type)) + if (TYPE_IS_PADDING_P (gnu_type)) { gnu_entity_name = TYPE_NAME (gnu_type); if (TREE_CODE (gnu_entity_name) == TYPE_DECL) @@ -4704,8 +4694,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tree gnu_low_bound, gnu_high_bound; /* If this is a padded type, we need to use the underlying type. */ - if (TREE_CODE (gnu_scalar_type) == RECORD_TYPE - && TYPE_IS_PADDING_P (gnu_scalar_type)) + if (TYPE_IS_PADDING_P (gnu_scalar_type)) gnu_scalar_type = TREE_TYPE (TYPE_FIELDS (gnu_scalar_type)); /* If this is a floating point type and we haven't set a floating @@ -4851,7 +4840,7 @@ get_unpadded_type (Entity_Id gnat_entity) { tree type = gnat_to_gnu_type (gnat_entity); - if (TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type)) + if (TYPE_IS_PADDING_P (type)) type = TREE_TYPE (TYPE_FIELDS (type)); return type; @@ -4984,7 +4973,7 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition, && !Has_Aliased_Components (gnat_array) && !Strict_Alignment (Component_Type (gnat_array)) && TREE_CODE (gnu_type) == RECORD_TYPE - && !TYPE_IS_FAT_POINTER_P (gnu_type) + && !TYPE_FAT_POINTER_P (gnu_type) && host_integerp (TYPE_SIZE (gnu_type), 1)) gnu_type = make_packable_type (gnu_type, false); @@ -5088,8 +5077,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech, /* If this is either a foreign function or if the underlying type won't be passed by reference, strip off possible padding type. */ - if (TREE_CODE (gnu_param_type) == RECORD_TYPE - && TYPE_IS_PADDING_P (gnu_param_type)) + if (TYPE_IS_PADDING_P (gnu_param_type)) { tree unpadded_type = TREE_TYPE (TYPE_FIELDS (gnu_param_type)); @@ -5161,7 +5149,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech, } /* Fat pointers are passed as thin pointers for foreign conventions. */ - else if (foreign && TYPE_FAT_POINTER_P (gnu_param_type)) + else if (foreign && TYPE_IS_FAT_POINTER_P (gnu_param_type)) gnu_param_type = make_type_from_size (gnu_param_type, size_int (POINTER_SIZE), 0); @@ -5462,7 +5450,7 @@ relate_alias_sets (tree gnu_new_type, tree gnu_old_type, enum alias_set_op op) see the inner types. */ while (TREE_CODE (gnu_old_type) == RECORD_TYPE && (TYPE_JUSTIFIED_MODULAR_P (gnu_old_type) - || TYPE_IS_PADDING_P (gnu_old_type))) + || TYPE_PADDING_P (gnu_old_type))) gnu_old_type = TREE_TYPE (TYPE_FIELDS (gnu_old_type)); /* Unconstrained array types are deemed incomplete and would thus be given @@ -5928,7 +5916,7 @@ make_packable_type (tree type, bool in_record) TYPE_JUSTIFIED_MODULAR_P (new_type) = TYPE_JUSTIFIED_MODULAR_P (type); TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type); if (TREE_CODE (type) == RECORD_TYPE) - TYPE_IS_PADDING_P (new_type) = TYPE_IS_PADDING_P (type); + TYPE_PADDING_P (new_type) = TYPE_PADDING_P (type); /* If we are in a record and have a small size, set the alignment to try for an integral mode. Otherwise set it to try for a smaller @@ -5971,7 +5959,7 @@ make_packable_type (tree type, bool in_record) if ((TREE_CODE (new_field_type) == RECORD_TYPE || TREE_CODE (new_field_type) == UNION_TYPE || TREE_CODE (new_field_type) == QUAL_UNION_TYPE) - && !TYPE_IS_FAT_POINTER_P (new_field_type) + && !TYPE_FAT_POINTER_P (new_field_type) && host_integerp (TYPE_SIZE (new_field_type), 1)) new_field_type = make_packable_type (new_field_type, true); @@ -5983,7 +5971,7 @@ make_packable_type (tree type, bool in_record) && (TREE_CODE (new_field_type) == RECORD_TYPE || TREE_CODE (new_field_type) == UNION_TYPE || TREE_CODE (new_field_type) == QUAL_UNION_TYPE) - && !TYPE_IS_FAT_POINTER_P (new_field_type) + && !TYPE_FAT_POINTER_P (new_field_type) && !TYPE_CONTAINS_TEMPLATE_P (new_field_type) && TYPE_ADA_SIZE (new_field_type)) new_size = TYPE_ADA_SIZE (new_field_type); @@ -6012,8 +6000,7 @@ make_packable_type (tree type, bool in_record) /* If this is a padding record, we never want to make the size smaller than what was specified. For QUAL_UNION_TYPE, also copy the size. */ - if ((TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type)) - || TREE_CODE (type) == QUAL_UNION_TYPE) + if (TYPE_IS_PADDING_P (type) || TREE_CODE (type) == QUAL_UNION_TYPE) { TYPE_SIZE (new_type) = TYPE_SIZE (type); TYPE_SIZE_UNIT (new_type) = TYPE_SIZE_UNIT (type); @@ -6066,7 +6053,7 @@ maybe_pad_type (tree type, tree size, unsigned int align, off the padding, since we will either be returning the inner type or repadding it. If no size or alignment is specified, use that of the original padded type. */ - if (TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type)) + if (TYPE_IS_PADDING_P (type)) { if ((!size || operand_equal_p (round_up (size, @@ -6115,7 +6102,7 @@ maybe_pad_type (tree type, tree size, unsigned int align, generate incorrect debugging information. So make a new record type and name. */ record = make_node (RECORD_TYPE); - TYPE_IS_PADDING_P (record) = 1; + TYPE_PADDING_P (record) = 1; if (Present (gnat_entity)) TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD"); @@ -6438,7 +6425,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, from a component clause. */ if (TREE_CODE (gnu_field_type) == RECORD_TYPE - && !TYPE_IS_FAT_POINTER_P (gnu_field_type) + && !TYPE_FAT_POINTER_P (gnu_field_type) && host_integerp (TYPE_SIZE (gnu_field_type), 1) && (packed == 1 || (gnu_size @@ -6668,8 +6655,7 @@ is_variable_size (tree type) if (!TREE_CONSTANT (TYPE_SIZE (type))) return true; - if (TREE_CODE (type) == RECORD_TYPE - && TYPE_IS_PADDING_P (type) + if (TYPE_IS_PADDING_P (type) && !TREE_CONSTANT (DECL_SIZE (TYPE_FIELDS (type)))) return true; @@ -7218,7 +7204,7 @@ annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref) { if (by_ref) { - if (TYPE_FAT_POINTER_P (gnu_type)) + if (TYPE_IS_FAT_POINTER_P (gnu_type)) gnu_type = TYPE_UNCONSTRAINED_ARRAY (gnu_type); else gnu_type = TREE_TYPE (gnu_type); @@ -7533,7 +7519,7 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, /* If this is an access type or a fat pointer, the minimum size is that given by the smallest integral mode that's valid for pointers. */ - if ((TREE_CODE (gnu_type) == POINTER_TYPE) || TYPE_FAT_POINTER_P (gnu_type)) + if (TREE_CODE (gnu_type) == POINTER_TYPE || TYPE_IS_FAT_POINTER_P (gnu_type)) { enum machine_mode p_mode; @@ -7627,8 +7613,7 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity) || (AGGREGATE_TYPE_P (gnu_type) && !(TREE_CODE (gnu_type) == ARRAY_TYPE && TYPE_PACKED_ARRAY_TYPE_P (gnu_type)) - && !(TREE_CODE (gnu_type) == RECORD_TYPE - && TYPE_IS_PADDING_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)))) && tree_int_cst_lt (size, old_size))) @@ -7651,7 +7636,7 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity) else if ((TREE_CODE (gnu_type) == RECORD_TYPE || TREE_CODE (gnu_type) == UNION_TYPE || TREE_CODE (gnu_type) == QUAL_UNION_TYPE) - && !TYPE_IS_FAT_POINTER_P (gnu_type)) + && !TYPE_FAT_POINTER_P (gnu_type)) SET_TYPE_ADA_SIZE (gnu_type, size); } @@ -7718,7 +7703,7 @@ make_type_from_size (tree type, tree size_tree, bool for_biased) case RECORD_TYPE: /* Do something if this is a fat pointer, in which case we may need to return the thin pointer. */ - if (TYPE_IS_FAT_POINTER_P (type) && size < POINTER_SIZE * 2) + if (TYPE_FAT_POINTER_P (type) && size < POINTER_SIZE * 2) { enum machine_mode p_mode = mode_for_size (size, MODE_INT, 0); if (!targetm.valid_pointer_mode (p_mode)) @@ -7733,7 +7718,7 @@ make_type_from_size (tree type, tree size_tree, bool for_biased) case POINTER_TYPE: /* Only do something if this is a thin pointer, in which case we may need to return the fat pointer. */ - if (TYPE_THIN_POINTER_P (type) && size >= POINTER_SIZE * 2) + if (TYPE_IS_THIN_POINTER_P (type) && size >= POINTER_SIZE * 2) return build_pointer_type (TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type))); break; @@ -8384,7 +8369,7 @@ rm_size (tree gnu_type) if ((TREE_CODE (gnu_type) == RECORD_TYPE || TREE_CODE (gnu_type) == UNION_TYPE || TREE_CODE (gnu_type) == QUAL_UNION_TYPE) - && !TYPE_IS_FAT_POINTER_P (gnu_type) + && !TYPE_FAT_POINTER_P (gnu_type) && TYPE_ADA_SIZE (gnu_type)) return TYPE_ADA_SIZE (gnu_type); -- cgit v1.2.1 From 5df12a52b3ff97d5aae2c652f76cc7aad3714785 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Wed, 21 Oct 2009 10:12:55 +0000 Subject: * gcc-interfaces/decl.c (gnat_to_gnu_entity): Do not create a new TYPE_DECL when a type is padded if there is already one and reset TYPE_STUB_DECL in this case. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@153053 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index a2af1798170..70ced844fb6 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -4436,7 +4436,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) us when we make the new TYPE_DECL below. */ if (gnu_size || align > 0) gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity, - false, true, definition, false); + false, !gnu_decl, definition, false); if (TYPE_IS_PADDING_P (gnu_type)) { @@ -4555,7 +4555,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) !Comes_From_Source (gnat_entity), debug_info_p, gnat_entity); else - TREE_TYPE (gnu_decl) = gnu_type; + { + TREE_TYPE (gnu_decl) = gnu_type; + TYPE_STUB_DECL (gnu_type) = gnu_decl; + } } if (is_type && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))) -- cgit v1.2.1 From 7c2043153fcc668b6b4465f9f66490144a4d3445 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Wed, 21 Oct 2009 10:20:06 +0000 Subject: * gcc-interfaces/decl.c (build_subst_list): Convert the expression of the constraint to the type of the discriminant. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@153054 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 70ced844fb6..d0b52f2e745 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -7374,12 +7374,16 @@ build_subst_list (Entity_Id gnat_subtype, Entity_Id gnat_type, bool definition) gnat_value = Next_Elmt (gnat_value)) /* Ignore access discriminants. */ if (!Is_Access_Type (Etype (Node (gnat_value)))) - gnu_list = tree_cons (gnat_to_gnu_field_decl (gnat_discrim), - elaborate_expression - (Node (gnat_value), gnat_subtype, - get_entity_name (gnat_discrim), definition, - true, false), - gnu_list); + { + tree gnu_field = gnat_to_gnu_field_decl (gnat_discrim); + gnu_list = tree_cons (gnu_field, + convert (TREE_TYPE (gnu_field), + elaborate_expression + (Node (gnat_value), gnat_subtype, + get_entity_name (gnat_discrim), + definition, true, false)), + gnu_list); + } return gnu_list; } -- cgit v1.2.1 From b10509f2bbb8bc9c926f16dadff0e1d55bdf9807 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sat, 24 Oct 2009 11:12:21 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity) : When processing the parent type, build the COMPONENT_REF for a discriminant with the proper type. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@153528 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index d0b52f2e745..6abb366bd07 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -2729,15 +2729,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) Present (gnat_field); gnat_field = Next_Stored_Discriminant (gnat_field)) if (Present (Corresponding_Discriminant (gnat_field))) - save_gnu_tree - (gnat_field, - build3 (COMPONENT_REF, - get_unpadded_type (Etype (gnat_field)), - gnu_get_parent, - gnat_to_gnu_field_decl (Corresponding_Discriminant - (gnat_field)), - NULL_TREE), - true); + { + tree gnu_field + = gnat_to_gnu_field_decl (Corresponding_Discriminant + (gnat_field)); + save_gnu_tree + (gnat_field, + build3 (COMPONENT_REF, TREE_TYPE (gnu_field), + gnu_get_parent, gnu_field, NULL_TREE), + true); + } /* Then we build the parent subtype. If it has discriminants but the type itself has unknown discriminants, this means that it -- cgit v1.2.1 From eb98f615b8c7a1b60815c969f552ea7d6d701c56 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Tue, 27 Oct 2009 20:24:31 +0000 Subject: * gcc-interface/decl.c (purpose_member_field): New static function. (annotate_rep): Use it instead of purpose_member. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@153616 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 6abb366bd07..c3766ee99b7 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -7231,6 +7231,23 @@ annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref) UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT)); } +/* Return first element of field list whose TREE_PURPOSE is ELEM or whose + DECL_ORIGINAL_FIELD of TREE_PURPOSE is ELEM. Return NULL_TREE if there + is no such element in the list. */ + +static tree +purpose_member_field (const_tree elem, tree list) +{ + while (list) + { + tree field = TREE_PURPOSE (list); + if (elem == field || elem == DECL_ORIGINAL_FIELD (field)) + return list; + list = TREE_CHAIN (list); + } + return NULL_TREE; +} + /* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding GCC type, set Component_Bit_Offset and Esize of the components to the position and size used by Gigi. */ @@ -7254,11 +7271,12 @@ annotate_rep (Entity_Id gnat_entity, tree gnu_type) || (Ekind (gnat_field) == E_Discriminant && !Is_Unchecked_Union (Scope (gnat_field)))) { - tree parent_offset, t; - - t = purpose_member (gnat_to_gnu_field_decl (gnat_field), gnu_list); + tree t = purpose_member_field (gnat_to_gnu_field_decl (gnat_field), + gnu_list); if (t) { + tree parent_offset; + if (type_annotate_only && Is_Tagged_Type (gnat_entity)) { /* In this mode the tag and parent components are not -- cgit v1.2.1 From 88ac43b96583fa07755340e470245865ece3524a Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Thu, 29 Oct 2009 18:28:49 +0000 Subject: * gcc-interface/decl.c (array_type_has_nonaliased_component): Swap parameters and rewrite comments. For a derived type, return the setting of its parent type. (gnat_to_gnu_entity): Do an alias set copy for derived types if they are composite. Adjust calls to above function. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@153721 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 64 +++++++++++++++++++++++++++++++++++++------- 1 file changed, 54 insertions(+), 10 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index c3766ee99b7..cd13e21710c 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -135,7 +135,7 @@ static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool, bool *); static tree gnat_to_gnu_field (Entity_Id, tree, int, bool, bool); static bool same_discriminant_p (Entity_Id, Entity_Id); -static bool array_type_has_nonaliased_component (Entity_Id, tree); +static bool array_type_has_nonaliased_component (tree, Entity_Id); static bool compile_time_known_address_p (Node_Id); static bool cannot_be_superflat_p (Node_Id); static void components_to_record (tree, Node_Id, tree, int, bool, tree *, @@ -1963,7 +1963,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { tem = build_array_type (tem, gnu_index_types[index]); TYPE_MULTI_ARRAY_P (tem) = (index > 0); - if (array_type_has_nonaliased_component (gnat_entity, tem)) + if (array_type_has_nonaliased_component (tem, gnat_entity)) TYPE_NONALIASED_COMPONENT (tem) = 1; } @@ -2312,7 +2312,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { gnu_type = build_array_type (gnu_type, gnu_index_types[index]); TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0); - if (array_type_has_nonaliased_component (gnat_entity, gnu_type)) + if (array_type_has_nonaliased_component (gnu_type, gnat_entity)) TYPE_NONALIASED_COMPONENT (gnu_type) = 1; } @@ -2563,7 +2563,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = build_array_type (gnat_to_gnu_type (Component_Type (gnat_entity)), gnu_index_type); - if (array_type_has_nonaliased_component (gnat_entity, gnu_type)) + if (array_type_has_nonaliased_component (gnu_type, gnat_entity)) TYPE_NONALIASED_COMPONENT (gnu_type) = 1; relate_alias_sets (gnu_type, gnu_string_type, ALIAS_SET_COPY); } @@ -4602,11 +4602,38 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) superset superset R ----------> D ----------> T + However, for composite types, conversions between derived types are + translated into VIEW_CONVERT_EXPRs so a sequence like: + + type Comp1 is new Comp; + type Comp2 is new Comp; + procedure Proc (C : Comp1); + + C : Comp2; + Proc (Comp1 (C)); + + is translated into: + + C : Comp2; + Proc ((Comp1 &) &VIEW_CONVERT_EXPR (C)); + + and gimplified into: + + C : Comp2; + Comp1 *C.0; + C.0 = (Comp1 *) &C; + Proc (C.0); + + i.e. generates code involving type punning. Therefore, Comp1 needs + to conflict with Comp2 and an alias set copy is required. + The language rules ensure the parent type is already frozen here. */ if (Is_Derived_Type (gnat_entity)) { tree gnu_parent_type = gnat_to_gnu_type (Etype (gnat_entity)); - relate_alias_sets (gnu_type, gnu_parent_type, ALIAS_SET_SUPERSET); + relate_alias_sets (gnu_type, gnu_parent_type, + Is_Composite_Type (gnat_entity) + ? ALIAS_SET_COPY : ALIAS_SET_SUPERSET); } /* Back-annotate the Alignment of the type if not already in the @@ -5254,21 +5281,38 @@ same_discriminant_p (Entity_Id discr1, Entity_Id discr2) Original_Record_Component (discr1) == Original_Record_Component (discr2); } -/* Return true if the array type specified by GNAT_TYPE and GNU_TYPE has - a non-aliased component in the back-end sense. */ +/* Return true if the array type GNU_TYPE, which represents a dimension of + GNAT_TYPE, has a non-aliased component in the back-end sense. */ static bool -array_type_has_nonaliased_component (Entity_Id gnat_type, tree gnu_type) +array_type_has_nonaliased_component (tree gnu_type, Entity_Id gnat_type) { - /* If the type below this is a multi-array type, then - this does not have aliased components. */ + /* If the array type is not the innermost dimension of the GNAT type, + then it has a non-aliased component. */ if (TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type))) return true; + /* If the array type has an aliased component in the front-end sense, + then it also has an aliased component in the back-end sense. */ if (Has_Aliased_Components (gnat_type)) return false; + /* If this is a derived type, then it has a non-aliased component if + and only if its parent type also has one. */ + if (Is_Derived_Type (gnat_type)) + { + tree gnu_parent_type = gnat_to_gnu_type (Etype (gnat_type)); + int index; + if (TREE_CODE (gnu_parent_type) == UNCONSTRAINED_ARRAY_TYPE) + gnu_parent_type + = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_parent_type)))); + for (index = Number_Dimensions (gnat_type) - 1; index > 0; index--) + gnu_parent_type = TREE_TYPE (gnu_parent_type); + return TYPE_NONALIASED_COMPONENT (gnu_parent_type); + } + + /* Otherwise, rely exclusively on properties of the element type. */ return type_for_nonaliased_component_p (TREE_TYPE (gnu_type)); } -- cgit v1.2.1 From 66adaa2172071bd15fcb9cd5281e46f72ffc6434 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Thu, 29 Oct 2009 18:36:21 +0000 Subject: * gcc-interface/decl.c (make_type_from_size) : Do not create integer types with precision 0. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@153722 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index cd13e21710c..c4d5e26582a 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -7737,6 +7737,10 @@ make_type_from_size (tree type, tree size_tree, bool for_biased) biased_p = (TREE_CODE (type) == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type)); + /* Integer types with precision 0 are forbidden. */ + if (size == 0) + size = 1; + /* Only do something if the type is not a packed array type and doesn't already have the proper size. */ if (TYPE_PACKED_ARRAY_TYPE_P (type) -- cgit v1.2.1 From 42173a9a36734023d716031d07bbb74fef23ae19 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sun, 8 Nov 2009 12:17:51 +0000 Subject: * gcc-interface/decl.c (make_packable_type): Fix oversight. (gnat_to_gnu_field): Do not attempt to change the form of the type if the field requires strict alignment. Always change the form of the type if the specified size is smaller than its size. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154009 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 70 +++++++++++++++----------------------------- 1 file changed, 24 insertions(+), 46 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index c4d5e26582a..9e643a3108b 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -6052,6 +6052,7 @@ make_packable_type (tree type, bool in_record) { TYPE_SIZE (new_type) = TYPE_SIZE (type); TYPE_SIZE_UNIT (new_type) = TYPE_SIZE_UNIT (type); + new_size = size; } else { @@ -6449,67 +6450,44 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, else gnu_size = NULL_TREE; - /* If we have a specified size that's smaller than that of the field type, - or a position is specified, and the field type is a record, see if we can - get either an integral mode form of the type or a smaller form. If we - can, show a size was specified for the field if there wasn't one already, - so we know to make this a bitfield and avoid making things wider. + /* If we have a specified size that is smaller than that of the field's type, + or a position is specified, and the field's type is a record that doesn't + require strict alignment, see if we can get either an integral mode form + of the type or a smaller form. If we can, show a size was specified for + the field if there wasn't one already, so we know to make this a bitfield + and avoid making things wider. - Doing this is first useful if the record is packed because we may then - place the field at a non-byte-aligned position and so achieve tighter - packing. + Changing to an integral mode form is useful when the record is packed as + we can then place the field at a non-byte-aligned position and so achieve + tighter packing. This is in addition required if the field shares a byte + with another field and the front-end lets the back-end handle the access + to the field, because GCC cannot handle non-byte-aligned BLKmode fields. - This is in addition *required* if the field shares a byte with another - field and the front-end lets the back-end handle the references, because - GCC does not handle BLKmode bitfields properly. + Changing to a smaller form is required if the specified size is smaller + than that of the field's type and the type contains sub-fields that are + padded, in order to avoid generating accesses to these sub-fields that + are wider than the field. We avoid the transformation if it is not required or potentially useful, as it might entail an increase of the field's alignment and have ripple effects on the outer record type. A typical case is a field known to be - byte aligned and not to share a byte with another field. - - Besides, we don't even look the possibility of a transformation in cases - known to be in error already, for instance when an invalid size results - from a component clause. */ - - if (TREE_CODE (gnu_field_type) == RECORD_TYPE + byte-aligned and not to share a byte with another field. */ + if (!needs_strict_alignment + && TREE_CODE (gnu_field_type) == RECORD_TYPE && !TYPE_FAT_POINTER_P (gnu_field_type) && host_integerp (TYPE_SIZE (gnu_field_type), 1) && (packed == 1 || (gnu_size && (tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type)) - || Present (Component_Clause (gnat_field)))))) + || (Present (Component_Clause (gnat_field)) + && !(UI_To_Int (Component_Bit_Offset (gnat_field)) + % BITS_PER_UNIT == 0 + && value_factor_p (gnu_size, BITS_PER_UNIT))))))) { - /* See what the alternate type and size would be. */ tree gnu_packable_type = make_packable_type (gnu_field_type, true); - - bool has_byte_aligned_clause - = Present (Component_Clause (gnat_field)) - && (UI_To_Int (Component_Bit_Offset (gnat_field)) - % BITS_PER_UNIT == 0); - - /* Compute whether we should avoid the substitution. */ - bool reject - /* There is no point substituting if there is no change... */ - = (gnu_packable_type == gnu_field_type) - /* ... nor when the field is known to be byte aligned and not to - share a byte with another field. */ - || (has_byte_aligned_clause - && value_factor_p (gnu_size, BITS_PER_UNIT)) - /* The size of an aliased field must be an exact multiple of the - type's alignment, which the substitution might increase. Reject - substitutions that would so invalidate a component clause when the - specified position is byte aligned, as the change would have no - real benefit from the packing standpoint anyway. */ - || (Is_Aliased (gnat_field) - && has_byte_aligned_clause - && !value_factor_p (gnu_size, TYPE_ALIGN (gnu_packable_type))); - - /* Substitute unless told otherwise. */ - if (!reject) + if (gnu_packable_type != gnu_field_type) { gnu_field_type = gnu_packable_type; - if (!gnu_size) gnu_size = rm_size (gnu_field_type); } -- cgit v1.2.1 From f61f63980cc1a89af15fc90ddf2c09b98418fc2f Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Mon, 23 Nov 2009 18:55:50 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity) : Pass the list of attributes when building the corresponding variable of a constant. * gcc-interface/utils.c (create_var_decl_1): Do not process attributes for constants. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154458 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 9e643a3108b..ceb1f349ce8 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1366,7 +1366,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tree gnu_corr_var = create_true_var_decl (gnu_entity_name, gnu_ext_name, gnu_type, gnu_expr, true, Is_Public (gnat_entity), - !definition, static_p, NULL, + !definition, static_p, attr_list, gnat_entity); SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var); -- cgit v1.2.1 From d58b12c28aed0417f819ea7628ff9cbf96f79d77 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Tue, 24 Nov 2009 20:02:40 +0000 Subject: * exp_util.adb (Make_CW_Equivalent_Type): Do not mark the type as frozen for targets that do not require front-end layout. (New_Class_Wide_Subtype): Always reset the freezing status to False. * exp_ch8.adb: Do not 'with' Targparm. (Expand_N_Object_Renaming_Declaration): Always freeze a class-wide subtype that has been built from the expression. * exp_intr.adb (Expand_Unc_Deallocation): If the designated type is class wide, freeze the implicit type that has been built from the expression at the dereference point. * freeze.adb (Freeze_Entity): Adjust comment. * gcc-interface/decl.c (Gigi_Equivalent_Type) : Remove useless test. * gcc-interface/trans.c (process_freeze_entity): Do not special-case class-wide subtypes. * s-osinte-aix.adb (clock_gettime): Fix comment. * s-osinte-darwin.adb (clock_gettime): Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154514 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index ceb1f349ce8..925610ce32e 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -4965,9 +4965,7 @@ Gigi_Equivalent_Type (Entity_Id gnat_entity) break; case E_Class_Wide_Type: - gnat_equiv = ((Present (Equivalent_Type (gnat_entity))) - ? Equivalent_Type (gnat_entity) - : Root_Type (gnat_entity)); + gnat_equiv = Root_Type (gnat_entity); break; case E_Task_Type: -- cgit v1.2.1 From f9001da79dcfe4252ef15588322181002cde5407 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Tue, 24 Nov 2009 20:25:58 +0000 Subject: * sem_util.adb (Set_Debug_Info_Needed): For an E_Class_Wide_Subtype, also set the flag on the Equivalent_Type. * gcc-interface/utils.c (finish_record_type): Replace DO_NOT_FINALIZE parameter with DEBUG_INFO_P. Rename FIELDLIST into FIELD_LIST. (rest_of_record_type_compilation): Rename FIELDLIST into FIELD_LIST. (build_vms_descriptor32): Adjust call to finish_record_type. (build_vms_descriptor): Likewise. (build_unc_object_type): Likewise. * decl.c (gnat_to_gnu_entity): Adjust calls to finish_record_type and components_to_record. (make_packable_type): Adjust call to finish_record_type. (maybe_pad_type): Likewise. Tweak condition. (components_to_record): Likewise. Replace DO_NOT_FINALIZE parameter with MAYBE_UNUSED. Adjust recursive call. (create_variant_part_from): Adjust call to finish_record_type. Do not call rest_of_record_type_compilation on the new record types. * trans.c (gigi): Adjust call to finish_record_type. * gigi.h (finish_record_type): Adjust prototype and comment. (rest_of_record_type_compilation): Adjust comment. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154515 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 123 +++++++++++++++++++++---------------------- 1 file changed, 61 insertions(+), 62 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 925610ce32e..8b4936ab6dc 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1630,20 +1630,22 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_field = create_field_decl (get_identifier ("OBJECT"), gnu_field_type, gnu_type, 1, 0, 0, 0); - /* Do not finalize it until after the parallel type is added. */ - finish_record_type (gnu_type, gnu_field, 0, true); + /* Do not emit debug info until after the parallel type is added. */ + finish_record_type (gnu_type, gnu_field, 0, false); TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1; relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY); - /* Make the original array type a parallel type. */ - if (debug_info_p - && present_gnu_tree (Original_Array_Type (gnat_entity))) - add_parallel_type (TYPE_STUB_DECL (gnu_type), - gnat_to_gnu_type - (Original_Array_Type (gnat_entity))); + if (debug_info_p) + { + /* Make the original array type a parallel type. */ + if (present_gnu_tree (Original_Array_Type (gnat_entity))) + add_parallel_type (TYPE_STUB_DECL (gnu_type), + gnat_to_gnu_type + (Original_Array_Type (gnat_entity))); - rest_of_record_type_compilation (gnu_type); + rest_of_record_type_compilation (gnu_type); + } } /* If the type we are dealing with has got a smaller alignment than the @@ -1678,7 +1680,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_field = create_field_decl (get_identifier ("OBJECT"), gnu_field_type, gnu_type, 1, 0, 0, 0); - finish_record_type (gnu_type, gnu_field, 0, false); + finish_record_type (gnu_type, gnu_field, 0, debug_info_p); TYPE_PADDING_P (gnu_type) = 1; relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY); @@ -1824,9 +1826,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Make sure we can put this into a register. */ TYPE_ALIGN (gnu_fat_type) = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE); - /* Do not finalize this record type since the types of its fields - are still incomplete at this point. */ - finish_record_type (gnu_fat_type, tem, 0, true); + /* Do not emit debug info for this record type since the types of its + fields are still incomplete at this point. */ + finish_record_type (gnu_fat_type, tem, 0, false); TYPE_FAT_POINTER_P (gnu_fat_type) = 1; /* Build a reference to the template from a PLACEHOLDER_EXPR that @@ -1933,7 +1935,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = chainon (gnu_template_fields, gnu_temp_fields[index]); /* Install all the fields into the template. */ - finish_record_type (gnu_template_type, gnu_template_fields, 0, false); + finish_record_type (gnu_template_type, gnu_template_fields, 0, + debug_info_p); TYPE_READONLY (gnu_template_type) = 1; /* Now make the array of arrays and update the pointer to the array @@ -2393,7 +2396,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_field_list = gnu_field; } - finish_record_type (gnu_bound_rec, gnu_field_list, 0, false); + finish_record_type (gnu_bound_rec, gnu_field_list, 0, true); add_parallel_type (TYPE_STUB_DECL (gnu_type), gnu_bound_rec); } @@ -2867,8 +2870,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Add the fields into the record type and finish it up. */ components_to_record (gnu_type, Component_List (record_definition), gnu_field_list, packed, definition, NULL, - false, all_rep, false, is_unchecked_union, - debug_info_p); + false, all_rep, is_unchecked_union, + debug_info_p, false); /* If it is a tagged record force the type to BLKmode to insure that these objects will always be put in memory. Likewise for limited @@ -3188,9 +3191,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && !present_gnu_tree (Etype (gnat_field))) gnat_to_gnu_entity (Etype (gnat_field), NULL_TREE, 0); - /* Do not finalize it since we're going to modify it below. */ + /* Do not emit debug info for the type yet since we're going to + modify it below. */ gnu_field_list = nreverse (gnu_field_list); - finish_record_type (gnu_type, gnu_field_list, 2, true); + finish_record_type (gnu_type, gnu_field_list, 2, false); /* See the E_Record_Type case for the rationale. */ if (Is_Tagged_Type (gnat_entity) @@ -3225,7 +3229,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_subtype_marker, 0, NULL_TREE, NULL_TREE, 0), - 0, false); + 0, true); add_parallel_type (TYPE_STUB_DECL (gnu_type), gnu_subtype_marker); @@ -3459,9 +3463,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE); TYPE_FAT_POINTER_P (gnu_type) = 1; - /* Do not finalize this record type since the types of - its fields are incomplete. */ - finish_record_type (gnu_type, fields, 0, true); + /* Do not emit debug info for this record type since the types + of its fields are incomplete. */ + finish_record_type (gnu_type, fields, 0, false); TYPE_OBJECT_RECORD_TYPE (gnu_old) = make_node (RECORD_TYPE); TYPE_NAME (TYPE_OBJECT_RECORD_TYPE (gnu_old)) @@ -4074,7 +4078,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) stubbed since structures are incomplete for the back-end. */ if (gnu_field_list && Convention (gnat_entity) != Convention_Stubbed) finish_record_type (gnu_return_type, nreverse (gnu_field_list), - 0, false); + 0, debug_info_p); /* If we have a CICO list but it has only one entry, we convert this function into a function that simply returns that one @@ -6041,7 +6045,7 @@ make_packable_type (tree type, bool in_record) field_list = new_field; } - finish_record_type (new_type, nreverse (field_list), 2, true); + finish_record_type (new_type, nreverse (field_list), 2, false); relate_alias_sets (new_type, type, ALIAS_SET_COPY); /* If this is a padding record, we never want to make the size smaller @@ -6198,8 +6202,8 @@ maybe_pad_type (tree type, tree size, unsigned int align, orig_size, bitsize_zero_node, 1); DECL_INTERNAL_P (field) = 1; - /* Do not finalize it until after the auxiliary record is built. */ - finish_record_type (record, field, 1, true); + /* Do not emit debug info until after the auxiliary record is built. */ + finish_record_type (record, field, 1, false); /* Set the same size for its RM size if requested; otherwise reuse the RM size of the original type. */ @@ -6208,9 +6212,9 @@ maybe_pad_type (tree type, tree size, unsigned int align, /* Unless debugging information isn't being written for the input type, write a record that shows what we are a subtype of and also make a variable that indicates our size, if still variable. */ - if (TYPE_NAME (record) - && AGGREGATE_TYPE_P (type) - && TREE_CODE (orig_size) != INTEGER_CST + if (TREE_CODE (orig_size) != INTEGER_CST + && TYPE_NAME (record) + && TYPE_NAME (type) && !(TREE_CODE (TYPE_NAME (type)) == TYPE_DECL && DECL_IGNORED_P (TYPE_NAME (type)))) { @@ -6230,7 +6234,7 @@ maybe_pad_type (tree type, tree size, unsigned int align, build_reference_type (type), marker, 0, NULL_TREE, NULL_TREE, 0), - 0, false); + 0, true); add_parallel_type (TYPE_STUB_DECL (record), marker); @@ -6720,35 +6724,34 @@ compare_field_bitpos (const PTR rt1, const PTR rt2) with Component_Alignment of Storage_Unit, -2 if this is for a record with a specified alignment. - DEFINITION is true if we are defining this record. + DEFINITION is true if we are defining this record type. P_GNU_REP_LIST, if nonzero, is a pointer to a list to which each field with a rep clause is to be added; in this case, that is all that should be done with such fields. - CANCEL_ALIGNMENT, if true, means the alignment should be zeroed before - laying out the record. This means the alignment only serves to force - fields to be bitfields, but not require the record to be that aligned. - This is used for variants. + CANCEL_ALIGNMENT is true if the alignment should be zeroed before laying + out the record. This means the alignment only serves to force fields to + be bitfields, but not to require the record to be that aligned. This is + used for variants. + + ALL_REP is true if a rep clause is present for all the fields. - ALL_REP, if true, means a rep clause was found for all the fields. This - simplifies the logic since we know we're not in the mixed case. + UNCHECKED_UNION is true if we are building this type for a record with a + Pragma Unchecked_Union. - DO_NOT_FINALIZE, if true, means that the record type is expected to be - modified afterwards so it will not be finalized here. + DEBUG_INFO_P is true if we need to write debug information about the type. - UNCHECKED_UNION, if true, means that we are building a type for a record - with a Pragma Unchecked_Union. + MAYBE_UNUSED is true if this type may be unused in the end; this doesn't + mean that its contents may be unused as well, but only the container. */ - DEBUG_INFO_P, if true, means that we need to write debug information for - types that we may create in the process. */ static void components_to_record (tree gnu_record_type, Node_Id gnat_component_list, tree gnu_field_list, int packed, bool definition, tree *p_gnu_rep_list, bool cancel_alignment, - bool all_rep, bool do_not_finalize, - bool unchecked_union, bool debug_info_p) + bool all_rep, bool unchecked_union, bool debug_info_p, + bool maybe_unused) { bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type); bool layout_with_rep = false; @@ -6878,12 +6881,12 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, = TYPE_SIZE_UNIT (gnu_record_type); } - /* Add the fields into the record type for the variant. Note that we - defer finalizing it until after we are sure to really use it. */ + /* Add the fields into the record type for the variant. Note that + we aren't sure to really use it at this point, see below. */ components_to_record (gnu_variant_type, Component_List (variant), NULL_TREE, packed, definition, &gnu_our_rep_list, !all_rep_and_size, all_rep, - true, unchecked_union, debug_info_p); + unchecked_union, debug_info_p, true); gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant)); @@ -6942,7 +6945,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, } finish_record_type (gnu_union_type, nreverse (gnu_variant_list), - all_rep_and_size ? 1 : 0, false); + all_rep_and_size ? 1 : 0, debug_info_p); /* If GNU_UNION_TYPE is our record type, it means we must have an Unchecked_Union with no fields. Verify that and, if so, just @@ -7034,7 +7037,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, if (gnu_field_list) { - finish_record_type (gnu_rep_type, gnu_our_rep_list, 1, false); + finish_record_type (gnu_rep_type, gnu_our_rep_list, 1, debug_info_p); gnu_field = create_field_decl (get_identifier ("REP"), gnu_rep_type, gnu_record_type, 0, NULL_TREE, NULL_TREE, 1); @@ -7052,7 +7055,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, TYPE_ALIGN (gnu_record_type) = 0; finish_record_type (gnu_record_type, nreverse (gnu_field_list), - layout_with_rep ? 1 : 0, do_not_finalize); + layout_with_rep ? 1 : 0, debug_info_p && !maybe_unused); } /* Given GNU_SIZE, a GCC tree representing a size, return a Uint to be @@ -8141,12 +8144,10 @@ create_variant_part_from (tree old_variant_part, tree variant_list, field_list = new_variant_subpart; } - /* Finish up the new variant and create the field. */ - finish_record_type (new_variant, nreverse (field_list), 2, true); + /* Finish up the new variant and create the field. No need for debug + info thanks to the XVS type. */ + finish_record_type (new_variant, nreverse (field_list), 2, false); compute_record_mode (new_variant); - rest_of_record_type_compilation (new_variant); - - /* No need for debug info thanks to the XVS type. */ create_type_decl (TYPE_NAME (new_variant), new_variant, NULL, true, false, Empty); @@ -8160,12 +8161,10 @@ create_variant_part_from (tree old_variant_part, tree variant_list, union_field_list = new_field; } - /* Finish up the union type and create the variant part. */ - finish_record_type (new_union_type, union_field_list, 2, true); + /* Finish up the union type and create the variant part. No need for debug + info thanks to the XVS type. */ + finish_record_type (new_union_type, union_field_list, 2, false); compute_record_mode (new_union_type); - rest_of_record_type_compilation (new_union_type); - - /* No need for debug info thanks to the XVS type. */ create_type_decl (TYPE_NAME (new_union_type), new_union_type, NULL, true, false, Empty); -- cgit v1.2.1 From 3c7f4ec0e99fc71dbe4bc0fb968b3b83659c302c Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Wed, 25 Nov 2009 21:28:00 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity) : Translate regular boolean types into BOOLEAN_TYPEs. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154658 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 8b4936ab6dc..0effe88cd9f 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1416,30 +1416,31 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) break; } - /* Normal case of non-character type or non-Standard character type. */ { - /* Here we have a list of enumeral constants in First_Literal. - We make a CONST_DECL for each and build into GNU_LITERAL_LIST - the list to be placed into TYPE_FIELDS. Each node in the list - is a TREE_LIST whose TREE_VALUE is the literal name and whose - TREE_PURPOSE is the value of the literal. */ - - Entity_Id gnat_literal; + /* We have a list of enumeral constants in First_Literal. We make a + CONST_DECL for each one and build into GNU_LITERAL_LIST the list to + be placed into TYPE_FIELDS. Each node in the list is a TREE_LIST + whose TREE_VALUE is the literal name and whose TREE_PURPOSE is the + value of the literal. But when we have a regular boolean type, we + simplify this a little by using a BOOLEAN_TYPE. */ + bool is_boolean = Is_Boolean_Type (gnat_entity) + && !Has_Non_Standard_Rep (gnat_entity); tree gnu_literal_list = NULL_TREE; + Entity_Id gnat_literal; if (Is_Unsigned_Type (gnat_entity)) gnu_type = make_unsigned_type (esize); else gnu_type = make_signed_type (esize); - TREE_SET_CODE (gnu_type, ENUMERAL_TYPE); + TREE_SET_CODE (gnu_type, is_boolean ? BOOLEAN_TYPE : ENUMERAL_TYPE); for (gnat_literal = First_Literal (gnat_entity); Present (gnat_literal); gnat_literal = Next_Literal (gnat_literal)) { - tree gnu_value = UI_To_gnu (Enumeration_Rep (gnat_literal), - gnu_type); + tree gnu_value + = UI_To_gnu (Enumeration_Rep (gnat_literal), gnu_type); tree gnu_literal = create_var_decl (get_entity_name (gnat_literal), NULL_TREE, gnu_type, gnu_value, true, false, false, @@ -1450,7 +1451,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_value, gnu_literal_list); } - TYPE_VALUES (gnu_type) = nreverse (gnu_literal_list); + if (!is_boolean) + TYPE_VALUES (gnu_type) = nreverse (gnu_literal_list); /* Note that the bounds are updated at the end of this function to avoid an infinite recursion since they refer to the type. */ -- cgit v1.2.1 From 664dfc7850f8dd5b7dc17da74821abf2be9091b1 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Wed, 7 Apr 2010 10:51:30 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity) : Set default alignment on the RETURN type built for the Copy-In Copy-Out mechanism. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158054 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 3 +++ 1 file changed, 3 insertions(+) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 0effe88cd9f..0b620a0c0b4 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -4062,6 +4062,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gcc_assert (TREE_CODE (gnu_return_type) == VOID_TYPE); gnu_return_type = make_node (RECORD_TYPE); TYPE_NAME (gnu_return_type) = get_identifier ("RETURN"); + /* Set a default alignment to speed up accesses. */ + TYPE_ALIGN (gnu_return_type) + = get_mode_alignment (ptr_mode); has_copy_in_out = true; } -- cgit v1.2.1 From 02433bf7f097de2d710298811b1626a969f61060 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Wed, 7 Apr 2010 11:38:06 +0000 Subject: * exp_pakd.adb (Create_Packed_Array_Type): Always use a modular type if the size is small enough. Propagate the alignment if there is an alignment clause on the original array type. * gcc-interface/decl.c (gnat_to_gnu_entity) Deal with under-aligned packed array types. Copy the size onto the justified modular type and don't lay it out again. Likewise for the padding type built for other under-aligned subtypes. * gcc-interface/utils.c (finish_record_type): Do not set a default mode on the type. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158056 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 87 ++++++++++++++++++++++++++------------------ 1 file changed, 52 insertions(+), 35 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 0b620a0c0b4..6da9ce4a0ae 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1593,6 +1593,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnat_to_gnu_type (Original_Array_Type (gnat_entity))); + /* We have to handle clauses that under-align the type specially. */ + if ((Present (Alignment_Clause (gnat_entity)) + || (Is_Packed_Array_Type (gnat_entity) + && Present + (Alignment_Clause (Original_Array_Type (gnat_entity))))) + && UI_Is_In_Int_Range (Alignment (gnat_entity))) + { + align = UI_To_Int (Alignment (gnat_entity)) * BITS_PER_UNIT; + if (align >= TYPE_ALIGN (gnu_type)) + align = 0; + } + /* If the type we are dealing with represents a bit-packed array, we need to have the bits left justified on big-endian targets and right justified on little-endian targets. We also need to @@ -1605,39 +1617,47 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { tree gnu_field_type, gnu_field; - /* Set the RM size before wrapping up the type. */ + /* Set the RM size before wrapping up the original type. */ SET_TYPE_RM_SIZE (gnu_type, UI_To_gnu (RM_Size (gnat_entity), bitsizetype)); TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1; + + /* Create a stripped-down declaration, mainly for debugging. */ + create_type_decl (gnu_entity_name, gnu_type, NULL, true, + debug_info_p, gnat_entity); + + /* Now save it and build the enclosing record type. */ gnu_field_type = gnu_type; gnu_type = make_node (RECORD_TYPE); TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "JM"); - - /* Propagate the alignment of the modular type to the record. - This means that bit-packed arrays have "ceil" alignment for - their size, which may seem counter-intuitive but makes it - possible to easily overlay them on modular types. */ - TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_field_type); TYPE_PACKED (gnu_type) = 1; + TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_field_type); + TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_field_type); + SET_TYPE_ADA_SIZE (gnu_type, TYPE_RM_SIZE (gnu_field_type)); + + /* Propagate the alignment of the modular type to the record type, + unless there is an alignment clause that under-aligns the type. + This means that bit-packed arrays are given "ceil" alignment for + their size by default, which may seem counter-intuitive but makes + it possible to overlay them on modular types easily. */ + TYPE_ALIGN (gnu_type) + = align > 0 ? align : TYPE_ALIGN (gnu_field_type); - /* Create a stripped-down declaration of the original type, mainly - for debugging. */ - create_type_decl (gnu_entity_name, gnu_field_type, NULL, true, - debug_info_p, gnat_entity); + relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY); /* Don't notify the field as "addressable", since we won't be taking it's address and it would prevent create_field_decl from making a bitfield. */ gnu_field = create_field_decl (get_identifier ("OBJECT"), - gnu_field_type, gnu_type, 1, 0, 0, 0); + gnu_field_type, gnu_type, 1, + NULL_TREE, bitsize_zero_node, 0); /* Do not emit debug info until after the parallel type is added. */ - finish_record_type (gnu_type, gnu_field, 0, false); + finish_record_type (gnu_type, gnu_field, 2, false); + compute_record_mode (gnu_type); TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1; - relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY); - if (debug_info_p) { /* Make the original array type a parallel type. */ @@ -1653,45 +1673,42 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* If the type we are dealing with has got a smaller alignment than the natural one, we need to wrap it up in a record type and under-align the latter. We reuse the padding machinery for this purpose. */ - else if (Present (Alignment_Clause (gnat_entity)) - && UI_Is_In_Int_Range (Alignment (gnat_entity)) - && (align = UI_To_Int (Alignment (gnat_entity)) * BITS_PER_UNIT) - && align < TYPE_ALIGN (gnu_type)) + else if (align > 0) { tree gnu_field_type, gnu_field; /* Set the RM size before wrapping up the type. */ SET_TYPE_RM_SIZE (gnu_type, UI_To_gnu (RM_Size (gnat_entity), bitsizetype)); + + /* Create a stripped-down declaration, mainly for debugging. */ + create_type_decl (gnu_entity_name, gnu_type, NULL, true, + debug_info_p, gnat_entity); + + /* Now save it and build the enclosing record type. */ gnu_field_type = gnu_type; gnu_type = make_node (RECORD_TYPE); TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "PAD"); - - TYPE_ALIGN (gnu_type) = align; TYPE_PACKED (gnu_type) = 1; - - /* Create a stripped-down declaration of the original type, mainly - for debugging. */ - create_type_decl (gnu_entity_name, gnu_field_type, NULL, true, - debug_info_p, gnat_entity); + TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_field_type); + TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_field_type); + SET_TYPE_ADA_SIZE (gnu_type, TYPE_RM_SIZE (gnu_field_type)); + TYPE_ALIGN (gnu_type) = align; + relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY); /* Don't notify the field as "addressable", since we won't be taking it's address and it would prevent create_field_decl from making a bitfield. */ - gnu_field = create_field_decl (get_identifier ("OBJECT"), - gnu_field_type, gnu_type, 1, 0, 0, 0); + gnu_field = create_field_decl (get_identifier ("F"), + gnu_field_type, gnu_type, 1, + NULL_TREE, bitsize_zero_node, 0); - finish_record_type (gnu_type, gnu_field, 0, debug_info_p); + finish_record_type (gnu_type, gnu_field, 2, debug_info_p); + compute_record_mode (gnu_type); TYPE_PADDING_P (gnu_type) = 1; - - relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY); } - /* Otherwise reset the alignment lest we computed it above. */ - else - align = 0; - break; case E_Floating_Point_Type: -- cgit v1.2.1 From 4cd5bb613c816cf996ca11a356cff1c7870806b0 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Thu, 8 Apr 2010 20:16:36 +0000 Subject: * tree.h (TREE_ADDRESSABLE): Document its effect for function types. * calls.c (expand_call): Pass the function type to aggregate_value_p. * function.c (aggregate_value_p): Do not honor DECL_BY_REFERENCE on the target function of a CALL_EXPR. Honor TREE_ADDRESSABLE on the function type instead. Reorder and simplify checks. * gimplify.c (gimplify_modify_expr_rhs) : New case. ada/ * gcc-interface/ada-tree.h (TYPE_RETURNS_UNCONSTRAINED_P): Rename into. (TYPE_RETURN_UNCONSTRAINED_P): ...this. (TYPE_RETURNS_BY_REF_P): Rename into. (TYPE_RETURN_BY_DIRECT_REF_P): ...this. (TYPE_RETURNS_BY_TARGET_PTR_P): Delete. * gcc-interface/gigi.h (create_subprog_type): Adjust parameter names. (build_return_expr): Likewise. * gcc-interface/decl.c (gnat_to_gnu_entity) : Rename local variables. If the return Mechanism is By_Reference, pass return_by_invisible_ref_p to create_subprog_type instead of toggling TREE_ADDRESSABLE. Test return_by_invisible_ref_p in order to annotate the mechanism. Use regular return for contrained types with non-static size and return by invisible reference for unconstrained return types with default discriminants. Update comment. * gcc-interface/trans.c (Subprogram_Body_to_gnu): If the function returns by invisible reference, turn the RESULT_DECL into a pointer. Do not handle DECL_BY_REF_P in the CICO case here. (call_to_gnu): Remove code handling return by target pointer. For a function call, if the return type has non-constant size, generate the assignment with an INIT_EXPR. (gnat_to_gnu) : Remove dead code in the CICO case. If the function returns by invisible reference, build the copy return operation manually. (add_decl_expr): Initialize the variable with an INIT_EXPR. * gcc-interface/utils.c (create_subprog_type): Adjust parameter names. Adjust for renaming of macros. Copy the node only when necessary. (create_subprog_decl): Do not toggle TREE_ADDRESSABLE on the return type, only change DECL_BY_REFERENCE on the RETURN_DECL. (convert_from_reference): Delete. (is_byref_result): Likewise. (gnat_genericize_r): Likewise. (gnat_genericize): Likewise. (end_subprog_body): Do not call gnat_genericize. * gcc-interface/utils2.c (build_binary_op) : New case. (build_return_expr): Adjust parameter names, logic and comment. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158139 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 114 ++++++++++++++++++++++--------------------- 1 file changed, 58 insertions(+), 56 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 6da9ce4a0ae..25b4c07fc46 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2009, Free Software Foundation, Inc. * + * Copyright (C) 1992-2010, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -3799,13 +3799,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tree gnu_field_list = NULL_TREE; /* Non-null for subprograms containing parameters passed by copy-in copy-out (Ada In Out or Out parameters not passed by reference), - in which case it is the list of nodes used to specify the values of - the in out/out parameters that are returned as a record upon + in which case it is the list of nodes used to specify the values + of the In Out/Out parameters that are returned as a record upon procedure return. The TREE_PURPOSE of an element of this list is a field of the record and the TREE_VALUE is the PARM_DECL corresponding to that field. This list will be saved in the TYPE_CI_CO_LIST field of the FUNCTION_TYPE node we create. */ - tree gnu_return_list = NULL_TREE; + tree gnu_cico_list = NULL_TREE; /* If an import pragma asks to map this subprogram to a GCC builtin, this is the builtin DECL node. */ tree gnu_builtin_decl = NULL_TREE; @@ -3831,9 +3831,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && Is_Pure (gnat_entity)); bool volatile_flag = No_Return (gnat_entity); - bool returns_by_ref = false; - bool returns_unconstrained = false; - bool returns_by_target_ptr = false; + bool return_by_direct_ref_p = false; + bool return_by_invisi_ref_p = false; + bool return_unconstrained_p = false; bool has_copy_in_out = false; bool has_stub = false; int parmnum; @@ -3885,37 +3885,39 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (kind == E_Function || kind == E_Subprogram_Type) gnu_return_type = gnat_to_gnu_type (Etype (gnat_entity)); - /* If this function returns by reference, make the actual - return type of this function the pointer and mark the decl. */ + /* If this function returns by reference, make the actual return + type of this function the pointer and mark the decl. */ if (Returns_By_Ref (gnat_entity)) { - returns_by_ref = true; gnu_return_type = build_pointer_type (gnu_return_type); + return_by_direct_ref_p = true; } - /* If the Mechanism is By_Reference, ensure the return type uses - the machine's by-reference mechanism, which may not the same - as above (e.g., it might be by passing a fake parameter). */ - else if (kind == E_Function - && Mechanism (gnat_entity) == By_Reference) - { - TREE_ADDRESSABLE (gnu_return_type) = 1; - - /* We expect this bit to be reset by gigi shortly, so can avoid a - type node copy here. This actually also prevents troubles with - the generation of debug information for the function, because - we might have issued such info for this type already, and would - be attaching a distinct type node to the function if we made a - copy here. */ - } - - /* If we are supposed to return an unconstrained array, - actually return a fat pointer and make a note of that. Return - a pointer to an unconstrained record of variable size. */ + /* If the Mechanism is By_Reference, ensure this function uses the + target's by-invisible-reference mechanism, which may not be the + same as above (e.g. it might be passing an extra parameter). + + Prior to GCC 4, this was handled by just setting TREE_ADDRESSABLE + on the result type. Everything required to pass by invisible + reference using the target's mechanism (e.g. an extra parameter) + was handled at RTL expansion time. + + This doesn't work with GCC 4 any more for several reasons. First, + the gimplification process might need to create temporaries of this + type and the gimplifier ICEs on such attempts; that's why the flag + is now set on the function type instead. Second, the middle-end + now also relies on a different attribute, DECL_BY_REFERENCE on the + RESULT_DECL, and expects the by-invisible-reference-ness to be made + explicit in the function body. */ + else if (kind == E_Function && Mechanism (gnat_entity) == By_Reference) + return_by_invisi_ref_p = true; + + /* If we are supposed to return an unconstrained array, actually return + a fat pointer and make a note of that. */ else if (TREE_CODE (gnu_return_type) == UNCONSTRAINED_ARRAY_TYPE) { gnu_return_type = TREE_TYPE (gnu_return_type); - returns_unconstrained = true; + return_unconstrained_p = true; } /* If the type requires a transient scope, the result is allocated @@ -3924,7 +3926,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) else if (Requires_Transient_Scope (Etype (gnat_entity))) { gnu_return_type = build_pointer_type (gnu_return_type); - returns_unconstrained = true; + return_unconstrained_p = true; } /* If the type is a padded type and the underlying type would not @@ -3936,20 +3938,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || Has_Foreign_Convention (gnat_entity))) gnu_return_type = TREE_TYPE (TYPE_FIELDS (gnu_return_type)); - /* If the return type has a non-constant size, we convert the function - into a procedure and its caller will pass a pointer to an object as - the first parameter when we call the function. This can happen for - an unconstrained type with a maximum size or a constrained type with - a size not known at compile time. */ - if (TYPE_SIZE_UNIT (gnu_return_type) - && !TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_return_type))) + /* If the return type is unconstrained, that means it must have a + maximum size. Use the padded type as the effective return type. + And ensure the function uses the target's by-invisible-reference + mechanism to avoid copying too much data when it returns. */ + if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_return_type))) { - returns_by_target_ptr = true; - gnu_param_list - = create_param_decl (get_identifier ("TARGET"), - build_reference_type (gnu_return_type), - true); - gnu_return_type = void_type_node; + gnu_return_type + = maybe_pad_type (gnu_return_type, + max_size (TYPE_SIZE (gnu_return_type), true), + 0, gnat_entity, false, false, false, true); + return_by_invisi_ref_p = true; } /* If the return type has a size that overflows, we cannot have @@ -4091,8 +4090,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) &DECL_SOURCE_LOCATION (gnu_field)); TREE_CHAIN (gnu_field) = gnu_field_list; gnu_field_list = gnu_field; - gnu_return_list = tree_cons (gnu_field, gnu_param, - gnu_return_list); + gnu_cico_list + = tree_cons (gnu_field, gnu_param, gnu_cico_list); } } @@ -4105,8 +4104,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* If we have a CICO list but it has only one entry, we convert this function into a function that simply returns that one object. */ - if (list_length (gnu_return_list) == 1) - gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_return_list)); + if (list_length (gnu_cico_list) == 1) + gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_cico_list)); if (Has_Stdcall_Convention (gnat_entity)) prepend_one_attribute_to @@ -4131,22 +4130,25 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_param_list = nreverse (gnu_param_list); if (has_stub) gnu_stub_param_list = nreverse (gnu_stub_param_list); - gnu_return_list = nreverse (gnu_return_list); + gnu_cico_list = nreverse (gnu_cico_list); if (Ekind (gnat_entity) == E_Function) - Set_Mechanism (gnat_entity, - (returns_by_ref || returns_unconstrained - ? By_Reference : By_Copy)); + Set_Mechanism (gnat_entity, return_unconstrained_p + || return_by_direct_ref_p + || return_by_invisi_ref_p + ? By_Reference : By_Copy); gnu_type = create_subprog_type (gnu_return_type, gnu_param_list, - gnu_return_list, returns_unconstrained, - returns_by_ref, returns_by_target_ptr); + gnu_cico_list, return_unconstrained_p, + return_by_direct_ref_p, + return_by_invisi_ref_p); if (has_stub) gnu_stub_type = create_subprog_type (gnu_return_type, gnu_stub_param_list, - gnu_return_list, returns_unconstrained, - returns_by_ref, returns_by_target_ptr); + gnu_cico_list, return_unconstrained_p, + return_by_direct_ref_p, + return_by_invisi_ref_p); /* A subprogram (something that doesn't return anything) shouldn't be considered const since there would be no reason for such a -- cgit v1.2.1 From 9bfb1138c84dbe7e60bba2be8d82f30f2bc2da8b Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Fri, 9 Apr 2010 10:10:25 +0000 Subject: * gcc-interface/gigi.h (gnat_mark_addressable): Rename parameter. * gcc-interface/decl.c (maybe_variable): Do not set TREE_STATIC on _REF node. Use the type of the operand to set TREE_READONLY. * gcc-interface/trans.c (Identifier_to_gnu): Do not set TREE_STATIC on _REF node. Do not overwrite TREE_READONLY. (call_to_gnu): Rename local variable and fix various nits. In the copy-in/copy-out case, build the SAVE_EXPR manually. (convert_with_check): Call protect_multiple_eval in lieu of save_expr and fold the computations. (protect_multiple_eval): Always save entire fat pointers. (maybe_stabilize_reference): Minor tweaks. (gnat_stabilize_reference_1): Likewise. Do not deal with tcc_constant, tcc_type and tcc_statement. * gcc-interface/utils.c (convert_to_fat_pointer): Call protect_multiple_eval in lieu of save_expr. (convert): Minor tweaks. (maybe_unconstrained_array): Do not set TREE_STATIC on _REF node. (builtin_type_for_size): Call gnat_type_for_size directly. * gcc-interface/utils2.c (contains_save_expr_p): Delete. (contains_null_expr): Likewise (gnat_build_constructor): Do not call it. (compare_arrays): Deal with all side-effects, use protect_multiple_eval instead of gnat_stabilize_reference to protect the operands. (nonbinary_modular_operation): Call protect_multiple_eval in lieu of save_expr. (maybe_wrap_malloc): Likewise. (build_allocator): Likewise. (build_unary_op) : Do not set TREE_STATIC on _REF node. (gnat_mark_addressable): Rename parameter. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158156 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 25b4c07fc46..03938d1712e 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -5743,9 +5743,7 @@ maybe_variable (tree gnu_operand) tree gnu_result = build1 (UNCONSTRAINED_ARRAY_REF, TREE_TYPE (gnu_operand), variable_size (TREE_OPERAND (gnu_operand, 0))); - - TREE_READONLY (gnu_result) = TREE_STATIC (gnu_result) - = TYPE_READONLY (TREE_TYPE (TREE_TYPE (gnu_operand))); + TREE_READONLY (gnu_result) = TYPE_READONLY (TREE_TYPE (gnu_operand)); return gnu_result; } -- cgit v1.2.1 From df8a2682f432b414383c112949c751302823e5c7 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Fri, 9 Apr 2010 10:49:46 +0000 Subject: * gcc-interface/gigi.h (maybe_variable): Delete. (protect_multiple_eval): Likewise. (maybe_stabilize_reference): Likewise. (gnat_save_expr): Declare. (gnat_protect_expr): Likewise. (gnat_stabilize_reference): Likewise. * gcc-interface/decl.c (gnat_to_gnu_entity) : Use gnat_stabilize_reference. (maybe_variable): Delete. (elaborate_expression_1): Use gnat_save_expr. * gcc-interface/trans.c (Attribute_to_gnu): Use gnat_protect_expr. (call_to_gnu): Pass NULL to gnat_stabilize_reference. (gnat_to_gnu) : Use gnat_save_expr. : Use gnat_protect_exp. : Pass NULL to gnat_stabilize_reference. : Use gnat_protect_expr. Pass NULL to gnat_stabilize_reference. (build_unary_op_trapv): Use gnat_protect_expr. (build_binary_op_trapv): Likewise. (emit_range_check): Likewise. (emit_index_check): Likewise. (convert_with_check): Likewise. (protect_multiple_eval): Move to utils2.c file. (maybe_stabilize_reference): Merge into... (gnat_stabilize_reference): ...this. Move to utils2.c file. (gnat_stabilize_reference_1): Likewise. * gcc-interface/utils.c (convert_to_fat_pointer): Use gnat_protect_expr instead of protect_multiple_eval. * gcc-interface/utils2.c (compare_arrays): Likewise. (nonbinary_modular_operation): Likewise. (maybe_wrap_malloc): Likewise. (build_allocator): Likewise. (gnat_save_expr): New function. (gnat_protect_expr): Rename from protect_multiple_eval. Early return in common cases. Propagate TREE_READONLY onto dereferences. (gnat_stabilize_reference_1): Move from trans.c file. (gnat_stabilize_reference): Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158159 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 29 +++-------------------------- 1 file changed, 3 insertions(+), 26 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 03938d1712e..dd768910022 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -897,7 +897,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && !TREE_SIDE_EFFECTS (gnu_expr)))) { maybe_stable_expr - = maybe_stabilize_reference (gnu_expr, true, &stable); + = gnat_stabilize_reference (gnu_expr, true, &stable); if (stable) { @@ -973,7 +973,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) else { maybe_stable_expr - = maybe_stabilize_reference (gnu_expr, true, &stable); + = gnat_stabilize_reference (gnu_expr, true, &stable); if (stable) renamed_obj = maybe_stable_expr; @@ -5727,29 +5727,6 @@ prepend_attributes (Entity_Id gnat_entity, struct attrib ** attr_list) } } -/* Called when we need to protect a variable object using a SAVE_EXPR. */ - -tree -maybe_variable (tree gnu_operand) -{ - if (TREE_CONSTANT (gnu_operand) - || TREE_READONLY (gnu_operand) - || TREE_CODE (gnu_operand) == SAVE_EXPR - || TREE_CODE (gnu_operand) == NULL_EXPR) - return gnu_operand; - - if (TREE_CODE (gnu_operand) == UNCONSTRAINED_ARRAY_REF) - { - tree gnu_result - = build1 (UNCONSTRAINED_ARRAY_REF, TREE_TYPE (gnu_operand), - variable_size (TREE_OPERAND (gnu_operand, 0))); - TREE_READONLY (gnu_result) = TYPE_READONLY (TREE_TYPE (gnu_operand)); - return gnu_result; - } - - return variable_size (gnu_operand); -} - /* Given a GNAT tree GNAT_EXPR, for an expression which is a value within a type definition (either a bound or a discriminant value) for GNAT_ENTITY, return the GCC tree to use for that expression. GNU_NAME is the suffix @@ -5852,7 +5829,7 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name, if (expr_global && expr_variable) return gnu_decl; - return expr_variable ? maybe_variable (gnu_expr) : gnu_expr; + return expr_variable ? gnat_save_expr (gnu_expr) : gnu_expr; } /* Create a record type that contains a SIZE bytes long field of TYPE with a -- cgit v1.2.1 From e568189fbcf2b6e91fd5928a44498540fe2ed5a8 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Tue, 13 Apr 2010 07:08:24 +0000 Subject: * gimple.c (walk_gimple_op) : Do not request a pure rvalue on the RHS if the LHS is of a non-renamable type. * tree-ssa-ccp.c (maybe_fold_offset_to_component_ref): Fold result. ada/ * gcc-interface/ada-tree.h (TYPE_BY_REFERENCE_P): Delete. (DECL_CONST_ADDRESS_P): New macro. (SET_DECL_ORIGINAL_FIELD_TO_FIELD): Likewise. (SAME_FIELD_P): Likewise. * gcc-interface/decl.c (constructor_address_p): New static function. (gnat_to_gnu_entity) : Set DECL_CONST_ADDRESS_P according to the return value of above function. (gnat_to_gnu_entity) : Force BLKmode for all types passed by reference. : Likewise. Set TREE_ADDRESSABLE on the type if it passed by reference. (make_packable_type): Use SET_DECL_ORIGINAL_FIELD_TO_FIELD. (create_field_decl_from): Likewise. (substitute_in_type): Likewise. (purpose_member_field): Use SAME_FIELD_P. * gcc-interface/misc.c (must_pass_by_ref): Test TREE_ADDRESSABLE. * gcc-interface/trans.c (lvalue_required_p): Add ADDRESS_OF_CONSTANT parameter and adjust recursive calls. : New case. : Return 1 if the object is of a class-wide type. Adjust calls to lvalue_required_p. Do not return the initializer of a DECL_CONST_ADDRESS_P constant if an lvalue is required for it. (call_to_gnu): Delay issuing error message for a misaligned actual and avoid the associated back-end assertion. Test TREE_ADDRESSABLE. (gnat_gimplify_expr) : Handle non-static constructors. * gcc-interface/utils.c (make_dummy_type): Set TREE_ADDRESSABLE if the type is passed by reference. (convert) : Convert in-place in more cases. * gcc-interface/utils2.c (build_cond_expr): Drop TYPE_BY_REFERENCE_P. (build_simple_component_ref): Use SAME_FIELD_P. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158254 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 59 ++++++++++++++++++++++++++++---------------- 1 file changed, 38 insertions(+), 21 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index dd768910022..a333170cb16 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -138,6 +138,7 @@ static bool same_discriminant_p (Entity_Id, Entity_Id); static bool array_type_has_nonaliased_component (tree, Entity_Id); static bool compile_time_known_address_p (Node_Id); static bool cannot_be_superflat_p (Node_Id); +static bool constructor_address_p (tree); static void components_to_record (tree, Node_Id, tree, int, bool, tree *, bool, bool, bool, bool, bool); static Uint annotate_value (tree); @@ -1376,6 +1377,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) DECL_IGNORED_P (gnu_decl) = 1; } + /* If this is a constant, even if we don't need a true variable, we + may need to avoid returning the initializer in every case. That + can happen for the address of a (constant) constructor because, + upon dereferencing it, the constructor will be reinjected in the + tree, which may not be valid in every case; see lvalue_required_p + for more details. */ + if (TREE_CODE (gnu_decl) == CONST_DECL) + DECL_CONST_ADDRESS_P (gnu_decl) = constructor_address_p (gnu_expr); + /* If this is declared in a block that contains a block with an exception handler, we must force this variable in memory to suppress an invalid optimization. */ @@ -2892,10 +2902,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) false, all_rep, is_unchecked_union, debug_info_p, false); - /* If it is a tagged record force the type to BLKmode to insure that - these objects will always be put in memory. Likewise for limited - record types. */ - if (Is_Tagged_Type (gnat_entity) || Is_Limited_Record (gnat_entity)) + /* If it is passed by reference, force BLKmode to ensure that objects ++ of this type will always be put in memory. */ + if (Is_By_Reference_Type (gnat_entity)) SET_TYPE_MODE (gnu_type, BLKmode); /* We used to remove the associations of the discriminants and _Parent @@ -3216,8 +3225,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) finish_record_type (gnu_type, gnu_field_list, 2, false); /* See the E_Record_Type case for the rationale. */ - if (Is_Tagged_Type (gnat_entity) - || Is_Limited_Record (gnat_entity)) + if (Is_By_Reference_Type (gnat_entity)) SET_TYPE_MODE (gnu_type, BLKmode); else compute_record_mode (gnu_type); @@ -4388,8 +4396,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || Is_Class_Wide_Equivalent_Type (gnat_entity)) TYPE_ALIGN_OK (gnu_type) = 1; - if (AGGREGATE_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_entity)) - TYPE_BY_REFERENCE_P (gnu_type) = 1; + /* If the type is passed by reference, objects of this type must be + fully addressable and cannot be copied. */ + if (Is_By_Reference_Type (gnat_entity)) + TREE_ADDRESSABLE (gnu_type) = 1; /* ??? Don't set the size for a String_Literal since it is either confirming or we don't handle it properly (if the low bound is @@ -5397,6 +5407,20 @@ cannot_be_superflat_p (Node_Id gnat_range) return (tree_int_cst_lt (gnu_hb, gnu_lb) == 0); } + +/* Return true if GNU_EXPR is (essentially) the address of a CONSTRUCTOR. */ + +static bool +constructor_address_p (tree gnu_expr) +{ + while (TREE_CODE (gnu_expr) == NOP_EXPR + || TREE_CODE (gnu_expr) == CONVERT_EXPR + || TREE_CODE (gnu_expr) == NON_LVALUE_EXPR) + gnu_expr = TREE_OPERAND (gnu_expr, 0); + + return (TREE_CODE (gnu_expr) == ADDR_EXPR + && TREE_CODE (TREE_OPERAND (gnu_expr, 0)) == CONSTRUCTOR); +} /* Given GNAT_ENTITY, elaborate all expressions that are required to be elaborated at the point of its definition, but do nothing else. */ @@ -6033,10 +6057,7 @@ make_packable_type (tree type, bool in_record) !DECL_NONADDRESSABLE_P (old_field)); DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field); - SET_DECL_ORIGINAL_FIELD - (new_field, (DECL_ORIGINAL_FIELD (old_field) - ? DECL_ORIGINAL_FIELD (old_field) : old_field)); - + SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field); if (TREE_CODE (new_type) == QUAL_UNION_TYPE) DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field); @@ -7253,9 +7274,8 @@ annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref) UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT)); } -/* Return first element of field list whose TREE_PURPOSE is ELEM or whose - DECL_ORIGINAL_FIELD of TREE_PURPOSE is ELEM. Return NULL_TREE if there - is no such element in the list. */ +/* Return first element of field list whose TREE_PURPOSE is the same as ELEM. + Return NULL_TREE if there is no such element in the list. */ static tree purpose_member_field (const_tree elem, tree list) @@ -7263,7 +7283,7 @@ purpose_member_field (const_tree elem, tree list) while (list) { tree field = TREE_PURPOSE (list); - if (elem == field || elem == DECL_ORIGINAL_FIELD (field)) + if (SAME_FIELD_P (field, elem)) return list; list = TREE_CHAIN (list); } @@ -8035,8 +8055,7 @@ create_field_decl_from (tree old_field, tree field_type, tree record_type, } DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field); - t = DECL_ORIGINAL_FIELD (old_field); - SET_DECL_ORIGINAL_FIELD (new_field, t ? t : old_field); + SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field); DECL_DISCRIMINANT_NUMBER (new_field) = DECL_DISCRIMINANT_NUMBER (old_field); TREE_THIS_VOLATILE (new_field) = TREE_THIS_VOLATILE (old_field); @@ -8372,9 +8391,7 @@ substitute_in_type (tree t, tree f, tree r) } DECL_CONTEXT (new_field) = nt; - SET_DECL_ORIGINAL_FIELD (new_field, - (DECL_ORIGINAL_FIELD (field) - ? DECL_ORIGINAL_FIELD (field) : field)); + SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, field); TREE_CHAIN (new_field) = TYPE_FIELDS (nt); TYPE_FIELDS (nt) = new_field; -- cgit v1.2.1 From cfc3dd357931bfbc550006ceaf6af6c5230d07d8 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Tue, 13 Apr 2010 07:21:15 +0000 Subject: * gcc-interface/gigi.h (standard_datatypes): Add ADT_parent_name_id. (parent_name_id): New macro. * gcc-interface/decl.c (gnat_to_gnu_entity) : Use it. * gcc-interface/trans.c (gigi): Initialize it. (lvalue_required_p) : New case. : Likewise. : Likewise. * gcc-interface/utils.c (convert): Try to properly upcast tagged types. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158255 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index a333170cb16..190aec6c7bc 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -2851,8 +2851,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* ...and reference the _Parent field of this record. */ gnu_field - = create_field_decl (get_identifier - (Get_Name_String (Name_uParent)), + = create_field_decl (parent_name_id, gnu_parent, gnu_type, 0, has_rep ? TYPE_SIZE (gnu_parent) : NULL_TREE, @@ -4392,6 +4391,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) handling alignment and possible padding. */ if (is_type && (!gnu_decl || this_made_decl)) { + /* Tell the middle-end that objects of tagged types are guaranteed to + be properly aligned. This is necessary because conversions to the + class-wide type are translated into conversions to the root type, + which can be less aligned than some of its derived types. */ if (Is_Tagged_Type (gnat_entity) || Is_Class_Wide_Equivalent_Type (gnat_entity)) TYPE_ALIGN_OK (gnu_type) = 1; -- cgit v1.2.1 From dd3b3682dc5dc5c388e306d7fbe35e4b4ebbcc5a Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Wed, 14 Apr 2010 07:58:08 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity) : Fix comment. * gcc-interface/trans.c (process_freeze_entity): Use local copy of Ekind. Return early for class-wide types. Do not compute initializer unless necessary. Reuse the tree for an associated class-wide type only if processing its root type. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158295 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 190aec6c7bc..7780cff32a4 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -4343,9 +4343,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) break; } - /* Simple class_wide types are always viewed as their root_type - by Gigi unless an Equivalent_Type is specified. */ case E_Class_Wide_Type: + /* Class-wide types are always transformed into their root type. */ gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, 0); maybe_present = true; break; -- cgit v1.2.1 From 4fcb1fcaf3b342a70b7978d60584f0b291d027d9 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Thu, 15 Apr 2010 10:10:03 +0000 Subject: * gcc-interface/decl.c (validate_size): Reorder, remove obsolete test and warning. (set_rm_size): Reorder and remove obsolete test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158368 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 78 +++++++++++++++++++------------------------- 1 file changed, 34 insertions(+), 44 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 7780cff32a4..b5ee0cfed0e 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -7516,13 +7516,9 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, Node_Id gnat_error_node; tree type_size, size; - if (kind == VAR_DECL - /* If a type needs strict alignment, a component of this type in - a packed record cannot be packed and thus uses the type size. */ - || (kind == TYPE_DECL && Strict_Alignment (gnat_object))) - type_size = TYPE_SIZE (gnu_type); - else - type_size = rm_size (gnu_type); + /* Return 0 if no size was specified. */ + if (uint_size == No_Uint) + return NULL_TREE; /* Find the node to use for errors. */ if ((Ekind (gnat_object) == E_Component @@ -7534,19 +7530,17 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, else gnat_error_node = gnat_object; - /* Return 0 if no size was specified, either because Esize was not Present - or the specified size was zero. */ - if (No (uint_size) || uint_size == No_Uint) - return NULL_TREE; - /* Get the size as a tree. Issue an error if a size was specified but cannot be represented in sizetype. */ size = UI_To_gnu (uint_size, bitsizetype); if (TREE_OVERFLOW (size)) { - post_error_ne (component_p ? "component size of & is too large" - : "size of & is too large", - gnat_error_node, gnat_object); + if (component_p) + post_error_ne ("component size of & is too large", gnat_error_node, + gnat_object); + else + post_error_ne ("size of & is too large", gnat_error_node, + gnat_object); return NULL_TREE; } @@ -7582,6 +7576,14 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, && TYPE_CONTAINS_TEMPLATE_P (gnu_type)) size = size_binop (PLUS_EXPR, DECL_SIZE (TYPE_FIELDS (gnu_type)), size); + if (kind == VAR_DECL + /* If a type needs strict alignment, a component of this type in + a packed record cannot be packed and thus uses the type size. */ + || (kind == TYPE_DECL && Strict_Alignment (gnat_object))) + type_size = TYPE_SIZE (gnu_type); + else + type_size = rm_size (gnu_type); + /* Modify the size of the type to be that of the maximum size if it has a discriminant. */ if (type_size && CONTAINS_PLACEHOLDER_P (type_size)) @@ -7591,13 +7593,9 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, by the smallest integral mode that's valid for pointers. */ if (TREE_CODE (gnu_type) == POINTER_TYPE || TYPE_IS_FAT_POINTER_P (gnu_type)) { - enum machine_mode p_mode; - - for (p_mode = GET_CLASS_NARROWEST_MODE (MODE_INT); - !targetm.valid_pointer_mode (p_mode); - p_mode = GET_MODE_WIDER_MODE (p_mode)) - ; - + enum machine_mode p_mode = GET_CLASS_NARROWEST_MODE (MODE_INT); + while (!targetm.valid_pointer_mode (p_mode)) + p_mode = GET_MODE_WIDER_MODE (p_mode); type_size = bitsize_int (GET_MODE_BITSIZE (p_mode)); } @@ -7612,22 +7610,11 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, ("component size for& too small{, minimum allowed is ^}", gnat_error_node, gnat_object, type_size); else - post_error_ne_tree ("size for& too small{, minimum allowed is ^}", - gnat_error_node, gnat_object, type_size); - - if (kind == VAR_DECL && !component_p - && TREE_CODE (rm_size (gnu_type)) == INTEGER_CST - && !tree_int_cst_lt (size, rm_size (gnu_type))) - post_error_ne_tree_2 - ("\\size of ^ is not a multiple of alignment (^ bits)", - gnat_error_node, gnat_object, rm_size (gnu_type), - TYPE_ALIGN (gnu_type)); - - else if (INTEGRAL_TYPE_P (gnu_type)) - post_error_ne ("\\size would be legal if & were not aliased!", - gnat_error_node, gnat_object); + post_error_ne_tree + ("size for& too small{, minimum allowed is ^}", + gnat_error_node, gnat_object, type_size); - return NULL_TREE; + size = NULL_TREE; } return size; @@ -7639,16 +7626,17 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, static void set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity) { + Node_Id gnat_attr_node; + tree old_size, size; + + /* Do nothing if no size was specified. */ + if (uint_size == No_Uint) + return; + /* Only issue an error if a Value_Size clause was explicitly given. Otherwise, we'd be duplicating an error on the Size clause. */ - Node_Id gnat_attr_node + gnat_attr_node = Get_Attribute_Definition_Clause (gnat_entity, Attr_Value_Size); - tree old_size = rm_size (gnu_type), size; - - /* Do nothing if no size was specified, either because RM size was not - Present or if the specified size was zero. */ - if (No (uint_size) || uint_size == No_Uint) - return; /* Get the size as a tree. Issue an error if a size was specified but cannot be represented in sizetype. */ @@ -7672,6 +7660,8 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity) && !Is_Discrete_Or_Fixed_Point_Type (gnat_entity))) return; + old_size = rm_size (gnu_type); + /* If the old size is self-referential, get the maximum size. */ if (CONTAINS_PLACEHOLDER_P (old_size)) old_size = max_size (old_size, true); -- cgit v1.2.1 From ac45dde2731ceeb2cfdf1cbe927dadd6bd6b6307 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Thu, 15 Apr 2010 21:15:47 +0000 Subject: * 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. : 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. : 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158390 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 78 +++++++++++++++++++++----------------------- 1 file changed, 37 insertions(+), 41 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index b5ee0cfed0e..9ca27fd03ab 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)) -- cgit v1.2.1 From 17052c8f8f63239deccec6d06ff1d9a9ebfc4640 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Fri, 16 Apr 2010 06:58:43 +0000 Subject: * gcc-interface/decl.c (make_type_from_size) : Just copy TYPE_NAME. * gcc-interface/trans.c (smaller_packable_type_p): Rename into... (smaller_form_type_p): ...this. Change parameter and variable names. (call_to_gnu): Use the nominal type of the parameter to create the temporary if it's a smaller form of the actual type. (addressable_p): Return false if the actual type is integral and its size is greater than that of the expected type. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158398 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 9ca27fd03ab..44c39299558 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -7748,14 +7748,9 @@ make_type_from_size (tree type, tree size_tree, bool for_biased) SET_TYPE_RM_MAX_VALUE (new_type, convert (TREE_TYPE (new_type), TYPE_MAX_VALUE (type))); - /* Propagate the name to avoid creating a fake subrange type. */ - if (TYPE_NAME (type)) - { - if (TREE_CODE (TYPE_NAME (type)) == TYPE_DECL) - TYPE_NAME (new_type) = DECL_NAME (TYPE_NAME (type)); - else - TYPE_NAME (new_type) = TYPE_NAME (type); - } + /* Copy the name to show that it's essentially the same type and + not a subrange type. */ + TYPE_NAME (new_type) = TYPE_NAME (type); TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p; SET_TYPE_RM_SIZE (new_type, bitsize_int (size)); return new_type; -- cgit v1.2.1 From eff24022ad68b3b4a16d9a28759219d1f3c7565f Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Fri, 16 Apr 2010 10:16:52 +0000 Subject: * uintp.adb (UI_From_Dint): Remove useless code. (UI_From_Int): Likewise. * uintp.h: Reorder declarations. (UI_From_gnu): Declare. (UI_Base): Likewise. (Vector_Template): Likewise. (Vector_To_Uint): Likewise. (Uint_0): Remove. (Uint_1): Likewise. * gcc-interface/gigi.h: Tweak comments. * gcc-interface/cuintp.c (UI_From_gnu): New global function. * gcc-interface/decl.c (maybe_pad_type): Do not warn if either size overflows. (annotate_value) : Call UI_From_gnu. * gcc-interface/trans.c (post_error_ne_num): Call post_error_ne. (post_error_ne_tree): Call UI_From_gnu and post_error_ne. * gcc-interface/utils.c (max_size) : Do not special-case TYPE_MAX_VALUE. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158408 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 18 +++++------------- 1 file changed, 5 insertions(+), 13 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 44c39299558..1a42ff7f8f8 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -6281,7 +6281,9 @@ maybe_pad_type (tree type, tree size, unsigned int align, && !operand_equal_p (size, orig_size, 0) && !(TREE_CODE (size) == INTEGER_CST && TREE_CODE (orig_size) == INTEGER_CST - && tree_int_cst_lt (size, orig_size))) + && (TREE_OVERFLOW (size) + || TREE_OVERFLOW (orig_size) + || tree_int_cst_lt (size, orig_size)))) { Node_Id gnat_error_node = Empty; @@ -7087,7 +7089,7 @@ annotate_value (tree gnu_size) TCode tcode; Node_Ref_Or_Val ops[3], ret; struct tree_int_map **h = NULL; - int size, i; + int i; /* See if we've already saved the value for this node. */ if (EXPR_P (gnu_size)) @@ -7143,17 +7145,7 @@ annotate_value (tree gnu_size) return annotate_value (temp); } - if (!host_integerp (gnu_size, 1)) - return No_Uint; - - size = tree_low_cst (gnu_size, 1); - - /* This peculiar test is to make sure that the size fits in an int - on machines where HOST_WIDE_INT is not "int". */ - if (tree_low_cst (gnu_size, 1) == size) - return UI_From_Int (size); - else - return No_Uint; + return UI_From_gnu (gnu_size); case COMPONENT_REF: /* The only case we handle here is a simple discriminant reference. */ -- cgit v1.2.1 From d243069c4137f2baa717a2aa1863fa238d204709 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Fri, 16 Apr 2010 12:07:02 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity): Use boolean_type_node in lieu of integer_type_node for boolean operations. (choices_to_gnu): Likewise. * gcc-interface/trans.c (Attribute_to_gnu): Likewise. (Loop_Statement_to_gnu): Likewise. (establish_gnat_vms_condition_handler): Likewise. (Exception_Handler_to_gnu_sjlj): Likewise. (gnat_to_gnu): Likewise. (build_unary_op_trapv): Likewise. (build_binary_op_trapv): Likewise. (emit_range_check): Likewise. (emit_index_check): Likewise. (convert_with_check): Likewise. * gcc-interface/utils.c (convert_vms_descriptor64): Likewise. (convert_vms_descriptor32): Likewise. (convert_vms_descriptor): Likewise. * gcc-interface/utils2.c (nonbinary_modular_operation): Likewise. (compare_arrays): Use boolean instead of integer constants. (build_binary_op) : New case. Check that the result type is a boolean type. : Remove obsolete assertion. : Check that the result type is a boolean type. : Delete. : Check that the result type is a boolean type. (build_unary_op): Use boolean_type_node in lieu of integer_type_node for boolean operations. (fill_vms_descriptor): Likewise. Fix formatting nits. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158411 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 30 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 16 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 1a42ff7f8f8..4db6c112ff0 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1916,7 +1916,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Compute the size of this dimension. */ gnu_max = build3 (COND_EXPR, gnu_index_base_type, - build2 (GE_EXPR, integer_type_node, gnu_high, gnu_low), + build2 (GE_EXPR, boolean_type_node, gnu_high, gnu_low), gnu_high, build2 (MINUS_EXPR, gnu_index_base_type, gnu_low, fold_convert (gnu_index_base_type, @@ -2214,7 +2214,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_high = build_cond_expr (sizetype, build_binary_op (GE_EXPR, - integer_type_node, + boolean_type_node, gnu_orig_max, gnu_orig_min), gnu_max, gnu_high); @@ -6335,13 +6335,11 @@ choices_to_gnu (tree operand, Node_Id choices) low = gnat_to_gnu (Low_Bound (choice)); high = gnat_to_gnu (High_Bound (choice)); - /* There's no good type to use here, so we might as well use - integer_type_node. */ this_test - = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node, - build_binary_op (GE_EXPR, integer_type_node, + = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node, + build_binary_op (GE_EXPR, boolean_type_node, operand, low), - build_binary_op (LE_EXPR, integer_type_node, + build_binary_op (LE_EXPR, boolean_type_node, operand, high)); break; @@ -6352,10 +6350,10 @@ choices_to_gnu (tree operand, Node_Id choices) high = gnat_to_gnu (High_Bound (gnat_temp)); this_test - = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node, - build_binary_op (GE_EXPR, integer_type_node, + = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node, + build_binary_op (GE_EXPR, boolean_type_node, operand, low), - build_binary_op (LE_EXPR, integer_type_node, + build_binary_op (LE_EXPR, boolean_type_node, operand, high)); break; @@ -6373,10 +6371,10 @@ choices_to_gnu (tree operand, Node_Id choices) high = TYPE_MAX_VALUE (type); this_test - = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node, - build_binary_op (GE_EXPR, integer_type_node, + = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node, + build_binary_op (GE_EXPR, boolean_type_node, operand, low), - build_binary_op (LE_EXPR, integer_type_node, + build_binary_op (LE_EXPR, boolean_type_node, operand, high)); break; } @@ -6386,7 +6384,7 @@ choices_to_gnu (tree operand, Node_Id choices) case N_Character_Literal: case N_Integer_Literal: single = gnat_to_gnu (choice); - this_test = build_binary_op (EQ_EXPR, integer_type_node, operand, + this_test = build_binary_op (EQ_EXPR, boolean_type_node, operand, single); break; @@ -6398,8 +6396,8 @@ choices_to_gnu (tree operand, Node_Id choices) gcc_unreachable (); } - result = build_binary_op (TRUTH_ORIF_EXPR, integer_type_node, - result, this_test); + result = build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node, result, + this_test); } return result; -- cgit v1.2.1 From 22582d866a933d4686e2c5068353b2083f84932a Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Fri, 16 Apr 2010 15:04:26 +0000 Subject: * gcc-interface/gigi.h (gnat_init_decl_processing): Delete. * gcc-interface/decl.c (gnat_to_gnu_entity): Constify a few variables. : Do not create the fake PARM_DECL if no debug info is needed. Do not create the corresponding VAR_DECL of a CONST_DECL for debugging purposes if no debug info is needed. Fix formatting. Reorder and add comments. * gcc-interface/trans.c (gnat_to_gnu) : Constify variable and remove obsolete comment. * gcc-interface/utils.c (convert_vms_descriptor64): Tweak comment. (convert_vms_descriptor32): Likewise. (convert): Remove dead code. : Pass the field instead of its name to build the reference to the P_ARRAY pointer. : Likewise. (maybe_unconstrained_array) : Likewise. (gnat_init_decl_processing): Delete, move contents to... * gcc-interface/misc.c (gnat_init): ...here. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158428 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 207 ++++++++++++++++++++++--------------------- 1 file changed, 108 insertions(+), 99 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 4db6c112ff0..02d729621bc 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -182,6 +182,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) const Entity_Kind kind = Ekind (gnat_entity); /* True if this is a type. */ const bool is_type = IN (kind, Type_Kind); + /* True if debug info is requested for this entity. */ + const bool debug_info_p = Needs_Debug_Info (gnat_entity); + /* True if this entity is to be considered as imported. */ + const bool imported_p + = (Is_Imported (gnat_entity) && No (Address_Clause (gnat_entity))); /* For a type, contains the equivalent GNAT node to be used in gigi. */ Entity_Id gnat_equiv_type = Empty; /* Temporary used to walk the GNAT tree. */ @@ -206,11 +211,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) bool maybe_present = false; /* 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); - /* True if this entity is to be considered as imported. */ - bool imported_p = (Is_Imported (gnat_entity) - && No (Address_Clause (gnat_entity))); /* Size and alignment of the GCC node, if meaningful. */ unsigned int esize = 0, align = 0; /* Contains the list of attributes directly attached to the entity. */ @@ -548,10 +548,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) case E_Out_Parameter: case E_Variable: - /* Simple variables, loop variables, Out parameters, and exceptions. */ + /* Simple variables, loop variables, Out parameters and exceptions. */ object: { - bool used_by_ref = false; bool const_flag = ((kind == E_Constant || kind == E_Variable) && Is_True_Constant (gnat_entity) @@ -563,6 +562,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) bool inner_const_flag = const_flag; bool static_p = Is_Statically_Allocated (gnat_entity); bool mutable_p = false; + bool used_by_ref = false; tree gnu_ext_name = NULL_TREE; tree renamed_obj = NULL_TREE; tree gnu_object_size; @@ -604,9 +604,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (kind == E_Loop_Parameter) gnu_type = get_base_type (gnu_type); - /* Reject non-renamed objects whose types are unconstrained arrays or - any object whose type is a dummy type or VOID_TYPE. */ - + /* Reject non-renamed objects whose type is an unconstrained array or + any object whose type is a dummy type or void. */ if ((TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE && No (Renamed_Object (gnat_entity))) || TYPE_IS_DUMMY_P (gnu_type) @@ -626,6 +625,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gcc_assert (Present (Alignment (gnat_entity))); align = validate_alignment (Alignment (gnat_entity), gnat_entity, TYPE_ALIGN (gnu_type)); + /* No point in changing the type if there is an address clause as the final type of the object will be a reference type. */ if (Present (Address_Clause (gnat_entity))) @@ -636,11 +636,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) false, false, definition, true); } - /* If we are defining the object, see if it has a Size value and - validate it if so. If we are not defining the object and a Size - clause applies, simply retrieve the value. We don't want to ignore - the clause and it is expected to have been validated already. Then - get the new type, if any. */ + /* If we are defining the object, see if it has a Size and validate it + if so. If we are not defining the object and a Size clause applies, + simply retrieve the value. We don't want to ignore the clause and + it is expected to have been validated already. Then get the new + type, if any. */ if (definition) gnu_size = validate_size (Esize (gnat_entity), gnu_type, gnat_entity, VAR_DECL, false, @@ -659,8 +659,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } /* If this object has self-referential size, it must be a record with - a default value. We are supposed to allocate an object of the - maximum size in this case unless it is a constant with an + a default discriminant. We are supposed to allocate an object of + the maximum size in this case, unless it is a constant with an initializing expression, in which case we can get the size from that. Note that the resulting size may still be a variable, so this may end up with an indirect allocation. */ @@ -707,8 +707,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } } - /* If the size is zero bytes, make it one byte since some linkers have - trouble with zero-sized objects. If the object will have a + /* If the size is zero byte, make it one byte since some linkers have + troubles with zero-sized objects. If the object will have a template, that will make it nonzero so don't bother. Also avoid doing that for an object renaming or an object with an address clause, as we would lose useful information on the view size @@ -774,7 +774,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ??? Note that we ignore Has_Volatile_Components on objects; it's not at all clear what to do in that case. */ - if (Has_Atomic_Components (gnat_entity)) { tree gnu_inner = (TREE_CODE (gnu_type) == ARRAY_TYPE @@ -789,10 +788,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Now check if the type of the object allows atomic access. Note that we must test the type, even if this object has size and - alignment to allow such access, because we will be going - inside the padded record to assign to the object. We could fix - this by always copying via an intermediate value, but it's not - clear it's worth the effort. */ + alignment to allow such access, because we will be going inside + the padded record to assign to the object. We could fix this by + always copying via an intermediate value, but it's not clear it's + worth the effort. */ if (Is_Atomic (gnat_entity)) check_ok_for_atomic (gnu_type, gnat_entity, false); @@ -1024,16 +1023,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = TYPE_PADDING_P (gnu_type) ? TYPE_FIELDS (TREE_TYPE (TYPE_FIELDS (gnu_type))) : TYPE_FIELDS (gnu_type); - gnu_expr = gnat_build_constructor - (gnu_type, - tree_cons - (template_field, - build_template (TREE_TYPE (template_field), - TREE_TYPE (TREE_CHAIN (template_field)), - NULL_TREE), - NULL_TREE)); + (gnu_type, + tree_cons + (template_field, + build_template (TREE_TYPE (template_field), + TREE_TYPE (TREE_CHAIN (template_field)), + NULL_TREE), + NULL_TREE)); } /* Convert the expression to the type of the object except in the @@ -1050,12 +1048,12 @@ 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); - /* If this is a pointer and it does not have an initializing - expression, initialize it to NULL, unless the object is - imported. */ + /* If this is a pointer that doesn't have an initializing expression, + initialize it to NULL, unless the object is imported. */ if (definition && (POINTER_TYPE_P (gnu_type) || TYPE_IS_FAT_POINTER_P (gnu_type)) - && !Is_Imported (gnat_entity) && !gnu_expr) + && !gnu_expr + && !Is_Imported (gnat_entity)) gnu_expr = integer_zero_node; /* If we are defining the object and it has an Address clause, we must @@ -1065,10 +1063,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) effects in this case. */ if (definition && Present (Address_Clause (gnat_entity))) { + Node_Id gnat_expr = Expression (Address_Clause (gnat_entity)); tree gnu_address = present_gnu_tree (gnat_entity) - ? get_gnu_tree (gnat_entity) - : gnat_to_gnu (Expression (Address_Clause (gnat_entity))); + ? get_gnu_tree (gnat_entity) : gnat_to_gnu (gnat_expr); save_gnu_tree (gnat_entity, NULL_TREE, false); @@ -1081,9 +1079,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = build_reference_type_for_mode (gnu_type, ptr_mode, true); gnu_address = convert (gnu_type, gnu_address); used_by_ref = true; - const_flag = !Is_Public (gnat_entity) - || compile_time_known_address_p (Expression (Address_Clause - (gnat_entity))); + const_flag + = !Is_Public (gnat_entity) + || compile_time_known_address_p (gnat_expr); /* If this is a deferred constant, the initializer is attached to the full view. */ @@ -1154,14 +1152,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) If the object's size overflows, make an allocator too, so that Storage_Error gets raised. Note that we will never free such memory, so we presume it never will get allocated. */ - if (!allocatable_size_p (TYPE_SIZE_UNIT (gnu_type), - global_bindings_p () || !definition + global_bindings_p () + || !definition || static_p) - || (gnu_size - && ! allocatable_size_p (gnu_size, - global_bindings_p () || !definition - || static_p))) + || (gnu_size && !allocatable_size_p (gnu_size, + global_bindings_p () + || !definition + || static_p))) { gnu_type = build_reference_type (gnu_type); gnu_size = NULL_TREE; @@ -1180,7 +1178,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) If we are elaborating a mutable object, tell build_allocator to ignore a possibly simpler size from the initializer, if any, as we must allocate the maximum possible size in this case. */ - if (definition) { tree gnu_alloc_type = TREE_TYPE (gnu_type); @@ -1302,6 +1299,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) (TREE_TYPE (TYPE_FIELDS (gnu_type))), 1))) static_p = true; + /* Now create the variable or the constant and set various flags. */ gnu_decl = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type, gnu_expr, const_flag, Is_Public (gnat_entity), @@ -1309,6 +1307,24 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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 we are defining an Out parameter and optimization isn't enabled, + create a fake PARM_DECL for debugging purposes and make it point to + the VAR_DECL. Suppress debug info for the latter but make sure it + will live on the stack so that it can be accessed from within the + debugger through the PARM_DECL. */ + if (kind == E_Out_Parameter && definition && !optimize && debug_info_p) + { + tree param = create_param_decl (gnu_entity_name, gnu_type, false); + gnat_pushdecl (param, gnat_entity); + SET_DECL_VALUE_EXPR (param, gnu_decl); + DECL_HAS_VALUE_EXPR_P (param) = 1; + DECL_IGNORED_P (gnu_decl) = 1; + TREE_ADDRESSABLE (gnu_decl) = 1; + } + + /* If this is a renaming pointer, attach the renamed object to it and + register it if we are at top level. */ if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj) { SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj); @@ -1319,46 +1335,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } } - if (definition && DECL_SIZE_UNIT (gnu_decl) - && get_block_jmpbuf_decl () - && (TREE_CODE (DECL_SIZE_UNIT (gnu_decl)) != INTEGER_CST - || (flag_stack_check == GENERIC_STACK_CHECK - && compare_tree_int (DECL_SIZE_UNIT (gnu_decl), - STACK_CHECK_MAX_VAR_SIZE) > 0))) - add_stmt_with_node (build_call_1_expr - (update_setjmp_buf_decl, - build_unary_op (ADDR_EXPR, NULL_TREE, - get_block_jmpbuf_decl ())), - gnat_entity); - - /* If we are defining an Out parameter and we're not optimizing, - create a fake PARM_DECL for debugging purposes and make it - point to the VAR_DECL. Suppress debug info for the latter - but make sure it will still live on the stack so it can be - accessed from within the debugger through the PARM_DECL. */ - if (kind == E_Out_Parameter && definition && !optimize) - { - tree param = create_param_decl (gnu_entity_name, gnu_type, false); - gnat_pushdecl (param, gnat_entity); - SET_DECL_VALUE_EXPR (param, gnu_decl); - DECL_HAS_VALUE_EXPR_P (param) = 1; - if (debug_info_p) - debug_info_p = false; - else - DECL_IGNORED_P (param) = 1; - TREE_ADDRESSABLE (gnu_decl) = 1; - } - - /* If this is a public constant or we're not optimizing and we're not - making a VAR_DECL for it, make one just for export or debugger use. - Likewise if the address is taken or if either the object or type is - aliased. Make an external declaration for a reference, unless this - is a Standard entity since there no real symbol at the object level - for these. */ + /* If this is a constant and we are defining it or it generates a real + symbol at the object level and we are referencing it, we may want + or need to have a true variable to represent it: + - if optimization isn't enabled, for debugging purposes, + - if the constant is public and not overlaid on something else, + - if its address is taken, + - if either itself or its type is aliased. */ if (TREE_CODE (gnu_decl) == CONST_DECL && (definition || Sloc (gnat_entity) > Standard_Location) - && ((Is_Public (gnat_entity) && No (Address_Clause (gnat_entity))) - || !optimize + && ((!optimize && debug_info_p) + || (Is_Public (gnat_entity) + && No (Address_Clause (gnat_entity))) || Address_Taken (gnat_entity) || Is_Aliased (gnat_entity) || Is_Aliased (Etype (gnat_entity)))) @@ -1372,8 +1360,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var); /* As debugging information will be generated for the variable, - do not generate information for the constant. */ - DECL_IGNORED_P (gnu_decl) = 1; + do not generate debugging information for the constant. */ + if (debug_info_p) + DECL_IGNORED_P (gnu_decl) = 1; + else + DECL_IGNORED_P (gnu_corr_var) = 1; } /* If this is a constant, even if we don't need a true variable, we @@ -1385,13 +1376,31 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (TREE_CODE (gnu_decl) == CONST_DECL) DECL_CONST_ADDRESS_P (gnu_decl) = constructor_address_p (gnu_expr); - /* If this is declared in a block that contains a block with an - exception handler, we must force this variable in memory to - suppress an invalid optimization. */ - if (Has_Nested_Block_With_Handler (Scope (gnat_entity)) - && Exception_Mechanism != Back_End_Exceptions) + /* If this object is declared in a block that contains a block with an + exception handler, and we aren't using the GCC exception mechanism, + we must force this variable in memory in order to avoid an invalid + optimization. */ + if (Exception_Mechanism != Back_End_Exceptions + && Has_Nested_Block_With_Handler (Scope (gnat_entity))) TREE_ADDRESSABLE (gnu_decl) = 1; + /* If we are defining an object with variable size or an object with + fixed size that will be dynamically allocated, and we are using the + setjmp/longjmp exception mechanism, update the setjmp buffer. */ + if (definition + && Exception_Mechanism == Setjmp_Longjmp + && get_block_jmpbuf_decl () + && DECL_SIZE_UNIT (gnu_decl) + && (TREE_CODE (DECL_SIZE_UNIT (gnu_decl)) != INTEGER_CST + || (flag_stack_check == GENERIC_STACK_CHECK + && compare_tree_int (DECL_SIZE_UNIT (gnu_decl), + STACK_CHECK_MAX_VAR_SIZE) > 0))) + add_stmt_with_node (build_call_1_expr + (update_setjmp_buf_decl, + build_unary_op (ADDR_EXPR, NULL_TREE, + get_block_jmpbuf_decl ())), + gnat_entity); + /* Back-annotate Esize and Alignment of the object if not already known. Note that we pick the values of the type, not those of the object, to shield ourselves from low-level platform-dependent @@ -1969,7 +1978,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Now make the array of arrays and update the pointer to the array in the fat pointer. Note that it is the first field. */ - tem = gnat_to_gnu_component_type (gnat_entity, definition, + tem = gnat_to_gnu_component_type (gnat_entity, definition, debug_info_p); /* If Component_Size is not already specified, annotate it with the @@ -2023,7 +2032,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) SET_TYPE_UNCONSTRAINED_ARRAY (gnu_fat_type, gnu_type); /* If the maximum size doesn't overflow, use it. */ - if (gnu_max_size + if (gnu_max_size && TREE_CODE (gnu_max_size) == INTEGER_CST && !TREE_OVERFLOW (gnu_max_size) && TREE_CODE (gnu_max_size_unit) == INTEGER_CST @@ -2049,9 +2058,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_fat_type, NULL, true, debug_info_p, gnat_entity); - /* Create the type to be used as what a thin pointer designates: an - record type for the object and its template with the field offsets - shifted to have the template at a negative offset. */ + /* Create the type to be used as what a thin pointer designates: + a record type for the object and its template with the fields + shifted to have the template at a negative offset. */ tem = build_unc_object_type (gnu_template_type, tem, create_concat_name (gnat_name, "XUT")); shift_unc_components_for_thin_pointers (tem); @@ -2901,7 +2910,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) debug_info_p, false); /* If it is passed by reference, force BLKmode to ensure that objects -+ of this type will always be put in memory. */ + of this type will always be put in memory. */ if (Is_By_Reference_Type (gnat_entity)) SET_TYPE_MODE (gnu_type, BLKmode); -- cgit v1.2.1 From 3fa661c420a097dd38a7a231c5df9b0a8b8a28ec Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sat, 17 Apr 2010 08:14:08 +0000 Subject: * gcc-interface/gigi.h (enum standard_datatypes): Add new values ADT_sbitsize_one_node and ADT_sbitsize_unit_node. (sbitsize_one_node): New macro. (sbitsize_unit_node): Likewise. * gcc-interface/decl.c (gnat_to_gnu_entity) : Fix latent bug in the computation of subrange_p. Fold wider_p predicate. (cannot_be_superflat_p): Use an explicitly signed 64-bit type to do the final comparison. (make_aligning_type): Build real negation and use sizetype throughout the offset computation. (maybe_pad_type): Do not issue the warning when the new size expression is too complex. (annotate_value) : Simplify code handling negative values. * gcc-interface/misc.c (gnat_init): Initialize sbitsize_one_node and sbitsize_unit_node. * gcc-interface/trans.c (Attribute_to_gnu) : Fold double negation. (gnat_to_gnu) : Likewise. * gcc-interface/utils.c (convert): Use sbitsize_unit_node. * gcc-interface/utils2.c (compare_arrays): Compute real lengths and use constants in sizetype. Remove dead code and tweak comments. Generate equality instead of inequality comparisons for zero length tests. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158461 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 72 +++++++++++++++++--------------------------- 1 file changed, 28 insertions(+), 44 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 02d729621bc..b7fd3318cee 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -2115,11 +2115,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) const int prec_comp = compare_tree_int (TYPE_RM_SIZE (gnu_index_type), TYPE_PRECISION (sizetype)); - const bool subrange_p = (prec_comp < 0) - || (prec_comp == 0 - && TYPE_UNSIGNED (gnu_index_type) - == TYPE_UNSIGNED (sizetype)); - const bool wider_p = (prec_comp > 0); + const bool subrange_p = (prec_comp < 0 + && (TYPE_UNSIGNED (gnu_index_type) + || !TYPE_UNSIGNED (sizetype))) + || (prec_comp == 0 + && TYPE_UNSIGNED (gnu_index_type) + == TYPE_UNSIGNED (sizetype)); tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type); tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type); tree gnu_min = convert (sizetype, gnu_orig_min); @@ -2298,7 +2299,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && TREE_CODE (TREE_TYPE (gnu_index_type)) != INTEGER_TYPE) || TYPE_BIASED_REPRESENTATION_P (gnu_index_type) - || wider_p) + || prec_comp > 0) need_index_type_struct = true; } @@ -5381,7 +5382,7 @@ 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; + tree gnu_lb, gnu_hb, gnu_lb_minus_one; /* If the low bound is not constant, try to find an upper bound. */ while (Nkind (gnat_lb) != N_Integer_Literal @@ -5401,19 +5402,23 @@ cannot_be_superflat_p (Node_Id gnat_range) || Nkind (scalar_range) == N_Range)) gnat_hb = Low_Bound (scalar_range); - if (!(Nkind (gnat_lb) == N_Integer_Literal - && Nkind (gnat_hb) == N_Integer_Literal)) + /* If we have failed to find constant bounds, punt. */ + if (Nkind (gnat_lb) != N_Integer_Literal + || Nkind (gnat_hb) != N_Integer_Literal) return false; - gnu_lb = UI_To_gnu (Intval (gnat_lb), bitsizetype); - gnu_hb = UI_To_gnu (Intval (gnat_hb), bitsizetype); + /* We need at least a signed 64-bit type to catch most cases. */ + gnu_lb = UI_To_gnu (Intval (gnat_lb), sbitsizetype); + gnu_hb = UI_To_gnu (Intval (gnat_hb), sbitsizetype); + if (TREE_OVERFLOW (gnu_lb) || TREE_OVERFLOW (gnu_hb)) + return false; /* If the low bound is the smallest integer, nothing can be smaller. */ - gnu_lb = size_binop (MINUS_EXPR, gnu_lb, bitsize_one_node); - if (TREE_OVERFLOW (gnu_lb)) + gnu_lb_minus_one = size_binop (MINUS_EXPR, gnu_lb, sbitsize_one_node); + if (TREE_OVERFLOW (gnu_lb_minus_one)) return true; - return (tree_int_cst_lt (gnu_hb, gnu_lb) == 0); + return !tree_int_cst_lt (gnu_hb, gnu_lb_minus_one); } /* Return true if GNU_EXPR is (essentially) the address of a CONSTRUCTOR. */ @@ -5876,7 +5881,6 @@ make_aligning_type (tree type, unsigned int align, tree size, /* We will be crafting a record type with one field at a position set to be the next multiple of ALIGN past record'address + room bytes. We use a record placeholder to express record'address. */ - tree record_type = make_node (RECORD_TYPE); tree record = build0 (PLACEHOLDER_EXPR, record_type); @@ -5896,7 +5900,6 @@ make_aligning_type (tree type, unsigned int align, tree size, Every length is in sizetype bytes there, except "pos" which has to be set as a bit position in the GCC tree for the record. */ - tree room_st = size_int (room); tree vblock_addr_st = size_binop (PLUS_EXPR, record_addr_st, room_st); tree voffset_st, pos, field; @@ -5911,13 +5914,11 @@ make_aligning_type (tree type, unsigned int align, tree size, /* Compute VOFFSET and then POS. The next byte position multiple of some alignment after some address is obtained by "and"ing the alignment minus 1 with the two's complement of the address. */ - voffset_st = size_binop (BIT_AND_EXPR, - size_diffop (size_zero_node, vblock_addr_st), - ssize_int ((align / BITS_PER_UNIT) - 1)); + fold_build1 (NEGATE_EXPR, sizetype, vblock_addr_st), + size_int ((align / BITS_PER_UNIT) - 1)); /* POS = (ROOM + VOFFSET) * BIT_PER_UNIT, in bitsizetype. */ - pos = size_binop (MULT_EXPR, convert (bitsizetype, size_binop (PLUS_EXPR, room_st, voffset_st)), @@ -5936,7 +5937,6 @@ make_aligning_type (tree type, unsigned int align, tree size, consequences on the alignment computation, and create_field_decl would make one without this special argument, for instance because of the complex position expression. */ - field = create_field_decl (get_identifier ("F"), type, record_type, 1, size, pos, -1); TYPE_FIELDS (record_type) = field; @@ -6287,6 +6287,7 @@ maybe_pad_type (tree type, tree size, unsigned int align, if (Present (gnat_entity) && size && TREE_CODE (size) != MAX_EXPR + && TREE_CODE (size) != COND_EXPR && !operand_equal_p (size, orig_size, 0) && !(TREE_CODE (size) == INTEGER_CST && TREE_CODE (orig_size) == INTEGER_CST @@ -7123,33 +7124,16 @@ annotate_value (tree gnu_size) if (TREE_OVERFLOW (gnu_size)) return No_Uint; - /* This may have come from a conversion from some smaller type, - so ensure this is in bitsizetype. */ + /* This may come from a conversion from some smaller type, so ensure + this is in bitsizetype. */ gnu_size = convert (bitsizetype, gnu_size); - /* For negative values, use NEGATE_EXPR of the supplied value. */ + /* For a negative value, use NEGATE_EXPR of the opposite. Such values + appear in expressions containing aligning patterns. */ if (tree_int_cst_sgn (gnu_size) < 0) { - /* The ridiculous code below is to handle the case of the largest - negative integer. */ - tree negative_size = size_diffop (bitsize_zero_node, gnu_size); - bool adjust = false; - tree temp; - - if (TREE_OVERFLOW (negative_size)) - { - negative_size - = size_binop (MINUS_EXPR, bitsize_zero_node, - size_binop (PLUS_EXPR, gnu_size, - bitsize_one_node)); - adjust = true; - } - - temp = build1 (NEGATE_EXPR, bitsizetype, negative_size); - if (adjust) - temp = build2 (MINUS_EXPR, bitsizetype, temp, bitsize_one_node); - - return annotate_value (temp); + tree op_size = fold_build1 (NEGATE_EXPR, bitsizetype, gnu_size); + return annotate_value (build1 (NEGATE_EXPR, bitsizetype, op_size)); } return UI_From_gnu (gnu_size); -- cgit v1.2.1 From 526c98579389dee0c99901aea0c1030761f83797 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sat, 17 Apr 2010 08:24:16 +0000 Subject: * back-end.adb (Call_Back_End): Pass Standard_Character to gigi. * gcc-interface/gigi.h (gigi): Add standard_character parameter. (CHAR_TYPE_SIZE, SHORT_TYPE_SIZE, INT_TYPE_SIZE, LONG_TYPE_SIZE, LONG_LONG_TYPE_SIZE, FLOAT_TYPE_SIZE, DOUBLE_TYPE_SIZE, LONG_DOUBLE_TYPE_SIZE, SIZE_TYPE): Delete. * gcc-interface/decl.c (gnat_to_gnu_entity) : Call rm_size. * gcc-interface/misc.c (gnat_init): Set signedness of char as per flag_signed_char. Tag sizetype with "size_type" moniker. * gcc-interface/trans.c (gigi): Add standard_character parameter. Remove useless built-in types. Equate unsigned_char_type_node to Standard.Character. Use it instead of char_type_node throughout. (Attribute_to_gnu): Likewise. (gnat_to_gnu): Likewise. * gcc-interface/utils2.c (build_call_raise): Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158462 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index b7fd3318cee..5d6bc79fd93 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -2113,7 +2113,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { tree gnu_index_type = get_unpadded_type (Etype (gnat_index)); const int prec_comp - = compare_tree_int (TYPE_RM_SIZE (gnu_index_type), + = compare_tree_int (rm_size (gnu_index_type), TYPE_PRECISION (sizetype)); const bool subrange_p = (prec_comp < 0 && (TYPE_UNSIGNED (gnu_index_type) -- cgit v1.2.1 From 3e70070e2728b17a16ceef391b6c74911db31065 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sat, 17 Apr 2010 14:16:36 +0000 Subject: * uintp.h (UI_Lt): Declare. * gcc-interface/decl.c (gnat_to_gnu_entity) : Do the size computation in sizetype. : Use unified handling for all index types. Do not generate MAX_EXPR-based expressions, only COND_EXPR-based ones. Add bypass for PATs. (annotate_value): Change test for negative values. (validate_size): Apply test for negative values on GNAT nodes. (set_rm_size): Likewise. * gcc-interface/misc.c (gnat_init): Set unsigned types for sizetypes. * gcc-interface/utils.c (rest_of_record_type_compilation): Change test for negative values. (max_size) : Do not reassociate a COND_EXPR on the LHS. (builtin_type_for_size): Adjust definition of signed_size_type_node. * gcc-interface/utils2.c (compare_arrays): Optimize comparison of lengths against zero. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158466 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 139 ++++++++++++++++++++----------------------- 1 file changed, 63 insertions(+), 76 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 5d6bc79fd93..b8e8a5b10bf 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -2112,15 +2112,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnat_base_index = Next_Index (gnat_base_index)) { tree gnu_index_type = get_unpadded_type (Etype (gnat_index)); - const int prec_comp - = compare_tree_int (rm_size (gnu_index_type), - TYPE_PRECISION (sizetype)); - const bool subrange_p = (prec_comp < 0 - && (TYPE_UNSIGNED (gnu_index_type) - || !TYPE_UNSIGNED (sizetype))) - || (prec_comp == 0 - && TYPE_UNSIGNED (gnu_index_type) - == TYPE_UNSIGNED (sizetype)); tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type); tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type); tree gnu_min = convert (sizetype, gnu_orig_min); @@ -2129,7 +2120,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = get_unpadded_type (Etype (gnat_base_index)); tree gnu_base_orig_min = TYPE_MIN_VALUE (gnu_base_index_type); tree gnu_base_orig_max = TYPE_MAX_VALUE (gnu_base_index_type); - tree gnu_high, gnu_low; + tree gnu_high; /* See if the base array type is already flat. If it is, we are probably compiling an ACATS test but it will cause the @@ -2145,8 +2136,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Similarly, if one of the values overflows in sizetype and the range is null, use 1..0 for the sizetype bounds. */ - else if (!subrange_p - && TREE_CODE (gnu_min) == INTEGER_CST + else if (TREE_CODE (gnu_min) == INTEGER_CST && TREE_CODE (gnu_max) == INTEGER_CST && (TREE_OVERFLOW (gnu_min) || TREE_OVERFLOW (gnu_max)) && tree_int_cst_lt (gnu_orig_max, gnu_orig_min)) @@ -2159,8 +2149,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* If the minimum and maximum values both overflow in sizetype, but the difference in the original type does not overflow in sizetype, ignore the overflow indication. */ - else if (!subrange_p - && TREE_CODE (gnu_min) == INTEGER_CST + else if (TREE_CODE (gnu_min) == INTEGER_CST && TREE_CODE (gnu_max) == INTEGER_CST && TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max) && !TREE_OVERFLOW @@ -2179,57 +2168,47 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) deal with the "superflat" case. There are three ways to do this. If we can prove that the array can never be superflat, we can just use the high bound of the index type. */ - else if (Nkind (gnat_index) == N_Range - && cannot_be_superflat_p (gnat_index)) + else if ((Nkind (gnat_index) == N_Range + && cannot_be_superflat_p (gnat_index)) + /* Packed Array Types are never superflat. */ + || Is_Packed_Array_Type (gnat_entity)) gnu_high = gnu_max; - /* Otherwise, if we can prove that the low bound minus one and - the high bound cannot overflow, we can just use the expression - MAX (hb, lb - 1). Similarly, if we can prove that the high - bound plus one and the low bound cannot overflow, we can use - the high bound as-is and MIN (hb + 1, lb) for the low bound. - Otherwise, we have to fall back to the most general expression - (hb >= lb) ? hb : lb - 1. Note that the comparison must be - done in the original index type, to avoid any overflow during - the conversion. */ - else + /* Otherwise, if the high bound is constant but the low bound is + not, we use the expression (hb >= lb) ? lb : hb + 1 for the + lower bound. Note that the comparison must be done in the + original type to avoid any overflow during the conversion. */ + else if (TREE_CODE (gnu_max) == INTEGER_CST + && TREE_CODE (gnu_min) != INTEGER_CST) { - gnu_high = size_binop (MINUS_EXPR, gnu_min, size_one_node); - gnu_low = size_binop (PLUS_EXPR, gnu_max, size_one_node); - - /* If gnu_high is a constant that has overflowed, the low - bound is the smallest integer so cannot be the maximum. - If gnu_low is a constant that has overflowed, the high - bound is the highest integer so cannot be the minimum. */ - if ((TREE_CODE (gnu_high) == INTEGER_CST - && TREE_OVERFLOW (gnu_high)) - || (TREE_CODE (gnu_low) == INTEGER_CST - && TREE_OVERFLOW (gnu_low))) - gnu_high = gnu_max; - - /* If the index type is a subrange and gnu_high a constant - that hasn't overflowed, we can use the maximum. */ - else if (subrange_p && TREE_CODE (gnu_high) == INTEGER_CST) - gnu_high = size_binop (MAX_EXPR, gnu_max, gnu_high); - - /* If the index type is a subrange and gnu_low a constant - that hasn't overflowed, we can use the minimum. */ - else if (subrange_p && TREE_CODE (gnu_low) == INTEGER_CST) - { - gnu_high = gnu_max; - gnu_min = size_binop (MIN_EXPR, gnu_min, gnu_low); - } - - else - gnu_high - = build_cond_expr (sizetype, - build_binary_op (GE_EXPR, - boolean_type_node, - gnu_orig_max, - gnu_orig_min), - gnu_max, gnu_high); + gnu_high = gnu_max; + gnu_min + = build_cond_expr (sizetype, + build_binary_op (GE_EXPR, + boolean_type_node, + gnu_orig_max, + gnu_orig_min), + gnu_min, + size_binop (PLUS_EXPR, gnu_max, + size_one_node)); } + /* Finally we use (hb >= lb) ? hb : lb - 1 for the upper bound + in all the other cases. Note that, here as well as above, + the condition used in the comparison must be equivalent to + the condition (length != 0). This is relied upon in order + to optimize array comparisons in compare_arrays. */ + else + gnu_high + = build_cond_expr (sizetype, + build_binary_op (GE_EXPR, + boolean_type_node, + gnu_orig_max, + gnu_orig_min), + gnu_max, + size_binop (MINUS_EXPR, gnu_min, + size_one_node)); + gnu_index_types[index] = create_index_type (gnu_min, gnu_high, gnu_index_type, gnat_entity); @@ -2299,7 +2278,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && TREE_CODE (TREE_TYPE (gnu_index_type)) != INTEGER_TYPE) || TYPE_BIASED_REPRESENTATION_P (gnu_index_type) - || prec_comp > 0) + || compare_tree_int (rm_size (gnu_index_type), + TYPE_PRECISION (sizetype)) > 0) need_index_type_struct = true; } @@ -7128,9 +7108,11 @@ annotate_value (tree gnu_size) this is in bitsizetype. */ gnu_size = convert (bitsizetype, gnu_size); - /* For a negative value, use NEGATE_EXPR of the opposite. Such values - appear in expressions containing aligning patterns. */ - if (tree_int_cst_sgn (gnu_size) < 0) + /* For a negative value, build NEGATE_EXPR of the opposite. Such values + appear in expressions containing aligning patterns. Note that, since + sizetype is sign-extended but nonetheless unsigned, we don't directly + use tree_int_cst_sgn. */ + if (TREE_INT_CST_HIGH (gnu_size) < 0) { tree op_size = fold_build1 (NEGATE_EXPR, bitsizetype, gnu_size); return annotate_value (build1 (NEGATE_EXPR, bitsizetype, op_size)); @@ -7498,6 +7480,10 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, if (uint_size == No_Uint) return NULL_TREE; + /* Ignore a negative size since that corresponds to our back-annotation. */ + if (UI_Lt (uint_size, Uint_0)) + return NULL_TREE; + /* Find the node to use for errors. */ if ((Ekind (gnat_object) == E_Component || Ekind (gnat_object) == E_Discriminant) @@ -7522,9 +7508,8 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, return NULL_TREE; } - /* Ignore a negative size since that corresponds to our back-annotation. - Also ignore a zero size if it is not permitted. */ - if (tree_int_cst_sgn (size) < 0 || (integer_zerop (size) && !zero_ok)) + /* Ignore a zero size if it is not permitted. */ + if (!zero_ok && integer_zerop (size)) return NULL_TREE; /* The size of objects is always a multiple of a byte. */ @@ -7611,6 +7596,10 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity) if (uint_size == No_Uint) return; + /* Ignore a negative size since that corresponds to our back-annotation. */ + if (UI_Lt (uint_size, Uint_0)) + return; + /* Only issue an error if a Value_Size clause was explicitly given. Otherwise, we'd be duplicating an error on the Size clause. */ gnat_attr_node @@ -7627,15 +7616,13 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity) return; } - /* Ignore a negative size since that corresponds to our back-annotation. - Also ignore a zero size unless a Value_Size clause exists, or a size - clause exists, or this is an integer type, in which case the front-end - will have always set it. */ - if (tree_int_cst_sgn (size) < 0 - || (integer_zerop (size) - && No (gnat_attr_node) - && !Has_Size_Clause (gnat_entity) - && !Is_Discrete_Or_Fixed_Point_Type (gnat_entity))) + /* Ignore a zero size unless a Value_Size clause exists, or a size clause + exists, or this is an integer type, in which case the front-end will + have always set it. */ + if (No (gnat_attr_node) + && integer_zerop (size) + && !Has_Size_Clause (gnat_entity) + && !Is_Discrete_Or_Fixed_Point_Type (gnat_entity)) return; old_size = rm_size (gnu_type); -- cgit v1.2.1 From 268e8c50e38a646dec47223dbe4ccf4595a80164 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sat, 17 Apr 2010 14:32:15 +0000 Subject: Add missing hunk for previous patch. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158467 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 68 ++++++++++++++++++++++++-------------------- 1 file changed, 37 insertions(+), 31 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index b8e8a5b10bf..f9d88a6a9bb 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1889,55 +1889,59 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) char field_name[16]; tree gnu_index_base_type = get_unpadded_type (Base_Type (Etype (gnat_index))); - tree gnu_low_field, gnu_high_field, gnu_low, gnu_high, gnu_max; + tree gnu_lb_field, gnu_hb_field, gnu_orig_min, gnu_orig_max; + tree gnu_min, gnu_max, gnu_high; /* Make the FIELD_DECLs for the low and high bounds of this type and then make extractions of these fields from the template. */ sprintf (field_name, "LB%d", index); - gnu_low_field = create_field_decl (get_identifier (field_name), - gnu_index_base_type, - gnu_template_type, 0, - NULL_TREE, NULL_TREE, 0); + gnu_lb_field = create_field_decl (get_identifier (field_name), + gnu_index_base_type, + gnu_template_type, 0, + NULL_TREE, NULL_TREE, 0); Sloc_to_locus (Sloc (gnat_entity), - &DECL_SOURCE_LOCATION (gnu_low_field)); + &DECL_SOURCE_LOCATION (gnu_lb_field)); field_name[0] = 'U'; - gnu_high_field = create_field_decl (get_identifier (field_name), - gnu_index_base_type, - gnu_template_type, 0, - NULL_TREE, NULL_TREE, 0); + gnu_hb_field = create_field_decl (get_identifier (field_name), + gnu_index_base_type, + gnu_template_type, 0, + NULL_TREE, NULL_TREE, 0); Sloc_to_locus (Sloc (gnat_entity), - &DECL_SOURCE_LOCATION (gnu_high_field)); + &DECL_SOURCE_LOCATION (gnu_hb_field)); - gnu_temp_fields[index] = chainon (gnu_low_field, gnu_high_field); + gnu_temp_fields[index] = chainon (gnu_lb_field, gnu_hb_field); /* We can't use build_component_ref here since the template type isn't complete yet. */ - gnu_low = build3 (COMPONENT_REF, gnu_index_base_type, - gnu_template_reference, gnu_low_field, - NULL_TREE); - gnu_high = build3 (COMPONENT_REF, gnu_index_base_type, - gnu_template_reference, gnu_high_field, - NULL_TREE); - TREE_READONLY (gnu_low) = TREE_READONLY (gnu_high) = 1; - - /* Compute the size of this dimension. */ - gnu_max - = build3 (COND_EXPR, gnu_index_base_type, - build2 (GE_EXPR, boolean_type_node, gnu_high, gnu_low), - gnu_high, - build2 (MINUS_EXPR, gnu_index_base_type, - gnu_low, fold_convert (gnu_index_base_type, - integer_one_node))); + gnu_orig_min = build3 (COMPONENT_REF, gnu_index_base_type, + gnu_template_reference, gnu_lb_field, + NULL_TREE); + gnu_orig_max = build3 (COMPONENT_REF, gnu_index_base_type, + gnu_template_reference, gnu_hb_field, + NULL_TREE); + TREE_READONLY (gnu_orig_min) = TREE_READONLY (gnu_orig_max) = 1; + + gnu_min = convert (sizetype, gnu_orig_min); + gnu_max = convert (sizetype, gnu_orig_max); + + /* Compute the size of this dimension. See the E_Array_Subtype + case below for the rationale. */ + gnu_high + = build3 (COND_EXPR, sizetype, + build2 (GE_EXPR, boolean_type_node, + gnu_orig_max, gnu_orig_min), + gnu_max, + size_binop (MINUS_EXPR, gnu_min, size_one_node)); /* Make a range type with the new range in the Ada base type. Then make an index type with the size range in sizetype. */ gnu_index_types[index] - = create_index_type (convert (sizetype, gnu_low), - convert (sizetype, gnu_max), + = create_index_type (gnu_min, gnu_high, create_range_type (gnu_index_base_type, - gnu_low, gnu_high), + gnu_orig_min, + gnu_orig_max), gnat_entity); /* Update the maximum size of the array in elements. */ @@ -2209,6 +2213,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) size_binop (MINUS_EXPR, gnu_min, size_one_node)); + /* Reuse the index type for the range type. Then make an index + type with the size range in sizetype. */ gnu_index_types[index] = create_index_type (gnu_min, gnu_high, gnu_index_type, gnat_entity); -- cgit v1.2.1 From 0954931c29742fea64063d4fda678604b2894ec8 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sun, 25 Apr 2010 09:42:41 +0000 Subject: * exp_dbug.ads: Fix outdated description. Mention link between XVS and XVZ objects. * gcc-interface/decl.c (gnat_to_gnu_entity) : Set XVZ variable as unit size of XVS type. (maybe_pad_type): Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158703 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index f9d88a6a9bb..ccedee020f0 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -3258,9 +3258,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (definition && TREE_CODE (gnu_size_unit) != INTEGER_CST && !CONTAINS_PLACEHOLDER_P (gnu_size_unit)) - create_var_decl (create_concat_name (gnat_entity, "XVZ"), - NULL_TREE, sizetype, gnu_size_unit, false, - false, false, false, NULL, gnat_entity); + TYPE_SIZE_UNIT (gnu_subtype_marker) + = create_var_decl (create_concat_name (gnat_entity, + "XVZ"), + NULL_TREE, sizetype, gnu_size_unit, + false, false, false, false, NULL, + gnat_entity); } /* Now we can finalize it. */ @@ -6253,9 +6256,10 @@ maybe_pad_type (tree type, tree size, unsigned int align, add_parallel_type (TYPE_STUB_DECL (record), marker); if (definition && size && TREE_CODE (size) != INTEGER_CST) - create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype, - TYPE_SIZE_UNIT (record), false, false, false, - false, NULL, gnat_entity); + TYPE_SIZE_UNIT (marker) + = create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype, + TYPE_SIZE_UNIT (record), false, false, false, + false, NULL, gnat_entity); } rest_of_record_type_compilation (record); -- cgit v1.2.1 From 8c77dd4889a88142439c59c55cc1d43db908eeb5 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sat, 8 May 2010 11:02:08 +0000 Subject: * gcc-interface/gigi.h (build_unc_object_type): Add DEBUG_INFO_P param. (build_unc_object_type_from_ptr): Likewise. * gcc-interface/utils.c (build_unc_object_type): Add DEBUG_INFO_P param and pass it to create_type_decl. Declare the type. Simplify. (build_unc_object_type_from_ptr): Add DEBUG_INFO_P parameter and pass it to build_unc_object_type. * gcc-interface/decl.c (gnat_to_gnu_entity): Adjust to above change. * gcc-interface/trans.c (Attribute_to_gnu): Likewise. (gnat_to_gnu): Likewise. * gcc-interface/utils2.c (build_allocator): Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159180 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index ccedee020f0..137cbbb3d63 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -807,7 +807,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = build_unc_object_type_from_ptr (gnu_fat, gnu_type, concat_name (gnu_entity_name, - "UNC")); + "UNC"), + debug_info_p); } #ifdef MINIMUM_ATOMIC_ALIGNMENT @@ -2066,7 +2067,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) a record type for the object and its template with the fields shifted to have the template at a negative offset. */ tem = build_unc_object_type (gnu_template_type, tem, - create_concat_name (gnat_name, "XUT")); + create_concat_name (gnat_name, "XUT"), + debug_info_p); shift_unc_components_for_thin_pointers (tem); SET_TYPE_UNCONSTRAINED_ARRAY (tem, gnu_type); -- cgit v1.2.1 From d51eba1a266862e911669b771b53de79a4ed8ec2 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sat, 8 May 2010 11:17:57 +0000 Subject: * gcc-interface/gigi.h (create_field_decl): Move PACKED parameter. * gcc-interface/utils.c (create_field_decl): Move PACKED parameter. (rest_of_record_type_compilation): Adjust call to create_field_decl. (make_descriptor_field): Likewise and pass correctly typed constants. (build_unc_object_type): Likewise. (unchecked_convert): Likewise. * gcc-interface/decl.c (elaborate_expression_2): New static function. (gnat_to_gnu_entity): Use it to make alignment factors explicit. Adjust call to create_field_decl. (make_aligning_type): Likewise. (make_packable_type): Likewise. (maybe_pad_type): Likewise. (gnat_to_gnu_field): Likewise. (components_to_record): Likewise. (create_field_decl_from): Likewise. (create_variant_part_from): Remove superfluous test. * gcc-interface/trans.c (gigi): Adjust call to create_field_decl. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159181 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 253 ++++++++++++++++++++++--------------------- 1 file changed, 128 insertions(+), 125 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 137cbbb3d63..3050475d6cf 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -129,6 +129,8 @@ static void prepend_attributes (Entity_Id, struct attrib **); static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool); static bool is_variable_size (tree); static tree elaborate_expression_1 (tree, Entity_Id, tree, bool, bool); +static tree elaborate_expression_2 (tree, Entity_Id, tree, bool, bool, + unsigned int); static tree make_packable_type (tree, bool); static tree gnat_to_gnu_component_type (Entity_Id, bool, bool); static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool, @@ -1668,9 +1670,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Don't notify the field as "addressable", since we won't be taking it's address and it would prevent create_field_decl from making a bitfield. */ - gnu_field = create_field_decl (get_identifier ("OBJECT"), - gnu_field_type, gnu_type, 1, - NULL_TREE, bitsize_zero_node, 0); + gnu_field + = create_field_decl (get_identifier ("OBJECT"), gnu_field_type, + gnu_type, NULL_TREE, bitsize_zero_node, 1, 0); /* Do not emit debug info until after the parallel type is added. */ finish_record_type (gnu_type, gnu_field, 2, false); @@ -1719,9 +1721,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Don't notify the field as "addressable", since we won't be taking it's address and it would prevent create_field_decl from making a bitfield. */ - gnu_field = create_field_decl (get_identifier ("F"), - gnu_field_type, gnu_type, 1, - NULL_TREE, bitsize_zero_node, 0); + gnu_field + = create_field_decl (get_identifier ("F"), gnu_field_type, + gnu_type, NULL_TREE, bitsize_zero_node, 1, 0); finish_record_type (gnu_type, gnu_field, 2, debug_info_p); compute_record_mode (gnu_type); @@ -1854,12 +1856,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tem = chainon (chainon (NULL_TREE, create_field_decl (get_identifier ("P_ARRAY"), ptr_void_type_node, - gnu_fat_type, 0, - NULL_TREE, NULL_TREE, 0)), + gnu_fat_type, NULL_TREE, + NULL_TREE, 0, 0)), create_field_decl (get_identifier ("P_BOUNDS"), gnu_ptr_template, - gnu_fat_type, 0, - NULL_TREE, NULL_TREE, 0)); + gnu_fat_type, NULL_TREE, + NULL_TREE, 0, 0)); /* Make sure we can put this into a register. */ TYPE_ALIGN (gnu_fat_type) = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE); @@ -1899,16 +1901,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) sprintf (field_name, "LB%d", index); gnu_lb_field = create_field_decl (get_identifier (field_name), gnu_index_base_type, - gnu_template_type, 0, - NULL_TREE, NULL_TREE, 0); + gnu_template_type, NULL_TREE, + NULL_TREE, 0, 0); Sloc_to_locus (Sloc (gnat_entity), &DECL_SOURCE_LOCATION (gnu_lb_field)); field_name[0] = 'U'; gnu_hb_field = create_field_decl (get_identifier (field_name), gnu_index_base_type, - gnu_template_type, 0, - NULL_TREE, NULL_TREE, 0); + gnu_template_type, NULL_TREE, + NULL_TREE, 0, 0); Sloc_to_locus (Sloc (gnat_entity), &DECL_SOURCE_LOCATION (gnu_hb_field)); @@ -2354,35 +2356,30 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) inner dimensions. */ if (global_bindings_p () && ndim > 1) { - tree gnu_str_name = get_identifier ("ST"); + tree gnu_st_name = get_identifier ("ST"); tree gnu_arr_type; for (gnu_arr_type = TREE_TYPE (gnu_type); TREE_CODE (gnu_arr_type) == ARRAY_TYPE; gnu_arr_type = TREE_TYPE (gnu_arr_type), - gnu_str_name = concat_name (gnu_str_name, "ST")) + gnu_st_name = concat_name (gnu_st_name, "ST")) { tree eltype = TREE_TYPE (gnu_arr_type); TYPE_SIZE (gnu_arr_type) = elaborate_expression_1 (TYPE_SIZE (gnu_arr_type), - gnat_entity, gnu_str_name, + gnat_entity, gnu_st_name, definition, false); /* ??? For now, store the size as a multiple of the alignment of the element type in bytes so that we can see the alignment from the tree. */ TYPE_SIZE_UNIT (gnu_arr_type) - = build_binary_op - (MULT_EXPR, sizetype, - elaborate_expression_1 - (build_binary_op (EXACT_DIV_EXPR, sizetype, - TYPE_SIZE_UNIT (gnu_arr_type), - size_int (TYPE_ALIGN (eltype) - / BITS_PER_UNIT)), - gnat_entity, concat_name (gnu_str_name, "A_U"), - definition, false), - size_int (TYPE_ALIGN (eltype) / BITS_PER_UNIT)); + = elaborate_expression_2 (TYPE_SIZE_UNIT (gnu_arr_type), + gnat_entity, + concat_name (gnu_st_name, "A_U"), + definition, false, + TYPE_ALIGN (eltype)); /* ??? create_type_decl is not invoked on the inner types so the MULT_EXPR node built above will never be marked. */ @@ -2416,8 +2413,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Make sure to reference the types themselves, and not just their names, as the debugger may fall back on them. */ gnu_field = create_field_decl (gnu_index_name, gnu_index, - gnu_bound_rec, - 0, NULL_TREE, NULL_TREE, 0); + gnu_bound_rec, NULL_TREE, + NULL_TREE, 0, 0); TREE_CHAIN (gnu_field) = gnu_field_list; gnu_field_list = gnu_field; } @@ -2849,11 +2846,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* ...and reference the _Parent field of this record. */ gnu_field = create_field_decl (parent_name_id, - gnu_parent, gnu_type, 0, + gnu_parent, gnu_type, has_rep ? TYPE_SIZE (gnu_parent) : NULL_TREE, has_rep - ? bitsize_zero_node : NULL_TREE, 1); + ? bitsize_zero_node : NULL_TREE, + 0, 1); DECL_INTERNAL_P (gnu_field) = 1; TREE_OPERAND (gnu_get_parent, 1) = gnu_field; TYPE_FIELDS (gnu_type) = gnu_field; @@ -3250,8 +3248,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) build_reference_type (gnu_unpad_base_type), gnu_subtype_marker, - 0, NULL_TREE, - NULL_TREE, 0), + NULL_TREE, NULL_TREE, + 0, 0), 0, true); add_parallel_type (TYPE_STUB_DECL (gnu_type), @@ -3477,11 +3475,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = chainon (chainon (NULL_TREE, create_field_decl (get_identifier ("P_ARRAY"), - gnu_ptr_array, - gnu_type, 0, 0, 0, 0)), + gnu_ptr_array, gnu_type, + NULL_TREE, NULL_TREE, 0, 0)), create_field_decl (get_identifier ("P_BOUNDS"), - gnu_ptr_template, - gnu_type, 0, 0, 0, 0)); + gnu_ptr_template, gnu_type, + NULL_TREE, NULL_TREE, 0, 0)); /* Make sure we can place this into a register. */ TYPE_ALIGN (gnu_type) @@ -4090,8 +4088,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) has_copy_in_out = true; } - gnu_field = create_field_decl (gnu_param_name, gnu_param_type, - gnu_return_type, 0, 0, 0, 0); + gnu_field + = create_field_decl (gnu_param_name, gnu_param_type, + gnu_return_type, NULL_TREE, NULL_TREE, + 0, 0); Sloc_to_locus (Sloc (gnat_param), &DECL_SOURCE_LOCATION (gnu_field)); TREE_CHAIN (gnu_field) = gnu_field_list; @@ -4495,45 +4495,38 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && !TREE_CONSTANT (TYPE_SIZE (gnu_type)) && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))) { - if (TREE_CODE (gnu_type) == RECORD_TYPE - && operand_equal_p (TYPE_ADA_SIZE (gnu_type), - TYPE_SIZE (gnu_type), 0)) - { - TYPE_SIZE (gnu_type) - = elaborate_expression_1 (TYPE_SIZE (gnu_type), - gnat_entity, get_identifier ("SIZE"), - definition, false); - SET_TYPE_ADA_SIZE (gnu_type, TYPE_SIZE (gnu_type)); - } - else + tree size = TYPE_SIZE (gnu_type); + + TYPE_SIZE (gnu_type) + = elaborate_expression_1 (size, gnat_entity, + get_identifier ("SIZE"), + definition, false); + + /* ??? For now, store the size as a multiple of the alignment in + bytes so that we can see the alignment from the tree. */ + TYPE_SIZE_UNIT (gnu_type) + = elaborate_expression_2 (TYPE_SIZE_UNIT (gnu_type), gnat_entity, + get_identifier ("SIZE_A_UNIT"), + definition, false, + TYPE_ALIGN (gnu_type)); + + /* ??? gnu_type may come from an existing type so the MULT_EXPR node + may not be marked by the call to create_type_decl below. */ + MARK_VISITED (TYPE_SIZE_UNIT (gnu_type)); + + if (TREE_CODE (gnu_type) == RECORD_TYPE) { - TYPE_SIZE (gnu_type) - = elaborate_expression_1 (TYPE_SIZE (gnu_type), - gnat_entity, get_identifier ("SIZE"), - definition, false); + tree ada_size = TYPE_ADA_SIZE (gnu_type); - /* ??? For now, store the size as a multiple of the alignment - in bytes so that we can see the alignment from the tree. */ - TYPE_SIZE_UNIT (gnu_type) - = build_binary_op - (MULT_EXPR, sizetype, - elaborate_expression_1 - (build_binary_op (EXACT_DIV_EXPR, sizetype, - TYPE_SIZE_UNIT (gnu_type), - size_int (TYPE_ALIGN (gnu_type) - / BITS_PER_UNIT)), - gnat_entity, get_identifier ("SIZE_A_UNIT"), - definition, false), - size_int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT)); - - if (TREE_CODE (gnu_type) == RECORD_TYPE) - SET_TYPE_ADA_SIZE - (gnu_type, - elaborate_expression_1 (TYPE_ADA_SIZE (gnu_type), - gnat_entity, - get_identifier ("RM_SIZE"), - definition, false)); - } + if (operand_equal_p (ada_size, size, 0)) + ada_size = TYPE_SIZE (gnu_type); + else + ada_size + = elaborate_expression_1 (ada_size, gnat_entity, + get_identifier ("RM_SIZE"), + definition, false); + SET_TYPE_ADA_SIZE (gnu_type, ada_size); + } } /* If this is a record type or subtype, call elaborate_expression_1 on @@ -4547,30 +4540,22 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { tree gnu_field = get_gnu_tree (gnat_temp); - /* ??? Unfortunately, GCC needs to be able to prove the - alignment of this offset and if it's a variable, it can't. - In GCC 3.4, we'll use DECL_OFFSET_ALIGN in some way, but - right now, we have to put in an explicit multiply and - divide by that value. */ + /* ??? For now, store the offset as a multiple of the alignment + in bytes so that we can see the alignment from the tree. */ if (!CONTAINS_PLACEHOLDER_P (DECL_FIELD_OFFSET (gnu_field))) { - DECL_FIELD_OFFSET (gnu_field) - = build_binary_op - (MULT_EXPR, sizetype, - elaborate_expression_1 - (build_binary_op (EXACT_DIV_EXPR, sizetype, - DECL_FIELD_OFFSET (gnu_field), - size_int (DECL_OFFSET_ALIGN (gnu_field) - / BITS_PER_UNIT)), - gnat_temp, get_identifier ("OFFSET"), - definition, false), - size_int (DECL_OFFSET_ALIGN (gnu_field) / BITS_PER_UNIT)); - - /* ??? The context of gnu_field is not necessarily gnu_type so - the MULT_EXPR node built above may not be marked by the call - to create_type_decl below. */ - if (global_bindings_p ()) - MARK_VISITED (DECL_FIELD_OFFSET (gnu_field)); + DECL_FIELD_OFFSET (gnu_field) + = elaborate_expression_2 (DECL_FIELD_OFFSET (gnu_field), + gnat_temp, + get_identifier ("OFFSET"), + definition, false, + DECL_OFFSET_ALIGN (gnu_field)); + + /* ??? The context of gnu_field is not necessarily gnu_type + so the MULT_EXPR node built above may not be marked by + the call to create_type_decl below. */ + if (global_bindings_p ()) + MARK_VISITED (DECL_FIELD_OFFSET (gnu_field)); } } @@ -5859,6 +5844,23 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name, return expr_variable ? gnat_save_expr (gnu_expr) : gnu_expr; } + +/* Similar, but take an alignment factor and make it explicit in the tree. */ + +static tree +elaborate_expression_2 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name, + bool definition, bool need_debug, unsigned int align) +{ + tree unit_align = size_int (align / BITS_PER_UNIT); + return + size_binop (MULT_EXPR, + elaborate_expression_1 (size_binop (EXACT_DIV_EXPR, + gnu_expr, + unit_align), + gnat_entity, gnu_name, definition, + need_debug), + unit_align); +} /* Create a record type that contains a SIZE bytes long field of TYPE with a starting bit position so that it is aligned to ALIGN bits, and leaving at @@ -5928,8 +5930,8 @@ make_aligning_type (tree type, unsigned int align, tree size, consequences on the alignment computation, and create_field_decl would make one without this special argument, for instance because of the complex position expression. */ - field = create_field_decl (get_identifier ("F"), type, record_type, - 1, size, pos, -1); + field = create_field_decl (get_identifier ("F"), type, record_type, size, + pos, 1, -1); TYPE_FIELDS (record_type) = field; TYPE_ALIGN (record_type) = base_align; @@ -6050,10 +6052,11 @@ make_packable_type (tree type, bool in_record) else new_size = DECL_SIZE (old_field); - new_field = create_field_decl (DECL_NAME (old_field), new_field_type, - new_type, TYPE_PACKED (type), new_size, - bit_position (old_field), - !DECL_NONADDRESSABLE_P (old_field)); + new_field + = create_field_decl (DECL_NAME (old_field), new_field_type, new_type, + new_size, bit_position (old_field), + TYPE_PACKED (type), + !DECL_NONADDRESSABLE_P (old_field)); DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field); SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field); @@ -6217,8 +6220,8 @@ maybe_pad_type (tree type, tree size, unsigned int align, } /* Now create the field with the original size. */ - field = create_field_decl (get_identifier ("F"), type, record, 0, - orig_size, bitsize_zero_node, 1); + field = create_field_decl (get_identifier ("F"), type, record, orig_size, + bitsize_zero_node, 0, 1); DECL_INTERNAL_P (field) = 1; /* Do not emit debug info until after the auxiliary record is built. */ @@ -6251,8 +6254,8 @@ maybe_pad_type (tree type, tree size, unsigned int align, finish_record_type (marker, create_field_decl (orig_name, build_reference_type (type), - marker, 0, NULL_TREE, NULL_TREE, - 0), + marker, NULL_TREE, NULL_TREE, + 0, 0), 0, true); add_parallel_type (TYPE_STUB_DECL (record), marker); @@ -6680,9 +6683,9 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, || !TYPE_CONTAINS_TEMPLATE_P (gnu_field_type)); /* Now create the decl for the field. */ - gnu_field = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type, - packed, gnu_size, gnu_pos, - Is_Aliased (gnat_field)); + gnu_field + = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type, + gnu_size, gnu_pos, packed, Is_Aliased (gnat_field)); Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field)); TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field); @@ -6934,14 +6937,14 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, create_type_decl (TYPE_NAME (gnu_variant_type), gnu_variant_type, NULL, true, debug_info_p, gnat_component_list); - gnu_field = create_field_decl (gnu_inner_name, gnu_variant_type, - gnu_union_type, field_packed, - (all_rep_and_size - ? TYPE_SIZE (gnu_variant_type) - : 0), - (all_rep_and_size - ? bitsize_zero_node : 0), - 0); + gnu_field + = create_field_decl (gnu_inner_name, gnu_variant_type, + gnu_union_type, + all_rep_and_size + ? TYPE_SIZE (gnu_variant_type) : 0, + all_rep_and_size + ? bitsize_zero_node : 0, + field_packed, 0); DECL_INTERNAL_P (gnu_field) = 1; @@ -6988,9 +6991,9 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, gnu_union_field = create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type, - union_field_packed, all_rep ? TYPE_SIZE (gnu_union_type) : 0, - all_rep ? bitsize_zero_node : 0, 0); + all_rep ? bitsize_zero_node : 0, + union_field_packed, 0); DECL_INTERNAL_P (gnu_union_field) = 1; TREE_CHAIN (gnu_union_field) = gnu_field_list; @@ -7061,7 +7064,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, finish_record_type (gnu_rep_type, gnu_our_rep_list, 1, debug_info_p); gnu_field = create_field_decl (get_identifier ("REP"), gnu_rep_type, - gnu_record_type, 0, NULL_TREE, NULL_TREE, 1); + gnu_record_type, NULL_TREE, NULL_TREE, 0, 1); DECL_INTERNAL_P (gnu_field) = 1; gnu_field_list = chainon (gnu_field_list, gnu_field); } @@ -8003,7 +8006,7 @@ create_field_decl_from (tree old_field, tree field_type, tree record_type, new_field = create_field_decl (DECL_NAME (old_field), field_type, record_type, - DECL_PACKED (old_field), size, new_pos, + size, new_pos, DECL_PACKED (old_field), !DECL_NONADDRESSABLE_P (old_field)); if (!new_pos) @@ -8071,7 +8074,6 @@ create_variant_part_from (tree old_variant_part, tree variant_list, tree record_type, tree pos_list, tree subst_list) { tree offset = DECL_FIELD_OFFSET (old_variant_part); - tree bitpos = DECL_FIELD_BIT_OFFSET (old_variant_part); tree old_union_type = TREE_TYPE (old_variant_part); tree new_union_type, new_variant_part, t; tree union_field_list = NULL_TREE; @@ -8083,8 +8085,9 @@ create_variant_part_from (tree old_variant_part, tree variant_list, /* If the position of the variant part is constant, subtract it from the size of the type of the parent to get the new size. This manual CSE reduces the code size when not optimizing. */ - if (TREE_CODE (offset) == INTEGER_CST && TREE_CODE (bitpos) == INTEGER_CST) + if (TREE_CODE (offset) == INTEGER_CST) { + tree bitpos = DECL_FIELD_BIT_OFFSET (old_variant_part); tree first_bit = bit_from_pos (offset, bitpos); TYPE_SIZE (new_union_type) = size_binop (MINUS_EXPR, TYPE_SIZE (record_type), first_bit); -- cgit v1.2.1 From c1c960b600444065ad759bc48f41bb9e15f97b75 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sat, 8 May 2010 11:31:31 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity): Create variables for size expressions of variant part of record types declared at library level. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159182 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 54 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 3050475d6cf..b0334f2c8ed 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -4516,8 +4516,62 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (TREE_CODE (gnu_type) == RECORD_TYPE) { + tree variant_part = get_variant_part (gnu_type); tree ada_size = TYPE_ADA_SIZE (gnu_type); + if (variant_part) + { + tree union_type = TREE_TYPE (variant_part); + tree offset = DECL_FIELD_OFFSET (variant_part); + + /* If the position of the variant part is constant, subtract + it from the size of the type of the parent to get the new + size. This manual CSE reduces the data size. */ + if (TREE_CODE (offset) == INTEGER_CST) + { + tree bitpos = DECL_FIELD_BIT_OFFSET (variant_part); + TYPE_SIZE (union_type) + = size_binop (MINUS_EXPR, TYPE_SIZE (gnu_type), + bit_from_pos (offset, bitpos)); + TYPE_SIZE_UNIT (union_type) + = size_binop (MINUS_EXPR, TYPE_SIZE_UNIT (gnu_type), + byte_from_pos (offset, bitpos)); + } + else + { + TYPE_SIZE (union_type) + = elaborate_expression_1 (TYPE_SIZE (union_type), + gnat_entity, + get_identifier ("VSIZE"), + definition, false); + + /* ??? For now, store the size as a multiple of the + alignment in bytes so that we can see the alignment + from the tree. */ + TYPE_SIZE_UNIT (union_type) + = elaborate_expression_2 (TYPE_SIZE_UNIT (union_type), + gnat_entity, + get_identifier + ("VSIZE_A_UNIT"), + definition, false, + TYPE_ALIGN (union_type)); + + /* ??? For now, store the offset as a multiple of the + alignment in bytes so that we can see the alignment + from the tree. */ + DECL_FIELD_OFFSET (variant_part) + = elaborate_expression_2 (offset, + gnat_entity, + get_identifier ("VOFFSET"), + definition, false, + DECL_OFFSET_ALIGN + (variant_part)); + } + + DECL_SIZE (variant_part) = TYPE_SIZE (union_type); + DECL_SIZE_UNIT (variant_part) = TYPE_SIZE_UNIT (union_type); + } + if (operand_equal_p (ada_size, size, 0)) ada_size = TYPE_SIZE (gnu_type); else -- cgit v1.2.1 From 4ce8ada59713e8a15d5082d98bf23d5f0e6ffbd4 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sat, 8 May 2010 11:38:26 +0000 Subject: * gcc-interface/decl.c (make_aligning_type): Declare the type. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159183 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index b0334f2c8ed..6df79fb878e 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -5955,8 +5955,8 @@ make_aligning_type (tree type, unsigned int align, tree size, if (TREE_CODE (name) == TYPE_DECL) name = DECL_NAME (name); - - TYPE_NAME (record_type) = concat_name (name, "_ALIGN"); + name = concat_name (name, "ALIGN"); + TYPE_NAME (record_type) = name; /* Compute VOFFSET and then POS. The next byte position multiple of some alignment after some address is obtained by "and"ing the alignment minus @@ -6001,8 +6001,12 @@ make_aligning_type (tree type, unsigned int align, tree size, size_int (room + align / BITS_PER_UNIT)); SET_TYPE_MODE (record_type, BLKmode); - relate_alias_sets (record_type, type, ALIAS_SET_COPY); + + /* Declare it now since it will never be declared otherwise. This is + necessary to ensure that its subtrees are properly marked. */ + create_type_decl (name, record_type, NULL, true, false, Empty); + return record_type; } -- cgit v1.2.1 From 7640ed3d8a38f4eedd02419fb353ac66320fc78e Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sat, 8 May 2010 11:50:18 +0000 Subject: * exp_disp.adb (Make_Tags): Mark the imported view of dispatch tables. * gcc-interface/decl.c (gnat_to_gnu_entity) : Make imported constants really constant. : Strip the suffix for dispatch table entities. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159184 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 6df79fb878e..fba552bc0e0 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -560,7 +560,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && (((Nkind (Declaration_Node (gnat_entity)) == N_Object_Declaration) && Present (Expression (Declaration_Node (gnat_entity)))) - || Present (Renamed_Object (gnat_entity)))); + || Present (Renamed_Object (gnat_entity)) + || Is_Imported (gnat_entity))); bool inner_const_flag = const_flag; bool static_p = Is_Statically_Allocated (gnat_entity); bool mutable_p = false; @@ -2975,6 +2976,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) break; } + /* If this is a record subtype associated with a dispatch table, + strip the suffix. This is necessary to make sure 2 different + subtypes associated with the imported and exported views of a + dispatch table are properly merged in LTO mode. */ + if (Is_Dispatch_Table_Entity (gnat_entity)) + { + char *p; + Get_Encoded_Name (gnat_entity); + p = strrchr (Name_Buffer, '_'); + gcc_assert (p); + strcpy (p+1, "dtS"); + gnu_entity_name = get_identifier (Name_Buffer); + } + /* When the subtype has discriminants and these discriminants affect the initial shape it has inherited, factor them in. But for an Unchecked_Union (it must be an Itype), just return the type. -- cgit v1.2.1 From d04be62faa126e69f58de254e9a91c5b744c9122 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Mon, 10 May 2010 21:52:45 +0000 Subject: * exp_disp.adb (Make_Tags): Mark the imported view of dispatch tables built for interfaces. * gcc-interface/decl.c (gnat_to_gnu_entity) : Use imported_p instead of Is_Imported when considering constants. Do not promote alignment of exported objects. : Strip all suffixes for dispatch table entities. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159247 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index fba552bc0e0..3118cfc2bd4 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -561,7 +561,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) == N_Object_Declaration) && Present (Expression (Declaration_Node (gnat_entity)))) || Present (Renamed_Object (gnat_entity)) - || Is_Imported (gnat_entity))); + || imported_p)); bool inner_const_flag = const_flag; bool static_p = Is_Statically_Allocated (gnat_entity); bool mutable_p = false; @@ -742,6 +742,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && kind != E_Out_Parameter && Is_Composite_Type (Etype (gnat_entity)) && !Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity)) + && !Is_Exported (gnat_entity) && !imported_p && No (Renamed_Object (gnat_entity)) && No (Address_Clause (gnat_entity)))) @@ -1000,7 +1001,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if ((Treat_As_Volatile (gnat_entity) || (!const_flag && (Is_Exported (gnat_entity) - || Is_Imported (gnat_entity) + || imported_p || Present (Address_Clause (gnat_entity))))) && !TYPE_VOLATILE (gnu_type)) gnu_type = build_qualified_type (gnu_type, @@ -2984,9 +2985,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { char *p; Get_Encoded_Name (gnat_entity); - p = strrchr (Name_Buffer, '_'); + p = strchr (Name_Buffer, '_'); gcc_assert (p); - strcpy (p+1, "dtS"); + strcpy (p+2, "dtS"); gnu_entity_name = get_identifier (Name_Buffer); } -- cgit v1.2.1 From b7ef90703a934af8574e5101b3209d99f0dfdb74 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Wed, 12 May 2010 11:27:24 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity) : Tidy up code, improve comments and fix formatting nits. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159312 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 209 ++++++++++++++++++++----------------------- 1 file changed, 99 insertions(+), 110 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 3118cfc2bd4..49a06fbfd7d 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -3358,13 +3358,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) case E_Anonymous_Access_Type: case E_General_Access_Type: { + /* The designated type and its equivalent type for gigi. */ Entity_Id gnat_desig_type = Directly_Designated_Type (gnat_entity); Entity_Id gnat_desig_equiv = Gigi_Equivalent_Type (gnat_desig_type); + /* Whether it comes from a limited with. */ bool is_from_limited_with = (IN (Ekind (gnat_desig_equiv), Incomplete_Kind) && From_With_Type (gnat_desig_equiv)); - - /* Get the "full view" of this entity. If this is an incomplete + /* The "full view" of the designated type. If this is an incomplete entity from a limited with, treat its non-limited view as the full view. Otherwise, if this is an incomplete or private type, use the full view. In the former case, we might point to a private type, @@ -3372,7 +3373,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) actual type used for the representation, so this takes a total of three steps. */ Entity_Id gnat_desig_full_direct_first - = (is_from_limited_with ? Non_Limited_View (gnat_desig_equiv) + = (is_from_limited_with + ? Non_Limited_View (gnat_desig_equiv) : (IN (Ekind (gnat_desig_equiv), Incomplete_Or_Private_Kind) ? Full_View (gnat_desig_equiv) : Empty)); Entity_Id gnat_desig_full_direct @@ -3383,27 +3385,25 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) : gnat_desig_full_direct_first); Entity_Id gnat_desig_full = Gigi_Equivalent_Type (gnat_desig_full_direct); - - /* This the type actually used to represent the designated type, - either gnat_desig_full or gnat_desig_equiv. */ + /* The type actually used to represent the designated type, either + gnat_desig_full or gnat_desig_equiv. */ Entity_Id gnat_desig_rep; - /* True if this is a pointer to an unconstrained array. */ bool is_unconstrained_array; - /* We want to know if we'll be seeing the freeze node for any incomplete type we may be pointing to. */ bool in_main_unit = (Present (gnat_desig_full) ? In_Extended_Main_Code_Unit (gnat_desig_full) : In_Extended_Main_Code_Unit (gnat_desig_type)); - /* True if we make a dummy type here. */ - bool got_fat_p = false; - /* True if the dummy is a fat pointer. */ bool made_dummy = false; - tree gnu_desig_type = NULL_TREE; + /* True if the dummy type is a fat pointer. */ + bool got_fat_p = false; + /* The mode to be used for the pointer type. */ enum machine_mode p_mode = mode_for_size (esize, MODE_INT, 0); + /* The GCC type used for the designated type. */ + tree gnu_desig_type = NULL_TREE; if (!targetm.valid_pointer_mode (p_mode)) p_mode = ptr_mode; @@ -3416,22 +3416,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) issues. This can lose some code efficiency, but there is no alternative. */ if (Ekind (gnat_desig_equiv) == E_Array_Subtype - && ! Is_Constrained (gnat_desig_equiv)) + && !Is_Constrained (gnat_desig_equiv)) gnat_desig_equiv = Etype (gnat_desig_equiv); if (Present (gnat_desig_full) && ((Ekind (gnat_desig_full) == E_Array_Subtype - && ! Is_Constrained (gnat_desig_full)) + && !Is_Constrained (gnat_desig_full)) || (Ekind (gnat_desig_full) == E_Record_Subtype && Ekind (Etype (gnat_desig_full)) == E_Record_Type))) gnat_desig_full = Etype (gnat_desig_full); - /* Now set the type that actually marks the representation of - the designated type and also flag whether we have a unconstrained - array. */ - gnat_desig_rep = gnat_desig_full ? gnat_desig_full : gnat_desig_equiv; + /* Set the type that's actually the representation of the designated + type and also flag whether we have a unconstrained array. */ + gnat_desig_rep + = Present (gnat_desig_full) ? gnat_desig_full : gnat_desig_equiv; is_unconstrained_array - = (Is_Array_Type (gnat_desig_rep) - && ! Is_Constrained (gnat_desig_rep)); + = Is_Array_Type (gnat_desig_rep) && !Is_Constrained (gnat_desig_rep); /* If we are pointing to an incomplete type whose completion is an unconstrained array, make a fat pointer type. The two types in our @@ -3442,31 +3441,28 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (is_unconstrained_array && (Present (gnat_desig_full) || (present_gnu_tree (gnat_desig_equiv) - && TYPE_IS_DUMMY_P (TREE_TYPE - (get_gnu_tree (gnat_desig_equiv)))) - || (No (gnat_desig_full) && ! in_main_unit - && defer_incomplete_level != 0 - && ! present_gnu_tree (gnat_desig_equiv)) - || (in_main_unit && is_from_limited_with - && Present (Freeze_Node (gnat_desig_rep))))) + && TYPE_IS_DUMMY_P + (TREE_TYPE (get_gnu_tree (gnat_desig_equiv)))) + || (!in_main_unit + && defer_incomplete_level + && !present_gnu_tree (gnat_desig_equiv)) + || (in_main_unit + && is_from_limited_with + && Present (Freeze_Node (gnat_desig_equiv))))) { - tree gnu_old; - if (present_gnu_tree (gnat_desig_rep)) - gnu_old = TREE_TYPE (get_gnu_tree (gnat_desig_rep)); + gnu_desig_type = TREE_TYPE (get_gnu_tree (gnat_desig_rep)); else { - gnu_old = make_dummy_type (gnat_desig_rep); - + gnu_desig_type = make_dummy_type (gnat_desig_rep); /* Show the dummy we get will be a fat pointer. */ got_fat_p = made_dummy = true; } - /* If the call above got something that has a pointer, that - pointer is our type. This could have happened either - because the type was elaborated or because somebody - else executed the code below. */ - gnu_type = TYPE_POINTER_TO (gnu_old); + /* If the call above got something that has a pointer, the pointer + is our type. This could have happened either because the type + was elaborated or because somebody else executed the code. */ + gnu_type = TYPE_POINTER_TO (gnu_desig_type); if (!gnu_type) { tree gnu_template_type = make_node (ENUMERAL_TYPE); @@ -3484,18 +3480,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_DUMMY_P (gnu_array_type) = 1; gnu_type = make_node (RECORD_TYPE); - SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_old); - TYPE_POINTER_TO (gnu_old) = gnu_type; + SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_desig_type); + TYPE_POINTER_TO (gnu_desig_type) = gnu_type; fields - = chainon (chainon (NULL_TREE, - create_field_decl - (get_identifier ("P_ARRAY"), + = create_field_decl (get_identifier ("P_ARRAY"), gnu_ptr_array, gnu_type, - NULL_TREE, NULL_TREE, 0, 0)), - create_field_decl (get_identifier ("P_BOUNDS"), - gnu_ptr_template, gnu_type, - NULL_TREE, NULL_TREE, 0, 0)); + NULL_TREE, NULL_TREE, 0, 0); + TREE_CHAIN (fields) + = create_field_decl (get_identifier ("P_BOUNDS"), + gnu_ptr_template, gnu_type, + NULL_TREE, NULL_TREE, 0, 0); /* Make sure we can place this into a register. */ TYPE_ALIGN (gnu_type) @@ -3506,10 +3501,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) of its fields are incomplete. */ finish_record_type (gnu_type, fields, 0, false); - TYPE_OBJECT_RECORD_TYPE (gnu_old) = make_node (RECORD_TYPE); - TYPE_NAME (TYPE_OBJECT_RECORD_TYPE (gnu_old)) + TYPE_OBJECT_RECORD_TYPE (gnu_desig_type) + = make_node (RECORD_TYPE); + TYPE_NAME (TYPE_OBJECT_RECORD_TYPE (gnu_desig_type)) = create_concat_name (gnat_desig_equiv, "XUT"); - TYPE_DUMMY_P (TYPE_OBJECT_RECORD_TYPE (gnu_old)) = 1; + TYPE_DUMMY_P (TYPE_OBJECT_RECORD_TYPE (gnu_desig_type)) = 1; } } @@ -3518,35 +3514,35 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && present_gnu_tree (gnat_desig_full)) gnu_desig_type = TREE_TYPE (get_gnu_tree (gnat_desig_full)); - /* Get the type of the thing we are to point to and build a pointer - to it. If it is a reference to an incomplete or private type with a + /* Get the type of the thing we are to point to and build a pointer to + it. If it is a reference to an incomplete or private type with a full view that is a record, make a dummy type node and get the actual type later when we have verified it is safe. */ - else if ((! in_main_unit - && ! present_gnu_tree (gnat_desig_equiv) + else if ((!in_main_unit + && !present_gnu_tree (gnat_desig_equiv) && Present (gnat_desig_full) - && ! present_gnu_tree (gnat_desig_full) + && !present_gnu_tree (gnat_desig_full) && Is_Record_Type (gnat_desig_full)) - /* Likewise if we are pointing to a record or array and we - are to defer elaborating incomplete types. We do this - since this access type may be the full view of some - private type. Note that the unconstrained array case is - handled above. */ - || ((! in_main_unit || imported_p) - && defer_incomplete_level != 0 - && ! present_gnu_tree (gnat_desig_equiv) - && ((Is_Record_Type (gnat_desig_rep) - || Is_Array_Type (gnat_desig_rep)))) + /* Likewise if we are pointing to a record or array and we are + to defer elaborating incomplete types. We do this as this + access type may be the full view of a private type. Note + that the unconstrained array case is handled above. */ + || ((!in_main_unit || imported_p) + && defer_incomplete_level + && !present_gnu_tree (gnat_desig_equiv) + && (Is_Record_Type (gnat_desig_rep) + || Is_Array_Type (gnat_desig_rep))) /* If this is a reference from a limited_with type back to our - main unit and there's a Freeze_Node for it, either we have + main unit and there's a freeze node for it, either we have already processed the declaration and made the dummy type, in which case we just reuse the latter, or we have not yet, in which case we make the dummy type and it will be reused - when the declaration is processed. In both cases, the - pointer eventually created below will be automatically - adjusted when the Freeze_Node is processed. Note that the + when the declaration is finally processed. In both cases, + the pointer eventually created below will be automatically + adjusted when the freeze node is processed. Note that the unconstrained array case is handled above. */ - || (in_main_unit && is_from_limited_with + || (in_main_unit + && is_from_limited_with && Present (Freeze_Node (gnat_desig_rep)))) { gnu_desig_type = make_dummy_type (gnat_desig_equiv); @@ -3562,13 +3558,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TREE_TYPE (gnu_type) = TYPE_POINTER_TO (gnu_type) = gnu_type; } - /* If expansion is disabled, the equivalent type of a concurrent - type is absent, so build a dummy pointer type. */ + /* If expansion is disabled, the equivalent type of a concurrent type + is absent, so build a dummy pointer type. */ else if (type_annotate_only && No (gnat_desig_equiv)) gnu_type = ptr_void_type_node; - /* Finally, handle the straightforward case where we can just - elaborate our designated type and point to it. */ + /* Finally, handle the default case where we can just elaborate our + designated type. */ else gnu_desig_type = gnat_to_gnu_type (gnat_desig_equiv); @@ -3580,11 +3576,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) break; } - /* If we have a GCC type for the designated type, possibly modify it - if we are pointing only to constant objects and then make a pointer - to it. Don't do this for unconstrained arrays. */ - if (!gnu_type && gnu_desig_type) + /* If we have not done it yet, build the pointer type the usual way. */ + if (!gnu_type) { + /* Modify the designated type if we are pointing only to constant + objects, but don't do it for unconstrained arrays. */ if (Is_Access_Constant (gnat_entity) && TREE_CODE (gnu_desig_type) != UNCONSTRAINED_ARRAY_TYPE) { @@ -3623,17 +3619,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) No_Strict_Aliasing (gnat_entity)); } - /* If we are not defining this object and we made a dummy pointer, + /* If we are not defining this object and we have made a dummy pointer, save our current definition, evaluate the actual type, and replace the tentative type we made with the actual one. If we are to defer - actually looking up the actual type, make an entry in the - deferred list. If this is from a limited with, we have to defer - to the end of the current spec in two cases: first if the - designated type is in the current unit and second if the access - type is. */ - if ((! in_main_unit || is_from_limited_with) && made_dummy) + actually looking up the actual type, make an entry in the deferred + list. If this is from a limited with, we have to defer to the end + of the current spec in two cases: first if the designated type is + in the current unit and second if the access type itself is. */ + if ((!in_main_unit || is_from_limited_with) && made_dummy) { - tree gnu_old_type + bool is_from_limited_with_in_main_unit + = (is_from_limited_with + && (in_main_unit + || In_Extended_Main_Code_Unit (gnat_entity))); + tree gnu_old_desig_type = TYPE_IS_FAT_POINTER_P (gnu_type) ? TYPE_UNCONSTRAINED_ARRAY (gnu_type) : TREE_TYPE (gnu_type); @@ -3652,37 +3651,27 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) save_gnu_tree (gnat_entity, gnu_decl, false); saved = true; - if (defer_incomplete_level == 0 - && ! (is_from_limited_with - && (in_main_unit - || In_Extended_Main_Code_Unit (gnat_entity)))) - update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_type), - gnat_to_gnu_type (gnat_desig_equiv)); - - /* Note that the call to gnat_to_gnu_type here might have - updated gnu_old_type directly, in which case it is not a - dummy type any more when we get into update_pointer_to. + /* Note that the call to gnat_to_gnu_type on gnat_desig_equiv might + update gnu_old_desig_type directly, in which case it will not be + a dummy type any more when we get into update_pointer_to. - This may happen for instance when the designated type is a - record type, because their elaboration starts with an - initial node from make_dummy_type, which may yield the same - node as the one we got. + This can happen e.g. when the designated type is a record type, + because their elaboration starts with an initial node from + make_dummy_type, which may be the same node as the one we got. - Besides, variants of this non-dummy type might have been - created along the way. update_pointer_to is expected to - properly take care of those situations. */ + Besides, variants of this non-dummy type might have been created + along the way. update_pointer_to is expected to properly take + care of those situations. */ + if (!defer_incomplete_level && !is_from_limited_with_in_main_unit) + update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_desig_type), + gnat_to_gnu_type (gnat_desig_equiv)); else { - struct incomplete *p - = (struct incomplete *) xmalloc (sizeof - (struct incomplete)); + struct incomplete *p = XNEW (struct incomplete); struct incomplete **head - = (is_from_limited_with - && (in_main_unit - || In_Extended_Main_Code_Unit (gnat_entity)) + = (is_from_limited_with_in_main_unit ? &defer_limited_with : &defer_incomplete_list); - - p->old_type = gnu_old_type; + p->old_type = gnu_old_desig_type; p->full_type = gnat_desig_equiv; p->next = *head; *head = p; -- cgit v1.2.1 From 0fff241f8cdba09dca53c3340b8efa45a621b5be Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sun, 16 May 2010 09:11:39 +0000 Subject: * gcc-interface/gigi.h (enum standard_datatypes): Add new value ADT_exception_data_name_id. (exception_data_name_id): New define. * gcc-interface/trans.c (gigi): Initialize it. * gcc-interface/decl.c (gnat_to_gnu_entity) : Use the standard exception type for standard exception definitions. Do not make them volatile. : Equate fields of types associated with an exception definition to those of the standard exception type. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159452 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 49a06fbfd7d..137d523ddbf 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -582,6 +582,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Get the type after elaborating the renamed object. */ gnu_type = gnat_to_gnu_type (Etype (gnat_entity)); + /* If this is a standard exception definition, then use the standard + exception type. This is necessary to make sure that imported and + exported views of exceptions are properly merged in LTO mode. */ + if (TREE_CODE (TYPE_NAME (gnu_type)) == TYPE_DECL + && DECL_NAME (TYPE_NAME (gnu_type)) == exception_data_name_id) + gnu_type = except_type_node; + /* For a debug renaming declaration, build a pure debug entity. */ if (Present (Debug_Renaming_Link (gnat_entity))) { @@ -1000,6 +1007,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) and disallow any optimizations for such a non-constant object. */ if ((Treat_As_Volatile (gnat_entity) || (!const_flag + && gnu_type != except_type_node && (Is_Exported (gnat_entity) || imported_p || Present (Address_Clause (gnat_entity))))) @@ -2922,6 +2930,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && Is_Itype (Etype (gnat_temp)) && !present_gnu_tree (gnat_temp)) gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0); + + /* If this is a record type associated with an exception definition, + equate its fields to those of the standard exception type. This + will make it possible to convert between them. */ + if (gnu_entity_name == exception_data_name_id) + { + tree gnu_std_field; + for (gnu_field = TYPE_FIELDS (gnu_type), + gnu_std_field = TYPE_FIELDS (except_type_node); + gnu_field; + gnu_field = TREE_CHAIN (gnu_field), + gnu_std_field = TREE_CHAIN (gnu_std_field)) + SET_DECL_ORIGINAL_FIELD_TO_FIELD (gnu_field, gnu_std_field); + gcc_assert (!gnu_std_field); + } } break; -- cgit v1.2.1 From 141acd01436bc952a91b63a4c98a3dc49256989e Mon Sep 17 00:00:00 2001 From: steven Date: Thu, 27 May 2010 16:02:50 +0000 Subject: gcc/ChangeLog: * Makefile.in (ALL_CFLAGS): Add file-specific CFLAGS. (ALL_HOST_FRONTEND_OBJS): New, for all front-end specific objects. (ALL_HOST_BACKEND_OBJS): New, for all backend and target objects. (ALL_HOST_OBJS): Now a union of the above two.
: Add -DIN_GCC_FRONTEND for all files in ALL_HOST_FRONTEND_OBJS. * system.h: Poison GCC_RTL_H if IN_GCC_FRONTEND is defined. * c-common.c: Pretend to be a backend file by undefining IN_GCC_FRONTEND (still need rtl.h here). ada/ChangeLog: * gcc-interface/decl.c: Pretend to be a backend file by undefining IN_GCC_FRONTEND (still need rtl.h here). java/ChangeLog: * buildings.c: Pretend to be a backend file by undefining IN_GCC_FRONTEND (still need rtl.h here). git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159927 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 137d523ddbf..5740a0899b1 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -23,6 +23,10 @@ * * ****************************************************************************/ +/* FIXME: Still need to include rtl.h here (via expr.h) because this file + actually generates RTL (search for gen_rtx_* in gnat_to_gnu_entity). */ +#undef IN_GCC_FRONTEND + #include "config.h" #include "system.h" #include "coretypes.h" -- cgit v1.2.1 From 474db1198e42852de5f5a47f4a5dda18cafaa565 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sun, 30 May 2010 10:38:00 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity): Adjust warning message. Fix nits in comments. * gcc-interface/misc.c (gnat_init_gcc_eh): Likewise. * gcc-interface/trans.c (gigi): Likewise. (Attribute_to_gnu): Likewise. (Case_Statement_to_gnu): Likewise. (gnat_to_gnu): Adjust warning message. * gcc-interface/utils.c (create_var_decl_1): Fix nits in comments. (build_vms_descriptor32): Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160048 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 5740a0899b1..71679fd1cbc 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -448,7 +448,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) the regular processing take place, which leaves us with a regular exception data object for VMS exceptions too. The condition code mapping is taken care of by the front end and the bitmasking by the - runtime library. */ + run-time library. */ goto object; case E_Discriminant: @@ -1220,7 +1220,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (TREE_CODE (TYPE_SIZE_UNIT (gnu_alloc_type)) == INTEGER_CST && TREE_OVERFLOW (TYPE_SIZE_UNIT (gnu_alloc_type)) && !Is_Imported (gnat_entity)) - post_error ("?Storage_Error will be raised at run-time!", + post_error ("?`Storage_Error` will be raised at run time!", gnat_entity); gnu_expr @@ -3713,7 +3713,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = ptr_void_type_node; else { - /* The runtime representation is the equivalent type. */ + /* The run-time representation is the equivalent type. */ gnu_type = gnat_to_gnu_type (gnat_equiv_type); maybe_present = true; } -- cgit v1.2.1 From 99eae3030dc96cee5d454806334b5b28282e9fbe Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sun, 30 May 2010 12:01:55 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity) : Reuse the TYPE_DECL of the equivalent type instead of building a new one. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160049 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 71679fd1cbc..0fd7753e1ae 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -4382,11 +4382,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) case E_Task_Subtype: case E_Protected_Type: case E_Protected_Subtype: + /* Concurrent types are always transformed into their record type. */ if (type_annotate_only && No (gnat_equiv_type)) gnu_type = void_type_node; else - gnu_type = gnat_to_gnu_type (gnat_equiv_type); - + gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, 0); maybe_present = true; break; -- cgit v1.2.1 From b2e48750cfa8c75c101a37264e58056d2663cac3 Mon Sep 17 00:00:00 2001 From: hjl Date: Thu, 3 Jun 2010 16:36:22 +0000 Subject: Check MAX_FIXED_MODE_SIZE on bit-field in C++. gcc/ada/ 2010-06-03 H.J. Lu PR c++/44294 * gcc-interface/decl.c (MAX_FIXED_MODE_SIZE): Removed. gcc/cp/ 2010-06-03 H.J. Lu PR c++/44294 * class.c (layout_class_type): Check MAX_FIXED_MODE_SIZE on bit-field. gcc/ 2010-06-03 H.J. Lu PR c++/44294 * defaults.h (MAX_FIXED_MODE_SIZE): New. * stor-layout.c (MAX_FIXED_MODE_SIZE): Removed. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160229 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 4 ---- 1 file changed, 4 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 0fd7753e1ae..cf9f025ba2c 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -55,10 +55,6 @@ #include "ada-tree.h" #include "gigi.h" -#ifndef MAX_FIXED_MODE_SIZE -#define MAX_FIXED_MODE_SIZE GET_MODE_BITSIZE (DImode) -#endif - /* Convention_Stdcall should be processed in a specific way on Windows targets only. The macro below is a helper to avoid having to check for a Windows specific attribute throughout this unit. */ -- cgit v1.2.1 From ba72912a012b97cad825eebee3f5f22253d0afe4 Mon Sep 17 00:00:00 2001 From: lauras Date: Tue, 8 Jun 2010 07:25:24 +0000 Subject: gcc/ada: 2010-06-08 Laurynas Biveinis * gcc-interface/utils.c (init_gnat_to_gnu): Use typed GC allocation. (init_dummy_type): Likewise. (gnat_pushlevel): Likewise. * gcc-interface/trans.c (Attribute_to_gnu): Likewise. (Subprogram_Body_to_gnu): Likewise. (Compilation_Unit_to_gnu): Likewise. (start_stmt_group): Likewise. (extract_encoding): Likewise. (decode_name): Likewise. * gcc-interface/misc.c (gnat_printable_name): Likewise. * gcc-interface/decl.c (annotate_value): Likewise. * gcc-interface/ada-tree.h (struct lang_type): Add variable_size GTY option. (struct lang_decl): Likewise. (SET_TYPE_LANG_SPECIFIC): Use typed GC allocation. (SET_DECL_LANG_SPECIFIC): Likewise. gcc/c-family: 2010-06-08 Laurynas Biveinis * c-pragma.c (push_alignment): Use typed GC allocation. (handle_pragma_push_options): Likewise. * c-common.c (parse_optimize_options): Likewise. * c-common.h (struct sorted_fields_type): Add variable_size GTY option. gcc/cp: 2010-06-08 Laurynas Biveinis * typeck2.c (abstract_virtuals_error): Likewise. * pt.c (maybe_process_partial_specialization): Likewise. (register_specialization): Likewise. (add_pending_template): Likewise. (lookup_template_class): Likewise. (push_tinst_level): Likewise. * parser.c (cp_lexer_new_main): Likewise. (cp_lexer_new_from_tokens): Likewise. (cp_token_cache_new): Likewise. (cp_parser_context_new): Likewise. (cp_parser_new): Likewise. (cp_parser_nested_name_specifier_opt): Likewise. (cp_parser_template_id): Likewise. * name-lookup.c (binding_entry_make): Likewise. (binding_table_construct): Likewise. (binding_table_new): Likewise. (cxx_binding_make): Likewise. (pushdecl_maybe_friend): Likewise. (begin_scope): Likewise. (push_to_top_level): Likewise. * lex.c (init_reswords): Likewise. (retrofit_lang_decl): Likewise. (cxx_dup_lang_specific_decl): Likewise. (copy_lang_type): Likewise. (cxx_make_type): Likewise. * decl.c (make_label_decl): Likewise. (check_goto): Likewise. (start_preparsed_function): Likewise. (save_function_data): Likewise. * cp-tree.h (TYPE_SET_PTRMEMFUNC_TYPE): Likewise. * cp-objcp-common.c (decl_shadowed_for_var_insert): Likewise. * class.c (finish_struct_1): Likewise. * cp-tree.h (struct lang_type): Add variable_size GTY option. (struct lang_decl): Likewise. * parser.c (cp_parser_new): Update comment to not reference ggc_alloc. gcc/fortran: 2010-06-08 Laurynas Biveinis * trans-types.c (gfc_get_nodesc_array_type): Use typed GC allocation. (gfc_get_array_type_bounds): Likewise. * trans-decl.c (gfc_allocate_lang_decl): Likewise. (gfc_find_module): Likewise. * f95-lang.c (pushlevel): Likewise. * trans.h (struct lang_type): Add variable_size GTY option. (struct lang_decl): Likewise. gcc/java: 2010-06-08 Laurynas Biveinis * jcf-reader.c (jcf_parse_constant_pool): Use typed GC allocation. * jcf-parse.c (java_parse_file): Likewise. (process_zip_dir): Likewise. * java-tree.h (MAYBE_CREATE_VAR_LANG_DECL_SPECIFIC): Likewise. (MAYBE_CREATE_TYPE_TYPE_LANG_SPECIFIC): Likewise. * expr.c (add_type_assertion): Likewise. * decl.c (make_binding_level): Likewise. (java_dup_lang_specific_decl): Likewise. * constants.c (set_constant_entry): Likewise. (cpool_for_class): Likewise. * class.c (add_method_1): Likewise. (java_treetreehash_new): Likewise. * java-tree.h (struct lang_type): Add variable_size GTY option. (struct lang_decl): Likewise. * jch.h (struct cpool_entry): Likewise. * java-tree.h (java_treetreehash_create): Remove parameter ggc. * except.c (prepare_eh_table_type): Update java_treetreehash_create call. * class.c (add_method_1): Update java_treetreehash_create call. (java_treetreehash_create): Remove parameter gc. Use htab_create_ggc. gcc/lto: 2010-06-08 Laurynas Biveinis * lto.c (lto_read_in_decl_state): Use typed GC allocation. (lto_file_read): Likewise. (new_partition): Likewise. (read_cgraph_and_symbols): Likewise. gcc/objc: 2010-06-08 Laurynas Biveinis * objc-act.h (ALLOC_OBJC_TYPE_LANG_SPECIFIC): Use typed GC allocation. * objc-act.c (objc_volatilize_decl): Likewise. (objc_build_string_object): Likewise. (hash_init): Likewise. (hash_enter): Likewise. (hash_add_attr): Likewise. (add_class): Likewise. (start_class): Likewise. gcc/objcp: 2010-06-08 Laurynas Biveinis * objcp-decl.h (ALLOC_OBJC_TYPE_LANG_SPECIFIC): Use typed GC allocation. gcc: 2010-06-08 Laurynas Biveinis * doc/tm.texi (Per-Function Data): Do not reference ggc_alloc. * doc/gty.texi (GTY Options): Document typed GC allocation and variable_size GTY option. * ggc-internal.h: New. * ggc.h: Update copyright year. (digit_string): Move to stringpool.c. (ggc_mark_stringpool, ggc_purge_stringpool, ggc_mark_roots) (gt_pch_save_stringpool, gt_pch_fixup_stringpool) (gt_pach_restore_stringpool, gt_pch_p_S, gt_pch_note_object) (init_ggc_pch, ggc_pch_count_object, ggc_pch_total_size) (ggc_pch_this_base, ggc_pch_alloc_object, ggc_pch_prepare_write) (ggc_pch_write_object, ggc_pch_finish, ggc_pch_read) (ggc_force_collect, ggc_get_size, ggc_statistics) (ggc_print_common_statistics): Move to ggc-internal.h. (digit_vector, new_ggc_zone, destroy_ggc_zone, ggc_alloc_stat) (ggc_alloc, ggc_alloc_cleared, ggc_realloc, ggc_calloc, GGC_NEW) (GGC_CNEW, GGC_NEWVEC, GGC_CNEWVEC, GGC_NEWVAR, ggc_alloc_rtvec) (ggc_alloc_tree, gt_pch_save, ggc_min_expand_heuristic) (ggc_min_heapsize_heuristic, ggc_alloc_zone) (ggc_alloc_zone_pass_stat): Remove. (ggc_internal_alloc_stat, ggc_internal_alloc) (ggc_internal_cleared_alloc_stat): New. (GGC_RESIZEVEC, GGC_RESIZEVAR): Redefine. (ggc_internal_vec_alloc_stat) (ggc_internal_cleared_vec_alloc_stat) (ggc_internal_vec_alloc_stat, ggc_internal_cleared_vec_alloc) (ggc_alloc_atomic_stat, ggc_alloc_atomic) (ggc_alloc_cleared_atomic, ggc_cleared_alloc_htab_ignore_args) (ggc_cleared_alloc_ptr_array_two_args): New. (htab_create_ggc, splay_tree_new_ggc): Redefine. (ggc_splay_alloc): Change the type of the first argument to enum gt_types_enum. (ggc_alloc_string): Make macro. (ggc_alloc_string_stat): New. (ggc_strdup): Redefine. (rtl_zone, tree_zone, tree_id_zone): Declare unconditionally. (ggc_alloc_rtvec_sized): New. (ggc_alloc_zone_stat): Rename to ggc_internal_alloc_zone_stat. (ggc_internal_alloc_zone_pass_stat, ggc_internal_alloc_zone_stat) (ggc_internal_cleared_alloc_zone_stat) (ggc_internal_zone_alloc_stat) (ggc_internal_zone_cleared_alloc_stat) (ggc_internal_zone_vec_alloc_stat) (ggc_alloc_zone_rtx_def_stat) (ggc_alloc_zone_tree_node_stat) (ggc_alloc_zone_cleared_tree_node_stat) (ggc_alloc_cleared_gimple_statement_d_stat): New. * ggc-common.c: Include ggc-internal.h. (ggc_internal_cleared_alloc_stat): Rename from ggc_alloc_cleared_stat. (ggc_realloc_stat): Use ggc_internal_alloc_stat. (ggc_calloc): Remove. (ggc_cleared_alloc_htab_ignore_args): New. (ggc_cleared_alloc_ptr_array_two_args): New. (ggc_splay_alloc): Add obj_type parameter. (init_ggc_heuristics): Formatting fixes. * ggc-none.c: Update copyright year. (ggc_alloc_stat): Rename to ggc_alloc_stat. (ggc_alloc_cleared_stat): Rename to ggc_internal_cleared_alloc_stat. (struct alloc_zone, rtl_zone, tree_zone, tree_id_zone): New. * ggc-page.c: Update copyright year. Include ggc-internal.h. Remove references to ggc_alloc in comments. (ggc_alloc_typed_stat): Call ggc_internal_alloc_stat. (ggc_alloc_stat): Rename to ggc_internal_alloc_stat. (new_ggc_zone, destroy_ggc_zone): Remove. (struct alloc_zone, rtl_zone, tree_zone, tree_id_zone): New. * ggc-zone.c: Include ggc-internal.h. Remove references to ggc_alloc in comments. (ggc_alloc_zone_stat): ggc_internal_alloc_zone_stat. (ggc_internal_alloc_zone_pass_stat): New. (ggc_internal_cleared_alloc_zone_stat): New. (ggc_alloc_typed_stat): Use ggc_internal_alloc_zone_pass_stat. (ggc_alloc_stat): Rename ggc_internal_alloc_stat. (new_ggc_zone, destroy_ggc_zone): Remove. * stringpool.c: Update copyright year. Include ggc-internal.h (digit_vector): Make static. (digit_string): Moved from ggc.h. (stringpool_ggc_alloc): Use ggc_alloc_atomic. (ggc_alloc_string): Rename to ggc_alloc_string_stat. * Makefile.in (GGC_INTERNAL_H): New. (ggc_common.o, ggc-page.o, ggc-zone.o, stringpool.o): Add $(GGC_INTERNAL_H) to dependencies. * gentype.c: Update copyright year. (walk_type): Accept variable_size GTY option. (USED_BY_TYPED_GC_P): New macro. (write_enum_defn): Use USED_BY_TYPED_GC_P. Do not output whitespace at the end of strings. (get_type_specifier, variable_size_p): New functions. (alloc_quantity, alloc_zone): New enums. (write_typed_alloc_def): New function. (write_typed_struct_alloc_def): Likewise. (write_typed_typed_typedef_alloc_def): Likewise. (write_typed_alloc_defns): Likewise. (output_typename, write_splay_tree_allocator_def): Likewise. (write_splay_tree_allocators): Likewise. (main): Call write_typed_alloc_defns and write_splay_tree_allocators. * lto-streamer.h (lto_file_decl_data_ptr): New. * passes.c (order): Define using cgraph_node_ptr. * strinpool.c (struct string_pool_data): Declare nested_ptr using ht_identifier_ptr. * gimple.h (union gimple_statement_d): Likewise. * rtl.h (struct rtx_def): Likewise. (struct rtvec_def): Likewise. * tree.h (union tree_node): Likewise. * tree-ssa-operands.h (struct ssa_operand_memory_d): Likewise. * cfgloop.c (record_loop_exits): Use htab_create_ggc. * tree-scalar-evolution.c (scev_initialize): Likewise. * alias.c (record_alias_subset): Update splay_tree_new_ggc call. * dwarf2asm.c (dw2_force_const_mem): Likewise. * omp-low.c (lower_omp_critical): Likewise. * bitmap.h (struct bitmap_head_def): Update comment to not reference ggc_alloc. * config/pa/pa.c (get_deferred_label): Use GGC_RESIZEVEC. * ira.c (fix_reg_equiv_init): Use GGC_RESIZEVEC. * ipa-prop.c (duplicate_ggc_array): Rename to duplicate_ipa_jump_func_array. Use typed GC allocation. (ipa_edge_duplication_hook): Call duplicate_ipa_jump_func_array. * gimple.c (gimple_alloc_stat): Use ggc_alloc_cleared_gimple_statement_d_stat. * varasm.c (create_block_symbol): Use ggc_alloc_zone_rtx_def. * tree.c (make_node_stat): Use ggc_alloc_zone_cleared_tree_node_stat. (make_tree_vec_stat): Likewise. (build_vl_exp_stat): Likewise. (copy_node_stat): Use ggc_alloc_zone_tree_node_stat. (make_tree_binfo_stat): Likewise. (tree_cons_stat): Likewise. * rtl.c (rtx_alloc_stat): Use ggc_alloc_zone_rtx_def_stat. (shallow_copy_rtx_stat): Likewise. (make_node_stat): Likewise. * lto-symtab.c: Fix comment. * tree-cfg.c (create_bb): Update comment to not reference ggc_alloc_cleared. * tree-ssa-structalias.c (struct heapvar_for_stmt): Fix param_is value. * varpool.c (varpool_node): Use typed GC allocation. (varpool_extra_name_alias): Likewise. * varasm.c (emutls_decl): Likewise. (get_unnamed_section): Likewise. (get_noswitch_section): Likewise. (get_section): Likewise. (get_block_for_section): Likewise. (build_constant_desc): Likewise. (create_constant_pool): Likewise. (force_const_mem): Likewise. * tree.c (build_vl_exp_stat): Likewise. (build_real): Likewise. (build_string): Likewise. (decl_debug_expr_insert): Likewise. (decl_value_expr_insert): Likewise. (type_hash_add): Likewise. (build_omp_clause): Likewise. * tree-ssanames.c (duplicate_ssa_name_ptr_info): Likewise. * tree-ssa.c (init_tree_ssa): Likewise. * tree-ssa-structalias.c (heapvar_insert): Likewise. * tree-ssa-operands.c (ssa_operand_alloc): Likewise. * tree-ssa-loop-niter.c (record_estimate): Likewise. * tree-ssa-alias.c (get_ptr_info): Likewise. * tree-scalar-evolution.c (new_scev_info_str): Likewise. * tree-phinodes.c (allocate_phi_node): Likewise. * tree-iterator.c (tsi_link_before): Likewise. (tsi_link_after): Likewise. * tree-eh.c (add_stmt_to_eh_lp_fn): Likewise. * tree-dfa.c (create_var_ann): Likewise. * tree-cfg.c (create_bb): Likewise. * toplev.c (alloc_for_identifier_to_locale): Likewise. (general_init): Likewise. * stringpool.c (stringpool_ggc_alloc): Likewise. (gt_pch_save_stringpool): Likewise. * sese.c (if_region_set_false_region): Likewise. * passes.c (do_per_function_toporder): Likewise. * optabs.c (set_optab_libfunc): Likewise. (set_conv_libfunc): Likewise. * lto-symtab.c (lto_symtab_register_decl): Likewise. * lto-streamer-in.c (lto_input_eh_catch_list): Likewise. (input_eh_region): Likewise. (input_eh_lp): Likewise. (make_new_block): Likewise. (unpack_ts_real_cst_value_fields): Likewise. * lto-section-in.c (lto_new_in_decl_state): Likewise. * lto-cgraph.c (input_node_opt_summary): Likewise. * loop-init.c (loop_optimizer_init): Likewise. * lambda.h (lambda_vector_new): Likewise. * lambda-code.c (replace_uses_equiv_to_x_with_y): Likewise. * ira.c (update_equiv_regs): Likewise. * ipa.c (cgraph_node_set_new): Likewise. (cgraph_node_set_add): Likewise. (varpool_node_set_new): Likewise. (varpool_node_set_add): Likewise. * ipa-prop.c (ipa_compute_jump_functions_for_edge): Likewise. (duplicate_ipa_jump_func_array): Likewise. (ipa_read_node_info): Likewise. * ipa-cp.c (ipcp_create_replace_map): Likewise. * integrate.c (get_hard_reg_initial_val): Likewise. * gimple.c (gimple_alloc_stat): Likewise. (gimple_build_omp_for): Likewise. (gimple_seq_alloc): Likewise. (gimple_copy): Likewise. * gimple-iterator.c (gsi_insert_before_without_update): Likewise. (gsi_insert_after_without_update): Likewise. * function.c (add_frame_space): Likewise. (insert_temp_slot_address): Likewise. (assign_stack_temp_for_type): Likewise. (allocate_struct_function): Likewise. (types_used_by_var_decl_insert): Likewise. * except.c (init_eh_for_function): Likewise. (gen_eh_region): Likewise. (gen_eh_region_catch): Likewise. (gen_eh_landing_pad): Likewise. (add_call_site): Likewise. * emit-rtl.c (get_mem_attrs): Likewise. (get_reg_attrs): Likewise. (start_sequence): Likewise. (init_emit): Likewise. * dwarf2out.c (new_cfi): Likewise. (queue_reg_save): Likewise. (dwarf2out_frame_init): Likewise. (new_loc_descr): Likewise. (find_AT_string): Likewise. (new_die): Likewise. (add_var_loc_to_decl): Likewise. (clone_die): Likewise. (clone_as_declaration): Likewise. (break_out_comdat_types): Likewise. (new_loc_list): Likewise. (loc_descriptor): Likewise. (add_loc_descr_to_each): Likewise. (add_const_value_attribute): Likewise. (tree_add_const_value_attribute): Likewise. (add_comp_dir_attribute): Likewise. (add_name_and_src_coords_attributes): Likewise. (lookup_filename): Likewise. (store_vcall_insn): Likewise. (dwarf2out_init): Likewise. * dbxout.c (dbxout_init): Likewise. * config/xtensa/xtensa.c (xtensa_init_machine_status): Likewise. * config/sparc/sparc.c (sparc_init_machine_status): Likewise. * config/score/score7.c (score7_output_external): Likewise. * config/score/score3.c (score3_output_external): Likewise. * config/s390/s390.c (s390_init_machine_status): Likewise. * config/rs6000/rs6000.c (builtin_function_type): Likewise. (rs6000_init_machine_status): Likewise. (output_toc): Likewise. * config/pa/pa.c (pa_init_machine_status): Likewise. (get_deferred_plabel): Likewise. * config/moxie/moxie.c (moxie_init_machine_status): Likewise. * config/mmix/mmix.c (mmix_init_machine_status): Likewise. * config/mips/mips.c (mflip_mips16_use_mips16_p): Likewise. * config/mep/mep.c (mep_init_machine_status): Likewise. (mep_note_pragma_flag): Likewise. * config/m32c/m32c.c (m32c_init_machine_status): Likewise. * config/iq2000/iq2000.c (iq2000_init_machine_status): Likewise. * config/ia64/ia64.c (ia64_init_machine_status): Likewise. * config/i386/winnt.c (i386_pe_record_external_function): Likewise. (i386_pe_maybe_record_exported_symbol): Likewise. * config/i386/i386.c (get_dllimport_decl): Likewise. (ix86_init_machine_status): Likewise. (assign_386_stack_local): Likewise. * config/frv/frv.c (frv_init_machine_status): Likewise. * config/darwin.c (machopic_indirection_name): Likewise. * config/cris/cris.c (cris_init_machine_status): Likewise. * config/bfin/bfin.c (bfin_init_machine_status): Likewise. * config/avr/avr.c (avr_init_machine_status): Likewise. * config/arm/arm.c (arm_init_machine_status): Likewise. * config/alpha/alpha.c (alpha_init_machine_status): Likewise. (alpha_need_linkage): Likewise. (alpha_use_linkage): Likewise. * cgraph.c (cgraph_allocate_node): Likewise. (cgraph_create_edge_1): Likewise. (cgraph_create_indirect_edge): Likewise. (cgraph_add_asm_node): Likewise. * cfgrtl.c (init_rtl_bb_info): Likewise. * cfgloop.c (alloc_loop): Likewise. (rescan_loop_exit): Likewise. * cfg.c (init_flow): Likewise. (alloc_block): Likewise. (unchecked_make_edge): Likewise. * c-parser.c (c_parse_init): Likewise. (c_parse_file): Likewise. * c-decl.c (bind): Likewise. (record_inline_static): Likewise. (push_scope): Likewise. (make_label): Likewise. (lookup_label_for_goto): Likewise. (finish_struct): Likewise. (finish_enum): Likewise. (c_push_function_context): Likewise. * bitmap.c (bitmap_element_allocate): Likewise. (bitmap_gc_alloc_stat): Likewise. * alias.c (record_alias_subset): Likewise. (init_alias_analysis): Likewise. include: 2010-06-08 Laurynas Biveinis * splay-tree.h: Update copyright years. (splay_tree_s): Document fields. (splay_tree_new_typed_alloc): New. * hashtab.h: Update copyright years. (htab_create_typed_alloc): New. libcpp: 2010-06-08 Laurynas Biveinis * include/symtab.h (ht_identifier_ptr): New. libiberty: 2010-06-08 Laurynas Biveinis * splay-tree.c: Update copyright years. (splay_tree_new_typed_alloc): New. (splay_tree_new_with_allocator): Use it. * hashtab.c: Update copyright years. (htab_create_typed_alloc): New. (htab_create_alloc): Use it. * functions.texi: Regenerate. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160425 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index cf9f025ba2c..fb4769b7bb2 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -7296,7 +7296,7 @@ annotate_value (tree gnu_size) /* Save the result in the cache. */ if (h) { - *h = GGC_NEW (struct tree_int_map); + *h = ggc_alloc_tree_int_map (); (*h)->base.from = gnu_size; (*h)->to = ret; } -- cgit v1.2.1 From e5d730aaf9b2ae8a1ca8499c0455696f9eb865c9 Mon Sep 17 00:00:00 2001 From: charlet Date: Wed, 23 Jun 2010 08:28:20 +0000 Subject: 2010-06-23 Olivier Hainque * gcc-interface/decl.c (intrin_types_incompatible_p): New function, helper for ... (intrin_arglists_compatible_p, intrin_return_compatible_p): New functions, helpers for ... (intrin_profiles_compatible_p): New function, replacement for ... (compatible_signatures_p): Removed. (gnat_to_gnu_entity) : If -Wextra, warn on attempt to bind an unregistered builtin function. When we have one, use it and warn on profile incompatibilities. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161257 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 248 ++++++++++++++++++++++++++++++++++++------- 1 file changed, 212 insertions(+), 36 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index fb4769b7bb2..020bc45a635 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -154,13 +154,24 @@ static tree make_type_from_size (tree, tree, bool); static unsigned int validate_alignment (Uint, Entity_Id, unsigned int); static unsigned int ceil_alignment (unsigned HOST_WIDE_INT); static void check_ok_for_atomic (tree, Entity_Id, bool); -static int compatible_signatures_p (tree, tree); static tree create_field_decl_from (tree, tree, tree, tree, tree, tree); static tree get_rep_part (tree); static tree get_variant_part (tree); static tree create_variant_part_from (tree, tree, tree, tree, tree); static void copy_and_substitute_in_size (tree, tree, tree); static void rest_of_type_decl_compilation_no_defer (tree); + +/* The relevant constituents of a subprogram binding to a GCC builtin. Used + to pass around calls performing profile compatibilty checks. */ + +typedef struct { + Entity_Id gnat_entity; /* The Ada subprogram entity. */ + tree ada_fntype; /* The corresponding GCC type node. */ + tree btin_fntype; /* The GCC builtin function type node. */ +} intrin_binding_t; + +static bool intrin_profiles_compatible_p (intrin_binding_t *); + /* Given GNAT_ENTITY, a GNAT defining identifier node, which denotes some Ada entity, return the equivalent GCC tree for that entity (a ..._DECL node) @@ -3906,9 +3917,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) We still want the parameter associations to take place because the proper generation of calls depends on it (a GNAT parameter without a corresponding GCC tree has a very specific meaning), so we don't - just break here. */ - if (Convention (gnat_entity) == Convention_Intrinsic) - gnu_builtin_decl = builtin_decl_for (gnu_ext_name); + just "break;" here. */ + if (Convention (gnat_entity) == Convention_Intrinsic + && Present (Interface_Name (gnat_entity))) + { + gnu_builtin_decl = builtin_decl_for (gnu_ext_name); + + /* Post a "Wextra" warning if we couldn't find the decl. Absence + of a real intrinsic for an import is most often unexpected but + allows hooking in alternate bodies, convenient in some cases so + we don't want the warning to be unconditional. */ + if (gnu_builtin_decl == NULL_TREE && extra_warnings) + post_error ("?gcc intrinsic not found for&!", gnat_entity); + } /* ??? What if we don't find the builtin node above ? warn ? err ? In the current state we neither warn nor err, and calls will just @@ -4204,21 +4225,25 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) | (TYPE_QUAL_CONST * const_flag) | (TYPE_QUAL_VOLATILE * volatile_flag)); - /* If we have a builtin decl for that function, check the signatures - compatibilities. If the signatures are compatible, use the builtin - decl. If they are not, we expect the checker predicate to have - posted the appropriate errors, and just continue with what we have - so far. */ + /* If we have a builtin decl for that function, use it. Check if the + profiles are compatible and warn if they are not. The checker is + expected to post extra diagnostics in this case. */ if (gnu_builtin_decl) { - tree gnu_builtin_type = TREE_TYPE (gnu_builtin_decl); + intrin_binding_t inb; - if (compatible_signatures_p (gnu_type, gnu_builtin_type)) - { - gnu_decl = gnu_builtin_decl; - gnu_type = gnu_builtin_type; - break; - } + inb.gnat_entity = gnat_entity; + inb.ada_fntype = gnu_type; + inb.btin_fntype = TREE_TYPE (gnu_builtin_decl); + + if (!intrin_profiles_compatible_p (&inb)) + post_error + ("?profile of& doesn't match the builtin it binds!", + gnat_entity); + + gnu_decl = gnu_builtin_decl; + gnu_type = TREE_TYPE (gnu_builtin_decl); + break; } /* If there was no specified Interface_Name and the external and @@ -8036,32 +8061,183 @@ check_ok_for_atomic (tree object, Entity_Id gnat_entity, bool comp_p) gnat_error_point, gnat_entity); } -/* Check if FTYPE1 and FTYPE2, two potentially different function type nodes, - have compatible signatures so that a call using one type may be safely - issued if the actual target function type is the other. Return 1 if it is - the case, 0 otherwise, and post errors on the incompatibilities. - This is used when an Ada subprogram is mapped onto a GCC builtin, to ensure - that calls to the subprogram will have arguments suitable for the later - underlying builtin expansion. */ +/* Helper for the intrin compatibility checks family. Evaluate whether + two types are definitely incompatible. */ -static int -compatible_signatures_p (tree ftype1, tree ftype2) +static bool +intrin_types_incompatible_p (tree t1, tree t2) +{ + enum tree_code code; + + if (TYPE_MAIN_VARIANT (t1) == TYPE_MAIN_VARIANT (t2)) + return false; + + if (TYPE_MODE (t1) != TYPE_MODE (t2)) + return true; + + if (TREE_CODE (t1) != TREE_CODE (t2)) + return true; + + code = TREE_CODE (t1); + + switch (code) + { + case INTEGER_TYPE: + case REAL_TYPE: + return TYPE_PRECISION (t1) != TYPE_PRECISION (t2); + + case POINTER_TYPE: + case REFERENCE_TYPE: + /* Assume designated types are ok. We'd need to account for char * and + void * variants to do better, which could rapidly get messy and isn't + clearly worth the effort. */ + return false; + + default: + break; + } + + return false; +} + +/* Helper for intrin_profiles_compatible_p, to perform compatibility checks + on the Ada/builtin argument lists for the INB binding. */ + +static bool +intrin_arglists_compatible_p (intrin_binding_t * inb) +{ + tree ada_args = TYPE_ARG_TYPES (inb->ada_fntype); + tree btin_args = TYPE_ARG_TYPES (inb->btin_fntype); + + /* Sequence position of the last argument we checked. */ + int argpos = 0; + + while (ada_args != 0 || btin_args != 0) + { + tree ada_type, btin_type; + + /* If one list is shorter than the other, they fail to match. */ + if (ada_args == 0 || btin_args == 0) + return false; + + ada_type = TREE_VALUE (ada_args); + btin_type = TREE_VALUE (btin_args); + + /* If we're done with the Ada args and not with the internal builtin + args, complain. */ + if (ada_type == void_type_node + && btin_type != void_type_node) + { + post_error ("?Ada arguments list too short!", inb->gnat_entity); + return false; + } + + /* If we're done with the internal builtin args, check the remaining + args on the Ada side. If they are all ints, assume these are access + levels and just ignore them with a conditional warning. Complain + otherwise. */ + if (btin_type == void_type_node + && ada_type != void_type_node) + { + while (TREE_CODE (ada_type) == INTEGER_TYPE) + { + ada_args = TREE_CHAIN (ada_args); + ada_type = TREE_VALUE (ada_args); + } + + if (ada_type != void_type_node) + { + post_error_ne_num ("?Ada arguments list too long (> ^)!", + inb->gnat_entity, inb->gnat_entity, + argpos); + return false; + } + + else + { + if (extra_warnings) + post_error ("?trailing Ada integer args ignored for " + "intrinsic binding!", + inb->gnat_entity); + return true; + } + } + + /* Otherwise, check that types match for the current argument. */ + argpos ++; + if (intrin_types_incompatible_p (ada_type, btin_type)) + { + post_error_ne_num ("?intrinsic binding type mismatch on argument ^!", + inb->gnat_entity, inb->gnat_entity, argpos); + return false; + } + + ada_args = TREE_CHAIN (ada_args); + btin_args = TREE_CHAIN (btin_args); + } + + return true; +} + +/* Helper for intrin_profiles_compatible_p, to perform compatibility checks + on the Ada/builtin return values for the INB binding. */ + +static bool +intrin_return_compatible_p (intrin_binding_t * inb) +{ + tree ada_return_type = TREE_TYPE (inb->ada_fntype); + tree btin_return_type = TREE_TYPE (inb->btin_fntype); + + if (VOID_TYPE_P (btin_return_type) + && VOID_TYPE_P (ada_return_type)) + return true; + + if (VOID_TYPE_P (ada_return_type) + && !VOID_TYPE_P (btin_return_type)) + { + if (extra_warnings) + post_error ("?builtin function imported as Ada procedure!", + inb->gnat_entity); + return true; + } + + if (intrin_types_incompatible_p (btin_return_type, ada_return_type)) + { + post_error ("?intrinsic binding type mismatch on return value!", + inb->gnat_entity); + return false; + } + + return true; +} + +/* Check and return whether the Ada and gcc builtin profiles bound by INB are + compatible. Issue relevant warnings when they are not. + + This is intended as a light check to diagnose the most obvious cases, not + as a full fledged type compatiblity predicate. It is the programmer's + responsibility to ensure correctness of the Ada declarations in Imports, + especially when binding straight to a compiler internal. */ + +static bool +intrin_profiles_compatible_p (intrin_binding_t * inb) { - /* As of now, we only perform very trivial tests and consider it's the - programmer's responsibility to ensure the type correctness in the Ada - declaration, as in the regular Import cases. + /* Check compatibility on return values and argument lists, each responsible + for posting warnings as appropriate. Ensure use of the proper sloc for + this purpose. */ + + bool arglists_compatible_p, return_compatible_p; + location_t saved_location = input_location; + + Sloc_to_locus (Sloc (inb->gnat_entity), &input_location); - Mismatches typically result in either error messages from the builtin - expander, internal compiler errors, or in a real call sequence. This - should be refined to issue diagnostics helping error detection and - correction. */ + return_compatible_p = intrin_return_compatible_p (inb); + arglists_compatible_p = intrin_arglists_compatible_p (inb); - /* Almost fake test, ensuring a use of each argument. */ - if (ftype1 == ftype2) - return 1; + input_location = saved_location; - return 1; + return return_compatible_p && arglists_compatible_p; } /* Return a FIELD_DECL node modeled on OLD_FIELD. FIELD_TYPE is its type -- cgit v1.2.1 From a204eb6dd7e0975d76798b5153e33e7b49b775fd Mon Sep 17 00:00:00 2001 From: charlet Date: Wed, 23 Jun 2010 08:40:22 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity) : Use Wshadow instead of Wextra to guard warning on absence of internal builtin decl for an import. Fix use of quote in warning text. (intrin_arglists_compatible_p): Remove processing of integer trailing args on the Ada side. Fix use of literal > in warning text. (intrin_return_compatible_p): Never warn on "function imported as procedure". Defer the void/void case to the common type compatibility check. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161258 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 68 +++++++++++++------------------------------- 1 file changed, 19 insertions(+), 49 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 020bc45a635..c263548e242 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -3912,22 +3912,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } /* If this subprogram is expectedly bound to a GCC builtin, fetch the - corresponding DECL node. - - We still want the parameter associations to take place because the - proper generation of calls depends on it (a GNAT parameter without - a corresponding GCC tree has a very specific meaning), so we don't - just "break;" here. */ + corresponding DECL node. Proper generation of calls later on need + proper parameter associations so we don't "break;" here. */ if (Convention (gnat_entity) == Convention_Intrinsic && Present (Interface_Name (gnat_entity))) { gnu_builtin_decl = builtin_decl_for (gnu_ext_name); - /* Post a "Wextra" warning if we couldn't find the decl. Absence - of a real intrinsic for an import is most often unexpected but - allows hooking in alternate bodies, convenient in some cases so - we don't want the warning to be unconditional. */ - if (gnu_builtin_decl == NULL_TREE && extra_warnings) + /* Unability to find the builtin decl most often indicates a + genuine mistake, but imports of unregistered intrinsics are + sometimes issued on purpose to allow hooking in alternate + bodies. We post a warning conditioned on Wshadow in this case, + to let developers be notified on demand without risking false + positives with common default sets of options. */ + + if (gnu_builtin_decl == NULL_TREE && warn_shadow) post_error ("?gcc intrinsic not found for&!", gnat_entity); } @@ -4238,7 +4237,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (!intrin_profiles_compatible_p (&inb)) post_error - ("?profile of& doesn't match the builtin it binds!", + ("?profile of& doesn''t match the builtin it binds!", gnat_entity); gnu_decl = gnu_builtin_decl; @@ -8125,7 +8124,7 @@ intrin_arglists_compatible_p (intrin_binding_t * inb) btin_type = TREE_VALUE (btin_args); /* If we're done with the Ada args and not with the internal builtin - args, complain. */ + args, or the other way around, complain. */ if (ada_type == void_type_node && btin_type != void_type_node) { @@ -8133,35 +8132,12 @@ intrin_arglists_compatible_p (intrin_binding_t * inb) return false; } - /* If we're done with the internal builtin args, check the remaining - args on the Ada side. If they are all ints, assume these are access - levels and just ignore them with a conditional warning. Complain - otherwise. */ if (btin_type == void_type_node && ada_type != void_type_node) { - while (TREE_CODE (ada_type) == INTEGER_TYPE) - { - ada_args = TREE_CHAIN (ada_args); - ada_type = TREE_VALUE (ada_args); - } - - if (ada_type != void_type_node) - { - post_error_ne_num ("?Ada arguments list too long (> ^)!", - inb->gnat_entity, inb->gnat_entity, - argpos); - return false; - } - - else - { - if (extra_warnings) - post_error ("?trailing Ada integer args ignored for " - "intrinsic binding!", - inb->gnat_entity); - return true; - } + post_error_ne_num ("?Ada arguments list too long ('> ^)!", + inb->gnat_entity, inb->gnat_entity, argpos); + return false; } /* Otherwise, check that types match for the current argument. */ @@ -8189,19 +8165,13 @@ intrin_return_compatible_p (intrin_binding_t * inb) tree ada_return_type = TREE_TYPE (inb->ada_fntype); tree btin_return_type = TREE_TYPE (inb->btin_fntype); - if (VOID_TYPE_P (btin_return_type) - && VOID_TYPE_P (ada_return_type)) - return true; - + /* Accept function imported as procedure, common and convenient. */ if (VOID_TYPE_P (ada_return_type) && !VOID_TYPE_P (btin_return_type)) - { - if (extra_warnings) - post_error ("?builtin function imported as Ada procedure!", - inb->gnat_entity); - return true; - } + return true; + /* Check return types compatibility otherwise. Note that this + handles void/void as well. */ if (intrin_types_incompatible_p (btin_return_type, ada_return_type)) { post_error ("?intrinsic binding type mismatch on return value!", -- cgit v1.2.1 From a234977f7e406f68a658f9ea4fd5541935d08783 Mon Sep 17 00:00:00 2001 From: charlet Date: Wed, 23 Jun 2010 08:56:20 +0000 Subject: (gnat_to_gnu_param): Use void_ptr GCC type for System.Address argument of GCC builtin imports. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161261 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index c263548e242..c2f697e9445 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -5264,6 +5264,12 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech, gnu_param_type = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_param_type)))); + /* For GCC builtins, pass Address integer types as (void *) */ + if (Convention (gnat_subprog) == Convention_Intrinsic + && Present (Interface_Name (gnat_subprog)) + && Is_Descendent_Of_Address (Etype (gnat_param))) + gnu_param_type = ptr_void_type_node; + /* VMS descriptors are themselves passed by reference. */ if (mech == By_Short_Descriptor || (mech == By_Descriptor && TARGET_ABI_OPEN_VMS && !TARGET_MALLOC64)) -- cgit v1.2.1 From 5cd86571c70d9a80880fb9611315ea89ca78bd5d Mon Sep 17 00:00:00 2001 From: froydnj Date: Tue, 29 Jun 2010 12:21:37 +0000 Subject: * gcc-interface/gigi.h (gnat_build_constructor): Take a VEC instead of a TREE_LIST. Update comment. * gcc-interface/trans.c (gigi): Build a VEC instead of a TREE_LIST. Adjust call to gnat_build_constructor. (Attribute_to_gnu): Likewise. (gnat_to_gnu): Likewise. (pos_to_constructor): Likewise. (extract_values): Likewise. * gcc-interface/utils.c (build_template): Likewise. (convert_vms_descriptor64): Likewise. (convert_vms_descriptor32): Likewise. (convert_to_fat_pointer): Likewise. (convert): Likewise. (unchecked_convert): Likewise. * gcc-interface/decl.c (gnat_to_gnu_entity): Likewise. * gcc-interface/utils2.c (build_allocator): Likewise. (fill_vms_descriptor): Likewise. (gnat_build_constructor): Take a VEC instead of a TREE_LIST. (compare_elmt_bitpos): Adjust for parameters being constructor_elts instead of TREE_LISTs. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161529 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index c2f697e9445..6952060259d 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1047,15 +1047,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = TYPE_PADDING_P (gnu_type) ? TYPE_FIELDS (TREE_TYPE (TYPE_FIELDS (gnu_type))) : TYPE_FIELDS (gnu_type); - gnu_expr - = gnat_build_constructor - (gnu_type, - tree_cons - (template_field, - build_template (TREE_TYPE (template_field), - TREE_TYPE (TREE_CHAIN (template_field)), - NULL_TREE), - NULL_TREE)); + VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 1); + tree t = build_template (TREE_TYPE (template_field), + TREE_TYPE (TREE_CHAIN (template_field)), + NULL_TREE); + CONSTRUCTOR_APPEND_ELT (v, template_field, t); + gnu_expr = gnat_build_constructor (gnu_type, v); } /* Convert the expression to the type of the object except in the -- cgit v1.2.1 From 61dd4d1211cd9be47627a224b16f49d635cead4e Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Sat, 3 Jul 2010 09:54:13 +0000 Subject: * gcc-interface/decl.c (gnat_to_gnu_entity) : Branch to common code handling the alignment of discrete types. : Likewise. : Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161770 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 6952060259d..b5168e79951 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1496,7 +1496,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Note that the bounds are updated at the end of this function to avoid an infinite recursion since they refer to the type. */ } - break; + goto discrete_type; case E_Signed_Integer_Type: case E_Ordinary_Fixed_Point_Type: @@ -1504,7 +1504,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* For integer types, just make a signed type the appropriate number of bits. */ gnu_type = make_signed_type (esize); - break; + goto discrete_type; case E_Modular_Integer_Type: { @@ -1543,7 +1543,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = gnu_subtype; } } - break; + goto discrete_type; case E_Signed_Integer_Subtype: case E_Enumeration_Subtype: @@ -1632,6 +1632,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnat_to_gnu_type (Original_Array_Type (gnat_entity))); + discrete_type: + /* We have to handle clauses that under-align the type specially. */ if ((Present (Alignment_Clause (gnat_entity)) || (Is_Packed_Array_Type (gnat_entity) @@ -1685,9 +1687,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY); - /* Don't notify the field as "addressable", since we won't be taking - it's address and it would prevent create_field_decl from making a - bitfield. */ + /* Don't declare the field as addressable since we won't be taking + its address and this would prevent create_field_decl from making + a bitfield. */ gnu_field = create_field_decl (get_identifier ("OBJECT"), gnu_field_type, gnu_type, NULL_TREE, bitsize_zero_node, 1, 0); @@ -1736,9 +1738,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_ALIGN (gnu_type) = align; relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY); - /* Don't notify the field as "addressable", since we won't be taking - it's address and it would prevent create_field_decl from making a - bitfield. */ + /* Don't declare the field as addressable since we won't be taking + its address and this would prevent create_field_decl from making + a bitfield. */ gnu_field = create_field_decl (get_identifier ("F"), gnu_field_type, gnu_type, NULL_TREE, bitsize_zero_node, 1, 0); -- cgit v1.2.1 From 1767a056f10a2ccbc900df04d01193da73a3d272 Mon Sep 17 00:00:00 2001 From: froydnj Date: Thu, 15 Jul 2010 14:31:28 +0000 Subject: gcc/ * tree.h (DECL_CHAIN): Define. * alias.c: Carefully replace TREE_CHAIN with DECL_CHAIN. * c-decl.c: Likewise. * c-parser.c: Likewise. * c-typeck.c: Likewise. * cfgexpand.c: Likewise. * cgraph.c: Likewise. * cgraphunit.c: Likewise. * combine.c: Likewise. * config/alpha/alpha.c: Likewise. * config/arm/arm.c: Likewise. * config/frv/frv.c: Likewise. * config/i386/i386.c: Likewise. * config/i386/winnt-cxx.c: Likewise. * config/ia64/ia64.c: Likewise. * config/iq2000/iq2000.c: Likewise. * config/mep/mep.c: Likewise. * config/mips/mips.c: Likewise. * config/pa/som.h: Likewise. * config/rs6000/rs6000.c: Likewise. * config/s390/s390.c: Likewise. * config/sh/sh.c: Likewise. * config/sh/symbian-cxx.c: Likewise. * config/sparc/sparc.c: Likewise. * config/spu/spu.c: Likewise. * config/stormy16/stormy16.c: Likewise. * config/vxworks.c: Likewise. * config/xtensa/xtensa.c: Likewise. * coverage.c: Likewise. * dbxout.c: Likewise. * dwarf2out.c: Likewise. * emit-rtl.c: Likewise. * expr.c: Likewise. * function.c: Likewise. * gimple-low.c: Likewise. * gimple-pretty-print.c: Likewise. * gimplify.c: Likewise. * integrate.c: Likewise. * ipa-inline.c: Likewise. * ipa-prop.c: Likewise. * ipa-split.c: Likewise. * ipa-struct-reorg.c: Likewise. * ipa-type-escape.c: Likewise. * langhooks.c: Likewise. * lto-cgraph.c: Likewise. * omp-low.c: Likewise. * stor-layout.c: Likewise. * tree-cfg.c: Likewise. * tree-complex.c: Likewise. * tree-dfa.c: Likewise. * tree-dump.c: Likewise. * tree-inline.c: Likewise. * tree-mudflap.c: Likewise. * tree-nested.c: Likewise. * tree-object-size.c: Likewise. * tree-pretty-print.c: Likewise. * tree-sra.c: Likewise. * tree-ssa-live.c: Likewise. * tree-ssa-loop-niter.c: Likewise. * tree-ssa-math-opts.c: Likewise. * tree-ssa-reassoc.c: Likewise. * tree-ssa-sccvn.c: Likewise. * tree-ssa-structalias.c: Likewise. * tree-tailcall.c: Likewise. * tree-vrp.c: Likewise. * tree.c: Likewise. * var-tracking.c: Likewise. * varasm.c: Likewise. gcc/ada/ * gcc-interface/decl.c: Carefully replace TREE_CHAIN with DECL_CHAIN. * gcc-interface/trans.c: Likewise. * gcc-interface/utils.c: Likewise. * gcc-interface/utils2.c: Likewise. gcc/c-family/ * c-common.c: Carefully replace TREE_CHAIN with DECL_CHAIN. * c-format.c: Likewise. gcc/cp/ * cp-tree.h: Carefully replace TREE_CHAIN with DECL_CHAIN. * call.c: Likewise. * class.c: Likewise. * cp-gimplify.c: Likewise. * decl.c: Likewise. * decl2.c: Likewise. * init.c: Likewise. * mangle.c: Likewise. * name-lookup.c: Likewise. * optimize.c: Likewise. * parser.c: Likewise. * pt.c: Likewise. * rtti.c: Likewise. * search.c: Likewise. * semantics.c: Likewise. * typeck.c: Likewise. * typeck2.c: Likewise. gcc/fortran/ * f95-lang.c: Carefully replace TREE_CHAIN with DECL_CHAIN. * trans-common.c: Likewise. * trans-decl.c: Likewise. * trans-types.c: Likewise. * trans.c: Likewise. gcc/java/ * java-tree.h: Carefully replace TREE_CHAIN with DECL_CHAIN. * boehm.c: Likewise. * class.c: Likewise. * decl.c: Likewise. * expr.c: Likewise. * jcf-parse.c: Likewise. * typeck.c: Likewise. * verify-glue.c: Likewise. gcc/objc/ * objc-act.c: Carefully replace TREE_CHAIN with DECL_CHAIN. gcc/testsuite/ * g++.dg/plugin/attribute_plugin.c: Carefully replace TREE_CHAIN with DECL_CHAIN. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162223 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/gcc-interface/decl.c | 76 ++++++++++++++++++++++---------------------- 1 file changed, 38 insertions(+), 38 deletions(-) (limited to 'gcc/ada/gcc-interface/decl.c') diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index b5168e79951..54d02225e01 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1049,7 +1049,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) : TYPE_FIELDS (gnu_type); VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 1); tree t = build_template (TREE_TYPE (template_field), - TREE_TYPE (TREE_CHAIN (template_field)), + TREE_TYPE (DECL_CHAIN (template_field)), NULL_TREE); CONSTRUCTOR_APPEND_ELT (v, template_field, t); gnu_expr = gnat_build_constructor (gnu_type, v); @@ -1207,7 +1207,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && TYPE_CONTAINS_TEMPLATE_P (gnu_alloc_type)) { gnu_alloc_type - = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_alloc_type))); + = TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (gnu_alloc_type))); if (TREE_CODE (gnu_expr) == CONSTRUCTOR && 1 == VEC_length (constructor_elt, @@ -1217,7 +1217,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_expr = build_component_ref (gnu_expr, NULL_TREE, - TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr))), + DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr))), false); } @@ -1896,7 +1896,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) fields once we build them. */ tem = build3 (COMPONENT_REF, gnu_ptr_template, build0 (PLACEHOLDER_EXPR, gnu_fat_type), - TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)), NULL_TREE); + DECL_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; @@ -2435,7 +2435,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_field = create_field_decl (gnu_index_name, gnu_index, gnu_bound_rec, NULL_TREE, NULL_TREE, 0, 0); - TREE_CHAIN (gnu_field) = gnu_field_list; + DECL_CHAIN (gnu_field) = gnu_field_list; gnu_field_list = gnu_field; } @@ -2905,7 +2905,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (!is_unchecked_union) { - TREE_CHAIN (gnu_field) = gnu_field_list; + DECL_CHAIN (gnu_field) = gnu_field_list; gnu_field_list = gnu_field; } } @@ -2950,8 +2950,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) for (gnu_field = TYPE_FIELDS (gnu_type), gnu_std_field = TYPE_FIELDS (except_type_node); gnu_field; - gnu_field = TREE_CHAIN (gnu_field), - gnu_std_field = TREE_CHAIN (gnu_std_field)) + gnu_field = DECL_CHAIN (gnu_field), + gnu_std_field = DECL_CHAIN (gnu_std_field)) SET_DECL_ORIGINAL_FIELD_TO_FIELD (gnu_field, gnu_std_field); gcc_assert (!gnu_std_field); } @@ -3207,7 +3207,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Put it in one of the new variants directly. */ if (gnu_cont_type != gnu_type) { - TREE_CHAIN (gnu_field) = TYPE_FIELDS (gnu_cont_type); + DECL_CHAIN (gnu_field) = TYPE_FIELDS (gnu_cont_type); TYPE_FIELDS (gnu_cont_type) = gnu_field; } @@ -3231,7 +3231,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) the other fields. */ else { - TREE_CHAIN (gnu_field) = gnu_field_list; + DECL_CHAIN (gnu_field) = gnu_field_list; gnu_field_list = gnu_field; if (!gnu_last) gnu_last = gnu_field; @@ -3248,7 +3248,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = create_variant_part_from (gnu_variant_part, gnu_variant_list, gnu_type, gnu_pos_list, gnu_subst_list); - TREE_CHAIN (new_variant_part) = gnu_field_list; + DECL_CHAIN (new_variant_part) = gnu_field_list; gnu_field_list = new_variant_part; } @@ -3520,7 +3520,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = create_field_decl (get_identifier ("P_ARRAY"), gnu_ptr_array, gnu_type, NULL_TREE, NULL_TREE, 0, 0); - TREE_CHAIN (fields) + DECL_CHAIN (fields) = create_field_decl (get_identifier ("P_BOUNDS"), gnu_ptr_template, gnu_type, NULL_TREE, NULL_TREE, 0, 0); @@ -4141,7 +4141,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 0, 0); Sloc_to_locus (Sloc (gnat_param), &DECL_SOURCE_LOCATION (gnu_field)); - TREE_CHAIN (gnu_field) = gnu_field_list; + DECL_CHAIN (gnu_field) = gnu_field_list; gnu_field_list = gnu_field; gnu_cico_list = tree_cons (gnu_field, gnu_param, gnu_cico_list); @@ -6140,7 +6140,7 @@ make_packable_type (tree type, bool in_record) /* Now copy the fields, keeping the position and size as we don't want to change the layout by propagating the packedness downwards. */ for (old_field = TYPE_FIELDS (type); old_field; - old_field = TREE_CHAIN (old_field)) + old_field = DECL_CHAIN (old_field)) { tree new_field_type = TREE_TYPE (old_field); tree new_field, new_size; @@ -6155,7 +6155,7 @@ make_packable_type (tree type, bool in_record) /* However, for the last field in a not already packed record type that is of an aggregate type, we need to use the RM size in the packable version of the record type, see finish_record_type. */ - if (!TREE_CHAIN (old_field) + if (!DECL_CHAIN (old_field) && !TYPE_PACKED (type) && (TREE_CODE (new_field_type) == RECORD_TYPE || TREE_CODE (new_field_type) == UNION_TYPE @@ -6178,7 +6178,7 @@ make_packable_type (tree type, bool in_record) if (TREE_CODE (new_type) == QUAL_UNION_TYPE) DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field); - TREE_CHAIN (new_field) = field_list; + DECL_CHAIN (new_field) = field_list; field_list = new_field; } @@ -6831,7 +6831,7 @@ is_variable_size (tree type) && TREE_CODE (type) != QUAL_UNION_TYPE) return false; - for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field)) + for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field)) if (is_variable_size (TREE_TYPE (field))) return true; @@ -6929,14 +6929,14 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, fields except for the _Tag or _Parent field. */ else if (gnat_name == Name_uController && gnu_last) { - TREE_CHAIN (gnu_field) = TREE_CHAIN (gnu_last); - TREE_CHAIN (gnu_last) = gnu_field; + DECL_CHAIN (gnu_field) = DECL_CHAIN (gnu_last); + DECL_CHAIN (gnu_last) = gnu_field; } /* If this is a regular field, put it after the other fields. */ else { - TREE_CHAIN (gnu_field) = gnu_field_list; + DECL_CHAIN (gnu_field) = gnu_field_list; gnu_field_list = gnu_field; if (!gnu_last) gnu_last = gnu_field; @@ -7035,7 +7035,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, use this field directly to match the layout of C unions. */ if (unchecked_union && TYPE_FIELDS (gnu_variant_type) - && !TREE_CHAIN (TYPE_FIELDS (gnu_variant_type))) + && !DECL_CHAIN (TYPE_FIELDS (gnu_variant_type))) gnu_field = TYPE_FIELDS (gnu_variant_type); else { @@ -7067,7 +7067,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, DECL_QUALIFIER (gnu_field) = gnu_qual; } - TREE_CHAIN (gnu_field) = gnu_variant_list; + DECL_CHAIN (gnu_field) = gnu_variant_list; gnu_variant_list = gnu_field; } @@ -7111,7 +7111,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, union_field_packed, 0); DECL_INTERNAL_P (gnu_union_field) = 1; - TREE_CHAIN (gnu_union_field) = gnu_field_list; + DECL_CHAIN (gnu_union_field) = gnu_field_list; gnu_field_list = gnu_union_field; } } @@ -7126,16 +7126,16 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, gnu_last = NULL_TREE; for (gnu_field = gnu_field_list; gnu_field; gnu_field = gnu_next) { - gnu_next = TREE_CHAIN (gnu_field); + gnu_next = DECL_CHAIN (gnu_field); if (DECL_FIELD_OFFSET (gnu_field)) { if (!gnu_last) gnu_field_list = gnu_next; else - TREE_CHAIN (gnu_last) = gnu_next; + DECL_CHAIN (gnu_last) = gnu_next; - TREE_CHAIN (gnu_field) = gnu_our_rep_list; + DECL_CHAIN (gnu_field) = gnu_our_rep_list; gnu_our_rep_list = gnu_field; } else @@ -7159,7 +7159,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, for (gnu_field = gnu_our_rep_list, i = 0; gnu_field; - gnu_field = TREE_CHAIN (gnu_field), i++) + gnu_field = DECL_CHAIN (gnu_field), i++) gnu_arr[i] = gnu_field; qsort (gnu_arr, len, sizeof (tree), compare_field_bitpos); @@ -7169,7 +7169,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, gnu_our_rep_list = NULL_TREE; for (i = len - 1; i >= 0; i--) { - TREE_CHAIN (gnu_arr[i]) = gnu_our_rep_list; + DECL_CHAIN (gnu_arr[i]) = gnu_our_rep_list; gnu_our_rep_list = gnu_arr[i]; DECL_CONTEXT (gnu_arr[i]) = gnu_rep_type; } @@ -7353,7 +7353,7 @@ annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref) { if (TREE_CODE (gnu_type) == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (gnu_type)) - size = TYPE_SIZE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)))); + size = TYPE_SIZE (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (gnu_type)))); else if (!size) size = TYPE_SIZE (gnu_type); @@ -7469,7 +7469,7 @@ build_position_list (tree gnu_type, bool do_not_flatten_variant, tree gnu_pos, for (gnu_field = TYPE_FIELDS (gnu_type); gnu_field; - gnu_field = TREE_CHAIN (gnu_field)) + gnu_field = DECL_CHAIN (gnu_field)) { tree gnu_our_bitpos = size_binop (PLUS_EXPR, gnu_bitpos, DECL_FIELD_BIT_OFFSET (gnu_field)); @@ -7555,7 +7555,7 @@ build_variant_list (tree qual_union_type, tree subst_list, tree gnu_list) for (gnu_field = TYPE_FIELDS (qual_union_type); gnu_field; - gnu_field = TREE_CHAIN (gnu_field)) + gnu_field = DECL_CHAIN (gnu_field)) { tree t, qual = DECL_QUALIFIER (gnu_field); @@ -8292,7 +8292,7 @@ get_variant_part (tree record_type) tree field; /* The variant part is the only internal field that is a qualified union. */ - for (field = TYPE_FIELDS (record_type); field; field = TREE_CHAIN (field)) + for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field)) if (DECL_INTERNAL_P (field) && TREE_CODE (TREE_TYPE (field)) == QUAL_UNION_TYPE) return field; @@ -8363,7 +8363,7 @@ create_variant_part_from (tree old_variant_part, tree variant_list, tree new_variant_subpart = create_variant_part_from (old_variant_subpart, variant_list, new_variant, pos_list, subst_list); - TREE_CHAIN (new_variant_subpart) = field_list; + DECL_CHAIN (new_variant_subpart) = field_list; field_list = new_variant_subpart; } @@ -8380,7 +8380,7 @@ create_variant_part_from (tree old_variant_part, tree variant_list, pos_list, subst_list); DECL_QUALIFIER (new_field) = TREE_VEC_ELT (TREE_VALUE (t), 1); DECL_INTERNAL_P (new_field) = 1; - TREE_CHAIN (new_field) = union_field_list; + DECL_CHAIN (new_field) = union_field_list; union_field_list = new_field; } @@ -8401,7 +8401,7 @@ create_variant_part_from (tree old_variant_part, tree variant_list, statically selected while outer ones are not; in this case, the list of fields of the inner variant is not flattened and we end up with a qualified union with a single member. Drop the useless container. */ - if (!TREE_CHAIN (union_field_list)) + if (!DECL_CHAIN (union_field_list)) { DECL_CONTEXT (union_field_list) = record_type; DECL_FIELD_OFFSET (union_field_list) @@ -8566,7 +8566,7 @@ substitute_in_type (tree t, tree f, tree r) nt = copy_type (t); TYPE_FIELDS (nt) = NULL_TREE; - for (field = TYPE_FIELDS (t); field; field = TREE_CHAIN (field)) + for (field = TYPE_FIELDS (t); field; field = DECL_CHAIN (field)) { tree new_field = copy_node (field), new_n; @@ -8598,7 +8598,7 @@ substitute_in_type (tree t, tree f, tree r) DECL_CONTEXT (new_field) = nt; SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, field); - TREE_CHAIN (new_field) = TYPE_FIELDS (nt); + DECL_CHAIN (new_field) = TYPE_FIELDS (nt); TYPE_FIELDS (nt) = new_field; } @@ -8632,7 +8632,7 @@ rm_size (tree gnu_type) && TYPE_CONTAINS_TEMPLATE_P (gnu_type)) return size_binop (PLUS_EXPR, - rm_size (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)))), + rm_size (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (gnu_type)))), DECL_SIZE (TYPE_FIELDS (gnu_type))); /* For record types, we store the size explicitly. */ -- cgit v1.2.1