* checks.adb (Apply_Address_Clause_Check): Remove Size_Warning_Output

	local variable and do not test it in Compile_Time_Bad_Alignment.
	Do not issue size or alignment warnings for the X'Address form.
	* sem_util.ads (Find_Overlaid_Object): Delete.
	(Find_Overlaid_Entity): New procedure.
	* sem_util.adb (Find_Overlaid_Object): Rename to...
	(Find_Overlaid_Entity): ...this and turn into a procedure.  Report
	whether the address is offseted within the overlaid entity.
	(Has_Compatible_Alignment): Track the offset globally instead of
	passing it to Check_Offset.  For an indexed component, compute the
	full offset when possible.  If the resulting offset is zero, only
	check the prefix.
	(Check_Offset): Delete.
	* sem_ch13.adb (Address_Clause_Check_Record): Add Off field.
	(Address_Aliased_Entity): Delete.
	(Analyze_Attribute_Definition_Clause) <Attribute_Address>: Call
	Find_Overlaid_Entity to find the overlaid entity and the offset.
	Adjust throughout for above change.
	(Validate_Address_Clauses): Always use attributes of entities, not of
	their type.  Tweak message for warning.  Call Has_Compatible_Alignment
	if the address is offseted to warn about incompatible alignments.
	* gcc-interface/gigi.h (annotate_object): Declare.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Annotate renaming
	entity.  Call annotate_object instead of annotating manually objects.
	(annotate_object): New function.
	* gcc-interface/trans.c (Subprogram_Body_to_gnu): Annotate parameters
	at the end.


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

8 files changed, 322 insertions, 307 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6abe93303f2..7f2c2e24d25 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,35 @@
 2009-07-11  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* checks.adb (Apply_Address_Clause_Check): Remove Size_Warning_Output
+	local variable and do not test it in Compile_Time_Bad_Alignment.
+	Do not issue size or alignment warnings for the X'Address form.
+	* sem_util.ads (Find_Overlaid_Object): Delete.
+	(Find_Overlaid_Entity): New procedure.
+	* sem_util.adb (Find_Overlaid_Object): Rename to...
+	(Find_Overlaid_Entity): ...this and turn into a procedure.  Report
+	whether the address is offseted within the overlaid entity.
+	(Has_Compatible_Alignment): Track the offset globally instead of
+	passing it to Check_Offset.  For an indexed component, compute the
+	full offset when possible.  If the resulting offset is zero, only
+	check the prefix.
+	(Check_Offset): Delete.
+	* sem_ch13.adb (Address_Clause_Check_Record): Add Off field.
+	(Address_Aliased_Entity): Delete.
+	(Analyze_Attribute_Definition_Clause) <Attribute_Address>: Call
+	Find_Overlaid_Entity to find the overlaid entity and the offset.
+	Adjust throughout for above change.
+	(Validate_Address_Clauses): Always use attributes of entities, not of
+	their type.  Tweak message for warning.  Call Has_Compatible_Alignment
+	if the address is offseted to warn about incompatible alignments.
+	* gcc-interface/gigi.h (annotate_object): Declare.
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Annotate renaming
+	entity.  Call annotate_object instead of annotating manually objects.
+	(annotate_object): New function.
+	* gcc-interface/trans.c (Subprogram_Body_to_gnu): Annotate parameters
+	at the end.
+
+2009-07-11  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/ada-tree.h: Minor reorganization.
 	* gcc-interface/misc.c (gnat_print_decl): Minor tweaks.
 	(gnat_print_type): Likewise.
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 7f78a5ed5d0..d08616193c4 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -532,16 +532,11 @@ package body Checks is
       --  when Aexp is a reference to a constant, in which case Expr gets
       --  reset to reference the value expression of the constant.
 
-      Size_Warning_Output : Boolean := False;
-      --  If we output a size warning we set this True, to stop generating
-      --  what is likely to be an unuseful redundant alignment warning.
-
       procedure Compile_Time_Bad_Alignment;
       --  Post error warnings when alignment is known to be incompatible. Note
       --  that we do not go as far as inserting a raise of Program_Error since
       --  this is an erroneous case, and it may happen that we are lucky and an
-      --  underaligned address turns out to be OK after all. Also this warning
-      --  is suppressed if we already complained about the size.
+      --  underaligned address turns out to be OK after all.
 
       --------------------------------
       -- Compile_Time_Bad_Alignment --
@@ -549,9 +544,7 @@ package body Checks is
 
       procedure Compile_Time_Bad_Alignment is
       begin
-         if not Size_Warning_Output
-           and then Address_Clause_Overlay_Warnings
-         then
+         if Address_Clause_Overlay_Warnings then
             Error_Msg_FE
               ("?specified address for& may be inconsistent with alignment ",
                Aexp, E);
@@ -565,7 +558,24 @@ package body Checks is
    --  Start of processing for Apply_Address_Clause_Check
 
    begin
-      --  First obtain expression from address clause
+      --  See if alignment check needed. Note that we never need a check if the
+      --  maximum alignment is one, since the check will always succeed.
+
+      --  Note: we do not check for checks suppressed here, since that check
+      --  was done in Sem_Ch13 when the address clause was processed. We are
+      --  only called if checks were not suppressed. The reason for this is
+      --  that we have to delay the call to Apply_Alignment_Check till freeze
+      --  time (so that all types etc are elaborated), but we have to check
+      --  the status of check suppressing at the point of the address clause.
+
+      if No (AC)
+        or else not Check_Address_Alignment (AC)
+        or else Maximum_Alignment = 1
+      then
+         return;
+      end if;
+
+      --  Obtain expression from address clause
 
       Expr := Expression (AC);
 
@@ -603,69 +613,7 @@ package body Checks is
          end if;
       end loop;
 
-      --  Output a warning if we have the situation of
-
-      --      for X'Address use Y'Address
-
-      --  and X and Y both have known object sizes, and Y is smaller than X
-
-      if Nkind (Expr) = N_Attribute_Reference
-        and then Attribute_Name (Expr) = Name_Address
-        and then Is_Entity_Name (Prefix (Expr))
-      then
-         declare
-            Exp_Ent  : constant Entity_Id := Entity (Prefix (Expr));
-            Obj_Size : Uint := No_Uint;
-            Exp_Size : Uint := No_Uint;
-
-         begin
-            if Known_Esize (E) then
-               Obj_Size := Esize (E);
-            elsif Known_Esize (Etype (E)) then
-               Obj_Size := Esize (Etype (E));
-            end if;
-
-            if Known_Esize (Exp_Ent) then
-               Exp_Size := Esize (Exp_Ent);
-            elsif Known_Esize (Etype (Exp_Ent)) then
-               Exp_Size := Esize (Etype (Exp_Ent));
-            end if;
-
-            if Obj_Size /= No_Uint
-              and then Exp_Size /= No_Uint
-              and then Obj_Size > Exp_Size
-              and then not Has_Warnings_Off (E)
-            then
-               if Address_Clause_Overlay_Warnings then
-                  Error_Msg_FE
-                    ("?& overlays smaller object", Aexp, E);
-                  Error_Msg_FE
-                    ("\?program execution may be erroneous", Aexp, E);
-                  Size_Warning_Output := True;
-                  Set_Address_Warning_Posted (AC);
-               end if;
-            end if;
-         end;
-      end if;
-
-      --  See if alignment check needed. Note that we never need a check if the
-      --  maximum alignment is one, since the check will always succeed.
-
-      --  Note: we do not check for checks suppressed here, since that check
-      --  was done in Sem_Ch13 when the address clause was processed. We are
-      --  only called if checks were not suppressed. The reason for this is
-      --  that we have to delay the call to Apply_Alignment_Check till freeze
-      --  time (so that all types etc are elaborated), but we have to check
-      --  the status of check suppressing at the point of the address clause.
-
-      if No (AC)
-        or else not Check_Address_Alignment (AC)
-        or else Maximum_Alignment = 1
-      then
-         return;
-      end if;
-
-      --  See if we know that Expr is a bad alignment at compile time
+      --  See if we know that Expr has a bad alignment at compile time
 
       if Compile_Time_Known_Value (Expr)
         and then (Known_Alignment (E) or else Known_Alignment (Typ))
@@ -690,20 +638,14 @@ package body Checks is
 
       --  If the expression has the form X'Address, then we can find out if
       --  the object X has an alignment that is compatible with the object E.
+      --  If it hasn't or we don't know, we defer issuing the warning until
+      --  the end of the compilation to take into account back end annotations.
 
       elsif Nkind (Expr) = N_Attribute_Reference
         and then Attribute_Name (Expr) = Name_Address
+        and then Has_Compatible_Alignment (E, Prefix (Expr)) = Known_Compatible
       then
-         declare
-            AR : constant Alignment_Result :=
-                   Has_Compatible_Alignment (E, Prefix (Expr));
-         begin
-            if AR = Known_Compatible then
-               return;
-            elsif AR = Known_Incompatible then
-               Compile_Time_Bad_Alignment;
-            end if;
-         end;
+         return;
       end if;
 
       --  Here we do not know if the value is acceptable. Stricly we don't have
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 42086128cd7..67d8cd1b0c4 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -905,6 +905,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 			  mark_visited (&gnu_decl);
 			save_gnu_tree (gnat_entity, gnu_decl, true);
 			saved = true;
+			annotate_object (gnat_entity, gnu_type, NULL_TREE,
+					 false);
 			break;
 		      }
 
@@ -1382,32 +1384,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    && Exception_Mechanism != Back_End_Exceptions)
 	  TREE_ADDRESSABLE (gnu_decl) = 1;
 
-	gnu_type = TREE_TYPE (gnu_decl);
-
-	/* Back-annotate Alignment and Esize of the object if not already
-	   known, except for when the object is actually a pointer to the
-	   real object, since alignment and size of a pointer don't have
-	   anything to do with those of the designated object.  Note that
-	   we pick the values of the type, not those of the object, to
-	   shield ourselves from low-level platform-dependent adjustments
-	   like alignment promotion.  This is both consistent with all the
-	   treatment above, where alignment and size are set on the type of
-	   the object and not on the object directly, and makes it possible
-	   to support confirming representation clauses in all cases.  */
-
-	if (!used_by_ref && Unknown_Alignment (gnat_entity))
-	  Set_Alignment (gnat_entity,
-			 UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
-
-	if (!used_by_ref && Unknown_Esize (gnat_entity))
-	  {
-	    if (TREE_CODE (gnu_type) == RECORD_TYPE
-		&& TYPE_CONTAINS_TEMPLATE_P (gnu_type))
-	      gnu_object_size
-		= TYPE_SIZE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type))));
-
-	    Set_Esize (gnat_entity, annotate_value (gnu_object_size));
-	  }
+	/* Back-annotate Esize and Alignment of the object if not already
+	   known.  Note that we pick the values of the type, not those of
+	   the object, to shield ourselves from low-level platform-dependent
+	   adjustments like alignment promotion.  This is both consistent with
+	   all the treatment above, where alignment and size are set on the
+	   type of the object and not on the object directly, and makes it
+	   possible to support all confirming representation clauses.  */
+	annotate_object (gnat_entity, TREE_TYPE (gnu_decl), gnu_object_size,
+			 used_by_ref);
       }
       break;
 
@@ -7223,6 +7208,39 @@ annotate_value (tree gnu_size)
   return ret;
 }
 
+/* Given GNAT_ENTITY, an object (constant, variable, parameter, exception)
+   and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the
+   size and alignment used by Gigi.  Prefer SIZE over TYPE_SIZE if non-null.
+   BY_REF is true if the object is used by reference.  */
+
+void
+annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref)
+{
+  if (by_ref)
+    {
+      if (TYPE_FAT_POINTER_P (gnu_type))
+	gnu_type = TYPE_UNCONSTRAINED_ARRAY (gnu_type);
+      else
+	gnu_type = TREE_TYPE (gnu_type);
+    }
+
+  if (Unknown_Esize (gnat_entity))
+    {
+      if (TREE_CODE (gnu_type) == RECORD_TYPE
+	  && TYPE_CONTAINS_TEMPLATE_P (gnu_type))
+	size = TYPE_SIZE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type))));
+      else if (!size)
+	size = TYPE_SIZE (gnu_type);
+
+      if (size)
+	Set_Esize (gnat_entity, annotate_value (size));
+    }
+
+  if (Unknown_Alignment (gnat_entity))
+    Set_Alignment (gnat_entity,
+		   UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
+}
+
 /* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding
    GCC type, set Component_Bit_Offset and Esize to the position and size
    used by Gigi.  */
diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 7bc89eef6fd..de253b8d939 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -135,6 +135,13 @@ extern tree maybe_pad_type (tree type, tree size, unsigned int align,
    the value passed against the list of choices.  */
 extern tree choices_to_gnu (tree operand, Node_Id choices);
 
+/* Given GNAT_ENTITY, an object (constant, variable, parameter, exception)
+   and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the
+   size and alignment used by Gigi.  Prefer SIZE over TYPE_SIZE if non-null.
+   BY_REF is true if the object is used by reference.  */
+extern void annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size,
+			     bool by_ref);
+
 /* Given a type T, a FIELD_DECL F, and a replacement value R, return a new
    type with all size expressions that contain F updated by replacing F
    with R.  If F is NULL_TREE, always make a new RECORD_TYPE, even if
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 76200ab34a9..5b4e5e86318 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -2328,13 +2328,18 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
 
   end_subprog_body (gnu_result, false);
 
-  /* Disconnect the trees for parameters that we made variables for from the
-     GNAT entities since these are unusable after we end the function.  */
+  /* Finally annotate the parameters and disconnect the trees for parameters
+     that we have turned into variables since they are now unusable.  */
   for (gnat_param = First_Formal_With_Extras (gnat_subprog_id);
        Present (gnat_param);
        gnat_param = Next_Formal_With_Extras (gnat_param))
-    if (TREE_CODE (get_gnu_tree (gnat_param)) == VAR_DECL)
-      save_gnu_tree (gnat_param, NULL_TREE, false);
+    {
+      tree gnu_param = get_gnu_tree (gnat_param);
+      annotate_object (gnat_param, TREE_TYPE (gnu_param), NULL_TREE,
+		       DECL_BY_REF_P (gnu_param));
+      if (TREE_CODE (gnu_param) == VAR_DECL)
+	save_gnu_tree (gnat_param, NULL_TREE, false);
+    }
 
   if (DECL_FUNCTION_STUB (gnu_subprog_decl))
     build_function_stub (gnu_subprog_decl, gnat_subprog_id);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 8f4d6eeb1ec..b763aa523ce 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -87,9 +87,6 @@ package body Sem_Ch13 is
    --  Attributes that do not specify a representation characteristic are
    --  operational attributes.
 
-   function Address_Aliased_Entity (N : Node_Id) return Entity_Id;
-   --  If expression N is of the form E'Address, return E
-
    procedure New_Stream_Subprogram
      (N    : Node_Id;
       Ent  : Entity_Id;
@@ -164,6 +161,9 @@ package body Sem_Ch13 is
 
       Y : Entity_Id;
       --  The entity of the object being overlaid
+
+      Off : Boolean;
+      --  Whether the address is offseted within Y
    end record;
 
    package Address_Clause_Checks is new Table.Table (
@@ -174,33 +174,6 @@ package body Sem_Ch13 is
      Table_Increment      => 200,
      Table_Name           => "Address_Clause_Checks");
 
-   ----------------------------
-   -- Address_Aliased_Entity --
-   ----------------------------
-
-   function Address_Aliased_Entity (N : Node_Id) return Entity_Id is
-   begin
-      if Nkind (N) = N_Attribute_Reference
-        and then Attribute_Name (N) = Name_Address
-      then
-         declare
-            P : Node_Id;
-
-         begin
-            P := Prefix (N);
-            while Nkind_In (P, N_Selected_Component, N_Indexed_Component) loop
-               P := Prefix (P);
-            end loop;
-
-            if Is_Entity_Name (P) then
-               return Entity (P);
-            end if;
-         end;
-      end if;
-
-      return Empty;
-   end Address_Aliased_Entity;
-
    -----------------------------------------
    -- Adjust_Record_For_Reverse_Bit_Order --
    -----------------------------------------
@@ -906,11 +879,12 @@ package body Sem_Ch13 is
               Ekind (U_Ent) = E_Constant
             then
                declare
-                  Expr  : constant Node_Id   := Expression (N);
-                  Aent  : constant Entity_Id := Address_Aliased_Entity (Expr);
-                  Ent_Y : constant Entity_Id := Find_Overlaid_Object (N);
+                  Expr  : constant Node_Id := Expression (N);
+                  O_Ent : Entity_Id;
+                  Off   : Boolean;
 
                begin
+
                   --  Exported variables cannot have an address clause,
                   --  because this cancels the effect of the pragma Export
 
@@ -918,12 +892,15 @@ package body Sem_Ch13 is
                      Error_Msg_N
                        ("cannot export object with address clause", Nam);
                      return;
+                  end if;
+
+                  Find_Overlaid_Entity (N, O_Ent, Off);
 
                   --  Overlaying controlled objects is erroneous
 
-                  elsif Present (Aent)
-                    and then (Has_Controlled_Component (Etype (Aent))
-                                or else Is_Controlled (Etype (Aent)))
+                  if Present (O_Ent)
+                    and then (Has_Controlled_Component (Etype (O_Ent))
+                                or else Is_Controlled (Etype (O_Ent)))
                   then
                      Error_Msg_N
                        ("?cannot overlay with controlled object", Expr);
@@ -934,9 +911,9 @@ package body Sem_Ch13 is
                          Reason => PE_Overlaid_Controlled_Object));
                      return;
 
-                  elsif Present (Aent)
+                  elsif Present (O_Ent)
                     and then Ekind (U_Ent) = E_Constant
-                    and then not Is_Constant_Object (Aent)
+                    and then not Is_Constant_Object (O_Ent)
                   then
                      Error_Msg_N ("constant overlays a variable?", Expr);
 
@@ -964,10 +941,15 @@ package body Sem_Ch13 is
                   --  Here we are checking for explicit overlap of one variable
                   --  by another, and if we find this then mark the overlapped
                   --  variable as also being volatile to prevent unwanted
-                  --  optimizations.
+                  --  optimizations. This is a significant pessimization so
+                  --  avoid it when there is an offset, i.e. when the object
+                  --  is composite; they cannot be optimized easily anyway.
 
-                  if Present (Ent_Y) then
-                     Set_Treat_As_Volatile (Ent_Y);
+                  if Present (O_Ent)
+                    and then Is_Object (O_Ent)
+                    and then not Off
+                  then
+                     Set_Treat_As_Volatile (O_Ent);
                   end if;
 
                   --  Legality checks on the address clause for initialized
@@ -1015,53 +997,42 @@ package body Sem_Ch13 is
                   --  the variable, it is somewhere else.
 
                   Kill_Size_Check_Code (U_Ent);
-               end;
-
-               --  If the address clause is of the form:
-
-               --    for Y'Address use X'Address
 
-               --  or
+                  --  If the address clause is of the form:
 
-               --    Const : constant Address := X'Address;
-               --    ...
-               --    for Y'Address use Const;
+                  --    for Y'Address use X'Address
 
-               --  then we make an entry in the table for checking the size and
-               --  alignment of the overlaying variable. We defer this check
-               --  till after code generation to take full advantage of the
-               --  annotation done by the back end. This entry is only made if
-               --  we have not already posted a warning about size/alignment
-               --  (some warnings of this type are posted in Checks), and if
-               --  the address clause comes from source.
+                  --  or
 
-               if Address_Clause_Overlay_Warnings
-                 and then Comes_From_Source (N)
-               then
-                  declare
-                     Ent_X : Entity_Id := Empty;
-                     Ent_Y : Entity_Id := Empty;
+                  --    Const : constant Address := X'Address;
+                  --    ...
+                  --    for Y'Address use Const;
 
-                  begin
-                     Ent_Y := Find_Overlaid_Object (N);
+                  --  then we make an entry in the table for checking the size
+                  --  and alignment of the overlaying variable. We defer this
+                  --  check till after code generation to take full advantage
+                  --  of the annotation done by the back end. This entry is
+                  --  only made if the address clause comes from source.
 
-                     if Present (Ent_Y) and then Is_Entity_Name (Name (N)) then
-                        Ent_X := Entity (Name (N));
-                        Address_Clause_Checks.Append ((N, Ent_X, Ent_Y));
+                  if Address_Clause_Overlay_Warnings
+                    and then Comes_From_Source (N)
+                    and then Present (O_Ent)
+                    and then Is_Object (O_Ent)
+                  then
+                     Address_Clause_Checks.Append ((N, U_Ent, O_Ent, Off));
 
-                        --  If variable overlays a constant view, and we are
-                        --  warning on overlays, then mark the variable as
-                        --  overlaying a constant (we will give warnings later
-                        --  if this variable is assigned).
+                     --  If variable overlays a constant view, and we are
+                     --  warning on overlays, then mark the variable as
+                     --  overlaying a constant (we will give warnings later
+                     --  if this variable is assigned).
 
-                        if Is_Constant_Object (Ent_Y)
-                          and then Ekind (Ent_X) = E_Variable
-                        then
-                           Set_Overlays_Constant (Ent_X);
-                        end if;
+                     if Is_Constant_Object (O_Ent)
+                       and then Ekind (U_Ent) = E_Variable
+                     then
+                        Set_Overlays_Constant (U_Ent);
                      end if;
-                  end;
-               end if;
+                  end if;
+               end;
 
             --  Not a valid entity for an address clause
 
@@ -4255,6 +4226,8 @@ package body Sem_Ch13 is
             ACCR : Address_Clause_Check_Record
                      renames Address_Clause_Checks.Table (J);
 
+            Expr : Node_Id;
+
             X_Alignment : Uint;
             Y_Alignment : Uint;
 
@@ -4266,35 +4239,17 @@ package body Sem_Ch13 is
 
             if not Address_Warning_Posted (ACCR.N) then
 
-               --  Get alignments. Really we should always have the alignment
-               --  of the objects properly back annotated, but right now the
-               --  back end fails to back annotate for address clauses???
+               Expr := Original_Node (Expression (ACCR.N));
 
-               if Known_Alignment (ACCR.X) then
-                  X_Alignment := Alignment (ACCR.X);
-               else
-                  X_Alignment := Alignment (Etype (ACCR.X));
-               end if;
+               --  Get alignments
 
-               if Known_Alignment (ACCR.Y) then
-                  Y_Alignment := Alignment (ACCR.Y);
-               else
-                  Y_Alignment := Alignment (Etype (ACCR.Y));
-               end if;
+               X_Alignment := Alignment (ACCR.X);
+               Y_Alignment := Alignment (ACCR.Y);
 
                --  Similarly obtain sizes
 
-               if Known_Esize (ACCR.X) then
-                  X_Size := Esize (ACCR.X);
-               else
-                  X_Size := Esize (Etype (ACCR.X));
-               end if;
-
-               if Known_Esize (ACCR.Y) then
-                  Y_Size := Esize (ACCR.Y);
-               else
-                  Y_Size := Esize (Etype (ACCR.Y));
-               end if;
+               X_Size := Esize (ACCR.X);
+               Y_Size := Esize (ACCR.Y);
 
                --  Check for large object overlaying smaller one
 
@@ -4302,8 +4257,10 @@ package body Sem_Ch13 is
                  and then X_Size > Uint_0
                  and then X_Size > Y_Size
                then
+                  Error_Msg_NE
+                    ("?& overlays smaller object", ACCR.N, ACCR.X);
                   Error_Msg_N
-                    ("?size for overlaid object is too small", ACCR.N);
+                    ("\?program execution may be erroneous", ACCR.N);
                   Error_Msg_Uint_1 := X_Size;
                   Error_Msg_NE
                     ("\?size of & is ^", ACCR.N, ACCR.X);
@@ -4311,16 +4268,23 @@ package body Sem_Ch13 is
                   Error_Msg_NE
                     ("\?size of & is ^", ACCR.N, ACCR.Y);
 
-                  --  Check for inadequate alignment. Again the defensive check
-                  --  on Y_Alignment should not be needed, but because of the
-                  --  failure in back end annotation, we can have an alignment
-                  --  of 0 here???
+               --  Check for inadequate alignment, both of the base object
+               --  and of the offset, if any.
 
-                  --  Note: we do not check alignments if we gave a size
-                  --  warning, since it would likely be redundant.
+               --  Note: we do not check the alignment if we gave a size
+               --  warning, since it would likely be redundant.
 
                elsif Y_Alignment /= Uint_0
-                 and then Y_Alignment < X_Alignment
+                 and then (Y_Alignment < X_Alignment
+                             or else (ACCR.Off
+                                        and then
+                                          Nkind (Expr) = N_Attribute_Reference
+                                        and then
+                                          Attribute_Name (Expr) = Name_Address
+                                        and then
+                                          Has_Compatible_Alignment
+                                            (ACCR.X, Prefix (Expr))
+                                             /= Known_Compatible))
                then
                   Error_Msg_NE
                     ("?specified address for& may be inconsistent "
@@ -4337,6 +4301,11 @@ package body Sem_Ch13 is
                   Error_Msg_NE
                     ("\?alignment of & is ^",
                      ACCR.N, ACCR.Y);
+                  if Y_Alignment >= X_Alignment then
+                     Error_Msg_N
+                      ("\?but offset is not multiple of alignment",
+                       ACCR.N);
+                  end if;
                end if;
             end if;
          end;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 77bf3110f43..5ff2d7c0341 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -2892,11 +2892,15 @@ package body Sem_Util is
    end Find_Corresponding_Discriminant;
 
    --------------------------
-   -- Find_Overlaid_Object --
+   -- Find_Overlaid_Entity --
    --------------------------
 
-   function Find_Overlaid_Object (N : Node_Id) return Entity_Id is
-      Expr  : Node_Id;
+   procedure Find_Overlaid_Entity
+     (N : Node_Id;
+      Ent : out Entity_Id;
+      Off : out Boolean)
+   is
+      Expr : Node_Id;
 
    begin
       --  We are looking for one of the two following forms:
@@ -2912,24 +2916,25 @@ package body Sem_Util is
       --  In the second case, the expr is either Y'Address, or recursively a
       --  constant that eventually references Y'Address.
 
+      Ent := Empty;
+      Off := False;
+
       if Nkind (N) = N_Attribute_Definition_Clause
         and then Chars (N) = Name_Address
       then
-         --  This loop checks the form of the expression for Y'Address where Y
-         --  is an object entity name. The first loop checks the original
-         --  expression in the attribute definition clause. Subsequent loops
-         --  check referenced constants.
-
          Expr := Expression (N);
+
+         --  This loop checks the form of the expression for Y'Address,
+         --  using recursion to deal with intermediate constants.
+
          loop
-            --  Check for Y'Address where Y is an object entity
+            --  Check for Y'Address
 
             if Nkind (Expr) = N_Attribute_Reference
               and then Attribute_Name (Expr) = Name_Address
-              and then Is_Entity_Name (Prefix (Expr))
-              and then Is_Object (Entity (Prefix (Expr)))
             then
-               return Entity (Prefix (Expr));
+               Expr := Prefix (Expr);
+               exit;
 
                --  Check for Const where Const is a constant entity
 
@@ -2941,13 +2946,36 @@ package body Sem_Util is
             --  Anything else does not need checking
 
             else
-               exit;
+               return;
             end if;
          end loop;
-      end if;
 
-      return Empty;
-   end Find_Overlaid_Object;
+         --  This loop checks the form of the prefix for an entity,
+         --  using recursion to deal with intermediate components.
+
+         loop
+            --  Check for Y where Y is an entity
+
+            if Is_Entity_Name (Expr) then
+               Ent := Entity (Expr);
+               return;
+
+            --  Check for components
+
+            elsif
+               Nkind_In (Expr, N_Selected_Component, N_Indexed_Component) then
+
+               Expr := Prefix (Expr);
+               Off := True;
+
+            --  Anything else does not need checking
+
+            else
+               return;
+            end if;
+         end loop;
+      end if;
+   end Find_Overlaid_Entity;
 
    -------------------------
    -- Find_Parameter_Type --
@@ -3829,16 +3857,16 @@ package body Sem_Util is
          Default : Alignment_Result) return Alignment_Result
       is
          Result : Alignment_Result := Known_Compatible;
-         --  Set to result if Problem_Prefix or Problem_Offset returns True.
-         --  Note that once a value of Known_Incompatible is set, it is sticky
-         --  and does not get changed to Unknown (the value in Result only gets
-         --  worse as we go along, never better).
+         --  Holds the current status of the result. Note that once a value of
+         --  Known_Incompatible is set, it is sticky and does not get changed
+         --  to Unknown (the value in Result only gets worse as we go along,
+         --  never better).
 
-         procedure Check_Offset (Offs : Uint);
-         --  Called when Expr is a selected or indexed component with Offs set
-         --  to resp Component_First_Bit or Component_Size. Checks that if the
-         --  offset is specified it is compatible with the object alignment
-         --  requirements. The value in Result is modified accordingly.
+         Offs : Uint := No_Uint;
+         --  Set to a factor of the offset from the base object when Expr is a
+         --  selected or indexed component, based on Component_Bit_Offset and
+         --  Component_Size respectively. A negative value is used to represent
+         --  a value which is not known at compile time.
 
          procedure Check_Prefix;
          --  Checks the prefix recursively in the case where the expression
@@ -3849,33 +3877,6 @@ package body Sem_Util is
          --  compatible, or known incompatible), then set Result to R.
 
          ------------------
-         -- Check_Offset --
-         ------------------
-
-         procedure Check_Offset (Offs : Uint) is
-         begin
-            --  Unspecified or zero offset is always OK
-
-            if Offs = No_Uint or else Offs = Uint_0 then
-               null;
-
-            --  If we do not know required alignment, any non-zero offset is
-            --  a potential problem (but certainly may be OK, so result is
-            --  unknown).
-
-            elsif Unknown_Alignment (Obj) then
-               Set_Result (Unknown);
-
-            --  If we know the required alignment, see if offset is compatible
-
-            else
-               if Offs mod (System_Storage_Unit * Alignment (Obj)) /= 0 then
-                  Set_Result (Known_Incompatible);
-               end if;
-            end if;
-         end Check_Offset;
-
-         ------------------
          -- Check_Prefix --
          ------------------
 
@@ -3940,33 +3941,55 @@ package body Sem_Util is
                Set_Result (Unknown);
             end if;
 
-            --  Check possible bad component offset and check prefix
+            --  Check prefix and component offset
 
-            Check_Offset
-              (Component_Bit_Offset (Entity (Selector_Name (Expr))));
             Check_Prefix;
+            Offs := Component_Bit_Offset (Entity (Selector_Name (Expr)));
 
          --  If Expr is an indexed component, we must make sure there is no
          --  potentially troublesome Component_Size clause and that the array
          --  is not bit-packed.
 
          elsif Nkind (Expr) = N_Indexed_Component then
+            declare
+               Typ : constant Entity_Id := Etype (Prefix (Expr));
+               Ind : constant Node_Id := First_Index (Typ);
+            begin
+               --  Bit packed array always generates unknown alignment
 
-            --  Bit packed array always generates unknown alignment
+               if Is_Bit_Packed_Array (Typ) then
+                  Set_Result (Unknown);
+               end if;
 
-            if Is_Bit_Packed_Array (Etype (Prefix (Expr))) then
-               Set_Result (Unknown);
-            end if;
+               --  Check prefix and component offset
 
-            --  Check possible bad component size and check prefix
+               Check_Prefix;
+               Offs := Component_Size (Typ);
 
-            Check_Offset (Component_Size (Etype (Prefix (Expr))));
-            Check_Prefix;
+               --  Small optimization: compute the full offset when possible
+
+               if Offs /= No_Uint
+                 and then Offs > Uint_0
+                 and then Present (Ind)
+                 and then Nkind (Ind) = N_Range
+                 and then Compile_Time_Known_Value (Low_Bound (Ind))
+                 and then Compile_Time_Known_Value (First (Expressions (Expr)))
+               then
+                  Offs := Offs * (Expr_Value (First (Expressions (Expr)))
+                                    - Expr_Value (Low_Bound ((Ind))));
+               end if;
+            end;
          end if;
 
+         --  If we have a null offset, the result is entirely determined by
+         --  the base object and has already been computed recursively.
+
+         if Offs = Uint_0 then
+            null;
+
          --  Case where we know the alignment of the object
 
-         if Known_Alignment (Obj) then
+         elsif Known_Alignment (Obj) then
             declare
                ObjA : constant Uint := Alignment (Obj);
                ExpA : Uint := No_Uint;
@@ -3981,9 +4004,16 @@ package body Sem_Util is
                --  Alignment of Obj is greater than 1, so we need to check
 
                else
-                  --  See if Expr is an object with known alignment
+                  --  If we have an offset, see if it is compatible
 
-                  if Is_Entity_Name (Expr)
+                  if Offs /= No_Uint and Offs > Uint_0 then
+                     if Offs mod (System_Storage_Unit * ObjA) /= 0 then
+                        Set_Result (Known_Incompatible);
+                     end if;
+
+                     --  See if Expr is an object with known alignment
+
+                  elsif Is_Entity_Name (Expr)
                     and then Known_Alignment (Entity (Expr))
                   then
                      ExpA := Alignment (Entity (Expr));
@@ -3995,26 +4025,29 @@ package body Sem_Util is
 
                   elsif Known_Alignment (Etype (Expr)) then
                      ExpA := Alignment (Etype (Expr));
+
+                     --  Otherwise the alignment is unknown
+
+                  else
+                     Set_Result (Default);
                   end if;
 
                   --  If we got an alignment, see if it is acceptable
 
-                  if ExpA /= No_Uint then
-                     if ExpA < ObjA then
-                        Set_Result (Known_Incompatible);
-                     end if;
+                  if ExpA /= No_Uint and then ExpA < ObjA then
+                     Set_Result (Known_Incompatible);
+                  end if;
 
-                     --  Case of Expr alignment unknown
+                  --  If Expr is not a piece of a larger object, see if size
+                  --  is given. If so, check that it is not too small for the
+                  --  required alignment.
 
-                  else
-                     Set_Result (Default);
-                  end if;
+                  if Offs /= No_Uint then
+                     null;
 
-                  --  See if size is given. If so, check that it is not too
-                  --  small for the required alignment.
-                  --  See if Expr is an object with known alignment
+                     --  See if Expr is an object with known size
 
-                  if Is_Entity_Name (Expr)
+                  elsif Is_Entity_Name (Expr)
                     and then Known_Static_Esize (Entity (Expr))
                   then
                      SizA := Esize (Entity (Expr));
@@ -4038,6 +4071,13 @@ package body Sem_Util is
                end if;
             end;
 
+         --  If we do not know required alignment, any non-zero offset is
+         --  a potential problem (but certainly may be OK, so result is
+         --  unknown).
+
+         elsif Offs /= No_Uint then
+            Set_Result (Unknown);
+
          --  If we can't find the result by direct comparison of alignment
          --  values, then there is still one case that we can determine known
          --  result, and that is when we can determine that the types are the
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index b4adabf26a9..1d836843513 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -320,12 +320,16 @@ package Sem_Util is
    --  denotes when analyzed. Subsequent uses of this id on a different
    --  type denote the discriminant at the same position in this new type.
 
-   function Find_Overlaid_Object (N : Node_Id) return Entity_Id;
-   --  The node N should be an address representation clause. This function
-   --  checks if the target expression is the address of some stand alone
-   --  object (variable or constant), and if so, returns its entity. If N is
-   --  not an address representation clause, or if it is not possible to
-   --  determine that the address is of this form, then Empty is returned.
+   procedure Find_Overlaid_Entity
+     (N : Node_Id;
+      Ent : out Entity_Id;
+      Off : out Boolean);
+   --  The node N should be an address representation clause. Determines if
+   --  the target expression is the address of an entity with an optional
+   --  offset. If so, set Ent to the entity and, if there is an offset, set
+   --  Off to True, otherwise to False. If N is not an address representation
+   --  clause, or if it is not possible to determine that the address is of
+   --  this form, then set Ent to Empty.
 
    function Find_Parameter_Type (Param : Node_Id) return Entity_Id;
    --  Return the type of formal parameter Param as determined by its