----------------------------------------------------------- --------------------- ------------------------------------------------------------------------------ -- 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: 548 $ -- $Date: 2012-10-12 01:48:51 +0200 (Fri, 12 Oct 2012) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Ada.Numerics; use Ada.Numerics; with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions; with scheduler_io; use scheduler_io; with Statements; use Statements; with Expressions; use Expressions; use Expressions.Variables_Type_Package; with Processors.extended; use Processors.extended; with processor_interface; use processor_interface; use Processors.Core_Units_Table_Package; with Tasks; use Tasks; with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; with unbounded_strings; use unbounded_strings; with Scheduler; use Scheduler; with Scheduler_Interface; use Scheduler_Interface; with Interpreter.extended; use Interpreter.extended; with Dependency_Services; use Dependency_Services; with Translate; use Translate; with io_tools; use io_tools; with Ada.IO_Exceptions; use Ada.IO_Exceptions; with Ada.Exceptions; use Ada.Exceptions; with Xml_generic_Parsers; use Xml_generic_Parsers; with Xml_generic_Parsers.event_table; use Xml_generic_Parsers.event_table; with Input_Sources.File; use Input_Sources.File; with Sax.Readers; use Sax.Readers; with Text_IO; use Text_IO; with Parser; use Parser; with Sections; use Sections; with section_Set; use section_Set; with Address_Spaces; use Address_Spaces; with Address_Spaces.extended; use Address_Spaces.extended; with Debug; use Debug; package body Multiprocessor_Services is procedure Free (Sched : in out Scheduling_Table_Ptr) is procedure Free_Pointer is new Unchecked_Deallocation ( Scheduling_Table, Scheduling_Table_Ptr); begin for I in Scheduling_Table_Range loop if Sched.entries (I).data.result /= null then free (Sched.entries (I).data.result); end if; end loop; Free_Pointer (Sched); end Free; procedure Build_Multiprocessor_Scheduling (My_Processors : in Processors_Set; My_Address_Spaces : in Address_Spaces_Set; My_Tasks : in Tasks_Set; My_Resources : in Resources_Set; My_Buffers : in Buffers_Set; My_Messages : in Messages_Set; My_Dependencies : in Tasks_Dependencies_Ptr; Result : in out Scheduling_Table_Ptr; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table; Last_Time : in Natural; With_Offsets : in Boolean := True; With_Precedencies : in Boolean := True; With_Resources : in Boolean := True; With_Task_Specific_Seed : in Boolean := True; Global_Seed_Value : in Integer := 0; Predictable_Global_Seed : in Boolean := True) is -- Data simulation -- Tmp_Buffers : array (Scheduling_Table_Range) of Buffers_Set; Tmp_Tasks : array (Scheduling_Table_Range) of Tasks_Set; Tmp_Resources : array (Scheduling_Table_Range) of Resources_Set; Si : Scheduling_Information; the_cores : Core_Units_Table; table_of_local_scheduler : Scheduler_table; -- Various pointers and iterators -- iterator2 : Address_Spaces_Iterator; A_Addr : Address_Space_Ptr; scheduler_index : scheduler_range; Iterator3 : Processors_Iterator; A_Processor : Generic_Processor_Ptr; -- Variables for the main loop of the simulation -- Last_Current_Time : Natural := 0; Current_Time : array (Scheduling_Table_Range) of Natural := (others => 0); Elected : Tasks_Range := Tasks_Range'First; No_Task : Boolean := True; must_perform_election : Boolean := True; begin Put_Debug ("Call Build_Multiprocessor_Scheduling", very_verbose); Put_Debug( "Build_Multiprocessor_Scheduling : check scheduler compliancy of tasks", very_verbose); ------------------------------------------------------------------------- -- Before scheduling, check if the tasks can be -- scheduled with the selected scheduler --------------------------------------------------------- reset_iterator (My_Processors, Iterator3); loop current_element (My_Processors, A_Processor, Iterator3); begin Result.entries (Result.nb_entries).item := A_Processor; Result.entries (Result.nb_entries).data.scheduling_msg := empty_string; Result.entries (Result.nb_entries).data.error_msg := empty_string; if (Get_Number_Of_Task_From_Processor (My_Tasks, A_Processor.name) /= 0) then the_cores := build_core_table (A_Processor); for core_id in 0 .. the_cores.nb_entries - 1 loop Check_Before_Scheduling ( extended_Core_Unit_Ptr (the_cores.entries (core_id)). scheduler.all, My_Tasks, A_Processor.name); end loop; if With_Precedencies then Dependencies_Periods_Control (My_Tasks, My_Dependencies, A_Processor.name); end if; else Result.entries (Result.nb_entries).data.error_msg := Lb_Minus & Lb_Define_Tasks_Before (Current_Language); end if; exception when Dependency_Services.Dependencies_Period_Error => Result.entries (Result.nb_entries).data.error_msg := Lb_Precedencies_Period_Error (Current_Language) & unbounded_lf; when Task_Set.Task_Must_Be_Periodic => Result.entries (Result.nb_entries).data.error_msg := Lb_Compute_Scheduling_Error_15 (Current_Language) & unbounded_lf; when Task_Set.Task_Must_Have_Period_Equal_To_Deadline => Result.entries (Result.nb_entries).data.error_msg := Lb_Compute_Scheduling_Error_14 (Current_Language) & unbounded_lf; when Task_Set.Task_Model_Error => Result.entries (Result.nb_entries).data.error_msg := Lb_Compute_Scheduling_Error_1 (Current_Language) & unbounded_lf; when Task_Set.Priority_Error => Result.entries (Result.nb_entries).data.error_msg := Lb_Compute_Scheduling_Error_11 (Current_Language) & unbounded_lf; end; Result.nb_entries := Result.nb_entries + 1; exit when is_last_element (My_Processors, Iterator3); next_element (My_Processors, Iterator3); end loop; --------------------------------------------------------- -- Now, perform scheduling simulation initialization -- This initialization is made in 5 steps : -- 1) initialization of variables to all processors and core units -- 2) gather all the data that will be handled by the simulateur -- 3) initialization of each processor -- 4) initialization of each core unit -- 5) initialization that are specific for each scheduler --------------------------------------------------------- -- Step 1 : initialization of variables to all processors and core units -- Put_Debug( "Build_Multiprocessor_Scheduling : initialization of processor and core units variables" , very_verbose); Si.Number_Of_Tasks := 0; Si.Number_Of_Resources := 0; Si.Number_Of_Processors := Integer (get_number_of_elements (My_Processors)); Si.Number_Of_Address_Spaces := Integer (get_number_of_elements (My_Address_Spaces)); Si.Simulation_Length := Last_Time; for J in 0 .. Result.nb_entries - 1 loop if Result.entries (J).data.error_msg = empty_string then Current_Processor_Name := Result.entries (J).item.name; Put_Debug ("Build_Multiprocessor_Scheduling : initialization of processor " & Current_Processor_Name, very_verbose); -- Step 2 : gather all the data that will be handled by the --simulateur -- -- Select tasks/resources/buffers -- select_and_copy (My_Tasks, Tmp_Tasks (J), Select_Cpu'Access); if (not is_empty(Tmp_Tasks(J))) then select_and_copy (My_Resources, Tmp_Resources (J), Select_Cpu'Access); select_and_copy (My_Buffers, Tmp_Buffers (J), Select_Cpu'Access); -- Build local/address spaces scheduler table -- scheduler_index := 0; table_of_local_scheduler := (others => null); if not is_empty (My_Address_Spaces) then reset_iterator (My_Address_Spaces, iterator2); loop current_element (My_Address_Spaces, A_Addr, iterator2); if A_Addr.cpu_name = Current_Processor_Name then if extended_address_space_Ptr (A_Addr).scheduler /= null then table_of_local_scheduler (scheduler_index) := new local_scheduler; table_of_local_scheduler (scheduler_index).scheduler := extended_address_space_Ptr (A_Addr).scheduler; table_of_local_scheduler (scheduler_index). address_space_name := A_Addr.name; scheduler_index := scheduler_index + 1; end if; end if; exit when is_last_element (My_Address_Spaces, iterator2); next_element (My_Address_Spaces, iterator2); end loop; end if; -- Step 3 : initialization of each processor -- the_cores := build_core_table (Result.entries (J).item); processor_Initialization (extended_Core_Unit_Ptr (the_cores.entries (0)).scheduler.all, Si, Result.entries (J).item.name, Tmp_Tasks (J), Tmp_Resources (J), Tmp_Buffers (J), Result.entries (J).data.result, With_Offsets, With_Precedencies, With_Resources, With_Task_Specific_Seed, Global_Seed_Value, Predictable_Global_Seed, Last_Time, Event_To_Generate); -- Step 4 : initialization of each core unit -- for core_id in 0 .. the_cores.nb_entries - 1 loop core_unit_Initialization ( extended_Core_Unit_Ptr (the_cores.entries (core_id)). scheduler.all, Si, Result.entries (J).item.name, Tmp_Tasks (J), Tmp_Resources (J), Tmp_Buffers (J), Result.entries (J).data.result, With_Offsets, With_Precedencies, With_Resources, With_Task_Specific_Seed, Global_Seed_Value, Predictable_Global_Seed, Last_Time, Event_To_Generate); end loop; -- Step 5 : initializations that are specific for each scheduler -- for core_id in 0 .. the_cores.nb_entries - 1 loop Specific_Scheduler_Initialization ( extended_Core_Unit_Ptr (the_cores.entries (core_id)). scheduler.all, Si, Result.entries (J).item.name, To_Unbounded_String (""), Tmp_Tasks (J), table_of_local_scheduler, Tmp_Resources (J), Tmp_Buffers (J), My_Messages, Result.entries (J).data.scheduling_msg); end loop; end if; end if; end loop; -------------------------------------------------------------- -- Now, we compute the scheduling of the overall architecture -------------------------------------------------------------- while (Last_Current_Time < Last_Time) loop Last_Current_Time := Natural'Last; for z in 0 .. Si.Number_Of_Tasks - 1 loop Si.Tcbs (z).already_run_at_current_time := False; end loop; for J in 0 .. Result.nb_entries - 1 loop if (Result.entries (J).data.error_msg = empty_string) then if (Current_Time (J) < Last_Time) then Put_Debug ( "Build_Multiprocessor_Scheduling : compute scheduling of time " & To_Unbounded_String (Natural'Image (Current_Time (J))), very_verbose); the_cores := build_core_table (Result.entries (J).item); for core_id in 0 .. the_cores.nb_entries - 1 loop -- Preemptive case : if a task has been previously --elected and if -- it has not ended its work => re-elect it ! -- must_perform_election := True; if (Get_Preemptive ( extended_Core_Unit_Ptr (the_cores.entries (core_id)). scheduler.all) = not_preemptive) then if ( extended_Core_Unit_Ptr (the_cores.entries ( core_id)).scheduler.previous_time_unit_was_busy) then Put_Line ("cpu was busy at previous time"); if Si.Tcbs ( extended_Core_Unit_Ptr (the_cores.entries ( core_id)).scheduler.Previously_Elected). Rest_Of_Capacity /= Si.Tcbs ( extended_Core_Unit_Ptr (the_cores.entries ( core_id)).scheduler.Previously_Elected).Tsk. capacity then Put_Line ("task is not ended"); Elected := extended_Core_Unit_Ptr (the_cores.entries ( core_id)).scheduler.Previously_Elected; No_Task := False; must_perform_election := False; end if; end if; end if; if must_perform_election then Put_Debug ("Call Do_Election ", very_verbose); Do_Election ( extended_Core_Unit_Ptr (the_cores.entries (core_id)). scheduler.all, Si, Result.entries (J).data.result, Result.entries (J).data.scheduling_msg, Current_Time (J), Result.entries (J).item.name, To_Unbounded_String (""), My_Dependencies, With_Offsets, With_Precedencies, With_Resources, Event_To_Generate, Elected, No_Task); end if; -- No task to schedule -- if not No_Task then Put_Debug( "Call Update_Task_Simulation_Properties_And_Produce_Events ", very_verbose); -- Assign the task to the current core unit and put it --in the already run state -- Si.Tcbs (Elected).assigned_core_unit := the_cores.entries (core_id).name; Si.Tcbs (Elected).already_run_at_current_time := True; -- Update task properties and produce events -- Update_Task_Simulation_Properties_And_Produce_Events ( extended_Core_Unit_Ptr (the_cores.entries (core_id)). scheduler.all, Result.entries (J).item.name, Si, My_Dependencies, Elected, Result.entries (J).data.result, Current_Time (J), Last_Time, With_Offsets, With_Precedencies, With_Resources, Event_To_Generate); end if; end loop; Current_Time (J) := Current_Time (J) + 1; Last_Current_Time := Natural'Min (Last_Current_Time, Current_Time (J)); end if; end if; end loop; end loop; end Build_Multiprocessor_Scheduling; procedure Display_Scheduling (Sched : in Scheduling_Table_Ptr) is Global_Sched : array (Scheduling_Table_Range) of Scheduling_Sequence_Ptr; Global_Sched_Index : array (Scheduling_Table_Range) of Time_Unit_Range := (others => 0); Global_Sched_Number : Scheduling_Table_Range := 0; Min_Time : Natural := 0; Current_Min_Time_Processor : Scheduling_Table_Range; begin New_Line; New_Line; Put_Line ("Event Table after scheduling : "); New_Line; Put_Line ("Event type/Task, buffer, message or resource name/Date"); New_Line; New_Line; -- how many processors scheduling should we run analysis ? -- for I in 0 .. Sched.nb_entries - 1 loop if (Sched.entries (I).data.error_msg = empty_string) then Global_Sched (Global_Sched_Number) := Sched.entries (I).data.result; Global_Sched_Number := Global_Sched_Number + 1; end if; end loop; -- Now, scan each time unit -- while Min_Time /= Natural'Last loop -- find the smallest time unit -- Min_Time := Natural'Last; for I in 0 .. Global_Sched_Number - 1 loop if Global_Sched_Index (I) < Global_Sched (I).nb_entries then if Global_Sched (I).entries (Global_Sched_Index (I)).item < Min_Time then Min_Time := Global_Sched (I).entries (Global_Sched_Index (I)).item; Current_Min_Time_Processor := I; end if; end if; end loop; if Min_Time /= Natural'Last then put (Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor))); Global_Sched_Index (Current_Min_Time_Processor) := Global_Sched_Index (Current_Min_Time_Processor) + 1; end if; end loop; New_Line; New_Line; end Display_Scheduling; procedure Run_An_Event_Analyzer (My_Tasks : in Tasks_Set; My_Processors : in Processors_Set; My_Address_Spaces : in Address_Spaces_Set; My_Resources : in Resources_Set; My_Buffers : in Buffers_Set; My_Messages : in Messages_Set; Sched : in Scheduling_Table_Ptr; An_Event_Analyzer : in Event_Analyzer_Ptr; Result : in out Unbounded_String) is Current : Generic_Statement_Ptr; Var, Var_Time, Var_Type, Var_Processor, Var_Message, Var_Resource, Var_Task, Var_Buffer : Variables_Range; Global_Sched : array (Scheduling_Table_Range) of Scheduling_Sequence_Ptr; Global_Sched_Index : array (Scheduling_Table_Range) of Time_Unit_Range := (others => 0); Global_Processor_Name : array (Scheduling_Table_Range) of Unbounded_String; Global_Sched_Number : Scheduling_Table_Range := 0; Min_Time : Natural := 0; Current_Min_Time_Processor : Scheduling_Table_Range; a_section : Computation_Section_Ptr; begin begin An_Event_Analyzer.String_Behavior := read_sequential_file (An_Event_Analyzer.Behavior_File_Name); exception when Ada.IO_Exceptions.Name_Error => Raise_Exception (Parametric_File_Error'Identity, To_String (Lb_File (Current_Language) & Lb_Colon & An_Event_Analyzer.Behavior_File_Name & Lb_Comma & Lb_Can_Not_Open_File (Current_Language)) & ", Name_Error"); when Ada.IO_Exceptions.Status_Error => Raise_Exception (Parametric_File_Error'Identity, To_String (Lb_File (Current_Language) & Lb_Colon & An_Event_Analyzer.Behavior_File_Name & Lb_Comma & Lb_Can_Not_Open_File (Current_Language)) & ", Status_Error"); when Ada.IO_Exceptions.Mode_Error => Raise_Exception (Parametric_File_Error'Identity, To_String (Lb_File (Current_Language) & Lb_Colon & An_Event_Analyzer.Behavior_File_Name & Lb_Comma & Lb_Can_Not_Open_File (Current_Language)) & ", Mode_Error"); when Ada.IO_Exceptions.Use_Error => Raise_Exception (Parametric_File_Error'Identity, To_String (Lb_File (Current_Language) & Lb_Colon & An_Event_Analyzer.Behavior_File_Name & Lb_Comma & Lb_Can_Not_Open_File (Current_Language)) & ", Use_Error"); when Ada.IO_Exceptions.Device_Error => Raise_Exception (Parametric_File_Error'Identity, To_String (Lb_File (Current_Language) & Lb_Colon & An_Event_Analyzer.Behavior_File_Name & Lb_Comma & Lb_Can_Not_Open_File (Current_Language)) & ", Device_Error"); when Ada.IO_Exceptions.End_Error => Raise_Exception (Parametric_File_Error'Identity, To_String (Lb_File (Current_Language) & Lb_Colon & An_Event_Analyzer.Behavior_File_Name & Lb_Comma & Lb_Can_Not_Open_File (Current_Language)) & ", End_Error"); when Ada.IO_Exceptions.Data_Error => Raise_Exception (Parametric_File_Error'Identity, To_String (Lb_File (Current_Language) & Lb_Colon & An_Event_Analyzer.Behavior_File_Name & Lb_Comma & Lb_Can_Not_Open_File (Current_Language)) & ", Data_Error"); when Ada.IO_Exceptions.Layout_Error => Raise_Exception (Parametric_File_Error'Identity, To_String (Lb_File (Current_Language) & Lb_Colon & An_Event_Analyzer.Behavior_File_Name & Lb_Comma & Lb_Can_Not_Open_File (Current_Language)) & ", Layout_Error"); when others => Raise_Exception (Parametric_File_Error'Identity, To_String (Lb_File (Current_Language) & Lb_Colon & An_Event_Analyzer.Behavior_File_Name & Lb_Comma & Lb_Can_Not_Open_File (Current_Language))); end; -- We should check the scheduler behavior syntax ... -- Open_Input (An_Event_Analyzer.String_Behavior); Parser.First_File (An_Event_Analyzer.Behavior_File_Name); Create_Parametric_Variables (Parser.Variables_Table, My_Tasks); Parser.Yyparse; -- Store syntax tree and compiling information -- begin a_section := Computation_Section_Ptr (Search_section (Parser.Root_Statement_Pointer, Sections.Start_Type)); An_Event_Analyzer.Root_Statement_Pointer (Sections.Start_Type) := a_section.first_statement; exception when others => An_Event_Analyzer.Root_Statement_Pointer (Sections.Start_Type) := null; end; begin a_section := Computation_Section_Ptr (Search_section (Parser.Root_Statement_Pointer, Sections.Gather_Event_Analyzer_Type)); An_Event_Analyzer.Root_Statement_Pointer ( Sections.Gather_Event_Analyzer_Type) := a_section.first_statement; exception when others => An_Event_Analyzer.Root_Statement_Pointer ( Sections.Gather_Event_Analyzer_Type) := null; end; begin a_section := Computation_Section_Ptr (Search_section (Parser.Root_Statement_Pointer, Sections.Display_Event_Analyzer_Type)); An_Event_Analyzer.Root_Statement_Pointer ( Sections.Display_Event_Analyzer_Type) := a_section.first_statement; exception when others => An_Event_Analyzer.Root_Statement_Pointer ( Sections.Display_Event_Analyzer_Type) := null; end; An_Event_Analyzer.Variables_Table := Parser.Variables_Table; An_Event_Analyzer.Sets_Table := Parser.Sets_Table; -- Initialize parametric variables which are constant -- Initialize_Parametric_Variables (An_Event_Analyzer.Variables_Table, My_Messages, My_Buffers, My_Resources, My_Tasks); -- "nb_processors" -- Var := Find_Variable (An_Event_Analyzer.Variables_Table, To_Unbounded_String ("nb_processors")); An_Event_Analyzer.Variables_Table.entries (Var).Simulation.Integer_Value := Integer (get_number_of_elements (My_Processors)); -- "nb_address_spaces" -- Var := Find_Variable (An_Event_Analyzer.Variables_Table, To_Unbounded_String ("nb_address_spaces")); An_Event_Analyzer.Variables_Table.entries (Var).Simulation.Integer_Value := Integer (get_number_of_elements (My_Address_Spaces)); -- Now : run "start" statements -- Current := An_Event_Analyzer.Root_Statement_Pointer (Sections.Start_Type); Dispatch (Current, Sections.Start_Type, To_Unbounded_String ("none"), An_Event_Analyzer.Variables_Table, Result); -- Now : run "event analyzer" statements -- Current := An_Event_Analyzer.Root_Statement_Pointer ( Sections.Gather_Event_Analyzer_Type); -- Find variables before running the simulation -- Var_Time := Find_Variable (An_Event_Analyzer.Variables_Table, To_Unbounded_String ("events.time")); Var_Type := Find_Variable (An_Event_Analyzer.Variables_Table, To_Unbounded_String ("events.type")); Var_Processor := Find_Variable (An_Event_Analyzer.Variables_Table, To_Unbounded_String ("events.processor_name")); Var_Message := Find_Variable (An_Event_Analyzer.Variables_Table, To_Unbounded_String ("events.message_name")); Var_Resource := Find_Variable (An_Event_Analyzer.Variables_Table, To_Unbounded_String ("events.resource_name")); Var_Task := Find_Variable (An_Event_Analyzer.Variables_Table, To_Unbounded_String ("events.task_name")); Var_Buffer := Find_Variable (An_Event_Analyzer.Variables_Table, To_Unbounded_String ("events.buffer_name")); -- how many processors scheduling should we run analysis ? -- for I in 0 .. Sched.nb_entries - 1 loop if (Sched.entries (I).data.error_msg = empty_string) then Global_Sched (Global_Sched_Number) := Sched.entries (I).data.result; Global_Processor_Name (Global_Sched_Number) := Sched.entries (I).item.name; Global_Sched_Number := Global_Sched_Number + 1; end if; end loop; -- Now, scan each time unit -- while Min_Time /= Natural'Last loop -- find the smallest time unit -- Min_Time := Natural'Last; for I in 0 .. Global_Sched_Number - 1 loop if Global_Sched_Index (I) < Global_Sched (I).nb_entries then if Global_Sched (I).entries (Global_Sched_Index (I)).item < Min_Time then Min_Time := Global_Sched (I).entries (Global_Sched_Index (I)).item; Current_Min_Time_Processor := I; end if; end if; end loop; if Min_Time /= Natural'Last then -- "events.time" -- An_Event_Analyzer.Variables_Table.entries (Var_Time).Simulation. Integer_Value := Integer ( Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).item); -- "events.type" -- An_Event_Analyzer.Variables_Table.entries (Var_Type).Simulation. String_Value := to_lower ( Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data.discriminant'Img); -- "events.processor_name" -- An_Event_Analyzer.Variables_Table.entries (Var_Processor). Simulation.String_Value := Global_Processor_Name (Current_Min_Time_Processor); -- "events.buffer_name" -- An_Event_Analyzer.Variables_Table.entries (Var_Buffer).Simulation. String_Value := empty_string; -- "events.resource_name" -- An_Event_Analyzer.Variables_Table.entries (Var_Resource). Simulation.String_Value := empty_string; -- "events.message_name" -- An_Event_Analyzer.Variables_Table.entries (Var_Message).Simulation. String_Value := empty_string; case Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data.discriminant is when Start_Of_Task_Capacity => An_Event_Analyzer.Variables_Table.entries (Var_Task).Simulation. String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. start_task.name; when End_Of_Task_Capacity => An_Event_Analyzer.Variables_Table.entries (Var_Task).Simulation. String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. end_task.name; when Write_To_Buffer => An_Event_Analyzer.Variables_Table.entries (Var_Task).Simulation. String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. write_task.name; An_Event_Analyzer.Variables_Table.entries (Var_Buffer). Simulation.String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. write_buffer.name; when Read_From_Buffer => An_Event_Analyzer.Variables_Table.entries (Var_Task).Simulation. String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. read_task.name; An_Event_Analyzer.Variables_Table.entries (Var_Buffer). Simulation.String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. read_buffer.name; when Running_Task => An_Event_Analyzer.Variables_Table.entries (Var_Task).Simulation. String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. running_task.name; when Context_Switch_Overhead => An_Event_Analyzer.Variables_Table.entries (Var_Task).Simulation. String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. switched_task.name; when Task_activation => An_Event_Analyzer.Variables_Table.entries (Var_Task).Simulation. String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. activation_task.name; when Allocate_Resource => An_Event_Analyzer.Variables_Table.entries (Var_Task).Simulation. String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. allocate_task.name; An_Event_Analyzer.Variables_Table.entries (Var_Resource). Simulation.String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. allocate_resource.name; when Release_Resource => An_Event_Analyzer.Variables_Table.entries (Var_Task).Simulation. String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. release_task.name; An_Event_Analyzer.Variables_Table.entries (Var_Resource). Simulation.String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. release_resource.name; when Wait_For_Resource => An_Event_Analyzer.Variables_Table.entries (Var_Task).Simulation. String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. wait_for_resource_task.name; An_Event_Analyzer.Variables_Table.entries (Var_Resource). Simulation.String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. wait_for_resource.name; when Send_Message => An_Event_Analyzer.Variables_Table.entries (Var_Task).Simulation. String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. send_task.name; An_Event_Analyzer.Variables_Table.entries (Var_Message). Simulation.String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. send_message.name; when Receive_Message => An_Event_Analyzer.Variables_Table.entries (Var_Task).Simulation. String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. receive_task.name; An_Event_Analyzer.Variables_Table.entries (Var_Message). Simulation.String_Value := Global_Sched (Current_Min_Time_Processor).entries ( Global_Sched_Index (Current_Min_Time_Processor)).data. receive_message.name; when wait_for_memory => null; end case; -- Do analysis on the current time : run "event_analyzer" --section/statements -- Dispatch (Current, Sections.Gather_Event_Analyzer_Type, To_Unbounded_String ("none"), An_Event_Analyzer.Variables_Table, Result); Global_Sched_Index (Current_Min_Time_Processor) := Global_Sched_Index (Current_Min_Time_Processor) + 1; end if; end loop; -- The end of the line : run "display_event" section/statements -- Current := An_Event_Analyzer.Root_Statement_Pointer ( Sections.Display_Event_Analyzer_Type); Dispatch (Current, Sections.Display_Event_Analyzer_Type, To_Unbounded_String ("none"), An_Event_Analyzer.Variables_Table, Result); end Run_An_Event_Analyzer; procedure Read_From_Xml_File (Sched : in out Scheduling_Table_Ptr; Sys : in System; File_Name : in String) is begin Read_From_Xml_File (Sched, Sys, To_Unbounded_String (File_Name)); end Read_From_Xml_File; procedure Read_From_Xml_File (Sched : in out Scheduling_Table_Ptr; Sys : in System; File_Name : in Unbounded_String) is Read : File_Input; My_Reader : Xml_Event_Table_Parser; Name_Start : Natural; S : constant String := To_String (File_Name); begin -- Base file name should be used as the public Id -- Name_Start := S'Last; while Name_Start >= S'First and then S (Name_Start) /= '/' loop Name_Start := Name_Start - 1; end loop; Set_Public_Id (Read, S (Name_Start + 1 .. S'Last)); Set_System_Id (Read, S); Open (S, Read); -- xmlns:* attributes will be reported in Start_Element -- Set_Feature (My_Reader, Namespace_Prefixes_Feature, False); Set_Feature (My_Reader, Validation_Feature, True); Set_Scheduled_System (My_Reader, Sys); Parse (My_Reader, Read); Free (Sched); Sched := Get_Parsed_Event_Table (My_Reader); Close (Read); exception when XML_Fatal_Error => Close (Read); raise Xml_Read_Error; end Read_From_Xml_File; procedure Write_To_Xml_File (Sched : in Scheduling_Table_Ptr; Sys : in System; File_Name : in String) is begin Write_To_Xml_File (Sched, Sys, To_Unbounded_String (File_Name)); end Write_To_Xml_File; procedure Write_To_Xml_File (Sched : in Scheduling_Table_Ptr; Sys : in System; File_Name : in Unbounded_String) is Into : File_Type; An_Event : Time_Unit_Event_Ptr; My_Scheduler : Generic_Scheduler_Ptr; A_Processor : Generic_Processor_Ptr; begin -- Open file and Write DTD/XML Header -- Create (Into, Mode => Out_File, Name => To_String (File_Name)); Put_Line (Into, " "); Put_Line (Into, ""); Put_Line (Into, " "); end loop; Put_Line (Into, " "); Put_Line (Into, " "); Put (Into, " "); Put_Line (Into, "] > "); New_Line (Into, 2); Put_Line (Into, ""); -- Export event table for each processor -- for I in 0 .. Sched.nb_entries - 1 loop if (Sched.entries (I).data.error_msg = empty_string) then Put_Line (Into, " "); Put_Line (Into, " " & To_String (Sched.entries (I).item.name) & " "); A_Processor := Search_Processor (Sys.Processors, Sched.entries (I).item.name); for J in 0 .. Sched.entries (I).data.result.nb_entries - 1 loop -- The event to treat -- An_Event := Sched.entries (I).data.result.entries (J).data; -- find the scheduler that had generated this event -- Indeed, some scheduler may redefine event XML export --procedure -- if A_Processor.processor_type = Monocore_type then My_Scheduler := extended_Core_Unit_Ptr ( Mono_Core_Processor_Ptr (A_Processor).core).scheduler; else if An_Event.discriminant = Running_Task then for i in 0 .. Multi_Cores_Processor_Ptr (A_Processor).cores. nb_entries - 1 loop if Multi_Cores_Processor_Ptr (A_Processor).cores. entries (i).name = An_Event.running_core then My_Scheduler := extended_Core_Unit_Ptr ( Multi_Cores_Processor_Ptr (A_Processor).cores. entries (i)).scheduler; end if; end loop; else My_Scheduler := extended_Core_Unit_Ptr ( Multi_Cores_Processor_Ptr (A_Processor).cores.entries (0 )).scheduler; end if; end if; Put (Into, " <" & to_lower (An_Event.discriminant'Img) & "> "); Put (Into, " " & Sched.entries (I).data.result.entries (J).item'Img & " "); case An_Event.discriminant is when wait_for_memory => null; when Start_Of_Task_Capacity => Put (Into, To_String (Export_Xml_Event_Start_Of_Task_Capacity (My_Scheduler.all, An_Event))); when End_Of_Task_Capacity => Put (Into, To_String (Export_Xml_Event_End_Of_Task_Capacity (My_Scheduler.all, An_Event))); when Write_To_Buffer => Put (Into, To_String (Export_Xml_Event_Write_To_Buffer (My_Scheduler.all, An_Event))); when Read_From_Buffer => Put (Into, To_String (Export_Xml_Event_Read_From_Buffer (My_Scheduler.all, An_Event))); when Context_Switch_Overhead => Put (Into, To_String (Export_Xml_Event_context_switch_overhead (My_Scheduler.all, An_Event))); when Running_Task => Put (Into, To_String (Export_Xml_Event_Running_Task (My_Scheduler.all, An_Event))); when Task_activation => Put (Into, To_String (Export_Xml_Event_Task_Activation (My_Scheduler.all, An_Event))); when Send_Message => Put (Into, To_String (Export_Xml_Event_Send_Message (My_Scheduler.all, An_Event))); when Receive_Message => Put (Into, To_String (Export_Xml_Event_Receive_Message (My_Scheduler.all, An_Event))); when Allocate_Resource => Put (Into, To_String (Export_Xml_Event_Allocate_Resource (My_Scheduler.all, An_Event))); when Release_Resource => Put (Into, To_String (Export_Xml_Event_Release_Resource (My_Scheduler.all, An_Event))); when Wait_For_Resource => Put (Into, To_String (Export_Xml_Event_Wait_For_Resource (My_Scheduler.all, An_Event))); end case; Put (Into, " "); New_Line (Into); end loop; Put_Line (Into, " "); New_Line (Into); end if; end loop; Put_Line (Into, ""); New_Line (Into); New_Line (Into); Close (Into); end Write_To_Xml_File; procedure Partition_Small_Task (Src_Processors : in Processors_Set; Src_Tasks : in Tasks_Set; Msg : in out Unbounded_String; Result_Tasks : in out Tasks_Set; Processor_Result : out Processors_Iterator) is A_Task_Result : Periodic_Task_Ptr; My_Task_Iterator_Result : Tasks_Iterator; A_Processor : Generic_Processor_Ptr; My_Processor_Iterator : Processors_Iterator; Processor_Util, Beta : Float := 0.0; S_Cur : Float := 1.0; First_Run : Boolean := True; begin Validate_Multiprocessor_Tasks (Src_Processors, Src_Tasks); duplicate (Src_Tasks, Result_Tasks); sort (Result_Tasks, Increasing_Si'Access); reset_iterator (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); reset_iterator (Src_Processors, My_Processor_Iterator); current_element (Src_Processors, A_Processor, My_Processor_Iterator); loop if First_Run = False then if is_last_element (Src_Processors, My_Processor_Iterator) then duplicate (Src_Tasks, Result_Tasks); raise No_Such_Processors; end if; next_element (Src_Processors, My_Processor_Iterator); current_element (Src_Processors, A_Processor, My_Processor_Iterator); end if; First_Run := False; if Float (A_Task_Result.capacity) / Float (A_Task_Result.period) > 1.0 then duplicate (Src_Tasks, Result_Tasks); raise No_Such_Processors; end if; A_Task_Result.cpu_name := A_Processor.name; Processor_Util := Float (A_Task_Result.capacity) / Float (A_Task_Result.period); S_Cur := Float (Log (Float (A_Task_Result.period), 2.0)) - Float'Floor (Float (Log (Float (A_Task_Result.period), 2.0))); Beta := 0.0; exit when is_last_element (Result_Tasks, My_Task_Iterator_Result); loop if is_last_element (Result_Tasks, My_Task_Iterator_Result) then First_Run := True; exit; end if; next_element (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); Beta := (Float (Log (Float (A_Task_Result.period), 2.0)) - Float'Floor (Float (Log (Float (A_Task_Result.period), 2.0)))) - S_Cur; Processor_Util := Processor_Util + Float (A_Task_Result.capacity) / Float (A_Task_Result.period); if (Processor_Util <= Float'Max (Float (Log (2.0, e)), 1.0 - Beta * Float (Log (2.0, e)))) then A_Task_Result.cpu_name := A_Processor.name; else exit; end if; end loop; end loop; Processor_Result := My_Processor_Iterator; sort (Result_Tasks, Increasing_Name'Access); end Partition_Small_Task; procedure Partition_Small_Task (Src_Processors : in Processors_Set; Src_Tasks : in Tasks_Set; Msg : in out Unbounded_String; Result_Tasks : in out Tasks_Set) is Tmp : Processors_Iterator; begin Msg := To_Unbounded_String (" (") & Lb_See (Current_Language) & To_Unbounded_String ("[9], [10]) "); Partition_Small_Task (Src_Processors, Src_Tasks, Msg, Result_Tasks, Tmp); end Partition_Small_Task; procedure Partition_Small_Task (Src_Processors : in Processors_Set; Result_Tasks : in out Tasks_Set; Processor_Result : out Processors_Iterator) is Src_Tasks : Tasks_Set; Msg : Unbounded_String; begin duplicate (Result_Tasks, Src_Tasks); Partition_Small_Task (Src_Processors, Src_Tasks, Msg, Result_Tasks, Processor_Result); end Partition_Small_Task; procedure Rm_General_Tasks (Src_Processors : in Processors_Set; Result_Tasks : in out Tasks_Set) is A_Task_Result : Periodic_Task_Ptr; A_Task_Tmp : Periodic_Task_Ptr; A_Task_Iterator : Tasks_Iterator; My_Task_Iterator_Result : Tasks_Iterator; Tmp_Iterator : Tasks_Iterator; A_Processor : Generic_Processor_Ptr; My_Processor_Iterator : Processors_Iterator; Src_Tasks : Tasks_Set; Num_Of_Tasks : Integer := 0; Task_Utilization, Total_Utilization : Float := 0.0; Goto_First_Loop : Boolean := False; begin duplicate (Result_Tasks, Src_Tasks); reset_iterator (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); reset_iterator (Src_Processors, My_Processor_Iterator); current_element (Src_Processors, A_Processor, My_Processor_Iterator); sort (Result_Tasks, Increasing_Period'Access); -- Zero processor locations -- loop A_Task_Result.cpu_name := To_Unbounded_String (""); exit when is_last_element (Result_Tasks, My_Task_Iterator_Result); next_element (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); end loop; reset_iterator (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); loop loop if Goto_First_Loop then Goto_First_Loop := False; exit; end if; -- Fetch information for condition-IP -- Tmp_Iterator := My_Task_Iterator_Result; reset_iterator (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); Num_Of_Tasks := 0; Total_Utilization := 0.0; loop if A_Task_Result.cpu_name = A_Processor.name then Num_Of_Tasks := Num_Of_Tasks + 1; Total_Utilization := Total_Utilization + Float (A_Task_Result.capacity) / Float (A_Task_Result.period); end if; exit when is_last_element (Result_Tasks, My_Task_Iterator_Result); next_element (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); end loop; My_Task_Iterator_Result := Tmp_Iterator; current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); Task_Utilization := Float (A_Task_Result.capacity) / Float (A_Task_Result.period); if Task_Utilization <= 2.0 * (1.0 / ((1.0 + Total_Utilization / Float (Num_Of_Tasks))) ** Num_Of_Tasks) - 1.0 then if Total_Utilization = 0.0 then A_Task_Result.cpu_name := A_Processor.name; exit; end if; reset_iterator (Result_Tasks, A_Task_Iterator); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Tmp), A_Task_Iterator); loop if A_Task_Tmp.cpu_name = A_Processor.name and A_Task_Tmp /= A_Task_Result then if A_Task_Result.period < A_Task_Tmp.period and (Integer (Float'Floor (Float (A_Task_Tmp.period) / Float (A_Task_Result.period))) * (A_Task_Tmp.period - A_Task_Result.capacity) >= A_Task_Tmp.capacity or A_Task_Tmp.period >= Integer (Float'Ceiling (Float (A_Task_Tmp.period) / Float (A_Task_Result.period))) * A_Task_Result.capacity + A_Task_Tmp.capacity) then A_Task_Result.cpu_name := A_Processor.name; reset_iterator (Src_Processors, My_Processor_Iterator); Goto_First_Loop := True; exit; else if A_Task_Result.period >= A_Task_Tmp.period and (((Integer (Float'Floor (Float (A_Task_Result.period) / Float (A_Task_Tmp.period))) * (A_Task_Result.period - A_Task_Tmp.capacity)) >= A_Task_Result.capacity) or (A_Task_Result.period >= (Integer (Float'Ceiling (Float (A_Task_Result.period) / Float (A_Task_Tmp.period))) * A_Task_Tmp.capacity + A_Task_Result.capacity))) then A_Task_Result.cpu_name := A_Processor.name; reset_iterator (Src_Processors, My_Processor_Iterator); Goto_First_Loop := True; exit; else if is_last_element (Src_Processors, My_Processor_Iterator) then duplicate (Src_Tasks, Result_Tasks); raise No_Such_Processors; end if; next_element (Src_Processors, My_Processor_Iterator); current_element (Src_Processors, A_Processor, My_Processor_Iterator); exit; end if; end if; end if; exit when is_last_element (Result_Tasks, A_Task_Iterator); next_element (Result_Tasks, A_Task_Iterator); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Tmp), A_Task_Iterator); end loop; else if is_last_element (Src_Processors, My_Processor_Iterator) then duplicate (Src_Tasks, Result_Tasks); raise No_Such_Processors; end if; next_element (Src_Processors, My_Processor_Iterator); current_element (Src_Processors, A_Processor, My_Processor_Iterator); end if; end loop; exit when is_last_element (Result_Tasks, My_Task_Iterator_Result); next_element (Result_Tasks, My_Task_Iterator_Result); end loop; end Rm_General_Tasks; procedure Partition_General_Task (Src_Processors : in Processors_Set; Src_Tasks : in Tasks_Set; Msg : in out Unbounded_String; Result_Tasks : in out Tasks_Set) is A_Task_Result : Periodic_Task_Ptr; My_Task_Iterator_Result : Tasks_Iterator; My_Processor_Iterator : Processors_Iterator; A_Processor : Generic_Processor_Ptr; Rmst_Tasks : Tasks_Set; Rmgt_Tasks : Tasks_Set; Tmp_Cpus : Processors_Set; Rmst_Index, Rmgt, Num_Of_Tasks : Integer := 0; begin Validate_Multiprocessor_Tasks (Src_Processors, Src_Tasks); Msg := To_Unbounded_String (" (") & Lb_See (Current_Language) & To_Unbounded_String ("[9], [10]) "); duplicate (Src_Tasks, Result_Tasks); sort (Result_Tasks, Increasing_Utilization'Access); -- Scan for max Alfa to make division between RMST and RMGT tasks -- reset_iterator (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); loop if Float (A_Task_Result.capacity) / Float (A_Task_Result.period) > 1.0 / 3.0 then exit; else Rmgt := Rmgt + 1; end if; exit when is_last_element (Result_Tasks, My_Task_Iterator_Result); next_element (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); end loop; -- Make bin-packing for RMST and RMGT -- reset_iterator (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); loop exit when Rmst_Index = Rmgt; add (Rmst_Tasks, Generic_Task_Ptr (A_Task_Result)); Rmst_Index := Rmst_Index + 1; next_element (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); end loop; Num_Of_Tasks := Integer (get_number_of_elements (Result_Tasks)); if Rmgt /= Num_Of_Tasks then loop current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); add (Rmgt_Tasks, Generic_Task_Ptr (A_Task_Result)); exit when is_last_element (Result_Tasks, My_Task_Iterator_Result); next_element (Result_Tasks, My_Task_Iterator_Result); end loop; end if; -- Call RMST and RMGT functions respectively -- if (is_empty (Rmst_Tasks) = False) then Partition_Small_Task (Src_Processors, Rmst_Tasks, My_Processor_Iterator); end if; if False = is_last_element (Src_Processors, My_Processor_Iterator) and is_empty (Rmgt_Tasks) = False then -- Make processor set for RMGT -- next_element (Src_Processors, My_Processor_Iterator); current_element (Src_Processors, A_Processor, My_Processor_Iterator); loop add (Tmp_Cpus, A_Processor); exit when is_last_element (Src_Processors, My_Processor_Iterator); next_element (Src_Processors, My_Processor_Iterator); current_element (Src_Processors, A_Processor, My_Processor_Iterator); end loop; Rm_General_Tasks (Tmp_Cpus, Rmgt_Tasks); else if is_last_element (Src_Processors, My_Processor_Iterator) and is_empty (Rmgt_Tasks) = False then duplicate (Src_Tasks, Result_Tasks); raise No_Such_Processors; end if; end if; -- Put results of two functions to returning task set -- if not is_empty (Rmst_Tasks) then duplicate (Rmst_Tasks, Result_Tasks); end if; if not is_empty (Rmgt_Tasks) then reset_iterator (Rmgt_Tasks, My_Task_Iterator_Result); current_element (Rmgt_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); loop add (Result_Tasks, Generic_Task_Ptr (A_Task_Result)); exit when is_last_element (Rmgt_Tasks, My_Task_Iterator_Result); next_element (Rmgt_Tasks, My_Task_Iterator_Result); current_element (Rmgt_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); end loop; end if; sort (Result_Tasks, Increasing_Name'Access); end Partition_General_Task; procedure Partition_Next_Fit (Src_Processors : in Processors_Set; Src_Tasks : in Tasks_Set; Msg : in out Unbounded_String; Result_Tasks : in out Tasks_Set) is A_Task_Result : Periodic_Task_Ptr; My_Task_Iterator_Result : Tasks_Iterator; A_Processor : Generic_Processor_Ptr; My_Processor_Iterator : Processors_Iterator; M : Integer := 2; Total_Utilization : Float := 0.0; Condition_Ip : Boolean := False; begin Validate_Multiprocessor_Tasks (Src_Processors, Src_Tasks); Msg := To_Unbounded_String (" (") & Lb_See (Current_Language) & To_Unbounded_String ("[9], [10]) "); duplicate (Src_Tasks, Result_Tasks); sort (Result_Tasks, Increasing_Period'Access); reset_iterator (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); reset_iterator (Src_Processors, My_Processor_Iterator); current_element (Src_Processors, A_Processor, My_Processor_Iterator); loop if Float (A_Task_Result.capacity) / Float (A_Task_Result.period) <= 1.0 then A_Task_Result.cpu_name := A_Processor.name; else duplicate (Src_Tasks, Result_Tasks); raise No_Such_Processors; end if; exit when is_last_element (Result_Tasks, My_Task_Iterator_Result); loop exit when is_last_element (Result_Tasks, My_Task_Iterator_Result); Total_Utilization := Total_Utilization + Float (A_Task_Result.capacity) / Float (A_Task_Result.period); next_element (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); if Float (A_Task_Result.capacity) / Float (A_Task_Result.period) <= 2.0 * (1.0 / (1.0 + Total_Utilization / Float ((M - 1))) ** (M - 1)) - 1.0 and Total_Utilization <= Float (M - 1) * (2.0 ** (1.0 / Float (M - 1)) - 1.0) then Condition_Ip := True; else Condition_Ip := False; end if; if Condition_Ip then A_Task_Result.cpu_name := A_Processor.name; M := M + 1; else if is_last_element (Src_Processors, My_Processor_Iterator) then duplicate (Src_Tasks, Result_Tasks); raise No_Such_Processors; end if; next_element (Src_Processors, My_Processor_Iterator); current_element (Src_Processors, A_Processor, My_Processor_Iterator); Total_Utilization := 0.0; M := 2; exit; end if; end loop; end loop; sort (Result_Tasks, Increasing_Name'Access); end Partition_Next_Fit; procedure Partition_First_Fit (Src_Processors : in Processors_Set; Src_Tasks : in Tasks_Set; Msg : in out Unbounded_String; Result_Tasks : in out Tasks_Set) is A_Task_Result : Periodic_Task_Ptr; My_Task_Iterator_Result : Tasks_Iterator; Temp_Task_Iterator : Tasks_Iterator; A_Processor : Generic_Processor_Ptr; My_Processor_Iterator : Processors_Iterator; Num_Of_Tasks : Integer := 0; Task_Utilization, Total_Utilization : Float := 0.0; begin Validate_Multiprocessor_Tasks (Src_Processors, Src_Tasks); Msg := To_Unbounded_String (" (") & Lb_See (Current_Language) & To_Unbounded_String ("[9], [10]) "); duplicate (Src_Tasks, Result_Tasks); sort (Result_Tasks, Increasing_Period'Access); reset_iterator (Result_Tasks, My_Task_Iterator_Result); Temp_Task_Iterator := My_Task_Iterator_Result; current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); reset_iterator (Src_Processors, My_Processor_Iterator); current_element (Src_Processors, A_Processor, My_Processor_Iterator); -- Zero processor locations -- loop A_Task_Result.cpu_name := To_Unbounded_String (""); exit when is_last_element (Result_Tasks, My_Task_Iterator_Result); next_element (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); end loop; reset_iterator (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); loop loop -- Fetch information for condition-IP -- reset_iterator (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); Num_Of_Tasks := 0; Total_Utilization := 0.0; loop if A_Task_Result.cpu_name = A_Processor.name then Num_Of_Tasks := Num_Of_Tasks + 1; Total_Utilization := Total_Utilization + Float (A_Task_Result.capacity) / Float (A_Task_Result.period); end if; exit when is_last_element (Result_Tasks, My_Task_Iterator_Result); next_element (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); end loop; My_Task_Iterator_Result := Temp_Task_Iterator; current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); Task_Utilization := Float (A_Task_Result.capacity) / Float (A_Task_Result.period); if (Task_Utilization <= 2.0 * (1.0 / (1.0 + Total_Utilization / Float (Num_Of_Tasks)) ** Num_Of_Tasks) - 1.0) then A_Task_Result.cpu_name := A_Processor.name; reset_iterator (Src_Processors, My_Processor_Iterator); current_element (Src_Processors, A_Processor, My_Processor_Iterator); exit; else if is_last_element (Src_Processors, My_Processor_Iterator) then duplicate (Src_Tasks, Result_Tasks); raise No_Such_Processors; end if; next_element (Src_Processors, My_Processor_Iterator); current_element (Src_Processors, A_Processor, My_Processor_Iterator); end if; end loop; exit when is_last_element (Result_Tasks, My_Task_Iterator_Result); next_element (Result_Tasks, My_Task_Iterator_Result); Temp_Task_Iterator := My_Task_Iterator_Result; end loop; sort (Result_Tasks, Increasing_Name'Access); end Partition_First_Fit; procedure Partition_Best_Fit (Src_Processors : in Processors_Set; Src_Tasks : in Tasks_Set; Msg : in out Unbounded_String; Result_Tasks : in out Tasks_Set) is A_Task_Result : Periodic_Task_Ptr; My_Task_Iterator_Result : Tasks_Iterator; A_Processor : Generic_Processor_Ptr; My_Processor_Iterator : Processors_Iterator; Temp_Task_Iterator : Tasks_Iterator; Best_Cpu : Processors_Iterator; M : Integer := 1; Best_Fit_Value : Float := 2.0; Best_Fit_Tmp_Value, Tot_Util : Float; First_Task : Boolean := True; Assignable : Boolean; begin Validate_Multiprocessor_Tasks (Src_Processors, Src_Tasks); Msg := To_Unbounded_String (" (") & Lb_See (Current_Language) & To_Unbounded_String ("[9], [10]) "); duplicate (Src_Tasks, Result_Tasks); sort (Result_Tasks, Increasing_Period'Access); reset_iterator (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); -- Zero processor locations -- loop A_Task_Result.cpu_name := To_Unbounded_String (""); exit when is_last_element (Result_Tasks, My_Task_Iterator_Result); next_element (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); end loop; reset_iterator (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); loop reset_iterator (Src_Processors, My_Processor_Iterator); current_element (Src_Processors, A_Processor, My_Processor_Iterator); -- Loop scans best processor for task to be placed -- loop Temp_Task_Iterator := My_Task_Iterator_Result; -- get CPU data -- reset_iterator (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); M := 1; Tot_Util := 0.0; loop if A_Task_Result.cpu_name = A_Processor.name then M := M + 1; Tot_Util := Tot_Util + Float (A_Task_Result.capacity) / Float (A_Task_Result.period); end if; exit when is_last_element (Result_Tasks, My_Task_Iterator_Result); next_element (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); end loop; My_Task_Iterator_Result := Temp_Task_Iterator; current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); -- test for condition IP -- if First_Task then if Float (A_Task_Result.capacity) / Float (A_Task_Result.period) <= 1.0 then reset_iterator (Src_Processors, Best_Cpu); My_Processor_Iterator := Best_Cpu; First_Task := False; Assignable := True; exit; else Assignable := False; exit; end if; else if Float (A_Task_Result.capacity) / Float (A_Task_Result.period) <= 2.0 * (1.0 / (1.0 + Tot_Util / Float ((M - 1))) ** (M - 1)) - 1.0 then -- Tricky Condition IP testing because mathematics function -- doesn't seem to understand handle -- zero number very well in following check (M := 0 -- happens when processor is empty) -- if M > 1 then if Tot_Util <= Float (M - 1) * (2.0 ** Float (1.0 / Float (M - 1)) - 1.0) then Best_Fit_Tmp_Value := 2.0 * (1.0 / ((1.0 + Tot_Util / Float (M - 1)) ** (M - 1))) - 1.0; if Best_Fit_Tmp_Value < Best_Fit_Value then Best_Fit_Value := Best_Fit_Tmp_Value; Best_Cpu := My_Processor_Iterator; Assignable := True; end if; end if; else Best_Fit_Tmp_Value := 2.0 * (1.0 / (1.0 + Tot_Util / Float (M - 1) ** (M - 1))) - 1.0; if Best_Fit_Tmp_Value < Best_Fit_Value then Best_Fit_Value := Best_Fit_Tmp_Value; Best_Cpu := My_Processor_Iterator; Assignable := True; end if; end if; -- End of tricky testing -- end if; end if; exit when is_last_element (Src_Processors, My_Processor_Iterator); next_element (Src_Processors, My_Processor_Iterator); current_element (Src_Processors, A_Processor, My_Processor_Iterator); end loop; if Assignable then -- save task to best CPU -- current_element (Src_Processors, A_Processor, Best_Cpu); A_Task_Result.cpu_name := A_Processor.name; Assignable := False; Best_Fit_Value := 2.0; else duplicate (Src_Tasks, Result_Tasks); raise No_Such_Processors; end if; exit when is_last_element (Result_Tasks, My_Task_Iterator_Result); next_element (Result_Tasks, My_Task_Iterator_Result); current_element (Result_Tasks, Generic_Task_Ptr (A_Task_Result), My_Task_Iterator_Result); end loop; sort (Result_Tasks, Increasing_Name'Access); end Partition_Best_Fit; procedure Validate_Multiprocessor_Tasks (Src_Processors : in Processors_Set; Src_Tasks : in Tasks_Set) is A_Processor : Generic_Processor_Ptr; My_Processor_Iterator : Processors_Iterator; begin -- check if tasks are periodic -- reset_iterator (Src_Processors, My_Processor_Iterator); loop current_element (Src_Processors, A_Processor, My_Processor_Iterator); Periodic_Control (Src_Tasks, A_Processor.name); exit when True = is_last_element (Src_Processors, My_Processor_Iterator); next_element (Src_Processors, My_Processor_Iterator); end loop; -- check if processors are rate-monotonic and non pre-emptive -- reset_iterator (Src_Processors, My_Processor_Iterator); loop current_element (Src_Processors, A_Processor, My_Processor_Iterator); if Get_Name ( extended_Core_Unit_Ptr ( Mono_Core_Processor_Ptr (A_Processor).core).scheduler.all) /= Rate_Monotonic_Protocol then raise Invalid_Scheduler_Multiprocessors; end if; if Get_Preemptive ( extended_Core_Unit_Ptr ( Mono_Core_Processor_Ptr (A_Processor).core).scheduler.all) = not_preemptive then raise Invalid_Scheduler_Multiprocessors; end if; exit when is_last_element (Src_Processors, My_Processor_Iterator); next_element (Src_Processors, My_Processor_Iterator); end loop; end Validate_Multiprocessor_Tasks; end Multiprocessor_Services;