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

	* g-socket.adb: Minor reformatting.

	* g-socthi-mingw.adb: Minor reformatting

	* g-sothco.ads: Minor reformatting

	* exp_ch4.adb:
	(Expand_Concatenate_String): Complete rewrite to generate efficient code
	inline instead of relying on external library routines.

	* s-strops.ads, s-sopco5.ads, s-sopco5.adb, s-sopco4.ads, s-sopco4.adb,
	s-sopco3.ads, s-sopco3.adb, s-strops.adb: Note that this unit is now
	obsolescent

2009-04-07  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb:
	(Eval_Attribute): for attributes of array objects that are not strings,
	attributes are not static if nominal subtype of object is unconstrained.

2009-04-07  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (New_Overloaded_Entity): If two implicit homonym
	operations for a type T in an instance do not override each other,
	when T is derived from a formal private type, the corresponding
	operations inherited by a type derived from T outside
	of the instance do not override each other either.



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

15 files changed, 538 insertions, 152 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7d168c87aac..7404808ded2 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,35 @@
 2009-04-07  Robert Dewar  <dewar@adacore.com>
 
+	* g-socket.adb: Minor reformatting.
+
+	* g-socthi-mingw.adb: Minor reformatting
+
+	* g-sothco.ads: Minor reformatting
+
+	* exp_ch4.adb:
+	(Expand_Concatenate_String): Complete rewrite to generate efficient code
+	inline instead of relying on external library routines.
+
+	* s-strops.ads, s-sopco5.ads, s-sopco5.adb, s-sopco4.ads, s-sopco4.adb,
+	s-sopco3.ads, s-sopco3.adb, s-strops.adb: Note that this unit is now
+	obsolescent
+
+2009-04-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_attr.adb:
+	(Eval_Attribute): for attributes of array objects that are not strings,
+	attributes are not static if nominal subtype of object is unconstrained.
+
+2009-04-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (New_Overloaded_Entity): If two implicit homonym
+	operations for a type T in an instance do not override each other,
+	when T is derived from a formal private type, the corresponding
+	operations inherited by a type derived from T outside
+	of the instance do not override each other either.
+
+2009-04-07  Robert Dewar  <dewar@adacore.com>
+
 	(Osint.Fail): Change calling sequence to have one string arg
 	(Make.Make_Failed): Same change
 	All callers are adjusted to use concatenation
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index e511e97e2e8..080a1af7b3f 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -62,6 +62,7 @@ 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;
@@ -145,11 +146,9 @@ package body Exp_Ch4 is
    --  singleton operands into singleton aggregates.
 
    procedure Expand_Concatenate_String (Cnode : Node_Id; Opnds : List_Id);
-   --  Routine to expand concatenation of 2-5 operands (in the list Operands)
-   --  and replace node Cnode with the result of the concatenation. If there
-   --  are two operands, they can be string or character. If there are more
-   --  than two operands, then are always of type string (i.e. the caller has
-   --  already converted character operands to strings in this case).
+   --  Routine to expand concatenation a sequence of two or more operands (in
+   --  the list Operands) and replace node Cnode with the result of the
+   --  concatenation. The operands can be of type String or Character.
 
    procedure Fixup_Universal_Fixed_Operation (N : Node_Id);
    --  N is a N_Op_Divide or N_Op_Multiply node whose result is universal
@@ -2761,74 +2760,440 @@ package body Exp_Ch4 is
    -------------------------------
 
    procedure Expand_Concatenate_String (Cnode : Node_Id; Opnds : List_Id) is
-      Loc   : constant Source_Ptr := Sloc (Cnode);
-      Opnd1 : constant Node_Id    := First (Opnds);
-      Opnd2 : constant Node_Id    := Next (Opnd1);
-      Typ1  : constant Entity_Id  := Base_Type (Etype (Opnd1));
-      Typ2  : constant Entity_Id  := Base_Type (Etype (Opnd2));
+      Loc : constant Source_Ptr := Sloc (Cnode);
 
-      R : RE_Id;
-      --  RE_Id value for function to be called
+      N : constant Nat := List_Length (Opnds);
+      --  Number of concatenation operands including nulls
+
+      NN : Nat := 0;
+      --  Number of operands excluding any known to be null
+
+      --  Arrays describing the operands, only the first NN entries of each
+      --  array are set (NN < N when we exclude known null operands).
+
+      Is_Fixed_Length : array (1 .. N) of Boolean;
+      --  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
+
+      Fixed_Length : array (1 .. N) of Uint;
+      --  Set to length of operand. Entries in this array are set only if
+      --  the corresponding entry in Is_Fixed_Length is True. Note that the
+      --  values in this array are always greater than zero, since we exclude
+      --  any
+
+      Fixed_Low_Bound : array (1 .. N) of Uint;
+      --  Set to lower bound of operand. Entries in this array are set only
+      --  if the corresponding entry in Is_Fixed_Length are True.
+
+      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
+      --  array are set only if the corresponding entry in Is_Fixed_Length
+      --  is False.
+
+      Aggr_Length : array (0 .. N) of Node_Id;
+      --  The J'th entry in an expression node that represents the total
+      --  length of operands 1 through J. It is either an integer literal
+      --  node, or a reference to a constant entity with the right value,
+      --  so it is fine to just do a Copy_Node to get an appropriate copy.
+      --  The extra zero'th entry always is set to zero.
+
+      Low_Bound : Node_Id;
+      --  An tree node representing the low bound of the result. This is either
+      --  an integer literal node, or an identifier reference to a constant
+      --  entity initialized to the appropriate value.
+
+      Result : Node_Id;
+      --  Result of the concatenation
+
+      Opnd : Node_Id;
+      Ent  : Entity_Id;
+      Len  : Uint;
+      J    : Nat;
+      Clen : Node_Id;
+      Set  : Boolean;
 
    begin
-      --  In all cases, we build a call to a routine giving the list of
-      --  arguments as the parameter list to the routine.
+      Aggr_Length (0) := Make_Integer_Literal (Loc, 0);
 
-      case List_Length (Opnds) is
-         when 2 =>
-            if Typ1 = Standard_Character then
-               if Typ2 = Standard_Character then
-                  R := RE_Str_Concat_CC;
+      --  Go through operands settinn up the above arrays
 
-               else
-                  pragma Assert (Typ2 = Standard_String);
-                  R := RE_Str_Concat_CS;
+      J := 1;
+      while J <= N loop
+         Opnd := Remove_Head (Opnds);
+         Set_Parent (Opnd, Parent (Cnode));
+         Set := False;
+
+         --  Character or Character literal case
+
+         if Base_Type (Etype (Opnd)) = Standard_Character then
+            NN := NN + 1;
+            Operands (NN) := Opnd;
+            Is_Fixed_Length (NN) := True;
+            Fixed_Length (NN) := Uint_1;
+            Fixed_Low_Bound (NN) := Uint_1;
+            Set := True;
+
+         --  String literal case
+
+         elsif Nkind (Opnd) = N_String_Literal then
+            Len := UI_From_Int (String_Length (Strval (Opnd)));
+
+            if Len = 0 then
+               goto Continue;
+            end if;
+
+            NN := NN + 1;
+            Operands (NN) := Opnd;
+            Is_Fixed_Length (NN) := True;
+            Fixed_Length (NN) := Len;
+            Fixed_Low_Bound (NN) := Uint_1;
+            Set := True;
+
+         --  All other cases
+
+         else
+            --  Check constrained case with known bounds
+
+            if Is_Constrained (Etype (Opnd)) then
+               declare
+                  Opnd_Typ : constant Entity_Id := Etype (Opnd);
+                  Index    : constant Node_Id   := First_Index (Opnd_Typ);
+                  Indx_Typ : constant Entity_Id := Etype (Index);
+                  Lo       : constant Node_Id   := Type_Low_Bound  (Indx_Typ);
+                  Hi       : constant Node_Id   := Type_High_Bound (Indx_Typ);
+
+               begin
+                  --  Fixed length constrained string type with known at
+                  --  compile time bounds is last case of fixed length
+
+                  if Compile_Time_Known_Value (Lo)
+                       and then
+                     Compile_Time_Known_Value (Hi)
+                  then
+                     declare
+                        Loval : constant Uint := Expr_Value (Lo);
+                        Hival : constant Uint := Expr_Value (Hi);
+                        Len   : constant Uint :=
+                                  UI_Max (Hival - Loval + 1, Uint_0);
+
+                     begin
+                        --  Exclude the null length case where the lower bound
+                        --  is other than 1 because annoyingly we need to keep
+                        --  such an operand around in case it is the one that
+                        --  supplies a lower bound to the result.
+
+                        if Loval = 1 or Len > 0 then
+
+                           --  Skip null case (we know that low bound is 1)
+
+                           if Len = 0 then
+                              goto Continue;
+                           end if;
+
+                           NN := NN + 1;
+                           Operands (NN) := Opnd;
+                           Is_Fixed_Length (NN) := True;
+                           Fixed_Length (NN)    := Len;
+                           Fixed_Low_Bound (NN) := Expr_Value (Lo);
+                           Set := True;
+                        end if;
+                     end;
+                  end if;
+               end;
+            end if;
+
+            --  All cases where the length is not known at compile time, or the
+            --  special case of an operand which is known to be null but has a
+            --  lower bound other than 1. Capture length of operand in entity.
+            --  separate entities
+
+            if not Set then
+               NN := NN + 1;
+               Operands (NN) := Opnd;
+               Is_Fixed_Length (NN) := False;
+
+               Var_Length (NN) :=
+                 Make_Defining_Identifier (Loc,
+                   Chars => New_Internal_Name ('L'));
+
+               Insert_Action (Cnode,
+                 Make_Object_Declaration (Loc,
+                   Defining_Identifier => Var_Length (NN),
+                   Constant_Present    => True,
+
+                   Object_Definition   =>
+                     New_Occurrence_Of (Standard_Natural, Loc),
+
+                   Expression          =>
+                     Make_Attribute_Reference (Loc,
+                       Prefix         =>
+                         Duplicate_Subexpr (Opnd, Name_Req => True),
+                       Attribute_Name => Name_Length)),
+
+                 Suppress => All_Checks);
+            end if;
+         end if;
+
+         --  Set next entry in aggregate length array
+
+         --  For first entry, make either integer literal for fixed length
+         --  or a reference to the saved length for variable length
+
+         if NN = 1 then
+            if Is_Fixed_Length (1) then
+               Aggr_Length (1) :=
+                 Make_Integer_Literal (Loc,
+                   Intval => Fixed_Length (1));
+            else
+               Aggr_Length (1) :=
+                 New_Reference_To (Var_Length (1), Loc);
+            end if;
+
+         --  If entry is fixed length and only fixed lengths so far, make
+         --  appropriate new integer literal adding new length.
+
+         elsif Is_Fixed_Length (NN)
+           and then Nkind (Aggr_Length (NN - 1)) = N_Integer_Literal
+         then
+            Aggr_Length (NN) :=
+              Make_Integer_Literal (Loc,
+                Intval => Fixed_Length (NN) + Intval (Aggr_Length (NN - 1)));
+
+            --  All other cases, construct an addition node for the length and
+            --  create an entity initialized to this length.
+
+         else
+            Ent :=
+              Make_Defining_Identifier (Loc,
+                Chars => New_Internal_Name ('L'));
+
+            if Is_Fixed_Length (NN) then
+               Clen := Make_Integer_Literal (Loc, Fixed_Length (NN));
+            else
+               Clen := New_Reference_To (Var_Length (NN), Loc);
+            end if;
+
+            Insert_Action (Cnode,
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Ent,
+                Constant_Present    => True,
+
+                Object_Definition   =>
+                  New_Occurrence_Of (Standard_Natural, Loc),
+
+                Expression          =>
+                  Make_Op_Add (Loc,
+                    Left_Opnd  => New_Copy (Aggr_Length (NN - 1)),
+                    Right_Opnd => Clen)),
+
+              Suppress => All_Checks);
+
+            Aggr_Length (NN) :=
+              Make_Identifier (Loc,
+                Chars => Chars (Ent));
+         end if;
+
+      <<Continue>>
+         J := J + 1;
+      end loop;
+
+      --  If we have only null operands, return a null string literal. Note
+      --  that this means the lower bound is 1, but we retained any known null
+      --  operands whose lower bound was not 1, so this is legitimate.
+
+      if NN = 0 then
+         Start_String;
+         Result :=
+           Make_String_Literal (Loc,
+             Strval => End_String);
+         goto Done;
+      end if;
+
+      --  If we have only one non-null operand, return it and we are done.
+      --  There is one case in which this cannot be done, and that is when
+      --  the sole operand is of a character type, in which case it must be
+      --  converted to a string, and the easiest way of doing that is to go
+      --  through the normal general circuit.
+
+      if NN = 1
+        and then Base_Type (Etype (Operands (1))) /= Standard_Character
+      then
+         Result := Operands (1);
+         goto Done;
+      end if;
+
+      --  Cases where we have a real concatenation
+
+      --  Next step is to find the low bound for the result string that we
+      --  will allocate. Annoyingly this is not simply the low bound of the
+      --  first argument, because of the darned null string special exception.
+
+      --  If the first operand in the list has known length we know that
+      --  the lower bound of the result is the lower bound of this operand.
+
+      if Is_Fixed_Length (1) then
+         Low_Bound :=
+           Make_Integer_Literal (Loc,
+             Intval => Fixed_Low_Bound (1));
+
+      --  OK, we don't know the lower bound, we have to build a horrible
+      --  expression actions node of the form
+
+      --     if Cond1'Length /= 0 then
+      --        Opnd1'First
+      --     else
+      --        if Opnd2'Length /= 0 then
+      --          Opnd2'First
+      --        else
+      --           ...
+
+      --  The nesting ends either when we hit an operand whose length is known
+      --  at compile time, or on reaching the last operand, whose low bound we
+      --  take unconditionally whether or not it is null. It's easiest to do
+      --  this with a recursive procedure:
+
+      else
+         declare
+            function Get_Known_Bound (J : Nat) return Node_Id;
+            --  Returns the lower bound determined by operands J .. NN
+
+            ---------------------
+            -- Get_Known_Bound --
+            ---------------------
+
+            function Get_Known_Bound (J : Nat) return Node_Id is
+               Lo : Node_Id;
+
+            begin
+               if Is_Fixed_Length (J) then
+                  return
+                    Make_Integer_Literal (Loc,
+                      Intval => Fixed_Low_Bound (J));
                end if;
 
-            elsif Typ1 = Standard_String then
-               if Typ2 = Standard_Character then
-                  R := RE_Str_Concat_SC;
+               Lo :=
+                 Make_Attribute_Reference (Loc,
+                   Prefix =>
+                     Duplicate_Subexpr (Operands (J), Name_Req => True),
+                   Attribute_Name => Name_First);
+
+               if J = NN then
+                  return Lo;
 
                else
-                  pragma Assert (Typ2 = Standard_String);
-                  R := RE_Str_Concat;
+                  return
+                    Make_Conditional_Expression (Loc,
+                      Expressions => New_List (
+
+                        Make_Op_Ne (Loc,
+                          Left_Opnd  => New_Reference_To (Var_Length (J), Loc),
+                          Right_Opnd => Make_Integer_Literal (Loc, 0)),
+
+                        Lo,
+                        Get_Known_Bound (J + 1)));
                end if;
+            end Get_Known_Bound;
 
-            --  If we have anything other than Standard_Character or
-            --  Standard_String, then we must have had a serious error
-            --  earlier, so we just abandon the attempt at expansion.
+         begin
+            Ent :=
+              Make_Defining_Identifier (Loc,
+                Chars => New_Internal_Name ('L'));
 
-            else
-               pragma Assert (Serious_Errors_Detected > 0);
-               return;
-            end if;
+            Insert_Action (Cnode,
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Ent,
+                Constant_Present    => True,
+                Object_Definition   =>
+                  New_Occurrence_Of (Standard_Natural, Loc),
+                Expression          => Get_Known_Bound (1)),
+              Suppress => All_Checks);
+
+            Low_Bound := New_Reference_To (Ent, Loc);
+         end;
+      end if;
 
-         when 3 =>
-            R := RE_Str_Concat_3;
+      --  Now we build the result, which is a reference to the string entity
+      --  we will construct with appropriate bounds.
 
-         when 4 =>
-            R := RE_Str_Concat_4;
+      Ent :=
+        Make_Defining_Identifier (Loc,
+          Chars => New_Internal_Name ('S'));
 
-         when 5 =>
-            R := RE_Str_Concat_5;
+      Insert_Action (Cnode,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Ent,
 
-         when others =>
-            R := RE_Null;
-            raise Program_Error;
-      end case;
+          Object_Definition   =>
+            Make_Subtype_Indication (Loc,
+              Subtype_Mark => New_Occurrence_Of (Standard_String, Loc),
+              Constraint   =>
+                Make_Index_Or_Discriminant_Constraint (Loc,
+                  Constraints => New_List (
+                    Make_Range (Loc,
+                      Low_Bound => New_Copy (Low_Bound),
+                      High_Bound =>
+                        Make_Op_Add (Loc,
+                          Left_Opnd  => New_Copy (Low_Bound),
+                          Right_Opnd =>
+                            Make_Op_Subtract (Loc,
+                              Left_Opnd  => New_Copy (Aggr_Length (NN)),
+                              Right_Opnd =>
+                                Make_Integer_Literal (Loc, 1)))))))),
+
+        Suppress => All_Checks);
+
+      --  Now we will generate the assignments to do the actual concatenation
+
+      for J in 1 .. NN loop
+         declare
+            Lo : constant Node_Id :=
+                   Make_Op_Add (Loc,
+                     Left_Opnd  => New_Copy (Low_Bound),
+                     Right_Opnd => Aggr_Length (J - 1));
+
+            Hi : constant Node_Id :=
+                   Make_Op_Add (Loc,
+                     Left_Opnd  => New_Copy (Low_Bound),
+                     Right_Opnd =>
+                       Make_Op_Subtract (Loc,
+                         Left_Opnd  => Aggr_Length (J),
+                         Right_Opnd => Make_Integer_Literal (Loc, 1)));
 
-      --  Now generate the appropriate call
+         begin
+            if Base_Type (Etype (Operands (J))) = Standard_Character then
+               Insert_Action (Cnode,
+                 Make_Assignment_Statement (Loc,
+                   Name       =>
+                     Make_Indexed_Component (Loc,
+                       Prefix      => New_Occurrence_Of (Ent, Loc),
+                       Expressions => New_List (Lo)),
+                   Expression => Operands (J)),
+                 Suppress => All_Checks);
 
-      Rewrite (Cnode,
-        Make_Function_Call (Sloc (Cnode),
-          Name => New_Occurrence_Of (RTE (R), Loc),
-          Parameter_Associations => Opnds));
+            else
+               Insert_Action (Cnode,
+                 Make_Assignment_Statement (Loc,
+                   Name       =>
+                     Make_Slice (Loc,
+                       Prefix         => New_Occurrence_Of (Ent, Loc),
+                       Discrete_Range =>
+                         Make_Range (Loc,
+                           Low_Bound  => Lo,
+                           High_Bound => Hi)),
+                   Expression => Operands (J)),
+                 Suppress => All_Checks);
+            end if;
+         end;
+      end loop;
 
-      Analyze_And_Resolve (Cnode, Standard_String);
+      Result := New_Reference_To (Ent, Loc);
 
-   exception
-      when RE_Not_Available =>
-         return;
+   <<Done>>
+      Rewrite (Cnode, Result);
+      Analyze_And_Resolve (Cnode, Standard_String);
    end Expand_Concatenate_String;
 
    ------------------------
@@ -4540,21 +4905,6 @@ package body Exp_Ch4 is
    -- Expand_N_Op_Concat --
    ------------------------
 
-   Max_Available_String_Operands : Int := -1;
-   --  This is initialized the first time this routine is called. It records
-   --  a value of 0,2,3,4,5 depending on what Str_Concat_n procedures are
-   --  available in the run-time:
-   --
-   --    0  None available
-   --    2  RE_Str_Concat available, RE_Str_Concat_3 not available
-   --    3  RE_Str_Concat/Concat_3 available, RE_Str_Concat_4 not available
-   --    4  RE_Str_Concat/Concat_3/4 available, RE_Str_Concat_5 not available
-   --    5  All routines including RE_Str_Concat_5 available
-
-   Char_Concat_Available : Boolean;
-   --  Records if the routines RE_Str_Concat_CC/CS/SC are available. True if
-   --  all three are available, False if any one of these is unavailable.
-
    procedure Expand_N_Op_Concat (N : Node_Id) is
       Opnds : List_Id;
       --  List of operands to be concatenated
@@ -4573,37 +4923,6 @@ package body Exp_Ch4 is
       --  Component type of concatenation represented by Cnode
 
    begin
-      --  Initialize global variables showing run-time status
-
-      if Max_Available_String_Operands < 1 then
-
-         --  See what routines are available and set max operand count
-         --  according to the highest count available in the run-time.
-
-         if not RTE_Available (RE_Str_Concat) then
-            Max_Available_String_Operands := 0;
-
-         elsif not RTE_Available (RE_Str_Concat_3) then
-            Max_Available_String_Operands := 2;
-
-         elsif not RTE_Available (RE_Str_Concat_4) then
-            Max_Available_String_Operands := 3;
-
-         elsif not RTE_Available (RE_Str_Concat_5) then
-            Max_Available_String_Operands := 4;
-
-         else
-            Max_Available_String_Operands := 5;
-         end if;
-
-         Char_Concat_Available :=
-           RTE_Available (RE_Str_Concat_CC)
-             and then
-           RTE_Available (RE_Str_Concat_CS)
-             and then
-           RTE_Available (RE_Str_Concat_SC);
-      end if;
-
       --  Ensure validity of both operands
 
       Binary_Op_Validity_Checks (N);
@@ -4632,29 +4951,16 @@ package body Exp_Ch4 is
       --  nodes above, so now we process bottom up, doing the operations. We
       --  gather a string that is as long as possible up to five operands
 
-      --  The outer loop runs more than once if there are more than five
-      --  concatenations of type Standard.String, the most we handle for
-      --  this case, or if more than one concatenation type is involved.
+      --  The outer loop runs more than once if more than one concatenation
+      --  type is involved.
 
       Outer : loop
          Opnds := New_List (Left_Opnd (Cnode), Right_Opnd (Cnode));
          Set_Parent (Opnds, N);
 
-         --  The inner loop gathers concatenation operands. We gather any
-         --  number of these in the non-string case, or if no concatenation
-         --  routines are available for string (since in that case we will
-         --  treat string like any other non-string case). Otherwise we only
-         --  gather as many operands as can be handled by the available
-         --  procedures in the run-time library (normally 5, but may be
-         --  less for the configurable run-time case).
+         --  The inner loop gathers concatenation operands
 
          Inner : while Cnode /= N
-                   and then (Base_Type (Etype (Cnode)) /= Standard_String
-                               or else
-                             Max_Available_String_Operands = 0
-                               or else
-                             List_Length (Opnds) <
-                                               Max_Available_String_Operands)
                    and then Base_Type (Etype (Cnode)) =
                             Base_Type (Etype (Parent (Cnode)))
          loop
@@ -4662,17 +4968,15 @@ package body Exp_Ch4 is
             Append (Right_Opnd (Cnode), Opnds);
          end loop Inner;
 
-         --  Here we process the collected operands. First we convert singleton
-         --  operands to singleton aggregates. This is skipped however for the
-         --  case of two operands of type String since we have special routines
-         --  for these cases.
+         --  Here we process the collected operands. First convert singleton
+         --  operands to singleton aggregates. This is skipped however for
+         --  the case of operands of type Character/String since the string
+         --  concatenation routine can handle these special cases.
 
          Atyp := Base_Type (Etype (Cnode));
          Ctyp := Base_Type (Component_Type (Etype (Cnode)));
 
-         if (List_Length (Opnds) > 2 or else Atyp /= Standard_String)
-           or else not Char_Concat_Available
-         then
+         if Atyp /= Standard_String then
             Opnd := First (Opnds);
             loop
                if Base_Type (Etype (Opnd)) = Ctyp then
@@ -4689,9 +4993,7 @@ package body Exp_Ch4 is
 
          --  Now call appropriate continuation routine
 
-         if Atyp = Standard_String
-           and then Max_Available_String_Operands > 0
-         then
+         if Atyp = Standard_String then
             Expand_Concatenate_String (Cnode, Opnds);
          else
             Expand_Concatenate_Other (Cnode, Opnds);
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index 0112ed8b84e..d14fae8f44c 100644
--- a/gcc/ada/g-socket.adb
+++ b/gcc/ada/g-socket.adb
@@ -1830,6 +1830,7 @@ package body GNAT.Sockets is
    procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type) is
    begin
       if Item.Last = No_Socket then
+
          --  Uninitialized socket set, make sure it is properly zeroed out
 
          Reset_Socket_Set (Item.Set'Access);
@@ -1838,6 +1839,7 @@ package body GNAT.Sockets is
       elsif Item.Last < Socket then
          Item.Last := Socket;
       end if;
+
       Insert_Socket_In_Set (Item.Set'Access, C.int (Socket));
    end Set;
 
diff --git a/gcc/ada/g-socthi-mingw.adb b/gcc/ada/g-socthi-mingw.adb
index a99c715fb31..a85a2572d8f 100644
--- a/gcc/ada/g-socthi-mingw.adb
+++ b/gcc/ada/g-socthi-mingw.adb
@@ -300,16 +300,16 @@ package body GNAT.Sockets.Thin is
       Last : aliased C.int;
 
    begin
-      --  Asynchronous connection failures are notified in the
-      --  exception fd set instead of the write fd set. To ensure
-      --  POSIX compatibility, copy write fd set into exception fd
-      --  set. Once select() returns, check any socket present in the
-      --  exception fd set and peek at incoming out-of-band data. If
-      --  the test is not successful, and the socket is present in
-      --  the initial write fd set, then move the socket from the
+      --  Asynchronous connection failures are notified in the exception fd set
+      --  instead of the write fd set. To ensure POSIX compatibility, copy
+      --  write fd set into exception fd set. Once select() returns, check any
+      --  socket present in the exception fd set and peek at incoming
+      --  out-of-band data. If the test is not successful, and the socket is
+      --  present in the initial write fd set, then move the socket from the
       --  exception fd set to the write fd set.
 
       if Writefds /= No_Fd_Set_Access then
+
          --  Add any socket present in write fd set into exception fd set
 
          declare
diff --git a/gcc/ada/g-sothco.ads b/gcc/ada/g-sothco.ads
index fc8304757c6..cb0bc09b86f 100644
--- a/gcc/ada/g-sothco.ads
+++ b/gcc/ada/g-sothco.ads
@@ -122,7 +122,7 @@ package GNAT.Sockets.Thin_Common is
       Sa_Family : Sockaddr_Length_And_Family;
       --  Address family (and address length on some platforms)
 
-      Sa_Data   : C.char_array (1 .. 14) := (others => C.nul);
+      Sa_Data : C.char_array (1 .. 14) := (others => C.nul);
       --  Family-specific data
       --  Note that some platforms require that all unused (reserved) bytes
       --  in addresses be initialized to 0 (e.g. VxWorks).
@@ -169,14 +169,15 @@ package GNAT.Sockets.Thin_Common is
       Sin_Family : Sockaddr_Length_And_Family;
       --  Address family (and address length on some platforms)
 
-      Sin_Port   : C.unsigned_short;
+      Sin_Port : C.unsigned_short;
       --  Port in network byte order
 
-      Sin_Addr   : In_Addr;
+      Sin_Addr : In_Addr;
       --  IPv4 address
 
-      Sin_Zero   : C.char_array (1 .. 8) := (others => C.nul);
+      Sin_Zero : C.char_array (1 .. 8) := (others => C.nul);
       --  Padding
+      --
       --  Note that some platforms require that all unused (reserved) bytes
       --  in addresses be initialized to 0 (e.g. VxWorks).
    end record;
@@ -272,8 +273,8 @@ package GNAT.Sockets.Thin_Common is
    --  value if it is, zero if it is not.
 
    procedure Last_Socket_In_Set
-     (Set    : access Fd_Set;
-      Last   : Int_Access);
+     (Set  : access Fd_Set;
+      Last : Int_Access);
    --  Find the largest socket in the socket set. This is needed for select().
    --  When Last_Socket_In_Set is called, parameter Last is a maximum value of
    --  the largest socket. This hint is used to avoid scanning very large
diff --git a/gcc/ada/s-sopco3.adb b/gcc/ada/s-sopco3.adb
index 6637b082de1..da427cb5bcc 100644
--- a/gcc/ada/s-sopco3.adb
+++ b/gcc/ada/s-sopco3.adb
@@ -31,6 +31,10 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+--  NOTE: This package is obsolescent. It is no longer used by the compiler
+--  which now generates concatenation inline. It is retained only because
+--  it may be used during bootstrapping using old versions of the compiler.
+
 pragma Warnings (Off);
 pragma Compiler_Unit;
 pragma Warnings (On);
diff --git a/gcc/ada/s-sopco3.ads b/gcc/ada/s-sopco3.ads
index 1698b14acec..6bff28f3940 100644
--- a/gcc/ada/s-sopco3.ads
+++ b/gcc/ada/s-sopco3.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -33,6 +33,10 @@
 
 --  This package contains the function for concatenating three strings
 
+--  NOTE: This package is obsolescent. It is no longer used by the compiler
+--  which now generates concatenation inline. It is retained only because
+--  it may be used during bootstrapping using old versions of the compiler.
+
 pragma Warnings (Off);
 pragma Compiler_Unit;
 pragma Warnings (On);
diff --git a/gcc/ada/s-sopco4.adb b/gcc/ada/s-sopco4.adb
index f7751aaae5a..3188e75c6f3 100644
--- a/gcc/ada/s-sopco4.adb
+++ b/gcc/ada/s-sopco4.adb
@@ -31,6 +31,10 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+--  NOTE: This package is obsolescent. It is no longer used by the compiler
+--  which now generates concatenation inline. It is retained only because
+--  it may be used during bootstrapping using old versions of the compiler.
+
 pragma Warnings (Off);
 pragma Compiler_Unit;
 pragma Warnings (On);
diff --git a/gcc/ada/s-sopco4.ads b/gcc/ada/s-sopco4.ads
index e705e5753d3..b08bcadea85 100644
--- a/gcc/ada/s-sopco4.ads
+++ b/gcc/ada/s-sopco4.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -33,6 +33,10 @@
 
 --  This package contains the function for concatenating four strings
 
+--  NOTE: This package is obsolescent. It is no longer used by the compiler
+--  which now generates concatenation inline. It is retained only because
+--  it may be used during bootstrapping using old versions of the compiler.
+
 pragma Warnings (Off);
 pragma Compiler_Unit;
 pragma Warnings (On);
diff --git a/gcc/ada/s-sopco5.adb b/gcc/ada/s-sopco5.adb
index bacae9f7aa0..8ca4cda8443 100644
--- a/gcc/ada/s-sopco5.adb
+++ b/gcc/ada/s-sopco5.adb
@@ -31,6 +31,10 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+--  NOTE: This package is obsolescent. It is no longer used by the compiler
+--  which now generates concatenation inline. It is retained only because
+--  it may be used during bootstrapping using old versions of the compiler.
+
 pragma Warnings (Off);
 pragma Compiler_Unit;
 pragma Warnings (On);
diff --git a/gcc/ada/s-sopco5.ads b/gcc/ada/s-sopco5.ads
index 2613a439a4a..19766311d3f 100644
--- a/gcc/ada/s-sopco5.ads
+++ b/gcc/ada/s-sopco5.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -33,6 +33,10 @@
 
 --  This package contains the function for concatenating five strings
 
+--  NOTE: This package is obsolescent. It is no longer used by the compiler
+--  which now generates concatenation inline. It is retained only because
+--  it may be used during bootstrapping using old versions of the compiler.
+
 pragma Warnings (Off);
 pragma Compiler_Unit;
 pragma Warnings (On);
diff --git a/gcc/ada/s-strops.adb b/gcc/ada/s-strops.adb
index e92c3bb7a6c..1c9b75f0f7e 100644
--- a/gcc/ada/s-strops.adb
+++ b/gcc/ada/s-strops.adb
@@ -31,6 +31,10 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+--  NOTE: This package is obsolescent. It is no longer used by the compiler
+--  which now generates concatenation inline. It is retained only because
+--  it may be used during bootstrapping using old versions of the compiler.
+
 pragma Warnings (Off);
 pragma Compiler_Unit;
 pragma Warnings (On);
diff --git a/gcc/ada/s-strops.ads b/gcc/ada/s-strops.ads
index 5d4191db783..ca8230d03b9 100644
--- a/gcc/ada/s-strops.ads
+++ b/gcc/ada/s-strops.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -34,6 +34,10 @@
 --  This package contains functions for runtime operations on strings
 --  (other than runtime comparison, found in s-strcom.ads).
 
+--  NOTE: This package is obsolescent. It is no longer used by the compiler
+--  which now generates concatenation inline. It is retained only because
+--  it may be used during bootstrapping using old versions of the compiler.
+
 pragma Warnings (Off);
 pragma Compiler_Unit;
 pragma Warnings (On);
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index fd72ba080d5..bab1802ec3a 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -5258,7 +5258,7 @@ package body Sem_Attr is
                if Present (AS) and then Is_Constrained (AS) then
                   P_Entity := AS;
 
-               --  If we have an unconstrained type, cannot fold
+               --  If we have an unconstrained type we cannot fold
 
                else
                   Check_Expressions;
@@ -5517,6 +5517,9 @@ package body Sem_Attr is
          --  an optimization, but it falls out essentially free, so why not.
          --  Again we compute the variable Static for easy reference later
          --  (note that no array attributes are static in Ada 83).
+         --  we also need to set Static properly for subsequent legality checks
+         --  which might otherwise accept non-static constants in contexts
+         --  where they are not legal.
 
          Static := Ada_Version >= Ada_95
                      and then Statically_Denotes_Entity (P);
@@ -5526,6 +5529,16 @@ package body Sem_Attr is
 
          begin
             N := First_Index (P_Type);
+
+            --  The expression is static if the array type is constrained
+            --  by given bounds, and not by an initial expression. Constant
+            --  strings are static in any case.
+
+            if Root_Type (P_Type) /= Standard_String then
+               Static :=
+                 Static and then not Is_Constr_Subt_For_U_Nominal (P_Type);
+            end if;
+
             while Present (N) loop
                Static := Static and then Is_Static_Subtype (Etype (N));
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 764d5245a95..0bc6dcee3df 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -7154,20 +7154,26 @@ package body Sem_Ch6 is
                --  odd case where both are derived operations declared at the
                --  same point, both operations should be declared, and in that
                --  case we bypass the following test and proceed to the next
-               --  part (this can only occur for certain obscure cases
-               --  involving homographs in instances and can't occur for
-               --  dispatching operations ???). Note that the following
-               --  condition is less than clear. For example, it's not at all
-               --  clear why there's a test for E_Entry here. ???
+               --  part. This can only occur for certain obscure cases in
+               --  instances, when an operation on a type derived from a formal
+               --  private type does not override a homograph inherited from
+               --  the actual. In subsequent derivations of such a type, the
+               --  DT positions of these operations remain distinct, if they
+               --  have been set.
 
                if Present (Alias (S))
                  and then (No (Alias (E))
+                            or else Is_Abstract_Subprogram (S)
                             or else Comes_From_Source (E)
-                            or else Is_Dispatching_Operation (E))
-                 and then
-                   (Ekind (E) = E_Entry
-                     or else Ekind (E) /= E_Enumeration_Literal)
+                            or else
+                              (Is_Dispatching_Operation (E)
+                                and then Present (DTC_Entity (Alias (S)))
+                                and then Present (DTC_Entity (Alias (E)))
+                                and then DT_Position (Alias (S))
+                                   = DT_Position (Alias (E))))
+                 and then Ekind (E) /= E_Enumeration_Literal
                then
+
                   --  When an derived operation is overloaded it may be due to
                   --  the fact that the full view of a private extension
                   --  re-inherits. It has to be dealt with.