[Ada] A task not executing an entry call consumes an Entry_Call slot

This patch resolves the issue where the ATC Level of a task's first
Entry_Call slot corresponds to a task not currently making an entry
call. Consequently, the first slot is never used to record an entry
call. To resolve this, the ATC Level of a such a task is now one less
than the first index of the Entry_Call array (and as result, the ATC
level corresponding to a completed task is now two less than the first
index of this array).

To aid the maintainability of code using ATC levels new constants are
introduced to represent key ATC nesting levels and comments are
introduce for the ATC level definitions.

As a result of this change, the GNAT Extended Ravenscar Profile now
works with the full runtime. The restricted runtime had assumed that the
first Entry_Call slot would be the only slot used for entry calls and
would only initialise this slot (and
System.Tasking.Protected_Objects.Single_Entry was coded this way).
However, Extended Ravenscar uses the native implementation of
System.Tasking.Protected_Objects where this assumption doesn't hold
until the implementation of this patch. Aside from enabling an extra
nested level, this is main functional change of this patch.

The following should compile and execute quietly:

gprbuild -q main.adb
./main

-- main.adb

pragma Profile (GNAT_Extended_Ravenscar);
pragma Partition_Elaboration_Policy (Sequential);

with Tasks;
with GNAT.OS_Lib;
with Ada.Synchronous_Task_Control;

procedure Main is
   pragma Priority (30);
begin
   Ada.Synchronous_Task_Control.Suspend_Until_True (Tasks.A_SO);
   Ada.Synchronous_Task_Control.Suspend_Until_True (Tasks.B_SO);

   GNAT.OS_Lib.OS_Exit (0);
end Main;

-- tasks.ads

with Ada.Synchronous_Task_Control;

package Tasks is
   A_SO : Ada.Synchronous_Task_Control.Suspension_Object;
   B_SO : Ada.Synchronous_Task_Control.Suspension_Object;

   task A with Priority => 25;
   task B with Priority => 20;
end Tasks;

--  tasks.adb

with Obj;

package body Tasks is

   task body A is
   begin
      for J in 1 .. 5 loop
         Obj.PO.Wait;
      end loop;
      Ada.Synchronous_Task_Control.Set_True (Tasks.A_SO);
   end A;

   task body B is
   begin
      for J in 1 .. 5 loop
         Obj.PO.Put;
      end loop;
      Ada.Synchronous_Task_Control.Set_True (Tasks.B_SO);
   end B;
end Tasks;

-- obj.ads

package Obj is
   protected type PT is
      pragma Priority (30);
      entry Put;
      entry Wait;
   private
      Wait_Ready : Boolean := False;
      Put_Ready  : Boolean := True;
   end PT;

   PO : PT;
end Obj;

-- obj.adb

package body Obj is
   protected body PT is
      entry Put when Put_Ready is
      begin
         Wait_Ready := True;
         Put_Ready  := False;
      end Put;

      entry Wait when Wait_Ready is
      begin
         Wait_Ready := False;
         Put_Ready  := True;
      end Wait;
   end PT;
end Obj;

2018-12-03  Patrick Bernardi  <bernardi@adacore.com>

gcc/ada/

	* libgnarl/s-taskin.ads (ATC_Level_Base): Redefine to span from
	-1 to Max_ATC_Nesting so that 0 represents no ATC nesting and -1
	represented a completed task. To increase readability, new
	constants are introduced to represent key ATC nesting levels.
	Consequently, Level_No_Pending_Abort replaces
	ATC_Level_Infinity.  ATC_Level related definitions now
	documented.
	(Ada_Task_Control_Block): The default initialization of
	components ATC_Nesting_Level and Pending_ATC_Level now use new
	ATC_Level_Base constants.  Comments improved
	* libgnarl/s-taskin.adb (Initialize): Improve the initialisation
	of the first element of the Entry_Calls array to facilitate
	better maintenance.
	* libgnarl/s-taasde.ads: Update comment.
	* libgnarl/s-taasde.adb, libgnarl/s-taenca.adb,
	libgnarl/s-tasren.adb, libgnarl/s-tassta.adb,
	libgnarl/s-tasuti.ads, libgnarl/s-tasuti.adb: Use new
	ATC_Level_Base constants.
	* libgnarl/s-tarest.adb (Create_Restricted_Task): Improve the
	initialisation of the first element of the task's Entry_Calls
	array to facilitate better maintenance.
	* libgnarl/s-tasini.ads (Locked_Abort_To_Level): Update
	signature to accept ATC_Level_Base.
	* libgnarl/s-tasini.adb (Locked_Abort_To_Level): Update
	signature to accept ATC_Level_Base.  Use new ATC_Level_Base
	constants and only modify the aborting task's Entry_Calls array
	if any entry call is happening.
	* libgnarl/s-tposen.adb (Protected_Single_Entry_Call): Reference
	the first element of the task's Entry_Calls array via 'First
	attribute to facilitate better maintenance.

From-SVN: r266752

14 files changed, 135 insertions, 52 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 49bf8c2..dae6574 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,36 @@
+2018-12-03  Patrick Bernardi  <bernardi@adacore.com>
+
+	* libgnarl/s-taskin.ads (ATC_Level_Base): Redefine to span from
+	-1 to Max_ATC_Nesting so that 0 represents no ATC nesting and -1
+	represented a completed task. To increase readability, new
+	constants are introduced to represent key ATC nesting levels.
+	Consequently, Level_No_Pending_Abort replaces
+	ATC_Level_Infinity.  ATC_Level related definitions now
+	documented.
+	(Ada_Task_Control_Block): The default initialization of
+	components ATC_Nesting_Level and Pending_ATC_Level now use new
+	ATC_Level_Base constants.  Comments improved
+	* libgnarl/s-taskin.adb (Initialize): Improve the initialisation
+	of the first element of the Entry_Calls array to facilitate
+	better maintenance.
+	* libgnarl/s-taasde.ads: Update comment.
+	* libgnarl/s-taasde.adb, libgnarl/s-taenca.adb,
+	libgnarl/s-tasren.adb, libgnarl/s-tassta.adb,
+	libgnarl/s-tasuti.ads, libgnarl/s-tasuti.adb: Use new
+	ATC_Level_Base constants.
+	* libgnarl/s-tarest.adb (Create_Restricted_Task): Improve the
+	initialisation of the first element of the task's Entry_Calls
+	array to facilitate better maintenance.
+	* libgnarl/s-tasini.ads (Locked_Abort_To_Level): Update
+	signature to accept ATC_Level_Base.
+	* libgnarl/s-tasini.adb (Locked_Abort_To_Level): Update
+	signature to accept ATC_Level_Base.  Use new ATC_Level_Base
+	constants and only modify the aborting task's Entry_Calls array
+	if any entry call is happening.
+	* libgnarl/s-tposen.adb (Protected_Single_Entry_Call): Reference
+	the first element of the task's Entry_Calls array via 'First
+	attribute to facilitate better maintenance.
+
 2018-12-03  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* einfo.adb (Write_Entity_Info): Don't take Scope of Standard
diff --git a/gcc/ada/libgnarl/s-taasde.adb b/gcc/ada/libgnarl/s-taasde.adb
index 78f5b0f..4f5b3e4 100644
--- a/gcc/ada/libgnarl/s-taasde.adb
+++ b/gcc/ada/libgnarl/s-taasde.adb
@@ -96,6 +96,7 @@ package body System.Tasking.Async_Delays is
    --  for an async. select statement with delay statement as trigger. The
    --  effect should be to remove the delay from the timer queue, and exit one
    --  ATC nesting level.
+
    --  The usage and logic are similar to Cancel_Protected_Entry_Call, but
    --  simplified because this is not a true entry call.
 
@@ -104,18 +105,17 @@ package body System.Tasking.Async_Delays is
       Dsucc : Delay_Block_Access;
 
    begin
-      --  Note that we mark the delay as being cancelled
-      --  using a level value that is reserved.
-
-      --  make this operation idempotent
+      --  A delay block level of Level_No_Pending_Abort indicates the delay
+      --  has been cancelled. If the delay has already been canceled, there is
+      --  nothing more to be done.
 
-      if D.Level = ATC_Level_Infinity then
+      if D.Level = Level_No_Pending_Abort then
          return;
       end if;
 
-      D.Level := ATC_Level_Infinity;
+      D.Level := Level_No_Pending_Abort;
 
-      --  remove self from timer queue
+      --  Remove self from timer queue
 
       STI.Defer_Abort_Nestable (D.Self_Id);
 
diff --git a/gcc/ada/libgnarl/s-taasde.ads b/gcc/ada/libgnarl/s-taasde.ads
index 5c78da8..22e1ca0 100644
--- a/gcc/ada/libgnarl/s-taasde.ads
+++ b/gcc/ada/libgnarl/s-taasde.ads
@@ -120,8 +120,8 @@ private
       Level : ATC_Level_Base;
       --  Normally Level is the ATC nesting level of the asynchronous select
       --  statement to which this delay belongs, but after a call has been
-      --  dequeued we set it to ATC_Level_Infinity so that the Cancel operation
-      --  can detect repeated calls, and act idempotently.
+      --  dequeued we set it to Level_No_Pending_Abort so that the Cancel
+      --  operation can detect repeated calls, and act idempotently.
 
       Resume_Time : Duration;
       --  The absolute wake up time, represented as Duration
diff --git a/gcc/ada/libgnarl/s-taenca.adb b/gcc/ada/libgnarl/s-taenca.adb
index 05b77b5..965bd1d 100644
--- a/gcc/ada/libgnarl/s-taenca.adb
+++ b/gcc/ada/libgnarl/s-taenca.adb
@@ -615,7 +615,7 @@ package body System.Tasking.Entry_Calls is
       Call    : Entry_Call_Link)
    is
    begin
-      pragma Assert (Self_ID.ATC_Nesting_Level > 0);
+      pragma Assert (Self_ID.ATC_Nesting_Level > Level_No_ATC_Occuring);
       pragma Assert (Call.Mode = Asynchronous_Call);
 
       STPO.Write_Lock (Self_ID);
diff --git a/gcc/ada/libgnarl/s-tarest.adb b/gcc/ada/libgnarl/s-tarest.adb
index b07e686..1966a91 100644
--- a/gcc/ada/libgnarl/s-tarest.adb
+++ b/gcc/ada/libgnarl/s-tarest.adb
@@ -562,7 +562,16 @@ package body System.Tasking.Restricted.Stages is
          raise Program_Error;
       end if;
 
-      Created_Task.Entry_Calls (1).Self := Created_Task;
+      --  Only the first element of the Entry_Calls array is used when the
+      --  Ravenscar Profile is active as no asynchronous transfer of control
+      --  is allowed.
+
+      Created_Task.Entry_Calls (Created_Task.Entry_Calls'First) :=
+        (Self   => Created_Task,
+         Level  => Created_Task.Entry_Calls'First,
+         others => <>);
+
+      --  Set task name
 
       Len :=
         Integer'Min (Created_Task.Common.Task_Image'Length, Task_Image'Length);
diff --git a/gcc/ada/libgnarl/s-tasini.adb b/gcc/ada/libgnarl/s-tasini.adb
index 3d642f4..2164c19 100644
--- a/gcc/ada/libgnarl/s-tasini.adb
+++ b/gcc/ada/libgnarl/s-tasini.adb
@@ -426,7 +426,7 @@ package body System.Tasking.Initialization is
    procedure Locked_Abort_To_Level
      (Self_ID : Task_Id;
       T       : Task_Id;
-      L       : ATC_Level)
+      L       : ATC_Level_Base)
    is
    begin
       if not T.Aborting and then T /= Self_ID then
@@ -440,11 +440,13 @@ package body System.Tasking.Initialization is
             when Activating
                | Runnable
             =>
-               --  This is needed to cancel an asynchronous protected entry
-               --  call during a requeue with abort.
+               if T.ATC_Nesting_Level > Level_No_ATC_Occuring then
+                  --  This scenario occurs when an asynchronous protected entry
+                  --  call is canceld during a requeue with abort.
 
-               T.Entry_Calls
-                 (T.ATC_Nesting_Level).Cancellation_Attempted := True;
+                  T.Entry_Calls
+                    (T.ATC_Nesting_Level).Cancellation_Attempted := True;
+               end if;
 
             when Interrupt_Server_Blocked_On_Event_Flag =>
                null;
@@ -465,6 +467,8 @@ package body System.Tasking.Initialization is
                Wakeup (T, T.Common.State);
 
             when Entry_Caller_Sleep  =>
+               pragma Assert (T.ATC_Nesting_Level > Level_No_ATC_Occuring);
+
                T.Entry_Calls
                  (T.ATC_Nesting_Level).Cancellation_Attempted := True;
                Wakeup (T, T.Common.State);
@@ -482,7 +486,7 @@ package body System.Tasking.Initialization is
          T.Pending_ATC_Level := L;
          T.Pending_Action := True;
 
-         if L = 0 then
+         if L = Level_Completed_Task then
             T.Callable := False;
          end if;
 
diff --git a/gcc/ada/libgnarl/s-tasini.ads b/gcc/ada/libgnarl/s-tasini.ads
index 21d7414..6bd865c 100644
--- a/gcc/ada/libgnarl/s-tasini.ads
+++ b/gcc/ada/libgnarl/s-tasini.ads
@@ -171,7 +171,7 @@ package System.Tasking.Initialization is
    procedure Locked_Abort_To_Level
      (Self_ID : Task_Id;
       T       : Task_Id;
-      L       : ATC_Level);
+      L       : ATC_Level_Base);
    pragma Inline (Locked_Abort_To_Level);
    --  Abort a task to a specified ATC level. Call this only with T locked
 
diff --git a/gcc/ada/libgnarl/s-taskin.adb b/gcc/ada/libgnarl/s-taskin.adb
index b35181a..d86a2b8 100644
--- a/gcc/ada/libgnarl/s-taskin.adb
+++ b/gcc/ada/libgnarl/s-taskin.adb
@@ -267,9 +267,12 @@ package body System.Tasking is
            Dispatching_Domain_Tasks (Base_CPU) + 1;
       end if;
 
-      --  Only initialize the first element since others are not relevant
-      --  in ravenscar mode. Rest of the initialization is done in Init_RTS.
+      --  The full initialization of the environment task's Entry_Calls array
+      --  is deferred to Init_RTS because only the first element of the array
+      --  is used by the restricted Ravenscar runtime.
+
+      T.Entry_Calls (T.Entry_Calls'First).Self := T;
+      T.Entry_Calls (T.Entry_Calls'First).Level := T.Entry_Calls'First;
 
-      T.Entry_Calls (1).Self := T;
    end Initialize;
 end System.Tasking;
diff --git a/gcc/ada/libgnarl/s-taskin.ads b/gcc/ada/libgnarl/s-taskin.ads
index 673d3cd..1bc33d1 100644
--- a/gcc/ada/libgnarl/s-taskin.ads
+++ b/gcc/ada/libgnarl/s-taskin.ads
@@ -565,7 +565,8 @@ package System.Tasking is
       --
       --  Protection: Self.L. Self will modify this field when Self.Accepting
       --  is False, and will not need the mutex to do so. Once a task sets
-      --  Pending_ATC_Level = 0, no other task can access this field.
+      --  Pending_ATC_Level = Level_Completed_Task, no other task can access
+      --  this field.
 
       LL : aliased Task_Primitives.Private_Data;
       --  Control block used by the underlying low-level tasking service
@@ -814,14 +815,32 @@ package System.Tasking is
    -----------------------------------
 
    Max_ATC_Nesting : constant Natural := 20;
+   --  The maximum number of nested asynchronous select statements supported
+   --  by the runtime.
 
-   subtype ATC_Level_Base is Integer range 0 .. Max_ATC_Nesting;
+   subtype ATC_Level_Base is Integer range -1 .. Max_ATC_Nesting;
+   --  Indicates the number of nested asynchronous task control statements
+   --  or entries a task is in.
 
-   ATC_Level_Infinity : constant ATC_Level_Base := ATC_Level_Base'Last;
+   Level_Completed_Task : constant ATC_Level_Base := -1;
+   --  ATC_Level of a task that has "completed". A task reaches the completed
+   --  state after an abort, exception propagation, or normal exit.
 
-   subtype ATC_Level is ATC_Level_Base range 0 .. ATC_Level_Base'Last - 1;
+   Level_No_ATC_Occuring : constant ATC_Level_Base := 0;
+   --  ATC_Level of a task not executing a entry call or an asynchronous
+   --  select statement.
 
-   subtype ATC_Level_Index is ATC_Level range 1 .. ATC_Level'Last;
+   Level_No_Pending_Abort : constant ATC_Level_Base := ATC_Level_Base'Last;
+   --  ATC_Level when there is no pending abort
+
+   subtype ATC_Level is ATC_Level_Base range
+     Level_No_ATC_Occuring .. Level_No_Pending_Abort - 1;
+   --  Nested ATC_Levels valid during the execution of a task
+
+   subtype ATC_Level_Index is ATC_Level range
+     Level_No_ATC_Occuring + 1 .. ATC_Level'Last;
+   --  ATC_Levels valid when a task is executing an entry call or asynchronous
+   --  task control statements.
 
    ----------------------------------
    -- Entry_Call_Record definition --
@@ -1082,7 +1101,7 @@ package System.Tasking is
 
       --  Beginning of counts
 
-      ATC_Nesting_Level : ATC_Level := 1;
+      ATC_Nesting_Level : ATC_Level := Level_No_ATC_Occuring;
       --  The dynamic level of ATC nesting (currently executing nested
       --  asynchronous select statements) in this task.
 
@@ -1102,13 +1121,17 @@ package System.Tasking is
 
       --  Protection: Only updated by Self; access assumed to be atomic
 
-      Pending_ATC_Level : ATC_Level_Base := ATC_Level_Infinity;
-      --  The ATC level to which this task is currently being aborted. If the
-      --  value is zero, the entire task has "completed". That may be via
-      --  abort, exception propagation, or normal exit. If the value is
-      --  ATC_Level_Infinity, the task is not being aborted to any level. If
-      --  the value is positive, the task has not completed. This should ONLY
-      --  be modified by Abort_To_Level and Exit_One_ATC_Level.
+      Pending_ATC_Level : ATC_Level_Base := Level_No_Pending_Abort;
+      --  Indicates the ATC level to which this task is currently being
+      --  aborted. Two special values exist:
+      --
+      --    * Level_Completed_Task: the task has completed.
+      --
+      --    * Level_No_Pending_Abort: the task is not being aborted to any
+      --                              level.
+      --
+      --  All other values indicate the task has not completed. This should
+      --  ONLY be modified by Abort_To_Level and Exit_One_ATC_Level.
       --
       --  Protection: Self.L
 
diff --git a/gcc/ada/libgnarl/s-tasren.adb b/gcc/ada/libgnarl/s-tasren.adb
index ce6583a..5ce200a 100644
--- a/gcc/ada/libgnarl/s-tasren.adb
+++ b/gcc/ada/libgnarl/s-tasren.adb
@@ -163,7 +163,7 @@ package body System.Tasking.Rendezvous is
       STPO.Write_Lock (Self_Id);
 
       if not Self_Id.Callable then
-         pragma Assert (Self_Id.Pending_ATC_Level = 0);
+         pragma Assert (Self_Id.Pending_ATC_Level = Level_Completed_Task);
 
          pragma Assert (Self_Id.Pending_Action);
 
@@ -205,6 +205,9 @@ package body System.Tasking.Rendezvous is
 
          if Self_Id.Common.Call /= null then
             Caller := Self_Id.Common.Call.Self;
+
+            pragma Assert (Caller.ATC_Nesting_Level > Level_No_ATC_Occuring);
+
             Uninterpreted_Data :=
               Caller.Entry_Calls (Caller.ATC_Nesting_Level).Uninterpreted_Data;
          else
@@ -247,7 +250,7 @@ package body System.Tasking.Rendezvous is
       STPO.Write_Lock (Self_Id);
 
       if not Self_Id.Callable then
-         pragma Assert (Self_Id.Pending_ATC_Level = 0);
+         pragma Assert (Self_Id.Pending_ATC_Level = Level_Completed_Task);
 
          pragma Assert (Self_Id.Pending_Action);
 
@@ -738,7 +741,7 @@ package body System.Tasking.Rendezvous is
       STPO.Write_Lock (Self_Id);
 
       if not Self_Id.Callable then
-         pragma Assert (Self_Id.Pending_ATC_Level = 0);
+         pragma Assert (Self_Id.Pending_ATC_Level = Level_Completed_Task);
 
          pragma Assert (Self_Id.Pending_Action);
 
@@ -893,7 +896,8 @@ package body System.Tasking.Rendezvous is
                --  we do not need to cancel the terminate alternative. The
                --  cleanup will be done in Complete_Master.
 
-               pragma Assert (Self_Id.Pending_ATC_Level = 0);
+               pragma Assert
+                  (Self_Id.Pending_ATC_Level = Level_Completed_Task);
                pragma Assert (Self_Id.Awake_Count = 0);
 
                STPO.Unlock (Self_Id);
@@ -1395,7 +1399,7 @@ package body System.Tasking.Rendezvous is
       STPO.Write_Lock (Self_Id);
 
       if not Self_Id.Callable then
-         pragma Assert (Self_Id.Pending_ATC_Level = 0);
+         pragma Assert (Self_Id.Pending_ATC_Level = Level_Completed_Task);
 
          pragma Assert (Self_Id.Pending_Action);
 
diff --git a/gcc/ada/libgnarl/s-tassta.adb b/gcc/ada/libgnarl/s-tassta.adb
index fe982e2..b48f238 100644
--- a/gcc/ada/libgnarl/s-tassta.adb
+++ b/gcc/ada/libgnarl/s-tassta.adb
@@ -588,7 +588,7 @@ package body System.Tasking.Stages is
       --  give up on creating this task, and simply return.
 
       if not Self_ID.Callable then
-         pragma Assert (Self_ID.Pending_ATC_Level = 0);
+         pragma Assert (Self_ID.Pending_ATC_Level = Level_Completed_Task);
          pragma Assert (Self_ID.Pending_Action);
          pragma Assert
            (Chain.T_ID = null or else Chain.T_ID.Common.State = Unactivated);
@@ -1553,7 +1553,9 @@ package body System.Tasking.Stages is
       --  for the task completion is an abort, we do not raise an exception.
       --  See RM 9.2(5).
 
-      if not Self_ID.Callable and then Self_ID.Pending_ATC_Level /= 0 then
+      if not Self_ID.Callable
+        and then Self_ID.Pending_ATC_Level /= Level_Completed_Task
+      then
          Activator.Common.Activation_Failed := True;
       end if;
 
@@ -1980,7 +1982,7 @@ package body System.Tasking.Stages is
            Self_ID.Master_Of_Task .. Self_ID.Master_Of_Task + 3);
       pragma Assert (Self_ID.Common.Wait_Count = 0);
       pragma Assert (Self_ID.Open_Accepts = null);
-      pragma Assert (Self_ID.ATC_Nesting_Level = 1);
+      pragma Assert (Self_ID.ATC_Nesting_Level = Level_No_ATC_Occuring);
 
       pragma Debug (Debug.Trace (Self_ID, "V_Complete_Task", 'C'));
 
diff --git a/gcc/ada/libgnarl/s-tasuti.adb b/gcc/ada/libgnarl/s-tasuti.adb
index 32c2c69..f3708fd 100644
--- a/gcc/ada/libgnarl/s-tasuti.adb
+++ b/gcc/ada/libgnarl/s-tasuti.adb
@@ -56,7 +56,8 @@ package body System.Tasking.Utilities is
    -- Abort_One_Task --
    --------------------
 
-   --  Similar to Locked_Abort_To_Level (Self_ID, T, 0), but:
+   --  Similar to Locked_Abort_To_Level (Self_ID, T, Level_Completed_Task),
+   --  but:
    --    (1) caller should be holding no locks except RTS_Lock when Single_Lock
    --    (2) may be called for tasks that have not yet been activated
    --    (3) always aborts whole task
@@ -72,7 +73,8 @@ package body System.Tasking.Utilities is
          Cancel_Queued_Entry_Calls (T);
 
       elsif T.Common.State /= Terminated then
-         Initialization.Locked_Abort_To_Level (Self_ID, T, 0);
+         Initialization.Locked_Abort_To_Level
+           (Self_ID, T, Level_Completed_Task);
       end if;
 
       Unlock (T);
@@ -123,11 +125,11 @@ package body System.Tasking.Utilities is
       C := All_Tasks_List;
 
       while C /= null loop
-         if C.Pending_ATC_Level > 0 then
+         if C.Pending_ATC_Level > Level_Completed_Task then
             P := C.Common.Parent;
 
             while P /= null loop
-               if P.Pending_ATC_Level = 0 then
+               if P.Pending_ATC_Level = Level_Completed_Task then
                   Abort_One_Task (Self_Id, C);
                   exit;
                end if;
@@ -204,23 +206,24 @@ package body System.Tasking.Utilities is
 
    procedure Exit_One_ATC_Level (Self_ID : Task_Id) is
    begin
+      pragma Assert (Self_ID.ATC_Nesting_Level > Level_No_ATC_Occuring);
+
       Self_ID.ATC_Nesting_Level := Self_ID.ATC_Nesting_Level - 1;
 
       pragma Debug
         (Debug.Trace (Self_ID, "EOAL: exited to ATC level: " &
          ATC_Level'Image (Self_ID.ATC_Nesting_Level), 'A'));
 
-      pragma Assert (Self_ID.ATC_Nesting_Level >= 1);
+      if Self_ID.Pending_ATC_Level < Level_No_Pending_Abort then
 
-      if Self_ID.Pending_ATC_Level < ATC_Level_Infinity then
          if Self_ID.Pending_ATC_Level = Self_ID.ATC_Nesting_Level then
-            Self_ID.Pending_ATC_Level := ATC_Level_Infinity;
+            Self_ID.Pending_ATC_Level := Level_No_Pending_Abort;
             Self_ID.Aborting := False;
          else
             --  Force the next Undefer_Abort to re-raise Abort_Signal
 
             pragma Assert
-             (Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level);
+              (Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level);
 
             if Self_ID.Aborting then
                Self_ID.ATC_Hack := True;
diff --git a/gcc/ada/libgnarl/s-tasuti.ads b/gcc/ada/libgnarl/s-tasuti.ads
index b4eff79..72d1ccc0 100644
--- a/gcc/ada/libgnarl/s-tasuti.ads
+++ b/gcc/ada/libgnarl/s-tasuti.ads
@@ -111,7 +111,8 @@ package System.Tasking.Utilities is
    --  The effect is to exit one level of ATC nesting.
 
    procedure Abort_One_Task (Self_ID : Task_Id; T : Task_Id);
-   --  Similar to Locked_Abort_To_Level (Self_ID, T, 0), but:
+   --  Similar to Locked_Abort_To_Level (Self_ID, T, Level_Completed_Task),
+   --  but:
    --    (1) caller should be holding no locks
    --    (2) may be called for tasks that have not yet been activated
    --    (3) always aborts whole task
diff --git a/gcc/ada/libgnarl/s-tposen.adb b/gcc/ada/libgnarl/s-tposen.adb
index 89319fa..bb74751 100644
--- a/gcc/ada/libgnarl/s-tposen.adb
+++ b/gcc/ada/libgnarl/s-tposen.adb
@@ -341,7 +341,8 @@ package body System.Tasking.Protected_Objects.Single_Entry is
       Uninterpreted_Data : System.Address)
    is
       Self_Id    : constant Task_Id := STPO.Self;
-      Entry_Call : Entry_Call_Record renames Self_Id.Entry_Calls (1);
+      Entry_Call : Entry_Call_Record renames
+        Self_Id.Entry_Calls (Self_Id.Entry_Calls'First);
    begin
       --  If pragma Detect_Blocking is active then Program_Error must be
       --  raised if this potentially blocking operation is called from a