-- --
-- B o d y --
-- --
--- Copyright (C) 1997-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1997-2009, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
--- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNARL; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- in both normal and restricted (ravenscar) environments.
with System.CRTL;
+with System.Task_Primitives;
with System.Task_Primitives.Operations;
-with Unchecked_Conversion;
+with Ada.Unchecked_Conversion;
package body System.Tasking.Debug is
package STPO renames System.Task_Primitives.Operations;
function To_Integer is new
- Unchecked_Conversion (Task_Id, System.Address);
+ Ada.Unchecked_Conversion (Task_Id, System.Task_Primitives.Task_Address);
type Trace_Flag_Set is array (Character) of Boolean;
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;
+ ------------------------
+ -- Signal_Debug_Event --
+ ------------------------
+
+ procedure Signal_Debug_Event
+ (Event_Kind : Event_Kind_Type;
+ Task_Value : Task_Id)
+ is
+ begin
+ null;
+ end Signal_Debug_Event;
+
+ --------------------
+ -- Stop_All_Tasks --
+ --------------------
+
+ procedure Stop_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.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 --
-----------------------