OSDN Git Service

* gcc-interface/decl.c (gnat_to_gnu_entity): Create variables for size
[pf3gnuchains/gcc-fork.git] / gcc / ada / gcc-interface / decl.c
index 137d523..b0334f2 100644 (file)
@@ -560,8 +560,7 @@ 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))
-                || imported_p));
+                || Present (Renamed_Object (gnat_entity))));
        bool inner_const_flag = const_flag;
        bool static_p = Is_Statically_Allocated (gnat_entity);
        bool mutable_p = false;
@@ -582,13 +581,6 @@ 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)))
          {
@@ -749,7 +741,6 @@ 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))))
@@ -1007,9 +998,8 @@ 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
+                    || Is_Imported (gnat_entity)
                     || Present (Address_Clause (gnat_entity)))))
            && !TYPE_VOLATILE (gnu_type))
          gnu_type = build_qualified_type (gnu_type,
@@ -2930,21 +2920,6 @@ 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;
 
@@ -3000,20 +2975,6 @@ 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 = strchr (Name_Buffer, '_');
-             gcc_assert (p);
-             strcpy (p+2, "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.
@@ -3381,14 +3342,13 @@ 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));
-       /* The "full view" of the designated type.  If this is an incomplete
+
+       /* Get the "full view" of this entity.  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,
@@ -3396,8 +3356,7 @@ 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
@@ -3408,25 +3367,27 @@ 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);
-       /* The type actually used to represent the designated type, either
-          gnat_desig_full or gnat_desig_equiv.  */
+
+       /* This 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 made_dummy = false;
-       /* 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.  */
+       /* True if the dummy is a fat pointer.  */
+       bool made_dummy = false;
        tree gnu_desig_type = NULL_TREE;
+       enum machine_mode p_mode = mode_for_size (esize, MODE_INT, 0);
 
        if (!targetm.valid_pointer_mode (p_mode))
          p_mode = ptr_mode;
@@ -3439,21 +3400,22 @@ 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);
 
-       /* 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;
+       /* 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;
        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
@@ -3464,28 +3426,31 @@ 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))))
-               || (!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)))))
+                   && 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)))))
          {
+           tree gnu_old;
+
            if (present_gnu_tree (gnat_desig_rep))
-             gnu_desig_type = TREE_TYPE (get_gnu_tree (gnat_desig_rep));
+             gnu_old = TREE_TYPE (get_gnu_tree (gnat_desig_rep));
            else
              {
-               gnu_desig_type = make_dummy_type (gnat_desig_rep);
+               gnu_old = 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, 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 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 (!gnu_type)
              {
                tree gnu_template_type = make_node (ENUMERAL_TYPE);
@@ -3503,17 +3468,18 @@ 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_desig_type);
-               TYPE_POINTER_TO (gnu_desig_type) = gnu_type;
+               SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_old);
+               TYPE_POINTER_TO (gnu_old) = gnu_type;
 
                fields
-                 = create_field_decl (get_identifier ("P_ARRAY"),
+                 = chainon (chainon (NULL_TREE,
+                                     create_field_decl
+                                     (get_identifier ("P_ARRAY"),
                                       gnu_ptr_array, gnu_type,
-                                      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);
+                                      NULL_TREE, NULL_TREE, 0, 0)),
+                            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)
@@ -3524,11 +3490,10 @@ 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_desig_type)
-                 = make_node (RECORD_TYPE);
-               TYPE_NAME (TYPE_OBJECT_RECORD_TYPE (gnu_desig_type))
+               TYPE_OBJECT_RECORD_TYPE (gnu_old) = make_node (RECORD_TYPE);
+               TYPE_NAME (TYPE_OBJECT_RECORD_TYPE (gnu_old))
                  = create_concat_name (gnat_desig_equiv, "XUT");
-               TYPE_DUMMY_P (TYPE_OBJECT_RECORD_TYPE (gnu_desig_type)) = 1;
+               TYPE_DUMMY_P (TYPE_OBJECT_RECORD_TYPE (gnu_old)) = 1;
              }
          }
 
@@ -3537,35 +3502,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 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)))
+                /* 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))))
                 /* 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 finally 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 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);
@@ -3581,13 +3546,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 default case where we can just elaborate our
-          designated type.  */
+       /* Finally, handle the straightforward case where we can just
+          elaborate our designated type and point to it.  */
        else
          gnu_desig_type = gnat_to_gnu_type (gnat_desig_equiv);
 
@@ -3599,11 +3564,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            break;
          }
 
-       /* If we have not done it yet, build the pointer type the usual way.  */
-       if (!gnu_type)
+       /* 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)
          {
-           /* 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)
              {
@@ -3642,20 +3607,17 @@ 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 have made a dummy pointer,
+       /* If we are not defining this object and we 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 itself 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 is.  */
+       if ((! in_main_unit || is_from_limited_with) && made_dummy)
          {
-           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
+           tree gnu_old_type
              = TYPE_IS_FAT_POINTER_P (gnu_type)
                ? TYPE_UNCONSTRAINED_ARRAY (gnu_type) : TREE_TYPE (gnu_type);
 
@@ -3674,27 +3636,37 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            save_gnu_tree (gnat_entity, gnu_decl, false);
            saved = true;
 
-           /* 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.
+           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));
 
-              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.
+             /* 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.
 
-              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));
+                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.
+
+                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.  */
            else
              {
-               struct incomplete *p = XNEW (struct incomplete);
+               struct incomplete *p
+                 = (struct incomplete *) xmalloc (sizeof
+                                                  (struct incomplete));
                struct incomplete **head
-                 = (is_from_limited_with_in_main_unit
+                 = (is_from_limited_with
+                    && (in_main_unit
+                        || In_Extended_Main_Code_Unit (gnat_entity))
                     ? &defer_limited_with : &defer_incomplete_list);
-               p->old_type = gnu_old_desig_type;
+
+               p->old_type = gnu_old_type;
                p->full_type = gnat_desig_equiv;
                p->next = *head;
                *head = p;
@@ -5983,8 +5955,8 @@ make_aligning_type (tree type, unsigned int align, tree size,
 
   if (TREE_CODE (name) == TYPE_DECL)
     name = DECL_NAME (name);
-  name = concat_name (name, "ALIGN");
-  TYPE_NAME (record_type) = name;
+
+  TYPE_NAME (record_type) = concat_name (name, "_ALIGN");
 
   /* Compute VOFFSET and then POS.  The next byte position multiple of some
      alignment after some address is obtained by "and"ing the alignment minus
@@ -6029,12 +6001,8 @@ 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);
 
+  relate_alias_sets (record_type, type, ALIAS_SET_COPY);
   return record_type;
 }
 \f