s-taprop-lynxos.adb, [...] (Stop_Task): New function, dummy implementation.

2007-09-26  Jerome Guitton  <guitton@adacore.com>

	* s-taprop-lynxos.adb, s-taprop-tru64.adb, s-taprop-irix.adb,
	s-taprop-hpux-dce.adb, s-taprop-linux.adb, s-taprop-dummy.adb,
	 s-taprop-solaris.adb, s-taprop-vms.adb, s-taprop-mingw.adb,
	s-taprop-posix.adb (Stop_Task): New function, dummy implementation.

	* s-taprop.ads, s-taprop-vxworks.adb (Stop_Task): New function.

	* s-tasdeb.adb (Stop_All_Tasks): New function, implementing a run-time
	function which can be called by the debugger to interrupt the tasks of
	an Ada application asynchronously, as needed on VxWorks.
	(Stop_All_Tasks_Handler): Renamed from Stop_All_Tasks.

	* s-tasdeb.ads (Stop_All_Tasks_Handler): New function declaration,
	renamed from Stop_All_Tasks. Update comments.
	(Stop_All_tasks): New function declaration.

From-SVN: r128781

diff --git a/gcc/ada/s-taprop-dummy.adb b/gcc/ada/s-taprop-dummy.adb
index 88d97680ba3e394629990de3e97f8fa5c04b0df7..a64a61cd9dd03fe7715b8fb687fce6cbca330d9f 100644 (file)
--- a/gcc/ada/s-taprop-dummy.adb
+++ b/gcc/ada/s-taprop-dummy.adb
@@ -401,6 +401,16 @@ package body System.Task_Primitives.Operations is
       null;
    end Stop_All_Tasks;
 
+   ---------------
+   -- Stop_Task --
+   ---------------
+
+   function Stop_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Stop_Task;
+
    ------------------------
    -- Suspend_Until_True --
    ------------------------

diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb
index 9b5d449f525f2a4ee6082c938c3e7ad6eb987340..33ca89bf3783ae3c56d5fea5fc9e3dbdf2cf0eff 100644 (file)
--- a/gcc/ada/s-taprop-hpux-dce.adb
+++ b/gcc/ada/s-taprop-hpux-dce.adb
@@ -1194,6 +1194,16 @@ package body System.Task_Primitives.Operations is
       null;
    end Stop_All_Tasks;
 
+   ---------------
+   -- Stop_Task --
+   ---------------
+
+   function Stop_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Stop_Task;
+
    -------------------
    -- Continue_Task --
    -------------------

diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb
index aec5d802548516fd6d14509221fde7a4932be0aa..62264cad1d5e97aed129b00541ae4bcda4a4ab62 100644 (file)
--- a/gcc/ada/s-taprop-irix.adb
+++ b/gcc/ada/s-taprop-irix.adb
@@ -1274,6 +1274,16 @@ package body System.Task_Primitives.Operations is
       null;
    end Stop_All_Tasks;
 
+   ---------------
+   -- Stop_Task --
+   ---------------
+
+   function Stop_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Stop_Task;
+
    -------------------
    -- Continue_Task --
    -------------------

diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index 4f5fe8f0bff15990de16f4afedc3dec05ad4eb31..b30fb2476174271840fadc0d658ae9ce22009017 100644 (file)
--- a/gcc/ada/s-taprop-linux.adb
+++ b/gcc/ada/s-taprop-linux.adb
@@ -1215,6 +1215,16 @@ package body System.Task_Primitives.Operations is
       null;
    end Stop_All_Tasks;
 
+   ---------------
+   -- Stop_Task --
+   ---------------
+
+   function Stop_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Stop_Task;
+
    -------------------
    -- Continue_Task --
    -------------------

diff --git a/gcc/ada/s-taprop-lynxos.adb b/gcc/ada/s-taprop-lynxos.adb
index d6abf8abfed24c61b08944d5c88b67c26788bbe5..8693fed7ced7243f669df05bcd60ee1e68236578 100644 (file)
--- a/gcc/ada/s-taprop-lynxos.adb
+++ b/gcc/ada/s-taprop-lynxos.adb
@@ -1342,6 +1342,16 @@ package body System.Task_Primitives.Operations is
       null;
    end Stop_All_Tasks;
 
+   ---------------
+   -- Stop_Task --
+   ---------------
+
+   function Stop_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Stop_Task;
+
    -------------------
    -- Continue_Task --
    -------------------

diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb
index 603e2430378ac36773e5fb9e2cae3618c5d457ac..b8ebc81438756739db6828b5e2a7e71336aa5cd2 100644 (file)
--- a/gcc/ada/s-taprop-mingw.adb
+++ b/gcc/ada/s-taprop-mingw.adb
@@ -1301,6 +1301,16 @@ package body System.Task_Primitives.Operations is
       null;
    end Stop_All_Tasks;
 
+   ---------------
+   -- Stop_Task --
+   ---------------
+
+   function Stop_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Stop_Task;
+
    -------------------
    -- Continue_Task --
    -------------------

diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb
index baae9408750c1c71c8dc88d485e255ed430f0e97..e0c35b52b9914c0a93da6418b2e8a6929d591ea3 100644 (file)
--- a/gcc/ada/s-taprop-posix.adb
+++ b/gcc/ada/s-taprop-posix.adb
@@ -1357,6 +1357,16 @@ package body System.Task_Primitives.Operations is
       null;
    end Stop_All_Tasks;
 
+   ---------------
+   -- Stop_Task --
+   ---------------
+
+   function Stop_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Stop_Task;
+
    -------------------
    -- Continue_Task --
    -------------------

diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb
index 823d9f48a8d0d6b0bd76a19a4b5e2b510efd99aa..26dab87029cfa8106beaa0e9fb496bc1030940ac 100644 (file)
--- a/gcc/ada/s-taprop-solaris.adb
+++ b/gcc/ada/s-taprop-solaris.adb
@@ -1957,6 +1957,16 @@ package body System.Task_Primitives.Operations is
       null;
    end Stop_All_Tasks;
 
+   ---------------
+   -- Stop_Task --
+   ---------------
+
+   function Stop_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Stop_Task;
+
    -------------------
    -- Continue_Task --
    -------------------

diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb
index 75d54eb8bdfe750b304ea2db8a9e66346f2ec998..975bae11f4fd14a666f9666494300384749e2469 100644 (file)
--- a/gcc/ada/s-taprop-tru64.adb
+++ b/gcc/ada/s-taprop-tru64.adb
@@ -1289,6 +1289,16 @@ package body System.Task_Primitives.Operations is
       null;
    end Stop_All_Tasks;
 
+   ---------------
+   -- Stop_Task --
+   ---------------
+
+   function Stop_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Stop_Task;
+
    -------------------
    -- Continue_Task --
    -------------------

diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb
index 9652ce6bf3f67b3cab532dd41840617e575c747a..0647b21c981c09df07c0125b6eb55e91104f36c8 100644 (file)
--- a/gcc/ada/s-taprop-vms.adb
+++ b/gcc/ada/s-taprop-vms.adb
@@ -1218,6 +1218,16 @@ package body System.Task_Primitives.Operations is
       null;
    end Stop_All_Tasks;
 
+   ---------------
+   -- Stop_Task --
+   ---------------
+
+   function Stop_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Stop_Task;
+
    -------------------
    -- Continue_Task --
    -------------------

diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb
index 7ba1ba5d9c14608d7349ffb7e50cf2567c6c8301..51e7f0cac181b7cd657b1e708884be3795050fd9 100644 (file)
--- a/gcc/ada/s-taprop-vxworks.adb
+++ b/gcc/ada/s-taprop-vxworks.adb
@@ -1311,6 +1311,19 @@ package body System.Task_Primitives.Operations is
       Dummy := Int_Unlock;
    end Stop_All_Tasks;
 
+   ---------------
+   -- Stop_Task --
+   ---------------
+
+   function Stop_Task (T : ST.Task_Id) return Boolean is
+   begin
+      if T.Common.LL.Thread /= 0 then
+         return Task_Stop (T.Common.LL.Thread) = 0;
+      else
+         return True;
+      end if;
+   end Stop_Task;
+
    -------------------
    -- Continue_Task --
    -------------------

diff --git a/gcc/ada/s-taprop.ads b/gcc/ada/s-taprop.ads
index d7dc0f702472bbc40e369a5d92cbcd48d7e77c93..d45ef18b9905253b6d6eb43ccfc55518a959bbf4 100644 (file)
--- a/gcc/ada/s-taprop.ads
+++ b/gcc/ada/s-taprop.ads
@@ -520,10 +520,11 @@ package System.Task_Primitives.Operations is
    function Suspend_Task
      (T           : ST.Task_Id;
       Thread_Self : OSI.Thread_Id) return Boolean;
-   --  Suspend a specific task when the underlying thread library provides
-   --  such functionality, unless the thread associated with T is Thread_Self.
-   --  Such functionality is needed by gdb on some targets (e.g VxWorks)
-   --  Return True is the operation is successful
+   --  Suspend a specific task when the underlying thread library provides this
+   --  functionality, unless the thread associated with T is Thread_Self. Such
+   --  functionality is needed by gdb on some targets (e.g VxWorks) Return True
+   --  is the operation is successful. On targets where this operation is not
+   --  available, a dummy body is present which always returns False.
 
    function Resume_Task
      (T           : ST.Task_Id;
@@ -539,6 +540,11 @@ package System.Task_Primitives.Operations is
    --  VxWorks) This function can be run from an interrupt handler. Return True
    --  is the operation is successful
 
+   function Stop_Task (T : ST.Task_Id) return Boolean;
+   --  Stop a specific task when the underlying thread library provides
+   --  such functionality. Such functionality is needed by gdb on some targets
+   --  (e.g VxWorks). Return True is the operation is successful.
+
    function Continue_Task (T : ST.Task_Id) return Boolean;
    --  Continue a specific task when the underlying thread library provides
    --  such functionality. Such functionality is needed by gdb on some targets

diff --git a/gcc/ada/s-tasdeb.adb b/gcc/ada/s-tasdeb.adb
index 0dc102737fe3e060858203ce39d3a96f40303aff..05719426d24315f1e81e5fcbf7a8cbe50bb8b014 100644 (file)
--- a/gcc/ada/s-tasdeb.adb
+++ b/gcc/ada/s-tasdeb.adb
@@ -252,10 +252,32 @@ package body System.Tasking.Debug is
    --------------------
 
    procedure Stop_All_Tasks is
+      C : Task_Id;
+
+      Dummy : Boolean;
+      pragma Unreferenced (Dummy);
+
    begin
-      STPO.Stop_All_Tasks;
+      STPO.Lock_RTS;
+
+      C := All_Tasks_List;
+      while C /= null loop
+         Dummy := STPO.Stop_Task (C);
+         C := C.Common.All_Tasks_Link;
+      end loop;
+
+      STPO.Unlock_RTS;
    end Stop_All_Tasks;
 
+   ----------------------------
+   -- Stop_All_Tasks_Handler --
+   ----------------------------
+
+   procedure Stop_All_Tasks_Handler is
+   begin
+      STPO.Stop_All_Tasks;
+   end Stop_All_Tasks_Handler;
+
    -----------------------
    -- Suspend_All_Tasks --
    -----------------------

diff --git a/gcc/ada/s-tasdeb.ads b/gcc/ada/s-tasdeb.ads
index 6f1673869354b8015b942c958518f034adfe94f9..72f3954a9d51644a52017a9a4707d450971c5cb1 100644 (file)
--- a/gcc/ada/s-tasdeb.ads
+++ b/gcc/ada/s-tasdeb.ads
@@ -95,15 +95,18 @@ package System.Tasking.Debug is
    --  Thread_Self by traversing All_Tasks_Lists and calling
    --  System.Task_Primitives.Operations.Continue_Task.
 
-   procedure Stop_All_Tasks;
+   procedure Stop_All_Tasks_Handler;
    --  Stop all the tasks by traversing All_Tasks_Lists and calling
-   --  System.Task_Primitives.Operations.Stop_Task. This function
+   --  System.Task_Primitives.Operations.Stop_All_Task. This function
    --  can be used in a interrupt handler.
 
+   procedure Stop_All_Tasks;
+   --  Stop all the tasks by traversing All_Tasks_Lists and calling
+   --  System.Task_Primitives.Operations.Stop_Task.
+
    procedure Continue_All_Tasks;
    --  Continue all the tasks by traversing All_Tasks_Lists and calling
-   --  System.Task_Primitives.Operations.Continue_Task. This function
-   --  can be used in a interrupt handler.
+   --  System.Task_Primitives.Operations.Continue_Task.
 
    -------------------------------
    -- Run-time tracing routines --