-------------------------------------------------------- ------------------------ ------------------------------------------------------------------------------ -- 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: 559 $ -- $Date: 2012-10-13 13:58:21 +0200 (Sat, 13 Oct 2012) $ -- $Author: gaudel $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Text_IO; use Text_IO; with Offsets; use Offsets; use Offsets.Offsets_Table_Package; with Qs_Tools; use Qs_Tools; with Ada.Exceptions; use Ada.Exceptions; with Expressions; use Expressions; with Dependencies; use Dependencies; with unbounded_strings; use unbounded_strings; package body Scheduler is procedure Put (My_Scheduler : in Generic_Scheduler_Ptr) is begin Put (My_Scheduler.all); end Put; function Export_Aadl_Properties (My_Scheduler : in Generic_Scheduler; Number_Of_Ht : in Natural) return Unbounded_String is Result : Unbounded_String := empty_string; begin for I in 1 .. Number_Of_Ht loop Result := Result & ASCII.HT; end loop; Result := Result & To_Unbounded_String ("Scheduling_Protocol => " & To_String (Get_Name (My_Scheduler)) & ";") & unbounded_lf; for I in 1 .. Number_Of_Ht loop Result := Result & ASCII.HT; end loop; Result := Result & To_Unbounded_String ("Cheddar_Properties::Scheduler_Quantum => " & Get_Quantum (My_Scheduler) & " ms ;") & unbounded_lf; for I in 1 .. Number_Of_Ht loop Result := Result & ASCII.HT; end loop; if Get_Preemptive (My_Scheduler) = preemptive then Result := Result & To_Unbounded_String ("Cheddar_Properties::Preemptive_Scheduler => True;") & unbounded_lf; else Result := Result & To_Unbounded_String ("Cheddar_Properties::Preemptive_Scheduler => False;") & unbounded_lf; end if; return Result; end Export_Aadl_Properties; function Export_Xml (My_Scheduler : in Generic_Scheduler) return Unbounded_String is Result : Unbounded_String := empty_string; Quantum : constant Natural := Get_Quantum (My_Scheduler); Is_Preemptive : constant Preemptives_Type := Get_Preemptive (My_Scheduler); Name : Unbounded_String := Get_Name (My_Scheduler); begin Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & ""); Result := Result & To_Unbounded_String (" ") & Name & To_Unbounded_String (" "); Result := Result & To_Unbounded_String ("") & unbounded_lf; return Result; end Export_Xml; procedure Set_Preemptive (My_Scheduler : in out Generic_Scheduler'Class; Preempt : in Preemptives_Type) is begin My_Scheduler.parameters.preemptive_type := Preempt; end Set_Preemptive; function Get_Preemptive (My_Scheduler : in Generic_Scheduler'Class) return Preemptives_Type is begin return My_Scheduler.parameters.preemptive_type; end Get_Preemptive; function Get_Preemptive (My_Scheduler : in Generic_Scheduler'Class) return String is begin return My_Scheduler.parameters.preemptive_type'Img; end Get_Preemptive; procedure Put (My_Scheduler : in Generic_Scheduler) is begin Put (My_Scheduler.parameters); end Put; procedure Reset (A_Scheduler : in out Generic_Scheduler'Class) is begin Initialize (A_Scheduler.parameters); end Reset; function Get_Name (My_Scheduler : in Generic_Scheduler'Class) return Unbounded_String is begin return To_Unbounded_String (My_Scheduler.parameters.scheduler_type'Img); end Get_Name; function Get_Name (My_Scheduler : in Generic_Scheduler_Ptr) return Unbounded_String is begin return Get_Name (My_Scheduler.all); end Get_Name; function Get_Name (My_Scheduler : in Generic_Scheduler'Class) return Schedulers_Type is begin return My_Scheduler.parameters.scheduler_type; end Get_Name; function Get_Name (My_Scheduler : in Generic_Scheduler_Ptr) return Schedulers_Type is begin return Get_Name (My_Scheduler.all); end Get_Name; function Build_Tcb (My_Scheduler : in Generic_Scheduler; A_Task : Generic_Task_Ptr) return Tcb_Ptr is A_Tcb : Tcb_Ptr; begin A_Tcb := new Tcb; Initialize (A_Tcb.all, A_Task); return A_Tcb; end Build_Tcb; procedure Initialize (A_Tcb : in out Tcb; A_Task : Generic_Task_Ptr) is Seed : Generator; begin A_Tcb.Tsk := A_Task; A_Tcb.Activation := 1; A_Tcb.End_Time := 0; A_Tcb.Used_Cpu := 0; A_Tcb.Wake_Up_Time := A_Tcb.Tsk.start_time; A_Tcb.Rest_Of_Capacity := A_Tcb.Tsk.capacity; A_Tcb.Used_Capacity := 0; A_Tcb.Suspended := False; if (A_Tcb.Tsk.task_type = Poisson_Type) or (A_Tcb.Tsk.task_type = Parametric_Type) then if (Poisson_Task_Ptr (A_Tcb.Tsk).predictable) then Reset (Seed, Poisson_Task_Ptr (A_Tcb.Tsk).seed); else Reset (Seed); end if; Save (Seed, A_Tcb.Task_Seed); end if; end Initialize; procedure processor_Initialization (My_Scheduler : in out Generic_Scheduler'Class; Si : in out Scheduling_Information; Processor_Name : in Unbounded_String; My_Tasks : in out Tasks_Set; My_Resources : in out Resources_Set; My_Buffers : in out Buffers_Set; Result : in out Scheduling_Sequence_Ptr; With_Offsets : Boolean; With_Precedencies : Boolean; With_Resources : Boolean; With_Task_Specific_Seed : Boolean := True; Global_Seed_Value : Integer := 0; Predictable_Global_Seed : Boolean := True; Given_Last_Time : in Natural; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is Iterator1 : Tasks_Iterator; Iterator2 : Resources_Iterator; A_Buffer_Size : Buffer_Scheduling_Information_Ptr; Iterator3 : Buffers_Iterator; A_Buffer : Buffer_Ptr; A_Task : Generic_Task_Ptr; A_Resource : Generic_Resource_Ptr; Seed : Generator; A_Item : Time_Unit_Event_Ptr; begin if (Predictable_Global_Seed) then Reset (Seed, Global_Seed_Value); else Reset (Seed); end if; Si.With_Specific_Task_Seed := With_Task_Specific_Seed; Save (Seed, Si.Global_Seed); -- Build Task Control Blocks -- reset_iterator (My_Tasks, Iterator1); loop current_element (My_Tasks, A_Task, Iterator1); Si.Tcbs (Si.Number_Of_Tasks) := Build_Tcb (My_Scheduler, A_Task); Si.Number_Of_Tasks := Si.Number_Of_Tasks + 1; exit when is_last_element (My_Tasks, Iterator1); next_element (My_Tasks, Iterator1); end loop; -- Build of buffer list with their current size -- (in order to generate Write/Read buffer events -- if (With_Precedencies) then if (get_number_of_elements (My_Buffers) > 0) then reset_iterator (My_Buffers, Iterator3); loop current_element (My_Buffers, A_Buffer, Iterator3); A_Buffer_Size := new Buffer_Scheduling_Information; A_Buffer_Size.Written_Buffer := A_Buffer; A_Buffer_Size.Current_Size := 0; add (Si.Written_Buffers, A_Buffer_Size); exit when is_last_element (My_Buffers, Iterator3); next_element (My_Buffers, Iterator3); end loop; end if; end if; if (With_Resources) then if (get_number_of_elements (My_Resources) > 0) then reset_iterator (My_Resources, Iterator2); loop current_element (My_Resources, A_Resource, Iterator2); Si.Shared_Resources (Si.Number_Of_Resources) := Build_Resource (My_Scheduler, A_Resource); Si.Number_Of_Resources := Si.Number_Of_Resources + 1; exit when is_last_element (My_Resources, Iterator2); next_element (My_Resources, Iterator2); end loop; end if; end if; -- Initialize event table (store the computed scheduling) -- initialize (Result.all); -- First activation for all tasks -- for I in 0 .. Si.Number_Of_Tasks - 1 loop if Si.Tcbs (I).Tsk.cpu_name = Processor_Name then if Event_To_Generate (Task_Activation) then A_Item := new Time_Unit_Event (Task_activation); A_Item.activation_task := Si.Tcbs (I).Tsk; add (Result.all, Si.Tcbs (I).Tsk.start_time, a_item); end if; end if; end loop; end processor_Initialization; procedure core_unit_Initialization (My_Scheduler : in out Generic_Scheduler'Class; Si : in out Scheduling_Information; Processor_Name : in Unbounded_String; My_Tasks : in out Tasks_Set; My_Resources : in out Resources_Set; My_Buffers : in out Buffers_Set; Result : in out Scheduling_Sequence_Ptr; With_Offsets : Boolean; With_Precedencies : Boolean; With_Resources : Boolean; With_Task_Specific_Seed : Boolean := True; Global_Seed_Value : Integer := 0; Predictable_Global_Seed : Boolean := True; Given_Last_Time : in Natural; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is begin My_Scheduler.Previously_Elected := Tasks_Range'First; My_Scheduler.previous_time_unit_was_busy := False; end core_unit_Initialization; procedure Update_Task_Simulation_Properties_And_Produce_Events (My_Scheduler : in out Generic_Scheduler'Class; Processor_Name : in Unbounded_String; Si : in out Scheduling_Information; My_Dependencies : in Tasks_Dependencies_Ptr; Elected : in Tasks_Range; Result : in out Scheduling_Sequence_Ptr; Current_Time : in Natural; Last_Time : in Natural; With_Offsets : Boolean := True; With_Precedencies : Boolean := True; With_Resources : Boolean := True; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is -- For Poisson Process task -- Seed : Generator; Temp : Natural; -- For Parametric task -- Parametric_Delay : Natural := 0; A_Item : Time_Unit_Event_Ptr; begin ------------------------------------------------------ -- Allocate/release shared resources -- and produce associated events ------------------------------------------------------ if With_Resources then Allocate_Resource (My_Scheduler, Si, Result, Current_Time, Si.Tcbs (Elected), Event_To_Generate); Release_Resource (My_Scheduler, Si, Result, Current_Time, Si.Tcbs (Elected), Event_To_Generate); end if; ------------------------------------------------------ -- Send/Receive Messages -- write/read on buffers -- and produce associated events ------------------------------------------------------ if With_Precedencies then Send_Message (My_Scheduler, Si, Result, Current_Time, Si.Tcbs (Elected), My_Dependencies, Event_To_Generate); Receive_Message (My_Scheduler, Si, Result, Current_Time, Si.Tcbs (Elected), My_Dependencies, Event_To_Generate); Buffer_Write (My_Scheduler, Si, Result, Current_Time, Si.Tcbs (Elected), My_Dependencies, Event_To_Generate); Buffer_Read (My_Scheduler, Si, Result, Current_Time, Si.Tcbs (Elected), My_Dependencies, Event_To_Generate); end if; --------------------------------------------------------- -- Update task properties and produce associated events --------------------------------------------------------- -- -- Produce events -- if Si.Tcbs (Elected).Rest_Of_Capacity = Si.Tcbs (Elected).Tsk.capacity then if Event_To_Generate (Start_Of_Task_Capacity) then A_Item := new Time_Unit_Event (Start_Of_Task_Capacity); A_Item.start_task := Si.Tcbs (Elected).Tsk; add (Result.all, Current_Time, a_item); end if; end if; if Event_To_Generate (Running_Task) then A_Item := Produce_Running_Task_Event (My_Scheduler, Si.Tcbs (Elected)); add (Result.all, Current_Time, a_item); end if; if Si.Tcbs (Elected).Rest_Of_Capacity - 1 = 0 then if Event_To_Generate (End_Of_Task_Capacity) then A_Item := new Time_Unit_Event (End_Of_Task_Capacity); A_Item.end_task := Si.Tcbs (Elected).Tsk; add (Result.all, Current_Time + 1, a_item); end if; end if; -- Update task properties -- -- update of various "capacities" -- Si.Tcbs (Elected).Used_Capacity := Si.Tcbs (Elected).Used_Capacity + 1; Si.Tcbs (Elected).Rest_Of_Capacity := Si.Tcbs (Elected).Rest_Of_Capacity - 1; Si.Tcbs (Elected).Used_Cpu := Si.Tcbs (Elected).Used_Cpu + 1; -- The task is not assigned anymore to a core unit -- if (Si.Tcbs (Elected).Rest_Of_Capacity = 0) then Si.Tcbs (Elected).assigned_core_unit := empty_string; end if; -- -- Compute the next task activations -- if (Si.Tcbs (Elected).Rest_Of_Capacity = 0) then Si.Tcbs (Elected).Used_Capacity := 0; Si.Tcbs (Elected).End_Time := Current_Time + 1; Si.Tcbs (Elected).Activation := Si.Tcbs (Elected).Activation + 1; case Si.Tcbs (Elected).Tsk.task_type is when Periodic_Type => Si.Tcbs (Elected).Rest_Of_Capacity := Si.Tcbs (Elected).Tsk.capacity; Si.Tcbs (Elected).Wake_Up_Time := Si.Tcbs (Elected).Wake_Up_Time + Periodic_Task_Ptr (Si.Tcbs (Elected).Tsk).period; when Poisson_Type => Si.Tcbs (Elected).Rest_Of_Capacity := Si.Tcbs (Elected).Tsk.capacity; if Si.With_Specific_Task_Seed then Reset (Seed, Si.Tcbs (Elected).Task_Seed); else Reset (Seed, Si.Global_Seed); end if; Temp := Natural (Get_Exponential_Time (Double ( Poisson_Task_Ptr (Si.Tcbs (Elected).Tsk).period), Seed)); Si.Tcbs (Elected).Wake_Up_Time := Si.Tcbs (Elected).Wake_Up_Time + Temp; if Si.With_Specific_Task_Seed then Save (Seed, Si.Tcbs (Elected).Task_Seed); else Save (Seed, Si.Global_Seed); end if; when Sporadic_Type => Si.Tcbs (Elected).Rest_Of_Capacity := Si.Tcbs (Elected).Tsk.capacity; if Si.With_Specific_Task_Seed then Reset (Seed, Si.Tcbs (Elected).Task_Seed); else Reset (Seed, Si.Global_Seed); end if; Temp := Natural (Get_Exponential_Time (Double ( Poisson_Task_Ptr (Si.Tcbs (Elected).Tsk).period), Seed)); Si.Tcbs (Elected).Wake_Up_Time := Si.Tcbs (Elected).Wake_Up_Time + Natural'Max (Temp, Periodic_Task_Ptr (Si.Tcbs (Elected).Tsk).period); if Si.With_Specific_Task_Seed then Save (Seed, Si.Tcbs (Elected).Task_Seed); else Save (Seed, Si.Global_Seed); end if; when Aperiodic_Type => null; when Scheduling_Task_Type => null; when Parametric_Type => Si.Tcbs (Elected).Rest_Of_Capacity := Si.Tcbs (Elected).Tsk.capacity; -- The scheduler has to be a parametric one !!! -- if (My_Scheduler.parameters.scheduler_type /= pipeline_User_Defined_Protocol) and (My_Scheduler.parameters.scheduler_type /= Compiled_User_Defined_Protocol) and (My_Scheduler.parameters.scheduler_type /= Automata_User_Defined_Protocol) then Raise_Exception (Statement_Error'Identity, "User-defined task only permitted with user-defined schedulers"); end if; Compute_Activation_Time (My_Scheduler, Si, Elected, Parametric_Delay); Si.Tcbs (Elected).Wake_Up_Time := Si.Tcbs (Elected).Wake_Up_Time + Parametric_Delay; when Frame_Task_Type => Si.Tcbs (Elected).Rest_Of_Capacity := Si.Tcbs (Elected).Tsk.capacity; Si.Tcbs (Elected).Wake_Up_Time := Si.Tcbs (Elected).Wake_Up_Time + Frame_Task_Ptr (Si.Tcbs (Elected).Tsk).period; end case; -- Add to the scheduling table the next activation time -- if Si.Tcbs (Elected).Tsk.task_type /= Aperiodic_Type and Si.Tcbs (Elected).Wake_Up_Time <= Last_Time then if Event_To_Generate (Task_Activation) then A_Item := new Time_Unit_Event (Task_activation); A_Item.activation_task := Si.Tcbs (Elected).Tsk; add (Result.all, Si.Tcbs (Elected).Wake_Up_Time, a_item); end if; end if; end if; -- Store the previous ran task -- My_Scheduler.Previously_Elected := Elected; My_Scheduler.previous_time_unit_was_busy := True; end Update_Task_Simulation_Properties_And_Produce_Events; -- Return true is the task "task_id" can be schedule now -- according its offsets -- function Check_Offset (A_Tcb : Tcb_Ptr; At_Time : Natural) return Boolean is Target_Time : Integer := 0; begin for K in 0 .. A_Tcb.Tsk.offsets.nb_entries - 1 loop if (A_Tcb.Tsk.offsets.entries (K).activation = A_Tcb.Activation) or (A_Tcb.Tsk.offsets.entries (K).activation = 0) then Target_Time := A_Tcb.Wake_Up_Time + A_Tcb.Tsk.offsets.entries (K).offset_value; if At_Time < Target_Time then return False; end if; end if; end loop; return True; end Check_Offset; function Select_Cpu (Op1 : in Generic_Task_Ptr) return Boolean is begin return (Op1.cpu_name = Current_Processor_Name); end Select_Cpu; function Select_Cpu (Op1 : in Generic_Resource_Ptr) return Boolean is begin return (Op1.cpu_name = Current_Processor_Name); end Select_Cpu; function Select_Cpu (Op1 : in Buffer_Ptr) return Boolean is begin return (Op1.cpu_name = Current_Processor_Name); end Select_Cpu; procedure Send_Message (My_Scheduler : in out Generic_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Current_Time : in Natural; A_Tcb : Tcb_Ptr; Deps : Tasks_Dependencies_Ptr; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is A_Item : Time_Unit_Event_Ptr; My_Iterator : Tasks_Dependencies_Iterator; A_Half_Dep_Ptr : Dependency_Ptr; A_Message : Generic_Message_Ptr; A_Message_Scheduling_Information : Message_Scheduling_Information_Ptr; begin -- is the time to send message ? -- if (A_Tcb.Rest_Of_Capacity = 1) then -- Check if the task has a message to send -- if not is_empty (Deps.Depends) then reset_iterator (Deps.Depends, My_Iterator); loop current_element (Deps.Depends, A_Half_Dep_Ptr, My_Iterator); -- Is the task concerned ? -- Is it a communication dependency ? -- Is it a sending operation ? -- if (A_Half_Dep_Ptr.discriminant = Communication_Dependency) then if (A_Half_Dep_Ptr.communication_dependent_task.name = A_Tcb.Tsk.name) and (A_Half_Dep_Ptr.communication_orientation = From_Task_To_Object) then A_Message := A_Half_Dep_Ptr.communication_dependency_object; A_Message_Scheduling_Information := new Message_Scheduling_Information; A_Message_Scheduling_Information.Send_Time := Current_Time + 1; A_Message_Scheduling_Information.Sended_Message := A_Message; add (Si.Sended_Messages, A_Message_Scheduling_Information); if Event_To_Generate (Send_Message) then A_Item := new Time_Unit_Event (Send_Message); A_Item.send_message := A_Message; A_Item.send_task := A_Tcb.Tsk; add (Result.all, A_Message_Scheduling_Information.Send_Time, A_Item); end if; end if; end if; exit when is_last_element (Deps.Depends, My_Iterator); next_element (Deps.Depends, My_Iterator); end loop; end if; end if; end Send_Message; procedure Receive_Message (My_Scheduler : in out Generic_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Current_Time : in Natural; A_Tcb : Tcb_Ptr; Deps : Tasks_Dependencies_Ptr; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is A_Item : Time_Unit_Event_Ptr; My_Iterator : Tasks_Dependencies_Iterator; A_Half_Dep_Ptr : Dependency_Ptr; A_Message : Generic_Message_Ptr; List_Ite : Message_Scheduling_Information_Iterator; Msg : Message_Scheduling_Information_Ptr; begin -- Is The time to receive a message ? -- if (A_Tcb.Rest_Of_Capacity = A_Tcb.Tsk.capacity) then -- Check the sended_messages to see if this -- messages was already sent -- if not is_empty (Si.Sended_Messages) then reset_head_iterator (Si.Sended_Messages, List_Ite); loop current_element (Si.Sended_Messages, Msg, List_Ite); reset_iterator (Deps.Depends, My_Iterator); loop current_element (Deps.Depends, A_Half_Dep_Ptr, My_Iterator); -- Is the task concerned ? -- Is it a communication dependency ? -- Is it a receiving operation ? -- if (A_Half_Dep_Ptr.discriminant = Communication_Dependency) then if (A_Half_Dep_Ptr.communication_dependent_task.name = A_Tcb.Tsk.name) and (A_Half_Dep_Ptr.communication_orientation = From_Object_To_Task) then A_Message := A_Half_Dep_Ptr.communication_dependency_object; -- Check the sended_messages to see if this -- messages was already sent -- -- Is it the right message ? -- Is the message arrived at the receiving processor ? -- if (Msg.Sended_Message.name = A_Message.name) then if (Current_Time >= (Msg.Send_Time + A_Message.response_time - 1)) then if Event_To_Generate (Receive_Message) then A_Item := new Time_Unit_Event (Receive_Message); A_Item.receive_message := A_Message; A_Item.receive_task := A_Tcb.Tsk; add (Result.all, Current_Time, A_item); end if; -- Delete received message -- delete (Si.Sended_Messages, Msg); -- Currently, a task reads only one message per --activation -- return; end if; end if; end if; end if; exit when is_last_element (Deps.Depends, My_Iterator); next_element (Deps.Depends, My_Iterator); end loop; if is_tail_element (Si.Sended_Messages, List_Ite) then exit; end if; next_element (Si.Sended_Messages, List_Ite); end loop; end if; end if; end Receive_Message; procedure Buffer_Read (My_Scheduler : in out Generic_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Current_Time : in Natural; A_Tcb : Tcb_Ptr; Deps : Tasks_Dependencies_Ptr; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is A_Item : Time_Unit_Event_Ptr; My_Iterator : Tasks_Dependencies_Iterator; A_Half_Dep_Ptr : Dependency_Ptr; A_Buffer : Buffer_Ptr; A_Buffer_Size : Buffer_Scheduling_Information_Ptr; List_Ite : Buffer_Scheduling_Information_Iterator; begin -- Check if the task has a buffer to write -- if (Has_Buffer_To_Read (Deps, A_Tcb.Tsk)) then -- for all tasks which have a precedency with the current task -- loop current_element (Deps.Depends, A_Half_Dep_Ptr, My_Iterator); if (A_Half_Dep_Ptr.discriminant = Queuing_Buffer_Dependency) then if (A_Half_Dep_Ptr.buffer_dependent_task.name = A_Tcb.Tsk.name) and (A_Half_Dep_Ptr.buffer_orientation = From_Object_To_Task) then A_Buffer := A_Half_Dep_Ptr.buffer_dependency_object; -- Must we generate Read event ? -- if Event_To_Generate (Read_From_Buffer) then for I in 0 .. A_Buffer.roles.nb_entries - 1 loop -- Is the right task ? -- if (A_Buffer.roles.entries (I).item = A_Tcb.Tsk.name) then -- Is it time to read ? -- if (A_Buffer.roles.entries (I).data.time = (A_Tcb.Tsk.capacity + 1 - A_Tcb.Rest_Of_Capacity)) then -- Does the task is consumer ? -- if (A_Buffer.roles.entries (I).data.the_role = queuing_Consumer) then -- Can we find some information to read ? -- if not is_empty (Si.Written_Buffers) then reset_head_iterator (Si.Written_Buffers, List_Ite); loop current_element (Si.Written_Buffers, A_Buffer_Size, List_Ite); if (A_Buffer_Size.Written_Buffer.name = A_Buffer.name) and (A_Buffer_Size.Current_Size >= A_Buffer.roles.entries (I).data. size) then A_Item := new Time_Unit_Event (Read_From_Buffer); A_Item.read_buffer := A_Buffer; A_Item.read_task := A_Tcb.Tsk; A_Item.read_size := A_Buffer.roles.entries (I).data. size; add (Result.all, Current_Time, A_Item); exit; end if; if is_tail_element (Si.Written_Buffers, List_Ite) then exit; end if; next_element (Si.Written_Buffers, List_Ite); end loop; end if; end if; end if; end if; end loop; end if; end if; end if; exit when is_last_element (Deps.Depends, My_Iterator); next_element (Deps.Depends, My_Iterator); end loop; end if; end Buffer_Read; procedure Buffer_Write (My_Scheduler : in out Generic_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Current_Time : in Natural; A_Tcb : Tcb_Ptr; Deps : Tasks_Dependencies_Ptr; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is A_Item : Time_Unit_Event_Ptr; My_Iterator : Tasks_Dependencies_Iterator; A_Half_Dep_Ptr : Dependency_Ptr; A_Buffer : Buffer_Ptr; A_Buffer_Size : Buffer_Scheduling_Information_Ptr; List_Ite : Buffer_Scheduling_Information_Iterator; begin -- Check if the task has a buffer to write -- if (Has_Buffer_To_Write (Deps, A_Tcb.Tsk)) then -- for all tasks which have a precedency with the current task -- loop current_element (Deps.Depends, A_Half_Dep_Ptr, My_Iterator); if (A_Half_Dep_Ptr.discriminant = Queuing_Buffer_Dependency) then if (A_Half_Dep_Ptr.buffer_dependent_task.name = A_Tcb.Tsk.name) and (A_Half_Dep_Ptr.buffer_orientation = From_Task_To_Object) then A_Buffer := A_Half_Dep_Ptr.buffer_dependency_object; -- Must we generate Write event ? -- if Event_To_Generate (Write_To_Buffer) then for I in 0 .. A_Buffer.roles.nb_entries - 1 loop -- Is the right task ? -- if (A_Buffer.roles.entries (I).item = A_Tcb.Tsk.name) then -- Does the task is producer ? -- if (A_Buffer.roles.entries (I).data.the_role = queuing_Producer) then -- Is it time to write ? -- if (A_Buffer.roles.entries (I).data.time = (A_Tcb.Tsk.capacity + 1 - A_Tcb.Rest_Of_Capacity)) then A_Item := new Time_Unit_Event (Write_To_Buffer); A_Item.write_buffer := A_Buffer; A_Item.write_task := A_Tcb.Tsk; A_Item.write_size := A_Buffer.roles.entries (I).data.size; add (Result.all, Current_Time, a_item); -- Add the size write event to the buffer list -- if not is_empty (Si.Written_Buffers) then reset_head_iterator (Si.Written_Buffers, List_Ite); loop current_element (Si.Written_Buffers, A_Buffer_Size, List_Ite); if A_Buffer_Size.Written_Buffer.name = A_Buffer.name then A_Buffer_Size.Current_Size := A_Buffer_Size.Current_Size + A_Item.write_size; exit; end if; if is_tail_element (Si.Written_Buffers, List_Ite) then exit; end if; next_element (Si.Written_Buffers, List_Ite); end loop; end if; end if; end if; end if; end loop; end if; end if; end if; exit when is_last_element (Deps.Depends, My_Iterator); next_element (Deps.Depends, My_Iterator); end loop; end if; end Buffer_Write; procedure Release_Resource (My_Scheduler : in out Generic_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Current_Time : in Natural; A_Tcb : Tcb_Ptr; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is Current_Capacity : Natural := 0; A_Item : Time_Unit_Event_Ptr; begin if (Si.Number_Of_Resources > 0) then Current_Capacity := A_Tcb.Tsk.capacity - A_Tcb.Rest_Of_Capacity + 1; for Index1 in 0 .. Si.Number_Of_Resources - 1 loop -- For each resource, check if the task hold resources -- and then release them -- for Index2 in 0 .. Si.Shared_Resources (Index1).Shared.critical_sections.nb_entries - 1 loop if (Current_Capacity = Si.Shared_Resources (Index1).Shared.critical_sections.entries ( Index2).data.task_end) and (Si.Shared_Resources (Index1).Shared.critical_sections.entries ( Index2).item = A_Tcb.Tsk.name) then Si.Shared_Resources (Index1).Shared.state := Si.Shared_Resources (Index1).Shared.state + 1; for I in 0 .. Si.Shared_Resources (Index1).Nb_Allocated - 1 loop if Si.Shared_Resources (Index1).Allocated_By (I) = A_Tcb.Tsk.name then Si.Shared_Resources (Index1).Allocated_By (I) := Si.Shared_Resources (Index1).Allocated_By ( Si.Shared_Resources (Index1).Nb_Allocated - 1); Si.Shared_Resources (Index1).Nb_Allocated := Si.Shared_Resources (Index1).Nb_Allocated - 1; if Event_To_Generate (Release_Resource) then A_Item := new Time_Unit_Event (Release_Resource); A_Item.release_resource := Si.Shared_Resources (Index1).Shared; A_Item.release_task := A_Tcb.Tsk; add (Result.all, Current_Time, a_item); end if; exit; end if; end loop; end if; end loop; end loop; end if; end Release_Resource; procedure Allocate_Resource (My_Scheduler : in out Generic_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Current_Time : in Natural; A_Tcb : Tcb_Ptr; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is Current_Capacity : Natural := 0; A_Item : Time_Unit_Event_Ptr; begin if (Si.Number_Of_Resources > 0) then Current_Capacity := A_Tcb.Tsk.capacity - A_Tcb.Rest_Of_Capacity + 1; for Index1 in 0 .. Si.Number_Of_Resources - 1 loop -- For each resource, check if the task request the resource -- and if the resource is free -- otherwise, block the task -- for Index2 in 0 .. Si.Shared_Resources (Index1).Shared.critical_sections.nb_entries - 1 loop if (Current_Capacity = Si.Shared_Resources (Index1).Shared.critical_sections.entries ( Index2).data.task_begin) and (Si.Shared_Resources (Index1).Shared.critical_sections.entries ( Index2).item = A_Tcb.Tsk.name) then Si.Shared_Resources (Index1).Shared.state := Si.Shared_Resources (Index1).Shared.state - 1; Si.Shared_Resources (Index1).Allocated_By ( Si.Shared_Resources (Index1).Nb_Allocated) := A_Tcb.Tsk.name; Si.Shared_Resources (Index1).Nb_Allocated := Si.Shared_Resources (Index1).Nb_Allocated + 1; if Event_To_Generate (Allocate_Resource) then A_Item := new Time_Unit_Event (Allocate_Resource); A_Item.allocate_resource := Si.Shared_Resources (Index1).Shared; A_Item.allocate_task := A_Tcb.Tsk; add (Result.all, Current_Time, a_item); end if; end if; end loop; end loop; end if; end Allocate_Resource; procedure Check_Resource (My_Scheduler : in out Generic_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Current_Time : in Natural; A_Tcb : in Tcb_Ptr; Is_Ready : out Boolean; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is Current_Capacity : Natural := 0; A_Item : Time_Unit_Event_Ptr; begin Is_Ready := True; if (Si.Number_Of_Resources > 0) then Current_Capacity := A_Tcb.Tsk.capacity - A_Tcb.Rest_Of_Capacity + 1; for Index1 in 0 .. Si.Number_Of_Resources - 1 loop -- For each resource, check if the task request the resource -- and if the resource is free -- for Index2 in 0 .. Si.Shared_Resources (Index1).Shared.critical_sections.nb_entries - 1 loop if (Current_Capacity = Si.Shared_Resources (Index1).Shared.critical_sections.entries ( Index2).data.task_begin) and (Si.Shared_Resources (Index1).Shared.critical_sections.entries ( Index2).item = A_Tcb.Tsk.name) then if (Si.Shared_Resources (Index1).Shared.state = 0) then Is_Ready := False; end if; if not Is_Ready then if Event_To_Generate (Wait_For_Resource) then A_Item := new Time_Unit_Event (Wait_For_Resource); A_Item.wait_for_resource := Si.Shared_Resources (Index1).Shared; A_Item.wait_for_resource_task := A_Tcb.Tsk; add (Result.all, current_time, A_Item); end if; end if; end if; end loop; end loop; end if; end Check_Resource; procedure Set_Quantum (My_Scheduler : in out Generic_Scheduler'Class; Q : in Natural) is begin My_Scheduler.parameters.quantum := Q; end Set_Quantum; function Get_Quantum (My_Scheduler : in Generic_Scheduler'Class) return Natural is begin return My_Scheduler.parameters.quantum; end Get_Quantum; function Get_Quantum (My_Scheduler : in Generic_Scheduler'Class) return Unbounded_String is begin return To_Unbounded_String (My_Scheduler.parameters.quantum'Img); end Get_Quantum; function Get_Quantum (My_Scheduler : in Generic_Scheduler'Class) return String is begin return My_Scheduler.parameters.quantum'Img; end Get_Quantum; function Build_Resource (My_Scheduler : in Generic_Scheduler; A_Resource : Generic_Resource_Ptr) return Shared_Resource_Ptr is New_A_Resource : Shared_Resource_Ptr; begin New_A_Resource := new Shared_Resource; New_A_Resource.Shared := A_Resource; return New_A_Resource; end Build_Resource; procedure Initialize (S : in out Scheduling_Information) is begin S.Number_Of_Tasks := 0; S.Number_Of_Resources := 0; end Initialize; -- If this function return "True", it means that -- the task "A_Tcb" can be selected because of all its -- predecessors have ended their activation -- function Check_Precedencies (Si : in Scheduling_Information; Deps : Tasks_Dependencies_Ptr; Current_Time : in Natural; A_Tcb : Tcb_Ptr) return Boolean is Has_Message_To_Receive : Boolean := False; Wait_Message : Boolean := False; Previous : Tasks_Set; Left : Generic_Task_Ptr; Ite1 : Tasks_Iterator; A_Half_Dep_Ptr : Dependency_Ptr; A_Message : Generic_Message_Ptr; My_Iterator : Tasks_Dependencies_Iterator; List_Ite : Message_Scheduling_Information_Iterator; Msg : Message_Scheduling_Information_Ptr; begin ------------------------------------------------- -- Check if the task has a task precedency and -- if they are met ------------------------------------------------- if Has_Predecessor (Deps, A_Tcb.Tsk) then reset (Previous); Previous := Get_Predecessors_List (Deps, A_Tcb.Tsk); reset_iterator (Previous, Ite1); for J in 0 .. get_number_of_elements (Previous) - 1 loop current_element (Previous, Left, Ite1); for I in 0 .. Si.Number_Of_Tasks - 1 loop if Si.Tcbs (I).Tsk.name = Left.name then if (Si.Tcbs (I).Activation <= A_Tcb.Activation) then return False; end if; -- Same activation ... be sure the previous task -- is ended -- if (Si.Tcbs (I).Activation = A_Tcb.Activation + 1) and (Si.Tcbs (I).End_Time > Current_Time) then return False; end if; end if; end loop; next_element (Previous, Ite1); end loop; end if; ------------------------------------------------- -- Check communication dependencies first -- A "receiver" has to read at most one message -- to be activated ------------------------------------------------- if not is_empty (Deps.Depends) then reset_iterator (Deps.Depends, My_Iterator); loop current_element (Deps.Depends, A_Half_Dep_Ptr, My_Iterator); -- Is the task concerned ? -- Is it a communication dependency ? -- Is it a receiving operation ? -- if (A_Half_Dep_Ptr.discriminant = Communication_Dependency) then if (A_Half_Dep_Ptr.communication_dependent_task.name = A_Tcb.Tsk.name) and (A_Half_Dep_Ptr.communication_orientation = From_Object_To_Task) then A_Message := A_Half_Dep_Ptr.communication_dependency_object; -- Is The task waiting for a message ? -- if (A_Tcb.Rest_Of_Capacity = A_Tcb.Tsk.capacity) then Wait_Message := True; end if; -- Check the sended_messages to see if this -- messages is just arrived -- if not is_empty (Si.Sended_Messages) then reset_head_iterator (Si.Sended_Messages, List_Ite); loop current_element (Si.Sended_Messages, Msg, List_Ite); -- Is it the right message ? -- Is the message arrived at the receiving processor ? -- if Wait_Message then if (Msg.Sended_Message.name = A_Message.name) then if (Current_Time >= (Msg.Send_Time + A_Message.response_time)) then Has_Message_To_Receive := True; end if; end if; end if; if is_tail_element (Si.Sended_Messages, List_Ite) then exit; end if; next_element (Si.Sended_Messages, List_Ite); end loop; end if; end if; end if; exit when is_last_element (Deps.Depends, My_Iterator); next_element (Deps.Depends, My_Iterator); end loop; end if; -- If the task wait for a message which is not -- arrived, do not wake up it -- if Wait_Message and (not Has_Message_To_Receive) then return False; end if; -- All dependency constraints are met -- return True; end Check_Precedencies; procedure Compute_Activation_Time (My_Scheduler : in Generic_Scheduler; Si : in out Scheduling_Information; Elected : in Tasks_Range; Value : in out Natural) is begin Value := 0; end Compute_Activation_Time; procedure Put (M : in Message_Scheduling_Information_Ptr) is begin Put ("Message " & To_String (M.Sended_Message.name)); Put_Line (" ; send_time = " & M.Send_Time'Img); end Put; procedure Put (M : in Buffer_Scheduling_Information_Ptr) is begin Put ("Buffer " & To_String (M.Written_Buffer.name)); Put_Line (" ; current_size = " & M.Current_Size'Img); end Put; function Produce_Running_Task_Event (My_Scheduler : in Generic_Scheduler; A_Task : in Tcb_Ptr) return Time_Unit_Event_Ptr is A_Item : Time_Unit_Event_Ptr; begin A_Item := new Time_Unit_Event (Running_Task); A_Item.running_task := A_Task.Tsk; A_Item.running_core := My_Scheduler.corresponding_core_unit; return A_Item; end Produce_Running_Task_Event; function Export_Xml_Event_Write_To_Buffer (My_Scheduler : in Generic_Scheduler; An_Event : in Time_Unit_Event_Ptr) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := " " & An_Event.write_buffer.name & " " & An_Event.write_task.name & " " & An_Event.write_size'Img; return Result; end Export_Xml_Event_Write_To_Buffer; function Export_Xml_Event_Read_From_Buffer (My_Scheduler : in Generic_Scheduler; An_Event : in Time_Unit_Event_Ptr) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := " " & An_Event.read_buffer.name & " " & An_Event.read_task.name & " " & An_Event.read_size'Img; return Result; end Export_Xml_Event_Read_From_Buffer; function Export_Xml_Event_Running_Task (My_Scheduler : in Generic_Scheduler; An_Event : in Time_Unit_Event_Ptr) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := " " & An_Event.running_task.name & " " & An_Event.running_core; return Result; end Export_Xml_Event_Running_Task; function Export_Xml_Event_context_switch_overhead (My_Scheduler : in Generic_Scheduler; An_Event : in Time_Unit_Event_Ptr) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := " " & An_Event.switched_task.name; return Result; end Export_Xml_Event_context_switch_overhead; function Export_Xml_Event_Task_Activation (My_Scheduler : in Generic_Scheduler; An_Event : in Time_Unit_Event_Ptr) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := " " & An_Event.activation_task.name; return Result; end Export_Xml_Event_Task_Activation; function Export_Xml_Event_Start_Of_Task_Capacity (My_Scheduler : in Generic_Scheduler; An_Event : in Time_Unit_Event_Ptr) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := " " & An_Event.start_task.name; return Result; end Export_Xml_Event_Start_Of_Task_Capacity; function Export_Xml_Event_End_Of_Task_Capacity (My_Scheduler : in Generic_Scheduler; An_Event : in Time_Unit_Event_Ptr) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := " " & An_Event.end_task.name; return Result; end Export_Xml_Event_End_Of_Task_Capacity; function Export_Xml_Event_Send_Message (My_Scheduler : in Generic_Scheduler; An_Event : in Time_Unit_Event_Ptr) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := " " & An_Event.send_message.name & " " & An_Event.send_task.name; return Result; end Export_Xml_Event_Send_Message; function Export_Xml_Event_Receive_Message (My_Scheduler : in Generic_Scheduler; An_Event : in Time_Unit_Event_Ptr) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := " " & An_Event.receive_message.name & " " & An_Event.receive_task.name; return Result; end Export_Xml_Event_Receive_Message; function Export_Xml_Event_Allocate_Resource (My_Scheduler : in Generic_Scheduler; An_Event : in Time_Unit_Event_Ptr) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := " " & An_Event.allocate_resource.name & " " & An_Event.allocate_task.name; return Result; end Export_Xml_Event_Allocate_Resource; function Export_Xml_Event_Release_Resource (My_Scheduler : in Generic_Scheduler; An_Event : in Time_Unit_Event_Ptr) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := " " & An_Event.release_resource.name & " " & An_Event.release_task.name; return Result; end Export_Xml_Event_Release_Resource; function Export_Xml_Event_Wait_For_Resource (My_Scheduler : in Generic_Scheduler; An_Event : in Time_Unit_Event_Ptr) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := " " & An_Event.wait_for_resource.name & " " & An_Event.wait_for_resource_task.name; return Result; end Export_Xml_Event_Wait_For_Resource; function XML_String (obj : in Generic_Scheduler_Ptr; level : in Natural := 0) return Unbounded_String is begin return XML_String (obj.parameters); end XML_String; --Added by Gaudel -- function Copy (obj : Buffer_Scheduling_Information_Ptr) return Buffer_Scheduling_Information_Ptr is ret : Buffer_Scheduling_Information_Ptr; begin ret := new Buffer_Scheduling_Information; ret.all := obj.all; return ret; end Copy; function Copy (obj : Message_Scheduling_Information_Ptr) return Message_Scheduling_Information_Ptr is ret : Message_Scheduling_Information_Ptr; begin ret := new Message_Scheduling_Information; ret.all := obj.all; return ret; end Copy; function Check_Task_Migration_Amoung_Cores (A_Scheduler : in Generic_Scheduler; A_Tcb : in Tcb_Ptr) return Boolean is begin -- The only case in which we MUST NOT select the task is when we have a --job level migration -- and when the task has already run a part of its capacity -- otherwise ... select the task by returning true -- if (A_Tcb.assigned_core_unit /= A_Scheduler.corresponding_core_unit) and (A_Tcb.assigned_core_unit /= empty_string) and (A_Scheduler.migration_is_allowed = job_level_migration_type) then return False; end if; return True; end Check_Task_Migration_Amoung_Cores; procedure Build_Attributes_XML_String (obj : in Generic_Scheduler_Ptr; level : in Natural := 0; result : in out Unbounded_String) is begin Build_Attributes_XML_String (obj.parameters, level, result); end Build_Attributes_XML_String; function XML_String(obj : in Buffer_Scheduling_Information_Ptr; level : in natural := 0) return Unbounded_String is begin return empty_string; end xml_string; function XML_String(obj : in Message_Scheduling_Information_Ptr; level : in natural := 0) return Unbounded_String is begin return empty_string; end xml_string; end Scheduler;