2007-08-14 Arnaud Charlet <charlet@adacore.com>

	* s-tpobop.ads, s-tpobop.adb, s-tasren.ads, s-tasren.adb,
	s-taskin.ads (Requeue_With_Abort): Rename field With_Abort.
	(PO_Do_Or_Queue, Task_Do_Or_Queue, Requeue_Call): Remove With_Abort
	parameter.

	* s-tassta.adb (Task_Wrapper): Increased value of the small overflow
	guard to 12K.

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

diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads
index dad836c..e8c0653 100644 (file)
--- a/gcc/ada/s-taskin.ads
+++ b/gcc/ada/s-taskin.ads
@@ -799,9 +799,9 @@ package System.Tasking is
       --  Cancellation of the call has been attempted.
       --  Consider merging this into State???
 
-      Requeue_With_Abort : Boolean := False;
-      --  Temporary to tell caller whether requeue is with abort.
-      --  Find a better way of doing this ???
+      With_Abort : Boolean := False;
+      --  Tell caller whether the call may be aborted
+      --  ??? consider merging this with Was_Abortable state
 
       Needs_Requeue : Boolean := False;
       --  Temporary to tell acceptor of task entry call that

diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb
index d448b82..2af7365 100644 (file)
--- a/gcc/ada/s-tasren.adb
+++ b/gcc/ada/s-tasren.adb
@@ -456,6 +456,7 @@ package body System.Tasking.Rendezvous is
       Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
       Entry_Call.Called_Task := Acceptor;
       Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
+      Entry_Call.With_Abort := True;
 
       --  Note: the caller will undefer abort on return (see WARNING above)
 
@@ -463,9 +464,7 @@ package body System.Tasking.Rendezvous is
          Lock_RTS;
       end if;
 
-      if not Task_Do_Or_Queue
-        (Self_Id, Entry_Call, With_Abort => True)
-      then
+      if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
          STPO.Write_Lock (Self_Id);
          Utilities.Exit_One_ATC_Level (Self_Id);
          STPO.Unlock (Self_Id);
@@ -646,9 +645,7 @@ package body System.Tasking.Rendezvous is
                   Lock_RTS;
                end if;
 
-               if not Task_Do_Or_Queue
-                 (Self_Id, Entry_Call, Entry_Call.Requeue_With_Abort)
-               then
+               if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
                   if Single_Lock then
                      Unlock_RTS;
                   end if;
@@ -687,9 +684,7 @@ package body System.Tasking.Rendezvous is
                   end if;
 
                else
-                  POO.PO_Do_Or_Queue
-                    (Self_Id, Called_PO, Entry_Call,
-                     Entry_Call.Requeue_With_Abort);
+                  POO.PO_Do_Or_Queue (Self_Id, Called_PO, Entry_Call);
                   POO.PO_Service_Entries (Self_Id, Called_PO);
                end if;
             end if;
@@ -758,7 +753,7 @@ package body System.Tasking.Rendezvous is
       Entry_Call.E := Entry_Index (E);
       Entry_Call.Called_Task := Acceptor;
       Entry_Call.Called_PO := Null_Address;
-      Entry_Call.Requeue_With_Abort := With_Abort;
+      Entry_Call.With_Abort := With_Abort;
       Object.Call_In_Progress := null;
    end Requeue_Protected_To_Task_Entry;
 
@@ -777,7 +772,7 @@ package body System.Tasking.Rendezvous is
    begin
       Initialization.Defer_Abort (Self_Id);
       Entry_Call.Needs_Requeue := True;
-      Entry_Call.Requeue_With_Abort := With_Abort;
+      Entry_Call.With_Abort := With_Abort;
       Entry_Call.E := Entry_Index (E);
       Entry_Call.Called_Task := Acceptor;
       Initialization.Undefer_Abort (Self_Id);
@@ -1102,12 +1097,12 @@ package body System.Tasking.Rendezvous is
          Unlock_RTS;
       end if;
 
+      Initialization.Undefer_Abort (Self_Id);
+
       --  Call Yield to let other tasks get a chance to run as this is a
       --  potential dispatching point.
 
       Yield (Do_Yield => False);
-
-      Initialization.Undefer_Abort (Self_Id);
       return Return_Count;
    end Task_Count;
 
@@ -1117,8 +1112,7 @@ package body System.Tasking.Rendezvous is
 
    function Task_Do_Or_Queue
      (Self_ID    : Task_Id;
-      Entry_Call : Entry_Call_Link;
-      With_Abort : Boolean) return Boolean
+      Entry_Call : Entry_Call_Link) return Boolean
    is
       E             : constant Task_Entry_Index :=
                         Task_Entry_Index (Entry_Call.E);
@@ -1273,7 +1267,7 @@ package body System.Tasking.Rendezvous is
       --  (re)enqueue the call, if the mode permits that.
 
       if Entry_Call.Mode /= Conditional_Call
-        or else not With_Abort
+        or else not Entry_Call.With_Abort
       then
          --  Timed_Call, Simple_Call, or Asynchronous_Call
 
@@ -1283,7 +1277,8 @@ package body System.Tasking.Rendezvous is
 
          pragma Assert (Old_State < Done);
 
-         Entry_Call.State := New_State (With_Abort, Entry_Call.State);
+         Entry_Call.State :=
+           New_State (Entry_Call.With_Abort, Entry_Call.State);
 
          STPO.Unlock (Acceptor);
 
@@ -1391,14 +1386,13 @@ package body System.Tasking.Rendezvous is
          Entry_Call.Called_Task := Acceptor;
          Entry_Call.Called_PO := Null_Address;
          Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
+         Entry_Call.With_Abort := True;
 
          if Single_Lock then
             Lock_RTS;
          end if;
 
-         if not Task_Do_Or_Queue
-           (Self_Id, Entry_Call, With_Abort => True)
-         then
+         if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
             STPO.Write_Lock (Self_Id);
             Utilities.Exit_One_ATC_Level (Self_Id);
             STPO.Unlock (Self_Id);
@@ -1759,6 +1753,7 @@ package body System.Tasking.Rendezvous is
       Entry_Call.Called_Task := Acceptor;
       Entry_Call.Called_PO := Null_Address;
       Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
+      Entry_Call.With_Abort := True;
 
       --  Note: the caller will undefer abort on return (see WARNING above)
 
@@ -1766,9 +1761,7 @@ package body System.Tasking.Rendezvous is
          Lock_RTS;
       end if;
 
-      if not Task_Do_Or_Queue
-       (Self_Id, Entry_Call, With_Abort => True)
-      then
+      if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
          STPO.Write_Lock (Self_Id);
          Utilities.Exit_One_ATC_Level (Self_Id);
          STPO.Unlock (Self_Id);

diff --git a/gcc/ada/s-tasren.ads b/gcc/ada/s-tasren.ads
index 9225584..67fdc5a 100644 (file)
--- a/gcc/ada/s-tasren.ads
+++ b/gcc/ada/s-tasren.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -319,8 +319,7 @@ package System.Tasking.Rendezvous is
 
    function Task_Do_Or_Queue
      (Self_ID    : Task_Id;
-      Entry_Call : Entry_Call_Link;
-      With_Abort : Boolean) return Boolean;
+      Entry_Call : Entry_Call_Link) return Boolean;
    --  Call this only with abort deferred and holding no locks, except
    --  the global RTS lock when Single_Lock is True which must be owned.
    --  Returns False iff the call cannot be served or queued, as is the

diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 2828432..3086a69 100644 (file)
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -770,7 +770,7 @@ package body System.Tasking.Stages is
       pragma Assert (Self_ID = Environment_Task);
 
       --  Set Environment_Task'Callable to false to notify library-level tasks
-      --  that it is waiting for them (cf 5619-003).
+      --  that it is waiting for them.
 
       Self_ID.Callable := False;
 
@@ -798,8 +798,8 @@ package body System.Tasking.Stages is
          exit when Utilities.Independent_Task_Count = 0;
 
          --  We used to yield here, but this did not take into account
-         --  low priority tasks that would cause dead lock in some cases.
-         --  See 8126-020.
+         --  low priority tasks that would cause dead lock in some cases
+         --  (true FIFO scheduling).
 
          Timed_Sleep
            (Self_ID, 0.01, System.OS_Primitives.Relative,
@@ -958,16 +958,22 @@ package body System.Tasking.Stages is
       Secondary_Stack : aliased SSE.Storage_Array (1 .. Secondary_Stack_Size);
 
       pragma Warnings (Off);
+      --  Why are warnings being turned off here???
+
       Secondary_Stack_Address : System.Address := Secondary_Stack'Address;
 
-      Small_Overflow_Guard    : constant := 4 * 1024;
-      Big_Overflow_Guard      : constant := 16 * 1024;
-      Small_Stack_Limit       : constant := 64 * 1024;
+      Small_Overflow_Guard : constant := 12 * 1024;
+      --  Note: this used to be 4K, but was changed to 12K, since smaller
+      --  values resulted in segmentation faults from dynamic stack analysis.
+
+      Big_Overflow_Guard   : constant := 16 * 1024;
+      Small_Stack_Limit    : constant := 64 * 1024;
       --  ??? These three values are experimental, and seems to work on most
-      --  platforms. They still need to be analyzed further.
+      --  platforms. They still need to be analyzed further. They also need
+      --  documentation, what are they???
 
-      Size :
-        Natural := Natural (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size);
+      Size : Natural :=
+               Natural (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size);
 
       Overflow_Guard : Natural;
       --  Size of the overflow guard, used by dynamic stack usage analysis
@@ -975,7 +981,7 @@ package body System.Tasking.Stages is
       pragma Warnings (On);
       --  Address of secondary stack. In the fixed secondary stack case, this
       --  value is not modified, causing a warning, hence the bracketing with
-      --  Warnings (Off/On).
+      --  Warnings (Off/On). But why is so much *more* bracketed ???
 
       SEH_Table : aliased SSE.Storage_Array (1 .. 8);
       --  Structured Exception Registration table (2 words)
@@ -1145,8 +1151,7 @@ package body System.Tasking.Stages is
                Cause := Abnormal;
             end if;
          when others =>
-            --  ??? Using an E : others here causes CD2C11A  to fail on
-            --      DEC Unix, see 7925-005.
+            --  ??? Using an E : others here causes CD2C11A to fail on Tru64.
 
             Initialization.Defer_Abort_Nestable (Self_ID);
 
@@ -1253,7 +1258,7 @@ package body System.Tasking.Stages is
       --  Since GCC cannot allocate stack chunks efficiently without reordering
       --  some of the allocations, we have to handle this unexpected situation
       --  here. We should normally never have to call Vulnerable_Complete_Task
-      --  here. See 6602-003 for more details.
+      --  here.
 
       if Self_ID.Common.Activator /= null then
          Vulnerable_Complete_Task (Self_ID);

diff --git a/gcc/ada/s-tpobop.adb b/gcc/ada/s-tpobop.adb
index 867e51c..25208ad 100644 (file)
--- a/gcc/ada/s-tpobop.adb
+++ b/gcc/ada/s-tpobop.adb
@@ -123,8 +123,7 @@ package body System.Tasking.Protected_Objects.Operations is
    procedure Requeue_Call
      (Self_Id    : Task_Id;
       Object     : Protection_Entries_Access;
-      Entry_Call : Entry_Call_Link;
-      With_Abort : Boolean);
+      Entry_Call : Entry_Call_Link);
    --  Handle requeue of Entry_Call.
    --  In particular, queue the call if needed, or service it immediately
    --  if possible.
@@ -314,8 +313,7 @@ package body System.Tasking.Protected_Objects.Operations is
    procedure PO_Do_Or_Queue
      (Self_ID    : Task_Id;
       Object     : Protection_Entries_Access;
-      Entry_Call : Entry_Call_Link;
-      With_Abort : Boolean)
+      Entry_Call : Entry_Call_Link)
    is
       E             : constant Protected_Entry_Index :=
                         Protected_Entry_Index (Entry_Call.E);
@@ -366,11 +364,11 @@ package body System.Tasking.Protected_Objects.Operations is
             end if;
 
          else
-            Requeue_Call (Self_ID, Object, Entry_Call, With_Abort);
+            Requeue_Call (Self_ID, Object, Entry_Call);
          end if;
 
       elsif Entry_Call.Mode /= Conditional_Call
-        or else not With_Abort
+        or else not Entry_Call.With_Abort
       then
 
          if Run_Time_Restrictions.Set (Max_Entry_Queue_Length)
@@ -396,7 +394,7 @@ package body System.Tasking.Protected_Objects.Operations is
             end if;
          else
             Queuing.Enqueue (Object.Entry_Queues (E), Entry_Call);
-            Update_For_Queue_To_PO (Entry_Call, With_Abort);
+            Update_For_Queue_To_PO (Entry_Call, Entry_Call.With_Abort);
          end if;
       else
          --  Conditional_Call and With_Abort
@@ -467,8 +465,7 @@ package body System.Tasking.Protected_Objects.Operations is
          end;
 
          if Object.Call_In_Progress = null then
-            Requeue_Call
-              (Self_ID, Object, Entry_Call, Entry_Call.Requeue_With_Abort);
+            Requeue_Call (Self_ID, Object, Entry_Call);
             exit when Entry_Call.State = Cancelled;
 
          else
@@ -628,8 +625,9 @@ package body System.Tasking.Protected_Objects.Operations is
       Entry_Call.Called_PO := To_Address (Object);
       Entry_Call.Called_Task := null;
       Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
+      Entry_Call.With_Abort := True;
 
-      PO_Do_Or_Queue (Self_ID, Object, Entry_Call, With_Abort => True);
+      PO_Do_Or_Queue (Self_ID, Object, Entry_Call);
       Initially_Abortable := Entry_Call.State = Now_Abortable;
       PO_Service_Entries (Self_ID, Object);
 
@@ -712,8 +710,7 @@ package body System.Tasking.Protected_Objects.Operations is
    procedure Requeue_Call
      (Self_Id    : Task_Id;
       Object     : Protection_Entries_Access;
-      Entry_Call : Entry_Call_Link;
-      With_Abort : Boolean)
+      Entry_Call : Entry_Call_Link)
    is
       New_Object        : Protection_Entries_Access;
       Ceiling_Violation : Boolean;
@@ -731,9 +728,7 @@ package body System.Tasking.Protected_Objects.Operations is
             STPO.Lock_RTS;
          end if;
 
-         Result := Rendezvous.Task_Do_Or_Queue
-           (Self_Id, Entry_Call,
-            With_Abort => Entry_Call.Requeue_With_Abort);
+         Result := Rendezvous.Task_Do_Or_Queue (Self_Id, Entry_Call);
 
          if not Result then
             Queuing.Broadcast_Program_Error
@@ -759,7 +754,7 @@ package body System.Tasking.Protected_Objects.Operations is
                  (Self_Id, Object, Entry_Call);
 
             else
-               PO_Do_Or_Queue (Self_Id, New_Object, Entry_Call, With_Abort);
+               PO_Do_Or_Queue (Self_Id, New_Object, Entry_Call);
                PO_Service_Entries (Self_Id, New_Object);
             end if;
 
@@ -772,7 +767,7 @@ package body System.Tasking.Protected_Objects.Operations is
 
             STPO.Yield (False);
 
-            if Entry_Call.Requeue_With_Abort
+            if Entry_Call.With_Abort
               and then Entry_Call.Cancellation_Attempted
             then
                --  If this is a requeue with abort and someone tried
@@ -782,7 +777,7 @@ package body System.Tasking.Protected_Objects.Operations is
                return;
             end if;
 
-            if not With_Abort
+            if not Entry_Call.With_Abort
               or else Entry_Call.Mode /= Conditional_Call
             then
                E := Protected_Entry_Index (Entry_Call.E);
@@ -812,11 +807,11 @@ package body System.Tasking.Protected_Objects.Operations is
                else
                   Queuing.Enqueue
                     (New_Object.Entry_Queues (E), Entry_Call);
-                  Update_For_Queue_To_PO (Entry_Call, With_Abort);
+                  Update_For_Queue_To_PO (Entry_Call, Entry_Call.With_Abort);
                end if;
 
             else
-               PO_Do_Or_Queue (Self_Id, New_Object, Entry_Call, With_Abort);
+               PO_Do_Or_Queue (Self_Id, New_Object, Entry_Call);
             end if;
          end if;
       end if;
@@ -890,7 +885,7 @@ package body System.Tasking.Protected_Objects.Operations is
       Entry_Call.E := Entry_Index (E);
       Entry_Call.Called_PO := To_Address (New_Object);
       Entry_Call.Called_Task := null;
-      Entry_Call.Requeue_With_Abort := With_Abort;
+      Entry_Call.With_Abort := With_Abort;
       Object.Call_In_Progress := null;
    end Requeue_Protected_Entry;
 
@@ -935,7 +930,7 @@ package body System.Tasking.Protected_Objects.Operations is
       --  at this point, and therefore, the caller cannot cancel the call.
 
       Entry_Call.Needs_Requeue := True;
-      Entry_Call.Requeue_With_Abort := With_Abort;
+      Entry_Call.With_Abort := With_Abort;
       Entry_Call.Called_PO := To_Address (New_Object);
       Entry_Call.Called_Task := null;
       Entry_Call.E := Entry_Index (E);
@@ -1022,8 +1017,9 @@ package body System.Tasking.Protected_Objects.Operations is
       Entry_Call.Called_PO := To_Address (Object);
       Entry_Call.Called_Task := null;
       Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
+      Entry_Call.With_Abort := True;
 
-      PO_Do_Or_Queue (Self_Id, Object, Entry_Call, With_Abort => True);
+      PO_Do_Or_Queue (Self_Id, Object, Entry_Call);
       PO_Service_Entries (Self_Id, Object);
 
       if Single_Lock then

diff --git a/gcc/ada/s-tpobop.ads b/gcc/ada/s-tpobop.ads
index 7c0a571..0316e0c 100644 (file)
--- a/gcc/ada/s-tpobop.ads
+++ b/gcc/ada/s-tpobop.ads
@@ -187,8 +187,7 @@ package System.Tasking.Protected_Objects.Operations is
    procedure PO_Do_Or_Queue
      (Self_ID    : Task_Id;
       Object     : Entries.Protection_Entries_Access;
-      Entry_Call : Entry_Call_Link;
-      With_Abort : Boolean);
+      Entry_Call : Entry_Call_Link);
    --  This procedure either executes or queues an entry call, depending
    --  on the status of the corresponding barrier. It assumes that abort
    --  is deferred and that the specified object is locked.
@@ -201,10 +200,9 @@ private
    end record;
    pragma Volatile (Communication_Block);
 
-   --  ?????
    --  The Communication_Block seems to be a relic. At the moment, the
    --  compiler seems to be generating unnecessary conditional code based on
    --  this block. See the code generated for async. select with task entry
-   --  call for another way of solving this.
+   --  call for another way of solving this ???
 
 end System.Tasking.Protected_Objects.Operations;