------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a GNU GPL real-time scheduling analysis tool. -- This program provides services to automatically check schedulability and -- other performance criteria of real-time architecture models. -- -- Copyright (C) 2002-2020, Frank Singhoff, Alain Plantec, Jerome Legrand, -- Hai Nam Tran, Stephane Rubini -- -- The Cheddar project was started in 2002 by -- Frank Singhoff, Lab-STICC UMR 6285, Université de Bretagne Occidentale -- -- Cheddar has been published in the "Agence de Protection des Programmes/France" in 2008. -- Since 2008, Ellidiss technologies also contributes to the development of -- Cheddar and provides industrial support. -- -- The full list of contributors and sponsors can be found in AUTHORS.txt and SPONSORS.txt -- -- 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$ -- $Date$ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Translate; use Translate; with text_io; use text_io; 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 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 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; Core_Name : in Unbounded_String; Options : in Scheduling_Option; 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; begin -- For each task, call "check_resources" 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 if ( (si.tcbs(i).tsk.core_name = To_Unbounded_String ("")) or (si.tcbs(i).tsk.core_name=core_name) ) then if (Si.Tcbs (I).Wake_Up_Time <= Current_Time) and (Si.Tcbs (I).Rest_Of_Capacity /= 0) then Check_jitter(Si.Tcbs (I), Current_Time, Si.Tcbs (I).is_jitter_ready ); if (Options.With_jitters = False) or (Si.Tcbs (I).is_jitter_ready) then if (Options.With_Offsets = False) or Check_Offset (Si.Tcbs (I), Current_Time) then if (Options.With_Precedencies = False) or Check_Precedencies (Si, Current_Time, Si.Tcbs (I)) then if Options.With_Resources then Check_Resource (My_Scheduler, Si, Result, Current_Time, Si.Tcbs (I), Fixed_Priority_Tcb_Ptr (Si.Tcbs (I)).Is_Resource_Ready, Event_To_Generate); end if; end if; 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.tsk.core_name = To_Unbounded_String ("")) or (current.tsk.core_name=core_name) ) then if not Tcb_Ptr(current).already_run_at_current_time then if Check_Core_Assignment(my_scheduler, Tcb_Ptr(current)) then if (Current.Wake_Up_Time <= Current_Time) and (Current.Rest_Of_Capacity /= 0) then if (Options.With_jitters = False) or (Tcb_ptr(current).is_jitter_ready) then if (Options.With_Offsets = False) or Check_Offset (Tcb_Ptr (Current), Current_Time) then if (Options.With_Precedencies = False) or Check_Precedencies (Si, Current_Time, Tcb_Ptr (Current)) then if (Options.With_Resources = False) or Fixed_Priority_Tcb_Ptr (Current).Is_Resource_Ready then -- the priority level is selected -- Ready := True; Found := True; exit; end if; end if; end if; 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); if (Current.Wake_Up_Time <= Current_Time) and (Current.Rest_Of_Capacity /= 0) then if (Options.With_jitters = False) or (Tcb_ptr(current).is_jitter_ready) then if (Options.With_Offsets = False) or Check_Offset (tcb_ptr(current), Current_Time) then if (Options.With_Resources = False) or Fixed_Priority_Tcb_Ptr (Current).Is_Resource_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 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; 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; end Scheduler.Fixed_Priority.Hpf;