2011-09-06 Robert Dewar <dewar@adacore.com>

	* s-tpopsp-vxworks.adb, prj-nmsc.adb: Minor reformatting.

2011-09-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* gcc-interface/trans.c (Attribute_to_gnu): New case for
	attribute Descriptor_Size.
	* exp_attr.adb (Expand_N_Attribute_Reference): Add processing
	for attribute Descriptor_Size.
	* exp_ch7.adb (Double_Size_Of): Removed.
	(Make_Finalize_Address_Stmts): Remove the code which generates
	an expression to calculate the dope vector of an unconstrained
	array. Instead use attribute Descriptor_Size and leave the
	calculation to the back end.
	(Nearest_Multiple_Rounded_Up): Removed.
	(Size_Of): Removed.
	* sem_attr.adb (Analyze_Attribute): Add processing for attribute
	Descriptor_Size. Currently the attribute is applicable only
	to unconstrained arrays.
	(Eval_Attribute): Add processing for
	attribute Descriptor_Size.
	* snames.ads-tmpl: Add a predefined name and an Attribute_Id
	for Descriptor_Size.

2011-09-06  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb: Remove useless formal.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178585 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 74a7edf..f79353a 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -109,15 +109,12 @@ package body Exp_Aggr is
    function Build_Record_Aggr_Code
      (N                             : Node_Id;
       Typ                           : Entity_Id;
-      Lhs                           : Node_Id;
-      Is_Limited_Ancestor_Expansion : Boolean   := False) return List_Id;
+      Lhs                           : Node_Id) return List_Id;
    --  N is an N_Aggregate or an N_Extension_Aggregate. Typ is the type of the
    --  aggregate. Target is an expression containing the location on which the
    --  component by component assignments will take place. Returns the list of
    --  assignments plus all other adjustments needed for tagged and controlled
-   --  types. Is_Limited_Ancestor_Expansion indicates that the function has
-   --  been called recursively to expand the limited ancestor to avoid copying
-   --  it.
+   --  types.
 
    procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id);
    --  N is an N_Aggregate or an N_Extension_Aggregate. Typ is the type of the
@@ -1734,8 +1731,7 @@ package body Exp_Aggr is
    function Build_Record_Aggr_Code
      (N                             : Node_Id;
       Typ                           : Entity_Id;
-      Lhs                           : Node_Id;
-      Is_Limited_Ancestor_Expansion : Boolean := False) return List_Id
+      Lhs                           : Node_Id) return List_Id
    is
       Loc     : constant Source_Ptr := Sloc (N);
       L       : constant List_Id    := New_List;
@@ -2338,8 +2334,7 @@ package body Exp_Aggr is
                   Build_Record_Aggr_Code (
                     N   => Unqualify (Ancestor),
                     Typ => Etype (Unqualify (Ancestor)),
-                    Lhs => Target,
-                    Is_Limited_Ancestor_Expansion => True));
+                    Lhs => Target));
 
             --  If the ancestor part is an expression "E", we generate
 

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 598520a..a98a7b9 100644 (file)
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -1799,6 +1799,15 @@ package body Exp_Attr is
          Analyze_And_Resolve (N, Typ);
       end Count;
 
+      ---------------------
+      -- Descriptor_Size --
+      ---------------------
+
+      --  This attribute is handled entirely by the back end
+
+      when Attribute_Descriptor_Size =>
+         Apply_Universal_Integer_Attribute_Checks (N);
+
       ---------------
       -- Elab_Body --
       ---------------

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 5ba3bc4..c7ea703 100644 (file)
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -7023,99 +7023,6 @@ package body Exp_Ch7 is
       Desg_Typ : Entity_Id;
       Obj_Expr : Node_Id;
 
-      function Double_Size_Of (Typ : Entity_Id) return Node_Id;
-      --  Subsidiary routine, produces an expression which calculates double
-      --  the size of Typ as the nearest multiple of its alignment rounded up.
-
-      function Nearest_Multiple_Rounded_Up
-        (Size_Expr : Node_Id;
-         Typ       : Entity_Id) return Node_Id;
-      --  Subsidiary routine, generate the following expression:
-      --    ((Size_Expr + Typ'Alignment - 1) / Typ'Alignment) * Typ'Alignment
-
-      function Size_Of (Typ : Entity_Id) return Node_Id;
-      --  Subsidiary routine, produces an expression which calculates the size
-      --  of Typ as the nearest multiple of its alignment rounded up.
-
-      --------------------
-      -- Double_Size_Of --
-      --------------------
-
-      function Double_Size_Of (Typ : Entity_Id) return Node_Id is
-      begin
-         return
-           Make_Op_Multiply (Loc,
-             Left_Opnd  => Make_Integer_Literal (Loc, 2),
-             Right_Opnd => Size_Of (Typ));
-      end Double_Size_Of;
-
-      ---------------------------------
-      -- Nearest_Multiple_Rounded_Up --
-      ---------------------------------
-
-      function Nearest_Multiple_Rounded_Up
-        (Size_Expr : Node_Id;
-         Typ       : Entity_Id) return Node_Id
-      is
-         function Alignment_Of (Typ : Entity_Id) return Node_Id;
-         --  Subsidiary routine, generate the following attribute reference:
-         --    Typ'Alignment
-
-         ------------------
-         -- Alignment_Of --
-         ------------------
-
-         function Alignment_Of (Typ : Entity_Id) return Node_Id is
-         begin
-            return
-              Make_Attribute_Reference (Loc,
-                Prefix         => New_Reference_To (Typ, Loc),
-                Attribute_Name => Name_Alignment);
-         end Alignment_Of;
-
-      --  Start of processing for Nearest_Multiple_Rounded_Up
-
-      begin
-         --  Generate:
-         --    ((Size_Expr + Typ'Alignment - 1) / Typ'Alignment) *
-         --                                           Typ'Alignment
-
-         return
-           Make_Op_Multiply (Loc,
-             Left_Opnd  =>
-               Make_Op_Divide (Loc,
-                 Left_Opnd  =>
-                   Make_Op_Add (Loc,
-                     Left_Opnd  => Size_Expr,
-                     Right_Opnd =>
-                       Make_Op_Subtract (Loc,
-                         Left_Opnd  => Alignment_Of (Typ),
-                         Right_Opnd => Make_Integer_Literal (Loc, 1))),
-                 Right_Opnd => Alignment_Of (Typ)),
-             Right_Opnd => Alignment_Of (Typ));
-      end Nearest_Multiple_Rounded_Up;
-
-      -------------
-      -- Size_Of --
-      -------------
-
-      function Size_Of (Typ : Entity_Id) return Node_Id is
-      begin
-         return
-           Nearest_Multiple_Rounded_Up
-             (Size_Expr =>
-                Make_Op_Divide (Loc,
-                  Left_Opnd  =>
-                    Make_Attribute_Reference (Loc,
-                      Prefix         => New_Reference_To (Typ, Loc),
-                      Attribute_Name => Name_Size),
-                  Right_Opnd =>
-                    Make_Integer_Literal (Loc, System_Storage_Unit)),
-              Typ => Typ);
-      end Size_Of;
-
-   --  Start of processing for Make_Finalize_Address_Stmts
-
    begin
       if Is_Array_Type (Typ) then
          if Is_Constrained (First_Subtype (Typ)) then
@@ -7190,11 +7097,7 @@ package body Exp_Ch7 is
         and then not Is_Constrained (First_Subtype (Typ))
       then
          declare
-            Dope_Expr : Node_Id;
-            Dope_Id   : Entity_Id;
-            For_First : Boolean := True;
-            Index     : Node_Id;
-            Index_Typ : Entity_Id;
+            Dope_Id : Entity_Id;
 
          begin
             --  Ensure that Ptr_Typ a thin pointer, generate:
@@ -7207,40 +7110,9 @@ package body Exp_Ch7 is
                 Expression =>
                   Make_Integer_Literal (Loc, System_Address_Size)));
 
-            --  For unconstrained arrays, create the expression which computes
-            --  the size of the dope vector.
-
-            Index := First_Index (Typ);
-            while Present (Index) loop
-               Index_Typ := Etype (Index);
-
-               --  Each bound has two values and a potential hole added to
-               --  compensate for alignment differences.
-
-               if For_First then
-                  For_First := False;
-                  Dope_Expr := Double_Size_Of (Index_Typ);
-
-               else
-                  Dope_Expr :=
-                    Make_Op_Add (Loc,
-                      Left_Opnd  => Dope_Expr,
-                      Right_Opnd => Double_Size_Of (Index_Typ));
-               end if;
-
-               Next_Index (Index);
-            end loop;
-
-            --  Dope_Expr calculates the size of the dope, acounting for
-            --  individual alignment holes on the index type level. Since the
-            --  alignment of the component type dictates the underlying layout
-            --  of the array, round the size of the dope to the next higher
-            --  multiple of the component alignment.
-
-            Dope_Expr := Nearest_Multiple_Rounded_Up (Dope_Expr, Typ);
-
             --  Generate:
-            --    Dnn : Storage_Offset := Dope_Expr;
+            --    Dnn : constant Storage_Offset :=
+            --            Desg_Typ'Descriptor_Size / Storage_Unit;
 
             Dope_Id := Make_Temporary (Loc, 'D');
 
@@ -7250,7 +7122,14 @@ package body Exp_Ch7 is
                 Constant_Present    => True,
                 Object_Definition   =>
                   New_Reference_To (RTE (RE_Storage_Offset), Loc),
-                Expression          => Dope_Expr));
+                Expression          =>
+                  Make_Op_Divide (Loc,
+                    Left_Opnd  =>
+                      Make_Attribute_Reference (Loc,
+                        Prefix         => New_Reference_To (Desg_Typ, Loc),
+                        Attribute_Name => Name_Descriptor_Size),
+                    Right_Opnd =>
+                      Make_Integer_Literal (Loc, System_Storage_Unit))));
 
             --  Shift the address from the start of the dope vector to the
             --  start of the elements:

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 8e0ccd4..13df71f 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -1878,6 +1878,20 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
       prefix_unused = true;
       break;
 
+    case Attr_Descriptor_Size:
+      gnu_type = TREE_TYPE (gnu_prefix);
+      gcc_assert (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE);
+
+      /* What we want is the offset of the ARRAY field in the record that the
+        thin pointer designates, but the components have been shifted so this
+        is actually the opposite of the offset of the BOUNDS field.  */
+      gnu_type = TYPE_OBJECT_RECORD_TYPE (gnu_type);
+      gnu_result = size_binop (MINUS_EXPR, bitsize_zero_node,
+                               bit_position (TYPE_FIELDS (gnu_type)));
+      gnu_result_type = get_unpadded_type (Etype (gnat_node));
+      prefix_unused = true;
+      break;
+
     case Attr_Null_Parameter:
       /* This is just a zero cast to the pointer type for our prefix and
         dereferenced.  */

diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index e7d9c5a..9193769 100644 (file)
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -6718,11 +6718,11 @@ package body Prj.Nmsc is
 
                if not Header_File then
                   Compute_Unit_Name
-                    (File_Name       => File_Name,
-                     Naming          => Config.Naming_Data,
-                     Kind            => Kind,
-                     Unit            => Unit,
-                     Project         => Project);
+                    (File_Name => File_Name,
+                     Naming    => Config.Naming_Data,
+                     Kind      => Kind,
+                     Unit      => Unit,
+                     Project   => Project);
 
                   if Unit /= No_Name then
                      Language    := Tmp_Lang;

diff --git a/gcc/ada/s-tpopsp-vxworks.adb b/gcc/ada/s-tpopsp-vxworks.adb
index 09c03ef..a926ca4 100644 (file)
--- a/gcc/ada/s-tpopsp-vxworks.adb
+++ b/gcc/ada/s-tpopsp-vxworks.adb
@@ -70,7 +70,9 @@ package body Specific is
       Result : STATUS;
 
    begin
-      --  If Self_Id is null, delete task specific data
+      --  If argument is null, destroy task specific data, to make API
+      --  consistent with other platforms, and thus compatible with the
+      --  shared version of s-tpoaal.adb.
 
       if Self_Id = null then
          Result := taskVarDelete (taskIdSelf, ATCB_Key'Access);

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 789cb47..9b33acd 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -3014,6 +3014,28 @@ package body Sem_Attr is
          Check_Floating_Point_Type_0;
          Set_Etype (N, Standard_Boolean);
 
+      ---------------------
+      -- Descriptor_Size --
+      ---------------------
+
+      when Attribute_Descriptor_Size =>
+         Check_E0;
+
+         --  Attribute Descriptor_Size is relevant only in the context of an
+         --  unconstrained array type.
+
+         if Is_Entity_Name (P)
+           and then Is_Type (Entity (P))
+           and then Is_Array_Type (Entity (P))
+           and then not Is_Constrained (Entity (P))
+         then
+            null;
+         else
+            Error_Attr_P ("invalid prefix for % attribute");
+         end if;
+
+         Set_Etype (N, Universal_Integer);
+
       ------------
       -- Digits --
       ------------
@@ -6246,6 +6268,13 @@ package body Sem_Attr is
          Fold_Uint
            (N, UI_From_Int (Boolean'Pos (Denorm_On_Target)), True);
 
+      ---------------------
+      -- Descriptor_Size --
+      ---------------------
+
+      when Attribute_Descriptor_Size =>
+         null;
+
       ------------
       -- Digits --
       ------------

diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index fea05ef..332a790 100644 (file)
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -744,6 +744,7 @@ package Snames is
    Name_Definite                       : constant Name_Id := N + $;
    Name_Delta                          : constant Name_Id := N + $;
    Name_Denorm                         : constant Name_Id := N + $;
+   Name_Descriptor_Size                : constant Name_Id := N + $;
    Name_Digits                         : constant Name_Id := N + $;
    Name_Elaborated                     : constant Name_Id := N + $; -- GNAT
    Name_Emax                           : constant Name_Id := N + $; -- Ada 83
@@ -1298,6 +1299,7 @@ package Snames is
       Attribute_Definite,
       Attribute_Delta,
       Attribute_Denorm,
+      Attribute_Descriptor_Size,
       Attribute_Digits,
       Attribute_Elaborated,
       Attribute_Emax,