------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a GNU GPL real time scheduling analysis tool. -- This program provides services to automatically check performances -- of real time architectures. -- -- Copyright (C) 2002-2010, by Frank Singhoff, Alain Plantec, Jerome Legrand -- -- The Cheddar project was started in 2002 by -- the LISyC Team, University of Western Britanny. -- -- Since 2008, Ellidiss technologies also contributes to the development of -- Cheddar and provides industrial support. -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT 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 -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- -- -- Contact : cheddar@listes.univ-brest.fr -- ----------------------------------------------------------------------------- -- Last update : -- $Rev: 523 $ -- $Date: 2012-09-26 15:09:39 +0200 (Wed, 26 Sep 2012) $ -- $Author: fotsing $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Translate; use Translate; with unbounded_strings; use unbounded_strings; with Scheduling_Analysis; use Scheduling_Analysis; use Scheduling_Analysis.Double_Tasks_Parameters_Package; with feasibility_test.processor_utilization; use feasibility_test.processor_utilization; package body Scheduler.Dynamic_Priority is function Build_Tcb (My_Scheduler : in Dynamic_Priority_Scheduler; A_Task : Generic_Task_Ptr) return Tcb_Ptr is A_Tcb : Dynamic_Priority_Tcb_Ptr; begin A_Tcb := new Dynamic_Priority_Tcb; Initialize (Tcb (A_Tcb.all), A_Task); Initialize (A_Tcb.all); return Tcb_Ptr (A_Tcb); end Build_Tcb; procedure Initialize (A_Tcb : in out Dynamic_Priority_Tcb) is begin A_Tcb.Dynamic_Deadline := A_Tcb.Tsk.deadline + A_Tcb.Wake_Up_Time; end Initialize; procedure Check_Before_Scheduling (My_Scheduler : in Dynamic_Priority_Scheduler; My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String) is begin null; end Check_Before_Scheduling; procedure Compute_Blocking_Time (My_Scheduler : in Dynamic_Priority_Scheduler; My_Tasks : in Tasks_Set; My_Resources : in Resources_Set; Processor_Name : in Unbounded_String; Msg : in out Unbounded_String; Blocking_Time : out Blocking_Time_Table) is begin raise Invalid_Scheduler; end Compute_Blocking_Time; procedure Bound_On_Processor_Utilization (My_Scheduler : in Dynamic_Priority_Scheduler; My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String; Result : in out Double; Msg : in out Unbounded_String) is begin Result := 1.0; Msg := To_Unbounded_String (" (") & Lb_See (Current_Language) & To_Unbounded_String ("[1], page 8, ") & Lb_Theorem (Current_Language) & To_Unbounded_String ("2). ") & unbounded_lf; end Bound_On_Processor_Utilization; function Compute_Wi_A_T (My_Tasks : in Tasks_Set; Taski : in Generic_Task_Ptr; A : in Integer; T : in Double) return Double is Result : Double := 0.0; Min : Double := 0.0; Iterator : Tasks_Iterator; Taskj : Generic_Task_Ptr; begin reset_iterator (My_Tasks, Iterator); loop current_element (My_Tasks, Taskj, Iterator); if ((Taskj.name /= Taski.name) and (Taskj.deadline <= A + Taski.deadline)) then Min := 1.0 + Double'Floor ((Double (A) + Double (Taski.deadline) - Double (Taskj.deadline)) / Double (Periodic_Task_Ptr (Taskj).period)); if (Double'Ceiling (T / Double (Periodic_Task_Ptr (Taskj).period)) < Min) then Min := Double'Ceiling (T / Double (Periodic_Task_Ptr (Taskj).period)); end if; Result := Result + Min * Double (Taskj.capacity); end if; -- exit loop when there is no more task -- exit when is_last_element (My_Tasks, Iterator); next_element (My_Tasks, Iterator); end loop; return Result; end Compute_Wi_A_T; function Compute_Li_A (My_Scheduler : in Dynamic_Priority_Scheduler; My_Tasks : in Tasks_Set; Taski : in Generic_Task_Ptr; A : in Integer) return Double is Li_A : Double := 0.1; Li_A_1 : Double := 0.0; Iterator : Tasks_Iterator; Taskj : Generic_Task_Ptr; Max_Cj : Natural := 0; Tmp : Double := 0.0; Min : Double := 0.0; Min1 : Double := 0.0; Min2 : Double := 0.0; begin if (My_Scheduler.parameters.preemptive_type = preemptive) then -- preemptive case -- while Li_A_1 /= Li_A loop Li_A := Li_A_1; Li_A_1 := Compute_Wi_A_T (My_Tasks, Taski, A, Li_A); case Taski.task_type is when Periodic_Type => Li_A_1 := Li_A_1 + (1.0 + Double'Floor (Double (A) / Double (Periodic_Task_Ptr (Taski).period))) * Double (Taski.capacity); when others => raise Constraint_Error; end case; end loop; else -- non preemptive case -- while Li_A_1 /= Li_A loop Li_A := Li_A_1; Tmp := 0.0; reset_iterator (My_Tasks, Iterator); loop current_element (My_Tasks, Taskj, Iterator); if ((A + Taski.deadline) < Taskj.deadline) then if (Taskj.capacity > Max_Cj) then Max_Cj := Taskj.capacity; end if; end if; if ((Taskj.name /= Taski.name) and (Taskj.deadline <= A + Taski.deadline)) then Min1 := 1.0 + Double'Floor (Li_A / Double (Periodic_Task_Ptr (Taskj).period)); Min2 := 1.0 + Double'Floor (Double (A) + Double (Taski.deadline) - Double (Taskj.deadline)) / Double (Periodic_Task_Ptr (Taskj).period); Min := Min1; if (Min2 < Min) then Min := Min2; end if; Tmp := Tmp + Min * Double (Taskj.capacity) + Double'Floor (Double (A) / Double (Periodic_Task_Ptr (Taskj).period)) * Double (Taski.capacity); end if; -- exit loop when there is no more task -- exit when is_last_element (My_Tasks, Iterator); next_element (My_Tasks, Iterator); end loop; Li_A_1 := Double (Max_Cj) + Tmp; end loop; end if; return Li_A; end Compute_Li_A; -- This function may present an infinite loop for non-preemptive case -- It may come from the upper bound for a: (exit when a >= Li(a)) -- procedure Compute_Response_Time (My_Scheduler : in Dynamic_Priority_Scheduler; My_Tasks : in out Tasks_Set; Processor_Name : in Unbounded_String; Msg : in out Unbounded_String; Response_Time : out Response_Time_Table) is Tmp : Tasks_Set; Iterator1 : Tasks_Iterator; Taski : Generic_Task_Ptr; Iterator2 : Tasks_Iterator; Taskj : Generic_Task_Ptr; I : Response_Time_Range := 0; A : Integer := 0; B_Sup : Double := 0.0; Li_A : Double := 0.0; K : Natural := 0; begin initialize (Response_Time); -- check if tasks are periodics -- Periodic_Control (My_Tasks, Processor_Name); -- check start time -- Start_Time_Control (My_Tasks, Processor_Name); -- check offset -- Offset_Control (My_Tasks, Processor_Name); -- Check processor utilization first -- if (Processor_Utilization_Over_Period (My_Tasks, Processor_Name) > 1.0) then raise Processor_Utilization_Exceeded; end if; -- Select task to proceed -- Current_Processor_Name := Processor_Name; select_and_copy (My_Tasks, Tmp, Select_Cpu'Access); reset_iterator (Tmp, Iterator1); loop -- selection of the current task -- current_element (Tmp, Taski, Iterator1); -- initialize response time for current task -- Response_Time.entries (I).data := 0.0; Response_Time.entries (I).item := Taski; Response_Time.nb_entries := Response_Time.nb_entries + 1; if (My_Scheduler.parameters.preemptive_type = preemptive) then Response_Time.entries (I).data := Double (Taski.capacity); end if; -- compute S "on the fly" -- reset_iterator (Tmp, Iterator2); loop current_element (Tmp, Taskj, Iterator2); K := 0; loop case Taskj.task_type is when Periodic_Type => A := (K * Periodic_Task_Ptr (Taskj).period) + Taskj.deadline - Taski.deadline; when others => raise Constraint_Error; end case; Li_A := Compute_Li_A (My_Scheduler, Tmp, Taski, A); if ((Li_A - Double (A)) > Response_Time.entries (I).data) then Response_Time.entries (I).data := Li_A - Double (A); -- PROBLEM -- with non preemptive case response_time has no upper bound --in some cases -- Put(Natural(Response_Time.Entries(i).Data)'Img) ; end if; if (My_Scheduler.parameters.preemptive_type = preemptive) then B_Sup := Li_A; else B_Sup := Li_A; end if; exit when (Double (A) >= B_Sup); -- PROBLEM : the lines below try yo fix the problem described --10 lines -- before (see morin2003.doc) -- The "exit when K" statement is not a part of the EDF --response time -- computation : it's just a way to be sure that the response -- time computation never loop for ever .... This Exit statement -- HAVE TO BE REMOVED BEFORE EDF response time computation will --be -- strongly tested by users -- --exit when Response_Time.Entries(I).Data > Double( -- Taski.Deadline); exit when K > 10000; K := K + 1; end loop; exit when is_last_element (Tmp, Iterator2); -- go to the next task -- next_element (Tmp, Iterator2); end loop; exit when is_last_element (Tmp, Iterator1); -- go to the next task -- next_element (Tmp, Iterator1); I := I + 1; end loop; end Compute_Response_Time; procedure Specific_Scheduler_Initialization (My_Scheduler : in out Dynamic_Priority_Scheduler; Si : in out Scheduling_Information; Processor_Name : in Unbounded_String; address_space_name : in Unbounded_String; My_Tasks : in out Tasks_Set; my_schedulers : in Scheduler_table; My_Resources : in out Resources_Set; My_Buffers : in out Buffers_Set; My_Messages : in Messages_Set; Msg : in out Unbounded_String) is begin null; end Specific_Scheduler_Initialization; end Scheduler.Dynamic_Priority;