2014-01-31 Robert Dewar <dewar@adacore.com>

	* sem_ch4.adb: Minor reformatting.

2014-01-31  Robert Dewar  <dewar@adacore.com>

	* exp_ch2.adb: New calling sequence for Is_LHS.
	* frontend.adb: Add call to Process_Deferred_References.
	* lib-xref.ads, lib-xref.adb (Process_Deferred_References): New.
	(Deferred_References): New table.
	* sem_ch8.adb (Find_Direct_Name): Make deferred reference table
	entries.
	(Find_Expanded_Name): Ditto.
	* sem_res.adb: New calling sequence for Is_LHS.
	* sem_util.ads, sem_util.adb (Is_LHS): New calling sequence.
	* sem_warn.adb: Call Process_Deferred_References before issuing
	warnings.

2014-01-31  Tristan Gingold  <gingold@adacore.com>

	* exp_util.adb (Corresponding_Runtime_Package): Restrict the
	use of System_Tasking_Protected_Objects_Single_Entry.
	* exp_ch9.adb (Build_Simple_Entry_Call): Remove Mode parameter
	of Protected_Single_Entry_Call.
	(Expand_N_Timed_Entry_Call): Remove single_entry case.
	* exp_disp.adb (Make_Disp_Asynchronous_Select_Body): Remove
	single_entry case.
	(Make_Disp_Timed_Select_Body): Likewise.
	* rtsfind.ads (RE_Timed_Protected_Single_Entry_Call): Remove.
	* s-tposen.adb (Send_Program_Error, PO_Do_Or_Queue): Remove
	Self_Id parameter.
	(Wakeup_Entry_Caller): Remove Self_ID and New_State parameters.
	(Wait_For_Completion_With_Timeout): Remove.
	(Protected_Single_Entry_Call): Remove Mode parameter
	(always Simple_Call).
	(Service_Entry): Remove Self_Id constant (not used anymore).
	(Timed_Protected_Single_Entry_Call): Remove.
	* s-tposen.ads (Timed_Protected_Single_Entry_Call): Remove.
	(Protected_Single_Entry_Call): Remove Mode parameter.



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

17 files changed, 214 insertions, 334 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 84f071b4c6c..47beaed1a48 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,43 @@
+2014-01-31  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch4.adb: Minor reformatting.
+
+2014-01-31  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch2.adb: New calling sequence for Is_LHS.
+	* frontend.adb: Add call to Process_Deferred_References.
+	* lib-xref.ads, lib-xref.adb (Process_Deferred_References): New.
+	(Deferred_References): New table.
+	* sem_ch8.adb (Find_Direct_Name): Make deferred reference table
+	entries.
+	(Find_Expanded_Name): Ditto.
+	* sem_res.adb: New calling sequence for Is_LHS.
+	* sem_util.ads, sem_util.adb (Is_LHS): New calling sequence.
+	* sem_warn.adb: Call Process_Deferred_References before issuing
+	warnings.
+
+2014-01-31  Tristan Gingold  <gingold@adacore.com>
+
+	* exp_util.adb (Corresponding_Runtime_Package): Restrict the
+	use of System_Tasking_Protected_Objects_Single_Entry.
+	* exp_ch9.adb (Build_Simple_Entry_Call): Remove Mode parameter
+	of Protected_Single_Entry_Call.
+	(Expand_N_Timed_Entry_Call): Remove single_entry case.
+	* exp_disp.adb (Make_Disp_Asynchronous_Select_Body): Remove
+	single_entry case.
+	(Make_Disp_Timed_Select_Body): Likewise.
+	* rtsfind.ads (RE_Timed_Protected_Single_Entry_Call): Remove.
+	* s-tposen.adb (Send_Program_Error, PO_Do_Or_Queue): Remove
+	Self_Id parameter.
+	(Wakeup_Entry_Caller): Remove Self_ID and New_State parameters.
+	(Wait_For_Completion_With_Timeout): Remove.
+	(Protected_Single_Entry_Call): Remove Mode parameter
+	(always Simple_Call).
+	(Service_Entry): Remove Self_Id constant (not used anymore).
+	(Timed_Protected_Single_Entry_Call): Remove.
+	* s-tposen.ads (Timed_Protected_Single_Entry_Call): Remove.
+	(Protected_Single_Entry_Call): Remove Mode parameter.
+
 2014-01-29  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* einfo.adb (Get_Pragma): Handle the retrieval of pragma Refined_Post.
diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb
index af35113b7b9..de3bbbcc1da 100644
--- a/gcc/ada/exp_ch2.adb
+++ b/gcc/ada/exp_ch2.adb
@@ -380,7 +380,7 @@ package body Exp_Ch2 is
         and then Is_Scalar_Type (Etype (N))
         and then (Is_Assignable (E) or else Is_Constant_Object (E))
         and then Comes_From_Source (N)
-        and then not Is_LHS (N)
+        and then Is_LHS (N) = No
         and then not Is_Actual_Out_Parameter (N)
         and then (Nkind (Parent (N)) /= N_Attribute_Reference
                    or else Attribute_Name (Parent (N)) /= Name_Valid)
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 0557995c563..078e8369fda 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -4682,12 +4682,10 @@ package body Exp_Ch9 is
          --  family index expressions are evaluated before the entry
          --  parameters.
 
-         if Abort_Allowed
-           or else Restriction_Active (No_Entry_Queue) = False
-           or else not Is_Protected_Type (Conctyp)
-           or else Number_Entries (Conctyp) > 1
-           or else (Has_Attach_Handler (Conctyp)
-                     and then not Restricted_Profile)
+         if not Is_Protected_Type (Conctyp)
+           or else
+             Corresponding_Runtime_Package (Conctyp) =
+               System_Tasking_Protected_Objects_Entries
          then
             X := Make_Defining_Identifier (Loc, Name_uX);
 
@@ -4902,8 +4900,7 @@ package body Exp_Ch9 is
                when System_Tasking_Protected_Objects_Single_Entry =>
                   --     Protected_Single_Entry_Call (
                   --       Object => po._object'Access,
-                  --       Uninterpreted_Data => P'Address;
-                  --       Mode => Simple_Call);
+                  --       Uninterpreted_Data => P'Address);
 
                   Call :=
                     Make_Procedure_Call_Statement (Loc,
@@ -4914,8 +4911,7 @@ package body Exp_Ch9 is
                         Make_Attribute_Reference (Loc,
                           Attribute_Name => Name_Unchecked_Access,
                           Prefix         => Parm1),
-                        Parm3,
-                        New_Reference_To (RTE (RE_Simple_Call), Loc)));
+                        Parm3));
 
                when others =>
                   raise Program_Error;
@@ -12481,24 +12477,6 @@ package body Exp_Ch9 is
                           (RTE (RE_Timed_Protected_Entry_Call), Loc),
                       Parameter_Associations => Params));
 
-               when System_Tasking_Protected_Objects_Single_Entry =>
-                  Param := First (Params);
-                  while Present (Param)
-                    and then not
-                      Is_RTE (Etype (Param), RE_Protected_Entry_Index)
-                  loop
-                     Next (Param);
-                  end loop;
-
-                  Remove (Param);
-
-                  Rewrite (Call,
-                    Make_Procedure_Call_Statement (Loc,
-                      Name =>
-                        New_Reference_To
-                          (RTE (RE_Timed_Protected_Single_Entry_Call), Loc),
-                      Parameter_Associations => Params));
-
                when others =>
                   raise Program_Error;
             end case;
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index d18e32c18c4..b0660fc0290 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -2337,30 +2337,6 @@ package body Exp_Disp is
 
                           New_Reference_To (Com_Block, Loc)))); -- comm block
 
-               when System_Tasking_Protected_Objects_Single_Entry =>
-
-                  --  Generate:
-                  --    procedure Protected_Single_Entry_Call
-                  --      (Object              : Protection_Entry_Access;
-                  --       Uninterpreted_Data  : System.Address;
-                  --       Mode                : Call_Modes);
-
-                  Append_To (Stmts,
-                    Make_Procedure_Call_Statement (Loc,
-                      Name =>
-                        New_Reference_To
-                          (RTE (RE_Protected_Single_Entry_Call), Loc),
-                      Parameter_Associations =>
-                        New_List (
-                          Obj_Ref,
-
-                          Make_Attribute_Reference (Loc,
-                            Prefix         => Make_Identifier (Loc, Name_uP),
-                            Attribute_Name => Name_Address),
-
-                            New_Reference_To
-                             (RTE (RE_Asynchronous_Call), Loc))));
-
                when others =>
                   raise Program_Error;
             end case;
@@ -3569,29 +3545,6 @@ package body Exp_Disp is
                           Make_Identifier (Loc, Name_uM),   --  delay mode
                           Make_Identifier (Loc, Name_uF)))); --  status flag
 
-               when System_Tasking_Protected_Objects_Single_Entry =>
-                  --  Generate:
-
-                  --   Timed_Protected_Single_Entry_Call
-                  --     (T._object'access, P, D, M, F);
-
-                  --  where T is the protected object, P is the wrapped
-                  --  parameters, D is the delay amount, M is the delay mode, F
-                  --  is the status flag.
-
-                  Append_To (Stmts,
-                    Make_Procedure_Call_Statement (Loc,
-                      Name =>
-                        New_Reference_To
-                          (RTE (RE_Timed_Protected_Single_Entry_Call), Loc),
-                      Parameter_Associations =>
-                        New_List (
-                          Obj_Ref,
-                          Make_Identifier (Loc, Name_uP),   --  parameter block
-                          Make_Identifier (Loc, Name_uD),   --  delay
-                          Make_Identifier (Loc, Name_uM),   --  delay mode
-                          Make_Identifier (Loc, Name_uF)))); --  status flag
-
                when others =>
                   raise Program_Error;
             end case;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index c77a1cb3a7b..b2ca1418238 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1646,6 +1646,7 @@ package body Exp_Util is
          then
             if Abort_Allowed
               or else Restriction_Active (No_Entry_Queue) = False
+              or else Restriction_Active (No_Select_Statements) = False
               or else Number_Entries (Typ) > 1
               or else (Has_Attach_Handler (Typ)
                         and then not Restricted_Profile)
diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb
index e07e0cc6c7b..2ead14c09da 100644
--- a/gcc/ada/frontend.adb
+++ b/gcc/ada/frontend.adb
@@ -36,6 +36,7 @@ with Fname.UF;
 with Inline;   use Inline;
 with Lib;      use Lib;
 with Lib.Load; use Lib.Load;
+with Lib.Xref; use Lib.Xref;
 with Live;     use Live;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
@@ -392,6 +393,7 @@ begin
 
          --  Output waiting warning messages
 
+         Lib.Xref.Process_Deferred_References;
          Sem_Warn.Output_Non_Modified_In_Out_Warnings;
          Sem_Warn.Output_Unreferenced_Messages;
          Sem_Warn.Check_Unused_Withs;
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index 67739211abc..034e67af928 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -1705,8 +1705,8 @@ package body Lib.Xref is
          end loop;
       end Handle_Orphan_Type_References;
 
-      --  Now we have all the references, including those for any embedded
-      --  type references, so we can sort them, and output them.
+      --  Now we have all the references, including those for any embedded type
+      --  references, so we can sort them, and output them.
 
       Output_Refs : declare
 
@@ -2563,6 +2563,38 @@ package body Lib.Xref is
       end Output_Refs;
    end Output_References;
 
+   ---------------------------------
+   -- Process_Deferred_References --
+   ---------------------------------
+
+   procedure Process_Deferred_References is
+   begin
+      for J in Deferred_References.First .. Deferred_References.Last loop
+         declare
+            D : Deferred_Reference_Entry renames Deferred_References.Table (J);
+
+         begin
+            case Is_LHS (D.N) is
+               when Yes =>
+                  Generate_Reference (D.E, D.N, 'm');
+
+               when No =>
+                  Generate_Reference (D.E, D.N, 'r');
+
+               --  Not clear if Unknown can occur at this stage, but if it
+               --  does we will treat it as a normal reference.
+
+               when Unknown =>
+                  Generate_Reference (D.E, D.N, 'r');
+            end case;
+         end;
+      end loop;
+
+      --  Clear processed entries from table
+
+      Deferred_References.Init;
+   end Process_Deferred_References;
+
 --  Start of elaboration for Lib.Xref
 
 begin
diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads
index a0d5370d575..b8f3e55ffce 100644
--- a/gcc/ada/lib-xref.ads
+++ b/gcc/ada/lib-xref.ads
@@ -600,6 +600,39 @@ package Lib.Xref is
    --  Export at line 4, that its body is exported to C, and that the link name
    --  as given in the pragma is "here".
 
+   -------------------------
+   -- Deferred_References --
+   -------------------------
+
+   --  Normally we generate references as we go along, but as discussed in
+   --  Sem_Util.Is_LHS, and Sem_Ch8.Find_Direct_Name/Find_Selected_Component,
+   --  we have one case where that is tricky, which is when we have something
+   --  like X.A := 3, where we don't know until we know the type of X whether
+   --  this is a reference (if X is an access type, so what we really have is
+   --  X.all.A := 3) or a modification, where X is not an access type.
+
+   --  What we do in such cases is to gather nodes, where we would have liked
+   --  to call Generate_Reference but we couldn't because we didn't know enough
+   --  into this table, Then we deal with generating references later on when
+   --  we have sufficient information to do it right.
+
+   type Deferred_Reference_Entry is record
+      E : Entity_Id;
+      N : Node_Id;
+   end record;
+   --  One entry, E, N are as required for Generate_Reference call
+
+   package Deferred_References is new Table.Table (
+     Table_Component_Type => Deferred_Reference_Entry,
+     Table_Index_Type     => Int,
+     Table_Low_Bound      => 0,
+     Table_Initial        => 512,
+     Table_Increment      => 200,
+     Table_Name           => "Name_Deferred_References");
+
+   procedure Process_Deferred_References;
+   --  This procedure is called from Frontend to process these table entries.
+
    -----------------------------
    -- SPARK Xrefs Information --
    -----------------------------
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 8325bcf1fb3..5fcfb310c9d 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -1750,7 +1750,6 @@ package Rtsfind is
      RE_Exceptional_Complete_Single_Entry_Body,
      RE_Protected_Count_Entry,           -- Protected_Objects.Single_Entry
      RE_Protected_Single_Entry_Caller,   -- Protected_Objects.Single_Entry
-     RE_Timed_Protected_Single_Entry_Call,
 
      RE_Protected_Entry_Index,           -- System.Tasking.Protected_Objects
      RE_Entry_Body,                      -- System.Tasking.Protected_Objects
@@ -3062,8 +3061,6 @@ package Rtsfind is
        System_Tasking_Protected_Objects_Single_Entry,
      RE_Protected_Single_Entry_Caller    =>
        System_Tasking_Protected_Objects_Single_Entry,
-     RE_Timed_Protected_Single_Entry_Call =>
-       System_Tasking_Protected_Objects_Single_Entry,
 
      RE_Protected_Entry_Index            => System_Tasking_Protected_Objects,
      RE_Entry_Body                       => System_Tasking_Protected_Objects,
diff --git a/gcc/ada/s-tposen.adb b/gcc/ada/s-tposen.adb
index 356da5aa461..697ee9dabb1 100644
--- a/gcc/ada/s-tposen.adb
+++ b/gcc/ada/s-tposen.adb
@@ -74,9 +74,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    -- Local Subprograms --
    -----------------------
 
-   procedure Send_Program_Error
-     (Self_Id    : Task_Id;
-      Entry_Call : Entry_Call_Link);
+   procedure Send_Program_Error (Entry_Call : Entry_Call_Link);
    pragma Inline (Send_Program_Error);
    --  Raise Program_Error in the caller of the specified entry call
 
@@ -84,19 +82,12 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    -- Entry Calls Handling --
    --------------------------
 
-   procedure Wakeup_Entry_Caller
-     (Self_ID    : Task_Id;
-      Entry_Call : Entry_Call_Link;
-      New_State  : Entry_Call_State);
+   procedure Wakeup_Entry_Caller (Entry_Call : Entry_Call_Link);
    pragma Inline (Wakeup_Entry_Caller);
    --  This is called at the end of service of an entry call,
    --  to abort the caller if he is in an abortable part, and
    --  to wake up the caller if he is on Entry_Caller_Sleep.
    --  Call it holding the lock of Entry_Call.Self.
-   --
-   --  Timed_Call or Simple_Call:
-   --    The caller is waiting on Entry_Caller_Sleep, in
-   --    Wait_For_Completion, or Wait_For_Completion_With_Timeout.
 
    procedure Wait_For_Completion (Entry_Call : Entry_Call_Link);
    pragma Inline (Wait_For_Completion);
@@ -105,13 +96,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    --  queued. This waits for calls on protected entries.
    --  Call this only when holding Self_ID locked.
 
-   procedure Wait_For_Completion_With_Timeout
-     (Entry_Call  : Entry_Call_Link;
-      Wakeup_Time : Duration;
-      Mode        : Delay_Modes);
-   --  Same as Wait_For_Completion but it waits for a timeout with the value
-   --  specified in Wakeup_Time as well.
-
    procedure Check_Exception
      (Self_ID : Task_Id;
       Entry_Call : Entry_Call_Link);
@@ -122,8 +106,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    --  The caller should not be holding any locks, or there will be deadlock.
 
    procedure PO_Do_Or_Queue
-     (Self_Id    : Task_Id;
-      Object     : Protection_Entry_Access;
+     (Object     : Protection_Entry_Access;
       Entry_Call : Entry_Call_Link);
    --  This procedure executes or queues an entry call, depending
    --  on the status of the corresponding barrier. It assumes that the
@@ -157,9 +140,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    -- Send_Program_Error --
    ------------------------
 
-   procedure Send_Program_Error
-     (Self_Id    : Task_Id;
-      Entry_Call : Entry_Call_Link)
+   procedure Send_Program_Error (Entry_Call : Entry_Call_Link)
    is
       Caller : constant Task_Id := Entry_Call.Self;
    begin
@@ -170,7 +151,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
       end if;
 
       STPO.Write_Lock (Caller);
-      Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
+      Wakeup_Entry_Caller (Entry_Call);
       STPO.Unlock (Caller);
 
       if Single_Lock then
@@ -190,51 +171,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is
       Self_Id.Common.State := Runnable;
    end Wait_For_Completion;
 
-   --------------------------------------
-   -- Wait_For_Completion_With_Timeout --
-   --------------------------------------
-
-   procedure Wait_For_Completion_With_Timeout
-     (Entry_Call  : Entry_Call_Link;
-      Wakeup_Time : Duration;
-      Mode        : Delay_Modes)
-   is
-      Self_Id  : constant Task_Id := Entry_Call.Self;
-      Timedout : Boolean;
-
-      Yielded  : Boolean;
-      pragma Unreferenced (Yielded);
-
-      use type Ada.Exceptions.Exception_Id;
-
-   begin
-      --  This procedure waits for the entry call to be served, with a timeout.
-      --  It tries to cancel the call if the timeout expires before the call is
-      --  served.
-
-      --  If we wake up from the timed sleep operation here, it may be for the
-      --  following possible reasons:
-
-      --  1) The entry call is done being served.
-      --  2) The timeout has expired (Timedout = True)
-
-      --  Once the timeout has expired we may need to continue to wait if the
-      --  call is already being serviced. In that case, we want to go back to
-      --  sleep, but without any timeout. The variable Timedout is used to
-      --  control this. If the Timedout flag is set, we do not need to Sleep
-      --  with a timeout. We just sleep until we get a wakeup for some status
-      --  change.
-
-      pragma Assert (Entry_Call.Mode = Timed_Call);
-      Self_Id.Common.State := Entry_Caller_Sleep;
-
-      STPO.Timed_Sleep
-        (Self_Id, Wakeup_Time, Mode, Entry_Caller_Sleep, Timedout, Yielded);
-
-      Entry_Call.State := (if Timedout then Cancelled else Done);
-      Self_Id.Common.State := Runnable;
-   end Wait_For_Completion_With_Timeout;
-
    -------------------------
    -- Wakeup_Entry_Caller --
    -------------------------
@@ -246,31 +182,18 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    --  (This enforces the rule that a task must be off-queue if its state is
    --  Done or Cancelled.) Call it holding the lock of Entry_Call.Self.
 
-   --  Timed_Call or Simple_Call:
-   --    The caller is waiting on Entry_Caller_Sleep, in
-   --    Wait_For_Completion, or Wait_For_Completion_With_Timeout.
-
-   --  Conditional_Call:
-   --    The caller might be in Wait_For_Completion,
-   --    waiting for a rendezvous (possibly requeued without abort)
-   --    to complete.
+   --  The caller is waiting on Entry_Caller_Sleep, in Wait_For_Completion.
 
    procedure Wakeup_Entry_Caller
-     (Self_ID    : Task_Id;
-      Entry_Call : Entry_Call_Link;
-      New_State  : Entry_Call_State)
+     (Entry_Call : Entry_Call_Link)
    is
-      pragma Warnings (Off, Self_ID);
-
       Caller : constant Task_Id := Entry_Call.Self;
-
    begin
-      pragma Assert (New_State = Done or else New_State = Cancelled);
       pragma Assert
         (Caller.Common.State /= Terminated and then
          Caller.Common.State /= Unactivated);
 
-      Entry_Call.State := New_State;
+      Entry_Call.State := Done;
       STPO.Wakeup (Caller, Entry_Caller_Sleep);
    end Wakeup_Entry_Caller;
 
@@ -338,8 +261,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    --------------------
 
    procedure PO_Do_Or_Queue
-     (Self_Id    : Task_Id;
-      Object     : Protection_Entry_Access;
+     (Object     : Protection_Entry_Access;
       Entry_Call : Entry_Call_Link)
    is
       Barrier_Value : Boolean;
@@ -356,7 +278,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
             --  This violates the No_Entry_Queue restriction, send
             --  Program_Error to the caller.
 
-            Send_Program_Error (Self_Id, Entry_Call);
+            Send_Program_Error (Entry_Call);
             return;
          end if;
 
@@ -370,45 +292,32 @@ package body System.Tasking.Protected_Objects.Single_Entry is
          end if;
 
          STPO.Write_Lock (Entry_Call.Self);
-         Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
+         Wakeup_Entry_Caller (Entry_Call);
          STPO.Unlock (Entry_Call.Self);
 
          if Single_Lock then
             STPO.Unlock_RTS;
          end if;
 
-      elsif Entry_Call.Mode /= Conditional_Call then
+      else
+         pragma Assert (Entry_Call.Mode = Simple_Call);
+
          if Object.Entry_Queue /= null then
 
             --  This violates the No_Entry_Queue restriction, send
             --  Program_Error to the caller.
 
-            Send_Program_Error (Self_Id, Entry_Call);
+            Send_Program_Error (Entry_Call);
             return;
          else
             Object.Entry_Queue := Entry_Call;
          end if;
 
-      else
-         --  Conditional_Call
-
-         if Single_Lock then
-            STPO.Lock_RTS;
-         end if;
-
-         STPO.Write_Lock (Entry_Call.Self);
-         Wakeup_Entry_Caller (Self_Id, Entry_Call, Cancelled);
-         STPO.Unlock (Entry_Call.Self);
-
-         if Single_Lock then
-            STPO.Unlock_RTS;
-         end if;
       end if;
 
    exception
       when others =>
-         Send_Program_Error
-           (Self_Id, Entry_Call);
+         Send_Program_Error (Entry_Call);
    end PO_Do_Or_Queue;
 
    ----------------------------
@@ -430,8 +339,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
 
    procedure Protected_Single_Entry_Call
      (Object             : Protection_Entry_Access;
-      Uninterpreted_Data : System.Address;
-      Mode               : Call_Modes)
+      Uninterpreted_Data : System.Address)
    is
       Self_Id    : constant Task_Id := STPO.Self;
       Entry_Call : Entry_Call_Record renames Self_Id.Entry_Calls (1);
@@ -448,12 +356,12 @@ package body System.Tasking.Protected_Objects.Single_Entry is
 
       Lock_Entry (Object);
 
-      Entry_Call.Mode := Mode;
+      Entry_Call.Mode := Simple_Call;
       Entry_Call.State := Now_Abortable;
       Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
       Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
 
-      PO_Do_Or_Queue (Self_Id, Object, Entry_Call'Access);
+      PO_Do_Or_Queue (Object, Entry_Call'Access);
       Unlock_Entry (Object);
 
       --  The call is either `Done' or not. It cannot be cancelled since there
@@ -493,7 +401,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    -------------------
 
    procedure Service_Entry (Object : Protection_Entry_Access) is
-      Self_Id    : constant Task_Id := STPO.Self;
       Entry_Call : constant Entry_Call_Link := Object.Entry_Queue;
       Caller     : Task_Id;
 
@@ -507,7 +414,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
 
             --  Violation of No_Entry_Queue restriction, raise exception
 
-            Send_Program_Error (Self_Id, Entry_Call);
+            Send_Program_Error (Entry_Call);
             Unlock_Entry (Object);
             return;
          end if;
@@ -524,7 +431,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
          end if;
 
          STPO.Write_Lock (Caller);
-         Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
+         Wakeup_Entry_Caller (Entry_Call);
          STPO.Unlock (Caller);
 
          if Single_Lock then
@@ -539,79 +446,10 @@ package body System.Tasking.Protected_Objects.Single_Entry is
 
    exception
       when others =>
-         Send_Program_Error (Self_Id, Entry_Call);
+         Send_Program_Error (Entry_Call);
          Unlock_Entry (Object);
    end Service_Entry;
 
-   ---------------------------------------
-   -- Timed_Protected_Single_Entry_Call --
-   ---------------------------------------
-
-   --  Compiler interface only (do not call from within the RTS)
-
-   procedure Timed_Protected_Single_Entry_Call
-     (Object                : Protection_Entry_Access;
-      Uninterpreted_Data    : System.Address;
-      Timeout               : Duration;
-      Mode                  : Delay_Modes;
-      Entry_Call_Successful : out Boolean)
-   is
-      Self_Id           : constant Task_Id  := STPO.Self;
-      Entry_Call        : Entry_Call_Record renames Self_Id.Entry_Calls (1);
-
-   begin
-      --  If pragma Detect_Blocking is active then Program_Error must be
-      --  raised if this potentially blocking operation is called from a
-      --  protected action.
-
-      if Detect_Blocking
-        and then Self_Id.Common.Protected_Action_Nesting > 0
-      then
-         raise Program_Error with "potentially blocking operation";
-      end if;
-
-      Lock (Object.Common'Access);
-
-      Entry_Call.Mode := Timed_Call;
-      Entry_Call.State := Now_Abortable;
-      Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
-      Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
-
-      PO_Do_Or_Queue (Self_Id, Object, Entry_Call'Access);
-      Unlock_Entry (Object);
-
-      --  Try to avoid waiting for completed calls.
-      --  The call is either `Done' or not. It cannot be cancelled since there
-      --  is no ATC construct and the timed wait has not started yet.
-
-      pragma Assert (Entry_Call.State /= Cancelled);
-
-      if Entry_Call.State = Done then
-         Check_Exception (Self_Id, Entry_Call'Access);
-         Entry_Call_Successful := True;
-         return;
-      end if;
-
-      if Single_Lock then
-         STPO.Lock_RTS;
-      else
-         STPO.Write_Lock (Self_Id);
-      end if;
-
-      Wait_For_Completion_With_Timeout (Entry_Call'Access, Timeout, Mode);
-
-      if Single_Lock then
-         STPO.Unlock_RTS;
-      else
-         STPO.Unlock (Self_Id);
-      end if;
-
-      pragma Assert (Entry_Call.State >= Done);
-
-      Check_Exception (Self_Id, Entry_Call'Access);
-      Entry_Call_Successful := Entry_Call.State = Done;
-   end Timed_Protected_Single_Entry_Call;
-
    ------------------
    -- Unlock_Entry --
    ------------------
diff --git a/gcc/ada/s-tposen.ads b/gcc/ada/s-tposen.ads
index 6cfd3de537d..b2713bd3282 100644
--- a/gcc/ada/s-tposen.ads
+++ b/gcc/ada/s-tposen.ads
@@ -225,8 +225,7 @@ package System.Tasking.Protected_Objects.Single_Entry is
 
    procedure Protected_Single_Entry_Call
      (Object              : Protection_Entry_Access;
-      Uninterpreted_Data  : System.Address;
-      Mode                : Call_Modes);
+      Uninterpreted_Data  : System.Address);
    --  Make a protected entry call to the specified object
    --
    --  Pend a protected entry call on the protected object represented by
@@ -237,18 +236,6 @@ package System.Tasking.Protected_Objects.Single_Entry is
    --      This will be returned by Next_Entry_Call when this call is serviced.
    --      It can be used by the compiler to pass information between the
    --      caller and the server, in particular entry parameters.
-   --
-   --    Mode
-   --      The kind of call to be pended
-
-   procedure Timed_Protected_Single_Entry_Call
-     (Object                : Protection_Entry_Access;
-      Uninterpreted_Data    : System.Address;
-      Timeout               : Duration;
-      Mode                  : Delay_Modes;
-      Entry_Call_Successful : out Boolean);
-   --  Same as the Protected_Entry_Call but with time-out specified.
-   --  This routine is used to implement timed entry calls.
 
    procedure Exceptional_Complete_Single_Entry_Body
      (Object : Protection_Entry_Access;
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index abcec64c973..abda180b7f3 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -5890,16 +5890,15 @@ package body Sem_Ch4 is
          --  correct. If an operand is universal it is compatible with any
          --  numeric type.
 
-         --  In Ada 2005, the equality on anonymous access types is declared
-         --  in Standard, and is always visible.
-         --  In an instance, the type may have been immediately visible.
-         --  Either the types are compatible, or one operand is universal
-         --  (numeric or null).
-
          elsif In_Open_Scopes (Scope (Bas))
            or else Is_Potentially_Use_Visible (Bas)
            or else In_Use (Bas)
            or else (In_Use (Scope (Bas)) and then not Is_Hidden (Bas))
+
+            --  In an instance, the type may have been immediately visible.
+            --  Either the types are compatible, or one operand is universal
+            --  (numeric or null).
+
            or else (In_Instance
                      and then
                        (First_Subtype (T1) = First_Subtype (Etype (R))
@@ -5907,6 +5906,10 @@ package body Sem_Ch4 is
                          or else
                            (Is_Numeric_Type (T1)
                              and then Is_Universal_Numeric_Type (Etype (R)))))
+
+           --  In Ada 2005, the equality on anonymous access types is declared
+           --  in Standard, and is always visible.
+
            or else Ekind (T1) = E_Anonymous_Access_Type
          then
             null;
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 8a77e4861d6..0868e01ab79 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -5152,29 +5152,29 @@ package body Sem_Ch8 is
 
             --  Normal case, not a label: generate reference
 
-            --    ??? It is too early to generate a reference here even if the
-            --    entity is unambiguous, because the tree is not sufficiently
-            --    typed at this point for Generate_Reference to determine
-            --    whether this reference modifies the denoted object (because
-            --    implicit dereferences cannot be identified prior to full type
-            --    resolution).
+            else
+               if not Is_Actual_Parameter then
 
-            --    The Is_Actual_Parameter routine takes care of one of these
-            --    cases but there are others probably ???
+                  --  Package or generic package is always a simple reference
 
-            --    If the entity is the LHS of an assignment, and is a variable
-            --    (rather than a package prefix), we can mark it as a
-            --    modification right away, to avoid duplicate references.
+                  if Ekind_In (E, E_Package, E_Generic_Package) then
+                     Generate_Reference (E, N, 'r');
+
+                  --  Else see if we have a left hand side
 
-            else
-               if not Is_Actual_Parameter then
-                  if Is_LHS (N)
-                    and then Ekind (E) /= E_Package
-                    and then Ekind (E) /= E_Generic_Package
-                  then
-                     Generate_Reference (E, N, 'm');
                   else
-                     Generate_Reference (E, N);
+                     case Is_LHS (N) is
+                        when Yes =>
+                           Generate_Reference (E, N, 'm');
+
+                        when No =>
+                           Generate_Reference (E, N, 'r');
+
+                        --  If we don't know now, generate reference later
+
+                     when Unknown =>
+                        Deferred_References.Append ((E, N));
+                     end case;
                   end if;
                end if;
 
@@ -5655,26 +5655,32 @@ package body Sem_Ch8 is
 
       Change_Selected_Component_To_Expanded_Name (N);
 
+      --  Set appropriate type
+
+      if Is_Type (Id) then
+         Set_Etype (N, Id);
+      else
+         Set_Etype (N, Get_Full_View (Etype (Id)));
+      end if;
+
       --  Do style check and generate reference, but skip both steps if this
       --  entity has homonyms, since we may not have the right homonym set yet.
       --  The proper homonym will be set during the resolve phase.
 
       if Has_Homonym (Id) then
          Set_Entity (N, Id);
+
       else
          Set_Entity_Or_Discriminal (N, Id);
 
-         if Is_LHS (N) then
-            Generate_Reference (Id, N, 'm');
-         else
-            Generate_Reference (Id, N);
-         end if;
-      end if;
-
-      if Is_Type (Id) then
-         Set_Etype (N, Id);
-      else
-         Set_Etype (N, Get_Full_View (Etype (Id)));
+         case Is_LHS (N) is
+            when Yes =>
+               Generate_Reference (Id, N, 'm');
+            when No =>
+               Generate_Reference (Id, N, 'r');
+            when Unknown =>
+               Deferred_References.Append ((Id, N));
+         end case;
       end if;
 
       --  Check for violation of No_Wide_Characters
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 8e08367047c..a01c20a7317 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7673,7 +7673,7 @@ package body Sem_Res is
                    or else (Is_Entity_Name (Prefix (N))
                              and then Is_Atomic (Entity (Prefix (N)))))
         and then Is_Bit_Packed_Array (Array_Type)
-        and then Is_LHS (N)
+        and then Is_LHS (N) = Yes
       then
          Error_Msg_N ("??assignment to component of packed atomic array",
                       Prefix (N));
@@ -9170,7 +9170,7 @@ package body Sem_Res is
                    or else (Is_Entity_Name (Prefix (N))
                              and then Is_Atomic (Entity (Prefix (N)))))
         and then Is_Packed (T)
-        and then Is_LHS (N)
+        and then Is_LHS (N) = Yes
       then
          Error_Msg_N
            ("??assignment to component of packed atomic record", Prefix (N));
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 85c8592959f..12704a692d2 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5587,7 +5587,8 @@ package body Sem_Util is
       --  we exclude overloaded calls, since we don't know enough to be sure
       --  of giving the right answer in this case.
 
-      if Is_Entity_Name (Name (Call))
+      if Nkind_In (Call, N_Function_Call, N_Procedure_Call_Statement)
+        and then Is_Entity_Name (Name (Call))
         and then Present (Entity (Name (Call)))
         and then Is_Overloadable (Entity (Name (Call)))
         and then not Is_Overloaded (Name (Call))
@@ -9982,14 +9983,18 @@ package body Sem_Util is
    --  We seem to have a lot of overlapping functions that do similar things
    --  (testing for left hand sides or lvalues???).
 
-   function Is_LHS (N : Node_Id) return Boolean is
+   function Is_LHS (N : Node_Id) return Is_LHS_Result is
       P : constant Node_Id := Parent (N);
 
    begin
       --  Return True if we are the left hand side of an assignment statement
 
       if Nkind (P) = N_Assignment_Statement then
-         return Name (P) = N;
+         if Name (P) = N then
+            return Yes;
+         else
+            return No;
+         end if;
 
       --  Case of prefix of indexed or selected component or slice
 
@@ -10002,23 +10007,16 @@ package body Sem_Util is
          --  what we really have is N.all.Q (or N.all(Q .. R)). In either
          --  case this makes N.all a left hand side but not N itself.
 
-         --  Here follows a worrisome kludge. If Etype (N) is not set, which
-         --  for sure happens in the call from Find_Direct_Name, that means we
-         --  don't know if N is of an access type, so we can't give an accurate
-         --  answer. For now, we assume we do not have an access type, which
-         --  means for example that P.Q.R := X will look like a modification
-         --  of P, even if P.Q eventually turns out to be an access type. The
-         --  consequence is at least that in some cases we incorrectly identify
-         --  a reference as a modification. It is not clear if there are any
-         --  other bad consequences. ???
+         --  If we don't know the type yet, this is the case where we return
+         --  Unknown, since the answer depends on the type which is unknown.
 
          if No (Etype (N)) then
-            return False;
+            return Unknown;
 
          --  We have an Etype set, so we can check it
 
          elsif Is_Access_Type (Etype (N)) then
-            return False;
+            return No;
 
          --  OK, not access type case, so just test whole expression
 
@@ -10029,7 +10027,7 @@ package body Sem_Util is
       --  All other cases are not left hand sides
 
       else
-         return False;
+         return No;
       end if;
    end Is_LHS;
 
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 5d32cfa64fb..0e26161fe21 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1164,8 +1164,15 @@ package Sem_Util is
    --  AI05-0139-2: Check whether Typ is one of the predefined interfaces in
    --  Ada.Iterator_Interfaces, or it is derived from one.
 
-   function Is_LHS (N : Node_Id) return Boolean;
-   --  Returns True iff N is used as Name in an assignment statement
+   type Is_LHS_Result is (Yes, No, Unknown);
+   function Is_LHS (N : Node_Id) return Is_LHS_Result;
+   --  Returns Yes if N is definitely used as Name in an assignment statement.
+   --  Returns No if N is definitely NOT used as a Name in an assignment
+   --  statement. Returns Unknown if we can't tell at this stage (happens in
+   --  the case where we don't know the type of N yet, and we have something
+   --  like N.A := 3, where this counts as N being used on the left side of
+   --  an assignment only if N is not an access type. If it is an access type
+   --  then it is N.all.A that is assigned, not N.
 
    function Is_Library_Level_Entity (E : Entity_Id) return Boolean;
    --  A library-level declaration is one that is accessible from Standard,
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 3c12676c52d..cca8c06ce71 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -30,6 +30,7 @@ with Errout;   use Errout;
 with Exp_Code; use Exp_Code;
 with Fname;    use Fname;
 with Lib;      use Lib;
+with Lib.Xref; use Lib.Xref;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Opt;      use Opt;
@@ -998,6 +999,8 @@ package body Sem_Warn is
    --  Start of processing for Check_References
 
    begin
+      Process_Deferred_References;
+
       --  No messages if warnings are suppressed, or if we have detected any
       --  real errors so far (this last check avoids junk messages resulting
       --  from errors, e.g. a subunit that is not loaded).
@@ -2566,6 +2569,8 @@ package body Sem_Warn is
          return;
       end if;
 
+      Process_Deferred_References;
+
       --  Flag any unused with clauses. For a subunit, check only the units
       --  in its context, not those of the parent, which may be needed by other
       --  subunits.  We will get the full warnings when we compile the parent,