------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Cheddar is a GNU GPL real-time scheduling analysis tool.
-- This program provides services to automatically check schedulability and
-- other performance criteria of real-time architecture models.
--
-- Copyright (C) 2002-2020, Frank Singhoff, Alain Plantec, Jerome Legrand,
-- Hai Nam Tran, Stephane Rubini
--
-- The Cheddar project was started in 2002 by
-- Frank Singhoff, Lab-STICC UMR 6285, Université de Bretagne Occidentale
--
-- Cheddar has been published in the "Agence de Protection des Programmes/France" in 2008.
-- Since 2008, Ellidiss technologies also contributes to the development of
-- Cheddar and provides industrial support.
--
-- The full list of contributors and sponsors can be found in AUTHORS.txt and SPONSORS.txt
--
-- 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$
-- $Date$
-- $Author: singhoff $
------------------------------------------------------------------------------
------------------------------------------------------------------------------
with Ada.Tags; use Ada.Tags;
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 processor_interface; use processor_interface;
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;
use scheduler.schedulers_table_package;
with scheduler_builder; use scheduler_builder;
with scheduler.user_defined; use scheduler.user_defined;
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 Ada.Text_IO.Text_Streams; use Ada.Text_IO.Text_Streams;
with parser; use parser;
with sections; use sections;
with section_set; use section_set;
with address_spaces; use address_spaces;
with debug; use debug;
with scheduler.hierarchical.offline; use scheduler.hierarchical.offline;
with event_analyzers.extended; use event_analyzers.extended;
with core_units; use core_units;
use core_units.core_units_table_package;
with buffer_set; use buffer_set;
use buffer_set.generic_buffer_set;
with resource_set; use resource_set;
use resource_set.generic_resource_set;
with battery_set; use battery_set;
with DOM.Core.Documents;
use DOM.Core, DOM.Core.Documents;
with DOM.Core; use DOM.Core;
with DOM.Core.Nodes; use DOM.Core.Nodes;
with DOM.Readers; use DOM.Readers;
with GNAT.Command_Line; use GNAT.Command_Line;
with GNAT.Expect; use GNAT.Expect;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Input_Sources.File; use Input_Sources.File;
with Input_Sources.Http; use Input_Sources.Http;
with Input_Sources; use Input_Sources;
with Sax.Readers; use Sax.Readers;
with Sax.Symbols;
with Sax.Utils; use Sax.Utils;
with Sax.Encodings; use Sax.Encodings;
with Unicode.CES; use Unicode.CES;
with Unicode.Encodings; use Unicode.Encodings;
with Ada.Direct_IO;
with primitive_write_xml; use primitive_write_xml;
with primitive_xml_strings; use primitive_xml_strings;
with scheduling_anomalies_services; use scheduling_anomalies_services;
with voltage_scaling; use voltage_scaling;
package body multiprocessor_services is
-------------------------------------
-- Internal data of the simulator
-------------------------------------
-- 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;
-- Tables of scheduler instances that are used to compute the
-- scheduling
--
table_of_address_space_scheduler : array
(scheduling_table_range) of scheduler_table;
table_of_core_scheduler : array (scheduling_table_range) of scheduler_table;
-- Various pointers and iterators
--
a_address_space_scheduler : address_space_scheduler_ptr;
a_core_scheduler : core_scheduler_ptr;
iterator1 : processors_iterator;
iterator2 : address_spaces_iterator;
iterator3 : core_units_iterator;
a_addr : address_space_ptr;
a_processor : generic_processor_ptr;
-- Variables to drive 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;
-- Variable to store an event table (to be used by a scheduler)
--
partition_sched : scheduling_table_ptr;
-- Variable to store .sc file of .XML file content
--
file_content : Unbounded_String;
-----------------------------------------------------
-- The two following subprograms are the main entry
-- point of the cheddar scheduling simulator
-----------------------------------------------------
procedure initialize_multiprocessor_scheduling
(sys : in system;
result : in out scheduling_table_ptr;
event_to_generate : in time_unit_event_type_boolean_table;
last_time : in Natural;
options : in scheduling_option)
is
begin
put_debug
("initialize_Multiprocessor_Scheduling : initialize internal simulator variables ",
very_verbose);
for i in scheduling_table_range loop
current_time (i) := 0;
reset (tmp_buffers (i));
reset (tmp_tasks (i));
reset (tmp_resources (i));
initialize (table_of_address_space_scheduler (i));
initialize (table_of_core_scheduler (i));
end loop;
initialize (si);
last_current_time := 0;
elected := tasks_range'first;
no_task := True;
must_perform_election := True;
-------------------------------------------------------------------------
-- Before initialization, check if the tasks can be
-- scheduled with the selected scheduler
--
-- If so, we prepar the scheduling result (i.e. table of
-- scheduling_sequence, with one scheduling_sequence per processor)
-- otherwise, a error message is prepared instead
---------------------------------------------------------
put_debug
("initialize_Multiprocessor_Scheduling : check scheduler compliancy of tasks",
very_verbose);
reset_iterator (sys.processors, iterator1);
loop
current_element (sys.processors, a_processor, iterator1);
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
(sys.tasks,
a_processor.name) /=
0)
then
-- Build core scheduler table
--
initialize (table_of_core_scheduler (result.nb_entries));
a_processor :=
search_processor (sys.processors, a_processor.name);
if a_processor.processor_type = monocore_type then
a_core_scheduler := new core_scheduler;
a_core_scheduler.scheduler :=
build_a_scheduler
(mono_core_processor_ptr (a_processor).core,
a_processor);
a_core_scheduler.entity :=
mono_core_processor_ptr (a_processor).core;
add
(table_of_core_scheduler (result.nb_entries),
entity_scheduler_ptr (a_core_scheduler));
else
for k in
0 ..
multi_cores_processor_ptr (a_processor).cores
.nb_entries -
1
loop
a_core_scheduler := new core_scheduler;
a_core_scheduler.scheduler :=
build_a_scheduler
(multi_cores_processor_ptr (a_processor).cores.entries
(k),
a_processor);
a_core_scheduler.entity :=
multi_cores_processor_ptr (a_processor).cores.entries
(k);
add
(table_of_core_scheduler (result.nb_entries),
entity_scheduler_ptr (a_core_scheduler));
end loop;
end if;
-- Check that the scheduler can be run on the architecture model
--
for core_id in
0 ..
table_of_core_scheduler (result.nb_entries).nb_entries - 1
loop
check_before_scheduling
(table_of_core_scheduler (result.nb_entries).entries
(core_id)
.scheduler.all,
sys.tasks,
a_processor.name);
end loop;
if options.with_precedencies then
dependencies_harmonic_periods_control
(sys.tasks,
sys.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 (sys.processors, iterator1);
next_element (sys.processors, iterator1);
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) Loading of all text file that may be uses by the simulator
-- e.g. user defined scheduler, offline scheduling, ...
-- by the schedulers
-- 6) basic initialization that are specific for each scheduler
---------------------------------------------------------
------------------------------------------------
-- Step 1 : initialization of variables to all processors and core units
--
put_debug
("initialize_Multiprocessor_Scheduling : initialization of processor and core units variables",
very_verbose);
-- Variables to store architecture model to simulate
--
si.number_of_tasks := 0;
si.number_of_resources := 0;
si.number_of_processors :=
get_number_of_elements (sys.processors);
si.number_of_address_spaces :=
get_number_of_elements (sys.address_spaces);
si.simulation_length := last_time;
for z in tasks_range loop
si.tcbs (z) := null;
end loop;
duplicate (sys.batteries, si.batteries);
duplicate (sys.processors, si.processors);
si.dependencies := new tasks_dependencies;
duplicate (sys.dependencies, si.dependencies);
for z in resources_range loop
si.shared_resources (z) := null;
end loop;
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
("initialize_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 for processor j
--
select_and_copy (sys.tasks, tmp_tasks (j), select_cpu'access);
if (not is_empty (tmp_tasks (j))) then
select_and_copy
(sys.resources,
tmp_resources (j),
select_cpu'access);
select_and_copy
(sys.buffers,
tmp_buffers (j),
select_cpu'access);
-- Build address spaces scheduler table for processor j
--
initialize (table_of_address_space_scheduler (j));
if not is_empty (sys.address_spaces) then
reset_iterator (sys.address_spaces, iterator2);
loop
current_element (sys.address_spaces, a_addr, iterator2);
if (a_addr.cpu_name = current_processor_name) and
(a_addr.scheduling.scheduler_type /=
no_scheduling_protocol)
then
a_address_space_scheduler :=
new address_space_scheduler;
a_processor :=
search_processor
(sys.processors,
current_processor_name);
a_address_space_scheduler.scheduler :=
build_a_scheduler (a_addr, a_processor);
a_address_space_scheduler.corresponding_address_space := a_addr;
add
(table_of_address_space_scheduler (j),
entity_scheduler_ptr (a_address_space_scheduler));
end if;
exit when is_last_element (sys.address_spaces, iterator2);
next_element (sys.address_spaces, iterator2);
end loop;
end if;
------------------------------------------------
-- Step 3 : initialization of each j processor
--
if options.with_dvfs then
dvfs_init_voltage_scaling(result.entries (j).item);
end if;
processor_initialization
(table_of_core_scheduler (j).entries (0).scheduler.all,
si,
result.entries (j).item.name,
tmp_tasks (j),
tmp_resources (j),
tmp_buffers (j),
result.entries (j).data.result,
options,
last_time,
event_to_generate,
sys.cache_access_profiles,
sys.caches);
----------------------------------------------------------------
-- Step 4 : initialization of each core unit of processor j
--
for core_id in 0 .. table_of_core_scheduler (j).nb_entries - 1
loop
core_unit_initialization
(table_of_core_scheduler (j).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,
options,
last_time,
event_to_generate);
end loop;
-------------------------------------------------------------------------------------
-- Step 5 : Loading of all text file that may be used by schedulers of processor j
-- e.g. user defined scheduler, offline scheduling, ...
--
for core_id in 0 .. table_of_core_scheduler (j).nb_entries - 1
loop
begin
if get_name
(table_of_core_scheduler (j).entries (core_id)
.scheduler.all) =
hierarchical_offline_protocol
then
read_from_xml_file
(partition_sched,
sys,
table_of_core_scheduler (j).entries (core_id)
.scheduler
.parameters
.user_defined_scheduler_source_file_name);
set_event_table
(hierarchical_offline_scheduler
(table_of_core_scheduler (j).entries (core_id)
.scheduler.all),
partition_sched);
end if;
if get_name
(table_of_core_scheduler (j).entries (core_id)
.scheduler.all) =
automata_user_defined_protocol or
get_name
(table_of_core_scheduler (j).entries (core_id)
.scheduler.all) =
pipeline_user_defined_protocol
then
file_content :=
read_sequential_file
(table_of_core_scheduler (j).entries (core_id)
.scheduler
.parameters
.user_defined_scheduler_source_file_name);
set_string_behavior
(user_defined_scheduler
(table_of_core_scheduler (j).entries (core_id)
.scheduler.all),
file_content);
end if;
exception
when Ada.IO_Exceptions.Name_Error =>
Raise_Exception
(parametric_file_error'identity,
To_String
(lb_file (current_language) &
lb_colon &
table_of_core_scheduler (j).entries (core_id)
.scheduler
.parameters
.user_defined_scheduler_source_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 &
table_of_core_scheduler (j).entries (core_id)
.scheduler
.parameters
.user_defined_scheduler_source_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 &
table_of_core_scheduler (j).entries (core_id)
.scheduler
.parameters
.user_defined_scheduler_source_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 &
table_of_core_scheduler (j).entries (core_id)
.scheduler
.parameters
.user_defined_scheduler_source_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 &
table_of_core_scheduler (j).entries (core_id)
.scheduler
.parameters
.user_defined_scheduler_source_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 &
table_of_core_scheduler (j).entries (core_id)
.scheduler
.parameters
.user_defined_scheduler_source_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 &
table_of_core_scheduler (j).entries (core_id)
.scheduler
.parameters
.user_defined_scheduler_source_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 &
table_of_core_scheduler (j).entries (core_id)
.scheduler
.parameters
.user_defined_scheduler_source_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 &
table_of_core_scheduler (j).entries (core_id)
.scheduler
.parameters
.user_defined_scheduler_source_file_name &
lb_comma &
lb_can_not_open_file (current_language)));
end;
end loop;
------------------------------------------------------------------------
-- Step 6 : basic initializations that are specific for each scheduler
--
for core_id in 0 .. table_of_core_scheduler (j).nb_entries - 1
loop
specific_scheduler_initialization
(table_of_core_scheduler (j).entries (core_id)
.scheduler.all,
si,
result.entries (j).item.name,
To_Unbounded_String (""),
tmp_tasks (j),
table_of_address_space_scheduler (j),
tmp_resources (j),
tmp_buffers (j),
sys.messages,
result.entries (j).data.scheduling_msg);
end loop;
end if;
end if;
end loop;
end initialize_multiprocessor_scheduling;
procedure build_multiprocessor_scheduling
(sys : in system;
result : in out scheduling_table_ptr;
event_to_generate : in time_unit_event_type_boolean_table;
last_time : in Natural;
options : in scheduling_option)
is
procedure do_election
(j : scheduling_table_range;
core_id : in scheduler_table_range)
is
begin
-- 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
(table_of_core_scheduler (j).entries (core_id).scheduler.all) =
not_preemptive)
then
if
(table_of_core_scheduler (j).entries (core_id).scheduler
.previous_running_task_is_not_completed)
then
put_debug
("Preemption management : task is not ended ",
very_verbose);
elected :=
table_of_core_scheduler (j).entries (core_id).scheduler
.previously_elected;
no_task := False;
must_perform_election := False;
end if;
end if;
if must_perform_election then
put_debug ("Call Do_Election ", very_verbose);
do_election
(table_of_core_scheduler (j).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 (""),
table_of_core_scheduler (j).entries (core_id).scheduler
.corresponding_core_unit
.name,
options,
event_to_generate,
elected,
no_task);
end if;
end do_election;
election_is_completed : Boolean := False;
core_id : scheduler_table_range := 0;
computed_elected : array
(schedulers_table_package.table_range) of Boolean;
selected : scheduler_table_range;
begin
put_debug ("Call Build_Multiprocessor_Scheduling", very_verbose);
initialize_multiprocessor_scheduling
(sys,
result,
event_to_generate,
last_time,
options);
if(options.with_anomaly_detection)
then
scheduling_anomalies_services.initialize(sys);
end if;
--------------------------------------------------------------
-- Now, we compute the scheduling of the overall architecture
--------------------------------------------------------------
while (last_current_time < last_time) loop
last_current_time := Natural'last;
-- Initialized TCB variables that have to be initiliazed
-- for each unit of time
--
for i in 0 .. si.number_of_tasks - 1 loop
si.tcbs (i).already_run_at_current_time := False;
si.tcbs (i).wait_for_a_resource := null;
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);
election_is_completed := False;
core_id := 0;
for k in 0 .. table_of_core_scheduler (j).nb_entries - 1 loop
computed_elected (k) := False;
end loop;
while (not election_is_completed) loop
for k in 0 .. table_of_core_scheduler (j).nb_entries - 1
loop
if computed_elected (k) = False then
core_id := k;
end if;
end loop;
do_election (j, core_id);
selected := core_id;
if not no_task then
for k in
0 .. table_of_core_scheduler (j).nb_entries - 1
loop
if
(table_of_core_scheduler (j).entries (k).scheduler
.previously_busy =
True) and
(table_of_core_scheduler (j).entries (k).scheduler
.previously_elected =
elected)
then
selected := k;
end if;
end loop;
end if;
computed_elected (selected) := True;
election_is_completed := True;
for k in 0 .. table_of_core_scheduler (j).nb_entries - 1
loop
if computed_elected (k) = False then
election_is_completed := False;
end if;
end loop;
-- Update task properties and produce events
--
update_task_simulation_data_and_produce_events
(table_of_core_scheduler (j).entries (selected)
.scheduler.all,
result.entries (j).item.name,
si,
sys.dependencies,
elected,
result.entries (j).data.result,
current_time (j),
last_time,
options,
event_to_generate);
if not no_task then
update_task_simulation_data_and_produce_events_when_task_is_run
(table_of_core_scheduler (j).entries (selected)
.scheduler.all,
result.entries (j).item.name,
si,
sys.dependencies,
elected,
result.entries (j).data.result,
current_time (j),
last_time,
options,
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
begin
Put_Line ("");
for i in 0 .. sched.nb_entries - 1 loop
for j in 0 .. sched.entries (i).data.result.nb_entries - 1 loop
Put (" ");
Put (xml_string (sched.entries (i).data.result.entries (j).item));
Put (xml_string (sched.entries (i).data.result.entries (j).data));
Put_Line (" ");
end loop;
end loop;
Put_Line ("");
New_Line;
New_Line;
end display_scheduling;
procedure run_an_event_analyzer
(sys : in system;
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;
ext_event_analyzer : extended_event_analyzer_ptr :=
extended_event_analyzer_ptr (an_event_analyzer);
a_section : computation_section_ptr;
begin
begin
ext_event_analyzer.string_behavior :=
read_sequential_file
(ext_event_analyzer.event_analyzer_source_file_name);
exception
when Ada.IO_Exceptions.Name_Error =>
Raise_Exception
(parametric_file_error'identity,
To_String
(lb_file (current_language) &
lb_colon &
ext_event_analyzer.event_analyzer_source_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 &
ext_event_analyzer.event_analyzer_source_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 &
ext_event_analyzer.event_analyzer_source_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 &
ext_event_analyzer.event_analyzer_source_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 &
ext_event_analyzer.event_analyzer_source_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 &
ext_event_analyzer.event_analyzer_source_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 &
ext_event_analyzer.event_analyzer_source_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 &
ext_event_analyzer.event_analyzer_source_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 &
ext_event_analyzer.event_analyzer_source_file_name &
lb_comma &
lb_can_not_open_file (current_language)));
end;
-- We should check the scheduler behavior syntax ...
--
open_input (ext_event_analyzer.string_behavior);
parser.first_file (ext_event_analyzer.event_analyzer_source_file_name);
create_parametric_variables (parser.variables_table, sys.tasks);
parser.yyparse;
-- Store syntax tree and compiling information
--
begin
a_section :=
computation_section_ptr
(search_section
(parser.root_statement_pointer,
sections.start_type));
ext_event_analyzer.root_statement_pointer (sections.start_type) :=
a_section.first_statement;
exception
when others =>
ext_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));
ext_event_analyzer.root_statement_pointer
(sections.gather_event_analyzer_type) :=
a_section.first_statement;
exception
when others =>
ext_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));
ext_event_analyzer.root_statement_pointer
(sections.display_event_analyzer_type) :=
a_section.first_statement;
exception
when others =>
ext_event_analyzer.root_statement_pointer
(sections.display_event_analyzer_type) :=
null;
end;
ext_event_analyzer.variables_table := parser.variables_table;
ext_event_analyzer.sets_table := parser.sets_table;
-- Initialize parametric variables which are constant
--
initialize_parametric_variables
(ext_event_analyzer.variables_table,
sys.messages,
sys.buffers,
sys.resources,
sys.tasks);
-- "nb_processors"
--
var :=
find_variable
(ext_event_analyzer.variables_table,
To_Unbounded_String ("nb_processors"));
ext_event_analyzer.variables_table.entries (var).simulation
.integer_value :=
Integer (get_number_of_elements (sys.processors));
-- "nb_address_spaces"
--
var :=
find_variable
(ext_event_analyzer.variables_table,
To_Unbounded_String ("nb_address_spaces"));
ext_event_analyzer.variables_table.entries (var).simulation
.integer_value :=
Integer (get_number_of_elements (sys.address_spaces));
-- Now : run "start" statements
--
current :=
ext_event_analyzer.root_statement_pointer (sections.start_type);
dispatch
(current,
sections.start_type,
To_Unbounded_String ("none"),
si,
ext_event_analyzer.variables_table,
result);
-- Now : run "event analyzer" statements
--
current :=
ext_event_analyzer.root_statement_pointer
(sections.gather_event_analyzer_type);
-- Find variables before running the simulation
--
var_time :=
find_variable
(ext_event_analyzer.variables_table,
To_Unbounded_String ("events.time"));
var_type :=
find_variable
(ext_event_analyzer.variables_table,
To_Unbounded_String ("events.type"));
var_processor :=
find_variable
(ext_event_analyzer.variables_table,
To_Unbounded_String ("events.processor_name"));
var_message :=
find_variable
(ext_event_analyzer.variables_table,
To_Unbounded_String ("events.message_name"));
var_resource :=
find_variable
(ext_event_analyzer.variables_table,
To_Unbounded_String ("events.resource_name"));
var_task :=
find_variable
(ext_event_analyzer.variables_table,
To_Unbounded_String ("events.task_name"));
var_buffer :=
find_variable
(ext_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"
--
ext_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"
--
ext_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
.type_of_event'
img);
-- "events.processor_name"
--
ext_event_analyzer.variables_table.entries (var_processor)
.simulation
.string_value :=
global_processor_name (current_min_time_processor);
-- "events.buffer_name"
--
ext_event_analyzer.variables_table.entries (var_buffer).simulation
.string_value :=
empty_string;
-- "events.resource_name"
--
ext_event_analyzer.variables_table.entries (var_resource)
.simulation
.string_value :=
empty_string;
-- "events.message_name"
--
ext_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
.type_of_event
is
when start_of_task_capacity =>
ext_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 =>
ext_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 =>
ext_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;
ext_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 =>
ext_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;
ext_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 buffer_overflow =>
null;
when buffer_underflow =>
null;
when running_task =>
ext_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 =>
ext_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 =>
ext_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 =>
ext_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;
ext_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 =>
ext_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;
ext_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 =>
ext_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;
ext_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 =>
ext_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;
ext_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 =>
ext_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;
ext_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;
when address_space_activation =>
ext_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_address_space;
when preemption =>
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"),
si,
ext_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 :=
ext_event_analyzer.root_statement_pointer
(sections.display_event_analyzer_type);
dispatch
(current,
sections.display_event_analyzer_type,
To_Unbounded_String ("none"),
si,
ext_event_analyzer.variables_table,
result);
end run_an_event_analyzer;
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;
input : file_input;
reader : tree_reader;
d : document;
begin
-- Open file and Write XML Header
--
Create (into, Mode => Out_File, Name => To_String (file_name));
Put_Line (into, " ");
-- Put_Line (Into, "");
-- Put_Line (Into, "");
New_Line (into, 2);
Put_Line (into, "");
for i in 0 .. sched.nb_entries - 1 loop
for j in 0 .. sched.entries (i).data.result.nb_entries - 1 loop
Put (into, "");
write_xml (into, sched.entries (i).data.result.entries (j).item);
Put_Line (into, "");
write_xml (into, sched.entries (i).data.result.entries (j).data);
end loop;
end loop;
Put_Line (into, "");
New_Line (into);
New_Line (into);
Close (into);
Open (To_String (file_name), input);
Parse (reader, input);
d := Get_Tree (reader);
Close (input);
Create (into, Mode => Out_File, Name => To_String (file_name));
Write
(Stream => Stream (into),
N => d,
Print_Comments => False,
Print_XML_Declaration => True,
With_URI => False,
EOL_Sequence => "" & ASCII.LF,
Pretty_Print => True,
Encoding => Unicode.Encodings.Get_By_Name ("utf-8"),
Collapse_Empty_Nodes => False);
Free (reader);
Close (into);
end write_to_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);
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 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 free (sched : in out scheduling_table_ptr) is
procedure free_pointer is new Unchecked_Deallocation
(scheduling_table,
scheduling_table_ptr);
begin
if sched /= null then
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 if;
end free;
end multiprocessor_services;