* gimple.c (walk_gimple_op) <GIMPLE_ASSIGN>: Do not request a pure

[pf3gnuchains/gcc-fork.git] / gcc / ada / gcc-interface / trans.c

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 7716061..97ac2f3 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -396,9 +396,6 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
                                                     int64_type, NULL_TREE),
                           NULL_TREE, false, true, true, NULL, Empty);
 
                                                     int64_type, NULL_TREE),
                           NULL_TREE, false, true, true, NULL, Empty);
 

-  /* Name of the _Parent field in tagged record types.  */
-  parent_name_id = get_identifier (Get_Name_String (Name_uParent));
-

   /* Make the types and functions used for exception processing.  */
   jmpbuf_type
     = build_array_type (gnat_type_for_mode (Pmode, 0),
   /* Make the types and functions used for exception processing.  */
   jmpbuf_type
     = build_array_type (gnat_type_for_mode (Pmode, 0),


@@ -797,29 +794,13 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
              || (Is_Composite_Type (Underlying_Type (Etype (gnat_node)))
                  && Is_Atomic (Entity (Name (gnat_parent)))));
 
              || (Is_Composite_Type (Underlying_Type (Etype (gnat_node)))
                  && Is_Atomic (Entity (Name (gnat_parent)))));
 

-    case N_Type_Conversion:
-    case N_Qualified_Expression:
-      /* We must look through all conversions for composite types because we
-        may need to bypass an intermediate conversion to a narrower record
-        type that is generated for a formal conversion, e.g. the conversion
-        to the root type of a hierarchy of tagged types generated for the
-        formal conversion to the class-wide type.  */
-      if (!Is_Composite_Type (Underlying_Type (Etype (gnat_node))))
-       return 0;
-
-      /* ... fall through ... */
-

     case N_Unchecked_Type_Conversion:
     case N_Unchecked_Type_Conversion:

+      /* Returning 0 is very likely correct but we get better code if we
+        go through the conversion.  */

       return lvalue_required_p (gnat_parent,
                                get_unpadded_type (Etype (gnat_parent)),
                                constant, address_of_constant, aliased);
 
       return lvalue_required_p (gnat_parent,
                                get_unpadded_type (Etype (gnat_parent)),
                                constant, address_of_constant, aliased);
 

-    case N_Allocator:
-      /* We should only reach here through the N_Qualified_Expression case
-        and, therefore, only for composite types.  Force an lvalue since
-        a block-copy to the newly allocated area of memory is made.  */
-      return 1;
-

    case N_Explicit_Dereference:
       /* We look through dereferences for address of constant because we need
         to handle the special cases listed above.  */
    case N_Explicit_Dereference:
       /* We look through dereferences for address of constant because we need
         to handle the special cases listed above.  */


@@ -3279,7 +3260,11 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
      handler can catch, with special cases for others and all others cases.
 
      Each exception type is actually identified by a pointer to the exception
      handler can catch, with special cases for others and all others cases.
 
      Each exception type is actually identified by a pointer to the exception

-     id, or to a dummy object for "others" and "all others".  */
+     id, or to a dummy object for "others" and "all others".
+
+     Care should be taken to ensure that the control flow impact of "others"
+     and "all others" is known to GCC. lang_eh_type_covers is doing the trick
+     currently.  */

   for (gnat_temp = First (Exception_Choices (gnat_node));
        gnat_temp; gnat_temp = Next (gnat_temp))
     {
   for (gnat_temp = First (Exception_Choices (gnat_node));
        gnat_temp; gnat_temp = Next (gnat_temp))
     {


@@ -6073,85 +6058,92 @@ elaborate_all_entities (Node_Id gnat_node)
     elaborate_all_entities (Library_Unit (gnat_node));
 }
 \f
     elaborate_all_entities (Library_Unit (gnat_node));
 }
 \f

-/* Do the processing of GNAT_NODE, an N_Freeze_Entity.  */
+/* Do the processing of N_Freeze_Entity, GNAT_NODE.  */

 
 static void
 process_freeze_entity (Node_Id gnat_node)
 {
 
 static void
 process_freeze_entity (Node_Id gnat_node)
 {

-  const Entity_Id gnat_entity = Entity (gnat_node);
-  const Entity_Kind kind = Ekind (gnat_entity);
-  tree gnu_old, gnu_new;
+  Entity_Id gnat_entity = Entity (gnat_node);
+  tree gnu_old;
+  tree gnu_new;
+  tree gnu_init
+    = (Nkind (Declaration_Node (gnat_entity)) == N_Object_Declaration
+       && present_gnu_tree (Declaration_Node (gnat_entity)))
+      ? get_gnu_tree (Declaration_Node (gnat_entity)) : NULL_TREE;

 
 

-  /* If this is a package, we need to generate code for the package.  */
-  if (kind == E_Package)
+  /* If this is a package, need to generate code for the package.  */
+  if (Ekind (gnat_entity) == E_Package)

     {
       insert_code_for
     {
       insert_code_for

-       (Parent (Corresponding_Body
-                (Parent (Declaration_Node (gnat_entity)))));
+       (Parent (Corresponding_Body
+                (Parent (Declaration_Node (gnat_entity)))));

       return;
     }
 
       return;
     }
 

-  /* Don't do anything for class-wide types as they are always transformed
-     into their root type.  */
-  if (kind == E_Class_Wide_Type)
-    return;
-
-  /* Check for an old definition.  This freeze node might be for an Itype.  */
+  /* Check for old definition after the above call.  This Freeze_Node
+     might be for one its Itypes.  */

   gnu_old
   gnu_old

-    = present_gnu_tree (gnat_entity) ? get_gnu_tree (gnat_entity) : NULL_TREE;
+    = present_gnu_tree (gnat_entity) ? get_gnu_tree (gnat_entity) : 0;

 
 

-  /* If this entity has an address representation clause, GNU_OLD is the
+  /* If this entity has an Address representation clause, GNU_OLD is the

      address, so discard it here.  */
   if (Present (Address_Clause (gnat_entity)))
      address, so discard it here.  */
   if (Present (Address_Clause (gnat_entity)))

-    gnu_old = NULL_TREE;
+    gnu_old = 0;
+
+  /* Don't do anything for class-wide types as they are always transformed
+     into their root type.  */
+  if (Ekind (gnat_entity) == E_Class_Wide_Type)
+    return;

 
   /* Don't do anything for subprograms that may have been elaborated before
 
   /* Don't do anything for subprograms that may have been elaborated before

-     their freeze nodes.  This can happen, for example, because of an inner
-     call in an instance body or because of previous compilation of a spec
-     for inlining purposes.  */
+     their freeze nodes.  This can happen, for example because of an inner call
+     in an instance body, or a previous compilation of a spec for inlining
+     purposes.  */

   if (gnu_old
       && ((TREE_CODE (gnu_old) == FUNCTION_DECL
   if (gnu_old
       && ((TREE_CODE (gnu_old) == FUNCTION_DECL

-          && (kind == E_Function || kind == E_Procedure))
-         || (TREE_CODE (TREE_TYPE (gnu_old)) == FUNCTION_TYPE
-             && kind == E_Subprogram_Type)))
+          && (Ekind (gnat_entity) == E_Function
+              || Ekind (gnat_entity) == E_Procedure))
+         || (gnu_old
+             && TREE_CODE (TREE_TYPE (gnu_old)) == FUNCTION_TYPE
+             && Ekind (gnat_entity) == E_Subprogram_Type)))

     return;
 
   /* If we have a non-dummy type old tree, we have nothing to do, except
      aborting if this is the public view of a private type whose full view was
      not delayed, as this node was never delayed as it should have been.  We
      let this happen for concurrent types and their Corresponding_Record_Type,
     return;
 
   /* If we have a non-dummy type old tree, we have nothing to do, except
      aborting if this is the public view of a private type whose full view was
      not delayed, as this node was never delayed as it should have been.  We
      let this happen for concurrent types and their Corresponding_Record_Type,

-     however, because each might legitimately be elaborated before its own
+     however, because each might legitimately be elaborated before it's own

      freeze node, e.g. while processing the other.  */
   if (gnu_old
       && !(TREE_CODE (gnu_old) == TYPE_DECL
           && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_old))))
     {
      freeze node, e.g. while processing the other.  */
   if (gnu_old
       && !(TREE_CODE (gnu_old) == TYPE_DECL
           && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_old))))
     {

-      gcc_assert ((IN (kind, Incomplete_Or_Private_Kind)
+      gcc_assert ((IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)

                   && Present (Full_View (gnat_entity))
                   && No (Freeze_Node (Full_View (gnat_entity))))
                  || Is_Concurrent_Type (gnat_entity)
                   && Present (Full_View (gnat_entity))
                   && No (Freeze_Node (Full_View (gnat_entity))))
                  || Is_Concurrent_Type (gnat_entity)

-                 || (IN (kind, Record_Kind)
+                 || (IN (Ekind (gnat_entity), Record_Kind)

                      && Is_Concurrent_Record_Type (gnat_entity)));
       return;
     }
 
   /* Reset the saved tree, if any, and elaborate the object or type for real.
                      && Is_Concurrent_Record_Type (gnat_entity)));
       return;
     }
 
   /* Reset the saved tree, if any, and elaborate the object or type for real.

-     If there is a full view, elaborate it and use the result.  And, if this
-     is the root type of a class-wide type, reuse it for the latter.  */
+     If there is a full declaration, elaborate it and copy the type to
+     GNAT_ENTITY.  Likewise if this is the record subtype corresponding to
+     a class wide type or subtype.  */

   if (gnu_old)
     {
       save_gnu_tree (gnat_entity, NULL_TREE, false);
   if (gnu_old)
     {
       save_gnu_tree (gnat_entity, NULL_TREE, false);

-      if (IN (kind, Incomplete_Or_Private_Kind)
-         && Present (Full_View (gnat_entity))
-         && present_gnu_tree (Full_View (gnat_entity)))
-       save_gnu_tree (Full_View (gnat_entity), NULL_TREE, false);
-      if (IN (kind, Type_Kind)
-         && Present (Class_Wide_Type (gnat_entity))
-         && Root_Type (Class_Wide_Type (gnat_entity)) == gnat_entity)
+      if (IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
+         && Present (Full_View (gnat_entity))
+         && present_gnu_tree (Full_View (gnat_entity)))
+       save_gnu_tree (Full_View (gnat_entity), NULL_TREE, false);
+      if (Present (Class_Wide_Type (gnat_entity))
+         && Class_Wide_Type (gnat_entity) != gnat_entity)

        save_gnu_tree (Class_Wide_Type (gnat_entity), NULL_TREE, false);
     }
 
        save_gnu_tree (Class_Wide_Type (gnat_entity), NULL_TREE, false);
     }
 

-  if (IN (kind, Incomplete_Or_Private_Kind)
+  if (IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)

       && Present (Full_View (gnat_entity)))
     {
       gnu_new = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 1);
       && Present (Full_View (gnat_entity)))
     {
       gnu_new = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 1);


@@ -6167,25 +6159,16 @@ process_freeze_entity (Node_Id gnat_node)
        Set_RM_Size (gnat_entity, RM_Size (Full_View (gnat_entity)));
 
       /* The above call may have defined this entity (the simplest example
        Set_RM_Size (gnat_entity, RM_Size (Full_View (gnat_entity)));
 
       /* The above call may have defined this entity (the simplest example

-        of this is when we have a private enumeral type since the bounds
-        will have the public view).  */
+        of this is when we have a private enumeral type since the bounds
+        will have the public view.  */

       if (!present_gnu_tree (gnat_entity))
       if (!present_gnu_tree (gnat_entity))

-       save_gnu_tree (gnat_entity, gnu_new, false);
+       save_gnu_tree (gnat_entity, gnu_new, false);
+      if (Present (Class_Wide_Type (gnat_entity))
+         && Class_Wide_Type (gnat_entity) != gnat_entity)
+       save_gnu_tree (Class_Wide_Type (gnat_entity), gnu_new, false);

     }
   else
     }
   else

-    {
-      tree gnu_init
-       = (Nkind (Declaration_Node (gnat_entity)) == N_Object_Declaration
-          && present_gnu_tree (Declaration_Node (gnat_entity)))
-         ? get_gnu_tree (Declaration_Node (gnat_entity)) : NULL_TREE;
-
-      gnu_new = gnat_to_gnu_entity (gnat_entity, gnu_init, 1);
-    }
-
-  if (IN (kind, Type_Kind)
-      && Present (Class_Wide_Type (gnat_entity))
-      && Root_Type (Class_Wide_Type (gnat_entity)) == gnat_entity)
-    save_gnu_tree (Class_Wide_Type (gnat_entity), gnu_new, false);
+    gnu_new = gnat_to_gnu_entity (gnat_entity, gnu_init, 1);

 
   /* If we've made any pointers to the old version of this type, we
      have to update them.  */
 
   /* If we've made any pointers to the old version of this type, we
      have to update them.  */