------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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-2023, Frank Singhoff, Alain Plantec, Jerome Legrand, -- Hai Nam Tran, Stephane Rubini -- -- The Cheddar project was started in 2002 by -- Frank Singhoff, Lab-STICC UMR CNRS 6285, Universite 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 README.md -- -- 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: 4589 $ -- $Date: 2023-09-29 16:02:19 +0200 (ven. 29 sept. 2023) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with sets; with task_set; use task_set; use type task_set.tasks_range; --#[debug] with debug; use debug; --------------------------------------------------------------------- -- Package Heuristics -- Purpose: Contain types definitions, functions and procedures -- usefull for heuristics manipulations. -- Extra: # Documentations on methods are puts in the specification file. --------------------------------------------------------------------- package body Heuristics is -------------------------- -- Heuristic_1::Can_Run -- -------------------------- function Can_Run (This : in out heuristic_1; Si : in scheduling_information) return Boolean is begin put_debug ("__DEBUG__ :: Can_Run -> Heuristic_1 [Not Implemented]"); return True; end Can_Run; -------------------------- -- Heuristic_2::Can_Run -- -------------------------- function Can_Run (This : in out heuristic_2; Si : in scheduling_information) return Boolean is begin put_debug ("__DEBUG__ :: Can_Run -> Heuristic_2 [Not Implemented]"); return True; end Can_Run; ------------------------- -- Heuristic_1::Update -- ------------------------- procedure Update_Values (This : in out heuristic_1; No_Task : in Boolean; Core_Id : in Natural) is begin if No_Task then Increase_Idle_Times (This, Core_Id); else Decrease_Idle_Times (This, Core_Id); end if; end Update_Values; ------------------------------- -- Heuristic_1::Reset_Values -- ------------------------------- procedure Reset_Values (This : in out heuristic_1; Core_Id : in Natural) is begin This.CNTI (Natural (Core_Id)) := 0; This.Number_Of_Valid_Idle_Times := 0; end Reset_Values; -------------------------------------- -- Heuristic_1::Decrease_Idle_Times -- -------------------------------------- procedure Decrease_Idle_Times (This : in out heuristic_1; Core_Id : in Natural) is begin This.CNTI (Natural (Core_Id)) := 0; This.Number_Of_Valid_Idle_Times := (if This.Number_Of_Valid_Idle_Times = 0 then 0 else This.Number_Of_Valid_Idle_Times - 1); end Decrease_Idle_Times; -------------------------------------- -- Heuristic_1::Increase_Idle_Times -- -------------------------------------- procedure Increase_Idle_Times (This : in out heuristic_1; Core_Id : in Natural) is begin This.CNTI (Natural (Core_Id)) := This.CNTI (Natural (Core_Id)) + 1; if This.CNTI (Natural (Core_Id)) = 2 then This.Number_Of_Valid_Idle_Times := This.Number_Of_Valid_Idle_Times + 1; end if; end Increase_Idle_Times; ---------------------------- -- Heuristic_1::Calculate -- ---------------------------- function Calculate (This : in out heuristic_1; Si : in scheduling_information) return Natural is Nearest_Wake_Up_Time : Natural := Natural'last; begin put_debug ("__INFO__ :: Number_Of_Valid_Idle_Times -> TRUE"); for num_task in 1 .. Si.number_of_tasks - 1 loop if Si.tcbs (num_task).wake_up_time < Nearest_Wake_Up_Time then Nearest_Wake_Up_Time := Si.tcbs (num_task).wake_up_time; end if; end loop; put_debug ("__INFO__ :: Nearest_Wake_Up_Time -> " & Nearest_Wake_Up_Time'img); return Nearest_Wake_Up_Time; end Calculate; ---------------------------- -- Heuristic_2::Calculate -- ---------------------------- function Calculate (This : in out heuristic_2; Si : in scheduling_information) return Natural is Jump_Time : Natural; Nearest_Wake_Up_Time : Natural; begin Jump_Time := This.Current_Time + Si.tcbs (This.Remaining_Task_Id).rest_of_capacity; Nearest_Wake_Up_Time := Get_Nearest_Wake_Up_Time (This, Si); Si.tcbs (This.Remaining_Task_Id).rest_of_capacity := Jump_Time - Nearest_Wake_Up_Time + 1; Si.tcbs (This.Remaining_Task_Id).used_capacity := Si.tcbs (This.Remaining_Task_Id).tsk.capacity - (Jump_Time - Nearest_Wake_Up_Time) - 1; if Nearest_Wake_Up_Time < Jump_Time then Jump_Time := Nearest_Wake_Up_Time; end if; return Jump_Time; end Calculate; -- procedure TestCalculation(Heuristic : Concrete_Heuristics'Class) is -- begin -- Put_Debug( "Testing an heuristic" ); -- Put_Debug( Calculate(Heuristic)'Img' ); -- end TestCalculation; ---------------------------------------- -- Heuristic_2::Verify_Pre_Conditions -- ---------------------------------------- function Verify_Pre_Conditions (This : in out heuristic_2; Si : in scheduling_information) return Boolean is tmp : Natural := 0; begin -- Test number of remaining jobs: if not Get_Remaining_Task (This, Si, This.Current_Time) then return False; end if; if (Si.tcbs (This.Remaining_Task_Id).rest_of_capacity > Si.tcbs (This.Remaining_Task_Id).tsk.capacity - 2) then This.Commit_Unit := Si.tcbs (This.Remaining_Task_Id).tsk.capacity - 2; end if; -- Test the capacity of the remaining job: if Si.tcbs (This.Remaining_Task_Id).tsk.capacity <= 2 then return False; end if; -- Test the starting event commit: if Si.tcbs (This.Remaining_Task_Id).wake_up_time > This.Current_Time or Si.tcbs (This.Remaining_Task_Id).rest_of_capacity >= This.Commit_Unit then return False; end if; -- Test the nearest wake up time: tmp := Get_Nearest_Wake_Up_Time (This, Si); if (tmp - This.Current_Time) <= 2 then return False; end if; -- Test the jump time: if ((This.Current_Time + Si.tcbs (This.Remaining_Task_Id).rest_of_capacity) - This.Current_Time) <= 2 then return False; end if; return True; end Verify_Pre_Conditions; ------------------------------------- -- Heuristic_2::Get_Remaining_Task -- ------------------------------------- function Get_Remaining_Task (This : in out heuristic_2; Si : in scheduling_information; Current_Time : in Natural) return Boolean is begin This.Number_Of_Tasks_Ended := 0; for num_task in 0 .. Si.number_of_tasks - 1 loop if (Si.tcbs (num_task).wake_up_time > Current_Time) and (Si.tcbs (num_task).rest_of_capacity = Si.tcbs (num_task).tsk.capacity) then This.Number_Of_Tasks_Ended := This.Number_Of_Tasks_Ended + 1; else This.Remaining_Task_Id := num_task; end if; end loop; if This.Number_Of_Tasks_Ended = Natural (Si.number_of_tasks) - 1 then return True; end if; return False; end Get_Remaining_Task; ------------------------------------------- -- Heuristic_2::Get_Nearest_Wake_Up_Time -- ------------------------------------------- function Get_Nearest_Wake_Up_Time (This : in out heuristic_2; Si : in scheduling_information) return Natural is Nearest_Wake_Up_Time : Natural := This.Current_Time + Si.tcbs (This.Remaining_Task_Id).rest_of_capacity; begin for num_task in 0 .. Si.number_of_tasks - 1 loop if Si.tcbs (num_task).tsk.name /= Si.tcbs (This.Remaining_Task_Id).tsk.name then if Si.tcbs (num_task).wake_up_time < Nearest_Wake_Up_Time then Nearest_Wake_Up_Time := Si.tcbs (num_task).wake_up_time; end if; end if; end loop; return Nearest_Wake_Up_Time; end Get_Nearest_Wake_Up_Time; ------------------------------- -- Heuristic_2::Reset_Values -- ------------------------------- procedure Reset_Values (This : in out heuristic_2; Si : in scheduling_information) is begin if (Si.tcbs (This.Remaining_Task_Id).rest_of_capacity > 1) then This.Commit_Unit := Si.tcbs (This.Remaining_Task_Id).rest_of_capacity - 2; else This.Commit_Unit := 0; put_debug ("INFO SAFETY PUT TO ZERO"); end if; heuristic_2 (Last_Job_Heuristic.all).Remaining_Task_Id := 0; heuristic_2 (Last_Job_Heuristic.all).Number_Of_Tasks_Ended := 0; end Reset_Values; ----------------------- -- Can_Run_Heuristic -- ----------------------- function Can_Run_Heuristic (Heuristic : in out concrete_heuristics'class; Si : in scheduling_information) return Boolean is begin return Can_Run (Heuristic, Si); end Can_Run_Heuristic; ------------------------- -- Calculate_Heuristic -- ------------------------- function Calculate_Heuristic (Heuristic : in out concrete_heuristics'class; Si : in scheduling_information) return Natural is begin return Calculate (Heuristic, Si); end Calculate_Heuristic; end Heuristics;