diff options
| -rw-r--r-- | gcc/ada/decl.c | 59 | ||||
| -rw-r--r-- | gcc/ada/utils.c | 45 | ||||
| -rw-r--r-- | gcc/ada/utils2.c | 18 |
3 files changed, 83 insertions, 39 deletions
diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index 710d0f1..6edda45 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2004, Free Software Foundation, Inc. * + * Copyright (C) 1992-2005, 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- * @@ -748,6 +748,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } if (const_flag + && !TREE_SIDE_EFFECTS (gnu_expr) && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE && TYPE_MODE (gnu_type) != BLKmode && Ekind (Etype (gnat_entity)) != E_Class_Wide_Type @@ -757,8 +758,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* If this is a declaration or reference that we can stabilize, just use that declaration or reference as this entity unless the latter has to be materialized. */ - else if ((DECL_P (gnu_expr) - || (REFERENCE_CLASS_P (gnu_expr) == tcc_reference)) + else if ((DECL_P (gnu_expr) || REFERENCE_CLASS_P (gnu_expr)) && !Materialize_Entity (gnat_entity) && (!global_bindings_p () || (staticp (gnu_expr) @@ -793,7 +793,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (!global_bindings_p ()) { + bool has_side_effects = TREE_SIDE_EFFECTS (gnu_expr); + gnu_expr = gnat_stabilize_reference (gnu_expr, true); + + /* If the original expression had side effects, put a + SAVE_EXPR around this whole thing. */ + if (has_side_effects) + gnu_expr = save_expr (gnu_expr); + add_stmt (gnu_expr); } @@ -2582,6 +2590,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tree gnu_subst_list = substitution_list (gnat_entity, gnat_base_type, NULL_TREE, definition); + bool possibly_overlapping_fields = false; tree gnu_temp; /* If this is a derived type, we may be seeing fields from any @@ -2598,12 +2607,24 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) BIGGEST_ALIGNMENT); if (Present (Parent_Subtype (gnat_root_type))) - gnu_subst_list - = substitution_list (Parent_Subtype (gnat_root_type), - Empty, gnu_subst_list, definition); + { + gnu_subst_list + = substitution_list (Parent_Subtype (gnat_root_type), + Empty, gnu_subst_list, + definition); + + /* If there's a _Parent field, it may overlap the + fields we have that appear to be in this record but + actually are from the parent. So make note of that + fact and later we'll make a UNION_TYPE instead of + a RECORD_TYPE, since the latter may not have + overlapping fields. */ + possibly_overlapping_fields = true; + } } - gnu_type = make_node (RECORD_TYPE); + gnu_type = make_node (possibly_overlapping_fields + ? UNION_TYPE : RECORD_TYPE); TYPE_NAME (gnu_type) = gnu_entity_id; TYPE_STUB_DECL (gnu_type) = create_type_decl (NULL_TREE, gnu_type, NULL, false, false, @@ -3163,10 +3184,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) p->next = defer_incomplete_list; defer_incomplete_list = p; } - else if - (IN (Ekind (Base_Type (Directly_Designated_Type (gnat_entity))), - Incomplete_Or_Private_Kind)) - { ;} + else if (IN (Ekind (Base_Type + (Directly_Designated_Type (gnat_entity))), + Incomplete_Or_Private_Kind)) + ; else gnat_to_gnu_entity (Directly_Designated_Type (gnat_entity), NULL_TREE, 0); @@ -4372,9 +4393,13 @@ make_dummy_type (Entity_Id gnat_type) /* If this is a record, make this a RECORD_TYPE or UNION_TYPE; else make it a VOID_TYPE. */ - if (Is_Record_Type (gnat_underlying)) - gnu_type = make_node (Is_Unchecked_Union (gnat_underlying) - ? UNION_TYPE : RECORD_TYPE); + if (Is_Unchecked_Union (gnat_underlying)) + { + gnu_type = make_node (UNION_TYPE); + TYPE_UNCHECKED_UNION_P (gnu_type) = 1; + } + else if (Is_Record_Type (gnat_underlying)) + gnu_type = make_node (RECORD_TYPE); else gnu_type = make_node (ENUMERAL_TYPE); @@ -5098,7 +5123,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, && TYPE_MODE (gnu_field_type) == BLKmode && host_integerp (TYPE_SIZE (gnu_field_type), 1) && compare_tree_int (TYPE_SIZE (gnu_field_type), BIGGEST_ALIGNMENT) <= 0 - && (packed + && (packed == 1 || (gnu_size && tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type))) || Present (Component_Clause (gnat_field)))) @@ -5375,7 +5400,9 @@ components_to_record (tree gnu_record_type, Node_Id component_list, /* If this is an unchecked union, each variant must have exactly one component, each of which becomes one component of this union. */ - if (TREE_CODE (gnu_record_type) == UNION_TYPE && Present (variant_part)) + if (TREE_CODE (gnu_record_type) == UNION_TYPE + && TYPE_UNCHECKED_UNION_P (gnu_record_type) + && Present (variant_part)) for (variant = First_Non_Pragma (Variants (variant_part)); Present (variant); variant = Next_Non_Pragma (variant)) diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index 4d4fad4..549c093 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2004, Free Software Foundation, Inc. * + * Copyright (C) 1992-2005, 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- * @@ -309,7 +309,7 @@ insert_block (tree block) } /* Records a ..._DECL node DECL as belonging to the current lexical scope - and uses GNAT_NODE for location information. */ + and uses GNAT_NODE for location information and propagating flags. */ void gnat_pushdecl (tree decl, Node_Id gnat_node) @@ -321,6 +321,8 @@ gnat_pushdecl (tree decl, Node_Id gnat_node) else DECL_CONTEXT (decl) = current_function_decl; + TREE_NO_WARNING (decl) = (gnat_node == Empty || Warnings_Off (gnat_node)); + /* Set the location of DECL and emit a declaration for it. */ if (Present (gnat_node)) Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (decl)); @@ -1182,8 +1184,8 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list, || !debug_info_p) DECL_IGNORED_P (type_decl) = 1; else if (code != ENUMERAL_TYPE && code != RECORD_TYPE - && !((code == POINTER_TYPE || code == REFERENCE_TYPE) - && TYPE_IS_DUMMY_P (TREE_TYPE (type)))) + && !((code == POINTER_TYPE || code == REFERENCE_TYPE) + && TYPE_IS_DUMMY_P (TREE_TYPE (type)))) rest_of_decl_compilation (type_decl, global_bindings_p (), 0); if (!TYPE_IS_DUMMY_P (type)) @@ -2905,21 +2907,29 @@ convert (tree type, tree expr) return unchecked_convert (type, expr, false); case UNION_TYPE: - /* Just validate that the type is indeed that of a field - of the type. Then make the simple conversion. */ - for (tem = TYPE_FIELDS (type); tem; tem = TREE_CHAIN (tem)) + /* For unchecked unions, just validate that the type is indeed that of + a field of the type. Then make the simple conversion. */ + if (TYPE_UNCHECKED_UNION_P (type)) { - if (TREE_TYPE (tem) == etype) - return build1 (CONVERT_EXPR, type, expr); - else if (TREE_CODE (TREE_TYPE (tem)) == RECORD_TYPE - && (TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (tem)) - || TYPE_IS_PADDING_P (TREE_TYPE (tem))) - && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (tem))) == etype) - return build1 (CONVERT_EXPR, type, - convert (TREE_TYPE (tem), expr)); - } + for (tem = TYPE_FIELDS (type); tem; tem = TREE_CHAIN (tem)) + { + if (TREE_TYPE (tem) == etype) + return build1 (CONVERT_EXPR, type, expr); + else if (TREE_CODE (TREE_TYPE (tem)) == RECORD_TYPE + && (TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (tem)) + || TYPE_IS_PADDING_P (TREE_TYPE (tem))) + && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (tem))) == etype) + return build1 (CONVERT_EXPR, type, + convert (TREE_TYPE (tem), expr)); + } - gcc_unreachable (); + gcc_unreachable (); + } + else + /* Otherwise, this is a conversion between a tagged type and some + subtype, which we have to mark as a UNION_TYPE because of + overlapping fields. */ + return unchecked_convert (type, expr, false); case UNCONSTRAINED_ARRAY_TYPE: /* If EXPR is a constrained array, take its address, convert it to a @@ -3214,6 +3224,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) /* Search the chain of currently reachable declarations for a builtin FUNCTION_DECL node corresponding to function NAME (an IDENTIFIER_NODE). Return the first node found, if any, or NULL_TREE otherwise. */ + tree builtin_decl_for (tree name __attribute__ ((unused))) { diff --git a/gcc/ada/utils2.c b/gcc/ada/utils2.c index 04ab0cb..008ac6e 100644 --- a/gcc/ada/utils2.c +++ b/gcc/ada/utils2.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2004, Free Software Foundation, Inc. * + * Copyright (C) 1992-2005, 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- * @@ -660,13 +660,16 @@ build_binary_op (enum tree_code op_code, tree result_type, might indicate a conversion between a root type and a class-wide type, which we must not remove. */ while (TREE_CODE (right_operand) == VIEW_CONVERT_EXPR - && ((TREE_CODE (right_type) == RECORD_TYPE + && (((TREE_CODE (right_type) == RECORD_TYPE + || TREE_CODE (right_type) == UNION_TYPE) && !TYPE_JUSTIFIED_MODULAR_P (right_type) && !TYPE_ALIGN_OK (right_type) && !TYPE_IS_FAT_POINTER_P (right_type)) || TREE_CODE (right_type) == ARRAY_TYPE) - && (((TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0))) - == RECORD_TYPE) + && ((((TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0))) + == RECORD_TYPE) + || (TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0))) + == UNION_TYPE)) && !(TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (TREE_OPERAND (right_operand, 0)))) && !(TYPE_ALIGN_OK @@ -695,7 +698,9 @@ build_binary_op (enum tree_code op_code, tree result_type, operation_type = best_type; /* If a class-wide type may be involved, force use of the RHS type. */ - if (TREE_CODE (right_type) == RECORD_TYPE && TYPE_ALIGN_OK (right_type)) + if ((TREE_CODE (right_type) == RECORD_TYPE + || TREE_CODE (right_type) == UNION_TYPE) + && TYPE_ALIGN_OK (right_type)) operation_type = right_type; /* Ensure everything on the LHS is valid. If we have a field reference, @@ -1087,7 +1092,8 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand) int unsignedp, volatilep; inner = get_inner_reference (operand, &bitsize, &bitpos, &offset, - &mode, &unsignedp, &volatilep, false); + &mode, &unsignedp, &volatilep, + false); /* If INNER is a padding type whose field has a self-referential size, convert to that inner type. We know the offset is zero |