------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- This Ada package was automatically generated by the software engineering
--tool Platypus
-- see http://cassoulet.univ-brest.fr/mme
--
-- Any modification of this file will be lost.
-- Please see the "platypus" directory instead : it contains the Cheddar's
-- model and its meta-model.
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Cheddar is a free real time scheduling tool.
-- This program provides services to automatically check temporal constraints
-- of real time tasks.
--
-- Copyright (C) 2002-2009 Frank Singhoff
-- Cheddar is developed by the LISYC Team, University of Brest
--
-- 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
-- To post to this mailing list, you must be subscribed
-- (see http//beru.univ-brest.fr/~singhoff/cheddar for details)
--
------------------------------------------------------------------------------
------------------------------------------------------------------------------
with primitive_xml_strings; use primitive_xml_strings;
with unbounded_strings; use unbounded_strings;
with debug; use debug;
with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
use unbounded_strings.unbounded_string_list_package;
with Tasks; use Tasks;
with task_dependencies; use task_dependencies;
use task_dependencies.half_dep_set;
with task_set; use task_set;
with Buffers; use Buffers;
with Generic_Graph; use Generic_Graph;
use Generic_Graph.Edge_Lists_Package;
use Generic_Graph.Node_Lists_Package;
with Generic_Graph.extended; use Generic_Graph.extended;
with systems; use systems;
with debug; use debug;
with Messages; use Messages;
with Dependencies; use Dependencies;
with Resources; use Resources;
with Processors; use Processors;
package body DP_Graph.extended is
-- --------= Task_Node =--------
procedure add_node
(obj : in out graph;
n : in task_node_ptr;
succeed : out Boolean)
is
begin
add_generic_node (obj, generic_node_ptr (n), succeed);
end add_node;
procedure initialize (obj : in out task_node_ptr) is
begin
obj := new task_node;
Initialize (generic_node'class (obj.all));
obj.TaskRef := null;
obj.Kind := periodic_type;
-- obj.Cpu := Empty_String;
end initialize;
function copy (obj : in task_node) return task_node_ptr is
new_task_node : task_node_ptr;
begin
new_task_node := new task_node'(obj);
return (new_task_node);
end copy;
function copy (obj : in task_node_ptr) return task_node_ptr is
begin
if (obj = null) then
raise building_graph_exception;
else
return copy (obj);
end if;
end copy;
function get_name (obj : in task_node) return Unbounded_String is
begin
return obj.cheddar_private_id;
end get_name;
function get_name (obj : in task_node_ptr) return Unbounded_String is
begin
return obj.cheddar_private_id;
end get_name;
function type_of (obj : in task_node) return unbounded_string_list is
list : unbounded_string_list;
s : unbounded_string_ptr;
begin
initialize (list);
s := new Unbounded_String;
s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT");
add (list, s);
s := new Unbounded_String;
s.all := To_Unbounded_String ("GENERIC_GRAPH.GENERIC_NODE");
add (list, s);
s := new Unbounded_String;
s.all := To_Unbounded_String ("DP_GRAPH.TASK_NODE");
add (list, s);
return list;
end type_of;
function xml_string (obj : in task_node) return Unbounded_String is
result : Unbounded_String;
begin
result := "" & unbounded_lf;
Build_Attributes_XML_String (obj, result);
result := result & "" & unbounded_lf;
return (result);
end xml_string;
function create_node_from_task
(obj : in generic_task_ptr) return task_node_ptr
is
res : task_node_ptr;
begin
initialize (res);
res.all.Id := obj.all.cheddar_private_id;
res.all.cheddar_private_id := obj.all.cheddar_private_id;
res.all.TaskRef := obj;
res.all.Kind := obj.all.task_type;
put_debug ("Node Id" & res.all.Id);
put_debug ("Task Id" & obj.all.cheddar_private_id);
return res;
end create_node_from_task;
-- --------= Time_Triggered_Communication_Edge =--------
procedure add_edge
(obj : in out graph;
e : in time_triggered_communication_edge_ptr;
succeed : out Boolean)
is
begin
add_generic_edge (obj, generic_edge_ptr (e), succeed);
end add_edge;
procedure initialize (obj : in out time_triggered_communication_edge) is
begin
Initialize (generic_edge (obj));
obj.Timing_Property := sampled_timing;
end initialize;
procedure initialize (obj : in out time_triggered_communication_edge_ptr) is
begin
obj := new time_triggered_communication_edge;
Initialize (generic_edge'class (obj.all));
obj.Timing_Property := sampled_timing;
end initialize;
function copy
(obj : in time_triggered_communication_edge)
return time_triggered_communication_edge_ptr
is
new_time_triggered_communication_edge : time_triggered_communication_edge_ptr;
begin
new_time_triggered_communication_edge :=
new time_triggered_communication_edge'(obj);
return (new_time_triggered_communication_edge);
end copy;
procedure put (obj : in time_triggered_communication_edge) is
begin
Put (generic_edge (obj));
Put ("Timing_Property: ");
Put (obj.Timing_Property'img);
Put ("; ");
end put;
procedure put_name (obj : in time_triggered_communication_edge_ptr) is
begin
Put (To_String (obj.cheddar_private_id));
end put_name;
function get_name
(obj : in time_triggered_communication_edge) return Unbounded_String
is
begin
return obj.cheddar_private_id;
end get_name;
function get_name
(obj : in time_triggered_communication_edge_ptr) return Unbounded_String
is
begin
return obj.cheddar_private_id;
end get_name;
function type_of
(obj : in time_triggered_communication_edge) return unbounded_string_list
is
list : unbounded_string_list;
s : unbounded_string_ptr;
begin
initialize (list);
s := new Unbounded_String;
s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT");
add (list, s);
s := new Unbounded_String;
s.all := To_Unbounded_String ("GENERIC_GRAPH.GENERIC_EDGE");
add (list, s);
s := new Unbounded_String;
s.all :=
To_Unbounded_String ("DP_GRAPH.Time_Triggered_Communication_EDGE");
add (list, s);
return list;
end type_of;
procedure build_attributes_xml_string
(obj : in time_triggered_communication_edge;
result : in out Unbounded_String)
is
begin
Build_Attributes_XML_String (generic_edge (obj), result);
result :=
result &
ASCII.HT &
" " &
XML_String (obj.Timing_Property) &
" " &
unbounded_lf;
end build_attributes_xml_string;
function xml_string
(obj : in time_triggered_communication_edge) return Unbounded_String
is
result : Unbounded_String;
begin
result :=
"" &
unbounded_lf;
build_attributes_xml_string (obj, result);
result := result & "" & unbounded_lf;
return (result);
end xml_string;
function create_time_triggered_communication_edge_from_dependency
(obj : in dependency_ptr;
naming_cpt : in Integer) return time_triggered_communication_edge_ptr
is
res : time_triggered_communication_edge_ptr;
begin
initialize (res);
res.all.Id := To_Unbounded_String ("Edge_" & (naming_cpt'img));
res.all.Node_1 :=
obj.all.time_triggered_communication_source.all.cheddar_private_id;
res.all.Node_2 :=
obj.all.time_triggered_communication_sink.all.cheddar_private_id;
res.all.Timing_Property := obj.all.time_triggered_timing_property;
return res;
end create_time_triggered_communication_edge_from_dependency;
-- --------= Resource_Edge =--------
procedure add_edge
(obj : in out graph;
e : in resource_edge_ptr;
succeed : out Boolean)
is
begin
add_generic_edge (obj, generic_edge_ptr (e), succeed);
end add_edge;
procedure initialize (obj : in out resource_edge) is
begin
Initialize (generic_edge (obj));
obj.Resource_Dependency_Resource := new generic_resource;
end initialize;
procedure initialize (obj : in out resource_edge_ptr) is
begin
obj := new resource_edge;
Initialize (generic_edge'class (obj.all));
obj.Resource_Dependency_Resource := new generic_resource;
end initialize;
function copy (obj : in resource_edge) return resource_edge_ptr is
new_resource_edge : resource_edge_ptr;
begin
new_resource_edge := new resource_edge'(obj);
return (new_resource_edge);
end copy;
procedure put (obj : in resource_edge) is
begin
Put (generic_edge (obj));
Put ("Resource_Dependency_Resource: ");
Put (obj.Resource_Dependency_Resource);
Put ("; ");
end put;
procedure put_name (obj : in resource_edge_ptr) is
begin
Put (To_String (obj.cheddar_private_id));
end put_name;
function get_name (obj : in resource_edge) return Unbounded_String is
begin
return obj.cheddar_private_id;
end get_name;
function get_name (obj : in resource_edge_ptr) return Unbounded_String is
begin
return obj.cheddar_private_id;
end get_name;
function type_of (obj : in resource_edge) return unbounded_string_list is
list : unbounded_string_list;
s : unbounded_string_ptr;
begin
initialize (list);
s := new Unbounded_String;
s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT");
add (list, s);
s := new Unbounded_String;
s.all := To_Unbounded_String ("GENERIC_GRAPH.GENERIC_EDGE");
add (list, s);
s := new Unbounded_String;
s.all := To_Unbounded_String ("DP_GRAPH.RESOURCE_EDGE");
add (list, s);
return list;
end type_of;
procedure build_attributes_xml_string
(obj : in resource_edge;
result : in out Unbounded_String)
is
begin
Build_Attributes_XML_String (generic_edge (obj), result);
end build_attributes_xml_string;
function xml_string (obj : in resource_edge) return Unbounded_String is
result : Unbounded_String;
begin
result :=
"" & unbounded_lf;
build_attributes_xml_string (obj, result);
result := result & "" & unbounded_lf;
return (result);
end xml_string;
function create_resource_edge_from_dependency
(obj : in dependency_ptr;
naming_cpt : in Integer) return resource_edge_ptr
is
res : resource_edge_ptr;
begin
initialize (res);
res.all.Id := To_Unbounded_String ("Edge_" & (naming_cpt'img));
res.all.Node_1 :=
obj.all.resource_dependency_task.all.cheddar_private_id;
res.all.Resource_Dependency_Resource :=
obj.all.resource_dependency_resource;
return res;
end create_resource_edge_from_dependency;
procedure clean_resource_edges (obj : in out graph) is
e_iterator : edge_lists_iterator;
current_edge : generic_edge_ptr;
e_iterator2 : edge_lists_iterator;
current_edge2 : generic_edge_ptr;
begin
reset_head_iterator (obj.Edges, e_iterator);
reset_head_iterator (obj.Edges, e_iterator2);
if not is_empty (obj.Edges) then
current_element (obj.Edges, current_edge, e_iterator);
while (not is_tail_element (obj.Edges, e_iterator)) loop
if element_in_list
(To_Unbounded_String ("DP_GRAPH.RESOURCE_EDGE"),
type_of (current_edge))
then
current_element (obj.Edges, current_edge2, e_iterator2);
while (not is_tail_element (obj.Edges, e_iterator2)) loop
if element_in_list
(To_Unbounded_String ("DP_GRAPH.RESOURCE_EDGE"),
type_of (current_edge2))
then
if
((resource_edge_ptr (current_edge)
.Resource_Dependency_Resource =
resource_edge_ptr (current_edge2)
.Resource_Dependency_Resource) and
not (current_edge.all.Id = current_edge2.all.Id) and
(current_edge.all.Node_2 =
current_edge2.all.Node_2) and
(current_edge.all.Node_1 = current_edge2.all.Node_1))
then
delete (obj.Edges, current_edge2);
reset_head_iterator (obj.Edges, e_iterator2);
reset_head_iterator (obj.Edges, e_iterator);
end if;
end if;
next_element (obj.Edges, e_iterator2);
current_element (obj.Edges, current_edge2, e_iterator2);
end loop;
reset_head_iterator (obj.Edges, e_iterator2);
end if;
next_element (obj.Edges, e_iterator);
current_element (obj.Edges, current_edge, e_iterator);
end loop;
if element_in_list
(To_Unbounded_String ("DP_GRAPH.RESOURCE_EDGE"),
type_of (current_edge))
then
current_element (obj.Edges, current_edge2, e_iterator2);
while (not is_tail_element (obj.Edges, e_iterator2)) loop
if element_in_list
(To_Unbounded_String ("DP_GRAPH.RESOURCE_EDGE"),
type_of (current_edge2))
then
if
((resource_edge_ptr (current_edge)
.Resource_Dependency_Resource =
resource_edge_ptr (current_edge2)
.Resource_Dependency_Resource) and
not (current_edge.all.Id = current_edge2.all.Id) and
(current_edge.all.Node_2 = current_edge2.all.Node_2) and
(current_edge.all.Node_1 = current_edge2.all.Node_1))
then
delete (obj.Edges, current_edge2);
reset_head_iterator (obj.Edges, e_iterator2);
reset_head_iterator (obj.Edges, e_iterator);
end if;
end if;
next_element (obj.Edges, e_iterator2);
current_element (obj.Edges, current_edge2, e_iterator2);
end loop;
reset_head_iterator (obj.Edges, e_iterator2);
end if;
end if;
end clean_resource_edges;
procedure create_specific_resource_edges
(obj : in out graph;
d : in dependency_ptr;
naming_cpt : in out Integer;
succeed : out Boolean)
is
e_iterator : edge_lists_iterator;
current_edge : generic_edge_ptr;
temporary_edge : resource_edge_ptr;
begin
succeed := False;
reset_head_iterator (obj.Edges, e_iterator);
if not is_empty (obj.Edges) then
current_element (obj.Edges, current_edge, e_iterator);
while (not is_tail_element (obj.Edges, e_iterator)) loop
if element_in_list
(To_Unbounded_String ("DP_GRAPH.RESOURCE_EDGE"),
type_of (current_edge))
then
if
(resource_edge_ptr (current_edge)
.Resource_Dependency_Resource =
d.resource_dependency_resource)
then
if (current_edge.all.Node_2 = empty_string) then
current_edge.all.Node_2 :=
Get_Name (d.all.resource_dependency_task);
succeed := True;
else
temporary_edge :=
create_resource_edge_from_dependency (d, naming_cpt);
naming_cpt := naming_cpt + 1;
temporary_edge.all.Node_2 := current_edge.all.Node_2;
add_edge (obj, Copy (temporary_edge), succeed);
temporary_edge :=
create_resource_edge_from_dependency (d, naming_cpt);
naming_cpt := naming_cpt + 1;
temporary_edge.all.Node_2 := current_edge.all.Node_1;
add_edge (obj, Copy (temporary_edge), succeed);
end if;
end if;
end if;
next_element (obj.Edges, e_iterator);
current_element (obj.Edges, current_edge, e_iterator);
end loop;
if element_in_list
(To_Unbounded_String ("DP_GRAPH.RESOURCE_EDGE"),
type_of (current_edge))
then
if
(resource_edge_ptr (current_edge).Resource_Dependency_Resource =
d.resource_dependency_resource)
then
if (current_edge.all.Node_2 = empty_string) then
current_edge.all.Node_2 :=
Get_Name (d.all.resource_dependency_task);
succeed := True;
else
temporary_edge :=
create_resource_edge_from_dependency (d, naming_cpt);
naming_cpt := naming_cpt + 1;
temporary_edge.all.Node_2 := current_edge.all.Node_2;
add_edge (obj, Copy (temporary_edge), succeed);
temporary_edge :=
create_resource_edge_from_dependency (d, naming_cpt);
naming_cpt := naming_cpt + 1;
temporary_edge.all.Node_2 := current_edge.all.Node_1;
add_edge (obj, Copy (temporary_edge), succeed);
end if;
end if;
end if;
end if;
if not succeed then
add_edge
(obj,
create_resource_edge_from_dependency (d, naming_cpt),
succeed);
end if;
if not succeed then
raise building_graph_exception;
end if;
naming_cpt := naming_cpt + 1;
end create_specific_resource_edges;
-- --------= Precedence_Edge =--------
procedure add_edge
(obj : in out graph;
e : in precedence_edge_ptr;
succeed : out Boolean)
is
begin
add_generic_edge (obj, generic_edge_ptr (e), succeed);
end add_edge;
procedure initialize (obj : in out precedence_edge) is
begin
Initialize (generic_edge (obj));
end initialize;
procedure initialize (obj : in out precedence_edge_ptr) is
begin
obj := new precedence_edge;
Initialize (generic_edge'class (obj.all));
end initialize;
function copy (obj : in precedence_edge) return precedence_edge_ptr is
new_precedence_edge : precedence_edge_ptr;
begin
new_precedence_edge := new precedence_edge'(obj);
return (new_precedence_edge);
end copy;
procedure put (obj : in precedence_edge) is
begin
Put (generic_edge (obj));
end put;
procedure put_name (obj : in precedence_edge_ptr) is
begin
Put (To_String (obj.cheddar_private_id));
end put_name;
function get_name (obj : in precedence_edge) return Unbounded_String is
begin
return obj.cheddar_private_id;
end get_name;
function get_name (obj : in precedence_edge_ptr) return Unbounded_String is
begin
return obj.cheddar_private_id;
end get_name;
function type_of (obj : in precedence_edge) return unbounded_string_list is
list : unbounded_string_list;
s : unbounded_string_ptr;
begin
initialize (list);
s := new Unbounded_String;
s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT");
add (list, s);
s := new Unbounded_String;
s.all := To_Unbounded_String ("GENERIC_GRAPH.GENERIC_EDGE");
add (list, s);
s := new Unbounded_String;
s.all := To_Unbounded_String ("DP_GRAPH.PRECEDENCE_EDGE");
add (list, s);
return list;
end type_of;
procedure build_attributes_xml_string
(obj : in precedence_edge;
result : in out Unbounded_String)
is
begin
Build_Attributes_XML_String (generic_edge (obj), result);
end build_attributes_xml_string;
function xml_string (obj : in precedence_edge) return Unbounded_String is
result : Unbounded_String;
begin
result :=
"" & unbounded_lf;
build_attributes_xml_string (obj, result);
result := result & "" & unbounded_lf;
return (result);
end xml_string;
function create_precedence_edge_from_dependency
(obj : in dependency_ptr;
naming_cpt : in Integer) return precedence_edge_ptr
is
res : precedence_edge_ptr;
begin
initialize (res);
res.all.Id := To_Unbounded_String ("Edge_" & (naming_cpt'img));
res.all.Node_1 := obj.all.precedence_source.all.cheddar_private_id;
res.all.Node_2 := obj.all.precedence_sink.all.cheddar_private_id;
return res;
end create_precedence_edge_from_dependency;
-- --------= Communication_Edge =--------
procedure add_edge
(obj : in out graph;
e : in communication_edge_ptr;
succeed : out Boolean)
is
begin
add_generic_edge (obj, generic_edge_ptr (e), succeed);
end add_edge;
procedure initialize (obj : in out communication_edge) is
begin
Initialize (generic_edge (obj));
obj.Communication_Dependency_Object := new periodic_message;
Initialize (obj.Communication_Dependency_Object.all);
end initialize;
procedure initialize (obj : in out communication_edge_ptr) is
begin
obj := new communication_edge;
Initialize (generic_edge'class (obj.all));
obj.all.Communication_Dependency_Object := new periodic_message;
Initialize (obj.all.Communication_Dependency_Object.all);
end initialize;
function create_communication_edge_from_dependency
(obj : in dependency_ptr;
naming_cpt : in Integer) return communication_edge_ptr
is
res : communication_edge_ptr;
begin
initialize (res);
res.all.Id := To_Unbounded_String ("Edge_" & (naming_cpt'img));
if
(obj.all.asynchronous_communication_orientation = from_task_to_object)
then
res.all.Node_1 :=
obj.all.asynchronous_communication_dependent_task.all
.cheddar_private_id;
else
res.all.Node_2 :=
obj.all.asynchronous_communication_dependent_task.all
.cheddar_private_id;
end if;
res.all.Communication_Dependency_Object :=
obj.all.asynchronous_communication_dependency_object;
return res;
end create_communication_edge_from_dependency;
procedure create_specific_communication_edges
(obj : in out graph;
d : in dependency_ptr;
naming_cpt : in out Integer;
succeed : out Boolean)
is
e_iterator : edge_lists_iterator;
current_edge : generic_edge_ptr;
temporary_edge : communication_edge_ptr;
begin
succeed := False;
reset_head_iterator (obj.Edges, e_iterator);
if not is_empty (obj.Edges) then
current_element (obj.Edges, current_edge, e_iterator);
while (not is_tail_element (obj.Edges, e_iterator)) loop
if element_in_list
(To_Unbounded_String ("DP_GRAPH.COMMUNICATION_EDGE"),
type_of (current_edge))
then
if
(communication_edge_ptr (current_edge)
.Communication_Dependency_Object =
d.asynchronous_communication_dependency_object)
then
if
(d.all.asynchronous_communication_orientation =
from_task_to_object)
then
if (current_edge.all.Node_1 = empty_string) then
current_edge.all.Node_1 :=
Get_Name
(d.all.asynchronous_communication_dependent_task);
succeed := True;
else
if not (current_edge.all.Node_2 = empty_string) then
temporary_edge :=
create_communication_edge_from_dependency
(d,
naming_cpt);
naming_cpt := naming_cpt + 1;
temporary_edge.all.Node_2 :=
current_edge.all.Node_2;
add_edge (obj, Copy (temporary_edge), succeed);
end if;
end if;
else
if (current_edge.all.Node_2 = empty_string) then
current_edge.all.Node_2 :=
Get_Name
(d.all.asynchronous_communication_dependent_task);
succeed := True;
else
if not (current_edge.Node_1 = empty_string) then
temporary_edge :=
create_communication_edge_from_dependency
(d,
naming_cpt);
naming_cpt := naming_cpt + 1;
temporary_edge.all.Node_1 :=
current_edge.all.Node_1;
add_edge (obj, Copy (temporary_edge), succeed);
end if;
end if;
end if;
end if;
end if;
next_element (obj.Edges, e_iterator);
current_element (obj.Edges, current_edge, e_iterator);
end loop;
if element_in_list
(To_Unbounded_String ("DP_GRAPH.COMMUNICATION_EDGE"),
type_of (current_edge))
then
if
(communication_edge_ptr (current_edge)
.Communication_Dependency_Object =
d.asynchronous_communication_dependency_object)
then
if
(d.all.asynchronous_communication_orientation =
from_task_to_object)
then
if (current_edge.all.Node_1 = empty_string) then
current_edge.all.Node_1 :=
Get_Name
(d.all.asynchronous_communication_dependent_task);
succeed := True;
else
if not (current_edge.all.Node_2 = empty_string) then
temporary_edge :=
create_communication_edge_from_dependency
(d,
naming_cpt);
naming_cpt := naming_cpt + 1;
temporary_edge.all.Node_2 := current_edge.all.Node_2;
add_edge (obj, Copy (temporary_edge), succeed);
end if;
end if;
else
if (current_edge.all.Node_2 = empty_string) then
current_edge.all.Node_2 :=
Get_Name
(d.all.asynchronous_communication_dependent_task);
succeed := True;
else
if not (current_edge.all.Node_1 = empty_string) then
temporary_edge :=
create_communication_edge_from_dependency
(d,
naming_cpt);
naming_cpt := naming_cpt + 1;
temporary_edge.all.Node_1 := current_edge.all.Node_1;
add_edge (obj, Copy (temporary_edge), succeed);
end if;
end if;
end if;
end if;
end if;
end if;
if not succeed then
add_edge
(obj,
create_communication_edge_from_dependency (d, naming_cpt),
succeed);
end if;
if not succeed then
raise building_graph_exception;
end if;
naming_cpt := naming_cpt + 1;
end create_specific_communication_edges;
function copy (obj : in communication_edge) return communication_edge_ptr is
new_communication_edge : communication_edge_ptr;
begin
new_communication_edge := new communication_edge'(obj);
return (new_communication_edge);
end copy;
procedure put (obj : in communication_edge) is
begin
Put (generic_edge (obj));
Put ("Communication_Dependency_Object: ");
if obj.Communication_Dependency_Object /= null then
Put (obj.Communication_Dependency_Object.all);
else
Put ("null");
end if;
Put ("; ");
end put;
procedure put_name (obj : in communication_edge_ptr) is
begin
Put (To_String (obj.cheddar_private_id));
end put_name;
function get_name (obj : in communication_edge) return Unbounded_String is
begin
return obj.cheddar_private_id;
end get_name;
function get_name
(obj : in communication_edge_ptr) return Unbounded_String
is
begin
return obj.cheddar_private_id;
end get_name;
function type_of
(obj : in communication_edge) return unbounded_string_list
is
list : unbounded_string_list;
s : unbounded_string_ptr;
begin
initialize (list);
s := new Unbounded_String;
s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT");
add (list, s);
s := new Unbounded_String;
s.all := To_Unbounded_String ("GENERIC_GRAPH.GENERIC_EDGE");
add (list, s);
s := new Unbounded_String;
s.all := To_Unbounded_String ("DP_GRAPH.COMMUNICATION_EDGE");
add (list, s);
return list;
end type_of;
procedure build_attributes_xml_string
(obj : in communication_edge;
result : in out Unbounded_String)
is
begin
Build_Attributes_XML_String (generic_edge (obj), result);
end build_attributes_xml_string;
function xml_string (obj : in communication_edge) return Unbounded_String is
result : Unbounded_String;
begin
result :=
"" & unbounded_lf;
build_attributes_xml_string (obj, result);
result := result & "" & unbounded_lf;
return (result);
end xml_string;
-- --------= Buffer_Edge =--------
procedure add_edge
(obj : in out graph;
e : in buffer_edge_ptr;
succeed : out Boolean)
is
begin
add_generic_edge (obj, generic_edge_ptr (e), succeed);
end add_edge;
procedure initialize (obj : in out buffer_edge) is
begin
Initialize (generic_edge (obj));
obj.Buffer_Dependency_Object := new buffer;
Initialize (obj.Buffer_Dependency_Object.all);
end initialize;
procedure initialize (obj : in out buffer_edge_ptr) is
begin
obj := new buffer_edge;
Initialize (generic_edge'class (obj.all));
obj.all.Buffer_Dependency_Object := new buffer;
Initialize (obj.Buffer_Dependency_Object.all);
end initialize;
function copy (obj : in buffer_edge) return buffer_edge_ptr is
new_buffer_edge : buffer_edge_ptr;
begin
new_buffer_edge := new buffer_edge'(obj);
return (new_buffer_edge);
end copy;
procedure put (obj : in buffer_edge) is
begin
Put (generic_edge (obj));
Put ("Buffer_Dependency_Object: ");
if obj.Buffer_Dependency_Object /= null then
Put (obj.Buffer_Dependency_Object.all);
else
Put ("null");
end if;
Put ("; ");
end put;
procedure put_name (obj : in buffer_edge_ptr) is
begin
Put (To_String (obj.cheddar_private_id));
end put_name;
function get_name (obj : in buffer_edge) return Unbounded_String is
begin
return obj.cheddar_private_id;
end get_name;
function get_name (obj : in buffer_edge_ptr) return Unbounded_String is
begin
return obj.cheddar_private_id;
end get_name;
function type_of (obj : in buffer_edge) return unbounded_string_list is
list : unbounded_string_list;
s : unbounded_string_ptr;
begin
initialize (list);
s := new Unbounded_String;
s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT");
add (list, s);
s := new Unbounded_String;
s.all := To_Unbounded_String ("GENERIC_GRAPH.GENERIC_EDGE");
add (list, s);
s := new Unbounded_String;
s.all := To_Unbounded_String ("DP_GRAPH.BUFFER_EDGE");
add (list, s);
return list;
end type_of;
function create_buffer_edge_from_dependency
(obj : in dependency_ptr;
naming_cpt : in Integer) return buffer_edge_ptr
is
res : buffer_edge_ptr;
begin
initialize (res);
res.all.Id := To_Unbounded_String ("Edge_" & (naming_cpt'img));
res.all.Node_1 := obj.all.buffer_dependent_task.all.cheddar_private_id;
res.all.Buffer_Dependency_Object := obj.all.buffer_dependency_object;
return res;
end create_buffer_edge_from_dependency;
procedure create_specific_buffer_edges
(obj : in out graph;
d : in dependency_ptr;
naming_cpt : in out Integer;
succeed : out Boolean)
is
e_iterator : edge_lists_iterator;
current_edge : generic_edge_ptr;
temporary_edge : buffer_edge_ptr;
begin
succeed := False;
reset_head_iterator (obj.Edges, e_iterator);
if not is_empty (obj.Edges) then
current_element (obj.Edges, current_edge, e_iterator);
while (not is_tail_element (obj.Edges, e_iterator)) loop
if element_in_list
(To_Unbounded_String ("DP_GRAPH.BUFFER_EDGE"),
type_of (current_edge))
then
if
(buffer_edge_ptr (current_edge).Buffer_Dependency_Object =
d.buffer_dependency_object)
then
if (d.all.buffer_orientation = from_task_to_object) then
if (current_edge.all.Node_1 = empty_string) then
current_edge.all.Node_1 :=
Get_Name (d.all.buffer_dependent_task);
succeed := True;
else
if not (current_edge.all.Node_2 = empty_string) then
temporary_edge :=
create_buffer_edge_from_dependency
(d,
naming_cpt);
naming_cpt := naming_cpt + 1;
temporary_edge.all.Node_2 :=
current_edge.all.Node_2;
add_edge (obj, Copy (temporary_edge), succeed);
end if;
end if;
else
if (current_edge.all.Node_2 = empty_string) then
current_edge.all.Node_2 :=
Get_Name (d.all.buffer_dependent_task);
succeed := True;
else
if not (current_edge.Node_1 = empty_string) then
temporary_edge :=
create_buffer_edge_from_dependency
(d,
naming_cpt);
naming_cpt := naming_cpt + 1;
temporary_edge.all.Node_1 :=
current_edge.all.Node_1;
add_edge (obj, Copy (temporary_edge), succeed);
end if;
end if;
end if;
end if;
end if;
next_element (obj.Edges, e_iterator);
current_element (obj.Edges, current_edge, e_iterator);
end loop;
if element_in_list
(To_Unbounded_String ("DP_GRAPH.BUFFER_EDGE"),
type_of (current_edge))
then
if
(buffer_edge_ptr (current_edge).Buffer_Dependency_Object =
d.buffer_dependency_object)
then
if (d.all.buffer_orientation = from_task_to_object) then
if (current_edge.all.Node_1 = empty_string) then
current_edge.all.Node_1 :=
Get_Name (d.all.buffer_dependent_task);
succeed := True;
else
if not (current_edge.all.Node_2 = empty_string) then
temporary_edge :=
create_buffer_edge_from_dependency (d, naming_cpt);
naming_cpt := naming_cpt + 1;
temporary_edge.all.Node_2 := current_edge.all.Node_2;
add_edge (obj, Copy (temporary_edge), succeed);
end if;
end if;
else
if (current_edge.all.Node_2 = empty_string) then
current_edge.all.Node_2 :=
Get_Name (d.all.buffer_dependent_task);
succeed := True;
else
if not (current_edge.all.Node_1 = empty_string) then
temporary_edge :=
create_buffer_edge_from_dependency (d, naming_cpt);
naming_cpt := naming_cpt + 1;
temporary_edge.all.Node_1 := current_edge.all.Node_1;
add_edge (obj, Copy (temporary_edge), succeed);
end if;
end if;
end if;
end if;
end if;
end if;
if not succeed then
add_edge
(obj,
create_buffer_edge_from_dependency (d, naming_cpt),
succeed);
end if;
if not succeed then
raise building_graph_exception;
end if;
naming_cpt := naming_cpt + 1;
end create_specific_buffer_edges;
function build_graph_from_system (obj : system) return graph is
built_graph : graph;
t_iterator : tasks_iterator;
current_task : generic_task_ptr;
d_iterator : tasks_dependencies_iterator;
current_dependency : dependency_ptr;
succeed : Boolean;
naming_cpt : Integer;
begin
naming_cpt := 1;
Initialize (built_graph);
reset_iterator (obj.tasks, t_iterator);
current_element (obj.tasks, current_task, t_iterator);
-- First Step : adding all task_nodes
while (not is_last_element (obj.tasks, t_iterator)) loop
add_node (built_graph, create_node_from_task (current_task), succeed);
put_debug ("*******************Building Graph");
next_element (obj.tasks, t_iterator);
current_element (obj.tasks, current_task, t_iterator);
if not succeed then
raise building_graph_exception;
end if;
end loop;
add_node (built_graph, create_node_from_task (current_task), succeed);
if (not is_empty (obj.dependencies.all.depends)) then
reset_iterator (obj.dependencies.all.depends, d_iterator);
current_element
(obj.dependencies.all.depends,
current_dependency,
d_iterator);
while (not is_last_element (obj.dependencies.all.depends, d_iterator))
loop
case current_dependency.type_of_dependency is
when precedence_dependency | remote_procedure_call_dependency =>
add_edge
(built_graph,
create_precedence_edge_from_dependency
(current_dependency,
naming_cpt),
succeed);
if not succeed then
raise building_graph_exception;
end if;
naming_cpt := naming_cpt + 1;
when queueing_buffer_dependency =>
create_specific_buffer_edges
(built_graph,
current_dependency,
naming_cpt,
succeed);
if not succeed then
raise building_graph_exception;
end if;
when asynchronous_communication_dependency =>
create_specific_communication_edges
(built_graph,
current_dependency,
naming_cpt,
succeed);
if not succeed then
raise building_graph_exception;
end if;
when time_triggered_communication_dependency =>
add_edge
(built_graph,
create_time_triggered_communication_edge_from_dependency
(current_dependency,
naming_cpt),
succeed);
if not succeed then
raise building_graph_exception;
end if;
naming_cpt := naming_cpt + 1;
when resource_dependency =>
create_specific_resource_edges
(built_graph,
current_dependency,
naming_cpt,
succeed);
if not succeed then
raise building_graph_exception;
end if;
naming_cpt := naming_cpt + 1;
when black_board_buffer_dependency =>
null;
end case;
next_element (obj.dependencies.all.depends, d_iterator);
current_element
(obj.dependencies.all.depends,
current_dependency,
d_iterator);
end loop;
case current_dependency.type_of_dependency is
when precedence_dependency | remote_procedure_call_dependency =>
add_edge
(built_graph,
create_precedence_edge_from_dependency
(current_dependency,
naming_cpt),
succeed);
if not succeed then
raise building_graph_exception;
end if;
naming_cpt := naming_cpt + 1;
when queueing_buffer_dependency =>
create_specific_buffer_edges
(built_graph,
current_dependency,
naming_cpt,
succeed);
if not succeed then
raise building_graph_exception;
end if;
when asynchronous_communication_dependency =>
create_specific_communication_edges
(built_graph,
current_dependency,
naming_cpt,
succeed);
if not succeed then
raise building_graph_exception;
end if;
when time_triggered_communication_dependency =>
add_edge
(built_graph,
create_time_triggered_communication_edge_from_dependency
(current_dependency,
naming_cpt),
succeed);
if not succeed then
raise building_graph_exception;
end if;
naming_cpt := naming_cpt + 1;
when resource_dependency =>
create_specific_resource_edges
(built_graph,
current_dependency,
naming_cpt,
succeed);
if not succeed then
raise building_graph_exception;
end if;
naming_cpt := naming_cpt + 1;
when black_board_buffer_dependency =>
null;
end case;
end if;
clean_resource_edges (built_graph);
return built_graph;
end build_graph_from_system;
function get_value (obj : graph_ptr) return graph is
return_graph : graph;
temp : graph_ptr;
begin
Initialize (return_graph);
temp := Copy (obj);
return_graph.Edges := temp.Edges;
return_graph.Nodes := temp.Nodes;
return return_graph;
end get_value;
end DP_Graph.extended;