[multiple changes]

2009-04-08  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb (Check_File, Process_Sources_In_Multi_Language_Mode):
	avoid copies of Source_Data variables when possible, since these
	involve calls to memcpy() which are done too many times.

2009-04-08  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Expand_Concatenate): Clean up code

From-SVN: r145721

3 files changed, 164 insertions, 150 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8acfe5e..91ac2e5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2009-04-08  Emmanuel Briot  <briot@adacore.com>
+
+	* prj-nmsc.adb (Check_File, Process_Sources_In_Multi_Language_Mode):
+	avoid copies of Source_Data variables when possible, since these
+	involve calls to memcpy() which are done too many times.
+
+2009-04-08  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch4.adb (Expand_Concatenate): Clean up code
+
 2009-04-07  Thomas Quinot  <quinot@adacore.com>
 
 	* exp_ch4.adb (Expand_Concatenate): Add missing conversion to index
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 771efd4..fa8ef46 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -62,7 +62,6 @@ with Sem_Warn; use Sem_Warn;
 with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with Stand;    use Stand;
-with Stringt;  use Stringt;
 with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Ttypes;   use Ttypes;
@@ -2168,7 +2167,14 @@ package body Exp_Ch4 is
       --  Number of concatenation operands including possibly null operands
 
       NN : Nat := 0;
-      --  Number of operands excluding any known to be null
+      --  Number of operands excluding any known to be null, except that the
+      --  last operand is always retained, in case it provides the bounds for
+      --  a null result.
+
+      Opnd : Node_Id;
+      --  Current operand being processed in the loop through operands. After
+      --  this loop is complete, always contains the last operand (which is not
+      --  the same as Operands (NN), since null operands are skipped).
 
       --  Arrays describing the operands, only the first NN entries of each
       --  array are set (NN < N when we exclude known null operands).
@@ -2177,7 +2183,8 @@ package body Exp_Ch4 is
       --  True if length of corresponding operand known at compile time
 
       Operands : array (1 .. N) of Node_Id;
-      --  Set to the corresponding entry in the Opnds list
+      --  Set to the corresponding entry in the Opnds list (but note that null
+      --  operands are excluded, so not all entries in the list are stored).
 
       Fixed_Length : array (1 .. N) of Uint;
       --  Set to length of operand. Entries in this array are set only if the
@@ -2188,11 +2195,6 @@ package body Exp_Ch4 is
       --  where the bound is known at compile time, else actual lower bound.
       --  The operand low bound is of type Ityp.
 
-      Opnd_High_Bound : array (1 .. N) of Node_Id;
-      --  Set to upper bound of operand. Either an integer literal in the case
-      --  where the bound is known at compile time, else actual upper bound.
-      --  The operand bound is of type Ityp.
-
       Var_Length : array (1 .. N) of Entity_Id;
       --  Set to an entity of type Natural that contains the length of an
       --  operand whose length is not known at compile time. Entries in this
@@ -2211,6 +2213,12 @@ package body Exp_Ch4 is
       --  This is either an integer literal node, or an identifier reference to
       --  a constant entity initialized to the appropriate value.
 
+      Last_Opnd_High_Bound : Node_Id;
+      --  A tree node representing the high bound of the last operand. This
+      --  need only be set if the result could be null. It is used for the
+      --  special case of setting the right high bound for a null result.
+      --  This is of type Ityp.
+
       High_Bound : Node_Id;
       --  A tree node representing the high bound of the result (of type Ityp)
 
@@ -2274,7 +2282,7 @@ package body Exp_Ch4 is
             --  we analyzed and resolved the expression.
 
             Set_Parent (X, Cnode);
-            Analyze_And_Resolve (X, Intyp);
+            Analyze_And_Resolve (X);
 
             if Compile_Time_Compare
                  (X, Type_High_Bound (Ityp),
@@ -2302,7 +2310,6 @@ package body Exp_Ch4 is
 
       --  Local Declarations
 
-      Opnd     : Node_Id;
       Opnd_Typ : Entity_Id;
       Ent      : Entity_Id;
       Len      : Uint;
@@ -2383,9 +2390,8 @@ package body Exp_Ch4 is
             Fixed_Length (NN) := Uint_1;
             Result_May_Be_Null := False;
 
-            --  Set bounds of operand (no need to set high bound since we know
-            --  for sure that result won't be null, so we won't ever use
-            --  Opnd_High_Bound).
+            --  Set low bound of operand (no need to set Last_Opnd_High_Bound
+            --  since we know that the result cannot be null).
 
             Opnd_Low_Bound (NN) :=
               Make_Attribute_Reference (Loc,
@@ -2399,7 +2405,21 @@ package body Exp_Ch4 is
          elsif Nkind (Opnd) = N_String_Literal then
             Len := String_Literal_Length (Opnd_Typ);
 
-            --  Skip null string literal unless last operand
+            if Len /= 0 then
+               Result_May_Be_Null := False;
+            end if;
+
+            --  Capture last operand high bound if result could be null
+
+            if J = N and then Result_May_Be_Null then
+               Last_Opnd_High_Bound :=
+                 Make_Op_Add (Loc,
+                   Left_Opnd  =>
+                     New_Copy_Tree (String_Literal_Low_Bound (Opnd_Typ)),
+                   Right_Opnd => Make_Integer_Literal (Loc, 1));
+            end if;
+
+            --  Skip null string literal
 
             if J < N and then Len = 0 then
                goto Continue;
@@ -2416,14 +2436,7 @@ package body Exp_Ch4 is
             Opnd_Low_Bound (NN) :=
               New_Copy_Tree (String_Literal_Low_Bound (Opnd_Typ));
 
-            Opnd_High_Bound (NN) :=
-              Make_Op_Add (Loc,
-                Left_Opnd  =>
-                  New_Copy_Tree (String_Literal_Low_Bound (Opnd_Typ)),
-                Right_Opnd => Make_Integer_Literal (Loc, 1));
-
             Set := True;
-            Result_May_Be_Null := False;
 
          --  All other cases
 
@@ -2456,10 +2469,18 @@ package body Exp_Ch4 is
                            Result_May_Be_Null := False;
                         end if;
 
-                        --  Exclude null length case except for last operand
-                        --  (where we may need it to get proper bounds).
+                        --  Capture last operand bound if result could be null
+
+                        if J = N and then Result_May_Be_Null then
+                           Last_Opnd_High_Bound :=
+                             Convert_To (Ityp,
+                               Make_Integer_Literal (Loc,
+                                 Intval => Expr_Value (Hi)));
+                        end if;
+
+                        --  Exclude null length case unless last operand
 
-                        if Len = 0 and then J < N then
+                        if J < N and then Len = 0 then
                            goto Continue;
                         end if;
 
@@ -2472,10 +2493,6 @@ package body Exp_Ch4 is
                           Make_Integer_Literal (Loc,
                             Intval => Expr_Value (Lo)));
 
-                        Opnd_High_Bound (NN) := To_Ityp (
-                          Make_Integer_Literal (Loc,
-                            Intval => Expr_Value (Hi)));
-
                         Set := True;
                      end;
                   end if;
@@ -2497,11 +2514,14 @@ package body Exp_Ch4 is
                      Duplicate_Subexpr (Opnd, Name_Req => True),
                    Attribute_Name => Name_First);
 
-               Opnd_High_Bound (NN) :=
-                 Make_Attribute_Reference (Loc,
-                   Prefix         =>
-                     Duplicate_Subexpr (Opnd, Name_Req => True),
-                   Attribute_Name => Name_Last);
+               if J = N and Result_May_Be_Null then
+                  Last_Opnd_High_Bound :=
+                    Convert_To (Ityp,
+                      Make_Attribute_Reference (Loc,
+                        Prefix         =>
+                          Duplicate_Subexpr (Opnd, Name_Req => True),
+                        Attribute_Name => Name_Last));
+               end if;
 
                --  Capture length of operand in entity
 
@@ -2593,14 +2613,10 @@ package body Exp_Ch4 is
          J := J + 1;
       end loop;
 
-      --  If we have only skipped null operands, return a null string literal.
-      --  Note that this means the lower bound is 1 and the type is string,
-      --  since we retained any null operands with a type other than string,
-      --  or a lower bound other than one, so this is a legitimate assumption.
+      --  If we have only skipped null operands, return the last operand
 
       if NN = 0 then
-         Start_String;
-         Result := Make_String_Literal (Loc, Strval => End_String);
+         Result := Opnd;
          goto Done;
       end if;
 
@@ -2703,10 +2719,7 @@ package body Exp_Ch4 is
          end;
       end if;
 
-      --  Now find the upper bound. This is normally the Low_Bound + Length - 1
-      --  but there is one exception, namely when the result is null in which
-      --  case the bounds come from the last operand (so that we get the proper
-      --  bounds if the last operand is super-flat).
+      --  Now find the upper bound, normally this is Low_Bound + Length - 1
 
       High_Bound :=
         To_Ityp (
@@ -2717,6 +2730,10 @@ package body Exp_Ch4 is
                 Left_Opnd  => New_Copy (Aggr_Length (NN)),
                 Right_Opnd => Make_Integer_Literal (Loc, 1))));
 
+      --  But there is one exception, namely when the result is null in which
+      --  case the bounds come from the last operand (so that we get the proper
+      --  bounds if the last operand is super-flat).
+
       if Result_May_Be_Null then
          High_Bound :=
            Make_Conditional_Expression (Loc,
@@ -2724,7 +2741,7 @@ package body Exp_Ch4 is
                Make_Op_Eq (Loc,
                  Left_Opnd  => New_Copy (Aggr_Length (NN)),
                  Right_Opnd => Make_Integer_Literal (Loc, 0)),
-               Opnd_High_Bound (NN),
+               Last_Opnd_High_Bound,
                High_Bound));
       end if;
 
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index e447860..8ad0d7e 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -50,6 +50,8 @@ with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
 
 package body Prj.Nmsc is
 
+   type Source_Data_Access is access Source_Data;
+
    No_Continuation_String : aliased String := "";
    Continuation_String    : aliased String := "\";
    --  Used in Check_Library for continuation error messages at the same
@@ -796,7 +798,7 @@ package body Prj.Nmsc is
             declare
                Language      : Language_Index;
                Source        : Source_Id;
-               Src_Data      : Source_Data;
+               Src_Data      : Source_Data_Access;
                Alt_Lang      : Alternate_Language_Id;
                Alt_Lang_Data : Alternate_Language_Data;
                Continuation  : Boolean := False;
@@ -806,7 +808,8 @@ package body Prj.Nmsc is
                while Language /= No_Language_Index loop
                   Source := Data.First_Source;
                   Source_Loop : while Source /= No_Source loop
-                     Src_Data := In_Tree.Sources.Table (Source);
+                     Src_Data :=
+                       In_Tree.Sources.Table (Source)'Unrestricted_Access;
 
                      exit Source_Loop when Src_Data.Language = Language;
 
@@ -2494,7 +2497,7 @@ package body Prj.Nmsc is
       Name    : File_Name_Type;
 
       Source   : Source_Id;
-      Src_Data : Source_Data;
+      Src_Data : Source_Data_Access;
 
       Project_2 : Project_Id;
       Data_2     : Project_Data;
@@ -2510,9 +2513,8 @@ package body Prj.Nmsc is
          loop
             Source := Data_2.First_Source;
             while Source /= No_Source loop
-               Src_Data := In_Tree.Sources.Table (Source);
+               Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access;
                Src_Data.In_Interfaces := False;
-               In_Tree.Sources.Table (Source) := Src_Data;
                Source := Src_Data.Next_In_Project;
             end loop;
 
@@ -2536,12 +2538,12 @@ package body Prj.Nmsc is
             loop
                Source := Data_2.First_Source;
                while Source /= No_Source loop
-                  Src_Data := In_Tree.Sources.Table (Source);
+                  Src_Data :=
+                    In_Tree.Sources.Table (Source)'Unrestricted_Access;
                   if Src_Data.File = Name then
                      if not Src_Data.Locally_Removed then
-                        In_Tree.Sources.Table (Source).In_Interfaces := True;
-                        In_Tree.Sources.Table
-                          (Source).Declared_In_Interfaces := True;
+                        Src_Data.In_Interfaces := True;
+                        Src_Data.Declared_In_Interfaces := True;
 
                         if Src_Data.Other_Part /= No_Source then
                            In_Tree.Sources.Table
@@ -2594,11 +2596,10 @@ package body Prj.Nmsc is
          if Data.Interfaces_Defined then
             Source := Data.First_Source;
             while Source /= No_Source loop
-               Src_Data := In_Tree.Sources.Table (Source);
+               Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access;
 
                if not Src_Data.Declared_In_Interfaces then
                   Src_Data.In_Interfaces := False;
-                  In_Tree.Sources.Table (Source) := Src_Data;
                end if;
 
                Source := Src_Data.Next_In_Project;
@@ -3529,7 +3530,7 @@ package body Prj.Nmsc is
       procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
          Proj_Data : Project_Data;
          Src_Id    : Source_Id;
-         Src       : Source_Data;
+         Src       : Source_Data_Access;
 
       begin
          if Proj /= No_Project then
@@ -3543,7 +3544,7 @@ package body Prj.Nmsc is
 
                Src_Id := Proj_Data.First_Source;
                while Src_Id /= No_Source loop
-                  Src := In_Tree.Sources.Table (Src_Id);
+                  Src := In_Tree.Sources.Table (Src_Id)'Unrestricted_Access;
 
                   exit when Src.Lang_Kind /= File_Based
                     or else Src.Kind /= Spec;
@@ -6412,8 +6413,6 @@ package body Prj.Nmsc is
    is
       Mains : constant Variable_Value :=
                 Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes, In_Tree);
-      List  : String_List_Id;
-      Elem  : String_Element;
 
    begin
       Data.Mains := Mains.Values;
@@ -6434,24 +6433,6 @@ package body Prj.Nmsc is
            (Project, In_Tree,
             "a library project file cannot have Main specified",
             Mains.Location);
-
-      --  Normal case where Main was specified
-
-      else
-         List := Mains.Values;
-         while List /= Nil_String loop
-            Elem := In_Tree.String_Elements.Table (List);
-
-            if Length_Of_Name (Elem.Value) = 0 then
-               Error_Msg
-                 (Project, In_Tree,
-                  "?a main cannot have an empty name",
-                  Elem.Location);
-               exit;
-            end if;
-
-            List := Elem.Next;
-         end loop;
       end if;
    end Get_Mains;
 
@@ -7385,12 +7366,12 @@ package body Prj.Nmsc is
 
          declare
             Source   : Source_Id;
-            Src_Data : Source_Data;
+            Src_Data : Source_Data_Access;
 
          begin
             Source := Data.First_Source;
             while Source /= No_Source loop
-               Src_Data := In_Tree.Sources.Table (Source);
+               Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access;
 
                if Src_Data.Naming_Exception
                  and then Src_Data.Path = No_Path_Information
@@ -8025,7 +8006,6 @@ package body Prj.Nmsc is
       Other_Part        : Source_Id;
       Add_Src           : Boolean;
       Src_Ind           : Source_File_Index;
-      Src_Data          : Source_Data;
       Unit              : Name_Id;
       Source_To_Replace : Source_Id := No_Source;
       Language_Name         : Name_Id;
@@ -8131,86 +8111,94 @@ package body Prj.Nmsc is
             Source := In_Tree.First_Source;
             Add_Src := True;
             while Source /= No_Source loop
-               Src_Data := In_Tree.Sources.Table (Source);
+               declare
+                  Src_Data : constant Source_Data_Access :=
+                    In_Tree.Sources.Table (Source)'Unrestricted_Access;
+               begin
 
-               if Unit /= No_Name
-                 and then Src_Data.Unit = Unit
-                 and then
-                   ((Src_Data.Kind = Spec and then Kind = Impl)
-                      or else
-                    (Src_Data.Kind = Impl and then Kind = Spec))
-               then
-                  Other_Part := Source;
+                  if Unit /= No_Name
+                    and then Src_Data.Unit = Unit
+                    and then
+                      ((Src_Data.Kind = Spec and then Kind = Impl)
+                       or else
+                         (Src_Data.Kind = Impl and then Kind = Spec))
+                  then
+                     Other_Part := Source;
 
-               elsif (Unit /= No_Name
-                       and then Src_Data.Unit = Unit
-                       and then
-                         (Src_Data.Kind = Kind
+                  elsif (Unit /= No_Name
+                         and then Src_Data.Unit = Unit
+                         and then
+                           (Src_Data.Kind = Kind
                             or else
-                         (Src_Data.Kind = Sep and then Kind = Impl)
+                              (Src_Data.Kind = Sep and then Kind = Impl)
                             or else
-                         (Src_Data.Kind = Impl and then Kind = Sep)))
-                 or else (Unit = No_Name and then Src_Data.File = File_Name)
-               then
-                  --  Duplication of file/unit in same project is only
-                  --  allowed if order of source directories is known.
+                              (Src_Data.Kind = Impl and then Kind = Sep)))
+                    or else
+                      (Unit = No_Name and then Src_Data.File = File_Name)
+                  then
+                     --  Duplication of file/unit in same project is only
+                     --  allowed if order of source directories is known.
 
-                  if Project = Src_Data.Project then
-                     if Data.Known_Order_Of_Source_Dirs then
-                        Add_Src := False;
+                     if Project = Src_Data.Project then
+                        if Data.Known_Order_Of_Source_Dirs then
+                           Add_Src := False;
 
-                     elsif Unit /= No_Name then
-                        Error_Msg_Name_1 := Unit;
-                        Error_Msg
-                          (Project, In_Tree, "duplicate unit %%", No_Location);
-                        Add_Src := False;
+                        elsif Unit /= No_Name then
+                           Error_Msg_Name_1 := Unit;
+                           Error_Msg
+                             (Project, In_Tree, "duplicate unit %%",
+                              No_Location);
+                           Add_Src := False;
 
-                     else
-                        Error_Msg_File_1 := File_Name;
-                        Error_Msg
-                          (Project, In_Tree, "duplicate source file name {",
-                           No_Location);
-                        Add_Src := False;
-                     end if;
+                        else
+                           Error_Msg_File_1 := File_Name;
+                           Error_Msg
+                             (Project, In_Tree, "duplicate source file name {",
+                              No_Location);
+                           Add_Src := False;
+                        end if;
 
-                     --  Do not allow the same unit name in different
-                     --  projects, except if one is extending the other.
+                        --  Do not allow the same unit name in different
+                        --  projects, except if one is extending the other.
 
-                     --  For a file based language, the same file name
-                     --  replaces a file in a project being extended, but
-                     --  it is allowed to have the same file name in
-                     --  unrelated projects.
+                        --  For a file based language, the same file name
+                        --  replaces a file in a project being extended, but
+                        --  it is allowed to have the same file name in
+                        --  unrelated projects.
 
-                  elsif Is_Extending
-                    (Project, Src_Data.Project, In_Tree)
-                  then
-                     Source_To_Replace := Source;
+                     elsif Is_Extending
+                       (Project, Src_Data.Project, In_Tree)
+                     then
+                        Source_To_Replace := Source;
 
-                  elsif Unit /= No_Name
-                    and then not Src_Data.Locally_Removed
-                  then
-                     Error_Msg_Name_1 := Unit;
-                     Error_Msg
-                       (Project, In_Tree,
-                        "unit %% cannot belong to several projects",
-                        No_Location);
+                     elsif Unit /= No_Name
+                       and then not Src_Data.Locally_Removed
+                     then
+                        Error_Msg_Name_1 := Unit;
+                        Error_Msg
+                          (Project, In_Tree,
+                           "unit %% cannot belong to several projects",
+                           No_Location);
 
-                     Error_Msg_Name_1 := In_Tree.Projects.Table (Project).Name;
-                     Error_Msg_Name_2 := Name_Id (Display_Path_Id);
-                     Error_Msg
-                       (Project, In_Tree, "\  project %%, %%", No_Location);
+                        Error_Msg_Name_1 :=
+                          In_Tree.Projects.Table (Project).Name;
+                        Error_Msg_Name_2 := Name_Id (Display_Path_Id);
+                        Error_Msg
+                          (Project, In_Tree, "\  project %%, %%", No_Location);
 
-                     Error_Msg_Name_1 :=
-                       In_Tree.Projects.Table (Src_Data.Project).Name;
-                     Error_Msg_Name_2 := Name_Id (Src_Data.Path.Display_Name);
-                     Error_Msg
-                       (Project, In_Tree, "\  project %%, %%", No_Location);
+                        Error_Msg_Name_1 :=
+                          In_Tree.Projects.Table (Src_Data.Project).Name;
+                        Error_Msg_Name_2 :=
+                          Name_Id (Src_Data.Path.Display_Name);
+                        Error_Msg
+                          (Project, In_Tree, "\  project %%, %%", No_Location);
 
-                     Add_Src := False;
+                        Add_Src := False;
+                     end if;
                   end if;
-               end if;
 
-               Source := Src_Data.Next_In_Sources;
+                  Source := Src_Data.Next_In_Sources;
+               end;
             end loop;
 
             if Add_Src then
@@ -8449,7 +8437,7 @@ package body Prj.Nmsc is
 
       procedure Process_Sources_In_Multi_Language_Mode is
          Source   : Source_Id;
-         Src_Data : Source_Data;
+         Src_Data : Source_Data_Access;
          Name_Loc : Name_Location;
          OK       : Boolean;
          FF       : File_Found;
@@ -8461,7 +8449,7 @@ package body Prj.Nmsc is
 
          Source := Data.First_Source;
          while Source /= No_Source loop
-            Src_Data := In_Tree.Sources.Table (Source);
+            Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access;
 
             --  A file that is excluded cannot also be an exception file name
 
@@ -8525,7 +8513,7 @@ package body Prj.Nmsc is
             Source := In_Tree.First_Source;
 
             while Source /= No_Source loop
-               Src_Data := In_Tree.Sources.Table (Source);
+               Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access;
 
                if Src_Data.File = FF.File then
 
@@ -8537,7 +8525,6 @@ package body Prj.Nmsc is
                   then
                      Src_Data.Locally_Removed := True;
                      Src_Data.In_Interfaces := False;
-                     In_Tree.Sources.Table (Source) := Src_Data;
                      Add_Forbidden_File_Name (FF.File);
                      OK := True;
                      exit;
@@ -8560,7 +8547,7 @@ package body Prj.Nmsc is
 
          Check_Object_File_Names : declare
             Src_Id      : Source_Id;
-            Src_Data    : Source_Data;
+            Src_Data    : Source_Data_Access;
             Source_Name : File_Name_Type;
 
             procedure Check_Object;
@@ -8596,7 +8583,7 @@ package body Prj.Nmsc is
             Object_File_Names.Reset;
             Src_Id := In_Tree.First_Source;
             while Src_Id /= No_Source loop
-               Src_Data := In_Tree.Sources.Table (Src_Id);
+               Src_Data := In_Tree.Sources.Table (Src_Id)'Unrestricted_Access;
 
                if Src_Data.Compiled and then Src_Data.Object_Exists
                  and then Project_Extends (Project, Src_Data.Project, In_Tree)