* [Ada] implement new multi-task mode scheme on vxworks
@ 2007-08-17 8:06 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2007-08-17 8:06 UTC (permalink / raw)
To: gcc-patches; +Cc: Jerome Guitton
[-- Attachment #1: Type: text/plain, Size: 1901 bytes --]
Manually tested on ppc-vxworks
Tested on i686-linux, committed on trunk
Implement a new scheme for the multi-tasks mode on VxWorks. On VxWorks,
when a task hit a breakpoint in the kernel space, only this
tasks is stopped; the other tasks of the application keep
running. Under the multi-tasks mode of GDB, to be able to debug the
whole Ada application, we go through the list of task and stop them
all. We used to let the debugger do that. The goal of this change is
to reduce the delay between the hit of the breakpoint and the stop of
the whole application. To do so, the run-time will provide a hook
(Stop_All_Tasks) which can be called from the breakpoint exception
handler on the target. The debugger will take care of attaching this
hook to the breakpoints that it sets. This change also provides the
proper way to resume the whole application, through a run-time routine
(Continue_All_Tasks).
2007-08-14 Jerome Guitton <guitton@adacore.com>
* s-taprop-lynxos.adb, s-taprop-tru64.adb, s-taprop-irix.adb,
s-taprop-hpux-dce.adb, s-taprop-dummy.adb, s-taprop-solaris.adb,
s-taprop-vms.adb, s-taprop-posix.adb (Continue_Task, Stop_All_Tasks):
New functions; dummy implementations.
* s-osinte-vxworks.ads (Task_Stop, Task_Cont, Int_Lock, Int_Unlock): New
functions, used to implement the multi-tasks mode routines on VxWorks.
* s-osinte-vxworks.adb, s-osinte-vxworks6.adb (Task_Cont, Task_Stop):
New functions, thin
binding to the VxWorks routines which have changed between VxWorks 5
and 6.
(Int_Lock, Int_Unlock): New function, thin binding to kernel routines
which are not callable from a RTP.
* s-taprop-vxworks.adb (Stop_All_Tasks, Continue_Task): New functions,
implemented for the multi-tasks mode on VxWorks 5 and 6.
* s-taprop.ads (Stop_All_Tasks, Continue_Task): New functions.
* s-tasdeb.ads, s-tasdeb.adb (Continue_All_Tasks, Stop_All_Tasks): New
functions.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 19488 bytes --]
Index: s-taprop-lynxos.adb
===================================================================
--- s-taprop-lynxos.adb (revision 127358)
+++ s-taprop-lynxos.adb (working copy)
@@ -1333,6 +1333,25 @@ package body System.Task_Primitives.Oper
return False;
end Resume_Task;
+ --------------------
+ -- Stop_All_Tasks --
+ --------------------
+
+ procedure Stop_All_Tasks is
+ begin
+ null;
+ end Stop_All_Tasks;
+
+ -------------------
+ -- Continue_Task --
+ -------------------
+
+ function Continue_Task (T : ST.Task_Id) return Boolean is
+ pragma Unreferenced (T);
+ begin
+ return False;
+ end Continue_Task;
+
----------------
-- Initialize --
----------------
Index: s-taprop-tru64.adb
===================================================================
--- s-taprop-tru64.adb (revision 127358)
+++ s-taprop-tru64.adb (working copy)
@@ -1280,6 +1280,25 @@ package body System.Task_Primitives.Oper
return False;
end Resume_Task;
+ --------------------
+ -- Stop_All_Tasks --
+ --------------------
+
+ procedure Stop_All_Tasks is
+ begin
+ null;
+ end Stop_All_Tasks;
+
+ -------------------
+ -- Continue_Task --
+ -------------------
+
+ function Continue_Task (T : ST.Task_Id) return Boolean is
+ pragma Unreferenced (T);
+ begin
+ return False;
+ end Continue_Task;
+
----------------
-- Initialize --
----------------
Index: s-taprop-irix.adb
===================================================================
--- s-taprop-irix.adb (revision 127358)
+++ s-taprop-irix.adb (working copy)
@@ -1265,6 +1265,25 @@ package body System.Task_Primitives.Oper
return False;
end Resume_Task;
+ --------------------
+ -- Stop_All_Tasks --
+ --------------------
+
+ procedure Stop_All_Tasks is
+ begin
+ null;
+ end Stop_All_Tasks;
+
+ -------------------
+ -- Continue_Task --
+ -------------------
+
+ function Continue_Task (T : ST.Task_Id) return Boolean is
+ pragma Unreferenced (T);
+ begin
+ return False;
+ end Continue_Task;
+
----------------
-- Initialize --
----------------
Index: s-taprop-hpux-dce.adb
===================================================================
--- s-taprop-hpux-dce.adb (revision 127358)
+++ s-taprop-hpux-dce.adb (working copy)
@@ -1185,6 +1185,25 @@ package body System.Task_Primitives.Oper
return False;
end Resume_Task;
+ --------------------
+ -- Stop_All_Tasks --
+ --------------------
+
+ procedure Stop_All_Tasks is
+ begin
+ null;
+ end Stop_All_Tasks;
+
+ -------------------
+ -- Continue_Task --
+ -------------------
+
+ function Continue_Task (T : ST.Task_Id) return Boolean is
+ pragma Unreferenced (T);
+ begin
+ return False;
+ end Continue_Task;
+
----------------
-- Initialize --
----------------
Index: s-taprop-dummy.adb
===================================================================
--- s-taprop-dummy.adb (revision 127358)
+++ s-taprop-dummy.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, 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- --
@@ -79,6 +79,15 @@ package body System.Task_Primitives.Oper
end Check_No_Locks;
-------------------
+ -- Continue_Task --
+ -------------------
+
+ function Continue_Task (T : ST.Task_Id) return Boolean is
+ begin
+ return False;
+ end Continue_Task;
+
+ -------------------
-- Current_State --
-------------------
@@ -383,6 +392,15 @@ package body System.Task_Primitives.Oper
return False;
end Suspend_Task;
+ --------------------
+ -- Stop_All_Tasks --
+ --------------------
+
+ procedure Stop_All_Tasks is
+ begin
+ null;
+ end Stop_All_Tasks;
+
------------------------
-- Suspend_Until_True --
------------------------
Index: s-taprop-solaris.adb
===================================================================
--- s-taprop-solaris.adb (revision 127358)
+++ s-taprop-solaris.adb (working copy)
@@ -1948,4 +1948,23 @@ package body System.Task_Primitives.Oper
end if;
end Resume_Task;
+ --------------------
+ -- Stop_All_Tasks --
+ --------------------
+
+ procedure Stop_All_Tasks is
+ begin
+ null;
+ end Stop_All_Tasks;
+
+ -------------------
+ -- Continue_Task --
+ -------------------
+
+ function Continue_Task (T : ST.Task_Id) return Boolean is
+ pragma Unreferenced (T);
+ begin
+ return False;
+ end Continue_Task;
+
end System.Task_Primitives.Operations;
Index: s-taprop-vms.adb
===================================================================
--- s-taprop-vms.adb (revision 127358)
+++ s-taprop-vms.adb (working copy)
@@ -1209,6 +1209,25 @@ package body System.Task_Primitives.Oper
return False;
end Resume_Task;
+ --------------------
+ -- Stop_All_Tasks --
+ --------------------
+
+ procedure Stop_All_Tasks is
+ begin
+ null;
+ end Stop_All_Tasks;
+
+ -------------------
+ -- Continue_Task --
+ -------------------
+
+ function Continue_Task (T : ST.Task_Id) return Boolean is
+ pragma Unreferenced (T);
+ begin
+ return False;
+ end Continue_Task;
+
----------------
-- Initialize --
----------------
Index: s-taprop-posix.adb
===================================================================
--- s-taprop-posix.adb (revision 127358)
+++ s-taprop-posix.adb (working copy)
@@ -1348,6 +1348,25 @@ package body System.Task_Primitives.Oper
return False;
end Resume_Task;
+ --------------------
+ -- Stop_All_Tasks --
+ --------------------
+
+ procedure Stop_All_Tasks is
+ begin
+ null;
+ end Stop_All_Tasks;
+
+ -------------------
+ -- Continue_Task --
+ -------------------
+
+ function Continue_Task (T : ST.Task_Id) return Boolean is
+ pragma Unreferenced (T);
+ begin
+ return False;
+ end Continue_Task;
+
----------------
-- Initialize --
----------------
Index: s-osinte-vxworks.ads
===================================================================
--- s-osinte-vxworks.ads (revision 127358)
+++ s-osinte-vxworks.ads (working copy)
@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1995-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- --
@@ -91,12 +91,14 @@ package System.OS_Interface is
-- Signal processing definitions --
-----------------------------------
- -- The how in sigprocmask().
+ -- The how in sigprocmask()
+
SIG_BLOCK : constant := 1;
SIG_UNBLOCK : constant := 2;
SIG_SETMASK : constant := 3;
- -- The sa_flags in struct sigaction.
+ -- The sa_flags in struct sigaction
+
SA_SIGINFO : constant := 16#0002#;
SA_ONSTACK : constant := 16#0004#;
@@ -157,6 +159,30 @@ package System.OS_Interface is
function getpid return t_id;
pragma Inline (getpid);
+ function Task_Stop (tid : t_id) return int;
+ pragma Inline (Task_Stop);
+ -- If we are in the kernel space, stop the task whose t_id is
+ -- given in parameter in such a way that it can be examined by the
+ -- debugger. This typically maps to taskSuspend on VxWorks 5 and
+ -- to taskStop on VxWorks 6.
+
+ function Task_Cont (tid : t_id) return int;
+ pragma Inline (Task_Cont);
+ -- If we are in the kernel space, continue the task whose t_id is
+ -- given in parameter if it has been stopped previously to be examined
+ -- by the debugger (e.g. by taskStop). It typically maps to taskResume
+ -- on VxWorks 5 and to taskCont on VxWorks 6.
+
+ function Int_Lock return int;
+ pragma Inline (Int_Lock);
+ -- If we are in the kernel space, lock interrupts. It typically maps to
+ -- intLock.
+
+ function Int_Unlock return int;
+ pragma Inline (Int_Unlock);
+ -- If we are in the kernel space, unlock interrupts. It typically maps to
+ -- intUnlock.
+
----------
-- Time --
----------
Index: s-osinte-vxworks.adb
===================================================================
--- s-osinte-vxworks.adb (revision 127358)
+++ s-osinte-vxworks.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1997-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1997-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- --
@@ -33,12 +33,12 @@
-- This is the VxWorks version
--- This package encapsulates all direct interfaces to OS services
--- that are needed by children of System.
+-- This package encapsulates all direct interfaces to OS services that are
+-- needed by children of System.
pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during
--- tasking operations. It causes infinite loops and other problems.
+-- Turn off polling, we do not want ATC polling to take place during tasking
+-- operations. It causes infinite loops and other problems.
package body System.OS_Interface is
@@ -59,6 +59,28 @@ package body System.OS_Interface is
return taskIdSelf;
end getpid;
+ --------------
+ -- Int_Lock --
+ --------------
+
+ function Int_Lock return int is
+ function intLock return int;
+ pragma Import (C, intLock, "intLock");
+ begin
+ return intLock;
+ end Int_Lock;
+
+ ----------------
+ -- Int_Unlock --
+ ----------------
+
+ function Int_Unlock return int is
+ function intUnlock return int;
+ pragma Import (C, intUnlock, "intUnlock");
+ begin
+ return intUnlock;
+ end Int_Unlock;
+
----------
-- kill --
----------
@@ -107,6 +129,28 @@ package body System.OS_Interface is
end if;
end sigwait;
+ ---------------
+ -- Task_Cont --
+ ---------------
+
+ function Task_Cont (tid : t_id) return int is
+ function taskResume (tid : t_id) return int;
+ pragma Import (C, taskResume, "taskResume");
+ begin
+ return taskResume (tid);
+ end Task_Cont;
+
+ ---------------
+ -- Task_Stop --
+ ---------------
+
+ function Task_Stop (tid : t_id) return int is
+ function taskSuspend (tid : t_id) return int;
+ pragma Import (C, taskSuspend, "taskSuspend");
+ begin
+ return taskSuspend (tid);
+ end Task_Stop;
+
-----------------
-- To_Duration --
-----------------
Index: s-taprop-vxworks.adb
===================================================================
--- s-taprop-vxworks.adb (revision 127358)
+++ s-taprop-vxworks.adb (working copy)
@@ -1282,6 +1282,49 @@ package body System.Task_Primitives.Oper
end if;
end Resume_Task;
+ --------------------
+ -- Stop_All_Tasks --
+ --------------------
+
+ procedure Stop_All_Tasks
+ is
+ Thread_Self : constant Thread_Id := taskIdSelf;
+ C : Task_Id;
+
+ Dummy : int;
+ pragma Unreferenced (Dummy);
+
+ begin
+ Dummy := Int_Lock;
+
+ C := All_Tasks_List;
+ while C /= null loop
+ if C.Common.LL.Thread /= 0
+ and then C.Common.LL.Thread /= Thread_Self
+ then
+ Dummy := Task_Stop (C.Common.LL.Thread);
+ end if;
+
+ C := C.Common.All_Tasks_Link;
+ end loop;
+
+ Dummy := Int_Unlock;
+ end Stop_All_Tasks;
+
+ -------------------
+ -- Continue_Task --
+ -------------------
+
+ function Continue_Task (T : ST.Task_Id) return Boolean
+ is
+ begin
+ if T.Common.LL.Thread /= 0 then
+ return Task_Cont (T.Common.LL.Thread) = 0;
+ else
+ return True;
+ end if;
+ end Continue_Task;
+
----------------
-- Initialize --
----------------
Index: s-taprop.ads
===================================================================
--- s-taprop.ads (revision 127358)
+++ s-taprop.ads (working copy)
@@ -533,4 +533,15 @@ package System.Task_Primitives.Operation
-- Such functionality is needed by gdb on some targets (e.g VxWorks)
-- Return True is the operation is successful
+ procedure Stop_All_Tasks;
+ -- Stop all tasks when the underlying thread library provides such
+ -- functionality. Such functionality is needed by gdb on some targets (e.g
+ -- VxWorks) This function can be run from an interrupt handler. 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
+ -- (e.g VxWorks) Return True is the operation is successful
+
end System.Task_Primitives.Operations;
Index: s-tasdeb.ads
===================================================================
--- s-tasdeb.ads (revision 127358)
+++ s-tasdeb.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1997-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1997-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- --
@@ -53,12 +53,12 @@ package System.Tasking.Debug is
-- the standard error file.
procedure Print_Task_Info (T : Task_Id);
- -- Similar to Print_Current_Task, for a given task.
+ -- Similar to Print_Current_Task, for a given task
procedure Set_User_State (Value : Long_Integer);
- -- Set user state value in the current task.
- -- This state will be displayed when calling List_Tasks or
- -- Print_Current_Task. It is useful for setting task specific state.
+ -- Set user state value in the current task. This state will be displayed
+ -- when calling List_Tasks or Print_Current_Task. It is useful for setting
+ -- task specific state.
function Get_User_State return Long_Integer;
-- Return the user state for the current task.
@@ -68,8 +68,8 @@ package System.Tasking.Debug is
-------------------------
Known_Tasks : array (0 .. 999) of Task_Id := (others => null);
- -- Global array of tasks read by gdb, and updated by
- -- Create_Task and Finalize_TCB
+ -- Global array of tasks read by gdb, and updated by Create_Task and
+ -- Finalize_TCB
----------------------------------
-- VxWorks specific GDB support --
@@ -79,11 +79,11 @@ package System.Tasking.Debug is
-- manner, only VxWorks currently uses them.
procedure Task_Creation_Hook (Thread : OS_Interface.Thread_Id);
- -- This procedure is used to notify GDB of task's creation.
- -- It must be called by the task's creator.
+ -- This procedure is used to notify GDB of task's creation. It must be
+ -- called by the task's creator.
procedure Task_Termination_Hook;
- -- This procedure is used to notify GDB of task's termination.
+ -- This procedure is used to notify GDB of task's termination
procedure Suspend_All_Tasks (Thread_Self : OS_Interface.Thread_Id);
-- Suspend all the tasks except the one whose associated thread is
@@ -95,6 +95,16 @@ package System.Tasking.Debug is
-- Thread_Self by traversing All_Tasks_Lists and calling
-- System.Task_Primitives.Operations.Continue_Task.
+ procedure Stop_All_Tasks;
+ -- Stop all the tasks by traversing All_Tasks_Lists and calling
+ -- System.Task_Primitives.Operations.Stop_Task. This function
+ -- can be used in a interrupt handler.
+
+ 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.
+
-------------------------------
-- Run-time tracing routines --
-------------------------------
@@ -111,8 +121,7 @@ package System.Tasking.Debug is
procedure Set_Trace
(Flag : Character;
Value : Boolean := True);
- -- Enable or disable tracing for Flag.
- -- By default, flags in the range 'A' .. 'Z' are disabled, others are
- -- enabled.
+ -- Enable or disable tracing for Flag. By default, flags in the range
+ -- 'A' .. 'Z' are disabled, others are enabled.
end System.Tasking.Debug;
Index: s-tasdeb.adb
===================================================================
--- s-tasdeb.adb (revision 127358)
+++ s-tasdeb.adb (working copy)
@@ -61,10 +61,32 @@ package body System.Tasking.Debug is
procedure Write (Fd : Integer; S : String; Count : Integer);
procedure Put (S : String);
- -- Display S on standard output.
+ -- Display S on standard output
procedure Put_Line (S : String := "");
- -- Display S on standard output with an additional line terminator.
+ -- Display S on standard output with an additional line terminator
+
+ ------------------------
+ -- Continue_All_Tasks --
+ ------------------------
+
+ procedure Continue_All_Tasks is
+ C : Task_Id;
+
+ Dummy : Boolean;
+ pragma Unreferenced (Dummy);
+
+ begin
+ STPO.Lock_RTS;
+
+ C := All_Tasks_List;
+ while C /= null loop
+ Dummy := STPO.Continue_Task (C);
+ C := C.Common.All_Tasks_Link;
+ end loop;
+
+ STPO.Unlock_RTS;
+ end Continue_All_Tasks;
--------------------
-- Get_User_State --
@@ -225,6 +247,15 @@ package body System.Tasking.Debug is
STPO.Self.User_State := Value;
end Set_User_State;
+ --------------------
+ -- Stop_All_Tasks --
+ --------------------
+
+ procedure Stop_All_Tasks is
+ begin
+ STPO.Stop_All_Tasks;
+ end Stop_All_Tasks;
+
-----------------------
-- Suspend_All_Tasks --
-----------------------
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2007-08-17 8:06 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2007-08-17 8:06 [Ada] implement new multi-task mode scheme on vxworks Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).