[Ada] improve multi-task mode support under vxworks

Arnaud Charlet charlet@adacore.com
Thu Sep 27 14:41:00 GMT 2007


Tested on i686-linux, committed on trunk

Polish the implementation of the VxWorks multi-task mode by adding
a stop function which can be called outside a breakpoint handler. This
is meant to be used when the debugger attaches an Ada application,
or when it interrupts it asynchronously. Rename the old implementation
of the stop function; this one should only be called from breakpoint
interrupt handlers.

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.

-------------- next part --------------
Index: s-taprop-lynxos.adb
===================================================================
--- s-taprop-lynxos.adb	(revision 128777)
+++ s-taprop-lynxos.adb	(working copy)
@@ -1342,6 +1342,16 @@ package body System.Task_Primitives.Oper
       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 --
    -------------------
Index: s-taprop-tru64.adb
===================================================================
--- s-taprop-tru64.adb	(revision 128777)
+++ s-taprop-tru64.adb	(working copy)
@@ -1289,6 +1289,16 @@ package body System.Task_Primitives.Oper
       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 --
    -------------------
Index: s-taprop-irix.adb
===================================================================
--- s-taprop-irix.adb	(revision 128777)
+++ s-taprop-irix.adb	(working copy)
@@ -1274,6 +1274,16 @@ package body System.Task_Primitives.Oper
       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 --
    -------------------
Index: s-taprop-hpux-dce.adb
===================================================================
--- s-taprop-hpux-dce.adb	(revision 128777)
+++ s-taprop-hpux-dce.adb	(working copy)
@@ -1194,6 +1194,16 @@ package body System.Task_Primitives.Oper
       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 --
    -------------------
Index: s-taprop-linux.adb
===================================================================
--- s-taprop-linux.adb	(revision 128777)
+++ s-taprop-linux.adb	(working copy)
@@ -1215,6 +1215,16 @@ package body System.Task_Primitives.Oper
       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 --
    -------------------
Index: s-taprop-dummy.adb
===================================================================
--- s-taprop-dummy.adb	(revision 128777)
+++ s-taprop-dummy.adb	(working copy)
@@ -401,6 +401,16 @@ package body System.Task_Primitives.Oper
       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 --
    ------------------------
Index: s-taprop-solaris.adb
===================================================================
--- s-taprop-solaris.adb	(revision 128777)
+++ s-taprop-solaris.adb	(working copy)
@@ -1957,6 +1957,16 @@ package body System.Task_Primitives.Oper
       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 --
    -------------------
Index: s-taprop-vms.adb
===================================================================
--- s-taprop-vms.adb	(revision 128777)
+++ s-taprop-vms.adb	(working copy)
@@ -1218,6 +1218,16 @@ package body System.Task_Primitives.Oper
       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 --
    -------------------
Index: s-taprop-mingw.adb
===================================================================
--- s-taprop-mingw.adb	(revision 128777)
+++ s-taprop-mingw.adb	(working copy)
@@ -1301,6 +1301,16 @@ package body System.Task_Primitives.Oper
       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 --
    -------------------
Index: s-taprop-posix.adb
===================================================================
--- s-taprop-posix.adb	(revision 128777)
+++ s-taprop-posix.adb	(working copy)
@@ -1357,6 +1357,16 @@ package body System.Task_Primitives.Oper
       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 --
    -------------------
Index: s-taprop.ads
===================================================================
--- s-taprop.ads	(revision 128777)
+++ s-taprop.ads	(working copy)
@@ -520,10 +520,11 @@ package System.Task_Primitives.Operation
    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.Operation
    --  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
Index: s-taprop-vxworks.adb
===================================================================
--- s-taprop-vxworks.adb	(revision 128777)
+++ s-taprop-vxworks.adb	(working copy)
@@ -1311,6 +1311,19 @@ package body System.Task_Primitives.Oper
       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 --
    -------------------
Index: s-tasdeb.adb
===================================================================
--- s-tasdeb.adb	(revision 128777)
+++ s-tasdeb.adb	(working copy)
@@ -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 --
    -----------------------
Index: s-tasdeb.ads
===================================================================
--- s-tasdeb.ads	(revision 128777)
+++ s-tasdeb.ads	(working copy)
@@ -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 --


More information about the Gcc-patches mailing list