s-taprop-lynxos.adb, [...] (Continue_Task, [...]): New functions; dummy implementations.

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 (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.

From-SVN: r127431

gcc/ada/s-osinte-vxworks.adb

@@ -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 --
    -----------------

gcc/ada/s-osinte-vxworks.ads

@@ -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 --
    ----------

gcc/ada/s-taprop-dummy.adb

@@ -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.Operations is
    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.Operations is
       return False;
    end Suspend_Task;
 
+   --------------------
+   -- Stop_All_Tasks --
+   --------------------
+
+   procedure Stop_All_Tasks is
+   begin
+      null;
+   end Stop_All_Tasks;
+
    ------------------------
    -- Suspend_Until_True --
    ------------------------

gcc/ada/s-taprop-hpux-dce.adb

@@ -1185,6 +1185,25 @@ package body System.Task_Primitives.Operations is
       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 --
    ----------------

gcc/ada/s-taprop-irix.adb

@@ -1265,6 +1265,25 @@ package body System.Task_Primitives.Operations is
       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 --
    ----------------

gcc/ada/s-taprop-lynxos.adb

@@ -1333,6 +1333,25 @@ package body System.Task_Primitives.Operations is
       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 --
    ----------------

gcc/ada/s-taprop-posix.adb

@@ -1348,6 +1348,25 @@ package body System.Task_Primitives.Operations is
       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 --
    ----------------

gcc/ada/s-taprop-solaris.adb

@@ -1948,4 +1948,23 @@ package body System.Task_Primitives.Operations is
       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;

gcc/ada/s-taprop-tru64.adb

@@ -1280,6 +1280,25 @@ package body System.Task_Primitives.Operations is
       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 --
    ----------------

gcc/ada/s-taprop-vms.adb

@@ -1209,6 +1209,25 @@ package body System.Task_Primitives.Operations is
       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 --
    ----------------

gcc/ada/s-taprop-vxworks.adb

@@ -1282,6 +1282,49 @@ package body System.Task_Primitives.Operations is
       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 --
    ----------------

gcc/ada/s-taprop.ads

@@ -533,4 +533,15 @@ package System.Task_Primitives.Operations is
    --  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;

gcc/ada/s-tasdeb.adb

@@ -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 --
    -----------------------

gcc/ada/s-tasdeb.ads

@@ -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;