* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127431
138bc75d-0d04-0410-961f-
82ee72b054a4
-- --
-- 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- --
-- 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
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 --
----------
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 --
-----------------
-- 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- --
-- 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#;
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 --
----------
-- --
-- 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- --
end Check_No_Locks;
-------------------
+ -- Continue_Task --
+ -------------------
+
+ function Continue_Task (T : ST.Task_Id) return Boolean is
+ begin
+ return False;
+ end Continue_Task;
+
+ -------------------
-- Current_State --
-------------------
return False;
end Suspend_Task;
+ --------------------
+ -- Stop_All_Tasks --
+ --------------------
+
+ procedure Stop_All_Tasks is
+ begin
+ null;
+ end Stop_All_Tasks;
+
------------------------
-- Suspend_Until_True --
------------------------
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 --
----------------
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 --
----------------
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 --
----------------
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 --
----------------
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;
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 --
----------------
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 --
----------------
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 --
----------------
-- 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;
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 --
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 --
-----------------------
-- --
-- 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- --
-- 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.
-------------------------
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 --
-- 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
-- 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 --
-------------------------------
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;
OSDN Git Service
