summaryrefslogtreecommitdiff
path: root/gcc/ada/s-taprop-linux.adb
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2005-09-05 07:46:06 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2005-09-05 07:46:06 +0000
commit51e69f04c0161130375d97979e76cbfd0bd2d45e (patch)
treea6cb1c584d1988e1b5e855ab100aea15d2e374d2 /gcc/ada/s-taprop-linux.adb
parent69e0f3d4a84e6e6226f05799ea4789427e996d42 (diff)
downloadgcc-51e69f04c0161130375d97979e76cbfd0bd2d45e.tar.gz
* a-calend-mingw.adb: Add call to OS_Primitives.Initialize;
* s-taprop-mingw.adb, s-taprop-vms.adb, s-taprop-solaris.adb, s-taprop-os2.adb, s-taprop-irix-athread.adb, s-taprop-linux.adb, s-taprop-hpux-dce.adb, s-taprop-irix.adb, s-taprop-tru64.adb, s-taprop-lynxos.adb: Move with clauses outside Warnings Off now that dependent units are Preelaborate. (Initialize): Call Interrupt_Managemeent.Initialize and OS_Primitives.Initialize to ensure proper initialization of this unit. Remove use of System.Soft_Links Make this unit Preelaborate. * s-stache.ads, s-taspri-vxworks.ads, s-taspri-mingw.ads, s-taspri-vms.ads, s-tasinf-solaris.ads, s-taspri-os2.ads, s-taspri-lynxos.ads, s-taspri-hpux-dce.ads, s-taspri-tru64.ads, s-tasinf-tru64.ads, s-tasinf-irix.ads, s-tasinf-irix-athread.ads, s-proinf-irix-athread.adb, s-proinf-irix-athread.ads, s-tratas.ads, s-tasinf.ads: Minor reformatting. Add pragma Preelaborate, since these packages are suitable for this categorization. Update comments. * s-traent-vms.ads, s-intman-dummy.adb, s-taprop-dummy.adb: Make this unit Preelaborate. * s-osprim-vxworks.adb, s-osprim-vms.adb, s-osprim-vms.ads, s-osprim-mingw.adb, s-intman-vxworks.ads, s-intman-vxworks.adb, s-intman-vms.adb, s-intman-mingw.adb, s-intman-vms.ads, s-osprim-unix.adb, s-osprim-os2.adb, s-osprim-solaris.adb, s-intman-solaris.adb, s-intman-irix-athread.adb, s-intman-irix.adb: Mark this unit Preelaborate. (Initialize): New procedure. Update comments. * s-taspri-linux.ads: Removed. * s-tpopsp-solaris.adb (Initialize): Create the key in this procedure, as done by other implementations (e.g. posix). * s-taprop.ads (Timed_Delay): Update spec since the caller now is responsible for deferring abort. Mark this unit Preelaborate. * s-taprob.adb, s-tarest.adb: Call System.Tasking.Initialize to ensure proper initialization of the tasking run-time. * s-tasdeb.ads: Mark this unit Preelaborate. (Known_Tasks): Add explicit default value to avoid elaboration code. * s-inmaop-vms.adb (Elaboration code): Add call to Interrupt_Management.Initialize since the elaboration code depends on proper initialization of this package. * s-intman.ads, s-inmaop-posix.adb, s-intman-posix.adb, s-osprim.ads, s-taprop-posix.adb, s-taspri-posix.ads, s-osprim-posix.adb: Make this unit Preelaborate. * a-calend.adb: Add call to OS_Primitives.Initialize * a-elchha.adb: Update use of Except.Id.Full_Name. Minor reformatting. Remove use of Ada.Exceptions.Traceback when possible, cleaner. * a-dynpri.adb, a-sytaco.adb, a-sytaco.ads: Move with clauses outside Warnings Off now that dependent units are Preelaborate. Use raise xxx with "..."; Ada 2005 form. * a-taside.ads, a-taside.adb: Remove some dependencies, to make it easier to make this unit truly Preelaborate. Rewrite some code to be conformant with Preelaborate rules. * g-os_lib.adb: Remove non-preelaborate code so that this unit can be marked Preelaborate in the future. * s-proinf.ads, g-string.ads, s-auxdec.ads, s-auxdec-vms_64.ads: Make these units Preelaborate. * s-exctab.adb: Update use of Except.Id.Full_Name. * s-soflin.ads, s-soflin.adb: Mark this unit Preelaborate_05. (Set_Exc_Stack_Addr_Soft, Get_Exc_Stack_Addr_NT, Set_Exc_Stack_Addr_NT, Set_Exc_Stack_Addr): Removed, no longer used. Remove reference to *Machine_State_Addr*, no longer needed. * s-stalib.ads: Mark this unit as Preelaborate[_05]. (Exception_Data): Full_Name is now a System.Address so that this unit can be made Preelaborate. Clean up/simplify code thanks to Full_Name being a System.Address. Remove obsolete pragma Suppress (All_Checks), no longer needed. * s-taskin.ads, s-taskin.adb: Move with clauses outside Warnings Off now that dependent units are Preelaborate. Make this unit Preelaborate. (Initialize): New proceduure, replace elaboration code and makes the set up of the tasking run-time cleaner. (Detect_Blocking): Now a function instead of a deferred boolean, to obey Preelaborate rules. * s-tassta.adb (Finalize_Global_Tasks): Remove Get/Set_Exc_Stack_Addr soft links, no longer used. * s-traces.ads, s-traent.ads: Add pragma Preelaborate, since these packages are suitable for this categorization. * s-solita.adb: Replace use of Ada.Exception by raise xxx with "..." since we compile run-time sources in Ada 2005 mode. (Timed_Delay_T): Call Abort_Defer/Undefer around Timed_Delay, to avoid having s-taprop*.adb depend on s-soflin and to avoid code duplication. Remove reference to *Machine_State_Addr*, no longer needed. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@103847 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/s-taprop-linux.adb')
-rw-r--r--gcc/ada/s-taprop-linux.adb163
1 files changed, 43 insertions, 120 deletions
diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index d255d7cebea..6cb7eb7e5cb 100644
--- a/gcc/ada/s-taprop-linux.adb
+++ b/gcc/ada/s-taprop-linux.adb
@@ -40,44 +40,32 @@ 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.
-with System.Tasking.Debug;
--- used for Known_Tasks
-
with Interfaces.C;
-- used for int
-- size_t
+with System.Parameters;
+-- used for Size_Type
+
+with System.Tasking.Debug;
+-- used for Known_Tasks
+
with System.Interrupt_Management;
-- used for Keep_Unmasked
-- Abort_Task_Interrupt
-- Interrupt_ID
-with System.Parameters;
--- used for Size_Type
+with System.OS_Primitives;
+-- used for Delay_Modes
-with System.Tasking;
--- used for Ada_Task_Control_Block
--- Task_Id
+with System.Soft_Links;
+-- used for Abort_Defer/Undefer
with Ada.Exceptions;
-- used for Raise_Exception
-- Raise_From_Signal_Handler
-- Exception_Id
-with System.Soft_Links;
--- used for Defer/Undefer_Abort
-
--- Note that we do not use System.Tasking.Initialization directly since
--- this is a higher level package that we shouldn't depend on. For example
--- when using the restricted run time, it is replaced by
--- System.Tasking.Restricted.Stages.
-
-with System.OS_Primitives;
--- used for Delay_Modes
-
-with System.Soft_Links;
--- used for Abort_Defer/Undefer
-
with Unchecked_Conversion;
with Unchecked_Deallocation;
@@ -90,8 +78,6 @@ package body System.Task_Primitives.Operations is
use System.Parameters;
use System.OS_Primitives;
- package SSL renames System.Soft_Links;
-
----------------
-- Local Data --
----------------
@@ -111,12 +97,10 @@ package body System.Task_Primitives.Operations is
-- A variable to hold Task_Id for the environment task
Unblocked_Signal_Mask : aliased sigset_t;
- -- The set of signals that should unblocked in all tasks
+ -- The set of signals that should be unblocked in all tasks
-- The followings are internal configuration constants needed
- Priority_Ceiling_Emulation : constant Boolean := True;
-
Next_Serial_Number : Task_Serial_Number := 100;
-- We start at 100, to reserve some special values for
-- using in error checking.
@@ -127,9 +111,6 @@ package body System.Task_Primitives.Operations is
Dispatching_Policy : Character;
pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
- FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
- -- Indicates whether FIFO_Within_Priorities is set
-
-- The following are effectively constants, but they need to
-- be initialized by calling a pthread_ function.
@@ -280,14 +261,11 @@ package body System.Task_Primitives.Operations is
(Prio : System.Any_Priority;
L : access Lock)
is
- Result : Interfaces.C.int;
+ pragma Unreferenced (Prio);
+ Result : Interfaces.C.int;
begin
- if Priority_Ceiling_Emulation then
- L.Ceiling := Prio;
- end if;
-
- Result := pthread_mutex_init (L.L'Access, Mutex_Attr'Access);
+ Result := pthread_mutex_init (L, Mutex_Attr'Access);
pragma Assert (Result = 0 or else Result = ENOMEM);
@@ -319,7 +297,7 @@ package body System.Task_Primitives.Operations is
procedure Finalize_Lock (L : access Lock) is
Result : Interfaces.C.int;
begin
- Result := pthread_mutex_destroy (L.L'Access);
+ Result := pthread_mutex_destroy (L);
pragma Assert (Result = 0);
end Finalize_Lock;
@@ -336,37 +314,13 @@ package body System.Task_Primitives.Operations is
procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
Result : Interfaces.C.int;
-
begin
- if Priority_Ceiling_Emulation then
- declare
- Self_ID : constant Task_Id := Self;
-
- begin
- if Self_ID.Common.LL.Active_Priority > L.Ceiling then
- Ceiling_Violation := True;
- return;
- end if;
-
- L.Saved_Priority := Self_ID.Common.LL.Active_Priority;
+ Result := pthread_mutex_lock (L);
+ Ceiling_Violation := Result = EINVAL;
- if Self_ID.Common.LL.Active_Priority < L.Ceiling then
- Self_ID.Common.LL.Active_Priority := L.Ceiling;
- end if;
-
- Result := pthread_mutex_lock (L.L'Access);
- pragma Assert (Result = 0);
- Ceiling_Violation := False;
- end;
-
- else
- Result := pthread_mutex_lock (L.L'Access);
- Ceiling_Violation := Result = EINVAL;
-
- -- Assume the cause of EINVAL is a priority ceiling violation
+ -- Assume the cause of EINVAL is a priority ceiling violation
- pragma Assert (Result = 0 or else Result = EINVAL);
- end if;
+ pragma Assert (Result = 0 or else Result = EINVAL);
end Write_Lock;
procedure Write_Lock
@@ -405,25 +359,9 @@ package body System.Task_Primitives.Operations is
procedure Unlock (L : access Lock) is
Result : Interfaces.C.int;
-
begin
- if Priority_Ceiling_Emulation then
- declare
- Self_ID : constant Task_Id := Self;
-
- begin
- Result := pthread_mutex_unlock (L.L'Access);
- pragma Assert (Result = 0);
-
- if Self_ID.Common.LL.Active_Priority > L.Saved_Priority then
- Self_ID.Common.LL.Active_Priority := L.Saved_Priority;
- end if;
- end;
-
- else
- Result := pthread_mutex_unlock (L.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_unlock (L);
+ pragma Assert (Result = 0);
end Unlock;
procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
@@ -553,14 +491,8 @@ package body System.Task_Primitives.Operations is
Abs_Time : Duration;
Request : aliased timespec;
Result : Interfaces.C.int;
- begin
-
- -- Only the little window between deferring abort and
- -- locking Self_ID is the reason we need to
- -- check for pending abort and priority change below! :(
-
- SSL.Abort_Defer.all;
+ begin
if Single_Lock then
Lock_RTS;
end if;
@@ -611,7 +543,6 @@ package body System.Task_Primitives.Operations is
end if;
Result := sched_yield;
- SSL.Abort_Undefer.all;
end Timed_Delay;
---------------------
@@ -678,12 +609,6 @@ package body System.Task_Primitives.Operations is
begin
T.Common.Current_Priority := Prio;
- if Priority_Ceiling_Emulation then
- if T.Common.LL.Active_Priority < Prio then
- T.Common.LL.Active_Priority := Prio;
- end if;
- end if;
-
-- Priorities are in range 1 .. 99 on GNU/Linux, so we map
-- map 0 .. 31 to 1 .. 32
@@ -693,7 +618,7 @@ package body System.Task_Primitives.Operations is
Result := pthread_setschedparam
(T.Common.LL.Thread, SCHED_RR, Param'Access);
- elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
+ elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
Result := pthread_setschedparam
(T.Common.LL.Thread, SCHED_FIFO, Param'Access);
@@ -1167,6 +1092,26 @@ package body System.Task_Primitives.Operations is
begin
Environment_Task_Id := Environment_Task;
+ Interrupt_Management.Initialize;
+
+ -- Prepare the set of signals that should be unblocked in all tasks
+
+ Result := sigemptyset (Unblocked_Signal_Mask'Access);
+ pragma Assert (Result = 0);
+
+ for J in Interrupt_Management.Interrupt_ID loop
+ if System.Interrupt_Management.Keep_Unmasked (J) then
+ Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
+ pragma Assert (Result = 0);
+ end if;
+ end loop;
+
+ Result := pthread_mutexattr_init (Mutex_Attr'Access);
+ pragma Assert (Result = 0);
+
+ Result := pthread_condattr_init (Cond_Attr'Access);
+ pragma Assert (Result = 0);
+
Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
-- Initialize the global RTS lock
@@ -1196,26 +1141,4 @@ package body System.Task_Primitives.Operations is
end if;
end Initialize;
-begin
- declare
- Result : Interfaces.C.int;
- begin
- -- Prepare the set of signals that should unblocked in all tasks
-
- Result := sigemptyset (Unblocked_Signal_Mask'Access);
- pragma Assert (Result = 0);
-
- for J in Interrupt_Management.Interrupt_ID loop
- if System.Interrupt_Management.Keep_Unmasked (J) then
- Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
- pragma Assert (Result = 0);
- end if;
- end loop;
-
- Result := pthread_mutexattr_init (Mutex_Attr'Access);
- pragma Assert (Result = 0);
-
- Result := pthread_condattr_init (Cond_Attr'Access);
- pragma Assert (Result = 0);
- end;
end System.Task_Primitives.Operations;