The run time contained code which tried to rearrange the ready queue
in order to achieve Annex D semantics. This code was not very efficient,
and it did not work with multiprocessors. We consider that we should
live with standard Windows semantics.
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-07-09 Jose Ruiz <r...@adacore.com>
* s-taprop-mingw.adb (Set_Priority): Remove the code that was
previously in place to reorder the ready queue when a task drops
its priority due to the loss of inherited priority.
Index: s-taprop-mingw.adb
===================================================================
--- s-taprop-mingw.adb (revision 189366)
+++ s-taprop-mingw.adb (working copy)
@@ -716,58 +716,29 @@
-- Set_Priority --
------------------
- type Prio_Array_Type is array (System.Any_Priority) of Integer;
- pragma Atomic_Components (Prio_Array_Type);
-
- Prio_Array : Prio_Array_Type;
- -- Global array containing the id of the currently running task for
- -- each priority.
- --
- -- Note: we assume that we are on a single processor with run-til-blocked
- -- scheduling.
-
procedure Set_Priority
(T : Task_Id;
Prio : System.Any_Priority;
Loss_Of_Inheritance : Boolean := False)
is
- Res : BOOL;
- Array_Item : Integer;
+ Res : BOOL;
+ pragma Unreferenced (Loss_Of_Inheritance);
begin
Res := SetThreadPriority
(T.Common.LL.Thread, Interfaces.C.int (Underlying_Priorities (Prio)));
pragma Assert (Res = Win32.TRUE);
- if Dispatching_Policy = 'F' or else Get_Policy (Prio) = 'F' then
+ -- Note: Annex D (RM D.2.3(5/2)) requires the task to be placed at the
+ -- head of its priority queue when decreasing its priority as a result
+ -- of a loss of inherited priority. This is not the case, but we
+ -- consider it an acceptable variation (RM 1.1.3(6)), given this is the
+ -- built-in behavior offered by the Windows operating system.
- -- Annex D requirement [RM D.2.2 par. 9]:
- -- If the task drops its priority due to the loss of inherited
- -- priority, it is added at the head of the ready queue for its
- -- new active priority.
+ -- In older versions we attempted to better approximate the Annex D
+ -- required behavior, but this simulation was not entirely accurate,
+ -- and it seems better to live with the standard Windows semantics.
- if Loss_Of_Inheritance
- and then Prio < T.Common.Current_Priority
- then
- Array_Item := Prio_Array (T.Common.Base_Priority) + 1;
- Prio_Array (T.Common.Base_Priority) := Array_Item;
-
- loop
- -- Let some processes a chance to arrive
-
- Yield;
-
- -- Then wait for our turn to proceed
-
- exit when Array_Item = Prio_Array (T.Common.Base_Priority)
- or else Prio_Array (T.Common.Base_Priority) = 1;
- end loop;
-
- Prio_Array (T.Common.Base_Priority) :=
- Prio_Array (T.Common.Base_Priority) - 1;
- end if;
- end if;
-
T.Common.Current_Priority := Prio;
end Set_Priority;
