------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 Text_IO; use Text_IO; with Translate; use Translate; with feasibility_test.processor_utilization; use feasibility_test.processor_utilization; with Parameters; use Parameters; use Parameters.User_Defined_Parameters_Table_Package; package body Scheduler.Fixed_Priority.Hpf is function Build_Tcb (My_Scheduler : in Hpf_Scheduler; A_Task : Generic_Task_Ptr) return Tcb_Ptr is A_Tcb : Hpf_Tcb_Ptr; begin A_Tcb := new Hpf_Tcb; Initialize (Tcb (A_Tcb.all), A_Task); Initialize (Fixed_Priority_Tcb (A_Tcb.all)); Initialize (A_Tcb.all); return Tcb_Ptr (A_Tcb); end Build_Tcb; procedure Initialize (A_Tcb : in out Hpf_Tcb) is begin A_Tcb.Task_Quantum := 0; end Initialize; procedure Initialize (A_Scheduler : in out Hpf_Scheduler) is begin Reset (A_Scheduler); A_Scheduler.parameters.scheduler_type := Posix_1003_Highest_Priority_First_Protocol; end Initialize; function Copy (A_Scheduler : in Hpf_Scheduler) return Generic_Scheduler_Ptr is Ptr : Hpf_Scheduler_Ptr; begin Ptr := new Hpf_Scheduler; Ptr.parameters := A_Scheduler.parameters; Ptr.Previously_Elected := A_Scheduler.Previously_Elected; Ptr.Used_Resource := A_Scheduler.Used_Resource; Ptr.Priority_Fifos := A_Scheduler.Priority_Fifos; return Generic_Scheduler_Ptr (Ptr); end Copy; procedure Check_Before_Scheduling (My_Scheduler : in Hpf_Scheduler; My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String) is begin null; end Check_Before_Scheduling; procedure Compute_Response_Time (My_Scheduler : in Hpf_Scheduler; My_Tasks : in out Tasks_Set; Processor_Name : in Unbounded_String; Msg : in out Unbounded_String; Response_Time : out Response_Time_Table) is begin -- Check if tasks are periodics -- Periodic_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; -- Check start time -- Start_Time_Control (My_Tasks, Processor_Name); -- Check offset -- Offset_Control (My_Tasks, Processor_Name); -- Compute response time -- Scheduler.Fixed_Priority.Compute_Response_Time (Fixed_Priority_Scheduler (My_Scheduler), My_Tasks, Processor_Name, Msg, Response_Time); end Compute_Response_Time; procedure Put_Tcb (E : Hpf_Tcb_Ptr) is begin null; end Put_Tcb; procedure Specific_Scheduler_Initialization (My_Scheduler : in out Hpf_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 Index : Tasks_Range := 0; begin for I in Priority_Range loop reset (My_Scheduler.Priority_Fifos (I)); end loop; for I in 0 .. Si.Number_Of_Tasks - 1 loop if (Si.Tcbs (I).Tsk.cpu_name = Processor_Name) and ((address_space_name = To_Unbounded_String ("")) or (address_space_name = Si.Tcbs (I).Tsk.address_space_name)) then Fixed_Priority_Tcb_Ptr (Si.Tcbs (I)).Current_Priority := Si.Tcbs (I).Tsk.priority; Hpf_Tcb_Ptr (Si.Tcbs (I)).Task_Quantum := My_Scheduler.parameters.quantum; end if; end loop; -- Insert task info fifos according to -- their priority level -- loop if (Si.Tcbs (Index).Tsk.cpu_name = Processor_Name) and ((address_space_name = To_Unbounded_String ("")) or (address_space_name = Si.Tcbs (Index).Tsk.address_space_name)) then -- MOD: There is actually no direct modification, -- but since tasks in a same task_group are consecuitive in Si.Tcbs, -- they are consecuitive when they are added to their respective Priority_Fifo. insert (My_Scheduler.Priority_Fifos ( Hpf_Tcb_Ptr (Si.Tcbs (Index)).Current_Priority), Hpf_Tcb_Ptr (Si.Tcbs (Index))); end if; Index := Index + 1; exit when Si.Tcbs (Index) = null; end loop; -- Set priority ceiling of resources (only for PCP resource -- Compute_Ceiling_Of_Resources (My_Scheduler, Si, Processor_Name, address_space_name, My_Tasks, My_Resources); end Specific_Scheduler_Initialization; procedure Do_Election (My_Scheduler : in out Hpf_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Msg : in out Unbounded_String; Current_Time : in Natural; Processor_Name : in Unbounded_String; Address_Space_Name : in Unbounded_String; My_Dependencies : in Tasks_Dependencies_Ptr; With_Offsets : in Boolean; With_Precedencies : in Boolean; With_Resources : in Boolean; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table; Elected : in out Tasks_Range; No_Task : in out Boolean) is Ready, Found : Boolean; Selected_Priority : Priority_Range; Index : Tasks_Range := 0; Current : Hpf_Tcb_Ptr; Elected_Task : Hpf_Tcb_Ptr := null; Max_Cpu_Usage : Natural := Natural'Last; -- MOD: For fair play handling Fairplay_Task_Group : Generic_Task_Group_Ptr; FifoIndex : Natural; begin -- For each task, call "check_ressources" to -- take care of priority modification (PCP and PIP) -- for I in 0 .. Si.Number_Of_Tasks - 1 loop if (Si.Tcbs (I).Tsk.cpu_name = Processor_Name) and ((Address_Space_Name = To_Unbounded_String ("")) or (Address_Space_Name = Si.Tcbs (I).Tsk.address_space_name)) then -- MOD: Added Jitter to Wake_Up_Time if (Si.Tcbs (I).Wake_Up_Time + Si.Tcbs (I).Current_Jitter <= Current_Time) and (Si.Tcbs (I).Rest_Of_Capacity /= 0) then if (With_Offsets = False) or Check_Offset (Si.Tcbs (I), Current_Time) then if (With_Precedencies = False) or Check_Precedencies (Si, My_Dependencies, Current_Time, Si.Tcbs (I)) then if With_Resources then Check_Resource (My_Scheduler, Si, Result, Current_Time, Si.Tcbs (I), Fixed_Priority_Tcb_Ptr (Si.Tcbs (I)).Is_Ready, Event_To_Generate); end if; end if; end if; end if; end if; end loop; -- Scan fifos to find the highest priority level -- with a ready task -- Warning : WE DO NOT CHANGE TASK POSITION IN THE -- FIFOS -- Selected_Priority := Priority_Range'Last; Found := False; loop if not is_empty (My_Scheduler.Priority_Fifos (Selected_Priority)) then for I in 1 .. get_size (My_Scheduler.Priority_Fifos (Selected_Priority)) loop Current := consult (My_Scheduler.Priority_Fifos (Selected_Priority)); -- is the task ready ? -- Ready := False; if (current.assigned_core_unit = empty_string or current.assigned_core_unit = My_Scheduler.corresponding_core_unit) then -- MOD: Added Jitter to Wake_Up_Time if (Current.Wake_Up_Time + Current.Current_Jitter <= Current_Time) and (Current.Rest_Of_Capacity /= 0) then if (With_Offsets = False) or Check_Offset (Tcb_Ptr (Current), Current_Time) then if (With_Precedencies = False) or Check_Precedencies (Si, My_Dependencies, Current_Time, Tcb_Ptr (Current)) then if (With_Resources = False) or Fixed_Priority_Tcb_Ptr (Current).Is_Ready then -- the priority level is selected -- Ready := True; Found := True; exit; end if; end if; end if; end if; end if; -- The current task is not ready ... -- put it the queue of the fifo -- and look for the Next element -- of the fifo -- if (Ready = False) then extract (My_Scheduler.Priority_Fifos (Selected_Priority), Current); insert (My_Scheduler.Priority_Fifos (Selected_Priority), Current); end if; end loop; end if; -- A fifo is already selected ... get out !! -- and never come back ......... -- if Found then No_Task := False; exit; end if; -- No task found = no task to schedule -- if (Selected_Priority = Priority_Range'First) then No_Task := True; return; end if; Selected_Priority := Selected_Priority - 1; end loop; -- Priority level is selected : find the task -- in the head of the fifo : this task is the elected -- task -- -- Task sharing policies -- if (Selected_Priority = 0) then -- Loop and looking for the less consuming -- task -- Max_Cpu_Usage := Natural'Last; for I in 1 .. get_size (My_Scheduler.Priority_Fifos (Selected_Priority)) loop extract (My_Scheduler.Priority_Fifos (Selected_Priority), Current); insert (My_Scheduler.Priority_Fifos (Selected_Priority), Current); -- MOD: Added Jitter to Wake_Up_Time if (Current.Wake_Up_Time + Current.Current_Jitter <= Current_Time) and (Current.Rest_Of_Capacity /= 0) then if (With_Offsets = False) or Check_Offset (Tcb_Ptr (Current), Current_Time) then if (With_Resources = False) or Fixed_Priority_Tcb_Ptr (Current).Is_Ready then if (Current.Used_Cpu <= Max_Cpu_Usage) then Max_Cpu_Usage := Current.Used_Cpu; Elected_Task := Current; end if; end if; end if; end if; end loop; else -- SCHED_FIFO or SCHED_RR task -- Elected_Task := consult (My_Scheduler.Priority_Fifos (Selected_Priority)); -- is the task quantum exausted ? -- if so and if SCHED_RR is set -- the task have to be moved to -- the queue of the fifo -- if (Elected_Task.Tsk.policy = Sched_Rr) then if (My_Scheduler.parameters.quantum > 0) then Elected_Task.Task_Quantum := Elected_Task.Task_Quantum - 1; if (Elected_Task.Task_Quantum = 0) then Elected_Task.Task_Quantum := My_Scheduler.parameters.quantum; extract (My_Scheduler.Priority_Fifos (Selected_Priority), Elected_Task); insert (My_Scheduler.Priority_Fifos (Selected_Priority), Elected_Task); end if; end if; end if; -- MOD: fairplay: when a task has the "yield" parameter, -- it is put at the end of the FIFO. -- All tasks that are part of the same task_group as the task with yield, -- are also put at the end of the FIFO. -- Remember that tasks part of the same task_group are consecuitive so we stop -- extracting/inserting when a task in a different task_group is found. -- To avoid infinity loop in case the FIFO only contains task part of the same task_group, -- we stop when the FIFO size is reached, i.e. we looped through every entry in the FIFO once. if Elected_Task.Rest_Of_Capacity = 1 then if Elected_Task.Tsk.parameters.nb_entries > 0 then for I in 0 .. Elected_Task.Tsk.parameters.nb_entries - 1 loop if Elected_Task.Tsk.parameters.entries (I).type_of_parameter = Boolean_Parameter and then Elected_Task.Tsk.parameters.entries (I).parameter_name = "yield" and then Elected_Task.Tsk.parameters.entries (I).boolean_value then Fairplay_Task_Group := null; for I in 0 .. Si.Number_Of_Task_Groups loop if Task_Is_Present_In_Group(Si.Task_Groups(I), Elected_Task.Tsk.name) then Fairplay_Task_Group := Si.Task_Groups(I); exit; end if; end loop; FifoIndex := 0; Current := consult (My_Scheduler.Priority_Fifos (Selected_Priority)); while FifoIndex < get_size (My_Scheduler.Priority_Fifos (Selected_Priority)) and Task_Is_Present_In_Group(Fairplay_Task_Group, Current.Tsk.name) loop extract (My_Scheduler.Priority_Fifos (Selected_Priority), Current); insert (My_Scheduler.Priority_Fifos (Selected_Priority), Current); Current := consult (My_Scheduler.Priority_Fifos (Selected_Priority)); FifoIndex := FifoIndex + 1; end loop; end if; end loop; end if; end if; end if; if (Elected_Task /= null) then Index := 0; loop if (Si.Tcbs (Index).Tsk.name = Elected_Task.Tsk.name) then Elected := Index; exit; end if; Index := Index + 1; exit when Si.Tcbs (Index) = null; end loop; end if; end Do_Election; procedure Dispatched_Change_Current_Priority (My_Scheduler : in out Hpf_Scheduler; A_Tcb : in Fixed_Priority_Tcb_Ptr; New_Priority : Priority_Range) is begin extract_any_where (My_Scheduler.Priority_Fifos (A_Tcb.Current_Priority), Hpf_Tcb_Ptr (A_Tcb)); A_Tcb.Current_Priority := New_Priority; insert (My_Scheduler.Priority_Fifos (A_Tcb.Current_Priority), Hpf_Tcb_Ptr (A_Tcb)); end Dispatched_Change_Current_Priority; procedure Utilization_Factor_Feasibility_Test (My_Scheduler : in Hpf_Scheduler; My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String; Result : in out Unbounded_String) is begin Result := Result & Lb_Pb_Sched_Unknown (Current_Language) & unbounded_lf; end Utilization_Factor_Feasibility_Test; end Scheduler.Fixed_Priority.Hpf;