[multiple changes]

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

	* vms_data.ads: Minor reformatting

	* einfo.ads, einfo.adb (Parent_Subtype): Now allowed on record subtype,
	applies to base type.
	(Parent_Subtype): Now allowed on record subtype, applies to base type
	* exp_ch5.adb (Expand_Assign_Record): Handle Componentwise_Assignment
	for case of fully repped tagged type.
	(Make_Tag_Ctrl_Assignment): Set Componentwise_Assignment and avoid
	tag save/restore for fully repped tagged type case.
	* exp_util.ads, exp_util.adb (Is_Fully_Repped_Tagged_Type): New function
	* fe.h (Is_Fully_Repped_Tagged_Type): New function
	* sem_ch13.adb (Analyze_Recorrd_Representation_Clause): Check for
	overlap of tagged type components with parent type if parent type is
	fully repped.
	* sinfo.ads, sinfo.adb (Componentwise_Assignment): New flag

	* sem_res.adb (Check_No_Direct_Boolean_Operators): Remove handling of
	comparisons.
	(Resolve_Comparison_Operators): Remove No_Direct_Boolean_Operators check
	(Resolve_Equality_Op): Remove No_Direct_Boolean_Operators check

	* gnat_rm.texi: Restriction No_Direct_Boolean_Operators includes only
	logical operators (AND/OR/XOR), not comparison operators.

	* sprint.ads: Minor reformatting

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

	* sem_intr.adb (Check_Intrinsic_Call): For Import_Value and related
	intrinsics, check that argument is a string literal, rather than
	checking for staticness.

From-SVN: r149811

15 files changed, 345 insertions, 120 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b0014db..6283b24 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,39 @@
 2009-07-20  Robert Dewar  <dewar@adacore.com>
 
+	* vms_data.ads: Minor reformatting
+
+	* einfo.ads, einfo.adb (Parent_Subtype): Now allowed on record subtype,
+	applies to base type.
+	(Parent_Subtype): Now allowed on record subtype, applies to base type
+	* exp_ch5.adb (Expand_Assign_Record): Handle Componentwise_Assignment
+	for case of fully repped tagged type.
+	(Make_Tag_Ctrl_Assignment): Set Componentwise_Assignment and avoid
+	tag save/restore for fully repped tagged type case.
+	* exp_util.ads, exp_util.adb (Is_Fully_Repped_Tagged_Type): New function
+	* fe.h (Is_Fully_Repped_Tagged_Type): New function
+	* sem_ch13.adb (Analyze_Recorrd_Representation_Clause): Check for
+	overlap of tagged type components with parent type if parent type is
+	fully repped.
+	* sinfo.ads, sinfo.adb (Componentwise_Assignment): New flag
+
+	* sem_res.adb (Check_No_Direct_Boolean_Operators): Remove handling of
+	comparisons.
+	(Resolve_Comparison_Operators): Remove No_Direct_Boolean_Operators check
+	(Resolve_Equality_Op): Remove No_Direct_Boolean_Operators check
+
+	* gnat_rm.texi: Restriction No_Direct_Boolean_Operators includes only
+	logical operators (AND/OR/XOR), not comparison operators.
+
+	* sprint.ads: Minor reformatting
+
+2009-07-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_intr.adb (Check_Intrinsic_Call): For Import_Value and related
+	intrinsics, check that argument is a string literal, rather than
+	checking for staticness.
+
+2009-07-20  Robert Dewar  <dewar@adacore.com>
+
 	* sem_ch13.adb: Minor reformatting
 
 	* einfo.ads: Minor reformatting
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index f038f23..170f4f0 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -2365,8 +2365,8 @@ package body Einfo is
 
    function Parent_Subtype (Id : E) return E is
    begin
-      pragma Assert (Ekind (Id) = E_Record_Type);
-      return Node19 (Id);
+      pragma Assert (Is_Record_Type (Id));
+      return Node19 (Base_Type (Id));
    end Parent_Subtype;
 
    function Postcondition_Proc (Id : E) return E is
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 5fa7194..150f18d 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3106,9 +3106,10 @@ package Einfo is
 --       used when obtaining the formal kind of a formal parameter (the result
 --       is one of E_[In/Out/In_Out]_Parameter)
 
---    Parent_Subtype (Node19)
---       Present in E_Record_Type. Points to the subtype to use for a field
---       that references the parent record.
+--    Parent_Subtype (Node19) [base type only]
+--       Present in E_Record_Type. Set only for derived tagged types, in which
+--       case it points to the subtype of the parent type. This is the type
+--       that is used as the Etype of the _parent field.
 
 --    Postcondition_Proc (Node8)
 --       Present only in procedure entities, saves the entity of the generated
@@ -5264,7 +5265,7 @@ package Einfo is
    --    Cloned_Subtype                      (Node16)   (subtype case only)
    --    First_Entity                        (Node17)
    --    Corresponding_Concurrent_Type       (Node18)
-   --    Parent_Subtype                      (Node19)
+   --    Parent_Subtype                      (Node19)   (base type only)
    --    Last_Entity                         (Node20)
    --    Discriminant_Constraint             (Elist21)
    --    Corresponding_Remote_Type           (Node22)
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index ddbe19f..29095c8 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -101,7 +101,9 @@ package body Exp_Ch5 is
    --  N is an assignment of a non-tagged record value. This routine handles
    --  the case where the assignment must be made component by component,
    --  either because the target is not byte aligned, or there is a change
-   --  of representation.
+   --  of representation, or when we have a tagged type with a representation
+   --  clause (this last case is required because holes in the tagged type
+   --  might be filled with components from child types).
 
    procedure Expand_Non_Function_Return (N : Node_Id);
    --  Called by Expand_N_Simple_Return_Statement in case we're returning from
@@ -114,11 +116,11 @@ package body Exp_Ch5 is
    --  from a function body this is called by Expand_N_Simple_Return_Statement.
 
    function Make_Tag_Ctrl_Assignment (N : Node_Id) return List_Id;
-   --  Generate the necessary code for controlled and tagged assignment,
-   --  that is to say, finalization of the target before, adjustment of
-   --  the target after and save and restore of the tag and finalization
-   --  pointers which are not 'part of the value' and must not be changed
-   --  upon assignment. N is the original Assignment node.
+   --  Generate the necessary code for controlled and tagged assignment, that
+   --  is to say, finalization of the target before, adjustment of the target
+   --  after and save and restore of the tag and finalization pointers which
+   --  are not 'part of the value' and must not be changed upon assignment. N
+   --  is the original Assignment node.
 
    ------------------------------
    -- Change_Of_Representation --
@@ -1128,13 +1130,10 @@ package body Exp_Ch5 is
    -- Expand_Assign_Record --
    --------------------------
 
-   --  The only processing required is in the change of representation case,
-   --  where we must expand the assignment to a series of field by field
-   --  assignments.
-
    procedure Expand_Assign_Record (N : Node_Id) is
-      Lhs : constant Node_Id := Name (N);
-      Rhs : Node_Id          := Expression (N);
+      Lhs   : constant Node_Id    := Name (N);
+      Rhs   : Node_Id             := Expression (N);
+      L_Typ : constant Entity_Id  := Base_Type (Etype (Lhs));
 
    begin
       --  If change of representation, then extract the real right hand side
@@ -1156,6 +1155,14 @@ package body Exp_Ch5 is
       then
          null;
 
+      --  If we have a tagged type that has a complete record representation
+      --  clause, we must do we must do component-wise assignments, since child
+      --  types may have used gaps for their components, and we might be
+      --  dealing with a view conversion.
+
+      elsif Is_Fully_Repped_Tagged_Type (L_Typ) then
+         null;
+
       --  If neither condition met, then nothing special to do, the back end
       --  can handle assignment of the entire component as a single entity.
 
@@ -1168,7 +1175,6 @@ package body Exp_Ch5 is
       declare
          Loc   : constant Source_Ptr := Sloc (N);
          R_Typ : constant Entity_Id  := Base_Type (Etype (Rhs));
-         L_Typ : constant Entity_Id  := Base_Type (Etype (Lhs));
          Decl  : constant Node_Id    := Declaration_Node (R_Typ);
          RDef  : Node_Id;
          F     : Entity_Id;
@@ -1214,11 +1220,11 @@ package body Exp_Ch5 is
 
          begin
             C := First_Entity (Utyp);
-
             while Present (C) loop
                if Chars (C) = Chars (Comp) then
                   return C;
                end if;
+
                Next_Entity (C);
             end loop;
 
@@ -1247,11 +1253,9 @@ package body Exp_Ch5 is
             Result := Make_Field_Assigns (CI);
 
             if Present (VP) then
-
                V := First_Non_Pragma (Variants (VP));
                Alts := New_List;
                while Present (V) loop
-
                   DCH := New_List;
                   DC := First (Discrete_Choices (V));
                   while Present (DC) loop
@@ -1334,6 +1338,14 @@ package body Exp_Ch5 is
             --  Set Assignment_OK, so discriminants can be assigned
 
             Set_Assignment_OK (Name (A), True);
+
+            if Componentwise_Assignment (N)
+              and then Nkind (Name (A)) = N_Selected_Component
+              and then Chars (Selector_Name (Name (A))) = Name_uParent
+            then
+               Set_Componentwise_Assignment (A);
+            end if;
+
             return A;
          end Make_Field_Assign;
 
@@ -1349,7 +1361,14 @@ package body Exp_Ch5 is
             Item := First (CI);
             Result := New_List;
             while Present (Item) loop
-               if Nkind (Item) = N_Component_Declaration then
+
+               --  Look for components, but exclude _tag field assignment if
+               --  the special Componentwise_Assignment flag is set.
+
+               if Nkind (Item) = N_Component_Declaration
+                 and then not (Is_Tag (Defining_Identifier (Item))
+                                and then Componentwise_Assignment (N))
+               then
                   Append_To
                     (Result, Make_Field_Assign (Defining_Identifier (Item)));
                end if;
@@ -1408,7 +1427,8 @@ package body Exp_Ch5 is
          --  We know the underlying type is a record, but its current view
          --  may be private. We must retrieve the usable record declaration.
 
-         if Nkind (Decl) = N_Private_Type_Declaration
+         if Nkind_In (Decl, N_Private_Type_Declaration,
+                            N_Private_Extension_Declaration)
            and then Present (Full_View (R_Typ))
          then
             RDef := Type_Definition (Declaration_Node (Full_View (R_Typ)));
@@ -1416,10 +1436,13 @@ package body Exp_Ch5 is
             RDef := Type_Definition (Decl);
          end if;
 
+         if Nkind (RDef) = N_Derived_Type_Definition then
+            RDef := Record_Extension_Part (RDef);
+         end if;
+
          if Nkind (RDef) = N_Record_Definition
            and then Present (Component_List (RDef))
          then
-
             if Is_Unchecked_Union (R_Typ) then
                Insert_Actions (N,
                  Make_Component_List_Assign (Component_List (RDef), True));
@@ -1430,7 +1453,6 @@ package body Exp_Ch5 is
 
             Rewrite (N, Make_Null_Statement (Loc));
          end if;
-
       end;
    end Expand_Assign_Record;
 
@@ -1449,6 +1471,18 @@ package body Exp_Ch5 is
       Exp  : Node_Id;
 
    begin
+      --  Special case to check right away, if the Componentwise_Assignment
+      --  flag is set, this is a reanalysis from the expansion of the primitive
+      --  assignment procedure for a tagged type, and all we need to do is to
+      --  expand to assignment of components, because otherwise, we would get
+      --  infinite recursion (since this looks like a tagged assignment which
+      --  would normally try to *call* the primitive assignment procedure).
+
+      if Componentwise_Assignment (N) then
+         Expand_Assign_Record (N);
+         return;
+      end if;
+
       --  Ada 2005 (AI-327): Handle assignment to priority of protected object
 
       --  Rewrite an assignment to X'Priority into a run-time call
@@ -1812,10 +1846,9 @@ package body Exp_Ch5 is
             Expand_Ctrl_Actions : constant Boolean := not No_Ctrl_Actions (N);
 
          begin
-            --  In the controlled case, we need to make sure that function
-            --  calls are evaluated before finalizing the target. In all cases,
-            --  it makes the expansion easier if the side-effects are removed
-            --  first.
+            --  In the controlled case, we ensure that function calls are
+            --  evaluated before finalizing the target. In all cases, it makes
+            --  the expansion easier if the side-effects are removed first.
 
             Remove_Side_Effects (Lhs);
             Remove_Side_Effects (Rhs);
@@ -1842,15 +1875,14 @@ package body Exp_Ch5 is
                --  is set True in this case).
 
                or else (Is_Tagged_Type (Typ)
-                          and then not Is_Value_Type (Etype (Lhs))
-                          and then Chars (Current_Scope) /= Name_uAssign
-                          and then Expand_Ctrl_Actions
-                          and then not Discriminant_Checks_Suppressed (Empty))
+                         and then not Is_Value_Type (Etype (Lhs))
+                         and then Chars (Current_Scope) /= Name_uAssign
+                         and then Expand_Ctrl_Actions
+                         and then not Discriminant_Checks_Suppressed (Empty))
             then
                --  Fetch the primitive op _assign and proper type to call it.
-               --  Because of possible conflicts between private and full view
-               --  the proper type is fetched directly from the operation
-               --  profile.
+               --  Because of possible conflicts between private and full view,
+               --  fetch the proper type directly from the operation profile.
 
                declare
                   Op    : constant Entity_Id :=
@@ -4304,7 +4336,11 @@ package body Exp_Ch5 is
       Ctrl_Act : constant Boolean := Needs_Finalization (T)
                                        and then not No_Ctrl_Actions (N);
 
+      Component_Assign : constant Boolean :=
+                           Is_Fully_Repped_Tagged_Type (T);
+
       Save_Tag : constant Boolean := Is_Tagged_Type (T)
+                                       and then not Component_Assign
                                        and then not No_Ctrl_Actions (N)
                                        and then Tagged_Type_Expansion;
       --  Tags are not saved and restored when VM_Target because VM tags are
@@ -4320,11 +4356,12 @@ package body Exp_Ch5 is
    begin
       Res := New_List;
 
-      --  Finalize the target of the assignment when controlled.
+      --  Finalize the target of the assignment when controlled
+
       --  We have two exceptions here:
 
-      --   1. If we are in an init proc since it is an initialization
-      --      more than an assignment
+      --   1. If we are in an init proc since it is an initialization more
+      --      than an assignment.
 
       --   2. If the left-hand side is a temporary that was not initialized
       --      (or the parent part of a temporary since it is the case in
@@ -4342,18 +4379,18 @@ package body Exp_Ch5 is
 
       elsif Nkind (L) = N_Type_Conversion
         and then Is_Entity_Name (Expression (L))
-        and then Nkind (Parent (Entity (Expression (L))))
-                   = N_Object_Declaration
+        and then Nkind (Parent (Entity (Expression (L)))) =
+                                              N_Object_Declaration
         and then No_Initialization (Parent (Entity (Expression (L))))
       then
          null;
 
       else
          Append_List_To (Res,
-           Make_Final_Call (
-             Ref         => Duplicate_Subexpr_No_Checks (L),
-             Typ         => Etype (L),
-             With_Detach => New_Reference_To (Standard_False, Loc)));
+           Make_Final_Call
+             (Ref         => Duplicate_Subexpr_No_Checks (L),
+              Typ         => Etype (L),
+              With_Detach => New_Reference_To (Standard_False, Loc)));
       end if;
 
       --  Save the Tag in a local variable Tag_Tmp
@@ -4628,8 +4665,7 @@ package body Exp_Ch5 is
 
                First_After_Root := Make_Integer_Literal (Loc, 1);
 
-               --  For the case of a controlled object, skip the
-               --  Root_Controlled part.
+               --  For controlled object, skip Root_Controlled part
 
                if Is_Controlled (T) then
                   First_After_Root :=
@@ -4644,9 +4680,8 @@ package body Exp_Ch5 is
                end if;
 
                --  For the case of a record with controlled components, skip
-               --  the Prev and Next components of the record controller.
-               --  These components constitute a 'hole' in the middle of the
-               --  data to be copied.
+               --  record controller Prev/Next components. These components
+               --  constitute a 'hole' in the middle of the data to be copied.
 
                if Has_Controlled_Component (T) then
                   Prev_Ref :=
@@ -4658,8 +4693,8 @@ package body Exp_Ch5 is
                             New_Reference_To (Controller_Component (T), Loc)),
                       Selector_Name =>  Make_Identifier (Loc, Name_Prev));
 
-                  --  Last index before hole: determined by position of
-                  --  the _Controller.Prev component.
+                  --  Last index before hole: determined by position of the
+                  --  _Controller.Prev component.
 
                   Last_Before_Hole :=
                     Make_Defining_Identifier (Loc,
@@ -4755,8 +4790,26 @@ package body Exp_Ch5 is
             end Controlled_Actions;
          end if;
 
+      --  Not controlled case
+
       else
-         Append_To (Res, Relocate_Node (N));
+         declare
+            Asn : constant Node_Id := Relocate_Node (N);
+
+         begin
+            --  If this is the case of a tagged type with a full rep clause,
+            --  we must expand it into component assignments, so we mark the
+            --  node as unanalyzed, to get it reanalyzed, but flag it has
+            --  requiring component-wise assignment so we don't get infinite
+            --  recursion.
+
+            if Component_Assign then
+               Set_Analyzed (Asn, False);
+               Set_Componentwise_Assignment (Asn, True);
+            end if;
+
+            Append_To (Res, Asn);
+         end;
       end if;
 
       --  Restore the tag
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 1031050..d139a2b 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -914,6 +914,7 @@ package body Exp_Util is
 
    function Component_May_Be_Bit_Aligned (Comp : Entity_Id) return Boolean is
       UT : constant Entity_Id := Underlying_Type (Etype (Comp));
+
    begin
       --  If no component clause, then everything is fine, since the back end
       --  never bit-misaligns by default, even if there is a pragma Packed for
@@ -930,9 +931,9 @@ package body Exp_Util is
       then
          return False;
 
-      --  If we know that we have a small (64 bits or less) record
-      --  or bit-packed array, then everything is fine, since the
-      --  back end can handle these cases correctly.
+      --  If we know that we have a small (64 bits or less) record or small
+      --  bit-packed array, then everything is fine, since the back end can
+      --  handle these cases correctly.
 
       elsif Esize (Comp) <= 64
         and then (Is_Record_Type (UT)
@@ -2939,6 +2940,43 @@ package body Exp_Util is
       return True;
    end Is_All_Null_Statements;
 
+   ---------------------------------
+   -- Is_Fully_Repped_Tagged_Type --
+   ---------------------------------
+
+   function Is_Fully_Repped_Tagged_Type (T : Entity_Id) return Boolean is
+      U    : constant Entity_Id := Underlying_Type (T);
+      Comp : Entity_Id;
+
+   begin
+      if No (U) or else not Is_Tagged_Type (U) then
+         return False;
+      elsif Has_Discriminants (U) then
+         return False;
+      elsif not Has_Specified_Layout (U) then
+         return False;
+      end if;
+
+      --  Here we have a tagged type, see if it has any unlayed out fields
+      --  other than a possible tag and parent fields. If so, we return False.
+
+      Comp := First_Component (U);
+      while Present (Comp) loop
+         if not Is_Tag (Comp)
+           and then Chars (Comp) /= Name_uParent
+           and then No (Component_Clause (Comp))
+         then
+            return False;
+         else
+            Next_Component (Comp);
+         end if;
+      end loop;
+
+      --  All components are layed out
+
+      return True;
+   end Is_Fully_Repped_Tagged_Type;
+
    ----------------------------------
    -- Is_Library_Level_Tagged_Type --
    ----------------------------------
@@ -3303,16 +3341,11 @@ package body Exp_Util is
    function Is_Renamed_Object (N : Node_Id) return Boolean is
       Pnod : constant Node_Id   := Parent (N);
       Kind : constant Node_Kind := Nkind (Pnod);
-
    begin
       if Kind = N_Object_Renaming_Declaration then
          return True;
-
-      elsif Kind = N_Indexed_Component
-        or else Kind = N_Selected_Component
-      then
+      elsif Nkind_In (Kind, N_Indexed_Component, N_Selected_Component) then
          return Is_Renamed_Object (Pnod);
-
       else
          return False;
       end if;
@@ -3623,8 +3656,8 @@ package body Exp_Util is
    -- Make_CW_Equivalent_Type --
    -----------------------------
 
-   --  Create a record type used as an equivalent of any member
-   --  of the class which takes its size from exp.
+   --  Create a record type used as an equivalent of any member of the class
+   --  which takes its size from exp.
 
    --  Generate the following code:
 
@@ -3671,6 +3704,7 @@ package body Exp_Util is
       Range_Type := Make_Defining_Identifier (Loc, New_Internal_Name ('G'));
 
       if not Is_Interface (Root_Typ) then
+
          --  subtype rg__xx is
          --    Storage_Offset range 1 .. (Expr'size - typ'size) / Storage_Unit
 
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index c310a21..1f3c9e8 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -466,6 +466,15 @@ package Exp_Util is
    --  False otherwise. True for an empty list. It is an error to call this
    --  routine with No_List as the argument.
 
+   function Is_Fully_Repped_Tagged_Type (T : Entity_Id) return Boolean;
+   --  Tests given type T, and returns True if T is a non-discriminated tagged
+   --  type which has a record representation clause that specifies the layout
+   --  of all the components, including recursively components in all parent
+   --  types. We exclude discriminated types for convenience, it is extremely
+   --  unlikely that the special processing associated with the use of this
+   --  routine is useful for the case of a discriminated type, and testing for
+   --  component overlap would be a pain.
+
    function Is_Library_Level_Tagged_Type (Typ : Entity_Id) return Boolean;
    --  Return True if Typ is a library level tagged type. Currently we use
    --  this information to build statically allocated dispatch tables.
diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
index bd55cbe..79468ff 100644
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -142,6 +142,12 @@ extern void Get_Encoded_Name			(Entity_Id);
 extern void Get_External_Name			(Entity_Id, Boolean);
 extern void Get_External_Name_With_Suffix	(Entity_Id, Fat_Pointer);
 
+/* exp_util: */
+
+#define Is_Fully_Repped_Tagged_Type exp_util__is_fully_repped_tagged_type
+
+extern Boolean Is_Fully_Repped_Tagged_Type      (Entity_Id);
+
 /* lib: */
 
 #define Cunit 				lib__cunit
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index bc18c28..a17d454 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -8445,13 +8445,11 @@ without a specific initializer (including the case of OUT scalar parameters).
 
 @item No_Direct_Boolean_Operators
 @findex No_Direct_Boolean_Operators
-This restriction ensures that no logical (and/or/xor) or comparison
-operators are used on operands of type Boolean (or any type derived
+This restriction ensures that no logical (and/or/xor) are used on
+operands of type Boolean (or any type derived
 from Boolean). This is intended for use in safety critical programs
 where the certification protocol requires the use of short-circuit
-(and then, or else) forms for all composite boolean operations. An
-exception is that an explicit equality test with True or False as the
-right operand is not considered to violate this restriction.
+(and then, or else) forms for all composite boolean operations.
 
 @item No_Dispatching_Calls
 @findex No_Dispatching_Calls
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 40dd75a..ef778a2 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2191,6 +2191,7 @@ package body Sem_Ch13 is
       Hbit    : Uint := Uint_0;
       Comp    : Entity_Id;
       Ocomp   : Entity_Id;
+      Pcomp   : Entity_Id;
       Biased  : Boolean;
 
       Max_Bit_So_Far : Uint;
@@ -2198,6 +2199,19 @@ package body Sem_Ch13 is
       --  are monotonically increasing, then we can skip the circuit for
       --  checking for overlap, since no overlap is possible.
 
+      Tagged_Parent : Entity_Id := Empty;
+      --  This is set in the case of a derived tagged type for which we have
+      --  Is_Fully_Repped_Tagged_Type True (indicating that all components are
+      --  positioned by record representation clauses). In this case we must
+      --  check for overlap between components of this tagged type, and the
+      --  components of its parent. Tagged_Parent will point to this parent
+      --  type. For all other cases Tagged_Parent is left set to Empty.
+
+      Parent_Last_Bit : Uint;
+      --  Relevant only if Tagged_Parent is set, Parent_Last_Bit indicates the
+      --  last bit position for any field in the parent type. We only need to
+      --  check overlap for fields starting below this point.
+
       Overlap_Check_Required : Boolean;
       --  Used to keep track of whether or not an overlap check is required
 
@@ -2319,6 +2333,39 @@ package body Sem_Ch13 is
          end loop;
       end if;
 
+      --  See if we have a fully repped derived tagged type
+
+      declare
+         PS : constant Entity_Id := Parent_Subtype (Rectype);
+
+      begin
+         if Present (PS) and then Is_Fully_Repped_Tagged_Type (PS) then
+            Tagged_Parent := PS;
+
+            --  Find maximum bit of any component of the parent type
+
+            Parent_Last_Bit := UI_From_Int (System_Address_Size - 1);
+            Pcomp := First_Entity (Tagged_Parent);
+            while Present (Pcomp) loop
+               if Ekind (Pcomp) = E_Discriminant
+                    or else
+                  Ekind (Pcomp) = E_Component
+               then
+                  if Component_Bit_Offset (Pcomp) /= No_Uint
+                    and then Known_Static_Esize (Pcomp)
+                  then
+                     Parent_Last_Bit :=
+                       UI_Max
+                         (Parent_Last_Bit,
+                          Component_Bit_Offset (Pcomp) + Esize (Pcomp) - 1);
+                  end if;
+
+                  Next_Entity (Pcomp);
+               end if;
+            end loop;
+         end if;
+      end;
+
       --  All done if no component clauses
 
       CC := First (Component_Clauses (N));
@@ -2483,6 +2530,9 @@ package body Sem_Ch13 is
                         end;
                      end if;
 
+                  --  Normal case where this is the first component clause we
+                  --  have seen for this entity, so set it up properly.
+
                   else
                      --  Make reference for field in record rep clause and set
                      --  appropriate entity field in the field identifier.
@@ -2523,7 +2573,7 @@ package body Sem_Ch13 is
                         then
                            Error_Msg_NE
                              ("component overlaps tag field of&",
-                              CC, Rectype);
+                              Component_Name (CC), Rectype);
                         end if;
 
                         --  This information is also set in the corresponding
@@ -2568,6 +2618,27 @@ package body Sem_Ch13 is
                            Error_Msg_N ("component size is negative", CC);
                         end if;
                      end if;
+
+                     --  If OK component size, check parent type overlap if
+                     --  this component might overlap a parent field.
+
+                     if Present (Tagged_Parent)
+                       and Fbit <= Parent_Last_Bit
+                     then
+                        Pcomp := First_Entity (Tagged_Parent);
+                        while Present (Pcomp) loop
+                           if (Ekind (Pcomp) = E_Discriminant
+                                or else
+                               Ekind (Pcomp) = E_Component)
+                             and then not Is_Tag (Pcomp)
+                             and then Chars (Pcomp) /= Name_uParent
+                           then
+                              Check_Component_Overlap (Comp, Pcomp);
+                           end if;
+
+                           Next_Entity (Pcomp);
+                        end loop;
+                     end if;
                   end if;
                end if;
             end if;
diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb
index 0b7adc4..42136b1 100644
--- a/gcc/ada/sem_intr.adb
+++ b/gcc/ada/sem_intr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, 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- --
@@ -102,7 +102,9 @@ package body Sem_Intr is
       Arg1 : constant Node_Id   := First_Actual (N);
 
    begin
-      --  For Import_xxx calls, argument must be static string
+      --  For Import_xxx calls, argument must be static string. A string
+      --  literal is legal even in Ada83 mode, where such literals are
+      --  not static.
 
       if Cnam = Name_Import_Address
            or else
@@ -115,7 +117,9 @@ package body Sem_Intr is
          then
             null;
 
-         elsif not Is_Static_Expression (Arg1) then
+         elsif Nkind (Arg1) /= N_String_Literal
+           and then not Is_Static_Expression (Arg1)
+         then
             Error_Msg_FE
               ("call to & requires static string argument!", N, Nam);
             Why_Not_Static (Arg1);
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index e6c4f59..372750b 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -120,9 +120,9 @@ package body Sem_Res is
    --  Could be optimized away perhaps?
 
    procedure Check_No_Direct_Boolean_Operators (N : Node_Id);
-   --  N is the node for a comparison or logical operator. If the operator
-   --  is predefined, and the root type of the operands is Standard.Boolean,
-   --  then a check is made for restriction No_Direct_Boolean_Operators.
+   --  N is the node for a logical operator. If the operator is predefined, and
+   --  the root type of the operands is Standard.Boolean, then a check is made
+   --  for restriction No_Direct_Boolean_Operators.
 
    function Is_Definite_Access_Type (E : Entity_Id) return Boolean;
    --  Determine whether E is an access type declared by an access
@@ -941,24 +941,9 @@ package body Sem_Res is
       if Scope (Entity (N)) = Standard_Standard
         and then Root_Type (Etype (Left_Opnd (N))) = Standard_Boolean
       then
-         --  Restriction does not apply to generated code
+         --  Restriction only applies to original source code
 
-         if not Comes_From_Source (N) then
-            null;
-
-         --  Restriction does not apply for A=False, A=True
-
-         elsif Nkind (N) = N_Op_Eq
-           and then (Is_Entity_Name (Right_Opnd (N))
-                      and then (Entity (Right_Opnd (N)) = Standard_True
-                                 or else
-                                Entity (Right_Opnd (N)) = Standard_False))
-         then
-            null;
-
-         --  Otherwise restriction applies
-
-         else
+         if Comes_From_Source (N) then
             Check_Restriction (No_Direct_Boolean_Operators, N);
          end if;
       end if;
@@ -5478,8 +5463,6 @@ package body Sem_Res is
       T : Entity_Id;
 
    begin
-      Check_No_Direct_Boolean_Operators (N);
-
       --  If this is an intrinsic operation which is not predefined, use the
       --  types of its declared arguments to resolve the possibly overloaded
       --  operands. Otherwise the operands are unambiguous and specify the
@@ -6224,8 +6207,6 @@ package body Sem_Res is
    --  Start of processing for Resolve_Equality_Op
 
    begin
-      Check_No_Direct_Boolean_Operators (N);
-
       Set_Etype (N, Base_Type (Typ));
       Generate_Reference (T, N, ' ');
 
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 2ed3ad3..da6adb2 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -464,6 +464,14 @@ package body Sinfo is
       return Node1 (N);
    end Component_Name;
 
+   function Componentwise_Assignment
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Assignment_Statement);
+      return Flag14 (N);
+   end Componentwise_Assignment;
+
    function Condition
       (N : Node_Id) return Node_Id is
    begin
@@ -3271,6 +3279,14 @@ package body Sinfo is
       Set_Node1_With_Parent (N, Val);
    end Set_Component_Name;
 
+   procedure Set_Componentwise_Assignment
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Assignment_Statement);
+      Set_Flag14 (N, Val);
+   end Set_Componentwise_Assignment;
+
    procedure Set_Condition
       (N : Node_Id; Val : Node_Id) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 5ba4571..737f7b6 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -679,6 +679,16 @@ package Sinfo is
    --    Sem_Aggr for the specific conditions under which an aggregate has this
    --    flag set. See also the flag Static_Processing_OK.
 
+   --  Componentwise_Assignment (Flag14-Sem)
+   --    Present in N_Assignment_Statement nodes. Set for a record assignment
+   --    where all that needs doing is to expand it into component-by-component
+   --    assignments. This is used internally for the case of tagged types with
+   --    rep clauses, where we need to avoid recursion (we don't want to try to
+   --    generate a call to the primitive operation, because this is the case
+   --    where we are compiling the primitive operation). Note that when we are
+   --    expanding component assignments in this case, we never assign the _tag
+   --    field, but we recursively assign components of the parent type.
+
    --  Condition_Actions (List3-Sem)
    --    This field appears in else-if nodes and in the iteration scheme node
    --    for while loops. This field is only used during semantic processing to
@@ -3861,6 +3871,7 @@ package Sinfo is
       --  Forwards_OK (Flag5-Sem)
       --  Backwards_OK (Flag6-Sem)
       --  No_Ctrl_Actions (Flag7-Sem)
+      --  Componentwise_Assignment (Flag14-Sem)
 
       --  Note: if a range check is required, then the Do_Range_Check flag
       --  is set in the Expression (right hand side), with the check being
@@ -7643,6 +7654,9 @@ package Sinfo is
    function Component_Name
      (N : Node_Id) return Node_Id;    -- Node1
 
+   function Componentwise_Assignment
+     (N : Node_Id) return Boolean;    -- Flag14
+
    function Condition
      (N : Node_Id) return Node_Id;    -- Node1
 
@@ -8537,6 +8551,9 @@ package Sinfo is
    procedure Set_Component_Name
      (N : Node_Id; Val : Node_Id);            -- Node1
 
+   procedure Set_Componentwise_Assignment
+     (N : Node_Id; Val : Boolean := True);    -- Flag14
+
    procedure Set_Condition
      (N : Node_Id; Val : Node_Id);            -- Node1
 
@@ -10983,6 +11000,7 @@ package Sinfo is
    pragma Inline (Component_Items);
    pragma Inline (Component_List);
    pragma Inline (Component_Name);
+   pragma Inline (Componentwise_Assignment);
    pragma Inline (Condition);
    pragma Inline (Condition_Actions);
    pragma Inline (Config_Pragmas);
@@ -11278,6 +11296,7 @@ package Sinfo is
    pragma Inline (Set_Component_Items);
    pragma Inline (Set_Component_List);
    pragma Inline (Set_Component_Name);
+   pragma Inline (Set_Componentwise_Assignment);
    pragma Inline (Set_Condition);
    pragma Inline (Set_Condition_Actions);
    pragma Inline (Set_Config_Pragmas);
diff --git a/gcc/ada/sprint.ads b/gcc/ada/sprint.ads
index 5300237..59c371a 100644
--- a/gcc/ada/sprint.ads
+++ b/gcc/ada/sprint.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, 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- --
@@ -85,9 +85,9 @@ package Sprint is
    --    Validate_Unchecked_Conversion       validate unchecked_conversion
    --                                                  (src-type, target-typ);
 
-   --  Note: the storage_pool parameters for allocators and the free node
-   --  are omitted if the Storage_Pool field is Empty, indicating use of
-   --  the standard default pool.
+   --  Note: the storage_pool parameters for allocators and the free node are
+   --  omitted if the Storage_Pool field is Empty, indicating use of the
+   --  standard default pool.
 
    -----------------
    -- Subprograms --
@@ -103,18 +103,18 @@ package Sprint is
    --    -sz  print source from tree for package Standard
 
    procedure Sprint_Comma_List (List : List_Id);
-   --  Prints the nodes in a list, with separating commas. If the list
-   --  is empty then no output is generated.
+   --  Prints the nodes in a list, with separating commas. If the list is empty
+   --  then no output is generated.
 
    procedure Sprint_Paren_Comma_List (List : List_Id);
-   --  Prints the nodes in a list, surrounded by parentheses, and separated
-   --  by comas. If the list is empty, then no output is generated. A blank
-   --  is output before the initial left parenthesis.
+   --  Prints the nodes in a list, surrounded by parentheses, and separated by
+   --  commas. If the list is empty, then no output is generated. A blank is
+   --  output before the initial left parenthesis.
 
    procedure Sprint_Opt_Paren_Comma_List (List : List_Id);
-   --  Same as normal Sprint_Paren_Comma_List procedure, except that
-   --  an extra blank is output if List is non-empty, and nothing at all is
-   --  printed it the argument is No_List.
+   --  Same as normal Sprint_Paren_Comma_List procedure, except that an extra
+   --  blank is output if List is non-empty, and nothing at all is printed it
+   --  the argument is No_List.
 
    procedure Sprint_Node_List (List : List_Id);
    --  Prints the nodes in a list with no separating characters. This is used
@@ -126,9 +126,9 @@ package Sprint is
    --  Like Sprint_Node_List, but prints nothing if List = No_List
 
    procedure Sprint_Indented_List (List : List_Id);
-   --  Like Sprint_Line_List, except that the indentation level is
-   --  increased before outputting the list of items, and then decremented
-   --  (back to its original level) before returning to the caller.
+   --  Like Sprint_Line_List, except that the indentation level is increased
+   --  before outputting the list of items, and then decremented (back to its
+   --  original level) before returning to the caller.
 
    procedure Sprint_Node (Node : Node_Id);
    --  Prints a single node. No new lines are output, except as required for
@@ -137,8 +137,8 @@ package Sprint is
    --  blank characters are generated.
 
    procedure Sprint_Opt_Node (Node : Node_Id);
-   --  Same as normal Sprint_Node procedure, except that one leading
-   --  blank is output before the node if it is non-empty.
+   --  Same as normal Sprint_Node procedure, except that one leading blank is
+   --  output before the node if it is non-empty.
 
    procedure pg (Arg : Union_Id);
    pragma Export (Ada, pg);
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index 9302175..37e876e 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -6561,8 +6561,7 @@ package VMS_Data is
    --        /NONO_LOCAL_HEADER (D)
    --        /NO_LOCAL_HEADER
    --
-   --  Do not put local comment header before body stub for a local progran
-   --  unit
+   --  Do not put local comment header before body stub for local program unit.
 
    S_Stub_Output  : aliased constant S := "/OUTPUT=@"                      &
                                             "-o@";
@@ -6621,9 +6620,9 @@ package VMS_Data is
    --      OVERWRITE (D)  Overwrite the existing tree file. If the current
    --                     directory already contains the file which, according
    --                     to the GNAT file naming rules should be considered
-   --                     as a tree file for the argument source file,
-   --                     gnatstub will refuse to create the tree file needed
-   --                     to create a sample body unless this option is chosen.
+   --                     as a tree file for the argument source file, gnatstub
+   --                     will refuse to create the tree file needed to create
+   --                     a sample body unless this option is chosen.
    --
    --      SAVE           Do not remove the tree file (i.e., the snapshot
    --                     of the compiler internal structures used by gnatstub)