2006-10-31 Arnaud Charlet <charlet@adacore.com>

	    Jose Ruiz  <ruiz@adacore.com>

	* s-osinte-posix.adb, s-osinte-linux.ads, s-osinte-freebsd.adb, 
	s-osinte-freebsd.ads, s-osinte-solaris-posix.ads, s-osinte-hpux.ads, 
	s-osinte-darwin.adb, s-osinte-darwin.ads, s-osinte-lynxos-3.ads,
	s-osinte-lynxos-3.adb (To_Target_Priority): New function maps from
	System.Any_Priority to a POSIX priority on the target.

	* system-linux-ia64.ads: 
	Extend range of Priority types on Linux to use the whole range made
	available by the system.

	* s-osinte-aix.adb, s-osinte-aix.ads (To_Target_Priority): New
	function maps from System.Any_Priority to a POSIX priority on the
	target.
	(PTHREAD_PRIO_PROTECT): Set real value.
	(PTHREAD_PRIO_INHERIT): Now a function.
	(SIGCPUFAIL): New signal.
	(Reserved): Add SIGALRM1, SIGWAITING, SIGCPUFAIL, since these signals
	are documented as reserved by the OS.

	* system-aix.ads: Use the full range of priorities provided by the
	system on AIX.

	* s-taprop-posix.adb: Call new function To_Target_Priority.
	(Set_Priority): Take into account Task_Dispatching_Policy and
	Priority_Specific_Dispatching pragmas when determining if Round Robin
	must be used for scheduling the task.

	* system-linux-x86_64.ads, system-linux-x86.ads, 
	system-linux-ppc.ads: Extend range of Priority types on Linux to use
	the whole range made available by the system.

	* s-taprop-vms.adb, s-taprop-mingw.adb, s-taprop-irix.adb, 
	s-taprop-tru64.adb, s-taprop-linux.adb, s-taprop-hpux-dce.adb, 
	s-taprop-lynxos.adb (Finalize_TCB): invalidate the stack-check cache
	when deallocating the TCB in order to avoid potential references to
	deallocated data.
	(Set_Priority): Take into account Task_Dispatching_Policy and
	Priority_Specific_Dispatching pragmas when determining if Round Robin
	or FIFO within priorities must be used for scheduling the task.

	* s-taprop-vxworks.adb (Enter_Task): Store the user-level task id in
	the Thread field (to be used internally by the run-time system) and the
	kernel-level task id in the LWP field (to be used by the debugger).
	(Create_Task): Reorganize to unify the calls to taskSpawn into a single
	instance, and propagate the current task options to the spawned task.
	(Set_Priority): Take into account Priority_Specific_Dispatching pragmas.
	(Initialize): Set Round Robin dispatching when the corresponding pragma
	is in effect.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@118235 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 37 insertions, 13 deletions

diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index 6455748751d..a41eb3f5570 100644
--- a/gcc/ada/s-taprop-linux.adb
+++ b/gcc/ada/s-taprop-linux.adb
@@ -63,6 +63,9 @@ with System.Soft_Links;
 --  For example when using the restricted run time, it is replaced by
 --  System.Tasking.Restricted.Stages.
 
+with System.Stack_Checking.Operations;
+--  Used for Invalidate_Stack_Cache;
+
 with Ada.Exceptions;
 --  used for Raise_Exception
 --           Raise_From_Signal_Handler
@@ -74,6 +77,7 @@ with Unchecked_Deallocation;
 package body System.Task_Primitives.Operations is
 
    package SSL renames System.Soft_Links;
+   package SC renames System.Stack_Checking.Operations;
 
    use System.Tasking.Debug;
    use System.Tasking;
@@ -144,7 +148,7 @@ package body System.Task_Primitives.Operations is
 
       function Self return Task_Id;
       pragma Inline (Self);
-      --  Return a pointer to the Ada Task Control Block of the calling task.
+      --  Return a pointer to the Ada Task Control Block of the calling task
 
    end Specific;
 
@@ -487,14 +491,16 @@ package body System.Task_Primitives.Operations is
    --  no locks.
 
    procedure Timed_Delay
-     (Self_ID  : Task_Id;
-      Time     : Duration;
-      Mode     : ST.Delay_Modes)
+     (Self_ID : Task_Id;
+      Time    : Duration;
+      Mode    : ST.Delay_Modes)
    is
       Check_Time : constant Duration := Monotonic_Clock;
       Abs_Time   : Duration;
       Request    : aliased timespec;
-      Result     : Interfaces.C.int;
+
+      Result : Interfaces.C.int;
+      pragma Warnings (Off, Result);
 
    begin
       if Single_Lock then
@@ -523,11 +529,15 @@ package body System.Task_Primitives.Operations is
             exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
 
             if Single_Lock then
-               Result := pthread_cond_timedwait (Self_ID.Common.LL.CV'Access,
-                 Single_RTS_Lock'Access, Request'Access);
+               Result := pthread_cond_timedwait
+                           (Self_ID.Common.LL.CV'Access,
+                            Single_RTS_Lock'Access,
+                            Request'Access);
             else
-               Result := pthread_cond_timedwait (Self_ID.Common.LL.CV'Access,
-                 Self_ID.Common.LL.L'Access, Request'Access);
+               Result := pthread_cond_timedwait
+                           (Self_ID.Common.LL.CV'Access,
+                            Self_ID.Common.LL.L'Access,
+                            Request'Access);
             end if;
 
             exit when Abs_Time <= Monotonic_Clock;
@@ -610,19 +620,33 @@ package body System.Task_Primitives.Operations is
       Result : Interfaces.C.int;
       Param  : aliased struct_sched_param;
 
+      function Get_Policy (Prio : System.Any_Priority) return Character;
+      pragma Import (C, Get_Policy, "__gnat_get_specific_dispatching");
+      --  Get priority specific dispatching policy
+
+      Priority_Specific_Policy : constant Character := Get_Policy (Prio);
+      --  Upper case first character of the policy name corresponding to the
+      --  task as set by a Priority_Specific_Dispatching pragma.
+
    begin
       T.Common.Current_Priority := Prio;
 
       --  Priorities are in range 1 .. 99 on GNU/Linux, so we map
-      --  map 0 .. 31 to 1 .. 32
+      --  map 0 .. 98 to 1 .. 99
 
       Param.sched_priority := Interfaces.C.int (Prio) + 1;
 
-      if Time_Slice_Val > 0 then
+      if Dispatching_Policy = 'R'
+        or else Priority_Specific_Policy = 'R'
+        or else Time_Slice_Val > 0
+      then
          Result := pthread_setschedparam
            (T.Common.LL.Thread, SCHED_RR, Param'Access);
 
-      elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
+      elsif Dispatching_Policy = 'F'
+        or else Priority_Specific_Policy = 'F'
+        or else Time_Slice_Val = 0
+      then
          Result := pthread_setschedparam
            (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
 
@@ -815,7 +839,7 @@ package body System.Task_Primitives.Operations is
       if T.Known_Tasks_Index /= -1 then
          Known_Tasks (T.Known_Tasks_Index) := null;
       end if;
-
+      SC.Invalidate_Stack_Cache (T.Common.Compiler_Data.Pri_Stack_Info'Access);
       Free (Tmp);
 
       if Is_Self then