re PR ada/26096 (Ada bootstrap fails in g-alleve.adb)

2006-02-13  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
	    Olivier Hainque  <hainque@adacore.com>
	    Eric Botcazou  <ebotcazou@adacore.com>

	* ada-tree.h: (TYPE_UNCHECKED_UNION_P): Deleted.
	
	* gigi.h (value_factor_p): Add prototype and description, now public.

	* decl.c (gnat_to_gnu_field): Don't attempt BLKmode to integral type
	promotion for field with rep clause if the associated size was proven
	to be in error.
	Expand comments describing attempts to use a packable type.
	(gnat_to_gnu_entity) <E_Signed_Integer_Subtype,
	E_Floating_Point_Subtype>: Inherit alias set of what we are making a
	subtype of to ensure conflicts amongst all subtypes in a hierarchy,
	necessary since these are not different types and pointers may
	actually designate any subtype in this hierarchy.
	(gnat_to_gnu_entity, case E_Record_Type): Always make fields for
	discriminants but put them into record only if not Unchecked_Union;
	pass flag to components_to_record showing Unchecked_Union.
	(make_dummy_type): Use UNION_TYPE only if Unchecked_Union and no
	components before variants; don't set TYPE_UNCHECKED_UNION_P.
	(components_to_record): New argument UNCHECKED_UNION.
	Remove special case code for Unchecked_Union and instead use main code
	with small changes.

	PR ada/26096
	(gnat_to_gnu_entity) <E_Variable>: Do not initialize the
	aligning variable with the expression being built, only its inner
	field.

	* trans.c (Handled_Sequence_Of_Statements_to_gnu): Remove call to
	emit_sequence_entry_statements.
	(emit_sequence_entry_statements, body_with_handlers_p): Delete.
	(establish_gnat_vms_condition_handler): Move before
	Subprogram_Body_to_gnu.
	(Subprogram_Body_to_gnu): On VMS, establish_gnat_vms_condition_handler
	for a subprogram if it has a foreign convention or is exported.
	(Identifier_to_gnu): Manually unshare the DECL_INITIAL tree when it is
	substituted for a CONST_DECL.
	(tree_transform, case N_Aggregate): Remove code for UNION_TYPE and pass
	Etype to assoc_to_constructor.
	(assoc_to_constructor): New argument, GNAT_ENTITY; use it to ignore
	discriminants of Unchecked_Union.
	(TARGET_ABI_OPEN_VMS): Define to 0 if not defined, so that later uses
	don't need cluttering preprocessor directives.
	(establish_gnat_vms_condition_handler): New function. Establish the GNAT
	condition handler as current in the compiled function.
	(body_with_handlers_p): New function. Tell whether a given sequence of
	statements node is attached to a package or subprogram body and involves
	exception handlers possibly nested within inner block statements.
	(emit_sequence_entry_statements): New function, to emit special
	statements on entry of sequences when necessary. Establish GNAT
	condition handler in the proper cases for VMS.
	(Handled_Sequence_Of_Statements_to_gnu): Start block code with
	emit_sequence_entry_statements.

	* utils2.c (find_common_type): If both input types are BLKmode and
	have a constant size, use the smaller one.
	(build_simple_component_ref): Also match if FIELD and NEW_FIELD are
	the same.

	* utils.c (value_factor_p): Make public, to allow uses from other gigi
	units.
	(create_type_decl): Do not set the flag DECL_IGNORED_P for dummy types.
	(convert, case UNION_TYPE): Remove special treatment for unchecked
	unions.

	PR ada/18659
	(update_pointer_to): Update variants of pointer types to
	unconstrained arrays by attaching the list of fields of the main
	variant.

From-SVN: r111030

6 files changed, 284 insertions, 140 deletions

diff --git a/gcc/ada/ada-tree.h b/gcc/ada/ada-tree.h
index befe25a..3a363a7 100644
--- a/gcc/ada/ada-tree.h
+++ b/gcc/ada/ada-tree.h
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2005 Free Software Foundation, Inc.          *
+ *          Copyright (C) 1992-2006 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- *
@@ -160,9 +160,6 @@ struct lang_type GTY(()) {tree t; };
    padding or alignment.  */
 #define TYPE_IS_PADDING_P(NODE) TYPE_LANG_FLAG_5 (RECORD_TYPE_CHECK (NODE))
 
-/* For a UNION_TYPE, nonzero if this is an unchecked union.  */
-#define TYPE_UNCHECKED_UNION_P(NODE) TYPE_LANG_FLAG_6 (UNION_TYPE_CHECK (NODE))
-
 /* This field is only defined for FUNCTION_TYPE nodes. If the Ada
    subprogram contains no parameters passed by copy in/copy out then this
    field is 0. Otherwise it points to a list of nodes used to specify the
diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c
index 3dd14f4..1a17c37 100644
--- a/gcc/ada/decl.c
+++ b/gcc/ada/decl.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2005, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2006, 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- *
@@ -91,7 +91,7 @@ static tree elaborate_expression_1 (Node_Id, Entity_Id, tree, tree,
 static tree make_packable_type (tree);
 static tree gnat_to_gnu_field (Entity_Id, tree, int, bool);
 static void components_to_record (tree, Node_Id, tree, int, bool, tree *,
-                                  bool, bool, bool);
+                                  bool, bool, bool, bool);
 static int compare_field_bitpos (const PTR, const PTR);
 static Uint annotate_value (tree);
 static void annotate_rep (Entity_Id, tree);
@@ -1058,7 +1058,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	    gnu_new_var
 	      = create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
-				 NULL_TREE, gnu_new_type, gnu_expr, false,
+				 NULL_TREE, gnu_new_type, NULL_TREE, false,
 				 false, false, false, NULL, gnat_entity);
 
 	    if (gnu_expr)
@@ -1416,6 +1416,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
       layout_type (gnu_type);
 
+      /* Inherit our alias set from what we're a subtype of.  Subtypes
+	 are not different types and a pointer can designate any instance
+	 within a subtype hierarchy.  */
+      copy_alias_set (gnu_type, TREE_TYPE (gnu_type));
+
       /* If the type we are dealing with is to represent a 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
@@ -1449,6 +1454,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	  finish_record_type (gnu_type, gnu_field, false, false);
 	  TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1;
 	  SET_TYPE_ADA_SIZE (gnu_type, bitsize_int (esize));
+
+	  copy_alias_set (gnu_type, gnu_field_type);
 	}
 
       break;
@@ -1516,6 +1523,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	  }
 
 	layout_type (gnu_type);
+
+	/* Inherit our alias set from what we're a subtype of, as for
+	   integer subtypes.  */
+	copy_alias_set (gnu_type, TREE_TYPE (gnu_type));
       }
     break;
 
@@ -2463,9 +2474,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    TREE_OPERAND (gnu_get_parent, 1) = gnu_field_list;
 	  }
 
-	/* Add the fields for the discriminants into the record.  */
-        if (!Is_Unchecked_Union (gnat_entity)
-	    && Has_Discriminants (gnat_entity))
+	/* Make the fields for the discriminants and put them into the record
+	   unless it's an Unchecked_Union.  */
+        if (Has_Discriminants (gnat_entity))
 	  for (gnat_field = First_Stored_Discriminant (gnat_entity);
 	       Present (gnat_field);
 	       gnat_field = Next_Stored_Discriminant (gnat_field))
@@ -2491,8 +2502,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 				     gnu_field, NULL_TREE),
 			     true);
 
-	      TREE_CHAIN (gnu_field) = gnu_field_list;
-	      gnu_field_list = gnu_field;
+	      if (!Is_Unchecked_Union (gnat_entity))
+		{
+		  TREE_CHAIN (gnu_field) = gnu_field_list;
+		  gnu_field_list = gnu_field;
+		}
 	    }
 
 	/* Put the discriminants into the record (backwards), so we can
@@ -2503,7 +2517,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	/* Add the listed fields into the record and finish up.  */
 	components_to_record (gnu_type, Component_List (record_definition),
 			      gnu_field_list, packed, definition, NULL,
-			      false, all_rep, this_deferred);
+			      false, all_rep, this_deferred,
+			      Is_Unchecked_Union (gnat_entity));
 
         if (this_deferred)
 	  {
@@ -4479,6 +4494,7 @@ make_dummy_type (Entity_Id gnat_type)
 {
   Entity_Id gnat_underlying;
   tree gnu_type;
+  enum tree_code code;
 
   /* Find a full type for GNAT_TYPE, taking into account any class wide
      types.  */
@@ -4498,17 +4514,31 @@ make_dummy_type (Entity_Id gnat_type)
     return dummy_node_table[gnat_underlying];
 
   /* If this is a record, make this a RECORD_TYPE or UNION_TYPE; else make
-     it a VOID_TYPE.  */
-  if (Is_Unchecked_Union (gnat_underlying))
+     it an ENUMERAL_TYPE.  */
+  if (Is_Record_Type (gnat_underlying))
     {
-      gnu_type = make_node (UNION_TYPE);
-      TYPE_UNCHECKED_UNION_P (gnu_type) = 1;
+      Node_Id component_list
+	= Component_List (Type_Definition
+			  (Declaration_Node
+			   (Implementation_Base_Type (gnat_underlying))));
+      Node_Id component;
+
+      /* Make this a UNION_TYPE unless it's either not an Unchecked_Union or
+	 we have a non-discriminant field outside a variant.  In either case,
+	 it's a RECORD_TYPE.  */
+      code = UNION_TYPE;
+      if (!Is_Unchecked_Union (gnat_underlying))
+	code = RECORD_TYPE;
+      else
+	for (component = First_Non_Pragma (Component_Items (component_list));
+	     Present (component); component = Next_Non_Pragma (component))
+	  if (Ekind (Defining_Entity (component)) == E_Component)
+	    code = RECORD_TYPE;
     }
-  else if (Is_Record_Type (gnat_underlying))
-    gnu_type = make_node (RECORD_TYPE);
   else
-    gnu_type = make_node (ENUMERAL_TYPE);
+    code = ENUMERAL_TYPE;
 
+  gnu_type = make_node (code);
   TYPE_NAME (gnu_type) = get_entity_name (gnat_type);
   TYPE_DUMMY_P (gnu_type) = 1;
   if (AGGREGATE_TYPE_P (gnu_type))
@@ -5215,12 +5245,30 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
     gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
 			      gnat_field, FIELD_DECL, false, true);
 
-  /* If we are packing this record, have a specified size that's smaller than
-     that of the field type, or a position is specified, and the field type is
-     also a record that's BLKmode and with a small constant size, see if we
-     can get a better form of the type that allows more packing.  If we can,
-     show a size was specified for it if there wasn't one so we know to make
-     this a bitfield and avoid making things wider.  */
+  /* 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 also a record that's
+     BLKmode and with a small constant size, see if we can get an integral
+     mode form of the type when appropriate.  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 can then
+     place the field at a non-byte-aligned position and so achieve tigther
+     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 references, because
+     GCC does not handle BLKmode bitfields properly.
+
+     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
       && TYPE_MODE (gnu_field_type) == BLKmode
       && host_integerp (TYPE_SIZE (gnu_field_type), 1)
@@ -5228,26 +5276,35 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
       && (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)) && gnu_size != 0)))
     {
       /* See what the alternate type and size would be.  */
       tree gnu_packable_type = make_packable_type (gnu_field_type);
 
+      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.  */
       int 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)
-          && Present (Component_Clause (gnat_field))
-          && UI_To_Int (Component_Bit_Offset (gnat_field)) % BITS_PER_UNIT == 0
-          && tree_low_cst (gnu_size, 1) % TYPE_ALIGN (gnu_packable_type) != 0)
-         );
+          && has_byte_aligned_clause
+          && ! value_factor_p (gnu_size, TYPE_ALIGN (gnu_packable_type)))
+	 );
 
       /* Substitute unless told otherwise.  */
       if (!reject)
@@ -5477,6 +5534,9 @@ is_variable_size (tree type)
    DEFER_DEBUG, if true, means that the debugging routines should not be
    called when finishing constructing the record type.
 
+   UNCHECKED_UNION, if tree, means that we are building a type for a record
+   with a Pragma Unchecked_Union.
+
    The processing of the component list fills in the chain with all of the
    fields of the record and then the record type is finished.  */
 
@@ -5484,12 +5544,11 @@ static void
 components_to_record (tree gnu_record_type, Node_Id component_list,
                       tree gnu_field_list, int packed, bool definition,
                       tree *p_gnu_rep_list, bool cancel_alignment,
-		      bool all_rep, bool defer_debug)
+		      bool all_rep, bool defer_debug, bool unchecked_union)
 {
   Node_Id component_decl;
   Entity_Id gnat_field;
   Node_Id variant_part;
-  Node_Id variant;
   tree gnu_our_rep_list = NULL_TREE;
   tree gnu_field, gnu_last;
   bool layout_with_rep = false;
@@ -5530,49 +5589,44 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
   /* At the end of the component list there may be a variant part.  */
   variant_part = Variant_Part (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
-      && 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))
-      {
-	component_decl
-	  = First_Non_Pragma (Component_Items (Component_List (variant)));
-	gnat_field = Defining_Entity (component_decl);
-	gnu_field = gnat_to_gnu_field (gnat_field, gnu_record_type, packed,
-				       definition);
-	TREE_CHAIN (gnu_field) = gnu_field_list;
-	gnu_field_list = gnu_field;
-	save_gnu_tree (gnat_field, gnu_field, false);
-      }
-
   /* We create a QUAL_UNION_TYPE for the variant part since the variants are
      mutually exclusive and should go in the same memory.  To do this we need
      to treat each variant as a record whose elements are created from the
      component list for the variant.  So here we create the records from the
-     lists for the variants and put them all into the QUAL_UNION_TYPE.  */
-  else if (Present (variant_part))
+     lists for the variants and put them all into the QUAL_UNION_TYPE.
+     If this is an Unchecked_Union, we make a UNION_TYPE instead or
+     use GNU_RECORD_TYPE if there are no fields so far.  */
+  if (Present (variant_part))
     {
       tree gnu_discriminant = gnat_to_gnu (Name (variant_part));
       Node_Id variant;
-      tree gnu_union_type = make_node (QUAL_UNION_TYPE);
-      tree gnu_union_field;
-      tree gnu_variant_list = NULL_TREE;
       tree gnu_name = TYPE_NAME (gnu_record_type);
       tree gnu_var_name
-	= concat_id_with_name
-	  (get_identifier (Get_Name_String (Chars (Name (variant_part)))),
-	   "XVN");
+	= concat_id_with_name (get_identifier (Get_Name_String
+					       (Chars (Name (variant_part)))),
+			       "XVN");
+      tree gnu_union_type;
+      tree gnu_union_name;
+      tree gnu_union_field;
+      tree gnu_variant_list = NULL_TREE;
 
       if (TREE_CODE (gnu_name) == TYPE_DECL)
 	gnu_name = DECL_NAME (gnu_name);
 
-      TYPE_NAME (gnu_union_type)
-	= concat_id_with_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name));
-      TYPE_PACKED (gnu_union_type) = TYPE_PACKED (gnu_record_type);
+      gnu_union_name = concat_id_with_name (gnu_name,
+					    IDENTIFIER_POINTER (gnu_var_name));
+
+      if (!gnu_field_list && TREE_CODE (gnu_record_type) == UNION_TYPE)
+	gnu_union_type = gnu_record_type;
+      else
+	{
+
+	  gnu_union_type
+	    = make_node (unchecked_union ? UNION_TYPE : QUAL_UNION_TYPE);
+
+	  TYPE_NAME (gnu_union_type) = gnu_union_name;
+	  TYPE_PACKED (gnu_union_type) = TYPE_PACKED (gnu_record_type);
+	}
 
       for (variant = First_Non_Pragma (Variants (variant_part));
            Present (variant);
@@ -5585,7 +5639,7 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
 	  Get_Variant_Encoding (variant);
 	  gnu_inner_name = get_identifier (Name_Buffer);
 	  TYPE_NAME (gnu_variant_type)
-	    = concat_id_with_name (TYPE_NAME (gnu_union_type),
+	    = concat_id_with_name (gnu_union_name,
 				   IDENTIFIER_POINTER (gnu_inner_name));
 
 	  /* Set the alignment of the inner type in case we need to make
@@ -5607,27 +5661,40 @@ components_to_record (tree gnu_record_type, Node_Id 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,
-				false);
+				false, unchecked_union);
 
 	  gnu_qual = choices_to_gnu (gnu_discriminant,
 				     Discrete_Choices (variant));
 
 	  Set_Present_Expr (variant, annotate_value (gnu_qual));
-	  gnu_field = create_field_decl (gnu_inner_name, gnu_variant_type,
-					 gnu_union_type, 0,
-					 (all_rep_and_size
-					  ? TYPE_SIZE (gnu_record_type) : 0),
-					 (all_rep_and_size
-					  ? bitsize_zero_node : 0),
-					 0);
 
-	  DECL_INTERNAL_P (gnu_field) = 1;
-	  DECL_QUALIFIER (gnu_field) = gnu_qual;
+	  /* If this is an Unchecked_Union and we have exactly one field,
+	     use that field here.  */
+	  if (unchecked_union && TYPE_FIELDS (gnu_variant_type)
+	      && !TREE_CHAIN (TYPE_FIELDS (gnu_variant_type)))
+	    gnu_field = TYPE_FIELDS (gnu_variant_type);
+	  else
+	    {
+	      gnu_field = create_field_decl (gnu_inner_name, gnu_variant_type,
+					     gnu_union_type, 0,
+					     (all_rep_and_size
+					      ? TYPE_SIZE (gnu_record_type)
+					      : 0),
+					     (all_rep_and_size
+					      ? bitsize_zero_node : 0),
+					     0);
+
+	      DECL_INTERNAL_P (gnu_field) = 1;
+
+	      if (!unchecked_union)
+		DECL_QUALIFIER (gnu_field) = gnu_qual;
+	    }
+
 	  TREE_CHAIN (gnu_field) = gnu_variant_list;
 	  gnu_variant_list = gnu_field;
 	}
 
-      /* We use to delete the empty variants from the end. However,
+      /* We used to delete the empty variants from the end. However,
          we no longer do that because we need them to generate complete
          debugging information for the variant record.  Otherwise,
          the union type definition will be missing the fields associated
@@ -5646,6 +5713,15 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
 	  finish_record_type (gnu_union_type, nreverse (gnu_variant_list),
 			      all_rep_and_size, false);
 
+	  /* 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
+	     return.  */
+	  if (gnu_union_type == gnu_record_type)
+	    {
+	      gcc_assert (!gnu_field_list && unchecked_union);
+	      return;
+	    }
+
 	  gnu_union_field
 	    = create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type,
 				 packed,
diff --git a/gcc/ada/gigi.h b/gcc/ada/gigi.h
index 2552e56..bc7844c 100644
--- a/gcc/ada/gigi.h
+++ b/gcc/ada/gigi.h
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2005 Free Software Foundation, Inc.          *
+ *          Copyright (C) 1992-2006 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- *
@@ -680,6 +680,10 @@ extern tree get_ada_base_type (tree type);
    in bits.  If we don't know anything about the alignment, return 0.  */
 extern unsigned int known_alignment (tree exp);
 
+/* Return true if VALUE is a multiple of FACTOR. FACTOR must be a power
+   of 2. */
+extern bool value_factor_p (tree value, HOST_WIDE_INT factor);
+
 /* Make a binary operation of kind OP_CODE.  RESULT_TYPE is the type
    desired for the result.  Usually the operation is to be performed
    in that type.  For MODIFY_EXPR and ARRAY_REF, RESULT_TYPE may be 0
diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index f8698c5..1a9f3f4 100644
--- a/gcc/ada/trans.c
+++ b/gcc/ada/trans.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2005, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2006, 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- *
@@ -57,6 +57,12 @@
 #include "ada-tree.h"
 #include "gigi.h"
 
+/* Let code below know whether we are targetting VMS without need of
+   intrusive preprocessor directives.  */
+#ifndef TARGET_ABI_OPEN_VMS
+#define TARGET_ABI_OPEN_VMS 0
+#endif
+
 int max_gnat_nodes;
 int number_names;
 struct Node *Nodes_Ptr;
@@ -159,7 +165,7 @@ static tree emit_index_check (tree, tree, tree, tree);
 static tree emit_check (tree, tree, int);
 static tree convert_with_check (Entity_Id, tree, bool, bool, bool);
 static bool addressable_p (tree);
-static tree assoc_to_constructor (Node_Id, tree);
+static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
 static tree extract_values (tree, tree);
 static tree pos_to_constructor (Node_Id, tree, Entity_Id);
 static tree maybe_implicit_deref (tree);
@@ -446,7 +452,18 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 			    == Attr_Unchecked_Access)
 		       || (Get_Attribute_Id (Attribute_Name (gnat_temp))
 			   == Attr_Unrestricted_Access)))))
-	gnu_result = DECL_INITIAL (gnu_result);
+	{
+	  gnu_result = DECL_INITIAL (gnu_result);
+	  /* ??? The mark/unmark mechanism implemented in Gigi to prevent tree
+	     sharing between global level and subprogram level doesn't apply
+	     to elaboration routines.  As a result, the DECL_INITIAL tree may
+	     be shared between the static initializer of a global object and
+	     the elaboration routine, thus wreaking havoc if a local temporary
+	     is created in place during gimplification of the latter and the
+	     former is emitted afterwards.  Manually unshare for now.  */
+	  if (TREE_VISITED (gnu_result))
+	    gnu_result = unshare_expr (gnu_result);
+	}
     }
 
   *gnu_result_type_p = gnu_result_type;
@@ -1340,6 +1357,57 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
   return gnu_result;
 }
 
+/* Emit statements to establish __gnat_handle_vms_condition as a VMS condition
+   handler for the current function.  */
+
+/* This is implemented by issuing a call to the appropriate VMS specific
+   builtin.  To avoid having VMS specific sections in the global gigi decls
+   array, we maintain the decls of interest here.  We can't declare them
+   inside the function because we must mark them never to be GC'd, which we
+   can only do at the global level.  */
+
+static GTY(()) tree vms_builtin_establish_handler_decl = NULL_TREE;
+static GTY(()) tree gnat_vms_condition_handler_decl = NULL_TREE;
+
+static void
+establish_gnat_vms_condition_handler (void)
+{
+  tree establish_stmt;
+
+  /* Elaborate the required decls on the first call.  Check on the decl for
+     the gnat condition handler to decide, as this is one we create so we are
+     sure that it will be non null on subsequent calls.  The builtin decl is
+     looked up so remains null on targets where it is not implemented yet.  */
+  if (gnat_vms_condition_handler_decl == NULL_TREE)
+    {
+      vms_builtin_establish_handler_decl
+	= builtin_decl_for
+	  (get_identifier ("__builtin_establish_vms_condition_handler"));
+
+      gnat_vms_condition_handler_decl
+	= create_subprog_decl (get_identifier ("__gnat_handle_vms_condition"),
+			       NULL_TREE,
+			       build_function_type_list (integer_type_node,
+							 ptr_void_type_node,
+							 ptr_void_type_node,
+							 NULL_TREE),
+			       NULL_TREE, 0, 1, 1, 0, Empty);
+    }
+
+  /* Do nothing if the establish builtin is not available, which might happen
+     on targets where the facility is not implemented.  */
+  if (vms_builtin_establish_handler_decl == NULL_TREE)
+    return;
+
+  establish_stmt
+    = build_call_1_expr (vms_builtin_establish_handler_decl,
+			 build_unary_op
+			 (ADDR_EXPR, NULL_TREE,
+			  gnat_vms_condition_handler_decl));
+
+  add_stmt (establish_stmt);
+}
+
 /* Subroutine of gnat_to_gnu to process gnat_node, an N_Subprogram_Body.  We
    don't return anything.  */
 
@@ -1433,6 +1501,22 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
 		     gnat_to_gnu_entity (gnat_param, NULL_TREE, 1));
       }
 
+
+  /* On VMS, establish our condition handler to possibly turn a condition into
+     the corresponding exception if the subprogram has a foreign convention or
+     is exported.
+
+     To ensure proper execution of local finalizations on condition instances,
+     we must turn a condition into the corresponding exception even if there
+     is no applicable Ada handler, and need at least one condition handler per
+     possible call chain involving GNAT code.  OTOH, establishing the handler
+     has a cost so we want to mimize the number of subprograms into which this
+     happens.  The foreign or exported condition is expected to satisfy all
+     the constraints.  */
+  if (TARGET_ABI_OPEN_VMS
+      && (Has_Foreign_Convention (gnat_node) || Is_Exported (gnat_node)))
+    establish_gnat_vms_condition_handler ();
+
   process_decls (Declarations (gnat_node), Empty, Empty, true, true);
 
   /* Generate the code of the subprogram itself.  A return statement will be
@@ -3082,25 +3166,11 @@ gnat_to_gnu (Node_Id gnat_node)
 	if (Null_Record_Present (gnat_node))
 	  gnu_result = gnat_build_constructor (gnu_aggr_type, NULL_TREE);
 
-	else if (TREE_CODE (gnu_aggr_type) == UNION_TYPE
-		 && TYPE_UNCHECKED_UNION_P (gnu_aggr_type))
-	  {
-	    /* The first element is the discrimant, which we ignore.  The
-	       next is the field we're building.  Convert the expression
-	       to the type of the field and then to the union type.  */
-	    Node_Id gnat_assoc
-	      = Next (First (Component_Associations (gnat_node)));
-	    Entity_Id gnat_field = Entity (First (Choices (gnat_assoc)));
-	    tree gnu_field_type
-	      = TREE_TYPE (gnat_to_gnu_entity (gnat_field, NULL_TREE, 0));
-
-	    gnu_result = convert (gnu_field_type,
-				  gnat_to_gnu (Expression (gnat_assoc)));
-	  }
 	else if (TREE_CODE (gnu_aggr_type) == RECORD_TYPE
 		 || TREE_CODE (gnu_aggr_type) == UNION_TYPE)
 	  gnu_result
-	    = assoc_to_constructor (First (Component_Associations (gnat_node)),
+	    = assoc_to_constructor (Etype (gnat_node),
+				    First (Component_Associations (gnat_node)),
 				    gnu_aggr_type);
 	else if (TREE_CODE (gnu_aggr_type) == ARRAY_TYPE)
 	  gnu_result = pos_to_constructor (First (Expressions (gnat_node)),
@@ -3996,7 +4066,8 @@ gnat_to_gnu (Node_Id gnat_node)
 
 	  if (Present (Actual_Designated_Subtype (gnat_node)))
 	    {
-	      gnu_actual_obj_type = gnat_to_gnu_type (Actual_Designated_Subtype (gnat_node));
+	      gnu_actual_obj_type
+	        = gnat_to_gnu_type (Actual_Designated_Subtype (gnat_node));
 
 	      if (TYPE_FAT_OR_THIN_POINTER_P (gnu_ptr_type))
 	        gnu_actual_obj_type
@@ -5582,13 +5653,14 @@ process_type (Entity_Id gnat_entity)
     }
 }
 
-/* GNAT_ASSOC is the front of the Component_Associations of an N_Aggregate.
-   GNU_TYPE is the GCC type of the corresponding record.
+/* GNAT_ENTITY is the type of the resulting constructors,
+   GNAT_ASSOC is the front of the Component_Associations of an N_Aggregate,
+   and GNU_TYPE is the GCC type of the corresponding record.
 
    Return a CONSTRUCTOR to build the record.  */
 
 static tree
-assoc_to_constructor (Node_Id gnat_assoc, tree gnu_type)
+assoc_to_constructor (Entity_Id gnat_entity, Node_Id gnat_assoc, tree gnu_type)
 {
   tree gnu_list, gnu_result;
 
@@ -5614,6 +5686,11 @@ assoc_to_constructor (Node_Id gnat_assoc, tree gnu_type)
 	  && Is_Tagged_Type (Scope (Entity (gnat_field))))
 	continue;
 
+      /* Also ignore discriminants of Unchecked_Unions.  */
+      else if (Is_Unchecked_Union (gnat_entity)
+	       && Ekind (Entity (gnat_field)) == E_Discriminant)
+	continue;
+
       /* Before assigning a value in an aggregate make sure range checks
 	 are done if required.  Then convert to the type of the field.  */
       if (Do_Range_Check (Expression (gnat_assoc)))
diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c
index 0b499af..78c1237 100644
--- a/gcc/ada/utils.c
+++ b/gcc/ada/utils.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2005, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2006, 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- *
@@ -133,7 +133,6 @@ static tree float_type_for_precision (int, enum machine_mode);
 static tree convert_to_fat_pointer (tree, tree);
 static tree convert_to_thin_pointer (tree, tree);
 static tree make_descriptor_field (const char *,tree, tree, tree);
-static bool value_factor_p (tree, HOST_WIDE_INT);
 static bool potential_alignment_gap (tree, tree, tree);
 
 /* Initialize the association of GNAT nodes to GCC trees.  */
@@ -1215,9 +1214,10 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list,
 
   /* Pass type declaration information to the debugger unless this is an
      UNCONSTRAINED_ARRAY_TYPE, which the debugger does not support,
-     and ENUMERAL_TYPE or RECORD_TYPE which is handled separately,
-     a dummy type, which will be completed later, or a type for which
-     debugging information was not requested.  */
+     and ENUMERAL_TYPE or RECORD_TYPE which is handled separately, or
+     type for which debugging information was not requested.  */
+  if (code == UNCONSTRAINED_ARRAY_TYPE || ! debug_info_p)
+    DECL_IGNORED_P (type_decl) = 1;
   if (code == UNCONSTRAINED_ARRAY_TYPE || TYPE_IS_DUMMY_P (type)
       || !debug_info_p)
     DECL_IGNORED_P (type_decl) = 1;
@@ -1573,7 +1573,7 @@ process_attributes (tree decl, struct attrib *attr_list)
 /* Return true if VALUE is a known to be a multiple of FACTOR, which must be
    a power of 2. */
 
-static bool
+bool
 value_factor_p (tree value, HOST_WIDE_INT factor)
 {
   if (host_integerp (value, 1))
@@ -2471,7 +2471,8 @@ build_unc_object_type (tree template_type, tree object_type, tree name)
 /* Same, taking a thin or fat pointer type instead of a template type. */
 
 tree
-build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type, tree name)
+build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type,
+				tree name)
 {
   tree template_type;
 
@@ -2592,7 +2593,13 @@ update_pointer_to (tree old_type, tree new_type)
 				  TREE_CHAIN (TYPE_FIELDS (ptr)), new_ref));
 
       for (var = TYPE_MAIN_VARIANT (ptr); var; var = TYPE_NEXT_VARIANT (var))
-	SET_TYPE_UNCONSTRAINED_ARRAY (var, new_type);
+	{
+	  SET_TYPE_UNCONSTRAINED_ARRAY (var, new_type);
+
+	  /* This may seem a bit gross, in particular wrt DECL_CONTEXT, but
+	     actually is in keeping with what build_qualified_type does.  */
+	  TYPE_FIELDS (var) = TYPE_FIELDS (ptr);
+	}
 
       TYPE_POINTER_TO (new_type) = TYPE_REFERENCE_TO (new_type)
 	= TREE_TYPE (new_type) = ptr;
@@ -2722,7 +2729,6 @@ convert (tree type, tree expr)
   enum tree_code code = TREE_CODE (type);
   tree etype = TREE_TYPE (expr);
   enum tree_code ecode = TREE_CODE (etype);
-  tree tem;
 
   /* If EXPR is already the right type, we are done.  */
   if (type == etype)
@@ -2892,11 +2898,9 @@ convert (tree type, tree expr)
 	      return build1 (VIEW_CONVERT_EXPR, type, op0);
 
 	    /* Otherwise, we may just bypass the input view conversion unless
-	       one of the types is a fat pointer, or we're converting to an
-	       unchecked union type.  Both are handled by specialized code
-	       below and the latter relies on exact type matching.  */
-	    else if (!TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype)
-		     && !(code == UNION_TYPE && TYPE_UNCHECKED_UNION_P (type)))
+	       one of the types is a fat pointer,  which is handled by
+	       specialized code below which relies on exact type matching.  */
+	    else if (!TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
 	      return convert (type, op0);
 	  }
       }
@@ -3020,29 +3024,10 @@ convert (tree type, tree expr)
       return unchecked_convert (type, expr, false);
 
     case UNION_TYPE:
-      /* 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))
-	{
-	  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 ();
-	}
-      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);
+      /* This is a either a conversion between a tagged type and some
+	 subtype, which we have to mark as a UNION_TYPE because of
+	 overlapping fields or a conversion of an Unchecked_Union.  */
+      return unchecked_convert (type, expr, false);
 
     case UNCONSTRAINED_ARRAY_TYPE:
       /* If EXPR is a constrained array, take its address, convert it to a
diff --git a/gcc/ada/utils2.c b/gcc/ada/utils2.c
index f9d87dc..4f38e15 100644
--- a/gcc/ada/utils2.c
+++ b/gcc/ada/utils2.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2005, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2006, 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- *
@@ -232,8 +232,12 @@ find_common_type (tree t1, tree t2)
   else if (TYPE_MODE (t2) != BLKmode)
     return t2;
 
-  /* Otherwise, return the type that has a constant size.  */
-  if (TREE_CONSTANT (TYPE_SIZE (t1)))
+  /* If both types have constant size, use the smaller one.  */
+  if (TREE_CONSTANT (TYPE_SIZE (t1)) && TREE_CONSTANT (TYPE_SIZE (t2)))
+    return tree_int_cst_lt (TYPE_SIZE (t1), TYPE_SIZE (t2)) ? t1 : t2;
+
+  /* Otherwise, if either type has a constant size, use it.  */
+  else if (TREE_CONSTANT (TYPE_SIZE (t1)))
     return t1;
   else if (TREE_CONSTANT (TYPE_SIZE (t2)))
     return t2;
@@ -1617,7 +1621,8 @@ build_simple_component_ref (tree record_variable, tree component,
 
       for (new_field = TYPE_FIELDS (record_type); new_field;
 	   new_field = TREE_CHAIN (new_field))
-	if (DECL_ORIGINAL_FIELD (new_field) == field
+	if (field == new_field
+	    || DECL_ORIGINAL_FIELD (new_field) == field
 	    || new_field == DECL_ORIGINAL_FIELD (field)
 	    || (DECL_ORIGINAL_FIELD (field)
 		&& (DECL_ORIGINAL_FIELD (field)