------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 Ada.Exceptions; use Ada.Exceptions; with Resources; use Resources; use Resources.Resource_accesses; with Time_Unit_Events; use Time_Unit_Events; use Time_Unit_Events.Time_Unit_Package; with natural_util; use natural_util; with double_util; use double_util; with integer_util; use integer_util; with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions; with Objects; use Objects; with Objects.extended; use Objects.extended; with Translate; use Translate; with Multi_precision_integers; use Multi_precision_integers; with Multi_precision_integers_IO; use Multi_precision_integers_IO; with multi_int_util; use multi_int_util; with Task_Groups; use Task_Groups; with Tasks; use Tasks; use Tasks.Generic_Task_List_Package; with Task_Set; use Task_Set; with Task_Dependencies; use Task_Dependencies; with initialize_framework; use initialize_framework; package body Task_Group_Set is procedure Add_Task_Group (My_Task_Groups : in out Task_Groups_Set; Name : in Unbounded_String; Task_Group_Type : in Task_Groups_Type) is Dummy : Generic_Task_Group_Ptr; begin Add_Task_Group (My_Task_Groups, Dummy, Name, Task_Group_Type); end Add_Task_Group; procedure Add_Task_Group (My_Task_Groups : in out Task_Groups_Set; A_Task_Group : in out Generic_Task_Group_Ptr; Name : in Unbounded_String; Task_Group_Type : in Task_Groups_Type) is New_Multiframe_Task_Group : Multiframe_Task_Group_Ptr; New_Transaction_Task_Group : Transaction_Task_Group_Ptr; My_Iterator : Task_Groups_Iterator; begin check_initialize; if (get_number_of_elements (My_Task_Groups) > 0) then reset_iterator (My_Task_Groups, My_Iterator); loop current_element (My_Task_Groups, A_Task_Group, My_Iterator); if (Name = A_Task_Group.name) then Raise_Exception (Task_Set.Invalid_Parameter'Identity, To_String (Lb_Task_Group (Current_Language) & " " & Name & " : " & Lb_Task_Group_Name (Current_Language) & Lb_Already_Defined (Current_Language))); end if; exit when is_last_element (My_Task_Groups, My_Iterator); next_element (My_Task_Groups, My_Iterator); end loop; end if; case Task_Group_Type is when Multiframe_Type => New_Multiframe_Task_Group := new Multiframe_Task_Group; A_Task_Group := Generic_Task_Group_Ptr (New_Multiframe_Task_Group); when Transaction_Type => New_Transaction_Task_Group := new Transaction_Task_Group; A_Task_Group := Generic_Task_Group_Ptr (New_Transaction_Task_Group); end case; A_Task_Group.name := Name; A_Task_Group.task_group_type := Task_Group_Type; Add_Task_Group(My_Task_Groups, A_Task_Group); exception when Generic_Task_Group_Set.full_set => Raise_Exception (Task_Set.Invalid_Parameter'Identity, To_String (Lb_Can_Not_Define_More_Tasks (Current_Language))); end Add_Task_Group; procedure Add_Task_Group (My_Task_Groups : in out Task_Groups_Set; A_Task_Group : in Generic_Task_Group_Ptr) is begin check_initialize; add(My_Task_Groups, A_Task_Group); end Add_Task_Group; procedure Add_Task (My_Tasks : in out Tasks_Set; My_Task_Groups : in out Task_Groups_Set; Task_Group_Name : in Unbounded_String; Name : in Unbounded_String; Cpu_Name : in Unbounded_String; Address_Space_Name : in Unbounded_String; Task_Type : in Tasks_Type; Start_Time : in Integer; Capacity : in Integer; Period : in Integer; Deadline : in Integer; Jitter : in Integer; Blocking_Time : in Integer; Priority : in Integer; Criticality : in Integer; Policy : in Policies; Offset : in Offsets_Table := No_Offset; Stack_Memory_Size : in Integer := 0; Text_Memory_Size : in Integer := 0; Param : in User_Defined_Parameters_Table := No_User_Defined_Parameter; Parametric_Rule_Name : in Unbounded_String := empty_string; Seed_Value : in Integer := 0; Predictable : in Boolean := True; context_switch_overhead : in Integer := 0) is A_Task_Group : Generic_Task_Group_Ptr; Found : Boolean := False; begin check_initialize; -- Get the task_group pointer A_Task_Group := Search_Task_Group(My_Task_Groups, Task_Group_Name); -- Task_Set.Add_Task Task_Set.Add_Task (My_Tasks, Name, Cpu_Name, Address_Space_Name, Task_Type, Start_Time, Capacity, Period, Deadline, Jitter, Blocking_Time, Priority, Criticality, Policy, Offset, Stack_Memory_Size, Text_Memory_Size, Param, Parametric_Rule_Name, Seed_Value, Predictable, context_switch_overhead); -- Add created task to task_group Add_Task_To_Group (My_Tasks, A_Task_Group, Name); end Add_Task; procedure Add_Task_To_Group (My_Tasks : in out Tasks_Set; My_Task_Group : in out Generic_Task_Group_Ptr; Name : in Unbounded_String) is A_Task : Generic_Task_Ptr; begin -- Get task pointer according to name in task set A_Task := Search_Task(My_Tasks, Name); Add_Task_To_Group(My_Task_Group, A_Task); end Add_Task_To_Group; procedure Add_Task_To_Group (My_Task_Group : in out Generic_Task_Group_Ptr; A_Task : in out Generic_Task_Ptr) is Tail_Task : Generic_Task_Ptr; Tail_Frame_Task : Frame_Task_Ptr; A_Multiframe : Multiframe_Task_Group_Ptr; begin check_initialize; if Task_Is_Present_In_Group(My_Task_Group, A_Task.Name) then -- TODO Add better exception message Raise_Exception (Task_Set.Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & A_Task.Name & " : " & Lb_Task_Name (Current_Language) & Lb_Already_Defined (Current_Language))); end if; -- Check if task is of correct task_type according to task_group_type Check_Task(My_Task_Group, A_Task); -- Modify A_Task's start time in Multiframe case if (not is_empty (My_Task_Group.task_list)) and (My_Task_Group.task_group_type = Multiframe_Type) then Tail_Task := get_tail(My_Task_Group.task_list); Tail_Frame_Task := Frame_Task_Ptr(Tail_Task); -- Start_Time A_Task.start_time := Tail_Frame_Task.start_time + Tail_Frame_Task.interarrival; end if; -- Add task to task list tail add_tail(My_Task_Group.task_list, A_Task); -- Update Multiframe period if (My_Task_Group.task_group_type = Multiframe_Type) then A_Multiframe := Multiframe_Task_Group_Ptr(My_Task_Group); Set_Multiframe_Period(A_Multiframe); end if; end Add_Task_To_Group; procedure Check_Task (A_Task_Group : in Generic_Task_Group_Ptr; A_Task : in Generic_Task_Ptr) is begin case A_Task_Group.task_group_type is when Multiframe_type => if (A_Task.Task_Type /= Frame_Task_Type) then Raise_Exception (Task_Set.Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & A_Task.Name & " : " & Lb_Task_Type (Current_Language) & Lb_Must_Be (Current_Language) & Lb_Frame (Current_Language))); end if; when Transaction_type => if (A_Task.Task_Type /= Periodic_Type) then Raise_Exception (Task_Set.Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & A_Task.Name & " : " & Lb_Task_Type (Current_Language) & Lb_Must_Be (Current_Language) & Lb_Periodic (Current_Language))); end if; when others => null; end case; end Check_Task; function Task_Is_Present_In_Group (My_Task_Group : in Generic_Task_Group_Ptr; Name : in Unbounded_String) return Boolean is My_Iterator : Generic_Task_Iterator; A_Task : Generic_Task_Ptr; begin if not is_empty (My_Task_Group.task_list) then reset_head_iterator (My_Task_Group.task_list, My_Iterator); loop current_element (My_Task_Group.task_list, A_Task, My_Iterator); if (A_Task.name = Name) then return true; end if; exit when is_tail_element (My_Task_Group.task_list, My_Iterator); next_element (My_Task_Group.task_list, My_Iterator); end loop; else return false; end if; return false; end Task_Is_Present_In_Group; function Search_Task_Group (My_Task_Groups : in Task_Groups_Set; Name : in Unbounded_String) return Generic_Task_Group_Ptr is My_Iterator : Task_Groups_Iterator; A_Task_Group : Generic_Task_Group_Ptr; begin reset_iterator (My_Task_Groups, My_Iterator); loop current_element (My_Task_Groups, A_Task_Group, My_Iterator); if (A_Task_Group.name = Name) then return A_Task_Group; end if; exit when is_last_element (My_Task_Groups, My_Iterator); next_element (My_Task_Groups, My_Iterator); end loop; Raise_Exception (Task_Group_Not_Found'Identity, To_String (Lb_Task_Group_Name (Current_Language) & "=" & Name)); end Search_Task_Group; function Search_Task_Group_By_Id (My_Task_Groups : in Task_Groups_Set; id : in Unbounded_String) return Generic_Task_Group_Ptr is My_Iterator : Task_Groups_Iterator; A_Task_Group : Generic_Task_Group_Ptr; begin reset_iterator (My_Task_Groups, My_Iterator); loop current_element (My_Task_Groups, A_Task_Group, My_Iterator); if (A_Task_Group.cheddar_private_id = id) then return A_Task_Group; end if; exit when is_last_element (My_Task_Groups, My_Iterator); next_element (My_Task_Groups, My_Iterator); end loop; Raise_Exception (Task_Group_Not_Found'Identity, To_String (Lb_Task_Group_Name (Current_Language) & "=" & id)); end Search_Task_Group_by_id; function Task_Group_Is_Present (My_Task_Groups : in Task_Groups_Set; Name : in Unbounded_String) return Boolean is My_Iterator : Task_Groups_Iterator; A_Task_Group : Generic_Task_Group_Ptr; begin if is_empty (My_Task_Groups) then return False; else reset_iterator (My_Task_Groups, My_Iterator); loop current_element (My_Task_Groups, A_Task_Group, My_Iterator); if (A_Task_Group.name = Name) then return true; end if; exit when is_last_element (My_Task_Groups, My_Iterator); next_element (My_Task_Groups, My_Iterator); end loop; return false; end if; end Task_Group_Is_Present; function Search_Task_Group_By_Task (My_Task_Groups : in Task_Groups_Set; Name : in Unbounded_String) return Generic_Task_Group_Ptr is My_Iterator : Task_Groups_Iterator; A_Task_Group : Generic_Task_Group_Ptr; begin reset_iterator (My_Task_Groups, My_Iterator); loop current_element (My_Task_Groups, A_Task_Group, My_Iterator); if (Task_Is_Present_In_Group(A_Task_Group, Name)) then return A_Task_Group; end if; exit when is_last_element (My_Task_Groups, My_Iterator); next_element (My_Task_Groups, My_Iterator); end loop; Raise_Exception (Task_Not_Found'Identity, To_String (Lb_Task_Name (Current_Language) & "=" & Name)); end Search_Task_Group_By_Task; function Search_Task_Group_By_Task (My_Task_Groups : in Task_Groups_Set; My_Task : in Generic_Task_Ptr) return Generic_Task_Group_Ptr is begin return Search_Task_Group_By_Task(My_Task_Groups, My_Task.name); end Search_Task_Group_By_Task; function Get_Multiframe_Period (A_Multiframe : in Multiframe_Task_Group_Ptr) return Integer is MF_Period : Integer; My_Iterator : Generic_Task_Iterator; A_Task : Generic_Task_Ptr; A_Frame_Task : Frame_Task_Ptr; begin MF_Period := 0; if (not is_empty (A_Multiframe.task_list)) then -- Compute MF_Period by summing Frame.interarrivals reset_head_iterator (A_Multiframe.task_list, My_Iterator); loop current_element (A_Multiframe.task_list, A_Task, My_Iterator); A_Frame_Task := Frame_Task_Ptr(A_Task); MF_Period := MF_Period + A_Frame_Task.interarrival; exit when is_tail_element (A_Multiframe.task_list, My_Iterator); next_element (A_Multiframe.task_list, My_Iterator); end loop; end if; return MF_Period; end Get_Multiframe_Period; function Get_No_Deadlocks_Precedences_Number (My_Task_Groups : in Task_Groups_Set) return Integer is -- Result : Integer; -- A_Task_Group : Generic_Task_Group_Ptr; -- Next_Task_Group : Generic_Task_Group_Ptr; begin return Get_No_Deadlocks_Precedences_Number(My_Task_Groups, Integer(get_number_of_elements(My_Task_Groups))); end Get_No_Deadlocks_Precedences_Number; function Get_No_Deadlocks_Precedences_Number (My_Task_Groups : in Task_Groups_Set; Number_Groups : in Integer) return Integer is Result : Integer; A_Task_Group : Generic_Task_Group_Ptr; Next_Task_Group : Generic_Task_Group_Ptr; begin Result := 0; for i in 0 .. (Number_Groups - 2) loop get_element_number(My_Task_Groups, A_Task_Group, (Task_Groups_Range(i))); for j in (i + 1) .. (Number_Groups - 1) loop get_element_number(My_Task_Groups, Next_Task_Group, (Task_Groups_Range(j))); Result := Result + Integer(get_number_of_elements(A_Task_Group.task_list) * get_number_of_elements(Next_Task_Group.task_list)); end loop; end loop; return Result; end Get_No_Deadlocks_Precedences_Number; procedure Set_Multiframe_Period (A_Multiframe : in out Multiframe_Task_Group_Ptr) is MF_Period : Integer; My_Iterator : Generic_Task_Iterator; A_Task : Generic_Task_Ptr; A_Frame_Task : Frame_Task_Ptr; begin if (not is_empty (A_Multiframe.task_list)) then MF_Period := Get_Multiframe_Period(A_Multiframe); -- Set MF_Period for all tasks reset_head_iterator (A_Multiframe.task_list, My_Iterator); loop current_element (A_Multiframe.task_list, A_Task, My_Iterator); A_Frame_Task := Frame_Task_Ptr(A_Task); A_Frame_Task.period := MF_Period; -- TODO Set MF_Period to A_Multiframe exit when is_tail_element (A_Multiframe.task_list, My_Iterator); next_element (A_Multiframe.task_list, My_Iterator); end loop; end if; end Set_Multiframe_Period; procedure Set_Multiframe_Precedences (My_Task_Groups : in Task_Groups_Set; My_Precedences : in out Tasks_Dependencies_Ptr) is My_Iterator : Task_Groups_Iterator; A_Task_Group : Generic_Task_Group_Ptr; A_Multiframe : Multiframe_Task_Group_Ptr; begin if (not is_empty (My_Task_Groups)) then reset_iterator (My_Task_Groups, My_Iterator); loop current_element (My_Task_Groups, A_Task_Group, My_Iterator); if (A_Task_Group.task_group_type = Multiframe_Type) then A_Multiframe := Multiframe_Task_Group_Ptr(A_Task_Group); Set_Multiframe_Precedences(A_Multiframe, My_Precedences); end if; exit when is_last_element (My_Task_Groups, My_Iterator); next_element (My_Task_Groups, My_Iterator); end loop; end if; end Set_Multiframe_Precedences; procedure Set_Multiframe_Precedences (A_Multiframe : in Multiframe_Task_Group_Ptr; My_Precedences : in out Tasks_Dependencies_Ptr) is My_Iterator : Generic_Task_Iterator; My_Next_Iterator : Generic_Task_Iterator; A_Task : Generic_Task_Ptr; Next_Task : Generic_Task_Ptr; begin if (not is_empty (A_Multiframe.task_list)) then reset_head_iterator (A_Multiframe.task_list, My_Iterator); reset_head_iterator (A_Multiframe.task_list, My_Next_Iterator); loop current_element (A_Multiframe.task_list, A_Task, My_Iterator); if (not is_tail_element (A_Multiframe.task_list, My_Next_Iterator)) then next_element (A_Multiframe.task_list, My_Next_Iterator); current_element (A_Multiframe.task_list, Next_Task, My_Next_Iterator); end if; if (not is_tail_element (A_Multiframe.task_list, My_Iterator)) then Add_One_Task_Dependency(My_Precedences, A_Task, Next_Task); end if; exit when is_tail_element (A_Multiframe.task_list, My_Iterator); next_element (A_Multiframe.task_list, My_Iterator); end loop; end if; end Set_Multiframe_Precedences; procedure Set_Interarrival (A_Frame_Task : in out Frame_Task_Ptr; A_Multiframe : in out Multiframe_Task_Group_Ptr; Interarrival : in Integer) is Dummy_Task_Group : Generic_Task_Group_Ptr; begin Dummy_Task_Group := Generic_Task_Group_Ptr(A_Multiframe); if (not Task_Is_Present_In_Group(Dummy_Task_Group, A_Frame_Task.name)) then -- TODO Add better exception message Raise_Exception (Task_Not_Present_In_Group'Identity, "Task is not present in group"); end if; A_Frame_Task.interarrival := Interarrival; Set_Multiframe_Period(A_Multiframe); Set_Multiframe_Start_Times(A_Multiframe); end Set_Interarrival; procedure Set_Multiframe_Start_Times (A_Multiframe : in Multiframe_Task_Group_Ptr) is My_Iterator : Generic_Task_Iterator; My_Next_Iterator : Generic_Task_Iterator; A_Task : Generic_Task_Ptr; A_Frame_Task : Frame_Task_Ptr; Next_Task : Generic_Task_Ptr; begin if (not is_empty (A_Multiframe.task_list)) then reset_head_iterator (A_Multiframe.task_list, My_Iterator); reset_head_iterator (A_Multiframe.task_list, My_Next_Iterator); loop current_element (A_Multiframe.task_list, A_Task, My_Iterator); if (not is_tail_element (A_Multiframe.task_list, My_Next_Iterator)) then next_element (A_Multiframe.task_list, My_Next_Iterator); current_element (A_Multiframe.task_list, Next_Task, My_Next_Iterator); end if; if (not is_tail_element (A_Multiframe.task_list, My_Iterator)) then A_Frame_Task := Frame_Task_Ptr(A_Task); Next_Task.start_time := A_Frame_Task.start_time + A_Frame_Task.interarrival; end if; exit when is_tail_element (A_Multiframe.task_list, My_Iterator); next_element (A_Multiframe.task_list, My_Iterator); end loop; end if; end Set_Multiframe_Start_Times; end Task_Group_Set;