------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 Ada.Exceptions; use Ada.Exceptions; with Resources; use Resources; use Resources.Resource_accesses; with buffers; use buffers; use buffers.Buffer_Roles_Package; 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 initialize_framework; use initialize_framework; with parameters.extended; use parameters.extended; with Cache_Access_Profile_Set; use Cache_Access_Profile_Set; with Caches; use Caches.Cache_Blocks_Table_Package; with Caches; use Caches; with Debug; use Debug; package body Task_Set is procedure Add_Task (My_Tasks : in out Tasks_Set; 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; every : in Integer := 0; Cache_Access_Profile_Name : in Unbounded_String := empty_string; CFG_Name : in Unbounded_String := empty_string) is Dummy : Generic_Task_Ptr; begin Add_Task (My_Tasks, Dummy, 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, every, Cache_Access_Profile_Name, CFG_Name); end Add_Task; procedure Check_Task (My_Tasks : in Tasks_Set; 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; every : in Integer := 0; Cache_Access_Profile_Name : in Unbounded_String := empty_string; CFG_Name : in Unbounded_String := empty_string) is begin if Name = "" then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task_Name (Current_Language) & Lb_Mandatory (Current_Language))); end if; if not Is_A_Valid_Identifier (Name) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Task_Name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; if not Is_A_Valid_Identifier (Parametric_Rule_Name) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Activation_Rule (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; if (Cpu_Name = "") then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Processor_Name (Current_Language) & Lb_Mandatory (Current_Language))); end if; if (Address_Space_Name = "") then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Address_Space_Name (Current_Language) & Lb_Mandatory (Current_Language))); end if; if not Is_A_Valid_Identifier (cpu_Name) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_task(Current_Language) & Name & " : " & lb_processor_name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; if not Is_A_Valid_Identifier (address_space_Name) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_task(Current_Language) & Name & " : " & lb_address_space_name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; case Task_Type is when Periodic_Type => if Period <= 0 then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Periodic (Current_Language) & Lb_Require_Period (Current_Language))); end if; when Aperiodic_Type => if Period /= 0 then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Aperiodic (Current_Language) & Lb_No_Period (Current_Language))); end if; when Poisson_Type => if Period <= 0 then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Poisson_Process_Task (Current_Language) & Lb_Require_Period (Current_Language))); end if; when Sporadic_Type => if Period <= 0 then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Sporadic_Task (Current_Language) & Lb_Require_Period (Current_Language))); end if; when Parametric_Type => if Parametric_Rule_Name = empty_string then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Parametric_Task (Current_Language) & Lb_Require_Activation_Rule (Current_Language))); end if; when Frame_Task_Type => if Period < 0 then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Frame (Current_Language) & Lb_Require_Period (Current_Language))); end if; when Scheduling_Task_type => null; end case; if (Capacity <= 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Capacity (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_than (Current_Language) & "0")); end if; if (every < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & lb_every(Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (context_switch_overhead < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & lb_context_switch_overhead (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (Jitter < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Jitter (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (Criticality < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Criticality (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (Period < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Period (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (Deadline < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Deadline (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (Deadline < Jitter) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Deadline (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_than (Current_Language) & Lb_Jitter (Current_Language))); end if; if (Start_Time < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Start_Time (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (Blocking_Time < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Blocking_Time (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (Text_Memory_Size < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Text_Memory_Size (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (Stack_Memory_Size < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Stack_Memory_Size (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (Priority < Integer (Priority_Range'First)) or (Priority > Integer (Priority_Range'Last)) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Invalid_Priority (Current_Language) & " : " & Priority'Img)); end if; if (Priority /= 0) and (Policy = Sched_Others) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Policy_Control (Current_Language))); end if; if (Priority = 0) and (Policy /= Sched_Others) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Policy_Control (Current_Language))); end if; if (To_String (Parametric_Rule_Name) /= "" and Task_Type /= Parametric_Type) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Rule_For_Parametric_Only (Current_Language))); end if; -- User defined integrity checks -- check_parameters(param, Lb_Task (Current_Language) & " " & Name); -- Offset integrity checks -- for I in 0 .. Offset.nb_entries - 1 loop if Offset.entries (I).offset_value < 0 then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & To_Unbounded_String ("Offset/val.") & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & To_Unbounded_String ("0"))); end if; if Offset.entries (I).activation < 0 then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & To_Unbounded_String ("Offset/activation") & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & To_Unbounded_String ("0"))); end if; end loop; if not Is_A_Valid_Identifier (Cache_Access_Profile_Name) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Cache_Access_Profile_Name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; if not Is_A_Valid_Identifier (CFG_Name) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_CFG_Name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; end Check_Task; procedure Add_Task (My_Tasks : in out Tasks_Set; A_Task : in out Generic_Task_Ptr; 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; every : in Integer := 0; Cache_Access_Profile_Name : in Unbounded_String := empty_string; CFG_Name : in Unbounded_String := empty_string) is New_Periodic_Task : Periodic_Task_Ptr; New_Aperiodic_Task : Aperiodic_Task_Ptr; New_Poisson_Task : Poisson_Task_Ptr; New_Parametric_Task : Parametric_Task_Ptr; New_Sporadic_Task : Sporadic_Task_Ptr; New_Scheduling_Task : Scheduling_Task_Ptr; New_Frame_Task : Frame_Task_Ptr; My_Iterator : Tasks_Iterator; begin check_initialize; Check_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, every, Cache_Access_Profile_Name, CFG_Name); if (get_number_of_elements (My_Tasks) > 0) then reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (Name = A_Task.name) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & Name & " : " & Lb_Task_Name (Current_Language) & Lb_Already_Defined (Current_Language))); end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; end if; case Task_Type is when Periodic_Type => New_Periodic_Task := new Periodic_Task; New_Periodic_Task.jitter := Natural (Jitter); New_Periodic_Task.period := Natural (Period); New_periodic_Task.every := Natural (every); A_Task := Generic_Task_Ptr (New_Periodic_Task); when Scheduling_Task_type => New_Scheduling_Task := new Scheduling_Task; A_Task := Generic_Task_Ptr (New_Scheduling_Task); New_Scheduling_Task.jitter := Natural (Jitter); New_Scheduling_Task.period := Natural (Period); New_scheduling_Task.every := Natural (every); New_Scheduling_Task.seed := Seed_Value; New_Scheduling_Task.predictable := Predictable; when Aperiodic_Type => New_Aperiodic_Task := new Aperiodic_Task; A_Task := Generic_Task_Ptr (New_Aperiodic_Task); when Poisson_Type => New_Poisson_Task := new Poisson_Task; New_Poisson_Task.jitter := Natural (Jitter); New_Poisson_Task.period := Natural (Period); New_poisson_Task.every := Natural (every); New_Poisson_Task.seed := Seed_Value; New_Poisson_Task.predictable := Predictable; A_Task := Generic_Task_Ptr (New_Poisson_Task); when Sporadic_Type => New_Sporadic_Task := new Sporadic_Task; New_Sporadic_Task.jitter := Natural (Jitter); New_Sporadic_Task.period := Natural (Period); New_sporadic_Task.every := Natural (every); New_Sporadic_Task.seed := Seed_Value; New_Sporadic_Task.predictable := Predictable; A_Task := Generic_Task_Ptr (New_Sporadic_Task); when Parametric_Type => New_Parametric_Task := new Parametric_Task; New_Parametric_Task.jitter := Natural (Jitter); New_Parametric_Task.period := Natural (Period); New_Parametric_Task.every := Natural (every); New_Parametric_Task.seed := Seed_Value; New_Parametric_Task.predictable := Predictable; New_Parametric_Task.activation_rule := Parametric_Rule_Name; A_Task := Generic_Task_Ptr (New_Parametric_Task); when Frame_Task_Type => New_Frame_Task := new Frame_Task; New_Frame_Task.interarrival := Natural (Period); A_Task := Generic_Task_Ptr (New_Frame_Task); end case; A_Task.context_switch_overhead := context_switch_overhead; A_Task.offsets := Offset; A_Task.deadline := Natural (Deadline); A_Task.name := Name; A_Task.capacity := Natural (Capacity); A_Task.start_time := Natural (Start_Time); A_Task.cpu_name := Cpu_Name; A_Task.address_space_name := Address_Space_Name; A_Task.priority := Priority_Range (Priority); A_Task.criticality := Natural (Criticality); A_Task.policy := Policy; A_Task.task_type := Task_Type; A_Task.blocking_time := Natural (Blocking_Time); A_Task.stack_memory_size := Natural (Stack_Memory_Size); A_Task.text_memory_size := Natural (Text_Memory_Size); A_Task.parameters := Param; A_Task.cfg_name := CFG_Name; A_Task.cache_access_profile_name := Cache_Access_Profile_Name; add (My_Tasks, A_Task); exception when Generic_Task_Set.full_set => Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Can_Not_Define_More_Tasks (Current_Language))); end Add_Task; function Task_Is_Present (My_Tasks : in Tasks_Set; Name : in Unbounded_String) return Boolean is My_Iterator : Tasks_Iterator; A_Task : Generic_Task_Ptr; Found : Boolean := False; begin if is_empty (My_Tasks) then return False; else reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.name = Name) then Found := True; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; return Found; end if; end Task_Is_Present; function Search_Task_by_id (My_Tasks : in Tasks_Set; id : in Unbounded_String) return Generic_Task_Ptr is My_Iterator : Tasks_Iterator; A_Task : Generic_Task_Ptr; Result : Generic_Task_Ptr; Found : Boolean := False; begin if not is_empty(My_Tasks) then reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.cheddar_private_id = id) then Found := True; Result := A_Task; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; end if; if not Found then Raise_Exception (Task_Not_Found'Identity, To_String (Lb_Task_id (Current_Language) & "=" & id)); end if; return Result; end Search_Task_by_id; function Search_Task (My_Tasks : in Tasks_Set; Name : in Unbounded_String) return Generic_Task_Ptr is My_Iterator : Tasks_Iterator; A_Task : Generic_Task_Ptr; Result : Generic_Task_Ptr; Found : Boolean := False; begin if not is_empty(My_Tasks) then reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.name = Name) then Found := True; Result := A_Task; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; end if; if not Found then Raise_Exception (Task_Not_Found'Identity, To_String (Lb_Task_Name (Current_Language) & "=" & Name)); end if; return Result; end Search_Task; function Increasing_UCB (CAPs : Cache_Access_Profiles_Set; Op1 : in Generic_Task_Ptr; Op2 : in Generic_Task_Ptr) return Boolean is a_cap1 : Cache_Access_Profile_Ptr; a_cap2 : Cache_Access_Profile_Ptr; begin a_cap1 := Search_Cache_Access_Profile(CAPs,Op1.cache_access_profile_name); a_cap2 := Search_Cache_Access_Profile(CAPs,Op2.cache_access_profile_name); return (a_cap1.UCBs.Nb_Entries <= a_cap2.UCBs.Nb_Entries); end Increasing_UCB; function Increasing_Si (Op1 : in Generic_Task_Ptr; Op2 : in Generic_Task_Ptr) return Boolean is Si1, Si2 : Float; begin Si1 := Log (Float (Periodic_Task_Ptr (Op1).period), 2.0) - Float'Floor (Log (Float (Periodic_Task_Ptr (Op1).period), 2.0)); Si2 := Float (Log (Float (Periodic_Task_Ptr (Op2).period), 2.0)) - Float'Floor (Float (Log (Float (Periodic_Task_Ptr (Op2).period), 2.0))); return (Si1 <= Si2); end Increasing_Si; function Increasing_Utilization (Op1 : in Generic_Task_Ptr; Op2 : in Generic_Task_Ptr) return Boolean is U1, U2 : Float; begin U1 := Float (Op1.capacity) / Float (Periodic_Task_Ptr (Op1).period); U2 := Float (Op2.capacity) / Float (Periodic_Task_Ptr (Op2).period); return (U1 <= U2); end Increasing_Utilization; function Increasing_Period_Deadline (Op1 : in Generic_Task_Ptr; Op2 : in Generic_Task_Ptr) return Boolean is begin if(Periodic_Task_Ptr(Op1).period < Periodic_Task_Ptr(Op2).period) then return true; elsif (Periodic_Task_Ptr(Op1).period = Periodic_Task_Ptr(Op2).period) then return (Op1.deadline <= Op2.deadline); else return false; end if; end Increasing_Period_Deadline; function Decreasing_Period_Deadline (Op1 : in Generic_Task_Ptr; Op2 : in Generic_Task_Ptr) return Boolean is begin if(Periodic_Task_Ptr(Op1).period > Periodic_Task_Ptr(Op2).period) then return true; elsif (Periodic_Task_Ptr(Op1).period = Periodic_Task_Ptr(Op2).period) then return (Op1.deadline >= Op2.deadline); else return false; end if; end Decreasing_Period_Deadline; function Increasing_Priority (Op1 : in Generic_Task_Ptr; Op2 : in Generic_Task_Ptr) return Boolean is begin return (Op1.priority <= Op2.priority); end Increasing_Priority; function Decreasing_Priority (Op1 : in Generic_Task_Ptr; Op2 : in Generic_Task_Ptr) return Boolean is begin return (Op1.priority >= Op2.priority); end Decreasing_Priority; function Increasing_Period (Op1 : in Generic_Task_Ptr; Op2 : in Generic_Task_Ptr) return Boolean is begin case Op1.task_type is when Periodic_Type => return (Periodic_Task_Ptr (Op1).period <= Periodic_Task_Ptr (Op2).period); when Poisson_Type => return (Poisson_Task_Ptr (Op1).period <= Poisson_Task_Ptr (Op2).period); when Sporadic_Type => return (Sporadic_Task_Ptr (Op1).period <= Sporadic_Task_Ptr (Op2).period); when others => return True; end case; end Increasing_Period; function Decreasing_Period (Op1 : in Generic_Task_Ptr; Op2 : in Generic_Task_Ptr) return Boolean is begin case Op1.task_type is when Periodic_Type => return (Periodic_Task_Ptr (Op1).period >= Periodic_Task_Ptr (Op2).period); when Poisson_Type => return (Poisson_Task_Ptr (Op1).period >= Poisson_Task_Ptr (Op2).period); when Sporadic_Type => return (Sporadic_Task_Ptr (Op1).period >= Sporadic_Task_Ptr (Op2).period); when others => return True; end case; end Decreasing_Period; function Increasing_Deadline (Op1 : in Generic_Task_Ptr; Op2 : in Generic_Task_Ptr) return Boolean is begin return (Op1.deadline <= Op2.deadline); end Increasing_Deadline; function Decreasing_Deadline (Op1 : in Generic_Task_Ptr; Op2 : in Generic_Task_Ptr) return Boolean is begin return (Op1.deadline >= Op2.deadline); end Decreasing_Deadline; function Increasing_Name (Op1 : in Generic_Task_Ptr; Op2 : in Generic_Task_Ptr) return Boolean is begin return (Op1.name <= Op2.name); end Increasing_Name; function Increasing_Offset (Op1 : in Generic_Task_Ptr; Op2 : in Generic_Task_Ptr) return Boolean is O1 : Integer; O2 : Integer; begin O1 := 0; if (Op1.offsets.Nb_Entries > 0) then O1 := Op1.offsets.entries(0).offset_value; end if; O2 := 0; if (Op2.offsets.Nb_Entries > 0) then O2 := Op2.offsets.entries(0).offset_value; end if; return (O1 <= O2); end Increasing_Offset; function Get (My_Tasks : in Tasks_Set; Task_Name : in Unbounded_String; Param_Name : in Task_Parameters) return Unbounded_String is A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; begin if (Param_Name /= Cpu_Name) and (Param_Name /= Address_Space_Name) then raise Invalid_Parameter; end if; reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.name = Task_Name) then exit; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; if (Param_Name = Cpu_Name) then return A_Task.cpu_name; else return A_Task.address_space_name; end if; end Get; function Get (My_Tasks : in Tasks_Set; Task_Name : in Unbounded_String; Param_Name : in Task_Parameters) return Boolean is A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; begin if (Param_Name /= Predictable) then raise Invalid_Parameter; end if; reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.name = Task_Name) then exit; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; if (A_Task.task_type /= Poisson_Type) and (A_Task.task_type /= Parametric_Type) then raise Invalid_Parameter; end if; return Poisson_Task_Ptr (A_Task).predictable; end Get; function Get (My_Tasks : in Tasks_Set; Task_Name : in Unbounded_String; Param_Name : in Task_Parameters) return Priority_Range is A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; begin if (Param_Name /= Priority) then raise Invalid_Parameter; end if; reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.name = Task_Name) then exit; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; return A_Task.priority; end Get; function Get (My_Tasks : in Tasks_Set; Task_Name : in Unbounded_String; Param_Name : in Task_Parameters) return Natural is A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; begin if ((Param_Name /= Start_Time) and (Param_Name /= Blocking_Time) and (Param_Name /= Capacity) and (Param_Name /= Period) and (Param_Name /= Deadline) and (Param_Name /= Jitter)) then raise Invalid_Parameter; end if; reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.name = Task_Name) then exit; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; if (Param_Name = Start_Time) then return A_Task.start_time; else if (Param_Name = Deadline) then return A_Task.deadline; else if (Param_Name = Period) then return Periodic_Task_Ptr (A_Task).period; else if (Param_Name = Jitter) then return Periodic_Task_Ptr (A_Task).jitter; else if (Param_Name = Capacity) then return A_Task.capacity; else return A_Task.blocking_time; end if; end if; end if; end if; end if; end Get; procedure Set (My_Tasks : in out Tasks_Set; Task_Name : in Unbounded_String; Param_Name : in Task_Parameters; Param_Value : in Unbounded_String) is A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; begin if (Param_Name /= Cpu_Name) and (Param_Name /= Address_Space_Name) then raise Invalid_Parameter; end if; reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.name = Task_Name) then if (Param_Name = Cpu_Name) then A_Task.cpu_name := Param_Value; else A_Task.address_space_name := Param_Value; end if; exit; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; end Set; procedure Set (My_Tasks : in out Tasks_Set; Task_Name : in Unbounded_String; Param_Name : in Task_Parameters; Param_Value : in Priority_Range) is A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; begin if (Param_Name /= Priority) then raise Invalid_Parameter; end if; reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.name = Task_Name) then A_Task.priority := Param_Value; exit; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; end Set; procedure Set (My_Tasks : in out Tasks_Set; Task_Name : in Unbounded_String; Param_Name : in Task_Parameters; Param_Value : in Boolean) is A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; begin if (Param_Name /= Predictable) then raise Invalid_Parameter; end if; reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.name = Task_Name) then if (A_Task.task_type /= Poisson_Type) and (A_Task.task_type /= Parametric_Type) then raise Invalid_Parameter; end if; Poisson_Task_Ptr (A_Task).predictable := Param_Value; exit; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; end Set; procedure Set (My_Tasks : in out Tasks_Set; Task_Name : in Unbounded_String; Param_Name : in Task_Parameters; Param_Value : in Natural) is A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; begin if ((Param_Name /= Start_Time) and (Param_Name /= Blocking_Time) and (Param_Name /= Capacity) and (Param_Name /= Period) and (Param_Name /= Deadline) and (Param_Name /= Jitter)) then raise Invalid_Parameter; end if; reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.name = Task_Name) then if (Param_Name = Start_Time) then A_Task.start_time := Param_Value; exit; end if; if (Param_Name = Deadline) then A_Task.deadline := Param_Value; end if; if (Param_Name = Period and A_Task.task_type = Periodic_Type) then Periodic_Task_Ptr (A_Task).period := Param_Value; exit; end if; if (Param_Name = Jitter and A_Task.task_type = Periodic_Type) then Periodic_Task_Ptr (A_Task).jitter := Param_Value; exit; end if; if (Param_Name = Period and A_Task.task_type = Poisson_Type) then Poisson_Task_Ptr (A_Task).period := Param_Value; exit; end if; if (Param_Name = Jitter and A_Task.task_type = Poisson_Type) then Poisson_Task_Ptr (A_Task).jitter := Param_Value; exit; end if; if (Param_Name = Capacity) then A_Task.capacity := Param_Value; exit; end if; if (Param_Name = Blocking_Time) then A_Task.blocking_time := Param_Value; exit; end if; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; end Set; function Get_Number_Of_Task_From_Processor (My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String) return Tasks_Range is Number : Tasks_Range := 0; A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; begin if is_empty (My_Tasks) then return 0; end if; reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.cpu_name = Processor_Name) then Number := Number + 1; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; return Number; end Get_Number_Of_Task_From_Processor; procedure Periodic_Control (My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String) is Iterator1 : Tasks_Iterator; Task1 : Generic_Task_Ptr; begin reset_iterator (My_Tasks, Iterator1); loop current_element (My_Tasks, Task1, Iterator1); if (Task1.cpu_name = Processor_Name) or (Processor_Name = empty_string) then if (Task1.task_type /= Periodic_Type) then raise Task_Must_Be_Periodic; end if; end if; exit when is_last_element (My_Tasks, Iterator1); next_element (My_Tasks, Iterator1); end loop; end Periodic_Control; procedure Priority_Control (My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String) is Iterator1 : Tasks_Iterator; Task1 : Generic_Task_Ptr; Iterator2 : Tasks_Iterator; Task2 : Generic_Task_Ptr; begin -- No duplicate priority -- reset_iterator (My_Tasks, Iterator1); loop current_element (My_Tasks, Task1, Iterator1); if (Task1.cpu_name = Processor_Name) or (Processor_Name = empty_string) then reset_iterator (My_Tasks, Iterator2); loop current_element (My_Tasks, Task2, Iterator2); if (Task2.cpu_name = Task1.cpu_name) and (Task1.name /= Task2.name) and (Task1.priority = Task2.priority) then raise Priority_Error; end if; exit when is_last_element (My_Tasks, Iterator2); next_element (My_Tasks, Iterator2); end loop; end if; exit when is_last_element (My_Tasks, Iterator1); next_element (My_Tasks, Iterator1); end loop; end Priority_Control; -- Check start time -- procedure Start_Time_Control (My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String) is Iterator1 : Tasks_Iterator; Task1 : Generic_Task_Ptr; begin reset_iterator (My_Tasks, Iterator1); loop current_element (My_Tasks, Task1, Iterator1); if ((Task1.cpu_name = Processor_Name) or (Processor_Name = empty_string)) and (Task1.start_time /= 0) then raise Start_Time_Error; end if; exit when is_last_element (My_Tasks, Iterator1); next_element (My_Tasks, Iterator1); end loop; end Start_Time_Control; -- Check offset -- procedure Offset_Control (My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String) is Iterator1 : Tasks_Iterator; Task1 : Generic_Task_Ptr; begin reset_iterator (My_Tasks, Iterator1); loop current_element (My_Tasks, Task1, Iterator1); if (Task1.cpu_name = Processor_Name) or (Processor_Name = empty_string) then for I in 0 .. Task1.offsets.nb_entries - 1 loop if (Task1.offsets.entries (I).activation /= 0) then raise Offset_Error; end if; end loop; end if; exit when is_last_element (My_Tasks, Iterator1); next_element (My_Tasks, Iterator1); end loop; end Offset_Control; procedure Have_Deadlines_Equal_Than_Periods_Control (My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String) is A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; begin reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (not ((A_Task.task_type = Periodic_Type) or (A_Task.task_type = Poisson_Type)) and (A_Task.cpu_name = Processor_Name)) then raise Task_Must_Be_Periodic; end if; if (A_Task.cpu_name = Processor_Name) or (Processor_Name = empty_string) then if A_Task.task_type = Periodic_Type then if (A_Task.deadline /= Periodic_Task_Ptr (A_Task).period) then raise Task_Must_Have_Period_Equal_To_Deadline; end if; end if; if A_Task.task_type = Poisson_Type then -- check this if (A_Task.deadline /= Poisson_Task_Ptr (A_Task).period) then raise Task_Must_Have_Period_Equal_To_Deadline; end if; end if; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; end Have_Deadlines_Equal_Than_Periods_Control; procedure Deadline_Control (My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String) is Iterator1 : Tasks_Iterator; Task1 : Generic_Task_Ptr; begin reset_iterator (My_Tasks, Iterator1); loop current_element (My_Tasks, Task1, Iterator1); if (Task1.cpu_name = Processor_Name) or (Processor_Name = empty_string) then if Task1.deadline = 0 then raise Deadline_Error; end if; end if; exit when is_last_element (My_Tasks, Iterator1); next_element (My_Tasks, Iterator1); end loop; end Deadline_Control; procedure Have_Same_Period_Control (My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String) is Iterator1 : Tasks_Iterator; Task1 : Generic_Task_Ptr; Period_Value : Natural := 0; First : Boolean := True; begin reset_iterator (My_Tasks, Iterator1); loop current_element (My_Tasks, Task1, Iterator1); if not ((Task1.task_type = Periodic_Type) or (Task1.task_type = Aperiodic_Type)) then raise Task_Model_Error; end if; if (Task1.cpu_name = Processor_Name) or (Processor_Name = empty_string) then if First then First := False; if Task1.task_type = Periodic_Type then Period_Value := Periodic_Task_Ptr (Task1).period; end if; else if Task1.task_type = Aperiodic_Type and Period_Value /= 0 then raise Task_Must_Have_The_Same_Period_Value; end if; if Task1.task_type = Periodic_Type and Period_Value /= Periodic_Task_Ptr (Task1).period then raise Task_Must_Have_The_Same_Period_Value; end if; end if; end if; exit when is_last_element (My_Tasks, Iterator1); next_element (My_Tasks, Iterator1); end loop; end Have_Same_Period_Control; function Deadline_Inferior_To_Period (My_Tasks : in Tasks_Set) return Boolean is My_Iterator : Tasks_Iterator; A_Task : Generic_Task_Ptr; Result : Boolean := True; begin reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if A_Task.task_type = Periodic_Type then if (Periodic_Task_Ptr (A_Task).period < A_Task.deadline) then Result := False; end if; end if; if A_Task.task_type = Poisson_Type then if (Poisson_Task_Ptr (A_Task).period < A_Task.deadline) then Result := False; end if; end if; -- Next task -- exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; return Result; end Deadline_Inferior_To_Period; function Is_Harmonic (My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String) return Boolean is My_Iterator1, My_Iterator2 : Tasks_Iterator; A_Task1, A_Task2 : Generic_Task_Ptr; Result : Boolean := True; Tmp_Mod : Natural; begin -- First loop -- reset_iterator (My_Tasks, My_Iterator1); loop current_element (My_Tasks, A_Task1, My_Iterator1); if (A_Task1.cpu_name = Processor_Name) or (Processor_Name = empty_string) then -- Second loop -- reset_iterator (My_Tasks, My_Iterator2); loop current_element (My_Tasks, A_Task2, My_Iterator2); if (A_Task2.cpu_name = Processor_Name) or (Processor_Name = empty_string) then if A_Task1.task_type = Periodic_Type then if (Periodic_Task_Ptr (A_Task1).period > Periodic_Task_Ptr (A_Task2).period) then Tmp_Mod := Periodic_Task_Ptr (A_Task1).period mod Periodic_Task_Ptr (A_Task2).period; else Tmp_Mod := Periodic_Task_Ptr (A_Task2).period mod Periodic_Task_Ptr (A_Task1).period; end if; if (A_Task1.name /= A_Task2.name and Tmp_Mod /= 0) then Result := False; end if; end if; if A_Task1.task_type = Poisson_Type then if (Poisson_Task_Ptr (A_Task1).period > Poisson_Task_Ptr (A_Task2).period) then Tmp_Mod := Poisson_Task_Ptr (A_Task1).period mod Poisson_Task_Ptr (A_Task2).period; else Tmp_Mod := Poisson_Task_Ptr (A_Task2).period mod Poisson_Task_Ptr (A_Task1).period; end if; if (A_Task1.name /= A_Task2.name and Tmp_Mod /= 0) then Result := False; end if; end if; end if; -- next task -- exit when is_last_element (My_Tasks, My_Iterator2); next_element (My_Tasks, My_Iterator2); end loop; end if; -- next task -- exit when is_last_element (My_Tasks, My_Iterator1); next_element (My_Tasks, My_Iterator1); end loop; return Result; end Is_Harmonic; -- Compute_Hyperperiod -- function Compute_Hyperperiod (My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String := empty_string) return Integer is Iterator1 : Tasks_Iterator; Task1 : Generic_Task_Ptr; Hyperperiod : Integer := 1; begin Periodic_Control(My_Tasks, Processor_Name); reset_iterator (My_Tasks, Iterator1); loop current_element (My_Tasks, Task1, Iterator1); if (Task1.cpu_name = Processor_Name) or (Processor_Name = empty_string) then Put_Debug("Task: " & To_String(Task1.name) & " | Task Period: " & Periodic_Task_Ptr(Task1).period'Img); Hyperperiod := natural_util.lcm(Hyperperiod,Periodic_Task_Ptr(Task1).period); end if; exit when is_last_element (My_Tasks, Iterator1); next_element (My_Tasks, Iterator1); end loop; return Hyperperiod; end Compute_Hyperperiod; procedure Check_entity_referencing_processor (My_Tasks : in Tasks_Set; A_processor : in Unbounded_String) is A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; begin if (get_number_of_elements (My_Tasks) > 0) then reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.cpu_name = A_processor) then Raise_Exception (Invalid_Parameter'Identity, To_String ( lb_processor (Current_Language) & " " & a_processor & " : " & lb_task (Current_Language) & " " & a_task.Name & " : " & lb_entity_referenced_elsewhere(current_language) )); end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; end if; end Check_entity_referencing_processor; procedure Check_entity_referencing_Address_Space (My_Tasks : in Tasks_Set; A_Addr : in Unbounded_String) is A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; begin if (get_number_of_elements (My_Tasks) > 0) then reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.address_space_name = A_Addr) then Raise_Exception (Invalid_Parameter'Identity, To_String ( lb_address_space (Current_Language) & " " & a_addr & " : " & lb_task (Current_Language) & " " & a_task.Name & " : " & lb_entity_referenced_elsewhere(current_language) )); end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; end if; end Check_entity_referencing_Address_Space; procedure Delete_Address_Space (My_Tasks : in out Tasks_Set; A_Addr : in Unbounded_String) is Tmp : Tasks_Set; A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; begin if (get_number_of_elements (My_Tasks) > 0) then reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.address_space_name = A_Addr) then add (Tmp, A_Task); end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; if not is_empty (Tmp) then reset_iterator (Tmp, My_Iterator); loop current_element (Tmp, A_Task, My_Iterator); delete (My_Tasks, A_Task); exit when is_last_element (Tmp, My_Iterator); next_element (Tmp, My_Iterator); end loop; reset (Tmp, False); end if; end if; end Delete_Address_Space; procedure Delete_Processor (My_Tasks : in out Tasks_Set; A_Processor : in Unbounded_String) is Tmp : Tasks_Set; A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; begin if (get_number_of_elements (My_Tasks) > 0) then reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if (A_Task.cpu_name = A_Processor) then add (Tmp, A_Task); end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; if not is_empty (Tmp) then reset_iterator (Tmp, My_Iterator); loop current_element (Tmp, A_Task, My_Iterator); delete (My_Tasks, A_Task); exit when is_last_element (Tmp, My_Iterator); next_element (Tmp, My_Iterator); end loop; reset (Tmp, False); end if; end if; end Delete_Processor; function Export_Aadl_Implementations (My_Tasks : in Tasks_Set; My_Resources : in Resources_Set) return Unbounded_String is My_Iterator : Tasks_Iterator; A_Task : Generic_Task_Ptr; My_Resource_Iterator : Resources_Iterator; A_Resource : Generic_Resource_Ptr; Print_Feature_Header : Boolean; Result : Unbounded_String := empty_string; begin if not is_empty (My_Tasks) then reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); Result := Result & To_Unbounded_String ("thread " & To_String (A_Task.name)) & unbounded_lf; Print_Feature_Header := True; -- Look for shared resource access -- if not is_empty (My_Resources) then reset_iterator (My_Resources, My_Resource_Iterator); loop current_element (My_Resources, A_Resource, My_Resource_Iterator); if A_Resource.critical_sections.nb_entries /= 0 then for I in 0 .. A_Resource.critical_sections.nb_entries - 1 loop if A_Resource.critical_sections.entries (I).item = A_Task.name then if Print_Feature_Header then Result := Result & To_Unbounded_String (ASCII.HT & "features") & unbounded_lf; Print_Feature_Header := False; end if; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & To_String (A_Resource.name) & "_features" & " : requires data access " & To_String (A_Resource.name) & ".Impl;") & unbounded_lf; exit; end if; end loop; end if; exit when is_last_element (My_Resources, My_Resource_Iterator); next_element (My_Resources, My_Resource_Iterator); end loop; end if; Result := Result & To_Unbounded_String ("end " & To_String (A_Task.name) & ";") & unbounded_lf & unbounded_lf; Result := Result & To_Unbounded_String ("thread implementation " & To_String (A_Task.name) & ".Impl") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "properties") & unbounded_lf; case A_Task.task_type is when Aperiodic_Type => Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Dispatch_Protocol => Background;") & unbounded_lf; when Periodic_Type => Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Dispatch_Protocol => Periodic;") & unbounded_lf; when Poisson_Type => Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Dispatch_Protocol => Poisson_Process;") & unbounded_lf; when Sporadic_Type => Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Dispatch_Protocol => Sporadic;") & unbounded_lf; when Scheduling_Task_Type => Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Dispatch_Protocol => Scheduling_Task;") & unbounded_lf; when Parametric_Type => Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Dispatch_Protocol => User_Defined;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Cheddar_Properties::Source_Text => " & """" & To_String (Parametric_Task_Ptr (A_Task).activation_rule) & """" & ";") & unbounded_lf; when others => null; end case; if A_Task.parameters.nb_entries > 0 then for I in 0 .. A_Task.parameters.nb_entries - 1 loop Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "User_Defined_Cheddar_Properties::" & To_String (A_Task.parameters.entries (I).parameter_name) & " => "); if A_Task.parameters.entries (I).type_of_parameter = Boolean_Parameter then Result := Result & To_Unbounded_String (A_Task.parameters.entries (I).boolean_value'Img); else if A_Task.parameters.entries (I).type_of_parameter = Integer_Parameter then Result := Result & To_Unbounded_String (A_Task.parameters.entries (I).integer_value' Img); else if A_Task.parameters.entries (I).type_of_parameter = Double_Parameter then Result := Result & To_Unbounded_String (To_String (format (A_Task.parameters.entries (I). double_value))); else Result := Result & To_Unbounded_String ("""" & To_String (A_Task.parameters.entries (I).string_value) & """"); end if; end if; end if; Result := Result & To_Unbounded_String (";") & unbounded_lf; end loop; end if; if A_Task.offsets.nb_entries > 0 then for I in 0 .. A_Task.offsets.nb_entries - 1 loop Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Cheddar_Properties::Dispatch_Offset_Value_" & To_String (integer_util.format (Integer (I))) & " => " & A_Task.offsets.entries (I).offset_value'Img & ";"); Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Cheddar_Properties::Dispatch_Offset_Time_" & To_String (integer_util.format (Integer (I))) & " => " & A_Task.offsets.entries (I).activation'Img & " ms ;") & unbounded_lf; end loop; end if; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Cheddar_Properties::Context_Switch_Overhead => " & A_Task.text_memory_size'Img & " ms ;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Source_Code_Size => " & A_Task.text_memory_size'Img & " kb ;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Source_Stack_Size => " & A_Task.stack_memory_size'Img & " kb ;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Compute_Execution_Time => " & A_Task.capacity'Img & " ms .. " & A_Task.capacity'Img & " ms;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Cheddar_Properties::Dispatch_Absolute_Time => " & A_Task.start_time'Img & " ms ;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Cheddar_Properties::POSIX_Scheduling_Policy => " & A_Task.policy'Img & ";") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Cheddar_Properties::Fixed_Priority => " & A_Task.priority'Img & ";") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Cheddar_Properties::Bound_On_Data_Blocking_Time => " & A_Task.blocking_time'Img & " ms ;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Deadline => " & A_Task.deadline'Img & " ms ;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Cheddar_Properties::Criticality => " & A_Task.criticality'Img & ";") & unbounded_lf; if (A_Task.task_type /= Aperiodic_Type) then Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Period => " & Periodic_Task_Ptr (A_Task).period'Img & " ms ;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Cheddar_Properties::Dispatch_Jitter => " & Periodic_Task_Ptr (A_Task).jitter'Img & " ms ;") & unbounded_lf; end if; if (A_Task.task_type = Poisson_Type) or (A_Task.task_type = Sporadic_Type) or (A_Task.task_type = Parametric_Type) then Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Cheddar_Properties::Dispatch_Seed_Value => " & Poisson_Task_Ptr (A_Task).seed'Img & ";") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "Cheddar_Properties::Dispatch_Seed_is_Predictable => " & Poisson_Task_Ptr (A_Task).predictable'Img & ";") & unbounded_lf; end if; Result := Result & To_Unbounded_String ("end " & To_String (A_Task.name) & ".Impl;") & unbounded_lf & unbounded_lf; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; end if; return Result; end Export_Aadl_Implementations; function Export_Aadl_User_Defined_Properties (My_Tasks : in Tasks_Set) return Unbounded_String is My_Iterator : Tasks_Iterator; A_Task : Generic_Task_Ptr; Find : Boolean := False; Properties_List : unbounded_string_list; List_Ite : unbounded_string_iterator; Str : unbounded_string_ptr; use unbounded_strings.unbounded_string_list_package; Result : Unbounded_String := empty_string; begin if not is_empty (My_Tasks) then reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if A_Task.parameters.nb_entries > 0 then for I in 0 .. A_Task.parameters.nb_entries - 1 loop -- Check that the property does not exist -- Find := False; if not is_empty (Properties_List) then reset_head_iterator (Properties_List, List_Ite); loop current_element (Properties_List, Str, List_Ite); if Str.all = A_Task.parameters.entries (I).parameter_name then Find := True; exit; end if; if is_tail_element (Properties_List, List_Ite) then exit; end if; next_element (Properties_List, List_Ite); end loop; end if; if not Find then Str := new Unbounded_String; Str.all := A_Task.parameters.entries (I).parameter_name; add (Properties_List, Str); Result := Result & To_Unbounded_String (ASCII.HT & To_String (A_Task.parameters.entries (I).parameter_name) & " : "); if A_Task.parameters.entries (I).type_of_parameter = Boolean_Parameter then Result := Result & To_Unbounded_String ("aadlboolean") & unbounded_lf; else if A_Task.parameters.entries (I).type_of_parameter = Integer_Parameter then Result := Result & To_Unbounded_String ("aadlinteger") & unbounded_lf; else if A_Task.parameters.entries (I).type_of_parameter = Double_Parameter then Result := Result & To_Unbounded_String ("aadlreal") & unbounded_lf; else Result := Result & To_Unbounded_String ("aadlstring") & unbounded_lf; end if; end if; end if; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (thread, thread group);") & unbounded_lf; end if; end loop; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; end if; return Result; end Export_Aadl_User_Defined_Properties; function Export_Aadl_Declarations (My_Tasks : in Tasks_Set; Address_Space_Name : in Unbounded_String; Number_Of_Ht : in Natural) return Unbounded_String is My_Iterator : Tasks_Iterator; A_Task : Generic_Task_Ptr; Result : Unbounded_String := empty_string; begin if not is_empty (My_Tasks) then reset_iterator (My_Tasks, My_Iterator); loop current_element (My_Tasks, A_Task, My_Iterator); if A_Task.address_space_name = Address_Space_Name then for I in 1 .. Number_Of_Ht loop Result := Result & ASCII.HT; end loop; Result := Result & To_Unbounded_String ("instancied_" & To_String (A_Task.name) & " : thread " & To_String (A_Task.name) & ".Impl;") & unbounded_lf; end if; exit when is_last_element (My_Tasks, My_Iterator); next_element (My_Tasks, My_Iterator); end loop; end if; return Result; end Export_Aadl_Declarations; end Task_Set;