Commit b52871e4 authored by hugues.jerome's avatar hugues.jerome

* Add AADL-to-Cheddar backend


git-svn-id: https://tecsw.estec.esa.int/svn/taste/trunk/ocarina@866 129961e7-ef38-4bb5-a8f7-c9a525a55882
parent 2df81058
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- O C A R I N A . B A C K E N D S . C H E D D A R . M A I N --
-- --
-- B o d y --
-- --
-- Copyright (C) 2010, GET-Telecom Paris. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 2, or (at your option) any --
-- later version. Ocarina 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 distributed with Ocarina; see file COPYING. --
-- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02111-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- Ocarina is maintained by the Ocarina team --
-- (ocarina-users@listes.enst.fr) --
-- --
------------------------------------------------------------------------------
with Ocarina.ME_AADL;
with Ocarina.ME_AADL.AADL_Instances.Nodes;
with Ocarina.ME_AADL.AADL_Instances.Nutils;
with Ocarina.ME_AADL.AADL_Instances.Entities;
with Ocarina.Backends.XML_Tree.Nodes;
with Ocarina.Backends.XML_Tree.Nutils;
with Ocarina.Backends.Cheddar.Mapping;
package body Ocarina.Backends.Cheddar.Main is
use Ocarina.ME_AADL;
use Ocarina.ME_AADL.AADL_Instances.Nodes;
use Ocarina.ME_AADL.AADL_Instances.Entities;
use Ocarina.Backends.XML_Tree.Nutils;
use Ocarina.Backends.Cheddar.Mapping;
package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
package XTN renames Ocarina.Backends.XML_Tree.Nodes;
procedure Visit_Component (E : Node_Id);
procedure Visit_System (E : Node_Id);
procedure Visit_Processor (E : Node_Id);
procedure Visit_Thread (E : Node_Id);
procedure Visit_Process (E : Node_Id);
procedure Visit_Data (E : Node_Id);
----------------------------
-- Visit_Subcomponents_Of --
----------------------------
procedure Visit_Subcomponents_Of (E : Node_Id);
procedure Visit_Subcomponents_Of (E : Node_Id) is
S : Node_Id;
begin
if not AINU.Is_Empty (Subcomponents (E)) then
S := First_Node (Subcomponents (E));
while Present (S) loop
-- Visit the component instance corresponding to the
-- subcomponent S.
Visit (Corresponding_Instance (S));
S := Next_Node (S);
end loop;
end if;
end Visit_Subcomponents_Of;
Root_System_Node : Node_Id := No_Node;
Cheddar_Node : Node_Id := No_Node;
Tasks_Node : Node_Id := No_Node;
Processors_Node : Node_Id := No_Node;
Address_Node : Node_Id := No_Node;
Buffers_Node : Node_Id := No_Node;
Resources_Node : Node_Id := No_Node;
Dependencies_Node : Node_Id := No_Node;
-----------
-- Visit --
-----------
procedure Visit (E : Node_Id) is
begin
case Kind (E) is
when K_Architecture_Instance =>
Root_System_Node := Root_System (E);
Visit (Root_System_Node);
when K_Component_Instance =>
Visit_Component (E);
when others =>
null;
end case;
end Visit;
---------------------
-- Visit_Component --
---------------------
procedure Visit_Component (E : Node_Id) is
Category : constant Component_Category
:= Get_Category_Of_Component (E);
begin
case Category is
when CC_System =>
Visit_System (E);
when CC_Processor =>
Visit_Processor (E);
when CC_Process =>
Visit_Process (E);
when CC_Thread =>
Visit_Thread (E);
when CC_Data =>
Visit_Data (E);
when others =>
null;
end case;
end Visit_Component;
------------------
-- Visit_Thread --
------------------
procedure Visit_Thread (E : Node_Id) is
F : Node_Id;
begin
Append_Node_To_List
(Map_Thread (E), XTN.Subitems (Tasks_Node));
if Present (Features (E)) then
F := First_Node (Features (E));
while Present (F) loop
if Kind (F) = K_Port_Spec_Instance
and then Is_Event (F)
then
if Is_In (F) then
Append_Node_To_List
(Map_Buffer (E, F), XTN.Subitems (Buffers_Node));
end if;
Append_Node_To_List
(Map_Dependency (E, F), XTN.Subitems (Dependencies_Node));
end if;
F := Next_Node (F);
end loop;
end if;
Visit_Subcomponents_Of (E);
end Visit_Thread;
------------------
-- Visit_Data --
------------------
procedure Visit_Data (E : Node_Id) is
begin
Append_Node_To_List
(Map_Data (E), XTN.Subitems (Resources_Node));
Visit_Subcomponents_Of (E);
end Visit_Data;
----------------------------
-- Visit_Process_Instance --
----------------------------
procedure Visit_Process (E : Node_Id) is
begin
Append_Node_To_List
(Map_Process (E), XTN.Subitems (Address_Node));
Visit_Subcomponents_Of (E);
end Visit_Process;
---------------------
-- Visit_Processor --
---------------------
procedure Visit_Processor (E : Node_Id) is
begin
Append_Node_To_List
(Map_Processor (E), XTN.Subitems (Processors_Node));
Visit_Subcomponents_Of (E);
end Visit_Processor;
------------------
-- Visit_System --
------------------
procedure Visit_System (E : Node_Id) is
P : Node_Id;
U : Node_Id;
begin
P := Map_HI_Node (E);
Push_Entity (P);
U := Map_HI_Unit (E);
Push_Entity (U);
-- A cheddar XML file is made of one cheddar node, with several
-- children: tasks (AADL tasks), processors (AADL processors),
-- address_spaces (AADL processes), resources (AADL data
-- components).
-- <!ELEMENT cheddar (processors,
-- (address_spaces)?,
-- (tasks)?,
-- ((event_analyzers)?
-- |(networks)?
-- |(buffers)?
-- |(resources)?
-- |(messages)?),
-- (dependencies)?)
-- >
if Cheddar_Node = No_Node then
Cheddar_Node := Make_Xml_Node ("cheddar");
Append_Node_To_List
(Cheddar_Node, XTN.Subitems (XTN.Root_Node (XTN.XML_File (U))));
end if;
if Processors_Node = No_Node then
Processors_Node := Make_XML_Node ("processors");
Append_Node_To_List (Processors_Node, XTN.Subitems (Cheddar_Node));
end if;
if Address_Node = No_Node then
Address_Node := Make_XML_Node ("address_spaces");
Append_Node_To_List (Address_Node, XTN.Subitems (Cheddar_Node));
end if;
if Tasks_Node = No_Node then
Tasks_Node := Make_XML_Node ("tasks");
Append_Node_To_List (Tasks_Node, XTN.Subitems (Cheddar_Node));
end if;
if Buffers_Node = No_Node then
Buffers_Node := Make_XML_Node ("buffers");
Append_Node_To_List (Buffers_Node, XTN.Subitems (Cheddar_Node));
end if;
if Resources_Node = No_Node then
Resources_Node := Make_XML_Node ("resources");
Append_Node_To_List (Resources_Node, XTN.Subitems (Cheddar_Node));
end if;
if Dependencies_Node = No_Node then
Dependencies_Node := Make_XML_Node ("dependencies");
Append_Node_To_List (Dependencies_Node, XTN.Subitems (Cheddar_Node));
end if;
Visit_Subcomponents_Of (E);
Pop_Entity;
Pop_Entity; -- A
end Visit_System;
end Ocarina.Backends.Cheddar.Main;
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- O C A R I N A . B A C K E N D S . C H E D D A R . M A I N --
-- --
-- S p e c --
-- --
-- Copyright (C) 2010, GET-Telecom Paris. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 2, or (at your option) any --
-- later version. Ocarina 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 distributed with Ocarina; see file COPYING. --
-- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02111-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- Ocarina is maintained by the Ocarina team --
-- (ocarina-users@listes.enst.fr) --
-- --
------------------------------------------------------------------------------
package Ocarina.Backends.Cheddar.Main is
procedure Visit (E : Node_Id);
end Ocarina.Backends.Cheddar.Main;
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- O C A R I N A . B A C K E N D S . C H E D D A R . M A P P I N G --
-- --
-- B o d y --
-- --
-- Copyright (C) 2010, GET-Telecom Paris. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 2, or (at your option) any --
-- later version. Ocarina 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 distributed with Ocarina; see file COPYING. --
-- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02111-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- Ocarina is maintained by the Ocarina team --
-- (ocarina-users@listes.enst.fr) --
-- --
------------------------------------------------------------------------------
with Namet; use Namet;
with Utils; use Utils;
with Ocarina.ME_AADL.AADL_Instances.Nodes;
with Ocarina.ME_AADL.AADL_Instances.Nutils;
with Ocarina.ME_AADL.AADL_Instances.Entities;
with Ocarina.Backends.Properties;
with Ocarina.Backends.Utils;
with Ocarina.Backends.XML_Common.Mapping;
with Ocarina.Backends.XML_Tree.Nodes;
with Ocarina.Backends.XML_Tree.Nutils;
with Ocarina.Backends.XML_Values;
package body Ocarina.Backends.Cheddar.Mapping is
use Ocarina.ME_AADL;
use Ocarina.ME_AADL.AADL_Instances.Nodes;
use Ocarina.ME_AADL.AADL_Instances.Entities;
use Ocarina.Backends.Properties;
use Ocarina.Backends.Utils;
use Ocarina.Backends.XML_Common.Mapping;
use Ocarina.Backends.XML_Tree.Nodes;
use Ocarina.Backends.XML_Tree.Nutils;
package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
package XTN renames Ocarina.Backends.XML_Tree.Nodes;
package XV renames Ocarina.Backends.XML_Values;
function Map_Buffer_Name (E : Node_Id; P : Node_Id) return Name_Id;
-- Compute name of buffer by concatenating name of the thread
-- instance and name of the port.
---------------------
-- Map_Buffer_Name --
---------------------
function Map_Buffer_Name (E : Node_Id; P : Node_Id) return Name_Id is
begin
Get_Name_String (Display_Name (Identifier (Parent_Subcomponent (E))));
Add_Str_To_Name_Buffer ("_");
Get_Name_String_And_Append (Display_Name (Identifier (P)));
return To_Lower (Name_Find);
end Map_Buffer_Name;
-----------------
-- Map_HI_Node --
-----------------
function Map_HI_Node (E : Node_Id) return Node_Id is
N : constant Node_Id := New_Node (XTN.K_HI_Node);
begin
pragma Assert (AINU.Is_Process (E)
or else AINU.Is_System (E)
or else AINU.Is_Processor (E));
if AINU.Is_System (E) then
Set_Str_To_Name_Buffer ("general");
else
Get_Name_String
(To_XML_Name (AIN.Name (Identifier (Parent_Subcomponent (E)))));
Add_Str_To_Name_Buffer ("_cheddar");
end if;
XTN.Set_Name (N, Name_Find);
Set_Units (N, New_List (K_List_Id));
-- Append the partition N to the node list
Append_Node_To_List (N, HI_Nodes (Current_Entity));
Set_Distributed_Application (N, Current_Entity);
return N;
end Map_HI_Node;
-----------------
-- Map_HI_Unit --
-----------------
function Map_HI_Unit (E : Node_Id)
return Node_Id is
U : Node_Id;
N : Node_Id;
P : Node_Id;
Root : Node_Id;
begin
pragma Assert (AINU.Is_System (E)
or else AINU.Is_Process (E)
or else AINU.Is_Processor (E));
U := New_Node (XTN.K_HI_Unit, Identifier (E));
-- Packages that are common to all nodes
if AINU.Is_System (E) then
Get_Name_String (To_XML_Name (Display_Name (Identifier (E))));
else
Get_Name_String
(To_XML_Name
(Display_Name (Identifier (Parent_Subcomponent (E)))));
end if;
Add_Str_To_Name_Buffer ("_cheddar");
N := Make_Defining_Identifier (Name_Find);
P := Make_XML_File (N);
Set_Distributed_Application_Unit (P, U);
XTN.Set_XML_File (U, P);
Root := Make_XML_Node ("", No_Name, K_Nameid);
XTN.Set_Root_Node (P, Root);
Append_Node_To_List (U, Units (Current_Entity));
XTN.Set_Entity (U, Current_Entity);
return U;
end Map_HI_Unit;
-------------------
-- Map_Processor --
-------------------
function Map_Processor (E : Node_Id) return Node_Id is
N : Node_Id;
P : Node_Id;
Schedulers : constant array (Supported_Scheduling_Protocol'Range)
of Name_Id :=
(RATE_MONOTONIC_PROTOCOL =>
Get_String_Name ("RATE_MONOTONIC_PROTOCOL"),
POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL =>
Get_String_Name ("POSIX_1003_HIGHEST_PRIORITY_FIRST_PROTOCOL"),
EARLIEST_DEADLINE_FIRST_PROTOCOL =>
Get_String_Name ("EARLIEST_DEADLINE_FIRST_PROTOCOL"),
others => No_Name);
Quantum : constant Time_Type := Get_Scheduler_Quantum (E);
begin
-- The structure of a XML node for a processor is
-- <!ELEMENT processor (name|
-- scheduler|
-- network_link)
-- >
N := Make_XML_Node ("processor");
-- name: computed from processor instance name
P := Map_Node_Identifier_To_XML_Node ("name", Parent_Subcomponent (E));
Append_Node_To_List (P, XTN.Subitems (N));
-- scheduler: computed from Scheduling_Protocol policy
P := Map_To_XML_Node ("scheduler",
Schedulers (Get_Scheduling_Protocol (E)));
if Quantum /= Null_Time then
declare
Name : constant Node_Id
:= Make_Defining_Identifier (Get_String_Name ("quantum"));
Value : constant Node_Id
:= Make_Literal (XV.New_Numeric_Value
(To_Milliseconds (Quantum), 1, 10));
begin
Append_Node_To_List (Make_Assignement (Name, Value),
XTN.Items (P));
end;
end if;
Append_Node_To_List (P, XTN.Subitems (N));
-- network_link: XXX for now we put a default value
P := Map_To_XML_Node ("network_link", Get_String_Name ("No_Network"));
Append_Node_To_List (P, XTN.Subitems (N));
return N;
end Map_Processor;
--------------
-- Map_Data --
--------------
function Map_Data (E : Node_Id) return Node_Id is
N : Node_Id;
P : Node_Id;
Concurrency_Protocols : constant array
(Supported_Concurrency_Control_Protocol'Range) of Name_Id :=
(Concurrency_NoneSpecified =>
Get_String_Name ("NO_PROTOCOL"),
Concurrency_Priority_Ceiling =>
Get_String_Name ("PRIORITY_CEILING_PROTOCOL"),
others => No_Name);
begin
-- The structure of a XML node for a data is
-- <!ELEMENT resource (cpu_name|
-- address_space_name|
-- name|
-- state|
-- protocol|
-- (state)?|
-- (resource_used_by)?)
-- >
N := Make_XML_Node ("resource");
-- cpu_name: computed from the processor binding of the
-- container process of the current data
P := Map_Node_Identifier_To_XML_Node
("cpu_name",
Parent_Subcomponent
(Get_Bound_Processor
(Corresponding_Instance
(Get_Container_Process
(Parent_Subcomponent (E))))));
Append_Node_To_List (P, XTN.Subitems (N));
-- address_space: name of the enclosing process
P := Map_Node_Identifier_To_XML_Node
("address_space_name",
Get_Container_Process (Parent_Subcomponent (E)));
Append_Node_To_List (P, XTN.Subitems (N));
-- name: computed from data instance name
P := Map_Node_Identifier_To_XML_Node ("name", Parent_Subcomponent (E));
Append_Node_To_List (P, XTN.Subitems (N));
-- state: XXX ?
P := Map_To_XML_Node ("state", Unsigned_Long_Long'(1));
Append_Node_To_List (P, XTN.Subitems (N));
-- protocol: computed from Concurrency_Protocol property
P := Map_To_XML_Node
("protocol",
Concurrency_Protocols (Get_Concurrency_Protocol (E)));
Append_Node_To_List (P, XTN.Subitems (N));
-- resource_used_by: computed from the list of threads
-- accessing to this data component. Per construction, it is
-- assumed to be computed from the list of connections in the
-- enclosing process.
P := Make_XML_Node ("resource_used_by");
declare
Access_List : constant List_Id := Connections
(Corresponding_Instance
(Get_Container_Process (Parent_Subcomponent (E))));
Connection : Node_Id;
K, M : Node_Id;
begin
if not AINU.Is_Empty (Access_List) then
Connection := AIN.First_Node (Access_List);
while Present (Connection) loop
if Kind (Connection) = K_Connection_Instance
and then Get_Category_Of_Connection (Connection)
= CT_Access_Data
then
if Item (AIN.First_Node (Path (Source (Connection))))
= Parent_Subcomponent (E)
then
M := Make_XML_Node ("resource_user");
K := Make_Defining_Identifier
(To_XML_Name
(Display_Name
(Identifier
(Item
(AIN.First_Node
(Path (Destination (Connection))))))));
Append_Node_To_List (K, XTN.Subitems (M));
K := Make_Literal (XV.New_Numeric_Value (1, 1, 10));
Append_Node_To_List (K, XTN.Subitems (M));
K := Make_Literal (XV.New_Numeric_Value (1, 1, 10));
Append_Node_To_List (K, XTN.Subitems (M));
Append_Node_To_List (M, XTN.Subitems (P));
end if;
end if;
Connection := AIN.Next_Node (Connection);
end loop;
end if;
end;
Append_Node_To_List (P, XTN.Subitems (N));
return N;
end Map_Data;
-----------------
-- Map_Process --
-----------------
function Map_Process (E : Node_Id) return Node_Id is
N : Node_Id;
P : Node_Id;
begin
-- The structure of a XML node for a address_space is
-- <!ELEMENT address_space (name|
-- text_memory_size|
-- data_memory_size|
-- stack_memory_size|
-- heap_memory_size)
-- >
N := Make_XML_Node ("address_space");
-- name: computed from process instance name
P := Map_Node_Identifier_To_XML_Node ("name", Parent_Subcomponent (E));
Append_Node_To_List (P, XTN.Subitems (N));
-- cpu_name: computed from the processor binding of the
-- container process of the current thread
P := Map_Node_Identifier_To_XML_Node
("cpu_name", Get_Bound_Processor (E));
Append_Node_To_List (P, XTN.Subitems (N));
-- text_memory_size: XXX
P := Map_To_XML_Node ("text_memory_size", Unsigned_Long_Long'(0));
Append_Node_To_List (P, XTN.Subitems (N));
-- data_memory_size: XXX
P := Map_To_XML_Node ("data_memory_size", Unsigned_Long_Long'(0));