diff options
| -rw-r--r-- | gcc/ada/s-osinte-vxworks.adb | 54 | ||||
| -rw-r--r-- | gcc/ada/s-osinte-vxworks.ads | 32 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-dummy.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-hpux-dce.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-irix.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-lynxos.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-posix.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-solaris.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-tru64.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-vms.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-vxworks.adb | 43 | ||||
| -rw-r--r-- | gcc/ada/s-taprop.ads | 11 | ||||
| -rw-r--r-- | gcc/ada/s-tasdeb.adb | 35 | ||||
| -rw-r--r-- | gcc/ada/s-tasdeb.ads | 35 |
14 files changed, 339 insertions, 24 deletions
diff --git a/gcc/ada/s-osinte-vxworks.adb b/gcc/ada/s-osinte-vxworks.adb index 5687d68cfbc..417ab5d415a 100644 --- a/gcc/ada/s-osinte-vxworks.adb +++ b/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 -- ----------------- diff --git a/gcc/ada/s-osinte-vxworks.ads b/gcc/ada/s-osinte-vxworks.ads index ac698397e3a..b1a6d1d139a 100644 --- a/gcc/ada/s-osinte-vxworks.ads +++ b/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 -- ---------- diff --git a/gcc/ada/s-taprop-dummy.adb b/gcc/ada/s-taprop-dummy.adb index ccd1c00cd86..88d97680ba3 100644 --- a/gcc/ada/s-taprop-dummy.adb +++ b/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 -- ------------------------ diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb index 416a36f6df7..9b5d449f525 100644 --- a/gcc/ada/s-taprop-hpux-dce.adb +++ b/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 -- ---------------- diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb index e18320d90fa..aec5d802548 100644 --- a/gcc/ada/s-taprop-irix.adb +++ b/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 -- ---------------- diff --git a/gcc/ada/s-taprop-lynxos.adb b/gcc/ada/s-taprop-lynxos.adb index 361d6fa67fb..d6abf8abfed 100644 --- a/gcc/ada/s-taprop-lynxos.adb +++ b/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 -- ---------------- diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb index b7a4383e76f..baae9408750 100644 --- a/gcc/ada/s-taprop-posix.adb +++ b/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 -- ---------------- diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb index 3cf44f74756..823d9f48a8d 100644 --- a/gcc/ada/s-taprop-solaris.adb +++ b/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; diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb index c778b992b0d..75d54eb8bdf 100644 --- a/gcc/ada/s-taprop-tru64.adb +++ b/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 -- ---------------- diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb index 5cade02b277..9652ce6bf3f 100644 --- a/gcc/ada/s-taprop-vms.adb +++ b/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 -- ---------------- diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index b0974a63486..7ba1ba5d9c1 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/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 -- ---------------- diff --git a/gcc/ada/s-taprop.ads b/gcc/ada/s-taprop.ads index 79996b76567..d7dc0f70247 100644 --- a/gcc/ada/s-taprop.ads +++ b/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; diff --git a/gcc/ada/s-tasdeb.adb b/gcc/ada/s-tasdeb.adb index 8d6ffdf04aa..0dc102737fe 100644 --- a/gcc/ada/s-tasdeb.adb +++ b/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 -- ----------------------- diff --git a/gcc/ada/s-tasdeb.ads b/gcc/ada/s-tasdeb.ads index d0c230d1f28..6f167386935 100644 --- a/gcc/ada/s-tasdeb.ads +++ b/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; |